diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000000..cfe51313e7 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +* text=auto eol=lf +impls/vbs/*.vbs text eol=crlf \ No newline at end of file diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md new file mode 100644 index 0000000000..0c180e4254 --- /dev/null +++ b/.github/pull_request_template.md @@ -0,0 +1,15 @@ +Pull request requirements: + +- [ ] Commits are well written and well organized. +- [ ] Commits for a specific implementation should be prefixed with + the implementation name. +- [ ] Github Actions CI passes all checks (including self-host) + +Additional requirements if you are adding a new implementation (see [FAQ](../docs/FAQ.md#add_implementation) for details): + +- [ ] Follow incremental structure (no common eval code) +- [ ] Add `impls//Dockerfile` +- [ ] Add `impls//Makefile` +- [ ] Update `IMPLS.yml` +- [ ] Update `Makefile.impls` +- [ ] Update `README.md` diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml new file mode 100644 index 0000000000..38f88a04ae --- /dev/null +++ b/.github/workflows/main.yml @@ -0,0 +1,211 @@ +name: Build and Test + +permissions: + contents: read + packages: write + +on: + push: {} + pull_request: {} + workflow_dispatch: + inputs: + impls: + description: 'Space separated list of impls to test (or all)' + required: true + default: 'all' + self-hosted: + description: 'Include self-hosted tests' + required: true + default: 'yes' + options: ['yes', 'no'] + +jobs: + get-matrix: + runs-on: ubuntu-24.04 + outputs: + do-linux: ${{ steps.get-matrix-step.outputs.do_linux }} + matrix-linux: ${{ steps.get-matrix-step.outputs.linux }} + do-macos: ${{ steps.get-matrix-step.outputs.do_macos }} + matrix-macos: ${{ steps.get-matrix-step.outputs.macos }} + do-windows: ${{ steps.get-matrix-step.outputs.do_windows }} + matrix-windows: ${{ steps.get-matrix-step.outputs.windows }} + steps: + - uses: actions/checkout@v4 + - id: files + if: ${{ github.event_name != 'workflow_dispatch' }} + uses: kanaka/get-changed-files@v4 + with: + default-base: master + - id: get-matrix-step + run: | + export OVERRIDE_IMPLS="${{ github.event.inputs.impls }}" # " + echo "OVERRIDE_IMPLS: ${OVERRIDE_IMPLS}" + ./get-ci-matrix.py ${{ steps.files.outputs.all }} > "${GITHUB_OUTPUT}" + + linux: + needs: get-matrix + if: ${{ needs.get-matrix.outputs.do-linux == 'true' }} + runs-on: ubuntu-24.04 + strategy: + fail-fast: false + matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-linux) }} + steps: + - uses: actions/checkout@v4 + with: + fetch-depth: 0 # Need full history for voom like versions + - name: Log in to GitHub Container Registry + uses: docker/login-action@v3 + with: + registry: ghcr.io + username: ${{ github.actor }} + password: ${{ secrets.GITHUB_TOKEN }} + - name: Docker Build/Push + run: | + export ${{ matrix.IMPL }} + ./ci.sh docker-build-push ${IMPL} + - name: Build + run: | + export ${{ matrix.IMPL }} + ./ci.sh build ${IMPL} + - name: Step Tests + run: | + export ${{ matrix.IMPL }} + ./ci.sh test ${IMPL} + - name: Regression Tests + run: | + export ${{ matrix.IMPL }} + STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} + - name: Performance Tests + run: | + export ${{ matrix.IMPL }} + ./ci.sh perf ${IMPL} + - name: Self-hosted Tests + if: ${{ github.event.inputs.self-hosted != 'no' }} + run: | + export ${{ matrix.IMPL }} + if [ -n "${NO_SELF_HOST:-}" ]; then + echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" + else + DO_SELF_HOST=1 ./ci.sh test ${IMPL} + # Check that self-hosted mode really ran + [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] + fi + - name: Print debug log + if: failure() + run: cat *.debug + - name: Archive logs and debug output + uses: actions/upload-artifact@v4 + with: + name: logs.${{ matrix.IMPL }} + path: | + *.log + *.debug + + macos: + needs: get-matrix + if: ${{ needs.get-matrix.outputs.do-macos == 'true' }} + runs-on: macos-12 + strategy: + fail-fast: false + matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-macos) }} + steps: + - uses: actions/checkout@v4 + - name: Build + run: | + export ${{ matrix.IMPL }} + ./ci.sh build ${IMPL} + - name: Step Tests + run: | + export ${{ matrix.IMPL }} + ./ci.sh test ${IMPL} + - name: Regression Tests + run: | + export ${{ matrix.IMPL }} + STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} + - name: Performance Tests + run: | + export ${{ matrix.IMPL }} + ./ci.sh perf ${IMPL} + - name: Self-hosted Tests + if: ${{ github.event.inputs.self-hosted != 'no' }} + run: | + export ${{ matrix.IMPL }} + if [ -n "${NO_SELF_HOST:-}" ]; then + echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" + else + DO_SELF_HOST=1 ./ci.sh test ${IMPL} + # Check that self-hosted mode really ran + [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] + fi + - name: Print debug log + if: failure() + run: cat *.debug + - name: Archive logs and debug output + uses: actions/upload-artifact@v4 + with: + name: logs.${{ matrix.IMPL }} + path: | + *.log + *.debug + + windows: + needs: get-matrix + if: ${{ needs.get-matrix.outputs.do-windows == 'true' }} + runs-on: windows-2022 + strategy: + fail-fast: false + matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-windows) }} + steps: + - uses: Vampire/setup-wsl@v3 + with: + distribution: Ubuntu-24.04 + - name: Install requirements for WSL + shell: wsl-bash {0} + run: | + sudo apt update -y + sudo apt install make -y + sudo apt install python3 -y + sudo ln -s /usr/bin/python3 /usr/bin/python + - uses: actions/checkout@v4 + - name: Build + shell: wsl-bash {0} + run: | + export ${{ matrix.IMPL }} + ./ci.sh build ${IMPL} + - name: Step Tests + shell: wsl-bash {0} + run: | + export ${{ matrix.IMPL }} + ./ci.sh test ${IMPL} + - name: Regression Tests + shell: wsl-bash {0} + run: | + export ${{ matrix.IMPL }} + STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} + - name: Performance Tests + shell: wsl-bash {0} + run: | + export ${{ matrix.IMPL }} + ./ci.sh perf ${IMPL} + - name: Self-hosted Tests + if: ${{ github.event.inputs.self-hosted != 'no' }} + shell: wsl-bash {0} + run: | + export ${{ matrix.IMPL }} + if [ -n "${NO_SELF_HOST:-}" ]; then + echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" + else + DO_SELF_HOST=1 ./ci.sh test ${IMPL} + # Check that self-hosted mode really ran + [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] + fi + - name: Print debug log + if: failure() + run: cat *.debug + - name: Archive logs and debug output + uses: actions/upload-artifact@v4 + with: + name: logs.${{ matrix.IMPL }} + path: | + *.log + *.debug diff --git a/.gitignore b/.gitignore index 6c346cfa7e..063a63b183 100644 --- a/.gitignore +++ b/.gitignore @@ -1,50 +1,26 @@ +.DS_Store +.bash_history +.cache +.cargo +.config +.mal-history +.mal_history +.crystal +.lein +.local +.m2 +.ivy2 +.sbt +.npm +.node-gyp */experiments -make/mal.mk -miniMAL/node_modules -js/node_modules -js/mal.js -js/mal_web.js -coffee/node_modules -bash/mal.sh -c/*.o -*.pyc -*/mal -*/step0_repl -*/step1_read_print -*/step2_eval -*/step3_env -*/step4_if_fn_do -*/step5_tco -*/step6_file -*/step7_quote -*/step8_macros -*/step9_try -*/stepA_mal -cs/*.exe -cs/*.dll -cs/*.mdb -clojure/target -clojure/.lein-repl-history -go/step* -go/mal -java/target/ -java/dependency-reduced-pom.xml -ocaml/*.cmi -ocaml/*.cmo -ocaml/*.swp -ocaml/*.cmx -ocaml/*.o -ocaml/mal_lib.* -rust/target/ -rust/mal -rust/Cargo.lock -rust/.cargo -r/lib -vb/*.exe -vb/*.dll -scala/target -scala/project -haskell/*.hi -haskell/*.o -lua/lib -lua/linenoise.so +node_modules +*/notes +GPATH +GTAGS +GRTAGS +logs +old +tmp/ +.xslt_mal_history +zig-cache/ diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000000..0e27995da0 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,19 @@ +sudo: required + +# matrix layout based on: +# https://github.com/libressl-portable/portable/blob/9e090286b55def5ca2c0cc375c65023a70d8796e/.travis.yml + +matrix: + include: + - {env: IMPL=objc NO_DOCKER=1, os: osx, osx_image: xcode7} + - {env: IMPL=swift NO_DOCKER=1, os: osx, osx_image: xcode7.3} + - {env: IMPL=swift3 NO_DOCKER=1, os: osx, osx_image: xcode8} + - {env: IMPL=swift4 NO_DOCKER=1, os: osx, osx_image: xcode10} + - {env: IMPL=swift5 NO_DOCKER=1, os: osx, osx_image: xcode11} + +script: + # Build, test, perf + - ./ci.sh build ${IMPL} + - ./ci.sh test ${IMPL} + - STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} + - ./ci.sh perf ${IMPL} diff --git a/IMPLS.yml b/IMPLS.yml new file mode 100644 index 0000000000..17e38a53eb --- /dev/null +++ b/IMPLS.yml @@ -0,0 +1,126 @@ +IMPL: + - {IMPL: ada} + - {IMPL: ada.2} + - {IMPL: awk} + - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout + - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM + - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM + - {IMPL: bbc-basic} + - {IMPL: c} + - {IMPL: c.2} + - {IMPL: cpp} + - {IMPL: coffee} + - {IMPL: cs} + - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM + - {IMPL: clojure, clojure_MODE: clj} + - {IMPL: clojure, clojure_MODE: cljs} + - {IMPL: common-lisp} + - {IMPL: crystal} + - {IMPL: d, d_MODE: gdc} + - {IMPL: d, d_MODE: ldc2} + - {IMPL: d, d_MODE: dmd} + - {IMPL: dart} + - {IMPL: elisp} + - {IMPL: elixir} + - {IMPL: elm} + - {IMPL: erlang, NO_SELF_HOST: 1} # step4 silent exit on "(DO 3)" + - {IMPL: es6} + - {IMPL: factor} + - {IMPL: fantom} + - {IMPL: fennel} + - {IMPL: forth} + - {IMPL: fsharp} + - {IMPL: go} + - {IMPL: groovy} + - {IMPL: gnu-smalltalk} + - {IMPL: guile} + - {IMPL: hare} + - {IMPL: haskell} + - {IMPL: haxe, haxe_MODE: neko} + - {IMPL: haxe, haxe_MODE: python} + - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} + - {IMPL: haxe, haxe_MODE: js} + - {IMPL: hy} + - {IMPL: io, NO_SELF_HOST: 1, NO_SELF_HOST_PERF: 1} # invalid pointer, perf OOM + - {IMPL: janet} + - {IMPL: java} + - {IMPL: java-truffle} + - {IMPL: jq, NO_SELF_HOST: 1} # start-up failure and other issues + - {IMPL: js} + - {IMPL: julia} + - {IMPL: kotlin} + - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} + - {IMPL: livescript} + - {IMPL: logo} + - {IMPL: lua} + - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout + - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} + - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} + - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} + - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} + - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout + - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout + - {IMPL: nasm, NO_SELF_HOST: 1} # needs memory bump, then fails in step7/quasiquote + - {IMPL: nim} + - {IMPL: objpascal} + - {IMPL: objc} + - {IMPL: ocaml} + - {IMPL: perl} + - {IMPL: perl6} + - {IMPL: php} + - {IMPL: picolisp} + - {IMPL: pike} + - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout +# - {IMPL: plsql} + - {IMPL: prolog} + - {IMPL: ps} + - {IMPL: powershell, NO_SELF_HOST: 1} # works, but too slow be default enabled + - {IMPL: purs} + - {IMPL: python2} + - {IMPL: python3} + - {IMPL: r} + - {IMPL: racket} + - {IMPL: rexx} + - {IMPL: rpython, SLOW: 1} + - {IMPL: ruby} + - {IMPL: ruby.2} + - {IMPL: rust} + - {IMPL: scala} + - {IMPL: scheme, scheme_MODE: chibi} + - {IMPL: scheme, scheme_MODE: kawa} + - {IMPL: scheme, scheme_MODE: gauche} + - {IMPL: scheme, scheme_MODE: chicken} + - {IMPL: scheme, scheme_MODE: sagittarius} + - {IMPL: scheme, scheme_MODE: cyclone} +# - {IMPL: scheme, scheme_MODE: foment} + - {IMPL: skew} + - {IMPL: sml, sml_MODE: polyml} + - {IMPL: sml, sml_MODE: mlton} + - {IMPL: sml, sml_MODE: mosml} + - {IMPL: tcl} + - {IMPL: ts} + - {IMPL: vala} + - {IMPL: vb} + - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout + - {IMPL: vimscript} + # no self-host perf for wasm due to mac stack overflow + - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + - {IMPL: wren} + - {IMPL: xslt, NO_SELF_HOST: 1} # step1 fail: "Too many nested template ..." + - {IMPL: yorick} + - {IMPL: zig} + + # See .travis.yml (for older osx / xcode tests) + - {IMPL: swift3} +# - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8} + - {IMPL: swift4} +# - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10} + - {IMPL: swift6} +# - {IMPL: swift6, NO_DOCKER: 1, OS: macos} # works but too expensive in GH Actions + + - {IMPL: vbs, NO_SELF_HOST: 1, NO_DOCKER: 1, OS: windows} # self-host too slow/expensive in GH Actions diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000000..88b2867725 --- /dev/null +++ b/LICENSE @@ -0,0 +1,387 @@ +Copyright (C) 2015 Joel Martin + +Mal (make-a-lisp) is licensed under the MPL 2.0 (Mozilla Public +License 2.0). The text of the MPL 2.0 license is included below and +can be found at https://www.mozilla.org/MPL/2.0/ + +Many of the implementations run or compile using a line editing +library. In some cases, the implementations provide an option in the +code to switch between the GNU GPL licensed GNU readline library and +the BSD licensed editline (libedit) library. + + +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. + + diff --git a/LICENSE.txt b/LICENSE.txt deleted file mode 100644 index 3bfdf5f61e..0000000000 --- a/LICENSE.txt +++ /dev/null @@ -1,387 +0,0 @@ -Copyright (C) 2015 Joel Martin - -Mal (make-a-lisp) is licensed under the MPL 2.0 (Mozilla Public -License 2.0). The text of the MPL 2.0 license is included below and -can be found at https://www.mozilla.org/MPL/2.0/ - -Many of the implemenations run or compile using a line editing -library. In some cases, the implementations provide an option in the -code to switch between the GNU GPL licensed GNU readline library and -the BSD licensed editline (libedit) library. - - -Mozilla Public License Version 2.0 -================================== - -1. Definitions --------------- - -1.1. "Contributor" - means each individual or legal entity that creates, contributes to - the creation of, or owns Covered Software. - -1.2. "Contributor Version" - means the combination of the Contributions of others (if any) used - by a Contributor and that particular Contributor's Contribution. - -1.3. "Contribution" - means Covered Software of a particular Contributor. - -1.4. "Covered Software" - means Source Code Form to which the initial Contributor has attached - the notice in Exhibit A, the Executable Form of such Source Code - Form, and Modifications of such Source Code Form, in each case - including portions thereof. - -1.5. "Incompatible With Secondary Licenses" - means - - (a) that the initial Contributor has attached the notice described - in Exhibit B to the Covered Software; or - - (b) that the Covered Software was made available under the terms of - version 1.1 or earlier of the License, but not also under the - terms of a Secondary License. - -1.6. "Executable Form" - means any form of the work other than Source Code Form. - -1.7. "Larger Work" - means a work that combines Covered Software with other material, in - a separate file or files, that is not Covered Software. - -1.8. "License" - means this document. - -1.9. "Licensable" - means having the right to grant, to the maximum extent possible, - whether at the time of the initial grant or subsequently, any and - all of the rights conveyed by this License. - -1.10. "Modifications" - means any of the following: - - (a) any file in Source Code Form that results from an addition to, - deletion from, or modification of the contents of Covered - Software; or - - (b) any new file in Source Code Form that contains any Covered - Software. - -1.11. "Patent Claims" of a Contributor - means any patent claim(s), including without limitation, method, - process, and apparatus claims, in any patent Licensable by such - Contributor that would be infringed, but for the grant of the - License, by the making, using, selling, offering for sale, having - made, import, or transfer of either its Contributions or its - Contributor Version. - -1.12. "Secondary License" - means either the GNU General Public License, Version 2.0, the GNU - Lesser General Public License, Version 2.1, the GNU Affero General - Public License, Version 3.0, or any later versions of those - licenses. - -1.13. "Source Code Form" - means the form of the work preferred for making modifications. - -1.14. "You" (or "Your") - means an individual or a legal entity exercising rights under this - License. For legal entities, "You" includes any entity that - controls, is controlled by, or is under common control with You. For - purposes of this definition, "control" means (a) the power, direct - or indirect, to cause the direction or management of such entity, - whether by contract or otherwise, or (b) ownership of more than - fifty percent (50%) of the outstanding shares or beneficial - ownership of such entity. - -2. License Grants and Conditions --------------------------------- - -2.1. Grants - -Each Contributor hereby grants You a world-wide, royalty-free, -non-exclusive license: - -(a) under intellectual property rights (other than patent or trademark) - Licensable by such Contributor to use, reproduce, make available, - modify, display, perform, distribute, and otherwise exploit its - Contributions, either on an unmodified basis, with Modifications, or - as part of a Larger Work; and - -(b) under Patent Claims of such Contributor to make, use, sell, offer - for sale, have made, import, and otherwise transfer either its - Contributions or its Contributor Version. - -2.2. Effective Date - -The licenses granted in Section 2.1 with respect to any Contribution -become effective for each Contribution on the date the Contributor first -distributes such Contribution. - -2.3. Limitations on Grant Scope - -The licenses granted in this Section 2 are the only rights granted under -this License. No additional rights or licenses will be implied from the -distribution or licensing of Covered Software under this License. -Notwithstanding Section 2.1(b) above, no patent license is granted by a -Contributor: - -(a) for any code that a Contributor has removed from Covered Software; - or - -(b) for infringements caused by: (i) Your and any other third party's - modifications of Covered Software, or (ii) the combination of its - Contributions with other software (except as part of its Contributor - Version); or - -(c) under Patent Claims infringed by Covered Software in the absence of - its Contributions. - -This License does not grant any rights in the trademarks, service marks, -or logos of any Contributor (except as may be necessary to comply with -the notice requirements in Section 3.4). - -2.4. Subsequent Licenses - -No Contributor makes additional grants as a result of Your choice to -distribute the Covered Software under a subsequent version of this -License (see Section 10.2) or under the terms of a Secondary License (if -permitted under the terms of Section 3.3). - -2.5. Representation - -Each Contributor represents that the Contributor believes its -Contributions are its original creation(s) or it has sufficient rights -to grant the rights to its Contributions conveyed by this License. - -2.6. Fair Use - -This License is not intended to limit any rights You have under -applicable copyright doctrines of fair use, fair dealing, or other -equivalents. - -2.7. Conditions - -Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted -in Section 2.1. - -3. Responsibilities -------------------- - -3.1. Distribution of Source Form - -All distribution of Covered Software in Source Code Form, including any -Modifications that You create or to which You contribute, must be under -the terms of this License. You must inform recipients that the Source -Code Form of the Covered Software is governed by the terms of this -License, and how they can obtain a copy of this License. You may not -attempt to alter or restrict the recipients' rights in the Source Code -Form. - -3.2. Distribution of Executable Form - -If You distribute Covered Software in Executable Form then: - -(a) such Covered Software must also be made available in Source Code - Form, as described in Section 3.1, and You must inform recipients of - the Executable Form how they can obtain a copy of such Source Code - Form by reasonable means in a timely manner, at a charge no more - than the cost of distribution to the recipient; and - -(b) You may distribute such Executable Form under the terms of this - License, or sublicense it under different terms, provided that the - license for the Executable Form does not attempt to limit or alter - the recipients' rights in the Source Code Form under this License. - -3.3. Distribution of a Larger Work - -You may create and distribute a Larger Work under terms of Your choice, -provided that You also comply with the requirements of this License for -the Covered Software. If the Larger Work is a combination of Covered -Software with a work governed by one or more Secondary Licenses, and the -Covered Software is not Incompatible With Secondary Licenses, this -License permits You to additionally distribute such Covered Software -under the terms of such Secondary License(s), so that the recipient of -the Larger Work may, at their option, further distribute the Covered -Software under the terms of either this License or such Secondary -License(s). - -3.4. Notices - -You may not remove or alter the substance of any license notices -(including copyright notices, patent notices, disclaimers of warranty, -or limitations of liability) contained within the Source Code Form of -the Covered Software, except that You may alter any license notices to -the extent required to remedy known factual inaccuracies. - -3.5. Application of Additional Terms - -You may choose to offer, and to charge a fee for, warranty, support, -indemnity or liability obligations to one or more recipients of Covered -Software. However, You may do so only on Your own behalf, and not on -behalf of any Contributor. You must make it absolutely clear that any -such warranty, support, indemnity, or liability obligation is offered by -You alone, and You hereby agree to indemnify every Contributor for any -liability incurred by such Contributor as a result of warranty, support, -indemnity or liability terms You offer. You may include additional -disclaimers of warranty and limitations of liability specific to any -jurisdiction. - -4. Inability to Comply Due to Statute or Regulation ---------------------------------------------------- - -If it is impossible for You to comply with any of the terms of this -License with respect to some or all of the Covered Software due to -statute, judicial order, or regulation then You must: (a) comply with -the terms of this License to the maximum extent possible; and (b) -describe the limitations and the code they affect. Such description must -be placed in a text file included with all distributions of the Covered -Software under this License. Except to the extent prohibited by statute -or regulation, such description must be sufficiently detailed for a -recipient of ordinary skill to be able to understand it. - -5. Termination --------------- - -5.1. The rights granted under this License will terminate automatically -if You fail to comply with any of its terms. However, if You become -compliant, then the rights granted under this License from a particular -Contributor are reinstated (a) provisionally, unless and until such -Contributor explicitly and finally terminates Your grants, and (b) on an -ongoing basis, if such Contributor fails to notify You of the -non-compliance by some reasonable means prior to 60 days after You have -come back into compliance. Moreover, Your grants from a particular -Contributor are reinstated on an ongoing basis if such Contributor -notifies You of the non-compliance by some reasonable means, this is the -first time You have received notice of non-compliance with this License -from such Contributor, and You become compliant prior to 30 days after -Your receipt of the notice. - -5.2. If You initiate litigation against any entity by asserting a patent -infringement claim (excluding declaratory judgment actions, -counter-claims, and cross-claims) alleging that a Contributor Version -directly or indirectly infringes any patent, then the rights granted to -You by any and all Contributors for the Covered Software under Section -2.1 of this License shall terminate. - -5.3. In the event of termination under Sections 5.1 or 5.2 above, all -end user license agreements (excluding distributors and resellers) which -have been validly granted by You or Your distributors under this License -prior to termination shall survive termination. - -************************************************************************ -* * -* 6. Disclaimer of Warranty * -* ------------------------- * -* * -* Covered Software is provided under this License on an "as is" * -* basis, without warranty of any kind, either expressed, implied, or * -* statutory, including, without limitation, warranties that the * -* Covered Software is free of defects, merchantable, fit for a * -* particular purpose or non-infringing. The entire risk as to the * -* quality and performance of the Covered Software is with You. * -* Should any Covered Software prove defective in any respect, You * -* (not any Contributor) assume the cost of any necessary servicing, * -* repair, or correction. This disclaimer of warranty constitutes an * -* essential part of this License. No use of any Covered Software is * -* authorized under this License except under this disclaimer. * -* * -************************************************************************ - -************************************************************************ -* * -* 7. Limitation of Liability * -* -------------------------- * -* * -* Under no circumstances and under no legal theory, whether tort * -* (including negligence), contract, or otherwise, shall any * -* Contributor, or anyone who distributes Covered Software as * -* permitted above, be liable to You for any direct, indirect, * -* special, incidental, or consequential damages of any character * -* including, without limitation, damages for lost profits, loss of * -* goodwill, work stoppage, computer failure or malfunction, or any * -* and all other commercial damages or losses, even if such party * -* shall have been informed of the possibility of such damages. This * -* limitation of liability shall not apply to liability for death or * -* personal injury resulting from such party's negligence to the * -* extent applicable law prohibits such limitation. Some * -* jurisdictions do not allow the exclusion or limitation of * -* incidental or consequential damages, so this exclusion and * -* limitation may not apply to You. * -* * -************************************************************************ - -8. Litigation -------------- - -Any litigation relating to this License may be brought only in the -courts of a jurisdiction where the defendant maintains its principal -place of business and such litigation shall be governed by laws of that -jurisdiction, without reference to its conflict-of-law provisions. -Nothing in this Section shall prevent a party's ability to bring -cross-claims or counter-claims. - -9. Miscellaneous ----------------- - -This License represents the complete agreement concerning the subject -matter hereof. If any provision of this License is held to be -unenforceable, such provision shall be reformed only to the extent -necessary to make it enforceable. Any law or regulation which provides -that the language of a contract shall be construed against the drafter -shall not be used to construe this License against a Contributor. - -10. Versions of the License ---------------------------- - -10.1. New Versions - -Mozilla Foundation is the license steward. Except as provided in Section -10.3, no one other than the license steward has the right to modify or -publish new versions of this License. Each version will be given a -distinguishing version number. - -10.2. Effect of New Versions - -You may distribute the Covered Software under the terms of the version -of the License under which You originally received the Covered Software, -or under the terms of any subsequent version published by the license -steward. - -10.3. Modified Versions - -If you create software not governed by this License, and you want to -create a new license for such software, you may create and use a -modified version of this License if you rename the license and remove -any references to the name of the license steward (except to note that -such modified license differs from this License). - -10.4. Distributing Source Code Form that is Incompatible With Secondary -Licenses - -If You choose to distribute Source Code Form that is Incompatible With -Secondary Licenses under the terms of this version of the License, the -notice described in Exhibit B of this License must be attached. - -Exhibit A - Source Code Form License Notice -------------------------------------------- - - This Source Code Form is subject to the terms of the Mozilla Public - License, v. 2.0. If a copy of the MPL was not distributed with this - file, You can obtain one at http://mozilla.org/MPL/2.0/. - -If it is not possible or desirable to put the notice in a particular -file, then You may include the notice in a location (such as a LICENSE -file in a relevant directory) where a recipient would be likely to look -for such a notice. - -You may add additional accurate notices of copyright ownership. - -Exhibit B - "Incompatible With Secondary Licenses" Notice ---------------------------------------------------------- - - This Source Code Form is "Incompatible With Secondary Licenses", as - defined by the Mozilla Public License, v. 2.0. - - diff --git a/Makefile b/Makefile index 5409c0ee1a..ff1cd7a643 100644 --- a/Makefile +++ b/Makefile @@ -1,18 +1,81 @@ +# Usage/help +all help: + @echo + @echo 'USAGE:' + @echo + @echo 'Rules/Targets:' + @echo + @echo 'make "IMPL" # build all steps of IMPL' + @echo 'make "build^IMPL" # build all steps of IMPL' + @echo 'make "IMPL^STEP" # build STEP of IMPL' + @echo 'make "build^IMPL^STEP" # build STEP of IMPL' + @echo + @echo 'make "test" # test all implementations' + @echo 'make "test^IMPL" # test all steps of IMPL' + @echo 'make "test^STEP" # test STEP for all implementations' + @echo 'make "test^IMPL^STEP" # test STEP of IMPL' + @echo + @echo 'make "perf" # run microbenchmarks for all implementations' + @echo 'make "perf^IMPL" # run microbenchmarks for IMPL' + @echo + @echo 'make "repl^IMPL" # run stepA of IMPL' + @echo 'make "repl^IMPL^STEP" # test STEP of IMPL' + @echo + @echo 'make "clean" # run 'make clean' for all implementations' + @echo 'make "clean^IMPL" # run 'make clean' for IMPL' + @echo + @echo 'make "stats" # run 'make stats' for all implementations' + @echo 'make "stats-lisp" # run 'make stats-lisp' for all implementations' + @echo 'make "stats^IMPL" # run 'make stats' for IMPL' + @echo 'make "stats-lisp^IMPL" # run 'make stats-lisp' for IMPL' + @echo + @echo 'Options/Settings:' + @echo + @echo 'make MAL_IMPL=IMPL "test^mal..." # use IMPL for self-host tests' + @echo 'make REGRESS=1 "test..." # test with previous step tests too' + @echo 'make DOCKERIZE=1 ... # to dockerize above rules/targets' + @echo 'make TEST_OPTS="--opt ..." # options to pass to runtest.py' + @echo + @echo 'Other:' + @echo + @echo 'make "docker-build^IMPL" # build docker image for IMPL' + @echo + @echo 'make "docker-shell^IMPL" # start bash shell in docker image for IMPL' + @echo + +# Implementation specific settings are here: +include Makefile.impls + # -# Command line settings +# General command line settings # MAL_IMPL = js -PYTHON = python +# Path to loccount for counting LOC stats +LOCCOUNT = loccount + +# Extra options to pass to runtest.py +TEST_OPTS = + +# Test with previous test files not just the test files for the +# current step. Step 0 and 1 tests are special and not included in +# later steps. +REGRESS = + +HARD= +DEFERRABLE=1 +OPTIONAL=1 + +# Run target/rule within docker image for the implementation +DOCKERIZE = + # -# Settings +# General settings and utility functions # -IMPLS = bash c clojure coffee cs forth go haskell java js lua make mal \ - ocaml matlab miniMAL perl php ps python r racket ruby rust \ - scala vb nim +EXTENSION = .mal step0 = step0_repl step1 = step1_read_print @@ -26,180 +89,272 @@ step8 = step8_macros step9 = step9_try stepA = stepA_mal -EXCLUDE_TESTS += test^bash^step5 # no stack exhaustion or completion -EXCLUDE_TESTS += test^c^step5 # segfault -EXCLUDE_TESTS += test^cs^step5 # fatal stack overflow fault -EXCLUDE_TESTS += test^haskell^step5 # test completes -EXCLUDE_TESTS += test^make^step5 # no TCO capability/step -EXCLUDE_TESTS += test^mal^step5 # no TCO capability/step -EXCLUDE_TESTS += test^go^step5 # test completes, even at 100,000 -EXCLUDE_TESTS += test^php^step5 # test completes, even at 100,000 -EXCLUDE_TESTS += test^racket^step5 # test completes -EXCLUDE_TESTS += test^ruby^step5 # test completes, even at 100,000 -EXCLUDE_TESTS += test^rust^step5 # no catching stack overflows -EXCLUDE_TESTS += test^ocaml^step5 # test completes, even at 1,000,000 -EXCLUDE_TESTS += test^nim^step5 # test completes, even at 100,000 - -# interop tests now implemented yet -EXCLUDE_TESTS += test^cs^stepA test^go^stepA test^haskell^stepA \ - test^java^stepA test^mal^stepA test^mal^step0 \ - test^php^stepA test^ps^stepA test^python^stepA \ - test^ruby^stepA test^rust^stepA test^vb^stepA - -EXCLUDE_PERFS = perf^mal # TODO: fix this +argv_STEP = step6_file -# -# Utility functions -# -STEP_TEST_FILES = $(strip $(wildcard $(1)/tests/$($(2)).mal) $(wildcard tests/$($(2)).mal)) - -bash_STEP_TO_PROG = bash/$($(1)).sh -c_STEP_TO_PROG = c/$($(1)) -clojure_STEP_TO_PROG = clojure/src/$($(1)).clj -coffee_STEP_TO_PROG = coffee/$($(1)).coffee -cs_STEP_TO_PROG = cs/$($(1)).exe -forth_STEP_TO_PROG = forth/$($(1)).fs -go_STEP_TO_PROG = go/$($(1)) -java_STEP_TO_PROG = java/src/main/java/mal/$($(1)).java -haskell_STEP_TO_PROG = haskell/$($(1)) -js_STEP_TO_PROG = js/$($(1)).js -lua_STEP_TO_PROG = lua/$($(1)).lua -make_STEP_TO_PROG = make/$($(1)).mk -mal_STEP_TO_PROG = mal/$($(1)).mal -ocaml_STEP_TO_PROG = ocaml/$($(1)) -matlab_STEP_TO_PROG = matlab/$($(1)).m -miniMAL_STEP_TO_PROG = miniMAL/$($(1)).json -perl_STEP_TO_PROG = perl/$($(1)).pl -php_STEP_TO_PROG = php/$($(1)).php -ps_STEP_TO_PROG = ps/$($(1)).ps -python_STEP_TO_PROG = python/$($(1)).py -r_STEP_TO_PROG = r/$($(1)).r -racket_STEP_TO_PROG = racket/$($(1)).rkt -ruby_STEP_TO_PROG = ruby/$($(1)).rb -rust_STEP_TO_PROG = rust/target/release/$($(1)) -scala_STEP_TO_PROG = scala/$($(1)).scala -vb_STEP_TO_PROG = vb/$($(1)).exe -nim_STEP_TO_PROG = nim/$($(1)) +regress_step0 = step0 +regress_step1 = step1 +regress_step2 = step2 +regress_step3 = $(regress_step2) step3 +regress_step4 = $(regress_step3) step4 +regress_step5 = $(regress_step4) step5 +regress_step6 = $(regress_step5) step6 +regress_step7 = $(regress_step6) step7 +regress_step8 = $(regress_step7) step8 +regress_step9 = $(regress_step8) step9 +regress_stepA = $(regress_step9) stepA # Needed some argument munging COMMA = , noop = SPACE = $(noop) $(noop) - -bash_RUNSTEP = bash ../$(2) $(3) -c_RUNSTEP = ../$(2) $(3) -clojure_RUNSTEP = lein with-profile +$(1) trampoline run $(3) -coffee_RUNSTEP = coffee ../$(2) $(3) -cs_RUNSTEP = mono ../$(2) --raw $(3) -forth_RUNSTEP = gforth ../$(2) $(3) -go_RUNSTEP = ../$(2) $(3) -haskell_RUNSTEP = ../$(2) $(3) -java_RUNSTEP = mvn -quiet exec:java -Dexec.mainClass="mal.$($(1))" -Dexec.args="--raw$(if $(3), $(3),)" -js_RUNSTEP = node ../$(2) $(3) -lua_RUNSTEP = ../$(2) --raw $(3) -make_RUNSTEP = make -f ../$(2) $(3) -mal_RUNSTEP = $(call $(MAL_IMPL)_RUNSTEP,$(1),$(call $(MAL_IMPL)_STEP_TO_PROG,stepA),../$(2),") #" -ocaml_RUNSTEP = ../$(2) $(3) -matlab_args = $(subst $(SPACE),$(COMMA),$(foreach x,$(strip $(1)),'$(x)')) -matlab_RUNSTEP = matlab -nodisplay -nosplash -nodesktop -nojvm -r "$($(1))($(call matlab_args,$(3)));quit;" -miniMAL_RUNSTEP = miniMAL ../$(2) $(3) -perl_RUNSTEP = perl ../$(2) --raw $(3) -php_RUNSTEP = php ../$(2) $(3) -ps_RUNSTEP = $(4)gs -q -I./ -dNODISPLAY -- ../$(2) $(3)$(4) -python_RUNSTEP = $(PYTHON) ../$(2) $(3) -r_RUNSTEP = Rscript ../$(2) $(3) -racket_RUNSTEP = ../$(2) $(3) -ruby_RUNSTEP = ruby ../$(2) $(3) -rust_RUNSTEP = ../$(2) $(3) -scala_RUNSTEP = sbt 'run-main $($(1))$(if $(3), $(3),)' -vb_RUNSTEP = mono ../$(2) --raw $(3) -nim_RUNSTEP = ../$(2) $(3) - -# Extra options to pass to runtest.py -cs_TEST_OPTS = --mono -mal_TEST_OPTS = --start-timeout 60 --test-timeout 120 -vb_TEST_OPTS = --mono - +export FACTOR_ROOTS := . + +opt_HARD = $(if $(strip $(HARD)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(HARD)),--hard,),) +opt_DEFERRABLE = $(if $(strip $(DEFERRABLE)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(DEFERRABLE)),--deferrable,--no-deferrable),--no-deferrable) +opt_OPTIONAL = $(if $(strip $(OPTIONAL)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(OPTIONAL)),--optional,--no-optional),--no-optional) + +# Return list of test files for a given step. If REGRESS is set then +# test files will include step 2 tests through tests for the step +# being tested. +STEP_TEST_FILES = $(strip $(wildcard \ + $(foreach s,$(if $(strip $(REGRESS)),\ + $(filter-out $(if $(filter $(1),$(step5_EXCLUDES)),step5,),\ + $(regress_$(2)))\ + ,$(2)),\ + impls/$(1)/tests/$($(s))$(EXTENSION) impls/tests/$($(s))$(EXTENSION)))) + +# DOCKERIZE utility functions +lc = $(subst A,a,$(subst B,b,$(subst C,c,$(subst D,d,$(subst E,e,$(subst F,f,$(subst G,g,$(subst H,h,$(subst I,i,$(subst J,j,$(subst K,k,$(subst L,l,$(subst M,m,$(subst N,n,$(subst O,o,$(subst P,p,$(subst Q,q,$(subst R,r,$(subst S,s,$(subst T,t,$(subst U,u,$(subst V,v,$(subst W,w,$(subst X,x,$(subst Y,y,$(subst Z,z,$1)))))))))))))))))))))))))) +impl_to_image = ghcr.io/kanaka/mal-test-$(call lc,$(1)):$(shell ./voom-like-version.sh impls/$(1)/Dockerfile) + +actual_impl = $(if $(filter mal,$(1)),$(patsubst %-mal,%,$(MAL_IMPL)),$(1)) + +# Takes impl +# Returns nothing if DOCKERIZE is not set, otherwise returns the +# docker prefix necessary to run make within the docker environment +# for this impl +get_build_command = $(strip $(foreach mode,$(1)_MODE, \ + $(if $(strip $(DOCKERIZE)),\ + docker run \ + -it --rm -u $(shell id -u) \ + -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal \ + -w /mal/impls/$(1) \ + $(if $(strip $($(mode))),-e $(mode)=$($(mode)),) \ + $(if $(filter factor,$(1)),-e FACTOR_ROOTS=$(FACTOR_ROOTS),) \ + $(call impl_to_image,$(1)) \ + make $(if $(strip $($(mode))),$(mode)=$($(mode)),) \ + ,\ + $(MAKE) $(if $(strip $($(mode))),$(mode)=$($(mode)),) -C impls/$(impl)))) + +# Takes impl and step args. Optional env vars and dockerize args +# Returns a command prefix (docker command and environment variables) +# necessary to launch the given impl and step +get_run_prefix = $(strip $(foreach mode,$(call actual_impl,$(1))_MODE, \ + $(if $(strip $(DOCKERIZE) $(4)),\ + docker run -e STEP=$($2) -e MAL_IMPL=$(MAL_IMPL) \ + -it --rm -u $(shell id -u) \ + -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal \ + -w /mal/impls/$(call actual_impl,$(1)) \ + $(if $(strip $($(mode))),-e $(mode)=$($(mode)),) \ + $(if $(filter factor,$(1)),-e FACTOR_ROOTS=$(FACTOR_ROOTS),) \ + $(foreach env,$(3),-e $(env)) \ + $(call impl_to_image,$(call actual_impl,$(1))) \ + ,\ + env STEP=$($2) MAL_IMPL=$(MAL_IMPL) \ + $(if $(strip $($(mode))),$(mode)=$($(mode)),) \ + $(if $(filter factor,$(1)),FACTOR_ROOTS=$(FACTOR_ROOTS),) \ + $(3)))) + +# Takes impl and step +# Returns the runtest command prefix (with runtest options) for testing the given step +get_runtest_cmd = $(call get_run_prefix,$(1),$(2),$(if $(filter cs fsharp mal tcl vb,$(1)),RAW=1,)) \ + ../../runtest.py $(opt_HARD) $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS) + +# Takes impl and step +# Returns the runtest command prefix (with runtest options) for testing the given step +get_argvtest_cmd = $(call get_run_prefix,$(1),$(2)) ../tests/run_argv_test.sh # Derived lists -STEPS = $(sort $(filter step%,$(.VARIABLES))) -IMPL_TESTS = $(foreach impl,$(IMPLS),test^$(impl)) +STEPS = $(sort $(filter-out %_EXCLUDES,$(filter step%,$(.VARIABLES)))) +DO_IMPLS = $(filter-out $(SKIP_IMPLS),$(IMPLS)) +IMPL_TESTS = $(foreach impl,$(DO_IMPLS),test^$(impl)) STEP_TESTS = $(foreach step,$(STEPS),test^$(step)) -ALL_TESTS = $(filter-out $(EXCLUDE_TESTS),\ +ALL_TESTS = $(filter-out $(foreach e,$(step5_EXCLUDES),test^$(e)^step5),\ $(strip $(sort \ - $(foreach impl,$(IMPLS),\ + $(foreach impl,$(DO_IMPLS),\ $(foreach step,$(STEPS),test^$(impl)^$(step)))))) +ALL_BUILDS = $(strip $(sort \ + $(foreach impl,$(DO_IMPLS),\ + $(foreach step,$(STEPS),build^$(impl)^$(step))))) + +DOCKER_BUILD = $(foreach impl,$(DO_IMPLS),docker-build^$(impl)) -IMPL_STATS = $(foreach impl,$(IMPLS),stats^$(impl)) -IMPL_STATS_LISP = $(foreach impl,$(IMPLS),stats-lisp^$(impl)) +DOCKER_SHELL = $(foreach impl,$(DO_IMPLS),docker-shell^$(impl)) + +IMPL_PERF = $(foreach impl,$(filter-out $(perf_EXCLUDES),$(DO_IMPLS)),perf^$(impl)) + +IMPL_STATS = $(foreach impl,$(DO_IMPLS),stats^$(impl)) + +IMPL_REPL = $(foreach impl,$(DO_IMPLS),repl^$(impl)) +ALL_REPL = $(strip $(sort \ + $(foreach impl,$(DO_IMPLS),\ + $(foreach step,$(STEPS),repl^$(impl)^$(step))))) -IMPL_PERF = $(filter-out $(EXCLUDE_PERFS),$(foreach impl,$(IMPLS),perf^$(impl))) # # Build rules # -# Build a program in 'c' directory -c/%: - $(MAKE) -C $(dir $(@)) $(notdir $(@)) - -# Allow test, test^STEP, test^IMPL, and test^IMPL^STEP +# Enable secondary expansion for all rules .SECONDEXPANSION: -$(IMPL_TESTS): $$(filter $$@^%,$$(ALL_TESTS)) -.SECONDEXPANSION: -$(STEP_TESTS): $$(foreach step,$$(subst test^,,$$@),$$(filter %^$$(step),$$(ALL_TESTS))) +# Build a program in an implementation directory +# Make sure we always try and build first because the dependencies are +# encoded in the implementation Makefile not here +.PHONY: $(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(call $(i)_STEP_TO_PROG,$(s)))) +$(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(call $(i)_STEP_TO_PROG,$(s)))): + $(foreach impl,$(word 2,$(subst /, ,$(@))),\ + $(if $(DOCKERIZE), \ + $(call get_build_command,$(impl)) $(patsubst impls/$(impl)/%,%,$(@)), \ + $(call get_build_command,$(impl)) $(subst impls/$(impl)/,,$(@)))) + +# Allow IMPL, build^IMPL, IMPL^STEP, and build^IMPL^STEP +$(DO_IMPLS): $$(foreach s,$$(STEPS),$$(call $$(@)_STEP_TO_PROG,$$(s))) + +$(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),build^$(i))): $$(foreach s,$$(STEPS),$$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(s))) + +$(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(i)^$(s))): $$(call $$(word 1,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 2,$$(subst ^, ,$$(@)))) + +$(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),build^$(i)^$(s))): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) + + + +# +# Test rules +# -.SECONDEXPANSION: $(ALL_TESTS): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ $(foreach step,$(word 3,$(subst ^, ,$(@))),\ - cd $(if $(filter mal,$(impl)),$(MAL_IMPL),$(impl)); \ - $(foreach test,$(call STEP_TEST_FILES,$(impl),$(step)),\ - echo '----------------------------------------------'; \ - echo 'Testing $@, step file: $+, test file: $(test)'; \ - echo 'Running: ../runtest.py $(call $(impl)_TEST_OPTS) ../$(test) -- $(call $(impl)_RUNSTEP,$(step),$(+))'; \ - ../runtest.py $(call $(impl)_TEST_OPTS) ../$(test) -- $(call $(impl)_RUNSTEP,$(step),$(+))))) - + echo "(call STEP_TEST_FILES,$(impl),$(step)): $(call STEP_TEST_FILES,$(impl),$(step))" && \ + cd impls/$(call actual_impl,$(impl)) && \ + $(foreach test,$(patsubst impls/%,%,$(call STEP_TEST_FILES,$(impl),$(step))),\ + echo '----------------------------------------------' && \ + echo 'Testing $@; step file: $+, test file: $(test)' && \ + echo 'Running: $(call get_runtest_cmd,$(impl),$(step)) ../$(test) -- ../$(impl)/run' && \ + $(call get_runtest_cmd,$(impl),$(step)) ../$(test) -- ../$(impl)/run && \ + $(if $(filter tests/$(argv_STEP)$(EXTENSION),$(test)),\ + echo '----------------------------------------------' && \ + echo 'Testing ARGV of $@; step file: $+' && \ + echo 'Running: $(call get_argvtest_cmd,$(impl),$(step)) ../$(impl)/run ' && \ + $(call get_argvtest_cmd,$(impl),$(step)) ../$(impl)/run && ,\ + true && ))\ + true)) + +# Allow test, tests, test^STEP, test^IMPL, and test^IMPL^STEP test: $(ALL_TESTS) tests: $(ALL_TESTS) +$(IMPL_TESTS): $$(filter $$@^%,$$(ALL_TESTS)) -# Stats rules +$(STEP_TESTS): $$(foreach step,$$(subst test^,,$$@),$$(filter %^$$(step),$$(ALL_TESTS))) -stats: $(IMPL_STATS) -stats-lisp: $(IMPL_STATS_LISP) -.SECONDEXPANSION: -$(IMPL_STATS): +# +# Docker build rules +# + +docker-build: $(DOCKER_BUILD) + +$(DOCKER_BUILD): @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - echo "Stats for $(impl):"; \ - $(MAKE) --no-print-directory -C $(impl) stats) + echo "Running: docker build -t $(call impl_to_image,$(impl)) .:"; \ + cd impls/$(impl) && docker build -t $(call impl_to_image,$(impl)) .) -.SECONDEXPANSION: -$(IMPL_STATS_LISP): +# +# Docker shell rules +# + +$(DOCKER_SHELL): @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - echo "Stats (lisp only) for $(impl):"; \ - $(MAKE) --no-print-directory -C $(impl) stats-lisp) + echo "Running: $(call get_run_prefix,$(impl),stepA,,dockerize) bash"; \ + $(call get_run_prefix,$(impl),stepA,,dockerize) bash) +# # Performance test rules +# perf: $(IMPL_PERF) -.SECONDEXPANSION: $(IMPL_PERF): @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ - cd $(if $(filter mal,$(impl)),$(MAL_IMPL),$(impl)); \ + cd impls/$(call actual_impl,$(impl)); \ echo "Performance test for $(impl):"; \ - echo 'Running: $(call $(impl)_RUNSTEP,stepA,$(call $(impl)_STEP_TO_PROG,stepA),../tests/perf1.mal)'; \ - $(call $(impl)_RUNSTEP,stepA,$(call $(impl)_STEP_TO_PROG,stepA),../tests/perf1.mal); \ - echo 'Running: $(call $(impl)_RUNSTEP,stepA,$(call $(impl)_STEP_TO_PROG,stepA),../tests/perf2.mal)'; \ - $(call $(impl)_RUNSTEP,stepA,$(call $(impl)_STEP_TO_PROG,stepA),../tests/perf2.mal); \ - echo 'Running: $(call $(impl)_RUNSTEP,stepA,$(call $(impl)_STEP_TO_PROG,stepA),../tests/perf3.mal)'; \ - $(call $(impl)_RUNSTEP,stepA,$(call $(impl)_STEP_TO_PROG,stepA),../tests/perf3.mal)) + echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal'; \ + $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal; \ + echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf2.mal'; \ + $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf2.mal; \ + echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf3.mal'; \ + $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf3.mal) + + +# +# REPL invocation rules +# + +$(ALL_REPL): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) + @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ + $(foreach step,$(word 3,$(subst ^, ,$(@))),\ + cd impls/$(call actual_impl,$(impl)); \ + echo 'REPL implementation $(impl), step file: $+'; \ + echo 'Running: $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run $(RUN_ARGS)'; \ + $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run $(RUN_ARGS);)) + +# Allow repl^IMPL^STEP and repl^IMPL (which starts REPL of stepA) +$(IMPL_REPL): $$@^stepA + +# +# Stats test rules +# + +# For a concise summary: +# make stats | egrep -A1 "^Stats for|^all" | egrep -v "^all|^--" +stats: $(IMPL_STATS) + +$(IMPL_STATS): + @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ + echo "Stats for $(impl):"; \ + $(LOCCOUNT) -x "[sS]tep[0-9]_.*|[.]md$$|tests|examples|Makefile|package.json|tsconfig.json|Cargo.toml|project.clj|node_modules|getline.cs|terminal.cs|elm-stuff|objpascal/regexpr|rdyncall|swift/templates" impls/$(impl)) + +# +# Utility functions +# +print-%: + @echo "$($(*))" + +# +# Recursive rules (call make FOO in each subdirectory) +# + +define recur_template +.PHONY: $(1) +$(1): $(2) +$(2): + @echo "----------------------------------------------"; \ + $$(foreach impl,$$(word 2,$$(subst ^, ,$$(@))),\ + echo "Running: $$(call get_build_command,$$(impl)) --no-print-directory $(1)"; \ + $$(call get_build_command,$$(impl)) --no-print-directory $(1)) +endef + +recur_impls_ = $(filter-out $(foreach impl,$($(1)_EXCLUDES),$(1)^$(impl)),$(foreach impl,$(IMPLS),$(1)^$(impl))) + +# recursive clean +$(eval $(call recur_template,clean,$(call recur_impls_,clean))) +# recursive dist +$(eval $(call recur_template,dist,$(call recur_impls_,dist))) diff --git a/Makefile.impls b/Makefile.impls new file mode 100644 index 0000000000..2c3517d7ff --- /dev/null +++ b/Makefile.impls @@ -0,0 +1,204 @@ +# HOWTO add a new implementation (named "foo"): +# - Add "foo" to the IMPLS variable (alphabetical order) +# - Add a new "foo_STEP_TO_PROG" variable. +# - Add an "impls/foo/run" script. +# - Add an "impls/foo/Makefile" +# - Add an "impls/foo/Dockerfile" +# - Implement each step in "impls/foo/". + +# +# Implementation specific command line settings +# + +# cbm or qbasic +basic_MODE = cbm +# clj or cljs (Clojure vs ClojureScript/lumo) +clojure_MODE = clj +# gdc, ldc2, or dmd +d_MODE = gdc +# python, js, cpp, or neko +haxe_MODE = neko +# octave or matlab +matlab_MODE = octave +# scheme (chibi, kawa, gauche, chicken, sagittarius, cyclone, foment) +scheme_MODE = chibi +# sml (polyml, mlton, mosml) +sml_MODE = polyml +# wasmtime wasmer wax node warpy wace_libc direct js wace_fooboot +wasm_MODE = wasmtime + + +# +# Implementation specific settings +# + +IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lisp cpp crystal cs d dart \ + elisp elixir elm erlang es6 factor fantom fennel forth fsharp go groovy gnu-smalltalk \ + guile hare haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 livescript logo lua make mal \ + matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \ + plsql powershell prolog ps purs python2 python3 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \ + swift swift3 swift4 swift6 tcl ts vala vb vbs vhdl vimscript wasm wren yorick xslt zig + +step5_EXCLUDES += bash # never completes at 10,000 +step5_EXCLUDES += basic # too slow, and limited to ints of 2^16 +step5_EXCLUDES += latex3 # no iteration, limited native stack +step5_EXCLUDES += make # no TCO capability (iteration or recursion) +step5_EXCLUDES += mal # host impl dependent +step5_EXCLUDES += matlab # never completes at 10,000 +step5_EXCLUDES += plpgsql # too slow for 10,000 +step5_EXCLUDES += plsql # too slow for 10,000 +step5_EXCLUDES += powershell # too slow for 10,000 +step5_EXCLUDES += prolog # no iteration (but interpreter does TCO implicitly) +step5_EXCLUDES += sml # not implemented :( +step5_EXCLUDES += $(if $(filter cpp,$(haxe_MODE)),haxe,) # cpp finishes 10,000, segfaults at 100,000 +step5_EXCLUDES += xslt # iteration cannot be expressed +step5_EXCLUDES += vbs # too slow for 10,000 + +dist_EXCLUDES += mal +# TODO: still need to implement dist +dist_EXCLUDES += guile io julia matlab swift + + +# Extra options to pass to runtest.py +bbc-basic_TEST_OPTS = --test-timeout 60 +guile_TEST_OPTS = --test-timeout 120 +io_TEST_OPTS = --test-timeout 120 +java-truffle_TEST_OPTS = --start-timeout 30 +logo_TEST_OPTS = --start-timeout 60 --test-timeout 120 +mal_TEST_OPTS = --start-timeout 60 --test-timeout 120 +miniMAL_TEST_OPTS = --start-timeout 60 --test-timeout 120 +perl6_TEST_OPTS = --test-timeout=60 +plpgsql_TEST_OPTS = --start-timeout 60 --test-timeout 180 +plsql_TEST_OPTS = --start-timeout 120 --test-timeout 120 +vimscript_TEST_OPTS = --test-timeout 30 +ifeq ($(MAL_IMPL),vimscript) +mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 +else ifeq ($(MAL_IMPL),powershell) +mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 +else ifeq ($(MAL_IMPL),vbs) +mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 --no-pty +endif +xslt_TEST_OPTS = --test-timeout 120 +vbs_TEST_OPTS = --no-pty + + +# +# Implementation specific utility functions +# + +basic_STEP_TO_PROG_cbm = impls/basic/$($(1)).bas +basic_STEP_TO_PROG_qbasic = impls/basic/$($(1)) + +clojure_STEP_TO_PROG_clj = impls/clojure/target/$($(1)).jar +clojure_STEP_TO_PROG_cljs = impls/clojure/src/mal/$($(1)).cljc + +haxe_STEP_TO_PROG_neko = impls/haxe/$($(1)).n +haxe_STEP_TO_PROG_python = impls/haxe/$($(1)).py +haxe_STEP_TO_PROG_cpp = impls/haxe/cpp/$($(1)) +haxe_STEP_TO_PROG_js = impls/haxe/$($(1)).js + +scheme_STEP_TO_PROG_chibi = impls/scheme/$($(1)).scm +scheme_STEP_TO_PROG_kawa = impls/scheme/out/$($(1)).class +scheme_STEP_TO_PROG_gauche = impls/scheme/$($(1)).scm +scheme_STEP_TO_PROG_chicken = impls/scheme/$($(1)) +scheme_STEP_TO_PROG_sagittarius = impls/scheme/$($(1)).scm +scheme_STEP_TO_PROG_cyclone = impls/scheme/$($(1)) +scheme_STEP_TO_PROG_foment = impls/scheme/$($(1)).scm + +# Map of step (e.g. "step8") to executable file for that step +ada_STEP_TO_PROG = impls/ada/$($(1)) +ada.2_STEP_TO_PROG = impls/ada.2/$($(1)) +awk_STEP_TO_PROG = impls/awk/$($(1)).awk +bash_STEP_TO_PROG = impls/bash/$($(1)).sh +basic_STEP_TO_PROG = $(basic_STEP_TO_PROG_$(basic_MODE)) +bbc-basic_STEP_TO_PROG = impls/bbc-basic/$($(1)).bas +c_STEP_TO_PROG = impls/c/$($(1)) +c.2_STEP_TO_PROG = impls/c.2/$($(1)) +chuck_STEP_TO_PROG = impls/chuck/$($(1)).ck +clojure_STEP_TO_PROG = $(clojure_STEP_TO_PROG_$(clojure_MODE)) +coffee_STEP_TO_PROG = impls/coffee/$($(1)).coffee +common-lisp_STEP_TO_PROG = impls/common-lisp/$($(1)) +cpp_STEP_TO_PROG = impls/cpp/$($(1)) +crystal_STEP_TO_PROG = impls/crystal/$($(1)) +cs_STEP_TO_PROG = impls/cs/$($(1)).exe +d_STEP_TO_PROG = impls/d/$($(1)) +dart_STEP_TO_PROG = impls/dart/$($(1)).dart +elisp_STEP_TO_PROG = impls/elisp/$($(1)).el +elixir_STEP_TO_PROG = impls/elixir/lib/mix/tasks/$($(1)).ex +elm_STEP_TO_PROG = impls/elm/$($(1)).js +erlang_STEP_TO_PROG = impls/erlang/$($(1)) +es6_STEP_TO_PROG = impls/es6/$($(1)).mjs +factor_STEP_TO_PROG = impls/factor/$($(1))/$($(1)).factor +fantom_STEP_TO_PROG = impls/fantom/lib/fan/$($(1)).pod +fennel_STEP_TO_PROG = impls/fennel/$($(1)).fnl +forth_STEP_TO_PROG = impls/forth/$($(1)).fs +fsharp_STEP_TO_PROG = impls/fsharp/$($(1)).exe +go_STEP_TO_PROG = impls/go/$($(1)) +groovy_STEP_TO_PROG = impls/groovy/$($(1)).groovy +gnu-smalltalk_STEP_TO_PROG = impls/gnu-smalltalk/$($(1)).st +guile_STEP_TO_PROG = impls/guile/$($(1)).scm +hare_STEP_TO_PROG = impls/hare/$($(1)) +haskell_STEP_TO_PROG = impls/haskell/$($(1)) +haxe_STEP_TO_PROG = $(haxe_STEP_TO_PROG_$(haxe_MODE)) +hy_STEP_TO_PROG = impls/hy/$($(1)).hy +io_STEP_TO_PROG = impls/io/$($(1)).io +janet_STEP_TO_PROG = impls/janet/$($(1)).janet +java_STEP_TO_PROG = impls/java/target/classes/mal/$($(1)).class +java-truffle_STEP_TO_PROG = impls/java-truffle/build/classes/java/main/truffle/mal/$($(1)).class +js_STEP_TO_PROG = impls/js/$($(1)).js +jq_STEP_PROG = impls/jq/$($(1)).jq +julia_STEP_TO_PROG = impls/julia/$($(1)).jl +kotlin_STEP_TO_PROG = impls/kotlin/$($(1)).jar +latex3_STEP_TO_PROG = impls/latex3/$($(1)).tex +livescript_STEP_TO_PROG = impls/livescript/$($(1)).js +logo_STEP_TO_PROG = impls/logo/$($(1)).lg +lua_STEP_TO_PROG = impls/lua/$($(1)).lua +make_STEP_TO_PROG = impls/make/$($(1)).mk +mal_STEP_TO_PROG = impls/mal/$($(1)).mal +matlab_STEP_TO_PROG = impls/matlab/$($(1)).m +miniMAL_STEP_TO_PROG = impls/miniMAL/$($(1)).json +nasm_STEP_TO_PROG = impls/nasm/$($(1)) +nim_STEP_TO_PROG = impls/nim/$($(1)) +objc_STEP_TO_PROG = impls/objc/$($(1)) +objpascal_STEP_TO_PROG = impls/objpascal/$($(1)) +ocaml_STEP_TO_PROG = impls/ocaml/$($(1)) +perl_STEP_TO_PROG = impls/perl/$($(1)).pl +perl6_STEP_TO_PROG = impls/perl6/$($(1)).pl +php_STEP_TO_PROG = impls/php/$($(1)).php +picolisp_STEP_TO_PROG = impls/picolisp/$($(1)).l +pike_STEP_TO_PROG = impls/pike/$($(1)).pike +plpgsql_STEP_TO_PROG = impls/plpgsql/$($(1)).sql +plsql_STEP_TO_PROG = impls/plsql/$($(1)).sql +powershell_STEP_TO_PROG = impls/powershell/$($(1)).ps1 +prolog_STEP_TO_PROG = impls/prolog/$($(1)).pl +ps_STEP_TO_PROG = impls/ps/$($(1)).ps +purs_STEP_TO_PROG = impls/purs/$($(1)).js +python2_STEP_TO_PROG = impls/python2/$($(1)).py +python3_STEP_TO_PROG = impls/python3/$($(1)).py +r_STEP_TO_PROG = impls/r/$($(1)).r +racket_STEP_TO_PROG = impls/racket/$($(1)).rkt +rexx_STEP_TO_PROG = impls/rexx/$($(1)).rexxpp +rpython_STEP_TO_PROG = impls/rpython/$($(1)) +ruby_STEP_TO_PROG = impls/ruby/$($(1)).rb +ruby.2_STEP_TO_PROG = impls/ruby.2/$($(1)).rb +rust_STEP_TO_PROG = impls/rust/target/release/$($(1)) +scala_STEP_TO_PROG = impls/scala/target/scala-2.11/classes/$($(1)).class +scheme_STEP_TO_PROG = $(scheme_STEP_TO_PROG_$(scheme_MODE)) +skew_STEP_TO_PROG = impls/skew/$($(1)).js +sml_STEP_TO_PROG = impls/sml/$($(1)) +swift_STEP_TO_PROG = impls/swift/$($(1)) +swift3_STEP_TO_PROG = impls/swift3/$($(1)) +swift4_STEP_TO_PROG = impls/swift4/$($(1)) +swift6_STEP_TO_PROG = impls/swift6/$($(1)) +tcl_STEP_TO_PROG = impls/tcl/$($(1)).tcl +ts_STEP_TO_PROG = impls/ts/$($(1)).js +vala_STEP_TO_PROG = impls/vala/$($(1)) +vb_STEP_TO_PROG = impls/vb/$($(1)).exe +vbs_STEP_TO_PROG = impls/vbs/$($(1)).vbs +vhdl_STEP_TO_PROG = impls/vhdl/$($(1)) +vimscript_STEP_TO_PROG = impls/vimscript/$($(1)).vim +wasm_STEP_TO_PROG = impls/wasm/$($(1)).wasm +wren_STEP_TO_PROG = impls/wren/$($(1)).wren +yorick_STEP_TO_PROG = impls/yorick/$($(1)).i +xslt_STEP_TO_PROG = impls/xslt/$($(1)) +zig_STEP_TO_PROG = impls/zig/$($(1)) diff --git a/README.md b/README.md index 0fce3a96a6..3dca01ab2d 100644 --- a/README.md +++ b/README.md @@ -1,86 +1,341 @@ # mal - Make a Lisp -## Description +[![Build and Test](https://github.com/kanaka/mal/actions/workflows/main.yml/badge.svg)](https://github.com/kanaka/mal/actions/workflows/main.yml) -Mal is a Clojure inspired Lisp interpreter. - -Mal is implemented in 27 different languages: - -* Bash shell -* C -* C# -* Clojure -* CoffeeScript -* Forth -* Go -* Haskell -* Java -* Javascript ([Online Demo](http://kanaka.github.io/mal)) -* Lua -* GNU Make -* mal itself -* MATLAB -* [miniMAL](https://github.com/kanaka/miniMAL) -* Nim -* OCaml -* Perl -* PHP -* Postscript -* Python -* R -* Racket -* Ruby -* Rust -* Scala -* Visual Basic.NET - - -Mal is a learning tool. See the ([make-a-lisp process -guide](process/guide.md)). Each implementation of mal is separated -into 11 incremental, self-contained (and testable) steps that -demonstrate core concepts of Lisp. The last step is capable of -self-hosting (running the mal implementation of mal). - -The mal (make a lisp) steps are: - -* [step0_repl](process/guide.md#step0) -* [step1_read_print](process/guide.md#step1) -* [step2_eval](process/guide.md#step2) -* [step3_env](process/guide.md#step3) -* [step4_if_fn_do](process/guide.md#step4) -* [step5_tco](process/guide.md#step5) -* [step6_file](process/guide.md#step6) -* [step7_quote](process/guide.md#step7) -* [step8_macros](process/guide.md#step8) -* [step9_try](process/guide.md#step9) -* [stepA_mal](process/guide.md#stepA) +## Description +**1. Mal is a Clojure inspired Lisp interpreter** + +**2. Mal is a learning tool** + +Each implementation of mal is separated into +11 incremental, self-contained (and testable) steps that demonstrate +core concepts of Lisp. The last step is capable of self-hosting +(running the mal implementation of mal). See the [make-a-lisp process +guide](process/guide.md). + +The make-a-lisp steps are: + +* [step0_repl](process/guide.md#step-0-the-repl) +* [step1_read_print](process/guide.md#step-1-read-and-print) +* [step2_eval](process/guide.md#step-2-eval) +* [step3_env](process/guide.md#step-3-environments) +* [step4_if_fn_do](process/guide.md#step-4-if-fn-do) +* [step5_tco](process/guide.md#step-5-tail-call-optimization) +* [step6_file](process/guide.md#step-6-files-mutation-and-evil) +* [step7_quote](process/guide.md#step-7-quoting) +* [step8_macros](process/guide.md#step-8-macros) +* [step9_try](process/guide.md#step-9-try) +* [stepA_mal](process/guide.md#step-a-metadata-self-hosting-and-interop) + +Each make-a-lisp step has an associated architectural diagram. That elements +that are new for that step are highlighted in red. +Here is the final architecture once [step A](process/guide.md#stepA) +is complete: + +![stepA_mal architecture](process/steps.png) + +If you are interested in creating a mal implementation (or just +interested in using mal for something) you are welcome to to join our +[Discord](https://discord.gg/CKgnNbJBpF). In addition to the [make-a-lisp +process guide](process/guide.md) there is also a [mal/make-a-lisp +FAQ](docs/FAQ.md) where I attempt to answer some common questions. + + +**3. Mal is implemented in 89 languages (95 different implementations and 118 runtime modes)** + +| Language | Creator | +| -------- | ------- | +| [Ada](#ada) | [Chris Moore](https://github.com/zmower) | +| [Ada #2](#ada2) | [Nicolas Boulenguez](https://github.com/asarhaddon) | +| [GNU Awk](#gnu-awk) | [Mitsuru Kariya](https://github.com/kariya-mitsuru) | +| [Bash 4](#bash-4) | [Joel Martin](https://github.com/kanaka) | +| [BASIC](#basic-c64-and-qbasic) (C64 & QBasic) | [Joel Martin](https://github.com/kanaka) | +| [BBC BASIC V](#bbc-basic-v) | [Ben Harris](https://github.com/bjh21) | +| [C](#c) | [Joel Martin](https://github.com/kanaka) | +| [C #2](#c2) | [Duncan Watts](https://github.com/fungiblecog) | +| [C++](#c-1) | [Stephen Thirlwall](https://github.com/sdt) | +| [C#](#c-2) | [Joel Martin](https://github.com/kanaka) | +| [ChucK](#chuck) | [Vasilij Schneidermann](https://github.com/wasamasa) | +| [Clojure](#clojure) (Clojure & ClojureScript) | [Joel Martin](https://github.com/kanaka) | +| [CoffeeScript](#coffeescript) | [Joel Martin](https://github.com/kanaka) | +| [Common Lisp](#common-lisp) | [Iqbal Ansari](https://github.com/iqbalansari) | +| [Crystal](#crystal) | [Linda_pp](https://github.com/rhysd) | +| [D](#d) | [Dov Murik](https://github.com/dubek) | +| [Dart](#dart) | [Harry Terkelsen](https://github.com/hterkelsen) | +| [Elixir](#elixir) | [Martin Ek](https://github.com/ekmartin) | +| [Elm](#elm) | [Jos van Bakel](https://github.com/c0deaddict) | +| [Emacs Lisp](#emacs-lisp) | [Vasilij Schneidermann](https://github.com/wasamasa) | +| [Erlang](#erlang) | [Nathan Fiedler](https://github.com/nlfiedler) | +| [ES6](#es6-ecmascript-2015) (ECMAScript 2015) | [Joel Martin](https://github.com/kanaka) | +| [F#](#f) | [Peter Stephens](https://github.com/pstephens) | +| [Factor](#factor) | [Jordan Lewis](https://github.com/jordanlewis) | +| [Fantom](#fantom) | [Dov Murik](https://github.com/dubek) | +| [Fennel](#fennel) | [sogaiu](https://github.com/sogaiu) | +| [Forth](#forth) | [Chris Houser](https://github.com/chouser) | +| [GNU Guile](#gnu-guile-21) | [Mu Lei](https://github.com/NalaGinrut) | +| [GNU Smalltalk](#gnu-smalltalk) | [Vasilij Schneidermann](https://github.com/wasamasa) | +| [Go](#go) | [Joel Martin](https://github.com/kanaka) | +| [Groovy](#groovy) | [Joel Martin](https://github.com/kanaka) | +| [Hare](#hare) | [Lou Woell](http://github.com/einsiedlerspiel) | +| [Haskell](#haskell) | [Joel Martin](https://github.com/kanaka) | +| [Haxe](#haxe-neko-python-c-and-javascript) (Neko, Python, C++, & JS) | [Joel Martin](https://github.com/kanaka) | +| [Hy](#hy) | [Joel Martin](https://github.com/kanaka) | +| [Io](#io) | [Dov Murik](https://github.com/dubek) | +| [Janet](#janet) | [sogaiu](https://github.com/sogaiu) | +| [Java](#java-17) | [Joel Martin](https://github.com/kanaka) | +| [Java Truffle](#java-using-truffle-for-graalvm) (Truffle/GraalVM) | [Matt McGill](https://github.com/mmcgill) | +| [JavaScript](#javascriptnode) ([Demo](http://kanaka.github.io/mal)) | [Joel Martin](https://github.com/kanaka) | +| [jq](#jq) | [Ali MohammadPur](https://github.com/alimpfard) | +| [Julia](#julia) | [Joel Martin](https://github.com/kanaka) | +| [Kotlin](#kotlin) | [Javier Fernandez-Ivern](https://github.com/ivern) | +| [LaTeX3](#latex3) | [Nicolas Boulenguez](https://github.com/asarhaddon) | +| [LiveScript](#livescript) | [Jos van Bakel](https://github.com/c0deaddict) | +| [Logo](#logo) | [Dov Murik](https://github.com/dubek) | +| [Lua](#lua) | [Joel Martin](https://github.com/kanaka) | +| [GNU Make](#gnu-make-381) | [Joel Martin](https://github.com/kanaka) | +| [mal itself](#mal) | [Joel Martin](https://github.com/kanaka) | +| [MATLAB](#matlab-gnu-octave-and-matlab) (GNU Octave & MATLAB) | [Joel Martin](https://github.com/kanaka) | +| [miniMAL](#minimal) ([Repo](https://github.com/kanaka/miniMAL), [Demo](https://kanaka.github.io/miniMAL/)) | [Joel Martin](https://github.com/kanaka) | +| [NASM](#nasm) | [Ben Dudson](https://github.com/bendudson) | +| [Nim](#nim-104) | [Dennis Felsing](https://github.com/def-) | +| [Object Pascal](#object-pascal) | [Joel Martin](https://github.com/kanaka) | +| [Objective C](#objective-c) | [Joel Martin](https://github.com/kanaka) | +| [OCaml](#ocaml-4010) | [Chris Houser](https://github.com/chouser) | +| [Perl](#perl-5) | [Joel Martin](https://github.com/kanaka) | +| [Perl 6](#perl-6) | [Hinrik Örn Sigurðsson](https://github.com/hinrik) | +| [PHP](#php-53) | [Joel Martin](https://github.com/kanaka) | +| [Picolisp](#picolisp) | [Vasilij Schneidermann](https://github.com/wasamasa) | +| [Pike](#pike) | [Dov Murik](https://github.com/dubek) | +| [PL/pgSQL](#plpgsql-postgresql-sql-procedural-language) (PostgreSQL) | [Joel Martin](https://github.com/kanaka) | +| [PL/SQL](#plsql-oracle-sql-procedural-language) (Oracle) | [Joel Martin](https://github.com/kanaka) | +| [PostScript](#postscript-level-23) | [Joel Martin](https://github.com/kanaka) | +| [PowerShell](#powershell) | [Joel Martin](https://github.com/kanaka) | +| [Prolog](#prolog-logical-language) | [Nicolas Boulenguez](https://github.com/asarhaddon) | +| [PureScript](#purescript) | [mrsekut](https://github.com/mrsekut) | +| [Python2](#python2) | [Joel Martin](https://github.com/kanaka) | +| [Python3](#python3) | [Gavin Lewis](https://github.com/epylar) | +| [RPython](#rpython) | [Joel Martin](https://github.com/kanaka) | +| [R](#r) | [Joel Martin](https://github.com/kanaka) | +| [Racket](#racket-53) | [Joel Martin](https://github.com/kanaka) | +| [Rexx](#rexx) | [Dov Murik](https://github.com/dubek) | +| [Ruby](#ruby-19) | [Joel Martin](https://github.com/kanaka) | +| [Ruby #2](#ruby) | [Ryan Cook](https://github.com/cookrn) | +| [Rust](#rust-138) | [Joel Martin](https://github.com/kanaka) | +| [Scala](#scala) | [Joel Martin](https://github.com/kanaka) | +| [Scheme (R7RS)](#scheme-r7rs) | [Vasilij Schneidermann](https://github.com/wasamasa) | +| [Skew](#skew) | [Dov Murik](https://github.com/dubek) | +| [Standard ML](#sml) | [Fabian Bergström](https://github.com/fabjan) | +| [Swift 3](#swift-3) | [Joel Martin](https://github.com/kanaka) | +| [Swift 4](#swift-4) | [陆é¥](https://github.com/LispLY) | +| [Swift 6](#swift-6) | [Oleg Montak](https://github.com/MontakOleg) | +| [Tcl](#tcl-86) | [Dov Murik](https://github.com/dubek) | +| [TypeScript](#typescript) | [Masahiro Wakame](https://github.com/vvakame) | +| [Vala](#vala) | [Simon Tatham](https://github.com/sgtatham) | +| [VHDL](#vhdl) | [Dov Murik](https://github.com/dubek) | +| [Vimscript](#vimscript) | [Dov Murik](https://github.com/dubek) | +| [Visual Basic.NET](#visual-basicnet) | [Joel Martin](https://github.com/kanaka) | +| [Visual Basic Script](#visual-basic-script) | [刘百超](https://github.com/OldLiu001) | +| [WebAssembly](#webassembly-wasm) (wasm) | [Joel Martin](https://github.com/kanaka) | +| [Wren](#wren) | [Dov Murik](https://github.com/dubek) | +| [XSLT](#xslt) | [Ali MohammadPur](https://github.com/alimpfard) | +| [Yorick](#yorick) | [Dov Murik](https://github.com/dubek) | +| [Zig](#zig) | [Josh Tobin](https://github.com/rjtobin) | + + +## Presentations Mal was presented publicly for the first time in a lightning talk at Clojure West 2014 (unfortunately there is no video). See -mal/clojurewest2014.mal for the presentation that was given at the -conference (yes the presentation is a mal program). +examples/clojurewest2014.mal for the presentation that was given at the +conference (yes, the presentation is a mal program). + +At Midwest.io 2015, Joel Martin gave a presentation on Mal titled +"Achievement Unlocked: A Better Path to Language Learning". +[Video](https://www.youtube.com/watch?v=lgyOAiRtZGw), +[Slides](http://kanaka.github.io/midwest.io.mal/). + +More recently Joel gave a presentation on "Make Your Own Lisp Interpreter +in 10 Incremental Steps" at LambdaConf 2016: +[Part 1](https://www.youtube.com/watch?v=jVhupfthTEk), +[Part 2](https://www.youtube.com/watch?v=X5OQBMGpaTU), +[Part 3](https://www.youtube.com/watch?v=6mARZzGgX4U), +[Part 4](https://www.youtube.com/watch?v=dCO1SYR5kDU), +[Slides](http://kanaka.github.io/lambdaconf/). ## Building/running implementations +The simplest way to run any given implementation is to use docker. +Every implementation has a docker image pre-built with language +dependencies installed. You can launch the REPL using a convenient +target in the top level Makefile (where IMPL is the implementation +directory name and stepX is the step to run): + +``` +make DOCKERIZE=1 "repl^IMPL^stepX" + # OR stepA is the default step: +make DOCKERIZE=1 "repl^IMPL" +``` + +## External / Alternate Implementations + +The following implementations are maintained as separate projects: + +### HolyC + +* [by Alexander Bagnalla](https://github.com/bagnalla/holyc_mal) + +### Rust + +* [by Tim Morgan](https://github.com/seven1m/mal-rust) +* [by vi](https://github.com/vi/mal-rust-vi) - using [Pest](https://pest.rs/) grammar, not using typical Mal infrastructure (cargo-ized steps and built-in converted tests). + +### Swift 2 + +* [by Keith Rollin](https://github.com/kanaka/mal/tree/fbfe678/impls/swift) - This implementation used to be in the repo. However, Swift 2 is no longer easily buildable/testable. + +### Q + +* [by Ali Mohammad Pur](https://github.com/alimpfard/mal/tree/q/impls/q) - The Q implementation works fine but it requires a proprietary manual download that can't be Dockerized (or integrated into the mal CI pipeline) so for now it remains a separate project. + + +## Other mal Projects + + * [malc](https://github.com/dubek/malc) - Mal (Make A Lisp) compiler. Compiles a Mal program to LLVM assembly language, then binary. + * [malcc](https://github.com/seven1m/malcc) - malcc is an incremental compiler implementation for the Mal language. It uses the Tiny C Compiler as the compiler backend and has full support for the Mal language, including macros, tail-call elimination, and even run-time eval. ["I Built a Lisp Compiler"](https://mpov.timmorgan.org/i-built-a-lisp-compiler/) post about the process. + * [frock](https://github.com/chr15m/frock) - Clojure-flavoured PHP. Uses mal/php to run programs. + * [flk](https://github.com/chr15m/flk) - A LISP that runs wherever Bash is + * [glisp](https://github.com/baku89/glisp) - Self-bootstrapping graphic design tool on Lisp. [Live Demo](https://baku89.com/glisp/) + * [mal2py-compiler](https://github.com/jcguu95/mal2py-compiler) - MAL-to-Python. A fork of the python3 implementation that compiles mal to python with a 16x performance improvement on the perf3 synthetic benchmark. + + +## Implementation Details + +### Ada + +The Ada implementation was developed with GNAT 4.9 on debian. It also +compiles unchanged on windows if you have windows versions of git, +GNAT and (optionally) make. There are no external dependencies +(readline not implemented). + +``` +cd impls/ada +make +./stepX_YYY +``` + +### Ada.2 + +The second Ada implementation was developed with GNAT 8 and links with +the GNU readline library. + +``` +cd impls/ada +make +./stepX_YYY +``` + +### GNU awk + +The GNU awk implementation of mal has been tested with GNU awk 4.1.1. + +``` +cd impls/gawk +gawk -O -f stepX_YYY.awk +``` + ### Bash 4 ``` -cd bash +cd impls/bash bash stepX_YYY.sh ``` +### BASIC (C64 and QBasic) + +The BASIC implementation uses a preprocessor that can generate BASIC +code that is compatible with both C64 BASIC (CBM v2) or QBasic. The +C64 mode has been tested with +[cbmbasic](https://github.com/kanaka/cbmbasic) (the patched version is +currently required to fix issues with line input) and the QBasic mode +has been tested with [FreeBASIC](freebasic.net). + +Generate C64 code and run it using cbmbasic: + +``` +cd impls/basic +make MODE=cbm stepX_YYY.bas +STEP=stepX_YYY basic_MODE=cbm ./run +``` + +Generate QBasic code, compile using FreeBASIC, and execute it: + +``` +cd impls/basic +make MODE=qbasic stepX_YYY.bas +make MODE=qbasic stepX_YYY +./stepX_YYY +``` + +Thanks to [Steven Syrek](https://github.com/sjsyrek) for the original +inspiration for this implementation. + +### BBC BASIC V + +The BBC BASIC V implementation can run in the Brandy interpreter: + +``` +cd impls/bbc-basic +brandy -quit stepX_YYY.bbc +``` + +Or in ARM BBC BASIC V under RISC OS 3 or later: + +``` +*Dir bbc-basic.riscos +*Run setup +*Run stepX_YYY +``` + ### C The C implementation of mal requires the following libraries (lib and -header packages): glib, libffi6 and either the libedit or GNU readline library. +header packages): glib, libffi6, libgc, and either the libedit or GNU readline +library. + +``` +cd impls/c +make +./stepX_YYY +``` + +### C.2 + +The second C implementation of mal requires the following libraries (lib and +header packages): libedit, libgc, libdl, and libffi. + +``` +cd impls/c.2 +make +./stepX_YYY +``` + + +### C++ + +The C++ implementation of mal requires g++-4.9 or clang++-3.5 and +a readline compatible library to build. See the `cpp/README.md` for +more details: ``` -cd c +cd impls/cpp make + # OR +make CXX=clang++-3.5 ./stepX_YYY ``` + ### C# ### The C# implementation of mal has been tested on Linux using the Mono @@ -88,16 +343,27 @@ C# compiler (mcs) and the Mono runtime (version 2.10.8.1). Both are required to build and run the C# implementation. ``` -cd cs +cd impls/cs make mono ./stepX_YYY.exe ``` +### ChucK + +The ChucK implementation has been tested with ChucK 1.3.5.2. + +``` +cd impls/chuck +./run +``` ### Clojure +For the most part the Clojure implementation requires Clojure 1.5, +however, to pass all tests, Clojure 1.8.0-RC4 is required. + ``` -cd clojure +cd impls/clojure lein with-profile +stepX trampoline run ``` @@ -105,71 +371,377 @@ lein with-profile +stepX trampoline run ``` sudo npm install -g coffee-script -cd coffee +cd impls/coffee coffee ./stepX_YYY ``` +### Common Lisp + +The implementation has been tested with SBCL, CCL, CMUCL, GNU CLISP, ECL and +Allegro CL on Ubuntu 16.04 and Ubuntu 12.04, see +the [README](impls/common-lisp/README.org) for more details. Provided you have the +dependencies mentioned installed, do the following to run the implementation + +``` +cd impls/common-lisp +make +./run +``` + +### Crystal + +The Crystal implementation of mal has been tested with Crystal 0.26.1. + +``` +cd impls/crystal +crystal run ./stepX_YYY.cr + # OR +make # needed to run tests +./stepX_YYY +``` + +### D + +The D implementation of mal was tested with GDC 4.8. It requires the GNU +readline library. + +``` +cd impls/d +make +./stepX_YYY +``` + +### Dart + +The Dart implementation has been tested with Dart 1.20. + +``` +cd impls/dart +dart ./stepX_YYY +``` + +### Emacs Lisp + +The Emacs Lisp implementation of mal has been tested with Emacs 24.3 +and 24.5. While there is very basic readline editing (`` +and `C-d` work, `C-c` cancels the process), it is recommended to use +`rlwrap`. + +``` +cd impls/elisp +emacs -Q --batch --load stepX_YYY.el +# with full readline support +rlwrap emacs -Q --batch --load stepX_YYY.el +``` + +### Elixir + +The Elixir implementation of mal has been tested with Elixir 1.0.5. + +``` +cd impls/elixir +mix stepX_YYY +# Or with readline/line editing functionality: +iex -S mix stepX_YYY +``` + +### Elm + +The Elm implementation of mal has been tested with Elm 0.18.0 + +``` +cd impls/elm +make stepX_YYY.js +STEP=stepX_YYY ./run +``` + +### Erlang + +The Erlang implementation of mal requires [Erlang/OTP R17](http://www.erlang.org/download.html) +and [rebar](https://github.com/rebar/rebar) to build. + +``` +cd impls/erlang +make + # OR +MAL_STEP=stepX_YYY rebar compile escriptize # build individual step +./stepX_YYY +``` + +### ES6 (ECMAScript 2015) + +The ES6 / ECMAScript 2015 implementation uses the +[babel](https://babeljs.io) compiler to generate ES5 compatible +JavaScript. The generated code has been tested with Node 0.12.4. + +``` +cd impls/es6 +make +node build/stepX_YYY.js +``` + + +### F# ### + +The F# implementation of mal has been tested on Linux using the Mono +F# compiler (fsharpc) and the Mono runtime (version 3.12.1). The mono C# +compiler (mcs) is also necessary to compile the readline dependency. All are +required to build and run the F# implementation. + +``` +cd impls/fsharp +make +mono ./stepX_YYY.exe +``` + +### Factor + +The Factor implementation of mal has been tested with Factor 0.97 +([factorcode.org](http://factorcode.org)). + +``` +cd impls/factor +FACTOR_ROOTS=. factor -run=stepX_YYY +``` + +### Fantom + +The Fantom implementation of mal has been tested with Fantom 1.0.70. + +``` +cd impls/fantom +make lib/fan/stepX_YYY.pod +STEP=stepX_YYY ./run +``` + +### Fennel + +The Fennel implementation of mal has been tested with Fennel version +0.9.1 on Lua 5.4. + +``` +cd impls/fennel +fennel ./stepX_YYY.fnl +``` + ### Forth ``` -cd forth +cd impls/forth gforth stepX_YYY.fs ``` +### GNU Guile 2.1+ + +``` +cd impls/guile +guile -L ./ stepX_YYY.scm +``` + +### GNU Smalltalk + +The Smalltalk implementation of mal has been tested with GNU Smalltalk 3.2.91. + +``` +cd impls/gnu-smalltalk +./run +``` + ### Go -You Go implementation of mal requires that go is installed on on the +The Go implementation of mal requires that go is installed on on the path. The implementation has been tested with Go 1.3.1. ``` -cd go +cd impls/go make ./stepX_YYY ``` +### Groovy + +The Groovy implementation of mal requires Groovy to run and has been +tested with Groovy 1.8.6. + +``` +cd impls/groovy +make +groovy ./stepX_YYY.groovy +``` + +### Hare + +The hare implementation was tested against Hare 0.25.2. + +``` +cd impls/hare +make +./stepX_YYY +``` + ### Haskell -Install the Haskell compiler (ghc/ghci), the Haskell platform and -either the editline package (BSD) or the readline package (GPL). On -Ubuntu these packages are: ghc, haskell-platform, -libghc-readline-dev/libghc-editline-dev +The Haskell implementation requires the ghc compiler version 7.10.1 or +later and also the Haskell parsec and readline (or editline) packages. ``` -cd haskell +cd impls/haskell make ./stepX_YYY ``` +### Haxe (Neko, Python, C++ and JavaScript) + +The Haxe implementation of mal requires Haxe version 3.2 to compile. +Four different Haxe targets are supported: Neko, Python, C++, and +JavaScript. + +``` +cd impls/haxe +# Neko +make all-neko +neko ./stepX_YYY.n +# Python +make all-python +python3 ./stepX_YYY.py +# C++ +make all-cpp +./cpp/stepX_YYY +# JavaScript +make all-js +node ./stepX_YYY.js +``` + +### Hy + +The Hy implementation of mal has been tested with Hy 0.13.0. + +``` +cd impls/hy +./stepX_YYY.hy +``` + +### Io + +The Io implementation of mal has been tested with Io version 20110905. + +``` +cd impls/io +io ./stepX_YYY.io +``` + +### Janet + +The Janet implementation of mal has been tested with Janet version 1.12.2. + +``` +cd impls/janet +janet ./stepX_YYY.janet +``` ### Java 1.7 The Java implementation of mal requires maven2 to build. ``` -cd java +cd impls/java mvn compile mvn -quiet exec:java -Dexec.mainClass=mal.stepX_YYY # OR mvn -quiet exec:java -Dexec.mainClass=mal.stepX_YYY -Dexec.args="CMDLINE_ARGS" ``` -### Javascript/Node +### Java, using Truffle for GraalVM + +This Java implementation will run on OpenJDK, but can run +as much as 30x faster on GraalVM thanks to the Truffle framework. +It's been tested with OpenJDK 11, GraalVM CE 20.1.0, and +GraalVM CE 21.1.0. + +``` +cd impls/java-truffle +./gradlew build +STEP=stepX_YYY ./run +``` + +### JavaScript/Node ``` -cd js -npm update +cd impls/js +npm install node stepX_YYY.js ``` +### Julia + +The Julia implementation of mal requires Julia 0.4. + +``` +cd impls/julia +julia stepX_YYY.jl +``` + +### jq + +Tested against version 1.6, with a lot of cheating in the IO department + +``` +cd impls/jq +STEP=stepA_YYY ./run + # with Debug +DEBUG=true STEP=stepA_YYY ./run +``` + +### Kotlin + +The Kotlin implementation of mal has been tested with Kotlin 1.0. + +``` +cd impls/kotlin +make +java -jar stepX_YYY.jar +``` + +### LaTeX3 + +The LaTeX3 implementation of mal has been tested with pdfTeX +3.141592653-2.6-1.40.24. + +Self hosting is too slow for any sensible timeout, and crashes in +step4, apparently because of hard-coded limitations. + +Anybody working on this should uncomment the two lines of (slow) +debugging options in the step file, and export DEBUG=1 (for more +output than tests accept). + +### LiveScript + +The LiveScript implementation of mal has been tested with LiveScript 1.5. + +``` +cd impls/livescript +make +node_modules/.bin/lsc stepX_YYY.ls +``` + +### Logo + +The Logo implementation of mal has been tested with UCBLogo 6.0. + +``` +cd impls/logo +logo stepX_YYY.lg +``` + ### Lua -Running the Lua implementation of mal requires lua 5.1 or later, -luarocks and the lua-rex-pcre library installed. +The Lua implementation of mal has been tested with Lua 5.3.5 The +implementation requires luarocks to be installed. ``` -cd lua -make # to build and link linenoise.so +cd impls/lua +make # to build and link linenoise.so and rex_pcre.so ./stepX_YYY.lua ``` @@ -180,7 +752,7 @@ the other implementations and passing the mal step to run as a command line argument. ``` -cd IMPL +cd impls/IMPL IMPL_STEPA_CMD ../mal/stepX_YYY.mal ``` @@ -188,43 +760,77 @@ IMPL_STEPA_CMD ../mal/stepX_YYY.mal ### GNU Make 3.81 ``` -cd make +cd impls/make make -f stepX_YYY.mk ``` -### Nim 0.10.3 +### NASM -Running the Nim implementation of mal requires Nim's current devel branch -(0.10.3) or later, and the nre library installed. +The NASM implementation of mal is written for x86-64 Linux, and has been tested +with Linux 3.16.0-4-amd64 and NASM version 2.11.05. ``` -cd nim +cd impls/nasm +make +./stepX_YYY +``` + +### Nim 1.0.4 + +The Nim implementation of mal has been tested with Nim 1.0.4. + +``` +cd impls/nim make # OR nimble build ./stepX_YYY ``` +### Object Pascal + +The Object Pascal implementation of mal has been built and tested on +Linux using the Free Pascal compiler version 2.6.2 and 2.6.4. + +``` +cd impls/objpascal +make +./stepX_YYY +``` + +### Objective C + +The Objective C implementation of mal has been built and tested on +Linux using clang/LLVM 3.6. It has also been built and tested on OS +X using Xcode 7. + +``` +cd impls/objc +make +./stepX_YYY +``` + ### OCaml 4.01.0 ``` -cd ocaml +cd impls/ocaml make ./stepX_YYY ``` -### MATLAB +### MATLAB (GNU Octave and MATLAB) -The MATLAB implementation of mal has been tested with MATLAB version -R2014a on Linux. Note that MATLAB is a commercial product. It should -be fairly simple to support GNU Octave once it support classdef object -syntax. +The MatLab implementation has been tested with GNU Octave 4.2.1. +It has also been tested with MATLAB version R2014a on Linux. Note that +MATLAB is a commercial product. ``` -cd matlab +cd impls/matlab ./stepX_YYY +octave -q --no-gui --no-history --eval "stepX_YYY();quit;" matlab -nodisplay -nosplash -nodesktop -nojvm -r "stepX_YYY();quit;" # OR with command line arguments +octave -q --no-gui --no-history --eval "stepX_YYY('arg1','arg2');quit;" matlab -nodisplay -nosplash -nodesktop -nojvm -r "stepX_YYY('arg1','arg2');quit;" ``` @@ -235,7 +841,7 @@ implemented in less than 1024 bytes of JavaScript. To run the miniMAL implementation of mal you need to download/install the miniMAL interpreter (which requires Node.js). ``` -cd miniMAL +cd impls/miniMAL # Download miniMAL and dependencies npm install export PATH=`pwd`/node_modules/minimal-lisp/:$PATH @@ -243,16 +849,26 @@ export PATH=`pwd`/node_modules/minimal-lisp/:$PATH miniMAL ./stepX_YYY ``` -### Perl 5.8 +### Perl 5 + +The Perl 5 implementation should work with perl 5.19.3 and later. For readline line editing support, install Term::ReadLine::Perl or Term::ReadLine::Gnu from CPAN. ``` -cd perl +cd impls/perl perl stepX_YYY.pl ``` +### Perl 6 + +The Perl 6 implementation was tested on Rakudo Perl 6 2016.04. + +``` +cd impls/perl6 +perl6 stepX_YYY.pl +``` ### PHP 5.3 @@ -260,25 +876,129 @@ The PHP implementation of mal requires the php command line interface to run. ``` -cd php +cd impls/php php stepX_YYY.php ``` -### Postscript Level 2/3 +### Picolisp + +The Picolisp implementation requires libreadline and Picolisp 3.1.11 +or later. + +``` +cd impls/picolisp +./run +``` + +### Pike -The Postscript implementation of mal requires ghostscript to run. It -has been tested with ghostscript 9.10. +The Pike implementation was tested on Pike 8.0. ``` -cd ps +cd impls/pike +pike stepX_YYY.pike +``` + +### PL/pgSQL (PostgreSQL SQL Procedural Language) + +The PL/pgSQL implementation of mal requires a running PostgreSQL server +(the "kanaka/mal-test-plpgsql" docker image automatically starts +a PostgreSQL server). The implementation connects to the PostgreSQL server +and create a database named "mal" to store tables and stored +procedures. The wrapper script uses the psql command to connect to the +server and defaults to the user "postgres" but this can be overridden +with the PSQL_USER environment variable. A password can be specified +using the PGPASSWORD environment variable. The implementation has been +tested with PostgreSQL 9.4. + +``` +cd impls/plpgsql +./wrap.sh stepX_YYY.sql + # OR +PSQL_USER=myuser PGPASSWORD=mypass ./wrap.sh stepX_YYY.sql +``` + +### PL/SQL (Oracle SQL Procedural Language) + +The PL/SQL implementation of mal requires a running Oracle DB +server (the "kanaka/mal-test-plsql" docker image automatically +starts an Oracle Express server). The implementation connects to the +Oracle server to create types, tables and stored procedures. The +default SQL\*Plus logon value (username/password@connect_identifier) is +"system/oracle" but this can be overridden with the ORACLE_LOGON +environment variable. The implementation has been tested with Oracle +Express Edition 11g Release 2. Note that any SQL\*Plus connection +warnings (user password expiration, etc) will interfere with the +ability of the wrapper script to communicate with the DB. + +``` +cd impls/plsql +./wrap.sh stepX_YYY.sql + # OR +ORACLE_LOGON=myuser/mypass@ORCL ./wrap.sh stepX_YYY.sql +``` + +### PostScript Level 2/3 + +The PostScript implementation of mal requires Ghostscript to run. It +has been tested with Ghostscript 9.10. + +``` +cd impls/ps gs -q -dNODISPLAY -I./ stepX_YYY.ps ``` -### Python (2 or 3) +### PowerShell + +The PowerShell implementation of mal requires the PowerShell script +language. It has been tested with PowerShell 6.0.0 Alpha 9 on Linux. + +``` +cd impls/powershell +powershell ./stepX_YYY.ps1 +``` + +### Prolog + +The Prolog implementation uses some constructs specific to SWI-Prolog, +includes readline support and has been tested on Debian GNU/Linux with +version 8.2.1. + +``` +cd impls/prolog +swipl stepX_YYY +``` + +### PureScript +The PureScript implementation requires the spago compiler version 0.20.2. + +``` +cd impls/purs +make +node ./stepX_YYY.js +``` + +### Python2 + +This implementation only uses python2 features, but avoids +incompatibilities with python3. + +### Python3 + +This implementation is checked for style and types +(flake8, pylint, mypy). It reports all errors with details. +It demonstrates iterators, decorators, functional tools, chain maps, +dataclasses, introspection, match statements, assignement expressions. + +### RPython + +You must have [rpython](https://rpython.readthedocs.org/) on your path +(included with [pypy](https://bitbucket.org/pypy/pypy/)). ``` -cd python -python stepX_YYY.py +cd impls/rpython +make # this takes a very long time +./stepX_YYY ``` ### R @@ -286,7 +1006,7 @@ python stepX_YYY.py The R implementation of mal requires R (r-base-core) to run. ``` -cd r +cd impls/r make libs # to download and build rdyncall Rscript stepX_YYY.r ``` @@ -297,28 +1017,48 @@ The Racket implementation of mal requires the Racket compiler/interpreter to run. ``` -cd racket -./stepX_YYY.rb +cd impls/racket +./stepX_YYY.rkt +``` + +### Rexx + +The Rexx implementation of mal has been tested with Regina Rexx 3.6. + +``` +cd impls/rexx +make +rexx -a ./stepX_YYY.rexxpp ``` ### Ruby (1.9+) ``` -cd ruby +cd impls/ruby +ruby stepX_YYY.rb +``` + +### Ruby #2 + +A second Ruby implementation with the following goals: + +- No global variables +- No modification (monkey-patching) of core Ruby classes +- Modularized into the `Mal` module namespace + +``` +cd impls/ruby.2 ruby stepX_YYY.rb ``` -### Rust (0.13) +### Rust (1.38+) The rust implementation of mal requires the rust compiler and build tool (cargo) to build. ``` -cd rust -# Need patched pcre lib (should be temporary) -git clone https://github.com/kanaka/rust-pcre cadencemarseille-pcre -cargo build --release -./target/stepX_YYY +cd impls/rust +cargo run --release --bin stepX_YYY ``` ### Scala ### @@ -326,13 +1066,159 @@ cargo build --release Install scala and sbt (http://www.scala-sbt.org/0.13/tutorial/Installing-sbt-on-Linux.html): ``` -cd scala +cd impls/scala sbt 'run-main stepX_YYY' # OR sbt compile scala -classpath target/scala*/classes stepX_YYY ``` +### Scheme (R7RS) ### + +The Scheme implementation of MAL has been tested with Chibi-Scheme +0.10, Kawa 3.1.1, Gauche 0.9.6, CHICKEN 5.1.0, Sagittarius 0.9.7, +Cyclone 0.32.0 (Git version) and Foment 0.4 (Git version). You should +be able to get it running on other conforming R7RS implementations +after figuring out how libraries are loaded and adjusting the +`Makefile` and `run` script accordingly. + +``` +cd impls/scheme +# chibi +scheme_MODE=chibi ./run +# kawa +make kawa +scheme_MODE=kawa ./run +# gauche +scheme_MODE=gauche ./run +# chicken +make chicken +scheme_MODE=chicken ./run +# sagittarius +scheme_MODE=sagittarius ./run +# cyclone +make cyclone +scheme_MODE=cyclone ./run +# foment +scheme_MODE=foment ./run +``` + +### Skew ### + +The Skew implementation of mal has been tested with Skew 0.7.42. + +``` +cd impls/skew +make +node stepX_YYY.js +``` + + +### Standard ML (Poly/ML, MLton, Moscow ML) + +The Standard ML implementation of mal requires an +[SML97](https://github.com/SMLFamily/The-Definition-of-Standard-ML-Revised) +implementation. The Makefile supports Poly/ML, MLton, Moscow ML, and has +been tested with Poly/ML 5.8.1, MLton 20210117, and Moscow ML version 2.10. + +``` +cd impls/sml +# Poly/ML +make sml_MODE=polyml +./stepX_YYY +# MLton +make sml_MODE=mlton +./stepX_YYY +# Moscow ML +make sml_MODE=mosml +./stepX_YYY +``` + + +### Swift 3 + +The Swift 3 implementation of mal requires the Swift 3.0 compiler. It +has been tested with Swift 3 Preview 3. + +``` +cd impls/swift3 +make +./stepX_YYY +``` + +### Swift 4 + +The Swift 4 implementation of mal requires the Swift 4.0 compiler. It +has been tested with Swift 4.2.3 release. + +``` +cd impls/swift4 +make +./stepX_YYY +``` + +### Swift 5 + +The Swift 5 implementation of mal requires the Swift 5.0 compiler. It +has been tested with Swift 5.1.1 release. + +``` +cd impls/swift6 +swift run stepX_YYY +``` + +### Tcl 8.6 + +The Tcl implementation of mal requires Tcl 8.6 to run. For readline line +editing support, install tclreadline. + +``` +cd impls/tcl +tclsh ./stepX_YYY.tcl +``` + +### TypeScript + +The TypeScript implementation of mal requires the TypeScript 2.2 compiler. +It has been tested with Node.js v6. + +``` +cd impls/ts +make +node ./stepX_YYY.js +``` + +### Vala + +The Vala implementation of mal has been tested with the Vala 0.40.8 +compiler. You will need to install `valac` and `libreadline-dev` or +equivalent. + +``` +cd impls/vala +make +./stepX_YYY +``` + +### VHDL + +The VHDL implementation of mal has been tested with GHDL 0.29. + +``` +cd impls/vhdl +make +./run_vhdl.sh ./stepX_YYY +``` + +### Vimscript + +The Vimscript implementation of mal requires Vim 8.0 to run. + +``` +cd impls/vimscript +./run_vimscript.sh ./stepX_YYY.vim +``` + ### Visual Basic.NET ### The VB.NET implementation of mal has been tested on Linux using the Mono @@ -340,26 +1226,114 @@ VB compiler (vbnc) and the Mono runtime (version 2.10.8.1). Both are required to build and run the VB.NET implementation. ``` -cd vb +cd impls/vb make mono ./stepX_YYY.exe ``` +### Visual Basic Script ### + +The VBScript implementation of mal has been tested on Windows 10 1909. +`install.vbs` can help you install the requirements (.NET 2.0 3.0 3.5). +If you havn't install `.NET 2.0 3.0 3.5`, it will popup a window for installation. +If you already installed that, it will do nothing. + +``` +cd impls\vbs +install.vbs +cscript -nologo stepX_YYY.vbs +``` + +### WebAssembly (wasm) ### + +The WebAssembly implementation is written in +[Wam](https://github.com/kanaka/wam) (WebAssembly Macro language) and +runs under several different non-web embeddings (runtimes): +[node](https://nodejs.org), +[wasmtime](https://github.com/CraneStation/wasmtime), +[wasmer](https://wasmer.io), +[wax](https://github.com/kanaka/wac), +[wace](https://github.com/kanaka/wac), +[warpy](https://github.com/kanaka/warpy). + +``` +cd impls/wasm +# node +make wasm_MODE=node +./run.js ./stepX_YYY.wasm +# wasmtime +make wasm_MODE=wasmtime +wasmtime --dir=./ --dir=../ --dir=/ ./stepX_YYY.wasm +# wasmer +make wasm_MODE=wasmer +wasmer run --dir=./ --dir=../ --dir=/ ./stepX_YYY.wasm +# wax +make wasm_MODE=wax +wax ./stepX_YYY.wasm +# wace +make wasm_MODE=wace_libc +wace ./stepX_YYY.wasm +# warpy +make wasm_MODE=warpy +warpy --argv --memory-pages 256 ./stepX_YYY.wasm +``` + +### XSLT + +The XSLT implementation of mal is written with XSLT 3 and tested on Saxon 9.9.1.6 Home Edition. + +``` +cd impls/xslt +STEP=stepX_YY ./run +``` + +### Wren + +The Wren implementation of mal was tested on Wren 0.2.0. + +``` +cd impls/wren +wren ./stepX_YYY.wren +``` + +### Yorick + +The Yorick implementation of mal was tested on Yorick 2.2.04. + +``` +cd impls/yorick +yorick -batch ./stepX_YYY.i +``` + +### Zig + +The Zig implementation of mal was tested on Zig 0.5. + +``` +cd impls/zig +zig build stepX_YYY +``` + ## Running tests +The top level Makefile has a number of useful targets to assist with +implementation development and testing. The `help` target provides +a list of the targets and options: + +``` +make help +``` + ### Functional tests -The are nearly 500 generic functional tests (for all implementations) +The are almost 800 generic functional tests (for all implementations) in the `tests/` directory. Each step has a corresponding test file containing tests specific to that step. The `runtest.py` test harness -uses pexpect to launch a Mal step implementation and then feeds the -tests one at a time to the implementation and compares the -output/return value to the expected output/return value. - -To simplify the process of running tests, a top level Makefile is -provided with convenient test targets. +launches a Mal step implementation and then feeds the tests one at +a time to the implementation and compares the output/return value to +the expected output/return value. * To run all the tests across all implementations (be prepared to wait): @@ -370,31 +1344,31 @@ make test * To run all tests against a single implementation: ``` -make test^IMPL +make "test^IMPL" # e.g. -make test^clojure -make test^js +make "test^clojure" +make "test^js" ``` * To run tests for a single step against all implementations: ``` -make test^stepX +make "test^stepX" # e.g. -make test^step2 -make test^step7 +make "test^step2" +make "test^step7" ``` -* To run tests for a specifc step against a single implementation: +* To run tests for a specific step against a single implementation: ``` -make test^IMPL^stepX +make "test^IMPL^stepX" # e.g -make test^ruby^step3 -make test^ps^step4 +make "test^ruby^step3" +make "test^ps^step4" ``` ### Self-hosted functional tests @@ -403,52 +1377,113 @@ make test^ps^step4 as the test implementation and use the `MAL_IMPL` make variable to change the underlying host language (default is JavaScript): ``` -make MAL_IMPL=IMPL test^mal^step2 +make MAL_IMPL=IMPL "test^mal^step2" # e.g. -make test^mal^step2 # js is default -make MAL_IMPL=ruby test^mal^step2 -make MAL_IMPL=python test^mal^step2 +make "test^mal^step2" # js is default +make MAL_IMPL=ruby "test^mal^step2" +make MAL_IMPL=python3 "test^mal^step2" +``` + +### Starting the REPL + +* To start the REPL of an implementation in a specific step: + +``` +make "repl^IMPL^stepX" + +# e.g +make "repl^ruby^step3" +make "repl^ps^step4" +``` + +* If you omit the step, then `stepA` is used: + +``` +make "repl^IMPL" + +# e.g +make "repl^ruby" +make "repl^ps" ``` +* To start the REPL of the self-hosted implementation, specify `mal` as the + REPL implementation and use the `MAL_IMPL` make variable to change the + underlying host language (default is JavaScript): +``` +make MAL_IMPL=IMPL "repl^mal^stepX" + +# e.g. +make "repl^mal^step2" # js is default +make MAL_IMPL=ruby "repl^mal^step2" +make MAL_IMPL=python3 "repl^mal" +``` ### Performance tests +Warning: These performance tests are neither statistically valid nor +comprehensive; runtime performance is a not a primary goal of mal. If +you draw any serious conclusions from these performance tests, then +please contact me about some amazing oceanfront property in Kansas +that I'm willing to sell you for cheap. + * To run performance tests against a single implementation: ``` -make perf^IMPL +make "perf^IMPL" # e.g. -make perf^js +make "perf^js" ``` * To run performance tests against all implementations: ``` -make perf +make "perf" ``` ### Generating language statistics -* To report line and byte stastics for a single implementation: +* To report line and byte statistics for a single implementation: ``` -make stats^IMPL +make "stats^IMPL" # e.g. -make stats^js +make "stats^js" ``` -* To report line and bytes stastics for general Lisp code (env, core - and stepA): +## Dockerized testing + +Every implementation directory contains a Dockerfile to create +a docker image containing all the dependencies for that +implementation. In addition, the top-level Makefile contains support +for running the tests target (and perf, stats, repl, etc) within +a docker container for that implementation by passing *"DOCKERIZE=1"* +on the make command line. For example: + +``` +make DOCKERIZE=1 "test^js^step3" ``` -make stats-lisp^IMPL -# e.g. -make stats-lisp^js +Existing implementations already have docker images built and pushed +to the docker registry. However, if +you wish to build or rebuild a docker image locally, the toplevel +Makefile provides a rule for building docker images: + +``` +make "docker-build^IMPL" ``` +**Notes**: +* Docker images are named *"ghcr.io/kanaka/mal-test-IMPL"* +* JVM-based language implementations (Groovy, Java, Clojure, Scala): + you will probably need to run this command once manually + first `make DOCKERIZE=1 "repl^IMPL"` before you can run tests because + runtime dependencies need to be downloaded to avoid the tests timing + out. These dependencies are downloaded to dot-files in the /mal + directory so they will persist between runs. + + ## License Mal (make-a-lisp) is licensed under the MPL 2.0 (Mozilla Public License 2.0). See LICENSE.txt for more details. - diff --git a/bash/Makefile b/bash/Makefile deleted file mode 100644 index dc1d1ad196..0000000000 --- a/bash/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -SOURCES_BASE = types.sh reader.sh printer.sh -SOURCES_LISP = env.sh core.sh stepA_mal.sh -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: mal.sh - -mal.sh: $(SOURCES) - cat $+ > $@ - echo "#!/usr/bin/env bash" > $@ - cat $+ | grep -v "^source " >> $@ - chmod +x $@ - -clean: - rm -f mal.sh - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/bash/step7_quote.sh b/bash/step7_quote.sh deleted file mode 100755 index 1952c99b13..0000000000 --- a/bash/step7_quote.sh +++ /dev/null @@ -1,219 +0,0 @@ -#!/usr/bin/env bash - -source $(dirname $0)/reader.sh -source $(dirname $0)/printer.sh -source $(dirname $0)/env.sh -source $(dirname $0)/core.sh - -# read -READ () { - [ "${1}" ] && r="${1}" || READLINE - READ_STR "${r}" -} - -# eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 -} - -QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return - else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi - fi - fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return -} - -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - case "${ot}" in - symbol) - ENV_GET "${env}" "${ast}" - return ;; - list) - _map_with_type _list EVAL "${ast}" "${env}" ;; - vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; - hash_map) - local res="" val="" hm="${ANON["${ast}"]}" - _hash_map; local new_hm="${r}" - eval local keys="\${!${hm}[@]}" - for key in ${keys}; do - eval val="\${${hm}[\"${key}\"]}" - EVAL "${val}" "${env}" - _assoc! "${new_hm}" "${key}" "${r}" - done - r="${new_hm}" ;; - *) - r="${ast}" ;; - esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi - - # apply list - _nth "${ast}" 0; local a0="${r}" - _nth "${ast}" 1; local a1="${r}" - _nth "${ast}" 2; local a2="${r}" - case "${ANON["${a0}"]}" in - def!) EVAL "${a2}" "${env}" - [[ "${__ERROR}" ]] && return 1 - ENV_SET "${env}" "${a1}" "${r}" - return ;; - let*) ENV "${env}"; local let_env="${r}" - local let_pairs=(${ANON["${a1}"]}) - local idx=0 - #echo "let: [${let_pairs[*]}] for ${a2}" - while [[ "${let_pairs["${idx}"]}" ]]; do - EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" - ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" - idx=$(( idx + 2)) - done - ast="${a2}" - env="${let_env}" - # Continue loop - ;; - quote) - r="${a1}" - return ;; - quasiquote) - QUASIQUOTE "${a1}" - ast="${r}" - # Continue loop - ;; - do) _count "${ast}" - _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - _last "${ast}" - ast="${r}" - # Continue loop - ;; - if) EVAL "${a1}" "${env}" - [[ "${__ERROR}" ]] && return 1 - if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then - # eval false form - _nth "${ast}" 3; local a3="${r}" - if [[ "${a3}" ]]; then - ast="${a3}" - else - r="${__nil}" - return - fi - else - # eval true condition - ast="${a2}" - fi - # Continue loop - ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" - return ;; - *) EVAL_AST "${ast}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" - #echo "invoke: [${f}] ${args}" - if [[ "${f//@/ }" != "${f}" ]]; then - set -- ${f//@/ } - ast="${2}" - ENV "${3}" "${4}" ${args} - env="${r}" - else - eval ${f%%@*} ${args} - return - fi - # Continue loop - ;; - esac - done -} - -# print -PRINT () { - if [[ "${__ERROR}" ]]; then - _pr_str "${__ERROR}" yes - r="Error: ${r}" - __ERROR= - else - _pr_str "${1}" yes - fi -} - -# repl -ENV; REPL_ENV="${r}" -REP () { - r= - READ "${1}" - EVAL "${r}" "${REPL_ENV}" - PRINT "${r}" -} - -# core.sh: defined using bash -_fref () { - _symbol "${1}"; local sym="${r}" - _function "${2} \"\${@}\"" - ENV_SET "${REPL_ENV}" "${sym}" "${r}" -} -for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done -_eval () { EVAL "${1}" "${REPL_ENV}"; } -_fref "eval" _eval -_list; argv="${r}" -for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done -_symbol "__STAR__ARGV__STAR__" -ENV_SET "${REPL_ENV}" "${r}" "${argv}"; - -# core.mal: defined using the language itself -REP "(def! not (fn* (a) (if a false true)))" -REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - -# load/run file from command line (then exit) -if [[ "${1}" ]]; then - REP "(load-file \"${1}\")" - exit 0 -fi - -# repl loop -while true; do - READLINE "user> " || exit "$?" - [[ "${r}" ]] && REP "${r}" && echo "${r}" -done diff --git a/bash/step8_macros.sh b/bash/step8_macros.sh deleted file mode 100755 index 0503ca9f13..0000000000 --- a/bash/step8_macros.sh +++ /dev/null @@ -1,260 +0,0 @@ -#!/usr/bin/env bash - -source $(dirname $0)/reader.sh -source $(dirname $0)/printer.sh -source $(dirname $0)/env.sh -source $(dirname $0)/core.sh - -# read -READ () { - [ "${1}" ] && r="${1}" || READLINE - READ_STR "${r}" -} - -# eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 -} - -QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return - else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi - fi - fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return -} - -IS_MACRO_CALL () { - if ! _list? "${1}"; then return 1; fi - _nth "${1}" 0; local a0="${r}" - if _symbol? "${a0}"; then - ENV_FIND "${2}" "${a0}" - if [[ "${r}" ]]; then - ENV_GET "${2}" "${a0}" - [ "${ANON["${r}_ismacro_"]}" ] - return $? - fi - fi - return 1 -} - -MACROEXPAND () { - local ast="${1}" env="${2}" - while IS_MACRO_CALL "${ast}" "${env}"; do - _nth "${ast}" 0; local a0="${r}" - ENV_GET "${env}" "${a0}"; local mac="${ANON["${r}"]}" - _rest "${ast}" - ${mac%%@*} ${ANON["${r}"]} - ast="${r}" - done - r="${ast}" -} - - -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - case "${ot}" in - symbol) - ENV_GET "${env}" "${ast}" - return ;; - list) - _map_with_type _list EVAL "${ast}" "${env}" ;; - vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; - hash_map) - local res="" val="" hm="${ANON["${ast}"]}" - _hash_map; local new_hm="${r}" - eval local keys="\${!${hm}[@]}" - for key in ${keys}; do - eval val="\${${hm}[\"${key}\"]}" - EVAL "${val}" "${env}" - _assoc! "${new_hm}" "${key}" "${r}" - done - r="${new_hm}" ;; - *) - r="${ast}" ;; - esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi - - # apply list - MACROEXPAND "${ast}" "${env}" - ast="${r}" - if ! _list? "${ast}"; then return; fi - _nth "${ast}" 0; local a0="${r}" - _nth "${ast}" 1; local a1="${r}" - _nth "${ast}" 2; local a2="${r}" - case "${ANON["${a0}"]}" in - def!) EVAL "${a2}" "${env}" - [[ "${__ERROR}" ]] && return 1 - ENV_SET "${env}" "${a1}" "${r}" - return ;; - let*) ENV "${env}"; local let_env="${r}" - local let_pairs=(${ANON["${a1}"]}) - local idx=0 - #echo "let: [${let_pairs[*]}] for ${a2}" - while [[ "${let_pairs["${idx}"]}" ]]; do - EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" - ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" - idx=$(( idx + 2)) - done - ast="${a2}" - env="${let_env}" - # Continue loop - ;; - quote) - r="${a1}" - return ;; - quasiquote) - QUASIQUOTE "${a1}" - ast="${r}" - # Continue loop - ;; - defmacro!) - EVAL "${a2}" "${env}" - [[ "${__ERROR}" ]] && return 1 - ANON["${r}_ismacro_"]="yes" - ENV_SET "${env}" "${a1}" "${r}" - return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; - do) _count "${ast}" - _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - _last "${ast}" - ast="${r}" - # Continue loop - ;; - if) EVAL "${a1}" "${env}" - [[ "${__ERROR}" ]] && return 1 - if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then - # eval false form - _nth "${ast}" 3; local a3="${r}" - if [[ "${a3}" ]]; then - ast="${a3}" - else - r="${__nil}" - return - fi - else - # eval true condition - ast="${a2}" - fi - # Continue loop - ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" - return ;; - *) EVAL_AST "${ast}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" - #echo "invoke: [${f}] ${args}" - if [[ "${f//@/ }" != "${f}" ]]; then - set -- ${f//@/ } - ast="${2}" - ENV "${3}" "${4}" ${args} - env="${r}" - else - eval ${f%%@*} ${args} - return - fi - # Continue loop - ;; - esac - done -} - -# print -PRINT () { - if [[ "${__ERROR}" ]]; then - _pr_str "${__ERROR}" yes - r="Error: ${r}" - __ERROR= - else - _pr_str "${1}" yes - fi -} - -# repl -ENV; REPL_ENV="${r}" -REP () { - r= - READ "${1}" - EVAL "${r}" "${REPL_ENV}" - PRINT "${r}" -} - -# core.sh: defined using bash -_fref () { - _symbol "${1}"; local sym="${r}" - _function "${2} \"\${@}\"" - ENV_SET "${REPL_ENV}" "${sym}" "${r}" -} -for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done -_eval () { EVAL "${1}" "${REPL_ENV}"; } -_fref "eval" _eval -_list; argv="${r}" -for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done -_symbol "__STAR__ARGV__STAR__" -ENV_SET "${REPL_ENV}" "${r}" "${argv}"; - -# core.mal: defined using the language itself -REP "(def! not (fn* (a) (if a false true)))" -REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - -# load/run file from command line (then exit) -if [[ "${1}" ]]; then - REP "(load-file \"${1}\")" - exit 0 -fi - -# repl loop -while true; do - READLINE "user> " || exit "$?" - [[ "${r}" ]] && REP "${r}" && echo "${r}" -done diff --git a/bash/step9_try.sh b/bash/step9_try.sh deleted file mode 100755 index 775e0ddd8d..0000000000 --- a/bash/step9_try.sh +++ /dev/null @@ -1,273 +0,0 @@ -#!/usr/bin/env bash - -source $(dirname $0)/reader.sh -source $(dirname $0)/printer.sh -source $(dirname $0)/env.sh -source $(dirname $0)/core.sh - -# read -READ () { - [ "${1}" ] && r="${1}" || READLINE - READ_STR "${r}" -} - -# eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 -} - -QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return - else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi - fi - fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return -} - -IS_MACRO_CALL () { - if ! _list? "${1}"; then return 1; fi - _nth "${1}" 0; local a0="${r}" - if _symbol? "${a0}"; then - ENV_FIND "${2}" "${a0}" - if [[ "${r}" ]]; then - ENV_GET "${2}" "${a0}" - [ "${ANON["${r}_ismacro_"]}" ] - return $? - fi - fi - return 1 -} - -MACROEXPAND () { - local ast="${1}" env="${2}" - while IS_MACRO_CALL "${ast}" "${env}"; do - _nth "${ast}" 0; local a0="${r}" - ENV_GET "${env}" "${a0}"; local mac="${ANON["${r}"]}" - _rest "${ast}" - ${mac%%@*} ${ANON["${r}"]} - ast="${r}" - done - r="${ast}" -} - - -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - case "${ot}" in - symbol) - ENV_GET "${env}" "${ast}" - return ;; - list) - _map_with_type _list EVAL "${ast}" "${env}" ;; - vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; - hash_map) - local res="" val="" hm="${ANON["${ast}"]}" - _hash_map; local new_hm="${r}" - eval local keys="\${!${hm}[@]}" - for key in ${keys}; do - eval val="\${${hm}[\"${key}\"]}" - EVAL "${val}" "${env}" - _assoc! "${new_hm}" "${key}" "${r}" - done - r="${new_hm}" ;; - *) - r="${ast}" ;; - esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi - - # apply list - MACROEXPAND "${ast}" "${env}" - ast="${r}" - if ! _list? "${ast}"; then return; fi - _nth "${ast}" 0; local a0="${r}" - _nth "${ast}" 1; local a1="${r}" - _nth "${ast}" 2; local a2="${r}" - case "${ANON["${a0}"]}" in - def!) EVAL "${a2}" "${env}" - [[ "${__ERROR}" ]] && return 1 - ENV_SET "${env}" "${a1}" "${r}" - return ;; - let*) ENV "${env}"; local let_env="${r}" - local let_pairs=(${ANON["${a1}"]}) - local idx=0 - #echo "let: [${let_pairs[*]}] for ${a2}" - while [[ "${let_pairs["${idx}"]}" ]]; do - EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" - ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" - idx=$(( idx + 2)) - done - ast="${a2}" - env="${let_env}" - # Continue loop - ;; - quote) - r="${a1}" - return ;; - quasiquote) - QUASIQUOTE "${a1}" - ast="${r}" - # Continue loop - ;; - defmacro!) - EVAL "${a2}" "${env}" - [[ "${__ERROR}" ]] && return 1 - ANON["${r}_ismacro_"]="yes" - ENV_SET "${env}" "${a1}" "${r}" - return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; - try*) EVAL "${a1}" "${env}" - [[ -z "${__ERROR}" ]] && return - _nth "${a2}" 0; local a20="${r}" - if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then - _nth "${a2}" 1; local a21="${r}" - _nth "${a2}" 2; local a22="${r}" - _list "${a21}"; local binds="${r}" - ENV "${env}" "${binds}" "${__ERROR}" - local try_env="${r}" - __ERROR= - EVAL "${a22}" "${try_env}" - fi # if no catch* clause, just propagate __ERROR - return ;; - do) _count "${ast}" - _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - _last "${ast}" - ast="${r}" - # Continue loop - ;; - if) EVAL "${a1}" "${env}" - [[ "${__ERROR}" ]] && return 1 - if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then - # eval false form - _nth "${ast}" 3; local a3="${r}" - if [[ "${a3}" ]]; then - ast="${a3}" - else - r="${__nil}" - return - fi - else - # eval true condition - ast="${a2}" - fi - # Continue loop - ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" - return ;; - *) EVAL_AST "${ast}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" - #echo "invoke: [${f}] ${args}" - if [[ "${f//@/ }" != "${f}" ]]; then - set -- ${f//@/ } - ast="${2}" - ENV "${3}" "${4}" ${args} - env="${r}" - else - eval ${f%%@*} ${args} - return - fi - # Continue loop - ;; - esac - done -} - -# print -PRINT () { - if [[ "${__ERROR}" ]]; then - _pr_str "${__ERROR}" yes - r="Error: ${r}" - __ERROR= - else - _pr_str "${1}" yes - fi -} - -# repl -ENV; REPL_ENV="${r}" -REP () { - r= - READ "${1}" - EVAL "${r}" "${REPL_ENV}" - PRINT "${r}" -} - -# core.sh: defined using bash -_fref () { - _symbol "${1}"; local sym="${r}" - _function "${2} \"\${@}\"" - ENV_SET "${REPL_ENV}" "${sym}" "${r}" -} -for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done -_eval () { EVAL "${1}" "${REPL_ENV}"; } -_fref "eval" _eval -_list; argv="${r}" -for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done -_symbol "__STAR__ARGV__STAR__" -ENV_SET "${REPL_ENV}" "${r}" "${argv}"; - -# core.mal: defined using the language itself -REP "(def! not (fn* (a) (if a false true)))" -REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - -# load/run file from command line (then exit) -if [[ "${1}" ]]; then - REP "(load-file \"${1}\")" - exit 0 -fi - -# repl loop -while true; do - READLINE "user> " || exit "$?" - [[ "${r}" ]] && REP "${r}" && echo "${r}" -done diff --git a/bash/stepA_mal.sh b/bash/stepA_mal.sh deleted file mode 100755 index 7b43496bd6..0000000000 --- a/bash/stepA_mal.sh +++ /dev/null @@ -1,283 +0,0 @@ -#!/usr/bin/env bash - -source $(dirname $0)/reader.sh -source $(dirname $0)/printer.sh -source $(dirname $0)/env.sh -source $(dirname $0)/core.sh - -# read -READ () { - [ "${1}" ] && r="${1}" || READLINE - READ_STR "${r}" -} - -# eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 -} - -QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return - else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi - fi - fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return -} - -IS_MACRO_CALL () { - if ! _list? "${1}"; then return 1; fi - _nth "${1}" 0; local a0="${r}" - if _symbol? "${a0}"; then - ENV_FIND "${2}" "${a0}" - if [[ "${r}" ]]; then - ENV_GET "${2}" "${a0}" - [ "${ANON["${r}_ismacro_"]}" ] - return $? - fi - fi - return 1 -} - -MACROEXPAND () { - local ast="${1}" env="${2}" - while IS_MACRO_CALL "${ast}" "${env}"; do - _nth "${ast}" 0; local a0="${r}" - ENV_GET "${env}" "${a0}"; local mac="${ANON["${r}"]}" - _rest "${ast}" - ${mac%%@*} ${ANON["${r}"]} - ast="${r}" - done - r="${ast}" -} - - -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - case "${ot}" in - symbol) - ENV_GET "${env}" "${ast}" - return ;; - list) - _map_with_type _list EVAL "${ast}" "${env}" ;; - vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; - hash_map) - local res="" val="" hm="${ANON["${ast}"]}" - _hash_map; local new_hm="${r}" - eval local keys="\${!${hm}[@]}" - for key in ${keys}; do - eval val="\${${hm}[\"${key}\"]}" - EVAL "${val}" "${env}" - _assoc! "${new_hm}" "${key}" "${r}" - done - r="${new_hm}" ;; - *) - r="${ast}" ;; - esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi - - # apply list - MACROEXPAND "${ast}" "${env}" - ast="${r}" - if ! _list? "${ast}"; then return; fi - _nth "${ast}" 0; local a0="${r}" - _nth "${ast}" 1; local a1="${r}" - _nth "${ast}" 2; local a2="${r}" - case "${ANON["${a0}"]}" in - def!) EVAL "${a2}" "${env}" - [[ "${__ERROR}" ]] && return 1 - ENV_SET "${env}" "${a1}" "${r}" - return ;; - let*) ENV "${env}"; local let_env="${r}" - local let_pairs=(${ANON["${a1}"]}) - local idx=0 - #echo "let: [${let_pairs[*]}] for ${a2}" - while [[ "${let_pairs["${idx}"]}" ]]; do - EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" - ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" - idx=$(( idx + 2)) - done - ast="${a2}" - env="${let_env}" - # Continue loop - ;; - quote) - r="${a1}" - return ;; - quasiquote) - QUASIQUOTE "${a1}" - ast="${r}" - # Continue loop - ;; - defmacro!) - EVAL "${a2}" "${env}" - [[ "${__ERROR}" ]] && return 1 - ANON["${r}_ismacro_"]="yes" - ENV_SET "${env}" "${a1}" "${r}" - return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; - sh*) EVAL "${a1}" "${env}" - local output="" - local line="" - while read line; do - output="${output}${line}\n" - done < <(eval ${ANON["${r}"]}) - _string "${output%\\n}" - return ;; - try*) EVAL "${a1}" "${env}" - [[ -z "${__ERROR}" ]] && return - _nth "${a2}" 0; local a20="${r}" - if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then - _nth "${a2}" 1; local a21="${r}" - _nth "${a2}" 2; local a22="${r}" - _list "${a21}"; local binds="${r}" - ENV "${env}" "${binds}" "${__ERROR}" - local try_env="${r}" - __ERROR= - EVAL "${a22}" "${try_env}" - fi # if no catch* clause, just propagate __ERROR - return ;; - do) _count "${ast}" - _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - _last "${ast}" - ast="${r}" - # Continue loop - ;; - if) EVAL "${a1}" "${env}" - [[ "${__ERROR}" ]] && return 1 - if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then - # eval false form - _nth "${ast}" 3; local a3="${r}" - if [[ "${a3}" ]]; then - ast="${a3}" - else - r="${__nil}" - return - fi - else - # eval true condition - ast="${a2}" - fi - # Continue loop - ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" - return ;; - *) EVAL_AST "${ast}" "${env}" - [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" - #echo "invoke: [${f}] ${args}" - if [[ "${f//@/ }" != "${f}" ]]; then - set -- ${f//@/ } - ast="${2}" - ENV "${3}" "${4}" ${args} - env="${r}" - else - eval ${f%%@*} ${args} - return - fi - # Continue loop - ;; - esac - done -} - -# print -PRINT () { - if [[ "${__ERROR}" ]]; then - _pr_str "${__ERROR}" yes - r="Error: ${r}" - __ERROR= - else - _pr_str "${1}" yes - fi -} - -# repl -ENV; REPL_ENV="${r}" -REP () { - r= - READ "${1}" - EVAL "${r}" "${REPL_ENV}" - PRINT "${r}" -} - -# core.sh: defined using bash -_fref () { - _symbol "${1}"; local sym="${r}" - _function "${2} \"\${@}\"" - ENV_SET "${REPL_ENV}" "${sym}" "${r}" -} -for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done -_eval () { EVAL "${1}" "${REPL_ENV}"; } -_fref "eval" _eval -_list; argv="${r}" -for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done -_symbol "__STAR__ARGV__STAR__" -ENV_SET "${REPL_ENV}" "${r}" "${argv}"; - -# core.mal: defined using the language itself -REP "(def! *host-language* \"bash\")" -REP "(def! not (fn* (a) (if a false true)))" -REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - -# load/run file from command line (then exit) -if [[ "${1}" ]]; then - REP "(load-file \"${1}\")" - exit 0 -fi - -# repl loop -REP "(println (str \"Mal [\" *host-language* \"]\"))" -while true; do - READLINE "user> " || exit "$?" - [[ "${r}" ]] && REP "${r}" && echo "${r}" -done diff --git a/bash/tests/stepA_mal.mal b/bash/tests/stepA_mal.mal deleted file mode 100644 index bf3eabdb23..0000000000 --- a/bash/tests/stepA_mal.mal +++ /dev/null @@ -1,17 +0,0 @@ -;; Testing basic bash interop - -(sh* "echo 7") -;=>"7" - -(sh* "echo >&2 hello") -; hello -;=>"" - -(sh* "foo=8; echo ${foo}") -;=>"8" - -(sh* "for x in a b c; do echo -n \"X${x}Y \"; done; echo") -;=>"XaY XbY XcY" - -(sh* "for x in 1 2 3; do echo -n \"$((1+$x)) \"; done; echo") -;=>"2 3 4" diff --git a/c/Makefile b/c/Makefile deleted file mode 100644 index e51e04b245..0000000000 --- a/c/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -USE_READLINE ?= -CFLAGS += -g -LDFLAGS += -g - -##################### - -TESTS = - -SOURCES_BASE = readline.h readline.c types.h types.c \ - reader.h reader.c printer.h printer.c \ - interop.h interop.c -SOURCES_LISP = env.c core.h core.c stepA_mal.c -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - - -##################### - -SRCS = step0_repl.c step1_read_print.c step2_eval.c step3_env.c \ - step4_if_fn_do.c step5_tco.c step6_file.c step7_quote.c \ - step8_macros.c step9_try.c stepA_mal.c -OBJS = $(SRCS:%.c=%.o) -BINS = $(OBJS:%.o=%) -OTHER_OBJS = types.o readline.o reader.o printer.o env.o core.o interop.o -OTHER_HDRS = types.h readline.h reader.h printer.h core.h interop.h - -GLIB_CFLAGS ?= $(shell pkg-config --cflags glib-2.0) -GLIB_LDFLAGS ?= $(shell pkg-config --libs glib-2.0) - -ifeq (,$(USE_READLINE)) -RL_LIBRARY ?= edit -else -RL_LIBRARY ?= readline -CFLAGS += -DUSE_READLINE=1 -endif - -CFLAGS += $(GLIB_CFLAGS) -LDFLAGS += -l$(RL_LIBRARY) $(GLIB_LDFLAGS) -ldl -lffi - -##################### - -all: $(BINS) mal - -mal: $(word $(words $(BINS)),$(BINS)) - cp $< $@ - -$(OBJS) $(OTHER_OBJS): %.o: %.c $(OTHER_HDRS) - gcc $(CFLAGS) -c $(@:%.o=%.c) -o $@ - -$(patsubst %.o,%,$(filter step%,$(OBJS))): $(OTHER_OBJS) -$(BINS): %: %.o - gcc $+ -o $@ $(LDFLAGS) - -clean: - rm -f $(OBJS) $(BINS) $(OTHER_OBJS) mal - -.PHONY: stats stats-lisp tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ./$@ || exit 1; \ diff --git a/c/core.c b/c/core.c deleted file mode 100644 index 8e420e989c..0000000000 --- a/c/core.c +++ /dev/null @@ -1,511 +0,0 @@ -#include -#include -#include -#include -#include -#include - -#include "types.h" -#include "core.h" -#include "reader.h" -#include "printer.h" - -// Errors/Exceptions -void throw(MalVal *obj) { - mal_error = obj; -} - - -// General functions - -MalVal *equal_Q(MalVal *a, MalVal *b) { - if (_equal_Q(a, b)) { return &mal_true; } - else { return &mal_false; } -} - - -// Scalar functions - -MalVal *nil_Q(MalVal *seq) { return seq->type & MAL_NIL ? &mal_true : &mal_false; } -MalVal *true_Q(MalVal *seq) { return seq->type & MAL_TRUE ? &mal_true : &mal_false; } -MalVal *false_Q(MalVal *seq) { return seq->type & MAL_FALSE ? &mal_true : &mal_false; } - - -// Symbol functions - -MalVal *symbol(MalVal *args) { - assert_type(args, MAL_STRING, - "symbol called with non-string value"); - args->type = MAL_SYMBOL; // change string to symbol - return args; -} - -MalVal *symbol_Q(MalVal *seq) { - return seq->type & MAL_SYMBOL ? &mal_true : &mal_false; } - - -// Keyword functions - -MalVal *keyword(MalVal *args) { - assert_type(args, MAL_STRING, - "keyword called with non-string value"); - return malval_new_keyword(args->val.string); -} - -MalVal *keyword_Q(MalVal *seq) { - return seq->type & MAL_STRING && seq->val.string[0] == '\x7f' - ? &mal_true - : &mal_false; -} - - -// String functions - -// Return a string representation of a MalVal sequence (in a format that can -// be read by the reader). Returned string must be freed by caller. -MalVal *pr_str(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "pr_str called with non-sequential args"); - return malval_new_string(_pr_str_args(args, " ", 1)); -} - -// Return a string representation of a MalVal sequence with every item -// concatenated together. Returned string must be freed by caller. -MalVal *str(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "str called with non-sequential args"); - return malval_new_string(_pr_str_args(args, "", 0)); -} - -// Print a string representation of a MalVal sequence (in a format that can -// be read by the reader) followed by a newline. Returns nil. -MalVal *prn(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "prn called with non-sequential args"); - char *repr = _pr_str_args(args, " ", 1); - g_print("%s\n", repr); - free(repr); - return &mal_nil; -} - -// Print a string representation of a MalVal sequence (for human consumption) -// followed by a newline. Returns nil. -MalVal *println(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "println called with non-sequential args"); - char *repr = _pr_str_args(args, " ", 0); - g_print("%s\n", repr); - free(repr); - return &mal_nil; -} - -MalVal *mal_readline(MalVal *str) { - assert_type(str, MAL_STRING, "readline of non-string"); - char * line = _readline(str->val.string); - if (line) { return malval_new_string(line); } - else { return &mal_nil; } -} - -MalVal *read_string(MalVal *str) { - assert_type(str, MAL_STRING, "read_string of non-string"); - return read_str(str->val.string); -} - -char *slurp_raw(char *path) { - char *data; - struct stat fst; - int fd = open(path, O_RDONLY), - sz; - if (fd < 0) { - abort("slurp failed to open '%s'", path); - } - if (fstat(fd, &fst) < 0) { - abort("slurp failed to stat '%s'", path); - } - data = malloc(fst.st_size+1); - sz = read(fd, data, fst.st_size); - if (sz < fst.st_size) { - abort("slurp failed to read '%s'", path); - } - data[sz] = '\0'; - return data; -} -MalVal *slurp(MalVal *path) { - assert_type(path, MAL_STRING, "slurp of non-string"); - char *data = slurp_raw(path->val.string); - if (!data || mal_error) { return NULL; } - return malval_new_string(data); -} - - - - -// Number functions - -WRAP_INTEGER_OP(plus,+) -WRAP_INTEGER_OP(minus,-) -WRAP_INTEGER_OP(multiply,*) -WRAP_INTEGER_OP(divide,/) -WRAP_INTEGER_CMP_OP(gt,>) -WRAP_INTEGER_CMP_OP(gte,>=) -WRAP_INTEGER_CMP_OP(lt,<) -WRAP_INTEGER_CMP_OP(lte,<=) - -MalVal *time_ms(MalVal *_) { - struct timeval tv; - long msecs; - gettimeofday(&tv, NULL); - msecs = tv.tv_sec * 1000 + tv.tv_usec/1000.0 + 0.5; - - return malval_new_integer(msecs); -} - - -// List functions - -MalVal *list(MalVal *args) { return _list(args); } -MalVal *list_Q(MalVal *seq) { return _list_Q(seq) ? &mal_true : &mal_false; } - - -// Vector functions - -MalVal *vector(MalVal *args) { return _vector(args); } -MalVal *vector_Q(MalVal *seq) { return _vector_Q(seq) ? &mal_true : &mal_false; } - - -// Hash map functions - -MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; } - -MalVal *assoc(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "assoc called with non-sequential arguments"); - assert(_count(args) >= 2, - "assoc needs at least 2 arguments"); - GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table); - MalVal *hm = malval_new_hash_map(htable); - return _assoc_BANG(hm, _rest(args)); -} - -MalVal *dissoc(MalVal* args) { - GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table); - MalVal *hm = malval_new_hash_map(htable); - return _dissoc_BANG(hm, _rest(args)); -} - -MalVal *keys(MalVal *obj) { - assert_type(obj, MAL_HASH_MAP, - "keys called on non-hash-map"); - - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(obj))); - g_hash_table_iter_init (&iter, obj->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - } - return seq; -} - -MalVal *vals(MalVal *obj) { - assert_type(obj, MAL_HASH_MAP, - "vals called on non-hash-map"); - - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(obj))); - g_hash_table_iter_init (&iter, obj->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - g_array_append_val(seq->val.array, value); - } - return seq; -} - - -// hash map and vector functions -MalVal *get(MalVal *obj, MalVal *key) { - MalVal *val; - switch (obj->type) { - case MAL_VECTOR: - return _nth(obj, key->val.intnum); - case MAL_HASH_MAP: - if (g_hash_table_lookup_extended(obj->val.hash_table, - key->val.string, - NULL, (gpointer*)&val)) { - return val; - } else { - return &mal_nil; - } - case MAL_NIL: - return &mal_nil; - default: - abort("get called on unsupported type %d", obj->type); - } -} - -MalVal *contains_Q(MalVal *obj, MalVal *key) { - switch (obj->type) { - case MAL_VECTOR: - if (key->val.intnum < obj->val.array->len) { - return &mal_true; - } else { - return &mal_false; - } - case MAL_HASH_MAP: - if (g_hash_table_contains(obj->val.hash_table, key->val.string)) { - return &mal_true; - } else { - return &mal_false; - } - default: - abort("contains? called on unsupported type %d", obj->type); - } -} - - -// Sequence functions - -MalVal *sequential_Q(MalVal *seq) { - return _sequential_Q(seq) ? &mal_true : &mal_false; -} - -MalVal *cons(MalVal *x, MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "second argument to cons is non-sequential"); - int i, len = _count(seq); - GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - len+1); - g_array_append_val(new_arr, x); - for (i=0; ival.array, MalVal*, i)); - } - return malval_new_list(MAL_LIST, new_arr); -} - -MalVal *concat(MalVal *args) { - MalVal *arg, *e, *lst; - int i, j, arg_cnt = _count(args); - lst = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), arg_cnt)); - for (i=0; ival.array, MalVal*, i); - assert_type(arg, MAL_LIST|MAL_VECTOR, - "concat called with non-sequential"); - for (j=0; j<_count(arg); j++) { - e = g_array_index(arg->val.array, MalVal*, j); - g_array_append_val(lst->val.array, e); - } - } - return lst; -} - -MalVal *nth(MalVal *seq, MalVal *idx) { - return _nth(seq, idx->val.intnum); -} - -MalVal *empty_Q(MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "empty? called with non-sequential"); - return (seq->val.array->len == 0) ? &mal_true : &mal_false; -} - -MalVal *count(MalVal *seq) { - return malval_new_integer(_count(seq)); -} - -MalVal *sconj(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "conj called with non-sequential"); - MalVal *src_lst = _nth(args, 0); - assert_type(args, MAL_LIST|MAL_VECTOR, - "first argument to conj is non-sequential"); - int i, len = _count(src_lst) + _count(args) - 1; - GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - len); - // Copy in src_lst - for (i=0; i<_count(src_lst); i++) { - g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i)); - } - // Conj extra args - for (i=1; i<_count(args); i++) { - if (src_lst->type & MAL_LIST) { - g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i)); - } else { - g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); - } - } - return malval_new_list(src_lst->type, new_arr); -} - -MalVal *apply(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "apply called with non-sequential"); - MalVal *f = _nth(args, 0); - MalVal *last_arg = _last(args); - assert_type(last_arg, MAL_LIST|MAL_VECTOR, - "last argument to apply is non-sequential"); - int i, len = _count(args) - 2 + _count(last_arg); - GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - len); - // Initial arguments - for (i=1; i<_count(args)-1; i++) { - g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); - } - // Add arguments from last_arg - for (i=0; i<_count(last_arg); i++) { - g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i)); - } - return _apply(f, malval_new_list(MAL_LIST, new_arr)); -} - -MalVal *map(MalVal *mvf, MalVal *lst) { - MalVal *res, *el; - assert_type(mvf, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "map called with non-function"); - assert_type(lst, MAL_LIST|MAL_VECTOR, - "map called with non-sequential"); - int i, len = _count(lst); - el = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); - for (i=0; itype & MAL_FUNCTION_MAL) { - Env *fn_env = new_env(mvf->val.func.env, - mvf->val.func.args, - _slice(lst, i, i+1)); - res = mvf->val.func.evaluator(mvf->val.func.body, fn_env); - } else { - res = mvf->val.f1(g_array_index(lst->val.array, MalVal*, i)); - } - if (!res || mal_error) return NULL; - g_array_append_val(el->val.array, res); - } - return el; -} - - -// Metadata functions - -MalVal *with_meta(MalVal *obj, MalVal *meta) { - MalVal *new_obj = malval_new(obj->type, meta); - new_obj->val = obj->val; - return new_obj; -} - -MalVal *meta(MalVal *obj) { - assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_HASH_MAP| - MAL_FUNCTION_C|MAL_FUNCTION_MAL|MAL_ATOM, - "attempt to get metadata from non-collection type"); - if (obj->metadata == NULL) { - return &mal_nil; - } else { - return obj->metadata; - } -} - - -// Atoms - -MalVal *atom(MalVal *val) { - return malval_new_atom(val); -} - -MalVal *atom_Q(MalVal *exp) { return _atom_Q(exp) ? &mal_true : &mal_false; } - -MalVal *deref(MalVal *atm) { - assert_type(atm, MAL_ATOM, - "deref called on non-atom"); - return atm->val.atom_val; -} - -MalVal *reset_BANG(MalVal *atm, MalVal *val) { - assert_type(atm, MAL_ATOM, - "reset! called with non-atom"); - atm->val.atom_val = val; - return val; -} - -MalVal *swap_BANG(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "swap! called with invalid arguments"); - assert(_count(args) >= 2, - "swap! called with %d args, needs at least 2", _count(args)); - MalVal *atm = _nth(args, 0), - *f = _nth(args, 1), - *sargs = _slice(args, 2, _count(args)), - *fargs = cons(atm->val.atom_val, sargs), - *new_val = _apply(f, fargs); - if (mal_error) { return NULL; } - atm->val.atom_val = new_val; - return new_val; -} - - - -core_ns_entry core_ns[56] = { - {"=", (void*(*)(void*))equal_Q, 2}, - {"throw", (void*(*)(void*))throw, 1}, - {"nil?", (void*(*)(void*))nil_Q, 1}, - {"true?", (void*(*)(void*))true_Q, 1}, - {"false?", (void*(*)(void*))false_Q, 1}, - {"symbol", (void*(*)(void*))symbol, 1}, - {"symbol?", (void*(*)(void*))symbol_Q, 1}, - {"keyword", (void*(*)(void*))keyword, 1}, - {"keyword?", (void*(*)(void*))keyword_Q, 1}, - - {"pr-str", (void*(*)(void*))pr_str, -1}, - {"str", (void*(*)(void*))str, -1}, - {"prn", (void*(*)(void*))prn, -1}, - {"println", (void*(*)(void*))println, -1}, - {"readline", (void*(*)(void*))mal_readline, 1}, - {"read-string", (void*(*)(void*))read_string, 1}, - {"slurp", (void*(*)(void*))slurp, 1}, - {"<", (void*(*)(void*))int_lt, 2}, - {"<=", (void*(*)(void*))int_lte, 2}, - {">", (void*(*)(void*))int_gt, 2}, - {">=", (void*(*)(void*))int_gte, 2}, - {"+", (void*(*)(void*))int_plus, 2}, - {"-", (void*(*)(void*))int_minus, 2}, - {"*", (void*(*)(void*))int_multiply, 2}, - {"/", (void*(*)(void*))int_divide, 2}, - {"time-ms", (void*(*)(void*))time_ms, 0}, - - {"list", (void*(*)(void*))list, -1}, - {"list?", (void*(*)(void*))list_Q, 1}, - {"vector", (void*(*)(void*))vector, -1}, - {"vector?", (void*(*)(void*))vector_Q, 1}, - {"hash-map", (void*(*)(void*))_hash_map, -1}, - {"map?", (void*(*)(void*))hash_map_Q, 1}, - {"assoc", (void*(*)(void*))assoc, -1}, - {"dissoc", (void*(*)(void*))dissoc, -1}, - {"get", (void*(*)(void*))get, 2}, - {"contains?", (void*(*)(void*))contains_Q, 2}, - {"keys", (void*(*)(void*))keys, 1}, - {"vals", (void*(*)(void*))vals, 1}, - - {"sequential?", (void*(*)(void*))sequential_Q, 1}, - {"cons", (void*(*)(void*))cons, 2}, - {"concat", (void*(*)(void*))concat, -1}, - {"nth", (void*(*)(void*))nth, 2}, - {"first", (void*(*)(void*))_first, 1}, - {"rest", (void*(*)(void*))_rest, 1}, - {"last", (void*(*)(void*))_last, 1}, - {"empty?", (void*(*)(void*))empty_Q, 1}, - {"count", (void*(*)(void*))count, 1}, - {"conj", (void*(*)(void*))sconj, -1}, - {"apply", (void*(*)(void*))apply, -1}, - {"map", (void*(*)(void*))map, 2}, - - {"with-meta", (void*(*)(void*))with_meta, 2}, - {"meta", (void*(*)(void*))meta, 1}, - {"atom", (void*(*)(void*))atom, 1}, - {"atom?", (void*(*)(void*))atom_Q, 1}, - {"deref", (void*(*)(void*))deref, 1}, - {"reset!", (void*(*)(void*))reset_BANG, 2}, - {"swap!", (void*(*)(void*))swap_BANG, -1}, - }; diff --git a/c/core.h b/c/core.h deleted file mode 100644 index 82070ffe16..0000000000 --- a/c/core.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef __MAL_CORE__ -#define __MAL_CORE__ - -#include - -// namespace of type functions -typedef struct { - char *name; - void *(*func)(void*); - int arg_cnt; -} core_ns_entry; - -extern core_ns_entry core_ns[56]; - -#endif diff --git a/c/env.c b/c/env.c deleted file mode 100644 index 0114d1e934..0000000000 --- a/c/env.c +++ /dev/null @@ -1,62 +0,0 @@ -/* -#include -#include -#include -*/ -#include -#include "types.h" - -// Env - -Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { - Env *e = malloc(sizeof(Env)); - e->table = g_hash_table_new(g_str_hash, g_str_equal); - e->outer = outer; - - if (binds && exprs) { - assert_type(binds, MAL_LIST|MAL_VECTOR, - "new_env called with non-sequential bindings"); - assert_type(exprs, MAL_LIST|MAL_VECTOR, - "new_env called with non-sequential expressions"); - int binds_len = _count(binds), - exprs_len = _count(exprs), - varargs = 0, i; - for (i=0; i exprs_len) { break; } - if (_nth(binds, i)->val.string[0] == '&') { - varargs = 1; - env_set(e, _nth(binds, i+1), _slice(exprs, i, _count(exprs))); - break; - } else { - env_set(e, _nth(binds, i), _nth(exprs, i)); - } - } - assert(varargs || (binds_len == exprs_len), - "Arity mismatch: %d formal params vs %d actual params", - binds_len, exprs_len); - - } - return e; -} - -Env *env_find(Env *env, MalVal *key) { - void *val = g_hash_table_lookup(env->table, key->val.string); - if (val) { - return env; - } else if (env->outer) { - return env_find(env->outer, key); - } else { - return NULL; - } -} - -MalVal *env_get(Env *env, MalVal *key) { - Env *e = env_find(env, key); - assert(e, "'%s' not found", key->val.string); - return g_hash_table_lookup(e->table, key->val.string); -} - -Env *env_set(Env *env, MalVal *key, MalVal *val) { - g_hash_table_insert(env->table, key->val.string, val); - return env; -} diff --git a/c/printer.c b/c/printer.c deleted file mode 100644 index 786d89e6a9..0000000000 --- a/c/printer.c +++ /dev/null @@ -1,151 +0,0 @@ -#include -#include -#include "types.h" -#include "printer.h" - -char *_pr_str_hash_map(MalVal *obj, int print_readably) { - int start = 1; - char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL, - *key2 = NULL; - GHashTableIter iter; - gpointer key, value; - - repr = g_strdup_printf("{"); - - g_hash_table_iter_init (&iter, obj->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - //g_print ("%s/%p ", (const char *) key, (void *) value); - if (((char*)key)[0] == '\x7f') { - key2 = g_strdup_printf("%s", (char*)key); - key2[0] = ':'; - } else { - key2 = g_strdup_printf("\"%s\"", (char*)key); - } - - repr_tmp1 = _pr_str((MalVal*)value, print_readably); - if (start) { - start = 0; - repr = g_strdup_printf("{%s %s", (char*)key2, repr_tmp1); - } else { - repr_tmp2 = repr; - repr = g_strdup_printf("%s %s %s", repr_tmp2, (char*)key2, repr_tmp1); - free(repr_tmp2); - } - free(repr_tmp1); - } - repr_tmp2 = repr; - repr = g_strdup_printf("%s}", repr_tmp2); - free(repr_tmp2); - return repr; -} - -char *_pr_str_list(MalVal *obj, int print_readably, char start, char end) { - int i; - char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL; - repr = g_strdup_printf("%c", start); - for (i=0; i<_count(obj); i++) { - repr_tmp1 = _pr_str(g_array_index(obj->val.array, MalVal*, i), - print_readably); - if (i == 0) { - repr = g_strdup_printf("%c%s", start, repr_tmp1); - } else { - repr_tmp2 = repr; - repr = g_strdup_printf("%s %s", repr_tmp2, repr_tmp1); - free(repr_tmp2); - } - free(repr_tmp1); - } - repr_tmp2 = repr; - repr = g_strdup_printf("%s%c", repr_tmp2, end); - free(repr_tmp2); - return repr; -} - -// Return a string representation of the MalVal object. Returned string must -// be freed by caller. -char *_pr_str(MalVal *obj, int print_readably) { - char *repr = NULL; - if (obj == NULL) { return NULL; } - switch (obj->type) { - case MAL_NIL: - repr = g_strdup_printf("nil"); - break; - case MAL_TRUE: - repr = g_strdup_printf("true"); - break; - case MAL_FALSE: - repr = g_strdup_printf("false"); - break; - case MAL_STRING: - if (obj->val.string[0] == '\x7f') { - // Keyword - repr = g_strdup_printf("%s", obj->val.string); - repr[0] = ':'; - } else if (print_readably) { - char *repr_tmp = g_strescape(obj->val.string, ""); - repr = g_strdup_printf("\"%s\"", repr_tmp); - free(repr_tmp); - } else { - repr = g_strdup_printf("%s", obj->val.string); - } - break; - case MAL_SYMBOL: - repr = g_strdup_printf("%s", obj->val.string); - break; - case MAL_INTEGER: - repr = g_strdup_printf("%" G_GINT64_FORMAT, obj->val.intnum); - break; - case MAL_FLOAT: - repr = g_strdup_printf("%f", obj->val.floatnum); - break; - case MAL_HASH_MAP: - repr = _pr_str_hash_map(obj, print_readably); - break; - case MAL_LIST: - repr = _pr_str_list(obj, print_readably, '(', ')'); - break; - case MAL_VECTOR: - repr = _pr_str_list(obj, print_readably, '[', ']'); - break; - case MAL_ATOM: - repr = g_strdup_printf("(atom %s)", - _pr_str(obj->val.atom_val, print_readably)); - break; - case MAL_FUNCTION_C: - repr = g_strdup_printf("#", obj->val.f0); - break; - case MAL_FUNCTION_MAL: - repr = g_strdup_printf("#", - _pr_str(obj->val.func.args, print_readably), - _pr_str(obj->val.func.body, print_readably)); - break; - default: - printf("pr_str unknown type %d\n", obj->type); - repr = g_strdup_printf(""); - } - return repr; -} - -// Return a string representation of the MalVal arguments. Returned string must -// be freed by caller. -char *_pr_str_args(MalVal *args, char *sep, int print_readably) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "_pr_str called with non-sequential args"); - int i; - char *repr = g_strdup_printf("%s", ""), - *repr2 = NULL; - for (i=0; i<_count(args); i++) { - MalVal *obj = g_array_index(args->val.array, MalVal*, i); - if (i != 0) { - repr2 = repr; - repr = g_strdup_printf("%s%s", repr2, sep); - free(repr2); - } - repr2 = repr; - repr = g_strdup_printf("%s%s", - repr2, _pr_str(obj, print_readably)); - free(repr2); - } - return repr; -} - diff --git a/c/reader.c b/c/reader.c deleted file mode 100644 index ae16321688..0000000000 --- a/c/reader.c +++ /dev/null @@ -1,289 +0,0 @@ -#include -#include -#include - -//#include -//#include -#include - -#include "types.h" -#include "reader.h" - -// Declare -MalVal *read_form(Reader *reader); - -Reader *reader_new() { - Reader *reader = (Reader*)malloc(sizeof(Reader)); - reader->array = g_array_sized_new(TRUE, FALSE, sizeof(char *), 8); - reader->position = 0; - return reader; -} - -int reader_append(Reader *reader, char* token) { - g_array_append_val(reader->array, token); - return TRUE; -} - -char *reader_peek(Reader *reader) { - return g_array_index(reader->array, char*, reader->position); -} - -char *reader_next(Reader *reader) { - if (reader->position >= reader->array->len) { - return NULL; - } else { - return g_array_index(reader->array, char*, reader->position++); - } -} - -void reader_free(Reader *reader) { - int i; - for(i=0; i < reader->array->len; i++) { - free(g_array_index(reader->array, char*, i)); - } - g_array_free(reader->array, TRUE); - free(reader); -} - -Reader *tokenize(char *line) { - GRegex *regex; - GMatchInfo *matchInfo; - GError *err = NULL; - - Reader *reader = reader_new(); - - regex = g_regex_new ("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)", 0, 0, &err); - g_regex_match (regex, line, 0, &matchInfo); - - if (err != NULL) { - fprintf(stderr, "Tokenize error: %s\n", err->message); - return NULL; - } - - while (g_match_info_matches(matchInfo)) { - gchar *result = g_match_info_fetch(matchInfo, 1); - if (result[0] != '\0' && result[0] != ';') { - reader_append(reader, result); - } - g_match_info_next(matchInfo, &err); - } - g_match_info_free(matchInfo); - g_regex_unref(regex); - if (reader->array->len == 0) { - reader_free(reader); - return NULL; - } else { - return reader; - } -} - - -// From http://creativeandcritical.net/str-replace-c/ - Laird Shaw -char *replace_str(const char *str, const char *old, const char *new) -{ - char *ret, *r; - const char *p, *q; - size_t oldlen = strlen(old); - size_t count, retlen, newlen = strlen(new); - - if (oldlen != newlen) { - for (count = 0, p = str; (q = strstr(p, old)) != NULL; p = q + oldlen) - count++; - /* this is undefined if p - str > PTRDIFF_MAX */ - retlen = p - str + strlen(p) + count * (newlen - oldlen); - } else - retlen = strlen(str); - - if ((ret = malloc(retlen + 1)) == NULL) - return NULL; - - for (r = ret, p = str; (q = strstr(p, old)) != NULL; p = q + oldlen) { - /* this is undefined if q - p > PTRDIFF_MAX */ - ptrdiff_t l = q - p; - memcpy(r, p, l); - r += l; - memcpy(r, new, newlen); - r += newlen; - } - strcpy(r, p); - - return ret; -} - - -MalVal *read_atom(Reader *reader) { - char *token; - GRegex *regex; - GMatchInfo *matchInfo; - GError *err = NULL; - gint pos; - MalVal *atom; - - token = reader_next(reader); - //g_print("read_atom token: %s\n", token); - - regex = g_regex_new ("(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"(.*)\"$|:(.*)|(^[^\"]*$)", 0, 0, &err); - g_regex_match (regex, token, 0, &matchInfo); - - if (g_match_info_fetch_pos(matchInfo, 1, &pos, NULL) && pos != -1) { - //g_print("read_atom integer\n"); - atom = malval_new_integer(g_ascii_strtoll(token, NULL, 10)); - } else if (g_match_info_fetch_pos(matchInfo, 2, &pos, NULL) && pos != -1) { - //g_print("read_atom float\n"); - atom = malval_new_float(g_ascii_strtod(token, NULL)); - } else if (g_match_info_fetch_pos(matchInfo, 3, &pos, NULL) && pos != -1) { - //g_print("read_atom nil\n"); - atom = &mal_nil; - } else if (g_match_info_fetch_pos(matchInfo, 4, &pos, NULL) && pos != -1) { - //g_print("read_atom true\n"); - atom = &mal_true; - } else if (g_match_info_fetch_pos(matchInfo, 5, &pos, NULL) && pos != -1) { - //g_print("read_atom false\n"); - atom = &mal_false; - } else if (g_match_info_fetch_pos(matchInfo, 6, &pos, NULL) && pos != -1) { - //g_print("read_atom string: %s\n", token); - char *str_tmp = replace_str(g_match_info_fetch(matchInfo, 6), "\\\"", "\""); - atom = malval_new_string(str_tmp); - } else if (g_match_info_fetch_pos(matchInfo, 7, &pos, NULL) && pos != -1) { - //g_print("read_atom keyword\n"); - atom = malval_new_keyword(g_match_info_fetch(matchInfo, 7)); - } else if (g_match_info_fetch_pos(matchInfo, 8, &pos, NULL) && pos != -1) { - //g_print("read_atom symbol\n"); - atom = malval_new_symbol(g_match_info_fetch(matchInfo, 8)); - } else { - malval_free(atom); - atom = NULL; - } - return atom; -} - -MalVal *read_list(Reader *reader, MalType type, char start, char end) { - MalVal *ast, *form; - char *token = reader_next(reader); - //g_print("read_list start token: %s\n", token); - if (token[0] != start) { abort("expected '(' or '['"); } - - ast = malval_new_list(type, g_array_new(TRUE, TRUE, sizeof(MalVal*))); - - while ((token = reader_peek(reader)) && - token[0] != end) { - //g_print("read_list internal token %s\n", token); - form = read_form(reader); - if (!form) { - if (!mal_error) { abort("unknown read_list failure"); } - g_array_free(ast->val.array, TRUE); - malval_free(ast); - return NULL; - } - g_array_append_val(ast->val.array, form); - } - if (!token) { abort("expected ')' or ']', got EOF"); } - reader_next(reader); - //g_print("read_list end token: %s\n", token); - return ast; -} - -MalVal *read_hash_map(Reader *reader) { - MalVal *lst = read_list(reader, MAL_LIST, '{', '}'); - MalVal *hm = _hash_map(lst); - malval_free(lst); - return hm; -} - - -MalVal *read_form(Reader *reader) { - char *token; - MalVal *form = NULL, *tmp; - -// while(token = reader_next(reader)) { -// printf("token: %s\n", token); -// } -// return NULL; - - token = reader_peek(reader); - - if (!token) { return NULL; } - //g_print("read_form token: %s\n", token); - - switch (token[0]) { - case ';': - abort("comments not yet implemented"); - break; - case '\'': - reader_next(reader); - form = _listX(2, malval_new_symbol("quote"), - read_form(reader)); - break; - case '`': - reader_next(reader); - form = _listX(2, malval_new_symbol("quasiquote"), - read_form(reader)); - break; - case '~': - reader_next(reader); - if (token[1] == '@') { - form = _listX(2, malval_new_symbol("splice-unquote"), - read_form(reader)); - } else { - form = _listX(2, malval_new_symbol("unquote"), - read_form(reader)); - }; - break; - case '^': - reader_next(reader); - MalVal *meta = read_form(reader); - form = _listX(3, malval_new_symbol("with-meta"), - read_form(reader), meta); - break; - case '@': - reader_next(reader); - form = _listX(2, malval_new_symbol("deref"), - read_form(reader)); - break; - - - // list - case ')': - abort("unexpected ')'"); - break; - case '(': - form = read_list(reader, MAL_LIST, '(', ')'); - break; - - // vector - case ']': - abort("unexpected ']'"); - break; - case '[': - form = read_list(reader, MAL_VECTOR, '[', ']'); - break; - - // hash-map - case '}': - abort("unexpected '}'"); - break; - case '{': - form = read_hash_map(reader); - break; - - default: - form = read_atom(reader); - break; - } - return form; - -} - -MalVal *read_str (char *str) { - Reader *reader; - char *token; - MalVal *ast = NULL; - - reader = tokenize(str); - if (reader) { - ast = read_form(reader); - reader_free(reader); - } - - return ast; -} diff --git a/c/readline.c b/c/readline.c deleted file mode 100644 index b981ee7482..0000000000 --- a/c/readline.c +++ /dev/null @@ -1,69 +0,0 @@ -#include -#include -#include - -#if USE_READLINE - #include - #include - #include -#else - #include - #include -#endif - -int history_loaded = 0; - -char HISTORY_FILE[] = "~/.mal-history"; - -int load_history() { - if (history_loaded) { return 0; } - int ret; - char *hf = tilde_expand(HISTORY_FILE); - if (access(hf, F_OK) != -1) { - // TODO: check if file exists first, use non-static path -#if USE_READLINE - ret = read_history(hf); -#else - FILE *fp = fopen(hf, "r"); - char *line = malloc(80); // getline reallocs as necessary - size_t sz = 80; - while ((ret = getline(&line, &sz, fp)) > 0) { - add_history(line); // Add line to in-memory history - } - free(line); - fclose(fp); -#endif - history_loaded = 1; - } - free(hf); -} - -int append_to_history() { - char *hf = tilde_expand(HISTORY_FILE); -#ifdef USE_READLINE - append_history(1, hf); -#else - HIST_ENTRY *he = history_get(history_length-1); - FILE *fp = fopen(hf, "a"); - fprintf(fp, "%s\n", he->line); - fclose(fp); -#endif - free(hf); -} - - -// line must be freed by caller -char *_readline (char prompt[]) { - char *line; - - load_history(); - - line = readline(prompt); - if (!line) return NULL; // EOF - add_history(line); // Add input to in-memory history - - append_to_history(); // Flush new line of history to disk - - return line; -} - diff --git a/c/step0_repl.c b/c/step0_repl.c deleted file mode 100644 index f6d8048ddf..0000000000 --- a/c/step0_repl.c +++ /dev/null @@ -1,44 +0,0 @@ -#include -#include -#include - -#ifdef USE_READLINE - #include - #include -#else - #include -#endif - -char *READ(char prompt[]) { - char *line; - line = readline(prompt); - if (!line) return NULL; // EOF - add_history(line); // Add input to history. - return line; -} - -char *EVAL(char *ast, void *env) { - return ast; -} - -char *PRINT(char *exp) { - return exp; -} - -int main() -{ - char *ast, *exp; - char prompt[100]; - - // Set the initial prompt - snprintf(prompt, sizeof(prompt), "user> "); - - for(;;) { - ast = READ(prompt); - if (!ast) return 0; - exp = EVAL(ast, NULL); - g_print("%s\n", PRINT(exp)); - - free(ast); // Free input string - } -} diff --git a/c/step1_read_print.c b/c/step1_read_print.c deleted file mode 100644 index 264528d26c..0000000000 --- a/c/step1_read_print.c +++ /dev/null @@ -1,82 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -MalVal *EVAL(MalVal *ast, GHashTable *env) { - if (!ast || mal_error) return NULL; - return ast; -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(GHashTable *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -int main() -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt - snprintf(prompt, sizeof(prompt), "user> "); - - // repl loop - for(;;) { - exp = RE(NULL, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step2_eval.c b/c/step2_eval.c deleted file mode 100644 index 39b27894e2..0000000000 --- a/c/step2_eval.c +++ /dev/null @@ -1,152 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" - -// Declarations -MalVal *EVAL(MalVal *ast, GHashTable *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -MalVal *eval_ast(MalVal *ast, GHashTable *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - // TODO: check if not found - return g_hash_table_lookup(env, ast->val.string); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, GHashTable *env) { - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - if (_count(ast) == 0) { return ast; } - MalVal *a0 = _nth(ast, 0); - assert_type(a0, MAL_SYMBOL, "Cannot invoke %s", _pr_str(a0,1)); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); - //g_print("eval_invoke el: %s\n", _pr_str(el,1)); - return f(_nth(el, 1), _nth(el, 2)); -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(GHashTable *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -GHashTable *repl_env; - - -void init_repl_env() { - repl_env = g_hash_table_new(g_str_hash, g_str_equal); - - WRAP_INTEGER_OP(plus,+) - WRAP_INTEGER_OP(minus,-) - WRAP_INTEGER_OP(multiply,*) - WRAP_INTEGER_OP(divide,/) - - g_hash_table_insert(repl_env, "+", int_plus); - g_hash_table_insert(repl_env, "-", int_minus); - g_hash_table_insert(repl_env, "*", int_multiply); - g_hash_table_insert(repl_env, "/", int_divide); -} - -int main() -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(); - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step3_env.c b/c/step3_env.c deleted file mode 100644 index cacf9d7249..0000000000 --- a/c/step3_env.c +++ /dev/null @@ -1,177 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - int i, len; - if (_count(ast) == 0) { return ast; } - MalVal *a0 = _nth(ast, 0); - assert_type(a0, MAL_SYMBOL, "Cannot apply %s", _pr_str(a0,1)); - if (strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - env_set(env, a1, res); - return res; - } else if (strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - return EVAL(a2, let_env); - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); - return f(_nth(el, 1), _nth(el, 2)); - } -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env() { - repl_env = new_env(NULL, NULL, NULL); - - WRAP_INTEGER_OP(plus,+) - WRAP_INTEGER_OP(minus,-) - WRAP_INTEGER_OP(multiply,*) - WRAP_INTEGER_OP(divide,/) - - env_set(repl_env, malval_new_symbol("+"), (MalVal *)int_plus); - env_set(repl_env, malval_new_symbol("-"), (MalVal *)int_minus); - env_set(repl_env, malval_new_symbol("*"), (MalVal *)int_multiply); - env_set(repl_env, malval_new_symbol("/"), (MalVal *)int_divide); -} - -int main() -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(); - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step4_if_fn_do.c b/c/step4_if_fn_do.c deleted file mode 100644 index 413bcd6b62..0000000000 --- a/c/step4_if_fn_do.c +++ /dev/null @@ -1,216 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - int i, len; - if (_count(ast) == 0) { return ast; } - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - return EVAL(a2, let_env); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - MalVal *el = eval_ast(_rest(ast), env); - return _last(el); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - if (ast->val.array->len > 3) { - return EVAL(_nth(ast, 3), env); - } else { - return &mal_nil; - } - } else { - // eval true slot form - MalVal *a2 = _nth(ast, 2); - return EVAL(a2, env); - } - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - return _apply(f, args); - } -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env() { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); -} - -int main() -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(); - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step5_tco.c b/c/step5_tco.c deleted file mode 100644 index a1762c8abf..0000000000 --- a/c/step5_tco.c +++ /dev/null @@ -1,229 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - int i, len; - if (_count(ast) == 0) { return ast; } - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - if (ast->val.array->len > 3) { - ast = _nth(ast, 3); - } else { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env() { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); -} - -int main() -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(); - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step6_file.c b/c/step6_file.c deleted file mode 100644 index 409e221c3c..0000000000 --- a/c/step6_file.c +++ /dev/null @@ -1,248 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - int i, len; - if (_count(ast) == 0) { return ast; } - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - if (ast->val.array->len > 3) { - ast = _nth(ast, 3); - } else { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env(int argc, char *argv[]) { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } - env_set(repl_env, - malval_new_symbol("eval"), - malval_new_function((void*(*)(void *))do_eval, 1)); - - MalVal *_argv = _listX(0); - for (i=2; i < argc; i++) { - MalVal *arg = malval_new_string(argv[i]); - g_array_append_val(_argv->val.array, arg); - } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "", - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -} - -int main(int argc, char *argv[]) -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(argc, argv); - - if (argc > 1) { - char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); - RE(repl_env, "", cmd); - return 0; - } - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step7_quote.c b/c/step7_quote.c deleted file mode 100644 index 73250e38df..0000000000 --- a/c/step7_quote.c +++ /dev/null @@ -1,285 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); -} - -MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); - } -} - -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - int i, len; - if (_count(ast) == 0) { return ast; } - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quote", a0->val.string) == 0) { - //g_print("eval apply quote\n"); - return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquote", a0->val.string) == 0) { - //g_print("eval apply quasiquote\n"); - MalVal *a1 = _nth(ast, 1); - ast = quasiquote(a1); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - if (ast->val.array->len > 3) { - ast = _nth(ast, 3); - } else { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env(int argc, char *argv[]) { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } - env_set(repl_env, - malval_new_symbol("eval"), - malval_new_function((void*(*)(void *))do_eval, 1)); - - MalVal *_argv = _listX(0); - for (i=2; i < argc; i++) { - MalVal *arg = malval_new_string(argv[i]); - g_array_append_val(_argv->val.array, arg); - } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "", - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -} - -int main(int argc, char *argv[]) -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(argc, argv); - - if (argc > 1) { - char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); - RE(repl_env, "", cmd); - return 0; - } - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step8_macros.c b/c/step8_macros.c deleted file mode 100644 index 55c6988f41..0000000000 --- a/c/step8_macros.c +++ /dev/null @@ -1,327 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); -MalVal *macroexpand(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); -} - -MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); - } -} - -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0) && - env_get(env, a0)->ismacro; -} - -MalVal *macroexpand(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} - -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { return ast; } - if (_count(ast) == 0) { return ast; } - - int i, len; - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quote", a0->val.string) == 0) { - //g_print("eval apply quote\n"); - return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquote", a0->val.string) == 0) { - //g_print("eval apply quasiquote\n"); - MalVal *a1 = _nth(ast, 1); - ast = quasiquote(a1); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("defmacro!", a0->val.string) == 0) { - //g_print("eval apply defmacro!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - res->ismacro = TRUE; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - if (ast->val.array->len > 3) { - ast = _nth(ast, 3); - } else { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->ismacro = FALSE; - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env(int argc, char *argv[]) { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } - env_set(repl_env, - malval_new_symbol("eval"), - malval_new_function((void*(*)(void *))do_eval, 1)); - - MalVal *_argv = _listX(0); - for (i=2; i < argc; i++) { - MalVal *arg = malval_new_string(argv[i]); - g_array_append_val(_argv->val.array, arg); - } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "", - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); -} - -int main(int argc, char *argv[]) -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(argc, argv); - - if (argc > 1) { - char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); - RE(repl_env, "", cmd); - return 0; - } - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/step9_try.c b/c/step9_try.c deleted file mode 100644 index ffba2f96ef..0000000000 --- a/c/step9_try.c +++ /dev/null @@ -1,349 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" -#include "interop.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); -MalVal *macroexpand(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); -} - -MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); - } -} - -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0) && - env_get(env, a0)->ismacro; -} - -MalVal *macroexpand(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} - -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { return ast; } - if (_count(ast) == 0) { return ast; } - - int i, len; - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quote", a0->val.string) == 0) { - //g_print("eval apply quote\n"); - return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquote", a0->val.string) == 0) { - //g_print("eval apply quasiquote\n"); - MalVal *a1 = _nth(ast, 1); - ast = quasiquote(a1); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("defmacro!", a0->val.string) == 0) { - //g_print("eval apply defmacro!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - res->ismacro = TRUE; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("try*", a0->val.string) == 0) { - //g_print("eval apply try*\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *a2 = _nth(ast, 2); - MalVal *res = EVAL(a1, env); - if (!mal_error) { return res; } - MalVal *a20 = _nth(a2, 0); - if (strcmp("catch*", a20->val.string) == 0) { - MalVal *a21 = _nth(a2, 1); - MalVal *a22 = _nth(a2, 2); - Env *catch_env = new_env(env, - _listX(1, a21), - _listX(1, mal_error)); - //malval_free(mal_error); - mal_error = NULL; - res = EVAL(a22, catch_env); - return res; - } else { - return &mal_nil; - } - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - if (ast->val.array->len > 3) { - ast = _nth(ast, 3); - } else { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->ismacro = FALSE; - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env(int argc, char *argv[]) { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } - env_set(repl_env, - malval_new_symbol("eval"), - malval_new_function((void*(*)(void *))do_eval, 1)); - - MalVal *_argv = _listX(0); - for (i=2; i < argc; i++) { - MalVal *arg = malval_new_string(argv[i]); - g_array_append_val(_argv->val.array, arg); - } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "", - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); -} - -int main(int argc, char *argv[]) -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(argc, argv); - - if (argc > 1) { - char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); - RE(repl_env, "", cmd); - return 0; - } - - // repl loop - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/stepA_mal.c b/c/stepA_mal.c deleted file mode 100644 index 05e9f65109..0000000000 --- a/c/stepA_mal.c +++ /dev/null @@ -1,356 +0,0 @@ -#include -#include -#include - -#include "types.h" -#include "readline.h" -#include "reader.h" -#include "core.h" -#include "interop.h" - -// Declarations -MalVal *EVAL(MalVal *ast, Env *env); -MalVal *macroexpand(MalVal *ast, Env *env); - -// read -MalVal *READ(char prompt[], char *str) { - char *line; - MalVal *ast; - if (str) { - line = str; - } else { - line = _readline(prompt); - if (!line) { - _error("EOF"); - return NULL; - } - } - ast = read_str(line); - if (!str) { free(line); } - return ast; -} - -// eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); -} - -MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); - } -} - -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0) && - env_get(env, a0)->ismacro; -} - -MalVal *macroexpand(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} - -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - if (ast->type == MAL_SYMBOL) { - //g_print("EVAL symbol: %s\n", ast->val.string); - return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { - //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); - MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); - if (!el || mal_error) return NULL; - el->type = ast->type; - return el; - } else if (ast->type == MAL_HASH_MAP) { - //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(ast))); - g_hash_table_iter_init (&iter, ast->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - MalVal *new_val = EVAL((MalVal *)value, env); - g_array_append_val(seq->val.array, new_val); - } - return _hash_map(seq); - } else { - //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); - return ast; - } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; - - // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { return ast; } - if (_count(ast) == 0) { return ast; } - - int i, len; - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("def!", a0->val.string) == 0) { - //g_print("eval apply def!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("let*", a0->val.string) == 0) { - //g_print("eval apply let*\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2), - *key, *val; - assert_type(a1, MAL_LIST|MAL_VECTOR, - "let* bindings must be list or vector"); - len = _count(a1); - assert((len % 2) == 0, "odd number of let* bindings forms"); - Env *let_env = new_env(env, NULL, NULL); - for(i=0; ival.array, MalVal*, i); - val = g_array_index(a1->val.array, MalVal*, i+1); - assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); - } - ast = a2; - env = let_env; - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quote", a0->val.string) == 0) { - //g_print("eval apply quote\n"); - return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquote", a0->val.string) == 0) { - //g_print("eval apply quasiquote\n"); - MalVal *a1 = _nth(ast, 1); - ast = quasiquote(a1); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("defmacro!", a0->val.string) == 0) { - //g_print("eval apply defmacro!\n"); - MalVal *a1 = _nth(ast, 1), - *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); - if (mal_error) return NULL; - res->ismacro = TRUE; - env_set(env, a1, res); - return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); - } else if ((a0->type & MAL_SYMBOL) && - strcmp(".", a0->val.string) == 0) { - //g_print("eval apply .\n"); - MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env); - return invoke_native(el); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("try*", a0->val.string) == 0) { - //g_print("eval apply try*\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *a2 = _nth(ast, 2); - MalVal *res = EVAL(a1, env); - if (!mal_error) { return res; } - MalVal *a20 = _nth(a2, 0); - if (strcmp("catch*", a20->val.string) == 0) { - MalVal *a21 = _nth(a2, 1); - MalVal *a22 = _nth(a2, 2); - Env *catch_env = new_env(env, - _listX(1, a21), - _listX(1, mal_error)); - //malval_free(mal_error); - mal_error = NULL; - res = EVAL(a22, catch_env); - return res; - } else { - return &mal_nil; - } - } else if ((a0->type & MAL_SYMBOL) && - strcmp("do", a0->val.string) == 0) { - //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); - ast = _last(ast); - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("if", a0->val.string) == 0) { - //g_print("eval apply if\n"); - MalVal *a1 = _nth(ast, 1); - MalVal *cond = EVAL(a1, env); - if (!cond || mal_error) return NULL; - if (cond->type & (MAL_FALSE|MAL_NIL)) { - // eval false slot form - if (ast->val.array->len > 3) { - ast = _nth(ast, 3); - } else { - return &mal_nil; - } - } else { - // eval true slot form - ast = _nth(ast, 2); - } - // Continue loop - } else if ((a0->type & MAL_SYMBOL) && - strcmp("fn*", a0->val.string) == 0) { - //g_print("eval apply fn*\n"); - MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); - mf->ismacro = FALSE; - mf->val.func.evaluator = EVAL; - mf->val.func.args = _nth(ast, 1); - mf->val.func.body = _nth(ast, 2); - mf->val.func.env = env; - return mf; - } else { - //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "cannot apply '%s'", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - ast = f->val.func.body; - env = new_env(f->val.func.env, f->val.func.args, args); - // Continue loop - } else { - return _apply(f, args); - } - } - - } // TCO while loop -} - -// print -char *PRINT(MalVal *exp) { - if (mal_error) { - fprintf(stderr, "Error: %s\n", mal_error->val.string); - malval_free(mal_error); - mal_error = NULL; - return NULL; - } - return _pr_str(exp,1); -} - -// repl - -// read and eval -MalVal *RE(Env *env, char *prompt, char *str) { - MalVal *ast, *exp; - ast = READ(prompt, str); - if (!ast || mal_error) return NULL; - exp = EVAL(ast, env); - if (ast != exp) { - malval_free(ast); // Free input structure - } - return exp; -} - -// Setup the initial REPL environment -Env *repl_env; - -void init_repl_env(int argc, char *argv[]) { - repl_env = new_env(NULL, NULL, NULL); - - // core.c: defined using C - int i; - for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), - malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); - } - MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } - env_set(repl_env, - malval_new_symbol("eval"), - malval_new_function((void*(*)(void *))do_eval, 1)); - - MalVal *_argv = _listX(0); - for (i=2; i < argc; i++) { - MalVal *arg = malval_new_string(argv[i]); - g_array_append_val(_argv->val.array, arg); - } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE(repl_env, "", "(def! *host-language* \"c\")"); - RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "", - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); -} - -int main(int argc, char *argv[]) -{ - MalVal *exp; - char *output; - char prompt[100]; - - // Set the initial prompt and environment - snprintf(prompt, sizeof(prompt), "user> "); - init_repl_env(argc, argv); - - if (argc > 1) { - char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); - RE(repl_env, "", cmd); - return 0; - } - - // repl loop - RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))"); - for(;;) { - exp = RE(repl_env, prompt, NULL); - if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { - return 0; - } - output = PRINT(exp); - - if (output) { - g_print("%s\n", output); - free(output); // Free output string - } - - //malval_free(exp); // Free evaluated expression - } -} diff --git a/c/types.c b/c/types.c deleted file mode 100644 index a6c84929f1..0000000000 --- a/c/types.c +++ /dev/null @@ -1,473 +0,0 @@ -#include -#include -#include -#include -#include "types.h" -#include "printer.h" - - -// Errors/Exceptions - -MalVal *mal_error = NULL; // WARNGIN: global state -void _error(const char *fmt, ...) { - va_list args; - va_start(args, fmt); - mal_error = malval_new_string(g_strdup_vprintf(fmt, args)); -} - -// Constant atomic values - -MalVal mal_nil = {MAL_NIL, NULL, {0}, 0}; -MalVal mal_true = {MAL_TRUE, NULL, {0}, 0}; -MalVal mal_false = {MAL_FALSE, NULL, {0}, 0}; - - -// General Functions - -// Print a hash table -#include -void g_hash_table_print(GHashTable *hash_table) { - GHashTableIter iter; - gpointer key, value; - - g_hash_table_iter_init (&iter, hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - g_print ("%s/%p ", (const char *) key, (void *) value); - //g_print ("%s ", (const char *) key); - } -} - -GHashTable *g_hash_table_copy(GHashTable *src_table) { - GHashTable *new_table = g_hash_table_new(g_str_hash, g_str_equal); - GHashTableIter iter; - gpointer key, value; - - g_hash_table_iter_init (&iter, src_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - g_hash_table_insert(new_table, key, value); - } - return new_table; -} - -int min(int a, int b) { return a < b ? a : b; } -int max(int a, int b) { return a > b ? a : b; } - -int _count(MalVal *obj) { - switch (obj->type) { - case MAL_NIL: return 0; - case MAL_LIST: return obj->val.array->len; - case MAL_VECTOR: return obj->val.array->len; - case MAL_HASH_MAP: return g_hash_table_size(obj->val.hash_table); - case MAL_STRING: return strlen(obj->val.string); - default: - _error("count unsupported for type %d\n", obj->type); - return 0; - } -} - -// Allocate a malval and set its type and value -MalVal *malval_new(MalType type, MalVal *metadata) { - MalVal *mv = (MalVal*)malloc(sizeof(MalVal)); - mv->type = type; - mv->metadata = metadata; - return mv; -} - -// -int malval_free(MalVal *mv) { - // TODO: free collection items - if (!(mv->type & (MAL_NIL|MAL_TRUE|MAL_FALSE))) { - free(mv); - } -} - -MalVal *malval_new_integer(gint64 val) { - MalVal *mv = malval_new(MAL_INTEGER, NULL); - mv->val.intnum = val; - return mv; -} - -MalVal *malval_new_float(gdouble val) { - MalVal *mv = malval_new(MAL_FLOAT, NULL); - mv->val.floatnum = val; - return mv; -} - -MalVal *malval_new_string(char *val) { - MalVal *mv = malval_new(MAL_STRING, NULL); - mv->val.string = val; - return mv; -} - -MalVal *malval_new_symbol(char *val) { - MalVal *mv = malval_new(MAL_SYMBOL, NULL); - mv->val.string = val; - return mv; -} - -MalVal *malval_new_keyword(char *val) { - MalVal *mv = malval_new(MAL_STRING, NULL); - mv->val.string = g_strdup_printf("\x7f%s", val); - return mv; -} - -MalVal *malval_new_list(MalType type, GArray *val) { - MalVal *mv = malval_new(type, NULL); - mv->val.array = val; - return mv; -} - -MalVal *malval_new_hash_map(GHashTable *val) { - MalVal *mv = malval_new(MAL_HASH_MAP, NULL); - mv->val.hash_table = val; - return mv; -} - -MalVal *malval_new_atom(MalVal *val) { - MalVal *mv = malval_new(MAL_ATOM, NULL); - mv->val.atom_val = val; - return mv; -} - - -MalVal *malval_new_function(void *(*func)(void *), int arg_cnt) { - MalVal *mv = malval_new(MAL_FUNCTION_C, NULL); - mv->func_arg_cnt = arg_cnt; - assert(mv->func_arg_cnt <= 20, - "native function restricted to 20 args (%d given)", - mv->func_arg_cnt); - mv->ismacro = FALSE; - switch (arg_cnt) { - case -1: mv->val.f1 = (void *(*)(void*))func; break; - case 0: mv->val.f0 = (void *(*)())func; break; - case 1: mv->val.f1 = (void *(*)(void*))func; break; - case 2: mv->val.f2 = (void *(*)(void*,void*))func; break; - case 3: mv->val.f3 = (void *(*)(void*,void*,void*))func; break; - case 4: mv->val.f4 = (void *(*)(void*,void*,void*,void*))func; break; - case 5: mv->val.f5 = (void *(*)(void*,void*,void*,void*,void*))func; break; - case 6: mv->val.f6 = (void *(*)(void*,void*,void*,void*,void*, - void*))func; break; - case 7: mv->val.f7 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*))func; break; - case 8: mv->val.f8 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*))func; break; - case 9: mv->val.f9 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*))func; break; - case 10: mv->val.f10 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*))func; break; - case 11: mv->val.f11 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*))func; break; - case 12: mv->val.f12 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*))func; break; - case 13: mv->val.f13 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*))func; break; - case 14: mv->val.f14 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*))func; break; - case 15: mv->val.f15 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*))func; break; - case 16: mv->val.f16 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*))func; break; - case 17: mv->val.f17 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*))func; break; - case 18: mv->val.f18 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*))func; break; - case 19: mv->val.f19 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*))func; break; - case 20: mv->val.f20 = (void *(*)(void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*))func; break; - } - return mv; -} - -MalVal *_apply(MalVal *f, MalVal *args) { - MalVal *res; - assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "Cannot invoke %s", _pr_str(f,1)); - if (f->type & MAL_FUNCTION_MAL) { - Env *fn_env = new_env(f->val.func.env, f->val.func.args, args); - res = f->val.func.evaluator(f->val.func.body, fn_env); - return res; - } else { - MalVal *a = args; - assert((f->func_arg_cnt == -1) || - (f->func_arg_cnt == _count(args)), - "Length of formal params (%d) does not match actual parameters (%d)", - f->func_arg_cnt, _count(args)); - switch (f->func_arg_cnt) { - case -1: res=f->val.f1 (a); break; - case 0: res=f->val.f0 (); break; - case 1: res=f->val.f1 (_nth(a,0)); break; - case 2: res=f->val.f2 (_nth(a,0),_nth(a,1)); break; - case 3: res=f->val.f3 (_nth(a,0),_nth(a,1),_nth(a,2)); break; - case 4: res=f->val.f4 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3)); break; - case 5: res=f->val.f5 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4)); break; - case 6: res=f->val.f6 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5)); break; - case 7: res=f->val.f7 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6)); break; - case 8: res=f->val.f8 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7)); break; - case 9: res=f->val.f9 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8)); break; - case 10: res=f->val.f10(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9)); break; - case 11: res=f->val.f11(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10)); break; - case 12: res=f->val.f12(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11)); break; - case 13: res=f->val.f13(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12)); break; - case 14: res=f->val.f14(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13)); break; - case 15: res=f->val.f15(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14)); break; - case 16: res=f->val.f16(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), - _nth(a,15)); break; - case 17: res=f->val.f17(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), - _nth(a,15),_nth(a,16)); break; - case 18: res=f->val.f18(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), - _nth(a,15),_nth(a,16),_nth(a,17)); break; - case 19: res=f->val.f19(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), - _nth(a,15),_nth(a,16),_nth(a,17),_nth(a,18)); break; - case 20: res=f->val.f20(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), - _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), - _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), - _nth(a,15),_nth(a,16),_nth(a,17),_nth(a,18),_nth(a,19)); break; - } - return res; - } -} - - -int _equal_Q(MalVal *a, MalVal *b) { - if (a == NULL || b == NULL) { return FALSE; } - - // If types are the same or both are sequential then they might be equal - if (!((a->type == b->type) || - (_sequential_Q(a) && _sequential_Q(b)))) { - return FALSE; - } - switch (a->type) { - case MAL_NIL: - case MAL_TRUE: - case MAL_FALSE: - return a->type == b->type; - case MAL_INTEGER: - return a->val.intnum == b->val.intnum; - case MAL_FLOAT: - return a->val.floatnum == b->val.floatnum; - case MAL_SYMBOL: - case MAL_STRING: - if (strcmp(a->val.string, b->val.string) == 0) { - return TRUE; - } else { - return FALSE; - } - case MAL_LIST: - case MAL_VECTOR: - if (a->val.array->len != b->val.array->len) { - return FALSE; - } - int i; - for (i=0; ival.array->len; i++) { - if (! _equal_Q(g_array_index(a->val.array, MalVal*, i), - g_array_index(b->val.array, MalVal*, i))) { - return FALSE; - } - } - return TRUE; - case MAL_HASH_MAP: - _error("_equal_Q does not support hash-maps yet"); - return FALSE; - case MAL_FUNCTION_C: - case MAL_FUNCTION_MAL: - return a->val.f0 == b->val.f0; - default: - _error("_equal_Q unsupported comparison type %d\n", a->type); - return FALSE; - } -} - - -// Lists -MalVal *_listX(int count, ...) { - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - count)); - MalVal *v; - va_list ap; - va_start(ap, count); - while (count-- > 0) { - v = va_arg(ap, MalVal*); - g_array_append_val(seq->val.array, v); - } - va_end(ap); - return seq; -} - -MalVal *_list(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "list called with invalid arguments"); - args->type = MAL_LIST; - return args; -} - -int _list_Q(MalVal *seq) { - return seq->type & MAL_LIST; -} - - -// Vectors -MalVal *_vector(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "vector called with invalid arguments"); - args->type = MAL_VECTOR; - return args; -} - -int _vector_Q(MalVal *seq) { - return seq->type & MAL_VECTOR; -} - - -// Hash maps -MalVal *_hash_map(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "hash-map called with non-sequential arguments"); - GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal); - MalVal *hm = malval_new_hash_map(htable); - return _assoc_BANG(hm, args); -} - -int _hash_map_Q(MalVal *seq) { - return seq->type & MAL_HASH_MAP; -} - -MalVal *_assoc_BANG(MalVal* hm, MalVal *args) { - assert((_count(args) % 2) == 0, - "odd number of parameters to assoc!"); - GHashTable *htable = hm->val.hash_table; - int i; - MalVal *k, *v; - for (i=0; i<_count(args); i+=2) { - k = g_array_index(args->val.array, MalVal*, i); - assert_type(k, MAL_STRING, - "assoc! called with non-string key"); - v = g_array_index(args->val.array, MalVal*, i+1); - g_hash_table_insert(htable, k->val.string, v); - } - return hm; -} - -MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) { - GHashTable *htable = hm->val.hash_table; - int i; - MalVal *k, *v; - for (i=0; i<_count(args); i++) { - k = g_array_index(args->val.array, MalVal*, i); - assert_type(k, MAL_STRING, - "dissoc! called with non-string key"); - g_hash_table_remove(htable, k->val.string); - } - return hm; -} - - -// Atoms -int _atom_Q(MalVal *exp) { - return exp->type & MAL_ATOM; -} - - -// Sequence functions -MalVal *_slice(MalVal *seq, int start, int end) { - int i, new_len = max(0, min(end-start, - _count(seq)-start)); - GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - new_len); - for (i=start; ival.array, MalVal*, i)); - } - return malval_new_list(MAL_LIST, new_arr); -} - - -int _sequential_Q(MalVal *seq) { - return seq->type & (MAL_LIST|MAL_VECTOR); -} - -MalVal *_nth(MalVal *seq, int idx) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "_nth called with non-sequential"); - if (idx >= _count(seq)) { - abort("nth: index out of range"); - } - return g_array_index(seq->val.array, MalVal*, idx); -} - -MalVal *_first(MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "_first called with non-sequential"); - if (_count(seq) == 0) { - return &mal_nil; - } - return g_array_index(seq->val.array, MalVal*, 0); -} - -MalVal *_last(MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "_last called with non-sequential"); - if (_count(seq) == 0) { - return &mal_nil; - } - return g_array_index(seq->val.array, MalVal*, _count(seq)-1); -} - - -MalVal *_rest(MalVal *seq) { - return _slice(seq, 1, _count(seq)); -} - - -MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) { - MalVal *e, *el; - assert_type(lst, MAL_LIST|MAL_VECTOR, - "_map called with non-sequential"); - int i, len = _count(lst); - el = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); - for (i=0; ival.array, MalVal*, i), arg2); - if (!e || mal_error) return NULL; - g_array_append_val(el->val.array, e); - } - return el; -} diff --git a/c/types.h b/c/types.h deleted file mode 100644 index 80a40ac794..0000000000 --- a/c/types.h +++ /dev/null @@ -1,169 +0,0 @@ -#ifndef __MAL_TYPES__ -#define __MAL_TYPES__ - -#include - - -struct MalVal; // pre-declare - - -// Env (implentation in env.c) - -typedef struct Env { - struct Env *outer; - GHashTable *table; -} Env; - -Env *new_env(Env *outer, struct MalVal* binds, struct MalVal *exprs); -Env *env_find(Env *env, struct MalVal *key); -struct MalVal *env_get(Env *env, struct MalVal *key); -Env *env_set(Env *env, struct MalVal *key, struct MalVal *val); - - -// Utility functiosn -void g_hash_table_print(GHashTable *hash_table); -GHashTable *g_hash_table_copy(GHashTable *src_table); - - -// Errors/exceptions - -extern struct MalVal *mal_error; -void _error(const char *fmt, ...); - -#define abort(format, ...) \ - { _error(format, ##__VA_ARGS__); return NULL; } - -#define assert(test, format, ...) \ - if (!(test)) { \ - _error(format, ##__VA_ARGS__); \ - return NULL; \ - } - -#define assert_type(mv, typ, format, ...) \ - if (!(mv->type & (typ))) { \ - _error(format, ##__VA_ARGS__); \ - return NULL; \ - } - - -typedef enum { - MAL_NIL = 1, - MAL_TRUE = 2, - MAL_FALSE = 4, - MAL_INTEGER = 8, - MAL_FLOAT = 16, - MAL_SYMBOL = 32, - MAL_STRING = 64, - MAL_LIST = 128, - MAL_VECTOR = 256, - MAL_HASH_MAP = 512, - MAL_ATOM = 1024, - MAL_FUNCTION_C = 2048, - MAL_FUNCTION_MAL = 4096, -} MalType; - -typedef struct MalVal { - MalType type; - struct MalVal *metadata; - union { - gint64 intnum; - gdouble floatnum; - char *string; - GArray *array; - GHashTable *hash_table; - struct MalVal *atom_val; - void *(*f0) (); - void *(*f1) (void*); - void *(*f2) (void*,void*); - void *(*f3) (void*,void*,void*); - void *(*f4) (void*,void*,void*,void*); - void *(*f5) (void*,void*,void*,void*,void*); - void *(*f6) (void*,void*,void*,void*,void*,void*); - void *(*f7) (void*,void*,void*,void*,void*,void*,void*); - void *(*f8) (void*,void*,void*,void*,void*,void*,void*,void*); - void *(*f9) (void*,void*,void*,void*,void*,void*,void*,void*,void*); - void *(*f10)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*); - void *(*f11)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*); - void *(*f12)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*); - void *(*f13)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*); - void *(*f14)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*,void*); - void *(*f15)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*); - void *(*f16)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*,void*); - void *(*f17)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*,void*,void*); - void *(*f18)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*,void*,void*,void*); - void *(*f19)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*,void*,void*,void*,void*); - void *(*f20)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, - void*,void*,void*,void*,void*,void*,void*,void*,void*,void*); - struct { - struct MalVal *(*evaluator)(struct MalVal *, Env *); - struct MalVal *args; - struct MalVal *body; - struct Env *env; - } func; - } val; - int func_arg_cnt; - int ismacro; -} MalVal; - -// Constants - -extern MalVal mal_nil; -extern MalVal mal_true; -extern MalVal mal_false; - - -// Declare functions used internally (by other C code). -// Mal visible functions are "exported" in types_ns - -MalVal *malval_new(MalType type, MalVal *metadata); -int malval_free(MalVal *mv); -MalVal *malval_new_integer(gint64 val); -MalVal *malval_new_float(gdouble val); -MalVal *malval_new_string(char *val); -MalVal *malval_new_symbol(char *val); -MalVal *malval_new_keyword(char *val); -MalVal *malval_new_list(MalType type, GArray *val); -MalVal *malval_new_hash_map(GHashTable *val); -MalVal *malval_new_atom(MalVal *val); -MalVal *malval_new_function(void *(*func)(void *), int arg_cnt); - -// Numbers -#define WRAP_INTEGER_OP(name, op) \ - MalVal *int_ ## name(MalVal *a, MalVal *b) { \ - return malval_new_integer(a->val.intnum op b->val.intnum); \ - } -#define WRAP_INTEGER_CMP_OP(name, op) \ - MalVal *int_ ## name(MalVal *a, MalVal *b) { \ - return a->val.intnum op b->val.intnum ? &mal_true : &mal_false; \ - } - -// Collections -MalVal *_listX(int count, ...); -MalVal *_list(MalVal *args); -MalVal *_vector(MalVal *args); -MalVal *_hash_map(MalVal *args); -MalVal *_assoc_BANG(MalVal* hm, MalVal *args); -MalVal *_dissoc_BANG(MalVal* hm, MalVal *args); - -MalVal *_apply(MalVal *f, MalVal *el); - -char *_pr_str(MalVal *args, int print_readably); - -MalVal *_slice(MalVal *seq, int start, int end); -MalVal *_nth(MalVal *seq, int idx); -MalVal *_first(MalVal *seq); -MalVal *_rest(MalVal *seq); -MalVal *_last(MalVal *seq); - -MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2); - -#endif diff --git a/ci.sh b/ci.sh new file mode 100755 index 0000000000..23bf343c4b --- /dev/null +++ b/ci.sh @@ -0,0 +1,107 @@ +#!/usr/bin/env bash + +set -ex + +ACTION=${1} +IMPL=${2} + +die() { local ret=$1; shift; echo >&2 "${*}"; exit $ret; } + +# Environment variable configuration +BUILD_IMPL=${BUILD_IMPL:-${IMPL}} + +if [ "${DO_SELF_HOST}" ]; then + MAL_IMPL=${IMPL} + IMPL=mal +fi + +if [ "${DO_HARD}" ]; then + TEST_OPTS="${TEST_OPTS} --hard" +fi + +raw_mode_var=${MAL_IMPL:-${IMPL}}_MODE +mode_var=${raw_mode_var/-/__} +mode_var=${mode_var/./__} +mode_val=${!mode_var} + +log_prefix="${ACTION}${REGRESS:+-regress}-${IMPL}${mode_val:+-${mode_val}}${MAL_IMPL:+-${MAL_IMPL}}" +TEST_OPTS="${TEST_OPTS} -vv --debug-file ../../${log_prefix}.debug" +TEST_OPTS="${TEST_OPTS} --continue-after-fail" + +step_summary() { + echo "${*}" + if [ "${GITHUB_STEP_SUMMARY}" ]; then + echo "${*}" >> "${GITHUB_STEP_SUMMARY}" + fi +} + +img_base="${MAL_IMPL:-${IMPL}}" +img_impl="${img_base%%-mal}" +img_name="mal-test-$(echo "${img_impl}" | tr '[:upper:]' '[:lower:]')" +img_ver=$(./voom-like-version.sh impls/${img_impl}/Dockerfile) +IMAGE="ghcr.io/kanaka/${img_name}:${img_ver}" + +# If NO_DOCKER is blank then run make in a docker image +MAKE="make ${mode_val:+${mode_var}=${mode_val}}" +if [ -z "${NO_DOCKER}" ]; then + # We could just use make DOCKERIZE=1 instead but that does add + # non-trivial startup overhead for each step. + MAKE="docker run -i -u $(id -u) -v `pwd`:/mal ${IMAGE} ${MAKE}" +fi + +# Log everything below this point: +exec &> >(tee ./${log_prefix}.log) + +if [ "${NO_PERF}" -a "${ACTION}" = "perf" ]; then + die 0 "Skipping perf test" +fi +if [ "${NO_SELF_HOST}" -a "${DO_SELF_HOST}" ]; then + die 0 "Skipping ${ACTION} of ${MAL_IMPL} self-host" +fi +if [ "${NO_SELF_HOST_PERF}" -a "${DO_SELF_HOST}" -a "${ACTION}" = "perf" ]; then + die 0 "Skipping only perf test for ${MAL_IMPL} self-host" +fi + +echo "ACTION: ${ACTION}" +echo "IMPL: ${IMPL}" +echo "BUILD_IMPL: ${BUILD_IMPL}" +echo "MAL_IMPL: ${MAL_IMPL}" +echo "TEST_OPTS: ${TEST_OPTS}" +echo "IMAGE: ${IMAGE}" +echo "MAKE: ${MAKE}" + +case "${ACTION}" in +docker-build-push) + if ! docker pull ${IMAGE}; then + step_summary "${BUILD_IMPL} - building ${IMAGE}" + make "docker-build^${BUILD_IMPL}" + step_summary "${BUILD_IMPL} - built ${IMAGE}" + if [ "${GITHUB_REPOSITORY}" = "kanaka/mal" ] && [ "${GITHUB_REF}" = "refs/heads/master" ]; then + docker push ${IMAGE} + step_summary "${BUILD_IMPL} - pushed ${IMAGE}" + fi + fi + ;; +build) + # rpython often fails on step9 in compute_vars_longevity + # so build step9, then continue with the full build + if [ "${BUILD_IMPL}" = "rpython" ]; then + ${MAKE} -C "impls/${BUILD_IMPL}" step9_try || true + fi + ${MAKE} -C "impls/${BUILD_IMPL}" + ;; +test|perf) + [ "${ACTION}" = "perf" ] && STEP= + if ! ${MAKE} TEST_OPTS="${TEST_OPTS}" \ + ${MAL_IMPL:+MAL_IMPL=${MAL_IMPL}} \ + ${REGRESS:+REGRESS=${REGRESS}} \ + ${HARD:+HARD=${HARD}} \ + ${DEFERRABLE:+DEFERRABLE=${DEFERRABLE}} \ + ${OPTIONAL:+OPTIONAL=${OPTIONAL}} \ + ${ACTION}^${IMPL}${STEP:+^${STEP}}; then + # show debug-file path on error + echo "Full debug log is at: ${log_prefix}.debug" + false + fi + ;; +esac diff --git a/clojure/Makefile b/clojure/Makefile deleted file mode 100644 index ec55ac1167..0000000000 --- a/clojure/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -SOURCES_BASE = src/readline.clj src/reader.clj src/printer.clj -SOURCES_LISP = src/env.clj src/core.clj src/stepA_mal.clj -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/clojure/project.clj b/clojure/project.clj deleted file mode 100644 index 447d643ff8..0000000000 --- a/clojure/project.clj +++ /dev/null @@ -1,25 +0,0 @@ -(defproject mal "0.0.1-SNAPSHOT" - :description "Make-A-Lisp" - - :dependencies [[org.clojure/clojure "1.5.1"] - [org.clojure/tools.reader "0.8.3"] - [net.n01se/clojure-jna "1.0.0"]] - - ;; To run a step with correct readline behavior: - ;; lein trampoline with-profile stepX run - ;; To load step in repl: - ;; lein with-profile +stepX repl - :profiles {:step0 {:main step0-repl} - :step1 {:main step1-read-print} - :step2 {:main step2-eval} - :step3 {:main step3-env} - :step4 {:main step4-if-fn-do} - :step5 {:main step5-tco} - :step6 {:main step6-file} - :step7 {:main step7-quote} - :step8 {:main step8-macros} - :step9 {:main step9-try} - :stepA {:main stepA-mal}} - - :main stepA-more) - diff --git a/clojure/src/core.clj b/clojure/src/core.clj deleted file mode 100644 index 4438e29d35..0000000000 --- a/clojure/src/core.clj +++ /dev/null @@ -1,77 +0,0 @@ -(ns core - (:require [readline])) - -;; Errors/exceptions -(defn mal_throw [obj] - (throw (ex-info "mal exception" {:data obj}))) - -;; Metadata functions -;; - store metadata at :meta key of the real metadata -(defn mal_with_meta [obj m] - (let [new-meta (assoc (meta obj) :meta m)] - (with-meta obj new-meta))) - -(defn mal_meta [obj] - (:meta (meta obj))) - -;; core_ns is core namespaces functions -(def core_ns - [['= =] - ['throw mal_throw] - ['nil? nil?] - ['true? true?] - ['false? false?] - ['symbol symbol] - ['symbol? symbol?] - ['keyword keyword] - ['keyword? keyword?] - - ['pr-str pr-str] - ['str str] - ['prn prn] - ['println println] - ['readline readline/readline] - ['read-string reader/read-string] - ['slurp slurp] - ['< <] - ['<= <=] - ['> >] - ['>= >=] - ['+ +] - ['- -] - ['* *] - ['/ /] - ['time-ms (fn time-ms [] (System/currentTimeMillis))] - - ['list list] - ['list? seq?] - ['vector vector] - ['vector? vector?] - ['hash-map hash-map] - ['map? map?] - ['assoc assoc] - ['dissoc dissoc] - ['get get] - ['contains? contains?] - ['keys (fn [hm] (let [ks (keys hm)] (if (nil? ks) '() ks)))] - ['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))] - - ['sequential? sequential?] - ['cons cons] - ['concat concat] - ['nth nth] - ['first first] - ['rest rest] - ['empty? empty?] - ['count count] - ['conj conj] - ['apply apply] - ['map #(doall (map %1 %2))] - - ['with-meta mal_with_meta] - ['meta mal_meta] - ['atom atom] - ['atom? (fn atom? [atm] (= (type atm) clojure.lang.Atom))] - ['deref deref] - ['reset! reset!] - ['swap! swap!]]) diff --git a/clojure/src/env.clj b/clojure/src/env.clj deleted file mode 100644 index 7f1f934c65..0000000000 --- a/clojure/src/env.clj +++ /dev/null @@ -1,35 +0,0 @@ -(ns env) - -(defn env [& [outer binds exprs]] - ;;(prn "env" binds exprs) - ;; (when (not= (count binds) (count exprs)) - ;; (throw (Exception. "Arity mistmatch in env call"))) - (atom - (loop [env {:outer outer} - b binds - e exprs] - (cond - (= nil b) - env - - (= '& (first b)) - (assoc env (nth b 1) e) - - :else - (recur (assoc env (first b) (first e)) (next b) (next e)))))) - -(defn env-find [env k] - (cond - (contains? @env k) env - (:outer @env) (env-find (:outer @env) k) - :else nil)) - -(defn env-get [env k] - (let [e (env-find env k)] - (when-not e - (throw (Exception. (str "'" k "' not found")))) - (get @e k))) - -(defn env-set [env k v] - (swap! env assoc k v) - v) diff --git a/clojure/src/printer.clj b/clojure/src/printer.clj deleted file mode 100644 index 656914f63e..0000000000 --- a/clojure/src/printer.clj +++ /dev/null @@ -1,7 +0,0 @@ -(ns printer) - -(defmethod clojure.core/print-method clojure.lang.Atom [a writer] - (.write writer "(atom ") - (.write writer (pr-str @a)) - (.write writer ")")) - diff --git a/clojure/src/reader.clj b/clojure/src/reader.clj deleted file mode 100644 index 8f14767519..0000000000 --- a/clojure/src/reader.clj +++ /dev/null @@ -1,32 +0,0 @@ -(ns reader - (:refer-clojure :exclude [read-string]) - (:require [clojure.tools.reader :as r] - [clojure.tools.reader.reader-types :as rt])) - -;; change tools.reader syntax-quote to quasiquote -(defn- wrap [sym] - (fn [rdr _] (list sym (#'r/read rdr true nil true)))) - -(defn- wrap-with [sym] - (fn [rdr arg _] (list sym (#'r/read rdr true nil true) arg))) - -;; Override some tools.reader reader macros so that we can do our own -;; metadata and quasiquote handling -(alter-var-root #'r/macros - (fn [f] - (fn [ch] - (case ch - \` (wrap 'quasiquote) - \~ (fn [rdr comma] - (if-let [ch (rt/peek-char rdr)] - (if (identical? \@ ch) - ((wrap 'splice-unquote) (doto rdr rt/read-char) \@) - ((wrap 'unquote) rdr \~)))) - \^ (fn [rdr comma] - (let [m (#'r/read rdr)] - ((wrap-with 'with-meta) rdr m \^))) - \@ (wrap 'deref) - (f ch))))) - -(defn read-string [s] - (r/read-string s)) diff --git a/clojure/src/step0_repl.clj b/clojure/src/step0_repl.clj deleted file mode 100644 index 7a1a44361b..0000000000 --- a/clojure/src/step0_repl.clj +++ /dev/null @@ -1,27 +0,0 @@ -(ns step0-repl - (:require [readline])) - - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - strng)) - -;; eval -(defn EVAL [ast env] - (eval (read-string ast))) - -;; print -(defn PRINT [exp] exp) - -;; repl -(defn rep [strng] (PRINT (EVAL (READ strng), {}))) -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (println (rep line)) - (recur)))) - -(defn -main [& args] - (repl-loop)) diff --git a/clojure/src/step1_read_print.clj b/clojure/src/step1_read_print.clj deleted file mode 100644 index 21b297d33d..0000000000 --- a/clojure/src/step1_read_print.clj +++ /dev/null @@ -1,36 +0,0 @@ -(ns step1-read-print - (:require [clojure.repl] - [readline] - [reader] - [printer])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(defn EVAL [ast env] - ast) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(defn rep - [strng] - (PRINT (EVAL (READ strng) {}))) - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (repl-loop)) diff --git a/clojure/src/step2_eval.clj b/clojure/src/step2_eval.clj deleted file mode 100644 index 96946afc29..0000000000 --- a/clojure/src/step2_eval.clj +++ /dev/null @@ -1,63 +0,0 @@ -(ns step2-eval - (:require [clojure.repl] - [readline] - [reader] - [printer])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (or (get env ast) - (throw (Error. (str ast " not found")))) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env {'+ + - '- - - '* * - '/ /}) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (repl-loop)) diff --git a/clojure/src/step3_env.clj b/clojure/src/step3_env.clj deleted file mode 100644 index 4d31260008..0000000000 --- a/clojure/src/step3_env.clj +++ /dev/null @@ -1,77 +0,0 @@ -(ns step3-env - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (EVAL a2 let-env)) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -(env/env-set repl-env '+ +) -(env/env-set repl-env '- -) -(env/env-set repl-env '* *) -(env/env-set repl-env '/ /) - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (repl-loop)) diff --git a/clojure/src/step4_if_fn_do.clj b/clojure/src/step4_if_fn_do.clj deleted file mode 100644 index c125b04072..0000000000 --- a/clojure/src/step4_if_fn_do.clj +++ /dev/null @@ -1,94 +0,0 @@ -(ns step4-if-fn-do - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (EVAL a2 let-env)) - - 'do - (last (eval-ast (rest ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (EVAL a3 env) - nil) - (EVAL a2 env))) - - 'fn* - (fn [& args] - (EVAL a2 (env/env env a1 args))) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* [a] (if a false true)))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (repl-loop)) diff --git a/clojure/src/step5_tco.clj b/clojure/src/step5_tco.clj deleted file mode 100644 index ed19b8ecfa..0000000000 --- a/clojure/src/step5_tco.clj +++ /dev/null @@ -1,104 +0,0 @@ -(ns step5-tco - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* [a] (if a false true)))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (repl-loop)) diff --git a/clojure/src/step6_file.clj b/clojure/src/step6_file.clj deleted file mode 100644 index 2d5e05d3c2..0000000000 --- a/clojure/src/step6_file.clj +++ /dev/null @@ -1,110 +0,0 @@ -(ns step6-file - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) -(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) -(env/env-set repl-env '*ARGV* ()) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (env/env-set repl-env '*ARGV* (rest args)) - (if args - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop))) diff --git a/clojure/src/step7_quote.clj b/clojure/src/step7_quote.clj deleted file mode 100644 index 633a81c938..0000000000 --- a/clojure/src/step7_quote.clj +++ /dev/null @@ -1,133 +0,0 @@ -(ns step7-quote - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) - -(defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'quote - a1 - - 'quasiquote - (recur (quasiquote a1) env) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) -(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) -(env/env-set repl-env '*ARGV* ()) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (env/env-set repl-env '*ARGV* (rest args)) - (if args - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop))) diff --git a/clojure/src/step8_macros.clj b/clojure/src/step8_macros.clj deleted file mode 100644 index b8b55dc8fc..0000000000 --- a/clojure/src/step8_macros.clj +++ /dev/null @@ -1,161 +0,0 @@ -(ns step8-macros - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) - -(defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) - -(defn is-macro-call [ast env] - (and (seq? ast) - (symbol? (first ast)) - (env/env-find env (first ast)) - (:ismacro (meta (env/env-get env (first ast)))))) - -(defn macroexpand [ast env] - (loop [ast ast] - (if (is-macro-call ast env) - (let [mac (env/env-get env (first ast))] - (recur (apply mac (rest ast)))) - ast))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - ast - - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'quote - a1 - - 'quasiquote - (recur (quasiquote a1) env) - - 'defmacro! - (let [func (with-meta (EVAL a2 env) - {:ismacro true})] - (env/env-set env a1 func)) - - 'macroexpand - (macroexpand a1 env) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) -(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) -(env/env-set repl-env '*ARGV* ()) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (env/env-set repl-env '*ARGV* (rest args)) - (if args - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop))) diff --git a/clojure/src/step9_try.clj b/clojure/src/step9_try.clj deleted file mode 100644 index 7e18a741e9..0000000000 --- a/clojure/src/step9_try.clj +++ /dev/null @@ -1,176 +0,0 @@ -(ns step9-try - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) - -(defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) - -(defn is-macro-call [ast env] - (and (seq? ast) - (symbol? (first ast)) - (env/env-find env (first ast)) - (:ismacro (meta (env/env-get env (first ast)))))) - -(defn macroexpand [ast env] - (loop [ast ast] - (if (is-macro-call ast env) - (let [mac (env/env-get env (first ast))] - (recur (apply mac (rest ast)))) - ast))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - ast - - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'quote - a1 - - 'quasiquote - (recur (quasiquote a1) env) - - 'defmacro! - (let [func (with-meta (EVAL a2 env) - {:ismacro true})] - (env/env-set env a1 func)) - - 'macroexpand - (macroexpand a1 env) - - 'try* - (if (= 'catch* (nth a2 0)) - (try - (EVAL a1 env) - (catch clojure.lang.ExceptionInfo ei - (EVAL (nth a2 2) (env/env env - [(nth a2 1)] - [(:data (ex-data ei))]))) - (catch Throwable t - (EVAL (nth a2 2) (env/env env - [(nth a2 1)] - [(.getMessage t)])))) - (EVAL a1 env)) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) -(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) -(env/env-set repl-env '*ARGV* ()) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (env/env-set repl-env '*ARGV* (rest args)) - (if args - (rep (str "(load-file \"" (first args) "\")")) - (do - (repl-loop)))) diff --git a/clojure/src/stepA_mal.clj b/clojure/src/stepA_mal.clj deleted file mode 100644 index ce289b6c5a..0000000000 --- a/clojure/src/stepA_mal.clj +++ /dev/null @@ -1,181 +0,0 @@ -(ns stepA-mal - (:refer-clojure :exclude [macroexpand]) - (:require [clojure.repl] - [readline] - [reader] - [printer] - [env] - [core])) - -;; read -(defn READ [& [strng]] - (let [line (if strng strng (read-line))] - (reader/read-string strng))) - -;; eval -(declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) - -(defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) - -(defn is-macro-call [ast env] - (and (seq? ast) - (symbol? (first ast)) - (env/env-find env (first ast)) - (:ismacro (meta (env/env-get env (first ast)))))) - -(defn macroexpand [ast env] - (loop [ast ast] - (if (is-macro-call ast env) - (let [mac (env/env-get env (first ast))] - (recur (apply mac (rest ast)))) - ast))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) - - ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - ast - - (let [[a0 a1 a2 a3] ast] - (condp = a0 - 'def! - (env/env-set env a1 (EVAL a2 env)) - - 'let* - (let [let-env (env/env env)] - (doseq [[b e] (partition 2 a1)] - (env/env-set let-env b (EVAL e let-env))) - (recur a2 let-env)) - - 'quote - a1 - - 'quasiquote - (recur (quasiquote a1) env) - - 'defmacro! - (let [func (with-meta (EVAL a2 env) - {:ismacro true})] - (env/env-set env a1 func)) - - 'macroexpand - (macroexpand a1 env) - - 'clj* - (eval (reader/read-string a1)) - - 'try* - (if (= 'catch* (nth a2 0)) - (try - (EVAL a1 env) - (catch clojure.lang.ExceptionInfo ei - (EVAL (nth a2 2) (env/env env - [(nth a2 1)] - [(:data (ex-data ei))]))) - (catch Throwable t - (EVAL (nth a2 2) (env/env env - [(nth a2 1)] - [(.getMessage t)])))) - (EVAL a1 env)) - - 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) - (recur (last ast) env)) - - 'if - (let [cond (EVAL a1 env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 2) - (recur a3 env) - nil) - (recur a2 env))) - - 'fn* - (with-meta - (fn [& args] - (EVAL a2 (env/env env a1 args))) - {:expression a2 - :environment env - :parameters a1}) - - ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) - {:keys [expression environment parameters]} (meta f)] - (if expression - (recur expression (env/env environment parameters args)) - (apply f args)))))))))) - -;; print -(defn PRINT [exp] (pr-str exp)) - -;; repl -(def repl-env (env/env)) -(defn rep - [strng] - (PRINT (EVAL (READ strng) repl-env))) - -;; core.clj: defined using Clojure -(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) -(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) -(env/env-set repl-env '*ARGV* ()) - -;; core.mal: defined using the language itself -(rep "(def! *host-language* \"clojure\")") -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(defn repl-loop [] - (let [line (readline/readline "user> ")] - (when line - (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment - (try - (println (rep line)) - (catch Throwable e - (clojure.repl/pst e)))) - (recur)))) - -(defn -main [& args] - (env/env-set repl-env '*ARGV* (rest args)) - (if args - (rep (str "(load-file \"" (first args) "\")")) - (do - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (repl-loop)))) diff --git a/clojure/tests/stepA_mal.mal b/clojure/tests/stepA_mal.mal deleted file mode 100644 index b3232224fd..0000000000 --- a/clojure/tests/stepA_mal.mal +++ /dev/null @@ -1,17 +0,0 @@ -;; Testing basic clojure interop - -(clj* "7") -;=>7 - -(clj* "\"abc\"") -;=>"abc" - -(clj* "{\"abc\" 123}") -;=>{"abc" 123} - -(clj* "(prn \"foo\")") -; "foo" -;=>nil - -(clj* "(for [x [1 2 3]] (+ 1 x))") -;=>(2 3 4) diff --git a/coffee/Makefile b/coffee/Makefile deleted file mode 100644 index 728d9f25b7..0000000000 --- a/coffee/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -TESTS = - -SOURCES_BASE = node_readline.coffee types.coffee \ - reader.coffee printer.coffee -SOURCES_LISP = env.coffee core.coffee stepA_mal.coffee -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -#all: mal.rb - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/coffee/env.coffee b/coffee/env.coffee deleted file mode 100644 index 80fbf12245..0000000000 --- a/coffee/env.coffee +++ /dev/null @@ -1,31 +0,0 @@ -types = require "./types.coffee" - -# Env -exports.Env = class Env - constructor: (@outer=null, @binds=[], @exprs=[]) -> - @data = {} - if @binds.length > 0 - for b,i in @binds - if types._symbol_Q(b) && b.name == "&" - @data[@binds[i+1].name] = exprs[i..] - break - else - @data[b.name] = exprs[i] - find: (key) -> - if not types._symbol_Q(key) - throw new Error("env.find key must be symbol") - if key.name of @data then @ - else if @outer then @outer.find(key) - else null - set: (key, value) -> - if not types._symbol_Q(key) - throw new Error("env.set key must be symbol") - @data[key.name] = value - get: (key) -> - if not types._symbol_Q(key) - throw new Error("env.get key must be symbol") - env = @find(key) - throw new Error("'" + key.name + "' not found") if !env - env.data[key.name] - -# vim: ts=2:sw=2 diff --git a/coffee/node_readline.coffee b/coffee/node_readline.coffee deleted file mode 100644 index 31e5ca0fee..0000000000 --- a/coffee/node_readline.coffee +++ /dev/null @@ -1,36 +0,0 @@ -# IMPORTANT: choose one -RL_LIB = "libreadline" # NOTE: libreadline is GPL -#RL_LIB = "libedit" - -HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history') - -rlwrap = {} # namespace for this module in web context - -ffi = require('ffi') -fs = require('fs') - -rllib = ffi.Library(RL_LIB, { - 'readline': ['string', ['string']], - 'add_history': ['int', ['string']]}) - -rl_history_loaded = false - -exports.readline = rlwrap.readline = (prompt = 'user> ') -> - if !rl_history_loaded - rl_history_loaded = true - lines = [] - if fs.existsSync(HISTORY_FILE) - lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); - - # Max of 2000 lines - lines = lines[Math.max(lines.length - 2000, 0)..] - rllib.add_history(line) for line in lines when line != "" - - line = rllib.readline prompt - if line - rllib.add_history line - fs.appendFileSync HISTORY_FILE, line + "\n" - - line - -# vim: ts=2:sw=2 diff --git a/coffee/package.json b/coffee/package.json deleted file mode 100644 index 859ec4ab4e..0000000000 --- a/coffee/package.json +++ /dev/null @@ -1,9 +0,0 @@ -{ - "name": "mal", - "version": "0.0.1", - "description": "Make a Lisp (mal) language implemented in CoffeeScript", - "dependencies": { - "ffi": "1.2.x", - "coffee-script": "~1.8" - } -} diff --git a/coffee/step1_read_print.coffee b/coffee/step1_read_print.coffee deleted file mode 100644 index 28edd1b2be..0000000000 --- a/coffee/step1_read_print.coffee +++ /dev/null @@ -1,27 +0,0 @@ -readline = require "./node_readline.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" - -# read -READ = (str) -> reader.read_str str - -# eval -EVAL = (ast, env) -> ast - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -rep = (str) -> PRINT(EVAL(READ(str), {})) - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step2_eval.coffee b/coffee/step2_eval.coffee deleted file mode 100644 index 1b3438e9a3..0000000000 --- a/coffee/step2_eval.coffee +++ /dev/null @@ -1,52 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" - -# read -READ = (str) -> reader.read_str str - -# eval -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env[ast.name] - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - [f, args...] = eval_ast ast, env - f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = {} -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -repl_env["+"] = (a,b) -> a+b -repl_env["-"] = (a,b) -> a-b -repl_env["*"] = (a,b) -> a*b -repl_env["/"] = (a,b) -> a/b - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step3_env.coffee b/coffee/step3_env.coffee deleted file mode 100644 index 1446197a9a..0000000000 --- a/coffee/step3_env.coffee +++ /dev/null @@ -1,63 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env - -# read -READ = (str) -> reader.read_str str - -# eval -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - EVAL(a2, let_env) - else - [f, args...] = eval_ast ast, env - f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -repl_env.set types._symbol("+"), (a,b) -> a+b -repl_env.set types._symbol("-"), (a,b) -> a-b -repl_env.set types._symbol("*"), (a,b) -> a*b -repl_env.set types._symbol("/"), (a,b) -> a/b - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step4_if_fn_do.coffee b/coffee/step4_if_fn_do.coffee deleted file mode 100644 index ef3347840c..0000000000 --- a/coffee/step4_if_fn_do.coffee +++ /dev/null @@ -1,76 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env -core = require("./core.coffee") - -# read -READ = (str) -> reader.read_str str - -# eval -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - EVAL(a2, let_env) - when "do" - el = eval_ast(ast[1..], env) - el[el.length-1] - when "if" - cond = EVAL(a1, env) - if cond == null or cond == false - if a3? then EVAL(a3, env) else null - else - EVAL(a2, env) - when "fn*" - (args...) -> EVAL(a2, new Env(env, a1, args)) - else - [f, args...] = eval_ast ast, env - f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -# core.coffee: defined using CoffeeScript -repl_env.set types._symbol(k), v for k,v of core.ns - -# core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step5_tco.coffee b/coffee/step5_tco.coffee deleted file mode 100644 index fa5aceddb7..0000000000 --- a/coffee/step5_tco.coffee +++ /dev/null @@ -1,82 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env -core = require("./core.coffee") - -# read -READ = (str) -> reader.read_str str - -# eval -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - return env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - when "do" - eval_ast(ast[1..-2], env) - ast = ast[ast.length-1] - when "if" - cond = EVAL(a1, env) - if cond == null or cond == false - if a3? then ast = a3 else return null - else - ast = a2 - when "fn*" - return types._function(EVAL, a2, env, a1) - else - [f, args...] = eval_ast ast, env - if types._function_Q(f) - ast = f.__ast__ - env = f.__gen_env__(args) - else - return f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -# core.coffee: defined using CoffeeScript -repl_env.set types._symbol(k), v for k,v of core.ns - -# core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step6_file.coffee b/coffee/step6_file.coffee deleted file mode 100644 index feafc63412..0000000000 --- a/coffee/step6_file.coffee +++ /dev/null @@ -1,90 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env -core = require("./core.coffee") - -# read -READ = (str) -> reader.read_str str - -# eval -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - return env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - when "do" - eval_ast(ast[1..-2], env) - ast = ast[ast.length-1] - when "if" - cond = EVAL(a1, env) - if cond == null or cond == false - if a3? then ast = a3 else return null - else - ast = a2 - when "fn*" - return types._function(EVAL, a2, env, a1) - else - [f, args...] = eval_ast ast, env - if types._function_Q(f) - ast = f.__ast__ - env = f.__gen_env__(args) - else - return f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -# core.coffee: defined using CoffeeScript -repl_env.set types._symbol(k), v for k,v of core.ns -repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) -repl_env.set types._symbol('*ARGV*'), [] - -# core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if process? && process.argv.length > 2 - repl_env.set types._symbol('*ARGV*'), process.argv[3..] - rep('(load-file "' + process.argv[2] + '")') - process.exit 0 - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step7_quote.coffee b/coffee/step7_quote.coffee deleted file mode 100644 index 7652a79474..0000000000 --- a/coffee/step7_quote.coffee +++ /dev/null @@ -1,106 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env -core = require("./core.coffee") - -# read -READ = (str) -> reader.read_str str - -# eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 - -quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] - - - -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - return env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - when "quote" - return a1 - when "quasiquote" - ast = quasiquote(a1) - when "do" - eval_ast(ast[1..-2], env) - ast = ast[ast.length-1] - when "if" - cond = EVAL(a1, env) - if cond == null or cond == false - if a3? then ast = a3 else return null - else - ast = a2 - when "fn*" - return types._function(EVAL, a2, env, a1) - else - [f, args...] = eval_ast ast, env - if types._function_Q(f) - ast = f.__ast__ - env = f.__gen_env__(args) - else - return f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -# core.coffee: defined using CoffeeScript -repl_env.set types._symbol(k), v for k,v of core.ns -repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) -repl_env.set types._symbol('*ARGV*'), [] - -# core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if process? && process.argv.length > 2 - repl_env.set types._symbol('*ARGV*'), process.argv[3..] - rep('(load-file "' + process.argv[2] + '")') - process.exit 0 - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step8_macros.coffee b/coffee/step8_macros.coffee deleted file mode 100644 index 6150d2e8fa..0000000000 --- a/coffee/step8_macros.coffee +++ /dev/null @@ -1,126 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env -core = require("./core.coffee") - -# read -READ = (str) -> reader.read_str str - -# eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 - -quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] - -is_macro_call = (ast, env) -> - return types._list_Q(ast) && types._symbol_Q(ast[0]) && - env.find(ast[0]) && env.get(ast[0]).__ismacro__ - -macroexpand = (ast, env) -> - while is_macro_call(ast, env) - ast = env.get(ast[0])(ast[1..]...) - ast - - - -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - ast = macroexpand ast, env - if !types._list_Q ast then return ast - - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - return env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - when "quote" - return a1 - when "quasiquote" - ast = quasiquote(a1) - when "defmacro!" - f = EVAL(a2, env) - f.__ismacro__ = true - return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, env) - when "do" - eval_ast(ast[1..-2], env) - ast = ast[ast.length-1] - when "if" - cond = EVAL(a1, env) - if cond == null or cond == false - if a3? then ast = a3 else return null - else - ast = a2 - when "fn*" - return types._function(EVAL, a2, env, a1) - else - [f, args...] = eval_ast ast, env - if types._function_Q(f) - ast = f.__ast__ - env = f.__gen_env__(args) - else - return f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -# core.coffee: defined using CoffeeScript -repl_env.set types._symbol(k), v for k,v of core.ns -repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) -repl_env.set types._symbol('*ARGV*'), [] - -# core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if process? && process.argv.length > 2 - repl_env.set types._symbol('*ARGV*'), process.argv[3..] - rep('(load-file "' + process.argv[2] + '")') - process.exit 0 - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/step9_try.coffee b/coffee/step9_try.coffee deleted file mode 100644 index d8f6f43c78..0000000000 --- a/coffee/step9_try.coffee +++ /dev/null @@ -1,134 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env -core = require("./core.coffee") - -# read -READ = (str) -> reader.read_str str - -# eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 - -quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] - -is_macro_call = (ast, env) -> - return types._list_Q(ast) && types._symbol_Q(ast[0]) && - env.find(ast[0]) && env.get(ast[0]).__ismacro__ - -macroexpand = (ast, env) -> - while is_macro_call(ast, env) - ast = env.get(ast[0])(ast[1..]...) - ast - - - -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - ast = macroexpand ast, env - if !types._list_Q ast then return ast - - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - return env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - when "quote" - return a1 - when "quasiquote" - ast = quasiquote(a1) - when "defmacro!" - f = EVAL(a2, env) - f.__ismacro__ = true - return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, env) - when "try*" - try return EVAL(a1, env) - catch exc - if a2 && a2[0].name == "catch*" - if exc instanceof Error then exc = exc.message - return EVAL a2[2], new Env(env, [a2[1]], [exc]) - else - throw exc - when "do" - eval_ast(ast[1..-2], env) - ast = ast[ast.length-1] - when "if" - cond = EVAL(a1, env) - if cond == null or cond == false - if a3? then ast = a3 else return null - else - ast = a2 - when "fn*" - return types._function(EVAL, a2, env, a1) - else - [f, args...] = eval_ast ast, env - if types._function_Q(f) - ast = f.__ast__ - env = f.__gen_env__(args) - else - return f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -# core.coffee: defined using CoffeeScript -repl_env.set types._symbol(k), v for k,v of core.ns -repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) -repl_env.set types._symbol('*ARGV*'), [] - -# core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if process? && process.argv.length > 2 - repl_env.set types._symbol('*ARGV*'), process.argv[3..] - rep('(load-file "' + process.argv[2] + '")') - process.exit 0 - -# repl loop -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/stepA_mal.coffee b/coffee/stepA_mal.coffee deleted file mode 100644 index 751f9add30..0000000000 --- a/coffee/stepA_mal.coffee +++ /dev/null @@ -1,142 +0,0 @@ -readline = require "./node_readline.coffee" -types = require "./types.coffee" -reader = require "./reader.coffee" -printer = require "./printer.coffee" -Env = require("./env.coffee").Env -core = require("./core.coffee") - -# read -READ = (str) -> reader.read_str str - -# eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 - -quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] - -is_macro_call = (ast, env) -> - return types._list_Q(ast) && types._symbol_Q(ast[0]) && - env.find(ast[0]) && env.get(ast[0]).__ismacro__ - -macroexpand = (ast, env) -> - while is_macro_call(ast, env) - ast = env.get(ast[0])(ast[1..]...) - ast - - - -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) - else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) - else if types._hash_map_Q(ast) - new_hm = {} - new_hm[k] = EVAL(ast[k],env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env - - # apply list - ast = macroexpand ast, env - if !types._list_Q ast then return ast - - [a0, a1, a2, a3] = ast - switch a0.name - when "def!" - return env.set(a1, EVAL(a2, env)) - when "let*" - let_env = new Env(env) - for k,i in a1 when i %% 2 == 0 - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - when "quote" - return a1 - when "quasiquote" - ast = quasiquote(a1) - when "defmacro!" - f = EVAL(a2, env) - f.__ismacro__ = true - return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, env) - when "try*" - try return EVAL(a1, env) - catch exc - if a2 && a2[0].name == "catch*" - if exc instanceof Error then exc = exc.message - return EVAL a2[2], new Env(env, [a2[1]], [exc]) - else - throw exc - when "js*" - res = eval(a1.toString()) - return if typeof(res) == 'undefined' then null else res - when "." - el = eval_ast(ast[2..], env) - return eval(a1.toString())(el...) - when "do" - eval_ast(ast[1..-2], env) - ast = ast[ast.length-1] - when "if" - cond = EVAL(a1, env) - if cond == null or cond == false - if a3? then ast = a3 else return null - else - ast = a2 - when "fn*" - return types._function(EVAL, a2, env, a1) - else - [f, args...] = eval_ast ast, env - if types._function_Q(f) - ast = f.__ast__ - env = f.__gen_env__(args) - else - return f(args...) - - -# print -PRINT = (exp) -> printer._pr_str exp, true - -# repl -repl_env = new Env() -rep = (str) -> PRINT(EVAL(READ(str), repl_env)) - -# core.coffee: defined using CoffeeScript -repl_env.set types._symbol(k), v for k,v of core.ns -repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) -repl_env.set types._symbol('*ARGV*'), [] - -# core.mal: defined using the language itself -rep("(def! *host-language* \"CoffeeScript\")") -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if process? && process.argv.length > 2 - repl_env.set types._symbol('*ARGV*'), process.argv[3..] - rep('(load-file "' + process.argv[2] + '")') - process.exit 0 - -# repl loop -rep("(println (str \"Mal [\" *host-language* \"]\"))") -while (line = readline.readline("user> ")) != null - continue if line == "" - try - console.log rep line - catch exc - continue if exc instanceof reader.BlankException - if exc.stack then console.log exc.stack - else console.log exc - -# vim: ts=2:sw=2 diff --git a/coffee/tests/stepA_mal.mal b/coffee/tests/stepA_mal.mal deleted file mode 100644 index f785292d48..0000000000 --- a/coffee/tests/stepA_mal.mal +++ /dev/null @@ -1,24 +0,0 @@ -;; Testing basic bash interop - -(js* "7") -;=>7 - -(js* "'7'") -;=>"7" - -(js* "[7,8,9]") -;=>(7 8 9) - -(js* "console.log('hello');") -; hello -;=>nil - -(js* "foo=8;") -(js* "foo;") -;=>8 - -(js* "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") -;=>"XaY XbY XcY" - -(js* "[1,2,3].map(function(x){return 1+x})") -;=>(2 3 4) diff --git a/core.mal b/core.mal deleted file mode 100644 index 2c4fc82abf..0000000000 --- a/core.mal +++ /dev/null @@ -1,84 +0,0 @@ -(def! inc (fn* (a) (+ a 1))) - -(def! dec (fn* (a) (- a 1))) - -(def! zero? (fn* (n) (= 0 n))) - -(def! reduce - (fn* (f init xs) - (if (> (count xs) 0) - (reduce f (f init (first xs)) (rest xs)) - init))) - -(def! identity (fn* (x) x)) - -(def! every? - (fn* (pred xs) - (if (> (count xs) 0) - (if (pred (first xs)) - (every? pred (rest xs)) - false) - true))) - -(def! not (fn* (x) (if x false true))) - -(def! some - (fn* (pred xs) - (if (> (count xs) 0) - (let* (res (pred (first xs))) - (if (pred (first xs)) - res - (some pred (rest xs)))) - nil))) - -(defmacro! and - (fn* (& xs) - (if (empty? xs) - true - (if (= 1 (count xs)) - (first xs) - `(let* (and_FIXME ~(first xs)) - (if and_FIXME (and ~@(rest xs)) and_FIXME)))))) - -(defmacro! or - (fn* (& xs) - (if (empty? xs) - nil - (if (= 1 (count xs)) - (first xs) - `(let* (or_FIXME ~(first xs)) - (if or_FIXME or_FIXME (or ~@(rest xs)))))))) - -(defmacro! cond - (fn* (& clauses) - (if (> (count clauses) 0) - (list 'if (first clauses) - (if (> (count clauses) 1) - (nth clauses 1) - (throw "cond requires an even number of forms")) - (cons 'cond (rest (rest clauses))))))) - -(defmacro! -> - (fn* (x & xs) - (if (empty? xs) - x - (let* (form (first xs) - more (rest xs)) - (if (empty? more) - (if (list? form) - `(~(first form) ~x ~@(rest form)) - (list form x)) - `(-> (-> ~x ~form) ~@more)))))) - -(defmacro! ->> - (fn* (x & xs) - (if (empty? xs) - x - (let* (form (first xs) - more (rest xs)) - (if (empty? more) - (if (list? form) - `(~(first form) ~@(rest form) ~x) - (list form x)) - `(->> (->> ~x ~form) ~@more)))))) - diff --git a/cs/Makefile b/cs/Makefile deleted file mode 100644 index 70d54ad048..0000000000 --- a/cs/Makefile +++ /dev/null @@ -1,50 +0,0 @@ -##################### - -DEBUG = - -TESTS = - -SOURCES_BASE = readline.cs types.cs reader.cs printer.cs -SOURCES_LISP = env.cs core.cs stepA_mal.cs -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -OTHER_SOURCES = getline.cs - -##################### - -SRCS = step0_repl.cs step1_read_print.cs step2_eval.cs step3_env.cs \ - step4_if_fn_do.cs step5_tco.cs step6_file.cs step7_quote.cs \ - step8_macros.cs step9_try.cs stepA_mal.cs - -LIB_SRCS = $(filter-out step%,$(OTHER_SOURCES) $(SOURCES)) - -FLAGS = $(if $(strip $(DEBUG)),-debug+,) - -##################### - -all: mal.exe $(patsubst %.cs,%.exe,$(SRCS)) - -mal.exe: $(patsubst %.cs,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) - cp $< $@ - -mal.dll: $(LIB_SRCS) - mcs $(FLAGS) -target:library $+ -out:$@ - -%.exe: %.cs mal.dll - mcs $(FLAGS) -r:mal.dll $< - -clean: - rm -f *.dll *.exe *.mdb - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ./$@ || exit 1; \ diff --git a/cs/env.cs b/cs/env.cs deleted file mode 100644 index 39ab100e0f..0000000000 --- a/cs/env.cs +++ /dev/null @@ -1,55 +0,0 @@ -using System.Collections.Generic; -using Mal; -using MalVal = Mal.types.MalVal; -using MalSymbol = Mal.types.MalSymbol; -using MalList = Mal.types.MalList; - -namespace Mal { - public class env { - public class Env { - Env outer = null; - Dictionary data = new Dictionary(); - - public Env(Env outer) { - this.outer = outer; - } - public Env(Env outer, MalList binds, MalList exprs) { - this.outer = outer; - for (int i=0; i(); - foreach (var entry in ((MalHashMap)ast).getValue()) { - new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); - } - return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, a3, res; - MalList el; - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast[0]; - - String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - - switch (a0sym) { - case "def!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - env.set((MalSymbol)a1, res); - return res; - case "let*": - a1 = ast[1]; - a2 = ast[2]; - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1)[i]; - val = ((MalList)a1)[i+1]; - let_env.set(key, EVAL(val, let_env)); - } - return EVAL(a2, let_env); - case "do": - el = (MalList)eval_ast(ast.rest(), env); - return el[el.size()-1]; - case "if": - a1 = ast[1]; - MalVal cond = EVAL(a1, env); - if (cond == Mal.types.Nil || cond == Mal.types.False) { - // eval false slot form - if (ast.size() > 3) { - a3 = ast[3]; - return EVAL(a3, env); - } else { - return Mal.types.Nil; - } - } else { - // eval true slot form - a2 = ast[2]; - return EVAL(a2, env); - } - case "fn*": - MalList a1f = (MalList)ast[1]; - MalVal a2f = ast[2]; - Env cur_env = env; - return new MalFunc( - args => EVAL(a2f, new Env(cur_env, a1f, args)) ); - default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; - return f.apply(el.rest()); - } - } - - // print - static string PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - static void Main(string[] args) { - var repl_env = new Mal.env.Env(null); - Func RE = (string str) => EVAL(READ(str), repl_env); - - // core.cs: defined using C# - foreach (var entry in core.ns) { - repl_env.set(new MalSymbol(entry.Key), entry.Value); - } - - // core.mal: defined using the language itself - RE("(def! not (fn* (a) (if a false true)))"); - - if (args.Length > 0 && args[0] == "--raw") { - Mal.readline.mode = Mal.readline.Mode.Raw; - } - - // repl loop - while (true) { - string line; - try { - line = Mal.readline.Readline("user> "); - if (line == null) { break; } - if (line == "") { continue; } - } catch (IOException e) { - Console.WriteLine("IOException: " + e.Message); - break; - } - try { - Console.WriteLine(PRINT(RE(line))); - } catch (Mal.types.MalContinue) { - continue; - } catch (Exception e) { - Console.WriteLine("Error: " + e.Message); - Console.WriteLine(e.StackTrace); - continue; - } - } - } - } -} diff --git a/cs/step7_quote.cs b/cs/step7_quote.cs deleted file mode 100644 index 7b031521fe..0000000000 --- a/cs/step7_quote.cs +++ /dev/null @@ -1,219 +0,0 @@ -using System; -using System.IO; -using System.Collections; -using System.Collections.Generic; -using Mal; -using MalVal = Mal.types.MalVal; -using MalString = Mal.types.MalString; -using MalSymbol = Mal.types.MalSymbol; -using MalInt = Mal.types.MalInt; -using MalList = Mal.types.MalList; -using MalVector = Mal.types.MalVector; -using MalHashMap = Mal.types.MalHashMap; -using MalFunc = Mal.types.MalFunc; -using Env = Mal.env.Env; - -namespace Mal { - class step7_quote { - // read - static MalVal READ(string str) { - return reader.read_str(str); - } - - // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - foreach (MalVal mv in old_lst.getValue()) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast is MalHashMap) { - var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { - new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); - } - return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast[0]; - - String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - - switch (a0sym) { - case "def!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - env.set((MalSymbol)a1, res); - return res; - case "let*": - a1 = ast[1]; - a2 = ast[2]; - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1)[i]; - val = ((MalList)a1)[i+1]; - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast[1]; - case "quasiquote": - orig_ast = quasiquote(ast[1]); - break; - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast[ast.size()-1]; - break; - case "if": - a1 = ast[1]; - MalVal cond = EVAL(a1, env); - if (cond == Mal.types.Nil || cond == Mal.types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast[3]; - } else { - return Mal.types.Nil; - } - } else { - // eval true slot form - orig_ast = ast[2]; - } - break; - case "fn*": - MalList a1f = (MalList)ast[1]; - MalVal a2f = ast[2]; - Env cur_env = env; - return new MalFunc(a2f, env, a1f, - args => EVAL(a2f, new Env(cur_env, a1f, args)) ); - default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.rest()); - } else { - return f.apply(el.rest()); - } - break; - } - - } - } - - // print - static string PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - static void Main(string[] args) { - var repl_env = new Mal.env.Env(null); - Func RE = (string str) => EVAL(READ(str), repl_env); - - // core.cs: defined using C# - foreach (var entry in core.ns) { - repl_env.set(new MalSymbol(entry.Key), entry.Value); - } - repl_env.set(new MalSymbol("eval"), new MalFunc( - a => EVAL(a[0], repl_env))); - int fileIdx = 1; - if (args.Length > 0 && args[0] == "--raw") { - Mal.readline.mode = Mal.readline.Mode.Raw; - fileIdx = 2; - } - MalList _argv = new MalList(); - for (int i=fileIdx; i < args.Length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE("(def! not (fn* (a) (if a false true)))"); - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - - if (args.Length > fileIdx) { - RE("(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - while (true) { - string line; - try { - line = Mal.readline.Readline("user> "); - if (line == null) { break; } - if (line == "") { continue; } - } catch (IOException e) { - Console.WriteLine("IOException: " + e.Message); - break; - } - try { - Console.WriteLine(PRINT(RE(line))); - } catch (Mal.types.MalContinue) { - continue; - } catch (Exception e) { - Console.WriteLine("Error: " + e.Message); - Console.WriteLine(e.StackTrace); - continue; - } - } - } - } -} diff --git a/cs/step8_macros.cs b/cs/step8_macros.cs deleted file mode 100644 index cac141131b..0000000000 --- a/cs/step8_macros.cs +++ /dev/null @@ -1,258 +0,0 @@ -using System; -using System.IO; -using System.Collections; -using System.Collections.Generic; -using Mal; -using MalVal = Mal.types.MalVal; -using MalString = Mal.types.MalString; -using MalSymbol = Mal.types.MalSymbol; -using MalInt = Mal.types.MalInt; -using MalList = Mal.types.MalList; -using MalVector = Mal.types.MalVector; -using MalHashMap = Mal.types.MalHashMap; -using MalFunc = Mal.types.MalFunc; -using Env = Mal.env.Env; - -namespace Mal { - class step8_macros { - // read - static MalVal READ(string str) { - return reader.read_str(str); - } - - // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static bool is_macro_call(MalVal ast, Env env) { - if (ast is MalList) { - MalVal a0 = ((MalList)ast)[0]; - if (a0 is MalSymbol && - env.find((MalSymbol)a0) != null) { - MalVal mac = env.get((MalSymbol)a0); - if (mac is MalFunc && - ((MalFunc)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; - MalFunc mac = (MalFunc) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - foreach (MalVal mv in old_lst.getValue()) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast is MalHashMap) { - var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { - new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); - } - return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - - if (ast.size() == 0) { return ast; } - a0 = ast[0]; - - String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - - switch (a0sym) { - case "def!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - env.set((MalSymbol)a1, res); - return res; - case "let*": - a1 = ast[1]; - a2 = ast[2]; - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1)[i]; - val = ((MalList)a1)[i+1]; - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast[1]; - case "quasiquote": - orig_ast = quasiquote(ast[1]); - break; - case "defmacro!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - ((MalFunc)res).setMacro(); - env.set(((MalSymbol)a1), res); - return res; - case "macroexpand": - a1 = ast[1]; - return macroexpand(a1, env); - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast[ast.size()-1]; - break; - case "if": - a1 = ast[1]; - MalVal cond = EVAL(a1, env); - if (cond == Mal.types.Nil || cond == Mal.types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast[3]; - } else { - return Mal.types.Nil; - } - } else { - // eval true slot form - orig_ast = ast[2]; - } - break; - case "fn*": - MalList a1f = (MalList)ast[1]; - MalVal a2f = ast[2]; - Env cur_env = env; - return new MalFunc(a2f, env, a1f, - args => EVAL(a2f, new Env(cur_env, a1f, args)) ); - default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.rest()); - } else { - return f.apply(el.rest()); - } - break; - } - - } - } - - // print - static string PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - static void Main(string[] args) { - var repl_env = new Mal.env.Env(null); - Func RE = (string str) => EVAL(READ(str), repl_env); - - // core.cs: defined using C# - foreach (var entry in core.ns) { - repl_env.set(new MalSymbol(entry.Key), entry.Value); - } - repl_env.set(new MalSymbol("eval"), new MalFunc( - a => EVAL(a[0], repl_env))); - int fileIdx = 1; - if (args.Length > 0 && args[0] == "--raw") { - Mal.readline.mode = Mal.readline.Mode.Raw; - fileIdx = 2; - } - MalList _argv = new MalList(); - for (int i=fileIdx; i < args.Length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE("(def! not (fn* (a) (if a false true)))"); - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - if (args.Length > fileIdx) { - RE("(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - while (true) { - string line; - try { - line = Mal.readline.Readline("user> "); - if (line == null) { break; } - if (line == "") { continue; } - } catch (IOException e) { - Console.WriteLine("IOException: " + e.Message); - break; - } - try { - Console.WriteLine(PRINT(RE(line))); - } catch (Mal.types.MalContinue) { - continue; - } catch (Exception e) { - Console.WriteLine("Error: " + e.Message); - Console.WriteLine(e.StackTrace); - continue; - } - } - } - } -} diff --git a/cs/step9_try.cs b/cs/step9_try.cs deleted file mode 100644 index bea360ccae..0000000000 --- a/cs/step9_try.cs +++ /dev/null @@ -1,283 +0,0 @@ -using System; -using System.IO; -using System.Collections; -using System.Collections.Generic; -using Mal; -using MalVal = Mal.types.MalVal; -using MalString = Mal.types.MalString; -using MalSymbol = Mal.types.MalSymbol; -using MalInt = Mal.types.MalInt; -using MalList = Mal.types.MalList; -using MalVector = Mal.types.MalVector; -using MalHashMap = Mal.types.MalHashMap; -using MalFunc = Mal.types.MalFunc; -using Env = Mal.env.Env; - -namespace Mal { - class step9_try { - // read - static MalVal READ(string str) { - return reader.read_str(str); - } - - // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static bool is_macro_call(MalVal ast, Env env) { - if (ast is MalList) { - MalVal a0 = ((MalList)ast)[0]; - if (a0 is MalSymbol && - env.find((MalSymbol)a0) != null) { - MalVal mac = env.get((MalSymbol)a0); - if (mac is MalFunc && - ((MalFunc)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; - MalFunc mac = (MalFunc) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - foreach (MalVal mv in old_lst.getValue()) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast is MalHashMap) { - var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { - new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); - } - return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - - if (ast.size() == 0) { return ast; } - a0 = ast[0]; - - String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - - switch (a0sym) { - case "def!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - env.set((MalSymbol)a1, res); - return res; - case "let*": - a1 = ast[1]; - a2 = ast[2]; - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1)[i]; - val = ((MalList)a1)[i+1]; - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast[1]; - case "quasiquote": - orig_ast = quasiquote(ast[1]); - break; - case "defmacro!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - ((MalFunc)res).setMacro(); - env.set(((MalSymbol)a1), res); - return res; - case "macroexpand": - a1 = ast[1]; - return macroexpand(a1, env); - case "try*": - try { - return EVAL(ast[1], env); - } catch (Exception e) { - if (ast.size() > 2) { - MalVal exc; - a2 = ast[2]; - MalVal a20 = ((MalList)a2)[0]; - if (((MalSymbol)a20).getName() == "catch*") { - if (e is Mal.types.MalException) { - exc = ((Mal.types.MalException)e).getValue(); - } else { - exc = new MalString(e.StackTrace); - } - return EVAL(((MalList)a2)[2], - new Env(env, ((MalList)a2).slice(1,2), - new MalList(exc))); - } - } - throw e; - } - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast[ast.size()-1]; - break; - case "if": - a1 = ast[1]; - MalVal cond = EVAL(a1, env); - if (cond == Mal.types.Nil || cond == Mal.types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast[3]; - } else { - return Mal.types.Nil; - } - } else { - // eval true slot form - orig_ast = ast[2]; - } - break; - case "fn*": - MalList a1f = (MalList)ast[1]; - MalVal a2f = ast[2]; - Env cur_env = env; - return new MalFunc(a2f, env, a1f, - args => EVAL(a2f, new Env(cur_env, a1f, args)) ); - default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.rest()); - } else { - return f.apply(el.rest()); - } - break; - } - - } - } - - // print - static string PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - static void Main(string[] args) { - var repl_env = new Mal.env.Env(null); - Func RE = (string str) => EVAL(READ(str), repl_env); - - // core.cs: defined using C# - foreach (var entry in core.ns) { - repl_env.set(new MalSymbol(entry.Key), entry.Value); - } - repl_env.set(new MalSymbol("eval"), new MalFunc( - a => EVAL(a[0], repl_env))); - int fileIdx = 1; - if (args.Length > 0 && args[0] == "--raw") { - Mal.readline.mode = Mal.readline.Mode.Raw; - fileIdx = 2; - } - MalList _argv = new MalList(); - for (int i=fileIdx; i < args.Length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE("(def! not (fn* (a) (if a false true)))"); - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - if (args.Length > fileIdx) { - RE("(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - while (true) { - string line; - try { - line = Mal.readline.Readline("user> "); - if (line == null) { break; } - if (line == "") { continue; } - } catch (IOException e) { - Console.WriteLine("IOException: " + e.Message); - break; - } - try { - Console.WriteLine(PRINT(RE(line))); - } catch (Mal.types.MalContinue) { - continue; - } catch (Mal.types.MalException e) { - Console.WriteLine("Error: " + - printer._pr_str(e.getValue(), false)); - continue; - } catch (Exception e) { - Console.WriteLine("Error: " + e.Message); - Console.WriteLine(e.StackTrace); - continue; - } - } - } - } -} diff --git a/cs/stepA_mal.cs b/cs/stepA_mal.cs deleted file mode 100644 index 0ccb39e2d5..0000000000 --- a/cs/stepA_mal.cs +++ /dev/null @@ -1,285 +0,0 @@ -using System; -using System.IO; -using System.Collections; -using System.Collections.Generic; -using Mal; -using MalVal = Mal.types.MalVal; -using MalString = Mal.types.MalString; -using MalSymbol = Mal.types.MalSymbol; -using MalInt = Mal.types.MalInt; -using MalList = Mal.types.MalList; -using MalVector = Mal.types.MalVector; -using MalHashMap = Mal.types.MalHashMap; -using MalFunc = Mal.types.MalFunc; -using Env = Mal.env.Env; - -namespace Mal { - class stepA_mal { - // read - static MalVal READ(string str) { - return reader.read_str(str); - } - - // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static bool is_macro_call(MalVal ast, Env env) { - if (ast is MalList) { - MalVal a0 = ((MalList)ast)[0]; - if (a0 is MalSymbol && - env.find((MalSymbol)a0) != null) { - MalVal mac = env.get((MalSymbol)a0); - if (mac is MalFunc && - ((MalFunc)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; - MalFunc mac = (MalFunc) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - foreach (MalVal mv in old_lst.getValue()) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast is MalHashMap) { - var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { - new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); - } - return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - - if (ast.size() == 0) { return ast; } - a0 = ast[0]; - - String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - - switch (a0sym) { - case "def!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - env.set((MalSymbol)a1, res); - return res; - case "let*": - a1 = ast[1]; - a2 = ast[2]; - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1)[i]; - val = ((MalList)a1)[i+1]; - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast[1]; - case "quasiquote": - orig_ast = quasiquote(ast[1]); - break; - case "defmacro!": - a1 = ast[1]; - a2 = ast[2]; - res = EVAL(a2, env); - ((MalFunc)res).setMacro(); - env.set(((MalSymbol)a1), res); - return res; - case "macroexpand": - a1 = ast[1]; - return macroexpand(a1, env); - case "try*": - try { - return EVAL(ast[1], env); - } catch (Exception e) { - if (ast.size() > 2) { - MalVal exc; - a2 = ast[2]; - MalVal a20 = ((MalList)a2)[0]; - if (((MalSymbol)a20).getName() == "catch*") { - if (e is Mal.types.MalException) { - exc = ((Mal.types.MalException)e).getValue(); - } else { - exc = new MalString(e.StackTrace); - } - return EVAL(((MalList)a2)[2], - new Env(env, ((MalList)a2).slice(1,2), - new MalList(exc))); - } - } - throw e; - } - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast[ast.size()-1]; - break; - case "if": - a1 = ast[1]; - MalVal cond = EVAL(a1, env); - if (cond == Mal.types.Nil || cond == Mal.types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast[3]; - } else { - return Mal.types.Nil; - } - } else { - // eval true slot form - orig_ast = ast[2]; - } - break; - case "fn*": - MalList a1f = (MalList)ast[1]; - MalVal a2f = ast[2]; - Env cur_env = env; - return new MalFunc(a2f, env, a1f, - args => EVAL(a2f, new Env(cur_env, a1f, args)) ); - default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.rest()); - } else { - return f.apply(el.rest()); - } - break; - } - - } - } - - // print - static string PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - static void Main(string[] args) { - var repl_env = new Mal.env.Env(null); - Func RE = (string str) => EVAL(READ(str), repl_env); - - // core.cs: defined using C# - foreach (var entry in core.ns) { - repl_env.set(new MalSymbol(entry.Key), entry.Value); - } - repl_env.set(new MalSymbol("eval"), new MalFunc( - a => EVAL(a[0], repl_env))); - int fileIdx = 0; - if (args.Length > 0 && args[0] == "--raw") { - Mal.readline.mode = Mal.readline.Mode.Raw; - fileIdx = 1; - } - MalList _argv = new MalList(); - for (int i=fileIdx; i < args.Length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - // core.mal: defined using the language itself - RE("(def! *host-language* \"c#\")"); - RE("(def! not (fn* (a) (if a false true)))"); - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - if (args.Length > fileIdx) { - RE("(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - RE("(println (str \"Mal [\" *host-language* \"]\"))"); - while (true) { - string line; - try { - line = Mal.readline.Readline("user> "); - if (line == null) { break; } - if (line == "") { continue; } - } catch (IOException e) { - Console.WriteLine("IOException: " + e.Message); - break; - } - try { - Console.WriteLine(PRINT(RE(line))); - } catch (Mal.types.MalContinue) { - continue; - } catch (Mal.types.MalException e) { - Console.WriteLine("Error: " + - printer._pr_str(e.getValue(), false)); - continue; - } catch (Exception e) { - Console.WriteLine("Error: " + e.Message); - Console.WriteLine(e.StackTrace); - continue; - } - } - } - } -} diff --git a/docs/FAQ.md b/docs/FAQ.md new file mode 100644 index 0000000000..4cfd83029c --- /dev/null +++ b/docs/FAQ.md @@ -0,0 +1,279 @@ +# Mal/Make-a-Lisp FAQ + + + +### Why did you create mal/make-a-lisp? +### OR Why the name "mal"? +### OR Why? +### OR Wat? + +In November of 2013, Alan Dipert gave a [lightning talk at +Clojure/conj](https://www.youtube.com/watch?v=bmHTFo2Rf2w#t=28m55s) +about [gherkin](https://github.com/alandipert/gherkin), a Lisp +implemented in bash. His presentation led me to ask myself the question +of whether a Lisp could be created using the GNU Make macro language. +As you have probably guessed, the answer to that question is yes. + +Interestingly, the current pedagogical/educational purpose of mal +happened due to a semantic naming accident (naming is such a fraught +task in computer science). If I am remembering correctly, the name +"mal" original meant "MAke Lisp". I do not remember precisely why +I continued to create more implementations, apart from the fact that +it was a fun challenge, but after the make implementation, many of the +others were relatively easy. At some point during that process, +I realized that the multiple implementations and incremental steps +(which was originally just for my own clarity) was a useful learning +tool and so the "mal" name became a double entendre for "Make, A Lisp" +and "make-a-lisp" (and eventually just the latter given that the make +implementation is now just a small part of the whole). + + + + +### Why is some code split into steps and some code not? + +The split between code that goes in steps and code that goes into other files +is not completely arbitrary (a bit arbitrary, but not completely). My rule of +thumb is something like this: if the code is specific and necessary for +implementing a Lisp then it belongs in the step files. If the purpose of the +code is for implementing new dynamic data-types/objects and the functions or +methods that operate on those types, then it goes in separate files. + +If the target language has types and functions that resemble mal types, then +those files tend to be very small or non-existent. Examples: + +* the mal implementation has no types, reader, printer files and + has a trivial core file (just to hoist underlying functions) +* the Clojure implementation has no types file and a fairly trivial + core file +* ruby types and the functions that operate on them are very "Lispy" + so the Ruby types file and core file are very small. + +The env file is somewhat more arbitrary, however, it is +a self-contained module that is implemented early and changes very +little after that, so I decided to separate it. Also, for languages +that have hierarchical maps/dictionaries (e.g. Javascript +objects/prototype chain), you do not necessarily need an env file. + +Another way of summarizing this answer is that the step files +represent the core of what makes something a Lisp, the rest of the +modules are just language specific details (they may be the harder +than the Lisp part, but that is due to the nature of the target +language not because of Lisp functionality per se). + + + + +### Why are the mal/make-a-lisp steps structured the way they are? + +### OR Why is X functionality in step Y instead of step Z? + +There is no single consistent rule that I have used to determine which +functionality goes in which step and the arrangement has changed +numerous times since the beginning of the project. There are several +different goals that I try and balance in determining which +functionality goes into which step: + +* **Optimize Lisp learning**: I want developers who are unfamiliar with + Lisp to be able to use the project and guide to learn about Lisp + without becoming overwhelmed. In many Lisp introductions, concepts + like quoting and homoiconicity (i.e. a user exposed eval function) + are introduced early. But these are fairly foreign to most other + languages so they are introduced in later steps in mal. I also try + to not to concentrate too many Lisp concepts in a single step. So + many steps contain one or two Lisp concepts plus some core function + additions that support those concepts. + +* **Optimize implementation language learning (equal-ish step + sizing)**: I try to structure the steps so that the target + implementation can be learned incrementally. This goal is the one + that has caused me to refactor the steps the most. Different + languages have different areas that they optimize and make simple + for the developer. For example, in Java (prior to 8) and PostScript + creating the equivalent of anonymous functions and function closures + is painful. In other languages, function closures are trivial, but + IO and error handling are tedious when you are first learning the + language (I am looking at you Haskell). So this goal is really about + trying to balance step size across multiple languages. + +* **Practical results early and continuous feedback**: it is + a scientific fact that many small rewards are more motivating than + a single large reward (citation intentionally omitted, get a small + reward by googling it yourself). Each step in mal adds new + functionality that can actually be exercised by the implementer and, + just as importantly, easily tested. + +Also, the step structure of mal/make-a-lisp is not perfect. It never +will be perfect, but there are some areas that could be improved. The +most glaring problem is that step1 is on the heavy/large size because +in most languages you have to implement a good portion of the +reader/printer before you can begin using/testing the step. The +compromise I have settled on for now is to put extra detail in the +process guide for step1 and to be clear that many of the types are +deferrable until later. But I am always open to suggestions. + + + + +### Will you add my new implementation? + +Absolutely! I want mal to have a idiomatic implementation in every +programming language. + +Here is a quick checklist of what you need to do to merge a new +implementation: +- Follow the incremental layout (no extracted eval code) +- Dockerfile that defines requirements for building and running you + implementation and has this LABEL and + ``` + LABEL org.opencontainers.image.source=https://github.com/kanaka/mal + ``` +- Makefile: if it is a compiled/built implementation then add rules + for building each step and a clean rule. +- Add your implementation to IMPLS.yml + - if takes a long time to build add `SLOW: 1` +- Add implemenation to `Makefile.impls` + - Add to `IMPLS` variable (alphabetical order) + - Add a `*_STEP_TO_PROG` line for resolving artifacts to build and + run (if not compiled, just point to the step file itself) +- Update the top-level README.md: + - Increment the implementation and runtime counts + - Add to the table of implementations + - Add a build/run notes sub-section to the `Implementation + Details` section +- Create a pull request (this will trigger CI and allow review) +- Make sure that CI passes for your implementation including + self-hosting (some esoteric languages can have an exception to this) + +Here are more detailed guidelines for getting your implementation +accepted into the main repository: + +* Your implementation should follow the existing mal steps and + structure: Lisp-centric code (eval, eval_ast, quasiquote, + macroexpand) in the step files, other code in reader, printer, env, + and core files. See [code layout rationale](#code_split) above. + I encourage you to create implementations that take mal in new + directions for your own learning and experimentation, but for it to + be included in the main repository I ask that it follows the steps + and structure. + +* Your implementation should stick as much as possible to the accepted + idioms and conventions in that language. Try to create an + implementation that will not make an expert in that language say + "Woah, that's a strange way of doing things". And on that topic, + I make no guarantees that the existing implementations are + particularly idiomatic in their target languages (improvements are + welcome). However, if it is clear to me that your implementation is + not idiomatic in a given language then I will probably ask you to + improve it first. + +* Your implementation needs to be complete enough to self-host. This + means that all the mandatory tests should pass in both direct and + self-hosted modes: + ```bash + make "test^[IMPL_NAME]" + make MAL_IMPL=[IMPL_NAME] "test^mal" + ``` + You do not need to pass the final optional tests for stepA that are + marked as optional and not needed for self-hosting (except for the + `time-ms` function which is needed to run the micro-benchmark tests). + +* Create a `Dockerfile` in your directory that installs all the + packages necessary to build and run your implementation. In order to + integrate fully with the Github Actions CI workflow, the + `Dockerfile` needs to include the following boilerplate (with your + name, email, and implementation filled in): + ``` + MAINTAINER Your Name + LABEL org.opencontainers.image.source=https://github.com/kanaka/mal + LABEL org.opencontainers.image.description="mal test container: Your_Implementation" + ``` + + In addition, the docker image should provide python3 (with a python + symlink to it) to enable running tests using the image. Here is the + typical `Dockerfile` template you should use if your + implementation does not require a special base distro: + + ``` + FROM ubuntu:24.04 + MAINTAINER Your Name + LABEL org.opencontainers.image.source=https://github.com/kanaka/mal + LABEL org.opencontainers.image.description="mal test container: Your_Implementation" + ########################################################## + # General requirements for testing or common across many + # implementations + ########################################################## + + RUN apt-get -y update + + # Required for running tests + RUN apt-get -y install make python3 + RUN ln -sf /usr/bin/python3 /usr/bin/python + + # Some typical implementation and test requirements + RUN apt-get -y install curl libreadline-dev libedit-dev + + RUN mkdir -p /mal + WORKDIR /mal + + ########################################################## + # Specific implementation requirements + ########################################################## + + ... Your packages ... + ``` + +* Build and tag your docker image. The image tag will have the + form `ghcr.io/kanaka/mal-test-[IMPL_NAME]:[VOOM_VERSION]`. + ``` + make "docker-build^[IMPL_NAME]" + +* The top-level Makefile has support for building/testing using + the docker image with the `DOCKERIZE` flag: + ```bash + make DOCKERIZE=1 "test^[IMPL_NAME]" + make DOCKERIZE=1 MAL_IMPL=[IMPL_NAME] "test^mal" + ``` + +* Make sure the CI build and test scripts pass locally: + ```bash + ./ci.sh build [IMPL_NAME] + ./ci.sh test [IMPL_NAME] + ``` + +* Push your code to a branch and make sure that the automated Github + Actions CI passes for your implementation. + +* If you are creating a new implementation for an existing + implementation (or somebody beats you to the punch while you are + working on it), there is still a chance I will merge your + implementation. If you can make a compelling argument that your + implementation is more idiomatic or significantly better in some way + than the existing implementation then I may replace the existing + one. However, if your approach is different or unique from the + existing implementation, there is still a good chance I will merge + your implementation side-by-side with the existing one. At the very + least, even if I decide not to merge your implementation, I am + certainly willing to link to you implementation once it is + completed. + +* You do not need to implement line editing (i.e. readline) + functionality for your implementation, however, it is a nice + convenience for users of your implementation and I personally find + it saves a lot of time when I am creating a new implementation to + have line edit support early in the process. + +### Why do some mal forms end in "\*" or "!" (swap!, def!, let\*, etc)? + +The forms that end in a bang mutate something: +* **def!** mutates the current environment +* **swap!** and **reset!** mutate an atom to refer to a new value + +The forms that end in a star are similar to similar Clojure forms but +are more limited in functionality: +* **fn\*** does not do parameter destructuring and only supports + a single body form. +* **let\*** does not do parameter destructuring +* **try\*** and **catch\*** do not support type matching of + exceptions + diff --git a/docs/Hints.md b/docs/Hints.md new file mode 100644 index 0000000000..3686cc833d --- /dev/null +++ b/docs/Hints.md @@ -0,0 +1,123 @@ +# Mal/Make-a-Lisp Implementation Hints + + + +### How do I get milliseconds since epoch for the "time-ms" function? +### Does the "time-ms" function have to return millisecond since epoch? + +Most languages usually have some way to do this natively even though +it might be buried deeply in the language. If you are having trouble +finding how to do this in your target language, consider asking the +question on stackoverflow (if it has not been asked already) or asking +on a discussion channel for your language because there is a good +chance somebody there knows how and will answer quickly (if there is +a native way at all). + +As a last resort you can always shell out and call the date command +like this: + +``` +date +%s%3N +``` + +There are currently two implementations where this method was +necessary (probably): bash and make. Unfortunately this method is +limited to Linux/UNIX. + +Also, "time-ms" technically just needs to return accurate milliseconds +since some arbitrary point in time (even program start) in order to be +used correctly for timing/benchmarking. For consistency it is best if +it returns epoch milliseconds, but this is not strictly required if +you language limitations make it difficult (e.g. size limit of +integers). + + + + +### How do I implement core/native functions if my language does not have any sort of function references (function pointers, closures, lambdas, etc)? +### How do I implement mal functions in step4 if I do not have function references? + +There are very few language that do not have any sort of function +references so I suggest asking about the specific problem you are +having on stackoverflow or a discussion channel for your language. In +the rare case where you have a language without some sort of function +reference abstraction, then you may have to implement a single +function with a large switch statement (or equivalent) that calls out +to the appropriate native core function ("+", "list", "throw", etc). +In other words, you create a function that implements "function +references" rather than using a feature of your language. You will +still need to store the symbol names for those function in the base +REPL environment but you will have some sort of tagging or marker that +will indicate to the `EVAL` function that it should call your "big +switch" function. + +In addition, if your language has no sort of closure/anonymous +function capability (note that with sufficient object oriented +features you can implement closure like functionality), then in step4 +you will need to borrow the way that functions are implemented from +step5. In other words, functions become a normal data type that stores +the function body (AST), the parameter list and the environment at the +time the function is defined. When the function is invoked, `EVAL` +will then evaluate these stored items rather than invoking a function +closure. It is less convenient to have to do this at step4, but the +bright side is that step5 will be simpler because you just have to +implement the TCO loop because you have already refactored how +functions are stored in step4. + + + +### How do I implement terminal input and output in a language which does not have standard I/O capabilities? + +If your target language has some way to get data in and out while it +is running (even if it is not standard terminal or file I/O) then you +will need to create some sort of wrapper script (see +`vimscript/run_vimscript.sh`) or call out to a shell script (see +`make/readline.mk` and `make/util.mk`) or implement some other +"appropriate" hack to to get the data in and out. As long +as your implementation can be used with the test runner and the hack +is just for working around I/O limitations in your target language, +it is considered legitimate for upstream inclusion. + +### How do I read the command-line arguments if my language runtime doesn't support access to them? + +Most languages give access to the command-line arguments that were passed to +the program, either as an argument to the `main` function (like `argc` and +`argv` in C) or as a global variable (like `sys.argv` in Python). If your +target language doesn't have such mechanisms, consider adding a wrapper script +that will read the command-line arguments that were passed to the script and +pass them to the program in a way that the program can read. This might be +through an environment variable (if the target language allows reading from +environment variables) or through a temporary file. + + + + +### How can I implement the reader without using a mutable object? + +You do not need a mutable object, but you do need someway of keeping +track of the current position in the token list. One way to implement +this is to pass both the token list and the current position to the +reader functions (read_form, read_list, read_atom, etc) and return +both the parsed AST and the new token list position. If your language +does not allow multiple values to be returned from functions then you +may need to define a data structure to return both the new position +and the parsed AST together. In other words, the pseudo-code would +look something like this: + +``` +ast, position = read_list(tokens, position) +``` + +--- + +Answers for the following questions are TBD. + +### How do I implement slurp in a language without the ability to read raw file data? + + + +### How do I support raising/throwing arbitrary objects in a language that does not support that? +### What do I do if my implementation language only supports string exceptions? + + + diff --git a/docs/TODO b/docs/TODO index 68c53931ba..a9a09d210d 100644 --- a/docs/TODO +++ b/docs/TODO @@ -1,23 +1,46 @@ -All: - - Finish guide.md - - - test to check args set properly - - test to make sure slurp captures final newline - - make sure errors propagate/print properly when self-hosted - - * change perf test to run for 10 seconds and then calculate number - of iterations per second - - redefine (defmacro!) as (def! (macro*)) - - runtest expect fixes: - * stop using expect, so we can drop --raw option - * fix C#, VB - - fix long line splitting in runtest - - regular expression matching in runtest - - add re (use in rep) everywhere and use that (to avoid printing) - - Implement/fix interop - - Print full exception when test gets EOF from expect - - - metadata on symbols +General: + * update language graph code and data + - pull from GHA instead of Travis + + * Add self-hosted CI mode/variable + + * Go through PRs. Close or update. + + * Add quick checklist for merging upstream to FAQ: + + * Add PR template/checklist. + + * Update diagrams to reflect the merged eval-ast/macroexpand + process. + + * Check that implementations are actually running self-hosted. + Check for "mal-user>" prompt or something. + + * update language graph code and data + * pull from GHA instead of Travis + + * update get-changed-files + * use GITHUB_OUTPUT instead of set-output + * update version of node + + - Fix self-hosted implementations #662 + + - Fix wasm modes wax and wace_libc + + - Fix wasm perf3 hang/OOM + +All/multiple Implementations: + - Add step3 and step4 tests. Fix powershell, jq, and xslt with + binding/closures. https://github.com/kanaka/mal/issues/645 + +--------------------------------------------- + +Other ideas for All: + - redefine (defmacro!) as (def! foo (macro*)) + - Fix/implement interop in more implementations + + - propagate/print errors when self-hosted + - metadata on symbols (as per Clojure) - metadata as a map only. ^ merges metadata in the reader itself. Line numbers in metadata from reader. - protocols! @@ -32,43 +55,29 @@ All: a *namespaces* map is found with the namespace name being looked up. Then the symbol would be looked up starting in the namespace environment. Need protocols first probably. - - Break out impl eval into step0.5 - - Fix quasiquoting of vectors - - - Get self-host working at earlier step: - - Move try* to step6 - - Remove macros from mal - multi-line REPL read - - loop/recur ? + - explicit recur in loops (for error checking) - gensym reader inside quasiquote + - standalone executables - - per impl tests for step5_tco --------------------------------------------- Bash: - explore using ${!prefix*} syntax (more like make impl) - GC + - maybe make it work more like basic/wasm C: - come up with better way to do 20 vararg code - - GC: use http://www.hboehm.info/gc/ - - fix mal/clojurewest2014.mal C#: - - fix command line arg processing (doesn't run file specified) - accumulates line breaks with mal/clojurewest2014.mal - - step9_interop: - http://www.ckode.dk/programming/eval-in-c-yes-its-possible/ - -Clojure: - - make indent consistent across steps (e.g. step5, step8) - - fix mal/clojurewest2014.mal + - interop: http://www.ckode.dk/programming/eval-in-c-yes-its-possible/ CoffeeScript: - make target to compile to JS - - fix "user> " prompt with mal/clojurewest2014.mal Go: - consider variable arguments in places where it makes sense @@ -77,28 +86,21 @@ Go: Haskell: - TCO using seq/bang patterns: http://stackoverflow.com/questions/9149183/tail-optimization-guarantee-loop-encoding-in-haskell - - immediately exits mal/clojurewest2014.mal + - immediately exits mal/clojurewest2014.mal ("\/" exception) Java: + - build step, don't use mvn in run script - Use gradle instead of mvn http://blog.paralleluniverse.co/2014/05/01/modern-java/ - - MAL formatting is a bit off with mal/clojurewest2014.mal Javascript: - interop: adopt techniques from miniMAL - - fix "user> " prompt with mal/clojurewest2014.mal - -Lua: - - time-ms should get actual milliseconds Make: - allow '_' in make variable names - hash-map with space in key string - - Fix: make -f stepA_mal.mk ../mal/step6_file.mal - (slurp "../tests/incA.mal") - (read-string "(+ 2 3)") - errors should propagate up from within load-file - - GC: expore using "undefined" directive in Make 3.82 + - GC: explore using "undefine" directive in Make 3.82 Mal: - line numbers in errors @@ -107,85 +109,46 @@ Mal: miniMAL: - figure out why {} literals are "static"/persistent +ObjPascal: + - verify that GC/reference counting works + - fix comment by itself error at REPL + +plpgsql: + - maybe combine wrap.sh and run + Perl: - fix metadata on native functions - - implement conj - -PHP: - - formatting messed up with mal/clojurewest2014.mal + - fix extra line breaks at REPL Postscript: - add negative numbers - fix blank line after comments - fix command line arg processing (doesn't run file specified) - - formatting messed up with mal/clojurewest2014.mal -Python: - - error: python ../python/stepA_mal.py ../mal/stepA_mal.mal ../mal/stepA_mal.mal - - interop tests +Powershell: + - convert function with "abc_def" to "abc-def" + - remove extraneous return statements at end of functions + - remove unnecessary semi-colons + - use ArrayList instead of Array for performance + - new test to test Keys/keys as hash-map key + - test *? predicates with nil R: - tracebacks in errors - fix running from different directory - - formatting messed up with mal/clojurewest2014.mal Racket - metadata on collections -Ruby: - Rust: - - use built-in regex once fixed: - https://github.com/rust-lang/rust/issues/18034 - https://github.com/rust-lang/rust/issues/18035 - fix 'make all' invocation of cargo build - - formatting messed up with mal/clojurewest2014.mal Scala - readline - fix exception when finished running something on command line -VB.Net - - convert readline.cs to readline.vb - - ---------------------------------------------- - - -Future Implementations: - - - Ada (gnat) - - http://rosettacode.org/wiki/Regular_expressions#Ada - - - C++ - - - Groovy - - http://groovy-lang.org/learn.html - - http://groovy-lang.org/structure.html - - - Erlang - - - F# - - - Haxe - - http://api.haxe.org/ - - http://haxe.us/haxe_tutorial.html - - - Julia - - - Nim - - - Objective-C: - - - Pascal: - sudo aptitude install fp-compiler-2.6.2 - - - VimL - - https://github.com/tpope/timl - - - Tcl +VHDL: + - combine run_vhdl.sh and run - - TeX/LaTeX - - Basic interpreter in TeX: http://ctanhg.scharrer-online.de/pkg/basix.html - - Cheat Sheet: http://www.stdout.org/~winston/latex/latexsheet.pd - - latex '\nonstopmode\input' blah.tex +vimscript: + - combine run_vimscript.sh and run diff --git a/docs/cheatsheet.html b/docs/cheatsheet.html new file mode 100644 index 0000000000..28719052b3 --- /dev/null +++ b/docs/cheatsheet.html @@ -0,0 +1,257 @@ + + + + + +

Make-A-Lisp Cheatsheet

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Step 1 Step 6
+ +
reader.EXT:
+  Reader(tokens) object: position, next(), peek()
+  tokenize:  /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/
+  read_atom: int, float, string (escaped), keyword, nil, true, false, symbol
+  read_list: repeatedly read_form until end token (EOF is error)
+  read_form: expand reader macros, read_list (vector/maps too), or read_atom
+  read_str:  tokenize, error if no tokens, call read_form(Reader(tokens))
+printer.EXT:
+  pr_str(ast, print_readably):
+    - map pr_str across collections
+    - unescape strings if print_readably
+step1_read_print.EXT:
+  main(args): loop: writeline PRINT(EVAL(READ(readline()), ""))
+
+ 		+
core.EXT:
+  read-string: call reader.read_str
+  slurp: return file content as a string
+  atom, atom?, deref, reset!, swap!: atom functions
+step6_file.EXT:
+  main(args):
+    - add eval and *ARGV* to repl_env
+    - define load-file using rep
+    - if args, set *ARGV* to rest(args) and call load-file with args[0]
+
+
+
+
+
+
   
Step 2 Step 7
+
step2_eval.EXT:
+  eval_ast(ast, env): lookup symbols in env, map EVAL across collections
+  EVAL(ast, env):
+    - if not list?(ast), return eval_ast(ast, env)
+    - otherwise apply (ast is a list):
+      el = eval_ast(ast, env)
+      return el[0](rest(el))
+  main(args): loop: writeline PRINT(EVAL(READ(readline()), {+: add, ...}))
+
+
+
+
+ 		+
core.EXT:
+  cons, concat: sequence functions
+step7_quote.EXT:
+  quasiquote(ast):
+    - ast is empty or not a list   -> (quote ast)
+    - (unquote FOO)                -> FOO
+    - ((splice-unquote FOO) BAR..) -> (concat FOO quasiquote(BAR...))
+    - (FOO BAR...)                 -> (cons FOO quasiquote(BAR...))
+  EVAL(ast, env):
+    - quote      -> return ast[1]
+    - quasiquote -> set ast to quasiquote(ast[1]), loop
+
+
   
Step 3 Step 8
+
env.EXT:
+  Env(outer) object: data, set(k, v), find(k), get(k)
+step3_env.EXT:
+  eval_ast(ast, env): switch to env.get for symbol lookup
+  EVAL(ast, env):
+    - def!  -> return env.set(ast[1], EVAL(ast[2], env))
+    - let*  -> create new env let_env
+               for each ODD/EVEN pair in ast[1]:
+                 let_env.set(ODD, EVAL(EVEN, let_env))
+               return EVAL(ast[2], let_env)
+  main(args): populate repl_env with numeric functions using repl_env.set
+
+ 		+
core.EXT:
+  nth, first, rest: sequence functions
+step8_macros.EXT:
+  macroexpand(ast, env):
+    - while env.get(ast[0]) is a macro: ast = env.get(ast[0])(rest(ast))
+  EVAL(ast, env):
+    - before apply section, add ast = macroexpand(ast, env)
+    - defmacro!   -> same as def!, but set mal function macro flag
+    - macroexpand -> return macroexpand(ast[1], env)
+
+
+
+
   
Step 4 Step 9
+
env.EXT:
+  Env(outer, binds, exprs) object: map binds to exprs, handle "&" as variadic
+core.EXT:
+  =: recursive compare of collections
+  pr-str, str: return pr_str(arg, true) join " ", pr_str(arg, false) join ""
+  prn, println: print pr_str(arg, true) join "", pr_str(arg, false) join ""
+  <, <=, >, >=, +, -, *, /: numeric comparison and numeric operations
+  list, list?, empty?, count: sequence functions
+step4_do_if_fn.EXT:
+  EVAL(ast, env):
+    - do  -> return last element of eval_ast(ast, env)
+    - if  -> if EVAL(ast[1], env): return EVAL(ast[2], env)
+             else                : return EVAL(ast[3], env)
+    - fn* -> return closure:
+               (args) -> EVAL(ast[2], new Env(env, ast[1], args))
+  main(args): populate repl_env with core functions, define not using rep()
+
+ 		+
core.EXT:
+  throw: raise mal value as exception (maybe wrap in native exception)
+  vector, vector?: sequence functions
+  hash-map, get, contains?, keys, vals: hash-map functions
+  assoc, dissoc: immutable hash-map transform functions
+  apply(f, args..., last): return f(concat(args, last))
+  map(f, args): return list of mapping f on each args
+step9_try.EXT:
+  EVAL(ast, env):
+    - try* -> try EVAL(ast[1], env)
+                catch exception exc (unwrap if necessary):
+                  new err_env with ast[2][1] symbol bound to exc
+                  EVAL(ast[2][2], err_env)
+
+
+
+
+
   
Step 5 Step A
+
step5_tco.EXT:
+  EVAL(ast, env):
+    - top level loop in EVAL
+    - let*  -> set env to let_env, set ast to ast[2], loop
+    - do    -> eval_ast of middle elements, sets ast to last element, loop
+    - if    -> set ast to ast[2] or ast[3] (or nil) depending condition, loop
+    - fn*   -> return new mal function type f with:
+                f.ast=ast[2], f.params=ast[1], f.env=env
+    - apply -> el = eval_ast(ast, env)
+               f = el[0]
+               if f is a mal function: ast = f.ast and env = f.env, loop
+               else                  : return el[0](rest(el))
+
+
+ 		+
core.EXT:
+  string?: true if string
+  readline: prompt and read a line of input (synchronous)
+  time-ms: return milliseconds since epoch (1970-1-1)
+  conj, seq: type specific sequence functions
+  meta, with-meta: metadata functions
+step9_try.EXT:
+  EVAL(ast, env):
+    - set *host-language* in repl_env to host language name
+  main(args): rep("(println (str \"Mal [\" *host-language* \"]\"))")
+
+
   
+ + diff --git a/docs/exercises.md b/docs/exercises.md new file mode 100644 index 0000000000..6fa7869417 --- /dev/null +++ b/docs/exercises.md @@ -0,0 +1,129 @@ +# Exercises to learn MAL + +The process introduces LISP by describing the internals of selected +low-level constructs. As a complementary and more traditional +approach, you may want to solve the following exercises in the MAL +language itself, using any of the existing implementations. + +You are encouraged to use the shortcuts defined in the step files +(`not`...) and `the `lib/` subdirectory (`reduce`...) whenever you +find that they increase the readability. + +The difficulty is progressive in each section, but they focus on +related topics and it is recommended to start them in parallel. + +Some solutions are given in the `examples` directory. Feel free to +submit new solutions, or new exercises. + +## Replace parts of the process with native constructs + +Once you have a working implementation, you may want to implement +parts of the process inside the MAL language itself. This has no other +purpose than learning the MAL language. Once it exists, a built-in +implementation will always be more efficient than a native +implementation. Also, the functions described in MAL process are +selected for educative purposes, so portability accross +implementations does not matter much. + +You may easily check your answers by passing them directly to the +interpreter. They will hide the built-in functions carrying the same +names, and the usual tests will check them. +``` +make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' test^IMPL^stepA +``` + +- Implement `nil?`, `true?`, `false?`, `empty?` and `sequential` with + another built-in function. + +- Implement `>`, `<=` and `>=` with `<`. + +- Implement `list`, `vec`, `prn`, `hash-map` and `swap!` as non-recursive + functions. + +- Implement `count`, `nth`, `map`, `concat` and `conj` with the empty + constructor `()`, `empty?`, `cons`, `first` and `rest`. + + You may use `or` to make the definition of `nth` a bit less ugly, + but avoid `cond` because its definition refers to `nth`. + + Let `count` and `nth` benefit from tail call optimization. + + Try to replace explicit recursions with calls to `reduce` and `foldr`. + + Once you have tested your solution, you should comment at least + `nth`. Many implementations, for example `foldr` in `core.mal`, + rely on an efficient `nth` built-in function. + +- Implement the `do` special as a non-recursive function. The special + form will hide your implementation, so in order to test it, you will + need to give it another name and adapt the test accordingly. + +- Implement quoting with macros. + The same remark applies. + +- Implement most of `let*` as a macro that uses `fn*` and recursion. + The same remark applies. + A macro is necessary because a function would attempt to evaluate + the first argument. + + Once your answer passes most tests and you understand which part is + tricky, you should search for black magic recipes on the web. Few of + us mortals are known to have invented a full solution on their own. + +- Implement `apply`. + +- Implement maps using lists. + - Recall how maps must be evaluated. + - In the tests, you may want to replace `{...}` with `(hash-map ...)`. + - An easy solution relies on lists alterning keys and values, so + that the `hash-map` is only a list in reverse order so that the + last definition takes precedence during searches. + - As a more performant solution will use lists to construct trees, + and ideally keep them balanced. You will find examples in most + teaching material about functional languages. + - Recall that `dissoc` is an optional feature. One you can implement + dissoc is by assoc'ing a replacement value that is a magic delete + keyword (e.g.: `__..DELETED..__`) which allows you to shadow + values in the lower levels of the structure. The hash map + functions have to detect that and do the right thing. e.g. `(keys + ...)` might have to keep track of deleted values as it is scanning + the tree and not add those keys when it finds them further down + the tree. + +- Implement macros within MAL. + +## More folds + +- Compute the sum of a sequence of numbers. +- Compute the product of a sequence of numbers. + +- Compute the logical conjunction ("and") and disjunction ("or") of a + sequence of MAL values interpreted as boolean values. For example, + `(conjunction [true 1 0 "" "a" nil true {}])` + should evaluate to `false` or `nil` because of the `nil` element. + + Why are folds not the best solution here, in terms of average + performances? + +- Does "-2-3-4" translate to `(reduce - 0 [2 3 4])`? + +- Suggest better solutions for + `(reduce str "" xs)` and + `(reduce concat [] xs)`. + +- What does `(reduce (fn* [acc _] acc) xs)` nil answer? + +- The answer is `(fn* [xs] (reduce (fn* [_ x] x) nil xs))`. + What was the question? + +- What is the intent of + `(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)`? + + Why is it the wrong answer? + +- Though `(sum (map count xs))` or `(count (apply concat xs))` can be + considered more readable, implement the same effect with a single loop. +- Compute the maximal length in a list of lists. + +- How would you name + `(fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs))`? diff --git a/docs/graph/README.md b/docs/graph/README.md new file mode 100644 index 0000000000..12100f2c9a --- /dev/null +++ b/docs/graph/README.md @@ -0,0 +1,72 @@ +# Mal Implementation Stats Graph + + +## Updating the data + +* Install prerequisites: + +For ubuntu: +``` +sudo apt-get install gh +sudo apt-get golang +``` + +For macos: +``` +brew install gh +brew install go +``` + +* Create logs dir and enter graph dir: +``` +mkdir -p docs/graph/logs +cd docs/graph/logs +``` + +* Install npm deps +``` +npm install +``` + +* Clone and build loccount: +``` +git clone https://gitlab.com/esr/loccount +make -C loccount +``` + +* Auth with github: +``` +gh auth login +``` + +* Download artifacts from a recent full and successful workflow run: + +``` +# list workflow runs +$ gh run list --repo kanaka/mal + +# Download recent full successful run: +$ gh run download 10598199016 --repo kanaka/mal +``` + +* Run the [StackOverflow tags + query](https://data.stackexchange.com/stackoverflow/query/edit/1013465) + and then download the CSV link: + +``` +curl https://data.stackexchange.com/stackoverflow/csv/2267200 -o so-tags.csv +``` + +* Remove/clean all generated files: + +``` +( cd ../.. && git ls-files --others impls/ | xargs rm ) +``` + +* Download GitHub and StackOverflow data and generate the final + combined data set: + +``` +PATH=$PATH:$(pwd)/loccount +time VERBOSE=1 node ./collect_data.js logs/ all_data.json +``` diff --git a/docs/graph/all_data.json b/docs/graph/all_data.json new file mode 100644 index 0000000000..ca8a11683a --- /dev/null +++ b/docs/graph/all_data.json @@ -0,0 +1,2134 @@ +{ + "ada": { + "dir": "ada", + "name": "Ada", + "syntax": "Algol", + "type_check": "Static", + "modes": [], + "perf1": 10, + "perf2": 44, + "perf3": 974, + "pull_count": 261, + "pull_rank": 66, + "push_count": 19718, + "push_rank": 60, + "star_count": 554, + "star_rank": 68, + "sloc": 3547, + "files": 19, + "author_name": "Chris Moore", + "author_url": "https://github.com/zmower", + "so_count": 2416, + "so_rank": 57, + "lloc": 2199 + }, + "ada.2": { + "dir": "ada.2", + "name": "Ada #2", + "syntax": "Algol", + "type_check": "Static", + "modes": [], + "perf1": 1, + "perf2": 1, + "perf3": 84457, + "pull_count": 261, + "pull_rank": 67, + "push_count": 19718, + "push_rank": 61, + "star_count": 554, + "star_rank": 69, + "sloc": 2277, + "files": 30, + "author_name": "Nicolas Boulenguez", + "author_url": "https://github.com/asarhaddon", + "so_count": 2416, + "so_rank": 58, + "lloc": 1437 + }, + "awk": { + "dir": "awk", + "name": "GNU Awk", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 7, + "perf2": 24, + "perf3": 1356, + "pull_count": 2, + "pull_rank": 71, + "push_count": null, + "push_rank": null, + "star_count": 13346, + "star_rank": 54, + "sloc": 2203, + "files": 7, + "author_name": "Miutsuru Kariya", + "author_url": "https://github.com/kariya-mitsuru", + "so_count": 33144, + "so_rank": 30, + "lloc": 0 + }, + "bash": { + "dir": "bash", + "name": "Bash 4", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 787, + "perf2": 3465, + "perf3": 11, + "pull_count": 921358, + "pull_rank": 16, + "push_count": 3851409, + "push_rank": 16, + "star_count": 2264769, + "star_rank": 18, + "sloc": 1110, + "files": 7, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 156259, + "so_rank": 17, + "lloc": 0 + }, + "basic": { + "dir": "basic", + "name": "BASIC", + "syntax": "OTHER", + "type_check": "Static", + "modes": [ + "cbm", + "qbasic" + ], + "perf1": 6, + "perf2": 19, + "perf3": 1675, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1960, + "files": 13, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 858, + "so_rank": 65, + "lloc": 1697 + }, + "bbc-basic": { + "dir": "bbc-basic", + "name": "BBC BASIC V", + "syntax": "OTHER", + "type_check": "Static", + "modes": [], + "perf1": 60, + "perf2": 290, + "perf3": 149, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1355, + "files": 7, + "author_name": "Ben Harris", + "author_url": "https://github.com/bjh21", + "so_count": 9, + "so_rank": 85, + "lloc": 1353 + }, + "c": { + "dir": "c", + "name": "C", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 1, + "perf3": 36416, + "pull_count": 1411773, + "pull_rank": 13, + "push_count": 5888004, + "push_rank": 11, + "star_count": 4085282, + "star_rank": 10, + "sloc": 1990, + "files": 15, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 405875, + "so_rank": 10, + "lloc": 1069 + }, + "c.2": { + "dir": "c.2", + "name": "C #2", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 1, + "perf2": 3, + "perf3": 15820, + "pull_count": 1411773, + "pull_rank": 14, + "push_count": 5888004, + "push_rank": 12, + "star_count": 4085282, + "star_rank": 11, + "sloc": 3326, + "files": 16, + "author_name": "Duncan Watts", + "author_url": "https://github.com/fungiblecog", + "so_count": 405875, + "so_rank": 11, + "lloc": 1677 + }, + "cpp": { + "dir": "cpp", + "name": "C++", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 1, + "perf3": 33490, + "pull_count": 2960837, + "pull_rank": 7, + "push_count": 10016021, + "push_rank": 8, + "star_count": 5571338, + "star_rank": 8, + "sloc": 2021, + "files": 19, + "author_name": "Stephen Thirlwall", + "author_url": "https://github.com/sdt", + "so_count": 887548, + "so_rank": 7, + "lloc": 945 + }, + "cs": { + "dir": "cs", + "name": "C#", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 4, + "perf2": 5, + "perf3": 24285, + "pull_count": 1264911, + "pull_rank": 15, + "push_count": 4838573, + "push_rank": 14, + "star_count": 2687097, + "star_rank": 17, + "sloc": 1185, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 1652013, + "so_rank": 5, + "lloc": 582 + }, + "chuck": { + "dir": "chuck", + "name": "ChucK", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 24, + "perf2": 70, + "perf3": 142, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 2509, + "files": 87, + "author_name": "Vasilij Schneidermann", + "author_url": "https://github.com/wasamasa", + "so_count": 22, + "so_rank": 83, + "lloc": 963 + }, + "clojure": { + "dir": "clojure", + "name": "Clojure", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [ + "clj", + "cljs" + ], + "perf1": 10, + "perf2": 34, + "perf3": 7675, + "pull_count": 118302, + "pull_rank": 27, + "push_count": 556345, + "push_rank": 26, + "star_count": 296560, + "star_rank": 25, + "sloc": 408, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 17703, + "so_rank": 37, + "lloc": 0 + }, + "coffee": { + "dir": "coffee", + "name": "CoffeeScript", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 2, + "perf2": 6, + "perf3": 33096, + "pull_count": 135423, + "pull_rank": 26, + "push_count": 596268, + "push_rank": 25, + "star_count": 587936, + "star_rank": 21, + "sloc": 447, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 9742, + "so_rank": 42, + "lloc": 0 + }, + "common-lisp": { + "dir": "common-lisp", + "name": "Common Lisp", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 2, + "perf3": 35135, + "pull_count": 9583, + "pull_rank": 49, + "push_count": 85811, + "push_rank": 44, + "star_count": 52545, + "star_rank": 39, + "sloc": 1000, + "files": 11, + "author_name": "Iqbal Ansari", + "author_url": "https://github.com/iqbalansari", + "so_count": 6341, + "so_rank": 49, + "lloc": 0 + }, + "crystal": { + "dir": "crystal", + "name": "Crystal", + "syntax": "OTHER", + "type_check": "Static", + "modes": [], + "perf1": 1, + "perf2": 1, + "perf3": 64175, + "pull_count": 11247, + "pull_rank": 48, + "push_count": 35005, + "push_rank": 52, + "star_count": 29422, + "star_rank": 47, + "sloc": 944, + "files": 8, + "author_name": "Linda_pp", + "author_url": "https://github.com/rhysd", + "so_count": 662, + "so_rank": 67, + "lloc": 0 + }, + "d": { + "dir": "d", + "name": "D", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 0, + "perf3": 41431, + "pull_count": 8541, + "pull_rank": 52, + "push_count": 71800, + "push_rank": 49, + "star_count": 23317, + "star_rank": 48, + "sloc": 1281, + "files": 8, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 2644, + "so_rank": 56, + "lloc": 549 + }, + "dart": { + "dir": "dart", + "name": "Dart", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 5, + "perf2": 10, + "perf3": 17398, + "pull_count": 182518, + "pull_rank": 22, + "push_count": 245271, + "push_rank": 34, + "star_count": 280006, + "star_rank": 26, + "sloc": 935, + "files": 8, + "author_name": "Harry Terkelsen", + "author_url": "https://github.com/hterkelsen", + "so_count": 94667, + "so_rank": 23, + "lloc": 467 + }, + "elixir": { + "dir": "elixir", + "name": "Elixir", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 17, + "perf2": 43, + "perf3": 839, + "pull_count": 118076, + "pull_rank": 28, + "push_count": 266735, + "push_rank": 33, + "star_count": 216415, + "star_rank": 27, + "sloc": 669, + "files": 10, + "author_name": "Martin Ek", + "author_url": "https://github.com/ekmartin", + "so_count": 9601, + "so_rank": 44, + "lloc": 0 + }, + "elm": { + "dir": "elm", + "name": "Elm", + "syntax": "ML", + "type_check": "Static", + "modes": [], + "perf1": 19, + "perf2": 55, + "perf3": 1971, + "pull_count": 12978, + "pull_rank": 46, + "push_count": 59552, + "push_rank": 51, + "star_count": 38261, + "star_rank": 43, + "sloc": 2404, + "files": 13, + "author_name": "Jos van Bakel", + "author_url": "https://github.com/c0deaddict", + "so_count": 1895, + "so_rank": 61, + "lloc": 0 + }, + "elisp": { + "dir": "elisp", + "name": "Emacs Lisp", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 14, + "perf3": 5600, + "pull_count": 69374, + "pull_rank": 34, + "push_count": 366344, + "push_rank": 29, + "star_count": 207304, + "star_rank": 30, + "sloc": 725, + "files": 7, + "author_name": "Vasilij Schneidermann", + "author_url": "https://github.com/wasamasa", + "so_count": 3771, + "so_rank": 54, + "lloc": 0 + }, + "erlang": { + "dir": "erlang", + "name": "Erlang", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 32, + "perf2": 62, + "perf3": 344, + "pull_count": 79420, + "pull_rank": 31, + "push_count": 285722, + "push_rank": 31, + "star_count": 149139, + "star_rank": 31, + "sloc": 1130, + "files": 8, + "author_name": "Nathan Fiedler", + "author_url": "https://github.com/nlfiedler", + "so_count": 9674, + "so_rank": 43, + "lloc": 0 + }, + "es6": { + "dir": "es6", + "name": "ES6", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 3, + "perf3": 30500, + "pull_count": 6754454, + "pull_rank": 2, + "push_count": 24043941, + "push_rank": 2, + "star_count": 25547072, + "star_rank": 2, + "sloc": 474, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 519108, + "so_rank": 8, + "lloc": 0 + }, + "fsharp": { + "dir": "fsharp", + "name": "F#", + "syntax": "ML", + "type_check": "Static", + "modes": [], + "perf1": 6, + "perf2": 6, + "perf3": 35952, + "pull_count": 32510, + "pull_rank": 37, + "push_count": 145642, + "push_rank": 38, + "star_count": 44240, + "star_rank": 42, + "sloc": 1074, + "files": 11, + "author_name": "Peter Stephens", + "author_url": "https://github.com/pstephens", + "so_count": 18116, + "so_rank": 36, + "lloc": 2 + }, + "fennel": { + "dir": "fennel", + "name": "Fennel", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 2301, + "perf2": 7241, + "perf3": 4, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1, + "files": 1, + "author_name": "sogaiu", + "author_url": "https://github.com/sogaiu", + "so_count": 3, + "so_rank": 88, + "lloc": 0 + }, + "factor": { + "dir": "factor", + "name": "Factor", + "syntax": "Stack", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 2, + "perf3": 40360, + "pull_count": 421, + "pull_rank": 63, + "push_count": 10507, + "push_rank": 66, + "star_count": 100, + "star_rank": 71, + "sloc": 394, + "files": 8, + "author_name": "Jordan Lewis", + "author_url": "https://github.com/jordanlewis", + "so_count": 65, + "so_rank": 78, + "lloc": 0 + }, + "fantom": { + "dir": "fantom", + "name": "Fantom", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 7, + "perf2": 16, + "perf3": 109845, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 733, + "files": 9, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 63, + "so_rank": 79, + "lloc": 0 + }, + "forth": { + "dir": "forth", + "name": "Forth", + "syntax": "Stack", + "type_check": "OTHER", + "modes": [], + "perf1": 37, + "perf2": 147, + "perf3": 291, + "pull_count": 32, + "pull_rank": 69, + "push_count": 1926, + "push_rank": 68, + "star_count": 632, + "star_rank": 67, + "sloc": 1415, + "files": 8, + "author_name": "Chris Houser", + "author_url": "https://github.com/chouser", + "so_count": 299, + "so_rank": 72, + "lloc": 0 + }, + "guile": { + "dir": "guile", + "name": "GNU Guile", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 2, + "perf3": 15138, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 735, + "files": 9, + "author_name": "Mu Lei", + "author_url": "https://github.com/NalaGinrut", + "so_count": 262, + "so_rank": 73, + "lloc": 0 + }, + "gnu-smalltalk": { + "dir": "gnu-smalltalk", + "name": "GNU Smalltalk", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 7, + "perf2": 21, + "perf3": 1709, + "pull_count": 13447, + "pull_rank": 44, + "push_count": 69848, + "push_rank": 50, + "star_count": 4823, + "star_rank": 61, + "sloc": 1005, + "files": 10, + "author_name": "Vasilij Schneidermann", + "author_url": "https://github.com/wasamasa", + "so_count": 115, + "so_rank": 75, + "lloc": 0 + }, + "go": { + "dir": "go", + "name": "Go", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 0, + "perf3": 72067, + "pull_count": 2795669, + "pull_rank": 8, + "push_count": 5100633, + "push_rank": 13, + "star_count": 7730404, + "star_rank": 7, + "sloc": 1412, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 73691, + "so_rank": 24, + "lloc": 673 + }, + "groovy": { + "dir": "groovy", + "name": "Groovy", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 64, + "perf2": 127, + "perf3": 1685, + "pull_count": 141340, + "pull_rank": 24, + "push_count": 473823, + "push_rank": 28, + "star_count": 148765, + "star_rank": 32, + "sloc": 672, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 30295, + "so_rank": 31, + "lloc": 0 + }, + "haskell": { + "dir": "haskell", + "name": "Haskell", + "syntax": "ML", + "type_check": "Static", + "modes": [], + "perf1": 1, + "perf2": 6, + "perf3": 6558, + "pull_count": 114458, + "pull_rank": 29, + "push_count": 732765, + "push_rank": 23, + "star_count": 334357, + "star_rank": 24, + "sloc": 712, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 51449, + "so_rank": 27, + "lloc": 0 + }, + "haxe": { + "dir": "haxe", + "name": "Haxe", + "syntax": "C", + "type_check": "Static", + "modes": [ + "neko", + "python", + "cpp", + "js" + ], + "perf1": 2, + "perf2": 4, + "perf3": 62403, + "pull_count": 13654, + "pull_rank": 43, + "push_count": 74768, + "push_rank": 48, + "star_count": 33782, + "star_rank": 44, + "sloc": 1089, + "files": 11, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 1635, + "so_rank": 62, + "lloc": 454 + }, + "hy": { + "dir": "hy", + "name": "Hy", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 10, + "perf2": 37, + "perf3": 1030, + "pull_count": 8, + "pull_rank": 70, + "push_count": null, + "push_rank": null, + "star_count": 308, + "star_rank": 70, + "sloc": 388, + "files": 7, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 101, + "so_rank": 76, + "lloc": 0 + }, + "io": { + "dir": "io", + "name": "Io", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 113, + "perf2": 423, + "perf3": 78, + "pull_count": 72, + "pull_rank": 68, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 538, + "files": 7, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 17620, + "so_rank": 38, + "lloc": 0 + }, + "java": { + "dir": "java", + "name": "Java", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 2, + "perf2": 10, + "perf3": 182169, + "pull_count": 4219162, + "pull_rank": 5, + "push_count": 15173396, + "push_rank": 5, + "star_count": 9695699, + "star_rank": 5, + "sloc": 1511, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 1919299, + "so_rank": 4, + "lloc": 696 + }, + "java-truffle": { + "dir": "java-truffle", + "name": "Java Truffle", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 5, + "perf2": 13, + "perf3": 163894, + "pull_count": 4219162, + "pull_rank": 6, + "push_count": 15173396, + "push_rank": 6, + "star_count": 9695699, + "star_rank": 6, + "sloc": 5827, + "files": 12, + "author_name": "Matt McGill", + "author_url": "https://github.com/mmcgill", + "so_count": 897, + "so_rank": 64, + "lloc": 2811 + }, + "js": { + "dir": "js", + "name": "JavaScript", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 4, + "perf3": 43462, + "pull_count": 6754454, + "pull_rank": 1, + "push_count": 24043941, + "push_rank": 1, + "star_count": 25547072, + "star_rank": 1, + "sloc": 856, + "files": 10, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 4346255, + "so_rank": 1, + "lloc": 0 + }, + "jq": { + "dir": "jq", + "name": "jq", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": null, + "perf2": null, + "perf3": 0, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 88, + "files": 2, + "author_name": "Ali MohammadPur", + "author_url": "https://github.com/alimpfard", + "so_count": 6778, + "so_rank": 48, + "lloc": 0 + }, + "janet": { + "dir": "janet", + "name": "Janet", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 7, + "perf2": 26, + "perf3": 1846, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1, + "files": 1, + "author_name": "sogaiu", + "author_url": "https://github.com/sogaiu", + "so_count": 3, + "so_rank": 89, + "lloc": 0 + }, + "julia": { + "dir": "julia", + "name": "Julia", + "syntax": "Algol", + "type_check": "Dynamic", + "modes": [], + "perf1": 115, + "perf2": 13, + "perf3": 8375, + "pull_count": 41276, + "pull_rank": 36, + "push_count": 174375, + "push_rank": 36, + "star_count": 54307, + "star_rank": 38, + "sloc": 560, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 12754, + "so_rank": 40, + "lloc": 0 + }, + "kotlin": { + "dir": "kotlin", + "name": "Kotlin", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 8, + "perf2": 19, + "perf3": 114806, + "pull_count": 368780, + "pull_rank": 20, + "push_count": 853297, + "push_rank": 21, + "star_count": 577249, + "star_rank": 22, + "sloc": 741, + "files": 8, + "author_name": "Javier Fernandez-Ivern", + "author_url": "https://github.com/ivern", + "so_count": 96732, + "so_rank": 21, + "lloc": 0 + }, + "latex3": { + "dir": "latex3", + "name": "LaTeX3", + "syntax": "Other", + "type_check": "Dynamic", + "modes": [], + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1131, + "files": 7, + "author_name": "Nicolas Boulenguez", + "author_url": "https://github.com/asarhaddon", + "so_count": 11509, + "so_rank": 41, + "lloc": 0 + }, + "livescript": { + "dir": "livescript", + "name": "LiveScript", + "syntax": "ML", + "type_check": "Dynamic", + "modes": [], + "perf1": 4, + "perf2": 10, + "perf3": 16804, + "pull_count": 327, + "pull_rank": 64, + "push_count": 8343, + "push_rank": 67, + "star_count": 9631, + "star_rank": 56, + "sloc": 783, + "files": 8, + "author_name": "Jos van Bakel", + "author_url": "https://github.com/c0deaddict", + "so_count": 66, + "so_rank": 77, + "lloc": 0 + }, + "logo": { + "dir": "logo", + "name": "Logo", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 179, + "perf2": 777, + "perf3": 48, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 805, + "files": 8, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 47, + "so_rank": 81, + "lloc": 0 + }, + "lua": { + "dir": "lua", + "name": "Lua", + "syntax": "Algol", + "type_check": "Dynamic", + "modes": [], + "perf1": 3931, + "perf2": 16211, + "perf3": 2, + "pull_count": 149093, + "pull_rank": 23, + "push_count": 765952, + "push_rank": 22, + "star_count": 386542, + "star_rank": 23, + "sloc": 925, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 22832, + "so_rank": 34, + "lloc": 0 + }, + "make": { + "dir": "make", + "name": "GNU Make", + "syntax": "OTHER", + "type_check": "OTHER", + "modes": [], + "perf1": 270, + "perf2": 1329, + "perf3": 18, + "pull_count": 97160, + "pull_rank": 30, + "push_count": 286234, + "push_rank": 30, + "star_count": 101953, + "star_rank": 34, + "sloc": 798, + "files": 12, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 25601, + "so_rank": 33, + "lloc": 0 + }, + "mal": { + "dir": "mal", + "name": "mal itself", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 72, + "perf2": 321, + "perf3": 156, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 206, + "files": 4, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 0, + "so_rank": 91, + "lloc": 0 + }, + "matlab": { + "dir": "matlab", + "name": "MATLAB", + "syntax": "Algol", + "type_check": "Dynamic", + "modes": [], + "perf1": 598, + "perf2": 2036, + "perf3": 17, + "pull_count": 6111, + "pull_rank": 54, + "push_count": 130167, + "push_rank": 39, + "star_count": 17596, + "star_rank": 51, + "sloc": 1103, + "files": 17, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 94997, + "so_rank": 22, + "lloc": 0 + }, + "miniMAL": { + "dir": "miniMAL", + "name": "miniMAL", + "syntax": "JSON", + "type_check": "Dynamic", + "modes": [], + "perf1": 144, + "perf2": 524, + "perf3": 72, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 727, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 0, + "so_rank": 92, + "lloc": 0 + }, + "nasm": { + "dir": "nasm", + "name": "NASM", + "syntax": "OTHER", + "type_check": "OTHER", + "modes": [], + "perf1": 1, + "perf2": 3, + "pull_count": 14978, + "pull_rank": 41, + "push_count": 126728, + "push_rank": 40, + "star_count": 54612, + "star_rank": 37, + "sloc": 6166, + "files": 9, + "author_name": "Ben Dudson", + "author_url": "https://github.com/bendudson", + "so_count": 5255, + "so_rank": 52, + "lloc": 0 + }, + "nim": { + "dir": "nim", + "name": "Nim", + "syntax": "Python", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 1, + "perf3": 56321, + "pull_count": 5093, + "pull_rank": 55, + "push_count": 17440, + "push_rank": 62, + "star_count": 16110, + "star_rank": 52, + "sloc": 625, + "files": 7, + "author_name": "Dennis Felsing", + "author_url": "https://github.com/def-", + "so_count": 687, + "so_rank": 66, + "lloc": 0 + }, + "objpascal": { + "dir": "objpascal", + "name": "Object Pascal", + "syntax": "Algol", + "type_check": "Static", + "modes": [], + "perf1": 3, + "perf2": 12, + "perf3": 3596, + "pull_count": 9438, + "pull_rank": 50, + "push_count": 95092, + "push_rank": 42, + "star_count": 48783, + "star_rank": 40, + "sloc": 1553, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 67138, + "so_rank": 26, + "lloc": 967 + }, + "objc": { + "dir": "objc", + "name": "Objective C", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 5, + "perf2": 19, + "perf3": 1958, + "pull_count": 290475, + "pull_rank": 21, + "push_count": 1326999, + "push_rank": 19, + "star_count": 3444492, + "star_rank": 14, + "sloc": 1121, + "files": 16, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 292176, + "so_rank": 13, + "lloc": 511 + }, + "ocaml": { + "dir": "ocaml", + "name": "OCaml", + "syntax": "ML", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 1, + "perf3": 39621, + "pull_count": 71286, + "pull_rank": 33, + "push_count": 242743, + "push_rank": 35, + "star_count": 131717, + "star_rank": 33, + "sloc": 541, + "files": 7, + "author_name": "Chris Houser", + "author_url": "https://github.com/chouser", + "so_count": 7644, + "so_rank": 47, + "lloc": 0 + }, + "perl": { + "dir": "perl", + "name": "Perl", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 3, + "perf2": 12, + "perf3": 3315, + "pull_count": 138992, + "pull_rank": 25, + "push_count": 720857, + "push_rank": 24, + "star_count": 210224, + "star_rank": 29, + "sloc": 836, + "files": 9, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 68197, + "so_rank": 25, + "lloc": 418 + }, + "perl6": { + "dir": "perl6", + "name": "Perl 6", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 55, + "perf2": 147, + "perf3": 311, + "pull_count": 4302, + "pull_rank": 56, + "push_count": 24807, + "push_rank": 57, + "star_count": 1314, + "star_rank": 65, + "sloc": 460, + "files": 7, + "author_name": "Hinrik Örn Sigurðsson", + "author_url": "https://github.com/hinrik", + "so_count": 2054, + "so_rank": 60, + "lloc": 155 + }, + "php": { + "dir": "php", + "name": "PHP", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 2, + "perf3": 12551, + "pull_count": 2791184, + "pull_rank": 9, + "push_count": 10165121, + "push_rank": 7, + "star_count": 4379644, + "star_rank": 9, + "sloc": 951, + "files": 10, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 1467322, + "so_rank": 6, + "lloc": 524 + }, + "picolisp": { + "dir": "picolisp", + "name": "Picolisp", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 3, + "perf3": 10702, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 561, + "files": 9, + "author_name": "Vasilij Schneidermann", + "author_url": "https://github.com/wasamasa", + "so_count": 8, + "so_rank": 86, + "lloc": 0 + }, + "pike": { + "dir": "pike", + "name": "Pike", + "syntax": "C", + "type_check": "OTHER", + "modes": [], + "perf1": 2, + "perf2": 6, + "perf3": 7568, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1, + "files": 1, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 14, + "so_rank": 84, + "lloc": 0 + }, + "plpgsql": { + "dir": "plpgsql", + "name": "PL/pgSQL", + "syntax": "Algol", + "type_check": "Static", + "modes": [], + "perf1": 324, + "perf2": 1673, + "perf3": 28, + "pull_count": 16616, + "pull_rank": 40, + "push_count": 111156, + "push_rank": 41, + "star_count": 29471, + "star_rank": 46, + "sloc": 1883, + "files": 11, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 4386, + "so_rank": 53, + "lloc": 0 + }, + "plsql": { + "dir": "plsql", + "name": "PL/SQL", + "syntax": "Algol", + "type_check": "Static", + "modes": [], + "perf1": null, + "perf2": null, + "perf3": 0, + "pull_count": 7172, + "pull_rank": 53, + "push_count": 31314, + "push_rank": 55, + "star_count": 6361, + "star_rank": 59, + "sloc": 2223, + "files": 11, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 29113, + "so_rank": 32, + "lloc": 0 + }, + "powershell": { + "dir": "powershell", + "name": "PowerShell", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 624, + "perf2": 2076, + "perf3": 17, + "pull_count": 75193, + "pull_rank": 32, + "push_count": 284307, + "push_rank": 32, + "star_count": 210859, + "star_rank": 28, + "sloc": 812, + "files": 7, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 118255, + "so_rank": 19, + "lloc": 0 + }, + "prolog": { + "dir": "prolog", + "name": "Prolog", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 15, + "perf2": 68, + "perf3": 648, + "pull_count": 638, + "pull_rank": 62, + "push_count": 34091, + "push_rank": 53, + "star_count": 4179, + "star_rank": 62, + "sloc": 591, + "files": 8, + "author_name": "Nicolas Boulenguez", + "author_url": "https://github.com/asarhaddon", + "so_count": 13462, + "so_rank": 39, + "lloc": 237 + }, + "ps": { + "dir": "ps", + "name": "PostScript", + "syntax": "Stack", + "type_check": "Dynamic", + "modes": [], + "perf1": 11, + "perf2": 54, + "perf3": 963, + "pull_count": 1816, + "pull_rank": 61, + "push_count": 13598, + "push_rank": 64, + "star_count": 1272, + "star_rank": 66, + "sloc": 1245, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 535, + "so_rank": 69, + "lloc": 0 + }, + "purs": { + "dir": "purs", + "name": "PureScript", + "syntax": "ML", + "type_check": "Static", + "modes": [], + "perf1": 41, + "perf2": 110, + "perf3": 1758, + "pull_count": 12980, + "pull_rank": 45, + "push_count": 23297, + "push_rank": 59, + "star_count": 15237, + "star_rank": 53, + "sloc": 13, + "files": 2, + "author_name": "mrsekut", + "author_url": "https://github.com/mrsekut", + "so_count": 601, + "so_rank": 68, + "lloc": 0 + }, + "python2": { + "dir": "python2", + "name": "Python2", + "syntax": "Python", + "type_check": "Dynamic", + "modes": [], + "perf1": 3, + "perf2": 11, + "perf3": 4088, + "pull_count": 6523874, + "pull_rank": 3, + "push_count": 19048234, + "push_rank": 3, + "star_count": 12495438, + "star_rank": 3, + "sloc": 552, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 2301019, + "so_rank": 3, + "lloc": 0 + }, + "python3": { + "dir": "python3", + "name": "Python3", + "syntax": "Python", + "type_check": "Dynamic", + "modes": [], + "perf1": 4, + "perf2": 12, + "perf3": 2834, + "pull_count": 6523874, + "pull_rank": 4, + "push_count": 19048234, + "push_rank": 4, + "star_count": 12495438, + "star_rank": 4, + "sloc": 867, + "files": 7, + "author_name": "Gavin Lewis", + "author_url": "https://github.com/epylar", + "so_count": 2549011, + "so_rank": 2, + "lloc": 0 + }, + "rpython": { + "dir": "rpython", + "name": "RPython", + "syntax": "Python", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 1, + "perf3": 219999, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1004, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 62, + "so_rank": 80, + "lloc": 0 + }, + "r": { + "dir": "r", + "name": "R", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 37, + "perf2": 114, + "perf3": 376, + "pull_count": 53300, + "pull_rank": 35, + "push_count": 522906, + "push_rank": 27, + "star_count": 95252, + "star_rank": 35, + "sloc": 736, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 508699, + "so_rank": 9, + "lloc": 0 + }, + "racket": { + "dir": "racket", + "name": "Racket", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 4, + "perf3": 9695, + "pull_count": 2247, + "pull_rank": 60, + "push_count": 27140, + "push_rank": 56, + "star_count": 8941, + "star_rank": 58, + "sloc": 495, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 5880, + "so_rank": 50, + "lloc": 0 + }, + "rexx": { + "dir": "rexx", + "name": "Rexx", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 81, + "perf2": 340, + "perf3": 121, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1237, + "files": 8, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 174, + "so_rank": 74, + "lloc": 0 + }, + "ruby": { + "dir": "ruby", + "name": "Ruby", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 1, + "perf2": 6, + "perf3": 7021, + "pull_count": 2750926, + "pull_rank": 10, + "push_count": 6646427, + "push_rank": 9, + "star_count": 3577810, + "star_rank": 12, + "sloc": 442, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 229218, + "so_rank": 15, + "lloc": 0 + }, + "ruby.2": { + "dir": "ruby.2", + "name": "Ruby #2", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 7, + "perf2": 28, + "perf3": 1498, + "pull_count": 2750926, + "pull_rank": 11, + "push_count": 6646427, + "push_rank": 10, + "star_count": 3577810, + "star_rank": 13, + "sloc": 1249, + "files": 8, + "author_name": "Ryan Cook", + "author_url": "https://github.com/cookrn", + "so_count": 229218, + "so_rank": 16, + "lloc": 0 + }, + "rust": { + "dir": "rust", + "name": "Rust", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 1, + "perf3": 66511, + "pull_count": 427223, + "pull_rank": 19, + "push_count": 988782, + "push_rank": 20, + "star_count": 1016188, + "star_rank": 19, + "sloc": 1118, + "files": 7, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 42120, + "so_rank": 28, + "lloc": 212 + }, + "scala": { + "dir": "scala", + "name": "Scala", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 11, + "perf2": 28, + "perf3": 83454, + "pull_count": 648787, + "pull_rank": 17, + "push_count": 1623883, + "push_rank": 17, + "star_count": 593810, + "star_rank": 20, + "sloc": 829, + "files": 7, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 112669, + "so_rank": 20, + "lloc": 0 + }, + "scheme": { + "dir": "scheme", + "name": "Scheme (R7RS)", + "syntax": "Lisp", + "type_check": "Dynamic", + "modes": [ + "chibi", + "kawa", + "gauche", + "chicken", + "sagittarius", + "cyclone", + "foment" + ], + "perf1": 4, + "perf2": 16, + "perf3": 2647, + "pull_count": 3192, + "pull_rank": 58, + "push_count": 89139, + "push_rank": 43, + "star_count": 32255, + "star_rank": 45, + "sloc": 895, + "files": 8, + "author_name": "Vasilij Schneidermann", + "author_url": "https://github.com/wasamasa", + "so_count": 8168, + "so_rank": 45, + "lloc": 0 + }, + "skew": { + "dir": "skew", + "name": "Skew", + "syntax": "OTHER", + "type_check": "Static", + "modes": [], + "perf1": 2, + "perf2": 6, + "perf3": 68779, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 704, + "files": 8, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 386, + "so_rank": 70, + "lloc": 0 + }, + "sml": { + "dir": "sml", + "name": "Standard ML", + "syntax": "ML", + "type_check": "Static", + "modes": [], + "perf1": 0, + "perf2": 1, + "perf3": 42241, + "pull_count": 3494, + "pull_rank": 57, + "push_count": 15782, + "push_rank": 63, + "star_count": 3521, + "star_rank": 63, + "sloc": 553, + "files": 10, + "author_name": "Fabian Bergström", + "author_url": "https://github.com/fabjan", + "so_count": 2099, + "so_rank": 59, + "lloc": 0 + }, + "swift5": { + "dir": "swift5", + "name": "Swift 5", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 5, + "perf2": 22, + "perf3": 1884, + "pull_count": 441064, + "pull_rank": 18, + "push_count": 1361391, + "push_rank": 18, + "star_count": 2778564, + "star_rank": 16, + "sloc": 1232, + "files": 11, + "author_name": "Oleg Montak", + "author_url": "https://github.com/MontakOleg", + "so_count": 343733, + "so_rank": 12, + "lloc": 0 + }, + "tcl": { + "dir": "tcl", + "name": "Tcl", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": 10, + "perf2": 32, + "perf3": 1057, + "pull_count": 2760, + "pull_rank": 59, + "push_count": 33537, + "push_rank": 54, + "star_count": 6233, + "star_rank": 60, + "sloc": 1083, + "files": 8, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 8074, + "so_rank": 46, + "lloc": 0 + }, + "ts": { + "dir": "ts", + "name": "TypeScript", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 1, + "perf2": 3, + "perf3": 61159, + "pull_count": 2152989, + "pull_rank": 12, + "push_count": 4497441, + "push_rank": 15, + "star_count": 3141436, + "star_rank": 15, + "sloc": 1244, + "files": 8, + "author_name": "Masahiro Wakame", + "author_url": "https://github.com/vvakame", + "so_count": 239371, + "so_rank": 14, + "lloc": 0 + }, + "vala": { + "dir": "vala", + "name": "Vala", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 3, + "perf2": 12, + "perf3": 4062, + "pull_count": 12061, + "pull_rank": 47, + "push_count": 80233, + "push_rank": 47, + "star_count": 45712, + "star_rank": 41, + "sloc": 2248, + "files": 8, + "author_name": "Simon Tatham", + "author_url": "https://github.com/sgtatham", + "so_count": 1006, + "so_rank": 63, + "lloc": 1114 + }, + "vhdl": { + "dir": "vhdl", + "name": "VHDL", + "syntax": "Algol", + "type_check": "Static", + "modes": [], + "perf1": 4, + "perf2": 16, + "perf3": 2593, + "pull_count": 284, + "pull_rank": 65, + "push_count": 23377, + "push_rank": 58, + "star_count": 9567, + "star_rank": 57, + "sloc": 1925, + "files": 9, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 5811, + "so_rank": 51, + "lloc": 0 + }, + "vimscript": { + "dir": "vimscript", + "name": "Vimscript", + "syntax": "Algol", + "type_check": "Dynamic", + "modes": [], + "perf1": 101, + "perf2": 436, + "perf3": 98, + "pull_count": null, + "pull_rank": null, + "push_count": 965, + "push_rank": 69, + "star_count": 1547, + "star_rank": 64, + "sloc": 969, + "files": 10, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 41, + "so_rank": 82, + "lloc": 12 + }, + "vb": { + "dir": "vb", + "name": "Visual Basic.NET", + "syntax": "Algol", + "type_check": "Static", + "modes": [], + "perf1": 2, + "perf2": 3, + "perf3": 33311, + "pull_count": 22562, + "pull_rank": 38, + "push_count": 80494, + "push_rank": 46, + "star_count": 19848, + "star_rank": 50, + "sloc": 1451, + "files": 8, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 140396, + "so_rank": 18, + "lloc": 0 + }, + "vbs": { + "dir": "vbs", + "name": "Visual Basic Script", + "syntax": "Algol", + "type_check": "Dynamic", + "modes": [], + "perf1": 2716, + "perf2": 13072, + "perf3": 3, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 2109, + "files": 8, + "author_name": "刘百超", + "author_url": "https://github.com/OldLiu001", + "so_count": 18658, + "so_rank": 35, + "lloc": 0 + }, + "wasm": { + "dir": "wasm", + "name": "WebAssembly", + "syntax": "Lisp", + "type_check": "Static", + "modes": [ + "wace_libc", + "node", + "warpy" + ], + "pull_count": 9341, + "pull_rank": 51, + "push_count": 11939, + "push_rank": 65, + "star_count": 10628, + "star_rank": 55, + "sloc": 3024, + "files": 16, + "author_name": "Joel Martin", + "author_url": "https://github.com/kanaka", + "so_count": 3002, + "so_rank": 55, + "lloc": 0 + }, + "wren": { + "dir": "wren", + "name": "Wren", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 2, + "perf2": 5, + "perf3": 7236, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1, + "files": 1, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 4, + "so_rank": 87, + "lloc": 0 + }, + "xslt": { + "dir": "xslt", + "name": "XSLT", + "syntax": "OTHER", + "type_check": "Dynamic", + "modes": [], + "perf1": null, + "perf2": null, + "perf3": 0, + "pull_count": 14834, + "pull_rank": 42, + "push_count": 83261, + "push_rank": 45, + "star_count": 22225, + "star_rank": 49, + "sloc": 132, + "files": 1, + "author_name": "Ali MohammadPur", + "author_url": "https://github.com/alimpfard", + "so_count": 38679, + "so_rank": 29, + "lloc": 0 + }, + "yorick": { + "dir": "yorick", + "name": "Yorick", + "syntax": "C", + "type_check": "Dynamic", + "modes": [], + "perf1": 53, + "perf2": 248, + "perf3": 184, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1013, + "files": 8, + "author_name": "Dov Murik", + "author_url": "https://github.com/dubek", + "so_count": 1, + "so_rank": 90, + "lloc": 108 + }, + "zig": { + "dir": "zig", + "name": "Zig", + "syntax": "C", + "type_check": "Static", + "modes": [], + "perf1": 1, + "perf2": 2, + "perf3": 9556, + "pull_count": null, + "pull_rank": null, + "push_count": null, + "push_rank": null, + "star_count": null, + "star_rank": null, + "sloc": 1, + "files": 1, + "author_name": "Josh Tobin", + "author_url": "https://github.com/rjtobin", + "so_count": 378, + "so_rank": 71, + "lloc": 0 + } +} \ No newline at end of file diff --git a/docs/graph/base_data.yaml b/docs/graph/base_data.yaml new file mode 100644 index 0000000000..53940f760e --- /dev/null +++ b/docs/graph/base_data.yaml @@ -0,0 +1,96 @@ +headers: + - [dir , name , syntax , type_check , modes] + +languages: + - [ada , Ada , Algol , Static , []] + - [ada.2 , "Ada #2" , Algol , Static , []] + - [awk , GNU Awk , C , Dynamic , []] + - [bash , Bash 4 , OTHER , Dynamic , []] + - [basic , BASIC , OTHER , Static , [cbm, qbasic]] + - [bbc-basic , BBC BASIC V , OTHER , Static , []] + - [c , C , C , Static , []] + - [c.2 , "C #2" , C , Static , []] + - [cpp , C++ , C , Static , []] + - [cs , C# , C , Static , []] + - [chuck , ChucK , C , Static , []] + - [clojure , Clojure , Lisp , Dynamic , [clj, cljs]] + - [coffee , CoffeeScript , OTHER , Dynamic , []] + - [common-lisp , Common Lisp , Lisp , Dynamic , []] + - [crystal , Crystal , OTHER , Static , []] + - [d , D , C , Static , []] + - [dart , Dart , C , Static , []] + - [elixir , Elixir , OTHER , Dynamic , []] + - [elm , Elm , ML , Static , []] + - [elisp , Emacs Lisp , Lisp , Dynamic , []] + - [erlang , Erlang , OTHER , Dynamic , []] + - [es6 , ES6 , C , Dynamic , []] + - [fsharp , F# , ML , Static , []] + - [fennel , "Fennel" , Lisp , Dynamic , []] + - [factor , Factor , Stack , Dynamic , []] + - [fantom , Fantom , C , Static , []] + - [forth , Forth , Stack , OTHER , []] + - [guile , GNU Guile , Lisp , Dynamic , []] + - [gnu-smalltalk , GNU Smalltalk , OTHER , Dynamic , []] + - [go , Go , C , Static , []] + - [groovy , Groovy , C , Dynamic , []] + - [haskell , Haskell , ML , Static , []] + - [haxe , Haxe , C , Static , [neko,python,cpp,js]] + - [hy , Hy , Lisp , Dynamic , []] + - [io , Io , OTHER , Dynamic , []] + - [java , Java , C , Static , []] + - [java-truffle , "Java Truffle" , C , Static , []] + - [js , JavaScript , C , Dynamic , []] + - [jq , jq , OTHER , Dynamic , []] + - [janet , "Janet" , Lisp , Dynamic , []] + - [julia , Julia , Algol , Dynamic , []] + - [kotlin , Kotlin , C , Static , []] + - [latex3 , LaTeX3 , Other , Dynamic , []] + - [livescript , LiveScript , ML , Dynamic , []] + - [logo , Logo , OTHER , Dynamic , []] + - [lua , Lua , Algol , Dynamic , []] + - [make , GNU Make , OTHER , OTHER , []] + - [mal , mal itself , Lisp , Dynamic , []] + - [matlab , MATLAB , Algol , Dynamic , []] + - [miniMAL , miniMAL , JSON , Dynamic , []] + - [nasm , NASM , OTHER , OTHER , []] + - [nim , Nim , Python , Static , []] + - [objpascal , Object Pascal , Algol , Static , []] + - [objc , Objective C , C , Static , []] + - [ocaml , OCaml , ML , Static , []] + - [perl , Perl , C , Dynamic , []] + - [perl6 , Perl 6 , C , Dynamic , []] + - [php , PHP , C , Dynamic , []] + - [picolisp , Picolisp , Lisp , Dynamic , []] + - [pike , Pike , C , OTHER , []] + - [plpgsql , PL/pgSQL , Algol , Static , []] + - [plsql , PL/SQL , Algol , Static , []] + - [powershell , PowerShell , OTHER , Dynamic , []] + - [prolog , Prolog , OTHER , Dynamic , []] + - [ps , PostScript , Stack , Dynamic , []] + - [purs , PureScript , ML , Static , []] + - [python2 , Python2 , Python , Dynamic , []] + - [python3 , Python3 , Python , Dynamic , []] + - [rpython , RPython , Python , Static , []] + - [r , R , C , Dynamic , []] + - [racket , Racket , Lisp , Dynamic , []] + - [rexx , Rexx , OTHER , Dynamic , []] + - [ruby , Ruby , OTHER , Dynamic , []] + - [ruby.2 , "Ruby #2" , OTHER , Dynamic , []] + - [rust , Rust , C , Static , []] + - [scala , Scala , C , Static , []] + - [scheme , Scheme (R7RS) , Lisp , Dynamic , [chibi,kawa,gauche,chicken,sagittarius,cyclone,foment]] + - [skew , Skew , OTHER , Static , []] + - [sml , "Standard ML" , ML , Static , []] + - [swift6 , "Swift 6" , C , Static , []] + - [tcl , Tcl , OTHER , Dynamic , []] + - [ts , TypeScript , C , Static , []] + - [vala , Vala , C , Static , []] + - [vhdl , VHDL , Algol , Static , []] + - [vimscript , Vimscript , Algol , Dynamic , []] + - [vb , Visual Basic.NET , Algol , Static , []] + - [vbs , Visual Basic Script , Algol , Dynamic , []] + - [wasm , WebAssembly , Lisp , Static , [wace_libc,node,warpy]] + - [wren , Wren , C , Dynamic , []] + - [xslt , XSLT , OTHER , Dynamic , []] + - [yorick , Yorick , C , Dynamic , []] + - [zig , Zig , C , Static , []] diff --git a/docs/graph/collect_data.js b/docs/graph/collect_data.js new file mode 100755 index 0000000000..e271007c69 --- /dev/null +++ b/docs/graph/collect_data.js @@ -0,0 +1,317 @@ +#!/usr/bin/env python + +const { promisify } = require('util') +const readFile = promisify(require('fs').readFile) +const writeFile = promisify(require('fs').writeFile) +const readdir = promisify(require('fs').readdir) +const path = require('path') +const yaml = require('js-yaml') +const csv = require('csvtojson') +const request = require('request-promise-native') +const exec = promisify(require('child_process').exec) + +const VERBOSE = process.env['VERBOSE'] || false +const BASE_PATH = process.env['BASE_PATH'] || 'base_data.yaml' +const README_PATH = process.env['README_PATH'] || '../../README.md' +const MAL_PATH = process.env['MAL_PATH'] || '../../' +// Refresh this file using this Query page: +// https://data.stackexchange.com/stackoverflow/query/edit/1013465 +const SO_TAGS_PATH = process.env['SO_TAGS_PATH'] || 'so-tags.csv' + +// GitHut 2.0 Pull Requests +const GITHUT_PULL_URL = process.env['GITHUT_PULL_URL'] || 'https://raw.githubusercontent.com/madnight/githut/master/src/data/gh-pull-request.json' +// GitHut 2.0 Pushes +const GITHUT_PUSH_URL = process.env['GITHUT_PUSH_URL'] || 'https://raw.githubusercontent.com/madnight/githut/master/src/data/gh-push-event.json' +// GitHut 2.0 Stars +const GITHUT_STAR_URL = process.env['GITHUT_STAR_URL'] || 'https://raw.githubusercontent.com/madnight/githut/master/src/data/gh-star-event.json' + +const ignoreLanguages = {"Swift 2":1, "Swift 3":1, "Swift 4":1} + +const githutToNames = { + 'Awk': ['GNU Awk'], + 'Ada': ['Ada', 'Ada #2'], + 'C': ['C', 'C #2'], + 'Shell': ['Bash 4'], + 'Java': ['Java', 'Java Truffle'], + 'JavaScript': ['JavaScript', 'ES6'], + 'Makefile': ['GNU Make'], + 'Matlab': ['MATLAB'], + 'Assembly': ['NASM'], + 'Pascal': ['Object Pascal'], + 'Objective-C': ['Objective C'], + 'PLpgSQL': ['PL/pgSQL'], + 'PLSQL': ['PL/SQL'], + 'Python': ['Python2', 'Python3'], + 'Ruby': ['Ruby', 'Ruby #2'], + 'Scheme': ['Scheme (R7RS)'], + 'Smalltalk': ['GNU Smalltalk'], + 'Swift': ['Swift 5'], + 'Vim script': ['Vimscript'], + 'Visual Basic': ['Visual Basic.NET'], +} +const dirToSOTags = { + 'ada.2': ['ada'], + 'bbc-basic': ['bbc-micro'], + 'cpp': ['c++', 'c++98', 'c++11', 'c++14', 'c++17'], + 'coffee': ['coffeescript'], + 'crystal': ['crystal-lang'], + 'cs': ['c#', 'c#-2.0', 'c#-3.0', 'c#-4.0'], + 'c.2': ['c'], + 'es6': ['ecmascript-6', 'es6-promise', 'es6-modules', 'es6-class', 'reactjs'], + 'fsharp': ['f#', 'f#-interactive', 'f#-data', 'f#-3.0'], + 'factor': ['factor-lang'], + 'java-truffle': ['graalvm'], + 'js': ['javascript', 'node.js', 'jquery', 'angular'], + 'latex3': ['latex'], + 'logo': ['logo-lang'], + 'make': ['makefile'], + 'nim': ['nim-lang'], + 'objpascal': ['delphi', 'freepascal', 'delphi-7', 'delphi-2007', 'delphi-2009', 'delphi-2010', 'delphi-xe', 'delphi-xe2', 'delphi-xe3', 'delphi-xe4', 'delphi-xe5', 'delphi-xe7'], + 'objc': ['objective-c'], + 'perl6': ['raku'], + 'purs': ['purescript'], + 'python2': ['python', 'python-2.7'], + 'python3': ['python', 'python-3.x'], + 'ruby.2': ['ruby'], + 'swift5': ['swift', 'swift4', 'swift5'], + 'ts': ['typescript', 'typescript-generics', 'typescript2.0'], + 'vimscript': ['viml'], + 'vb': ['vb.net'], + 'vbs': ['vbscript'], + 'wasm': ['webassembly'], +} + +const soMapOverrides = { + 'mal': 0, // StackOverflow mal is something else + 'miniMAL': 0, + 'bbc-micro': 9, // outside 50,000 query limit + 'fennel': 3, // outside 50,000 query limit + 'janet': 3, // outside 50,000 query limit + 'picolisp': 8, // outside 50,000 query limit + 'wren': 4, // outside 50,000 query limit + 'yorick': 1, // outside 50,000 query limit +} + +function vlog(...args) { + if (VERBOSE) { + console.log(...args) + } +} + +function die(code, ...args) { + console.error(...args) + process.exit(code) +} + +async function main() { + const logsPath = path.resolve(process.argv[2]) + const outPath = path.resolve(process.argv[3]) + + vlog(`Loading base data yaml from '${BASE_PATH}`) + const baseYaml = yaml.safeLoad(await readFile(BASE_PATH, 'utf8')) + vlog(`Loading README text from '${README_PATH}`) + const readmeLines = (await readFile(README_PATH, 'utf8')).split(/\n/) + vlog(`Downloading GitHut Pulls HTML from '${GITHUT_PULL_URL}`) + const githutPullText = (await request(GITHUT_PULL_URL)) + vlog(`Downloading GitHut Pushes HTML from '${GITHUT_PUSH_URL}`) + const githutPushText = (await request(GITHUT_PUSH_URL)) + vlog(`Downloading GitHut Stars HTML from '${GITHUT_STAR_URL}`) + const githutStarText = (await request(GITHUT_STAR_URL)) + vlog(`Loading StackOverflow Tags CSV from '${SO_TAGS_PATH}`) + const soTagList = await csv().fromFile(SO_TAGS_PATH) + vlog(`Loading log data from '${logsPath}'`) + const logDirs = (await readdir(logsPath)).sort() + let logData = [] + for (const d of logDirs) { + let dir = /IMPL=([^ ]*)/.exec(d)[1] + if (!dir) { console.log("ignoring log dir:", d); continue } + let logPath = `${logsPath}/${d}` + const logFiles = (await readdir(logPath)) + .filter(f => /^perf-.*\.log/.exec(f)) + const path = `${logPath}/${logFiles[0]}` + logData.push([await readFile(path, 'utf8'), path, dir]) + } + + let dirs = [] + let names = [] + let dataList = [] + let dataByDir = {} + let dataByName = {} + + vlog(`Processing base data`) + for (let d of baseYaml['languages']) { + let data = {'dir': d[0], + 'name': d[1], + 'syntax': d[2], + 'type_check': d[3], + 'modes': d[4], + 'perf1': null, + 'perf2': null, + 'perf3': 0, + 'pull_count': null, + 'pull_rank': null, + 'push_count': null, + 'push_rank': null, + 'star_count': null, + 'star_rank': null, + 'sloc': 0, + 'files': 0} + dirs.push(d[0]) + names.push(d[1]) + dataList.push(data) + dataByDir[d[0]] = data + dataByName[d[1]] = data + } + + + vlog(`Processing README implementations table`) + const readme_re = /^\| \[([^\[]*)\].* \| \[([^|]*)\]\(([^|]*)\) *\| *$/ + for (let row of readmeLines.filter(l => /^\| [\[]/.exec(l))) { + t = readme_re.exec(row) + if (t) { + if (t[1] in ignoreLanguages) { + vlog(` ${t[1]}: ignoring (in ignoreLanguages list)`) + } else if (t[1] in dataByName) { + let data = dataByName[t[1]] + data.author_name = t[2] + data.author_url = t[3] + } else { + die(1, `README language '${t[1]}' not found in base data`) + } + } else { + die(1, `No match for README table row: ${row}`) + } + } + + + vlog(`Processing StackOverflow tag data`) + const soMap = { + ...soTagList + .reduce((m,d) => (m[d.TagName] = parseInt(d.Rate), m), {}), + ...soMapOverrides + } + for (let dir of dirs) { + if (!('so_count' in dataByDir[dir])) { + dataByDir[dir]['so_count'] = 0 + } + let tags = dirToSOTags[dir] + if (!tags) { + if (dir in soMap) { + tags = [dir] + } else { + vlog(` ${dir} not found as StackOverflow tag`) + tags = [] + } + } + for (let tag of tags) { + if (tag in soMap) { + dataByDir[dir]['so_count'] += soMap[tag] + //vlog(` ${dir} count: ${count}`) + } else { + die(1, `${tag} not found in soMap`) + } + } + } + let curRank = 1 + let soSort = Object.values(dataByDir).sort((a,b) => b.so_count - a.so_count) + for (let data of soSort) { + data.so_rank = curRank + vlog(` ${data.dir} so_count: ${data.so_count}, rank: ${curRank}`) + curRank += 1 + } + const maxSORank = curRank + + + vlog(`Processing log file data`) + const perf_run_re = /Running:.*\.\.\/tests\/(perf[0-9])\.mal/ + const perf_num_re = /Elapsed time: ([0-9.]+) msecs|iters over 10 seconds: ([0-9]+)/ + for (let [log, file, dir] of logData) { + const data = dataByDir[dir] +// if (data.perf1 !== null) { +// vlog(` ${dir} already has perf data, ignoring ${file}`) +// continue +// } + const perfs = {} + const logLines = log.split(/\n/) + for (let i = 0; i < logLines.length; i++) { + const match_run = perf_run_re.exec(logLines[i]) + if (match_run) { + // Find the result line + let match_num = null + do { + i += 1 + match_num = perf_num_re.exec(logLines[i]) + if (match_num) { + num = parseFloat(match_num[1] || match_num[2], 10) + perfs[match_run[1]] = num + } + } while ((!match_num) && i < logLines.length) + } + } + if ((!data.perf3) || (perfs.perf3 > data.perf3)) { + data.perf1 = perfs.perf1 + data.perf2 = perfs.perf2 + data.perf3 = perfs.perf3 + vlog(` ${dir}: ${perfs.perf1}, ${perfs.perf2}, ${perfs.perf3}`) + } else { + vlog(` ${dir}: ${perfs.perf1}, ${perfs.perf2}, ${perfs.perf3} (perf3 is worse, ignoring log ${file})`) + } + } + + + function githutProcess(textData, kind) { + const gMap = JSON.parse(textData) + .reduce((m, d) => (m[d.name] = parseInt(d.count) + (m[d.name] || 0), m), {}) + const gdata = Object.entries(gMap) + .sort(([k1,v1],[k2,v2]) => v2 - v1) + let curRank = 1 + for (let [gname, gcount] of gdata) { + const names = githutToNames[gname] || [gname] + for (let name of names) { + if (name in dataByName) { + dataByName[name][kind + '_count'] = gcount + dataByName[name][kind + '_rank'] = curRank + vlog(` ${dataByName[name].dir} count: ${gcount}, rank: ${curRank}`) + curRank += 1 + } else if (gname in githutToNames) { + vlog(` ignoring known GitHut language ${name} (${gname})`) + } else { + //vlog(` ignoring GitHut language ${name}`) + } + } + } + for (let name in dataByName) { + if (!dataByName[name][kind + '_count']) { + vlog(` ${dataByName[name].dir} no GitHut data`) + } + } + return curRank; + } + vlog(`Processing GitHut Pull Request data`) + githutProcess(githutPullText, 'pull') + vlog(`Processing GitHut Push data`) + githutProcess(githutPushText, 'push') + vlog(`Processing GitHut Stars data`) + githutProcess(githutStarText, 'star') + + + vlog(`Gathering LOC stats`) + const stat_re = /SLOC=([0-9]+).*LLOC=([0-9]+).*in ([0-9]+) files/ + process.chdir(MAL_PATH) + for (let data of dataList) { + const { stdout, stderr } = await exec(`make "stats^${data.dir}"`) + const match = stat_re.exec(stdout.split(/\n/)[1]) + data.sloc = parseInt(match[1], 10) + data.lloc = parseInt(match[2], 10) + data.files = parseInt(match[3], 10) + vlog(` ${data.dir}: sloc: ${data.sloc}, lloc: ${data.lloc}, files: ${data.files}`) + } + + + vlog(`Writing full lanaguage data to ${outPath}`) + await writeFile(outPath, JSON.stringify(dataByDir, null, 2)) + + process.exit(0) +} + +main() diff --git a/docs/graph/graph_languages.js b/docs/graph/graph_languages.js new file mode 100644 index 0000000000..84d23341dc --- /dev/null +++ b/docs/graph/graph_languages.js @@ -0,0 +1,304 @@ +const malColors = [ + "#1f77b4","#bf7f0e","#4cb00c","#b62728","#9467bd","#bc664b","#b377c2","#0fbf6f","#bcbd22","#17beef", + "#1f6784","#8f7f0e","#4c800c","#862728","#54678d","#8c564b","#8377c2","#0f8f6f","#8c8d22","#178eef", + "#1f97d4","#ff7f0e","#4cf00c","#f62728","#c467fd","#fc764b","#f377c2","#0fff6f","#fcfd22","#17feef", +] + +const axisMap = { + 'pull_rank': 'GH PRs', + 'push_rank': 'GH Pushes', + 'star_rank': 'GH Stars', + 'so_rank': 'SO Tags', + 'perf1': 'Perf 1', + 'perf2': 'Perf 2', + 'perf3': 'Perf 3', + 'sloc': 'SLOC size', + 'files': 'File count', +} +const colorMap = { + 'syntax': 'Syntax Style', + 'type_check': 'Type Discipline', + 'author_name': 'Author', +} +const axisKeySet = new Set(Object.keys(axisMap)) +const colorKeySet = new Set(['type_check', 'syntax', 'author_name']) + +const perfSet = new Set(['perf1', 'perf2', 'perf3']) +const invertSet = new Set(['pull_rank', 'push_rank', 'star_rank', 'so_rank', 'perf1', 'perf2']) +const perfLogSet = new Set(['perf1', 'perf2', 'sloc', 'files']) + +let cfg = { + ckey: 'syntax', + xkey: 'so_rank', + ykey: 'perf3', + skey: 'sloc', + + xlog: false, + ylog: true, +} + +let allData +let graphData = [] +let chart + +// +// Util functions +// + +function malExtent(data, key) { + let extent = d3.extent(Object.values(data), d => d[key]) + // pad the bottom rank so it's not on the opposite axis line + if (key.endsWith('_rank')) { + extent[0] = 0.99 // Setting this to 1 breaks log scale render + extent[extent.length-1] += 1 + } + // Replace 0's with 0.01 to prevent divide by zero errors + if (extent[0] === 0) { extent[0] = 0.0001 } + if (extent[extent.length-1] === 0) { extent[extent.length-1] = 0.0001 } + // For rankings, perf1, and perf2 reverse the Axis range + if (invertSet.has(key)) { + extent.reverse() + } + return extent +} + +function malScale(log) { + return log ? d3.scale.log() : d3.scale.linear() +} + +function malTickValues(key, log) { + if (log && perfSet.has(key)) { + return [1, 10, 100, 1000, 10000, 100000] + } else { + return null + } +} + +function malCircleSize(key, min, max, val) { + let size = (val || 0.01) - (min - 0.01) + if (invertSet.has(key)) { + size = (max + 0.01) - size + } +// if (perfLogSet.has(key)) { +// size = Math.log(size) +// } +// console.log(key, max, val, size) + return size +} + + +// +// UI / Axis Data / query parameters +// + +// Parser query string and update cfg map with valid config options +(function parseQuery(q) { + const pairs = (q[0] === '?' ? q.substr(1) : q).split('&') + for (const [p1, p2] of pairs.map(p => p.split('='))) { + let k = decodeURIComponent(p1).toLowerCase() + let v = p2 ? decodeURIComponent(p2) : true + if (v in {"true":1,"1":1,"yes":1}) { v = true } + if (v in {"false":1,"0":1,"no":1}) { v = false } + if (k in cfg && (axisKeySet.has(v) || colorKeySet.has(v))) { + cfg[k] = v + } + if ((new Set(['xlog', 'ylog'])).has(k) && typeof v === 'boolean') { + cfg[k] = v + } + } +})(location.search) + +// Generate the control buttons and set the checked elements based on +// the cfg +function ctlChange(evt) { + if (new Set(['xlog', 'ylog']).has(evt.target.name)) { + cfg[evt.target.name] = evt.target.checked + } else { + cfg[evt.target.name] = evt.target.value + } + const query = Object.entries(cfg).map(([k,v]) => k + "=" + v).join('&') + history.pushState(null, '', '?' + query) + updateGraphData() +} +for (let key of ['ckey', 'xkey', 'ykey', 'skey']) { + const parent = document.getElementById(key + '-controls') + const ctlMap = ({ + 'ckey': colorMap, + 'xkey': Object.assign({}, axisMap, {'xlog': 'Log Scale'}), + 'ykey': Object.assign({}, axisMap, {'ylog': 'Log Scale'}), + 'skey': axisMap, + })[key] + for (let [val, name] of Object.entries(ctlMap)) { + const log = (new Set(['xlog', 'ylog']).has(val)) ? val : false + const ctl = document.createElement('input') + ctl.class = 'selects' + ctl.type = log ? 'checkbox' : 'radio' + ctl.name = log ? log : key + ctl.value = log ? true : val + if ((log && cfg[val] === true) || cfg[key] === val) { + ctl.checked = true + } + ctl.addEventListener('change', ctlChange) + parent.appendChild(ctl) + parent.appendChild(document.createTextNode(name)) + } +} + +// +// Graph rendering / updating +// + +function updateGraphData() { + let xMax = 0 + let yMax = 0 + let sMin = null + let sMax = null + const colorSet = new Set(Object.values(allData).map(d => d[cfg.ckey])) + const colorList = Array.from(colorSet.values()) + // empty the graphData without recreating it + while (graphData.length > 0) { graphData.pop() } + graphData.push(...colorList.map(t => ({key: t, values: []}))) + for (let dir of Object.keys(allData)) { + const impl = allData[dir] + if (impl[cfg.xkey] > xMax) { xMax = impl[cfg.xkey] } + if (impl[cfg.ykey] > yMax) { yMax = impl[cfg.ykey] } + if (sMin === null) { sMin = impl[cfg.skey] } + if (impl[cfg.skey] < sMin) { sMin = impl[cfg.skey] } + if (impl[cfg.skey] > sMax) { sMax = impl[cfg.skey] } + } + for (let dir of Object.keys(allData)) { + const impl = allData[dir] + // Invert size for inverted data + graphData[colorList.indexOf(impl[cfg.ckey])].values.push({ + x: impl[cfg.xkey] || 0, + y: impl[cfg.ykey] || 0, + size: malCircleSize(cfg.skey, sMin, sMax, impl[cfg.skey]), + shape: 'circle', + label: impl.name, + impl: impl, + }) + } + + // Update the axes domain, scale and tick values + chart.xDomain(malExtent(allData, cfg.xkey)) + chart.yDomain(malExtent(allData, cfg.ykey)) + chart.xScale(malScale(cfg.xlog)) + chart.yScale(malScale(cfg.ylog)) + chart.xAxis.tickValues(malTickValues(cfg.xkey, cfg.xlog)) + chart.yAxis.tickValues(malTickValues(cfg.ykey, cfg.ylog)) + chart.xAxis.axisLabel(axisMap[cfg.xkey]) + chart.yAxis.axisLabel(axisMap[cfg.ykey]) + + // Update the graph + d3.select('#mal svg') + .data([graphData]) + .transition().duration(350).ease('linear') + .call(chart) + + chart.update() + + nv.utils.windowResize(chart.update) +} + +nv.addGraph(function() { + chart = nv.models.scatterChart() + .showDistX(true) + .showDistY(true) + .showLabels(true) + .duration(300) + .color(malColors) + chart.dispatch.on('renderEnd', function() { + //console.log('render complete') + }) + chart.dispatch.on('stateChange', function(e) { + nv.log('New State:', JSON.stringify(e)) + }) + chart.tooltip.contentGenerator(function(obj) { + const i = obj.point.impl + return '

' + i.name + '

' + + '
    ' + + '
  • Syntax Style: ' + i.syntax + + '
  • Type Discipline: ' + i.type_check + + '
  • GitHub:' + + '
      ' + + '
    • PR Count: ' + (i.pull_count || 'unknown') + + '
    • PR Rank: ' + i.pull_rank + + '
    • Push Count: ' + (i.push_count || 'unknown') + + '
    • Push Rank: ' + i.push_rank + + '
    • Star Count: ' + (i.star_count || 'unknown') + + '
    • Star Rank: ' + i.star_rank + + '
    ' + + '
  • StackOverflow:' + + '
      ' + + '
    • Tag Count: ' + (i.so_count || 'unknown') + + '
    • Tag Rank: ' + i.so_rank + + '
    ' + + '

  • ' + + '
  • Perf 1: ' + i.perf1 + ' ms
    ' + + '
  • Perf 2: ' + i.perf2 + ' ms
    ' + + '
  • Perf 3: ' + i.perf3 + ' iters / 10 sec
    ' + + '
  • SLOC: ' + i.sloc + ' lines
    ' + + '
  • Author: ' + i.author_name + '
    ' + + '    ' + i.author_url.replace(/https?:\/\//, '') + + '
' + }) + + // Load and mangle the data + d3.json("all_data.json", function (error, data) { + allData = data + + console.log(`Filling in missing data attributes`) + const dataList = Object.values(allData) + // leave a gap between ranked impls and those with no rank + const rankGap = 10 + const maxPullRank = Math.max(...dataList.map(d => d.pull_rank)) + const maxPushRank = Math.max(...dataList.map(d => d.push_rank)) + const maxStarRank = Math.max(...dataList.map(d => d.star_rank)) + const maxSORank = Math.max(...dataList.map(d => d.so_rank)) + const maxPerf1 = dataList.reduce((a, d) => d.perf1 > a ? d.perf1 : a, 0) + const maxPerf2 = dataList.reduce((a, d) => d.perf2 > a ? d.perf1 : a, 0) + for (let d of dataList) { + if (d.pull_rank === null) { + d.pull_rank = maxPullRank + rankGap + console.log(` set pull_rank to ${d.pull_rank} for ${d.dir}`) + } + if (d.push_rank === null) { + d.push_rank = maxPushRank + rankGap + console.log(` set push_rank to ${d.push_rank} for ${d.dir}`) + } + if (d.star_rank === null) { + d.star_rank = maxStarRank + rankGap + console.log(` set star_rank to ${d.star_rank} for ${d.dir}`) + } + if (d.so_count === 0) { + d.so_rank = maxSORank + rankGap + console.log(` set so_rank to ${d.so_rank} for ${d.dir}`) + } + if (d.perf1 === null) { + d.perf1 = maxPerf1 + console.log(` set perf1 to ${maxPerf1} for ${d.dir}`) + } + if (d.perf2 === null) { + d.perf2 = maxPerf2 + console.log(` set perf2 to ${maxPerf2} for ${d.dir}`) + } + } + + console.log(`Adjusting perf numbers to avoid 0`) + for (let d of dataList) { + if (d.perf1 === 0) { d.perf1 = 0.9 } + if (d.perf2 === 0) { d.perf2 = 0.9 } + if (d.perf3 === 0) { d.perf3 = 0.01 } + } + + // NOTE: TODO: major hack to workaround bug with switching + // to/from logarithmic mode. Seems to require at least one + // value to be less than 1 for it to work + allData.rpython.perf2 = 0.9 + + updateGraphData() + }) + + return chart +}) + diff --git a/docs/graph/index.html b/docs/graph/index.html new file mode 100644 index 0000000000..668dab3cfe --- /dev/null +++ b/docs/graph/index.html @@ -0,0 +1,181 @@ + + + + + + + + + + + +
+

Mal Implementation Stats

+
+ +
+ + + + + + + + + + + + + + + + + + +
+
+ + +
+

Important Caveats:

+

The data on this graph is very specific to Mal. + Do not use this data to directly compare programming + languages.

+
    +
  • Bad takeaway: "Language X is faster than + language Y"
    • +
  • Good takeway: "The mal impl in + language X is faster than the one + in language Y for the 'perf 3' microbenchmark"
    • +
+

Here are some reasons (non-exhaustive) why this data + should be taken with a grain of salt:

+
    +
  • The focus of the make-a-lisp process is on learning + (either Lisp or the target language). The resulting + implementations have a common structure that is + intended for understandability and consistency + between implementations. They are not structured or + intended to have optimal runtime performance or code + concision.
    • +
  • Mal implementations are created by different + authors and the authors have varying levels of + experience with the target language and they often + created a mal implementation with the goal of learning + the target language.
    • +
  • While the overall structure of each mal + implementation is similar, the implementation details + are up to the author.
    • +
  • There are hundreds of tests that each implementation + must pass before being accepted into the tree. + However, the mal language has no formal + specification so authors make choices + about whether and how to handle edge cases that are + not covered by the tests. For example, mal + implementations have different levels of runtime error + checking.
    • +
  • The performance benchmarks are very narrow in + focus and these numbers should not be extrapolated + casually. For example, the 'perf 3' microbenchmark + repeats a macro and data structure manipulation test + repeatedly for 10 seconds and counts the number of + iterations through the test. Languages with runtime + optimization (e.g. JIT) tend to do particularly well + at this benchmark (RPython, JVM-based, etc).
    • +
+

Other Notes:

+
    +
  • Syntax style and type discipline are best effort + and based on Wikipedia information and personal + experience. There are also other aspects to type + discipline (strong, gradual, duck, etc) that are not + currently included.
    • +
  • The GitHub information was gathered by the GitHut + 2.0 project and then translated into a ordinal + ranking of implementations relative to each other. +
  • The StackOverflow information was generated + by a tag + count query and then translated into a ordinal + ranking of implementations relative to each other. +
  • Not all languages have GitHub or StackOverflow data + so a gap of 10 ticks is introduced between the + ranked languages and the languages with no data.
    • +
+
+
+ 		Color data:
X-Axis data:
Y-Axis data:
Circle size:
+
+ +
+ +
+ + + + + + + diff --git a/docs/graph/package-lock.json b/docs/graph/package-lock.json new file mode 100644 index 0000000000..5dc42fd4c7 --- /dev/null +++ b/docs/graph/package-lock.json @@ -0,0 +1,568 @@ +{ + "name": "mal_graph", + "version": "0.0.1", + "lockfileVersion": 3, + "requires": true, + "packages": { + "": { + "name": "mal_graph", + "version": "0.0.1", + "dependencies": { + "csvtojson": "2.0.8", + "js-yaml": "3.13.1", + "request": "2.88.0", + "request-promise-native": "1.0.7" + } + }, + "node_modules/ajv": { + "version": "6.12.6", + "resolved": "https://registry.npmjs.org/ajv/-/ajv-6.12.6.tgz", + "integrity": "sha512-j3fVLgvTo527anyYyJOGTYJbG+vnnQYvE0m5mmkc1TK+nxAppkCLMIL0aZ4dblVCNoGShhm+kzE4ZUykBoMg4g==", + "dependencies": { + "fast-deep-equal": "^3.1.1", + "fast-json-stable-stringify": "^2.0.0", + "json-schema-traverse": "^0.4.1", + "uri-js": "^4.2.2" + }, + "funding": { + "type": "github", + "url": "https://github.com/sponsors/epoberezkin" + } + }, + "node_modules/argparse": { + "version": "1.0.10", + "resolved": "https://registry.npmjs.org/argparse/-/argparse-1.0.10.tgz", + "integrity": "sha512-o5Roy6tNG4SL/FOkCAN6RzjiakZS25RLYFrcMttJqbdd8BWrnA+fGz57iN5Pb06pvBGvl5gQ0B48dJlslXvoTg==", + "dependencies": { + "sprintf-js": "~1.0.2" + } + }, + "node_modules/asn1": { + "version": "0.2.6", + "resolved": "https://registry.npmjs.org/asn1/-/asn1-0.2.6.tgz", + "integrity": "sha512-ix/FxPn0MDjeyJ7i/yoHGFt/EX6LyNbxSEhPPXODPL+KB0VPk86UYfL0lMdy+KCnv+fmvIzySwaK5COwqVbWTQ==", + "dependencies": { + "safer-buffer": "~2.1.0" + } + }, + "node_modules/assert-plus": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/assert-plus/-/assert-plus-1.0.0.tgz", + "integrity": "sha512-NfJ4UzBCcQGLDlQq7nHxH+tv3kyZ0hHQqF5BO6J7tNJeP5do1llPr8dZ8zHonfhAu0PHAdMkSo+8o0wxg9lZWw==", + "engines": { + "node": ">=0.8" + } + }, + "node_modules/asynckit": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz", + "integrity": "sha512-Oei9OH4tRh0YqU3GxhX79dM/mwVgvbZJaSNaRk+bshkj0S5cfHcgYakreBjrHwatXKbz+IoIdYLxrKim2MjW0Q==" + }, + "node_modules/aws-sign2": { + "version": "0.7.0", + "resolved": "https://registry.npmjs.org/aws-sign2/-/aws-sign2-0.7.0.tgz", + "integrity": "sha512-08kcGqnYf/YmjoRhfxyu+CLxBjUtHLXLXX/vUfx9l2LYzG3c1m61nrpyFUZI6zeS+Li/wWMMidD9KgrqtGq3mA==", + "engines": { + "node": "*" + } + }, + "node_modules/aws4": { + "version": "1.13.2", + "resolved": "https://registry.npmjs.org/aws4/-/aws4-1.13.2.tgz", + "integrity": "sha512-lHe62zvbTB5eEABUVi/AwVh0ZKY9rMMDhmm+eeyuuUQbQ3+J+fONVQOZyj+DdrvD4BY33uYniyRJ4UJIaSKAfw==" + }, + "node_modules/bcrypt-pbkdf": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/bcrypt-pbkdf/-/bcrypt-pbkdf-1.0.2.tgz", + "integrity": "sha512-qeFIXtP4MSoi6NLqO12WfqARWWuCKi2Rn/9hJLEmtB5yTNr9DqFWkJRCf2qShWzPeAMRnOgCrq0sg/KLv5ES9w==", + "dependencies": { + "tweetnacl": "^0.14.3" + } + }, + "node_modules/bluebird": { + "version": "3.7.2", + "resolved": "https://registry.npmjs.org/bluebird/-/bluebird-3.7.2.tgz", + "integrity": "sha512-XpNj6GDQzdfW+r2Wnn7xiSAd7TM3jzkxGXBGTtWKuSXv1xUV+azxAm8jdWZN06QTQk+2N2XB9jRDkvbmQmcRtg==" + }, + "node_modules/caseless": { + "version": "0.12.0", + "resolved": "https://registry.npmjs.org/caseless/-/caseless-0.12.0.tgz", + "integrity": "sha512-4tYFyifaFfGacoiObjJegolkwSU4xQNGbVgUiNYVUxbQ2x2lUsFvY4hVgVzGiIe6WLOPqycWXA40l+PWsxthUw==" + }, + "node_modules/combined-stream": { + "version": "1.0.8", + "resolved": "https://registry.npmjs.org/combined-stream/-/combined-stream-1.0.8.tgz", + "integrity": "sha512-FQN4MRfuJeHf7cBbBMJFXhKSDq+2kAArBlmRBvcvFE5BB1HZKXtSFASDhdlz9zOYwxh8lDdnvmMOe/+5cdoEdg==", + "dependencies": { + "delayed-stream": "~1.0.0" + }, + "engines": { + "node": ">= 0.8" + } + }, + "node_modules/core-util-is": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/core-util-is/-/core-util-is-1.0.2.tgz", + "integrity": "sha512-3lqz5YjWTYnW6dlDa5TLaTCcShfar1e40rmcJVwCBJC6mWlFuj0eCHIElmG1g5kyuJ/GD+8Wn4FFCcz4gJPfaQ==" + }, + "node_modules/csvtojson": { + "version": "2.0.8", + "resolved": "https://registry.npmjs.org/csvtojson/-/csvtojson-2.0.8.tgz", + "integrity": "sha512-DC6YFtsJiA7t/Yz+KjzT6GXuKtU/5gRbbl7HJqvDVVir+dxdw2/1EgwfgJdnsvUT7lOnON5DvGftKuYWX1nMOQ==", + "dependencies": { + "bluebird": "^3.5.1", + "lodash": "^4.17.3", + "strip-bom": "^2.0.0" + }, + "bin": { + "csvtojson": "bin/csvtojson" + }, + "engines": { + "node": ">=4.0.0" + } + }, + "node_modules/dashdash": { + "version": "1.14.1", + "resolved": "https://registry.npmjs.org/dashdash/-/dashdash-1.14.1.tgz", + "integrity": "sha512-jRFi8UDGo6j+odZiEpjazZaWqEal3w/basFjQHQEwVtZJGDpxbH1MeYluwCS8Xq5wmLJooDlMgvVarmWfGM44g==", + "dependencies": { + "assert-plus": "^1.0.0" + }, + "engines": { + "node": ">=0.10" + } + }, + "node_modules/delayed-stream": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/delayed-stream/-/delayed-stream-1.0.0.tgz", + "integrity": "sha512-ZySD7Nf91aLB0RxL4KGrKHBXl7Eds1DAmEdcoVawXnLD7SDhpNgtuII2aAkg7a7QS41jxPSZ17p4VdGnMHk3MQ==", + "engines": { + "node": ">=0.4.0" + } + }, + "node_modules/ecc-jsbn": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/ecc-jsbn/-/ecc-jsbn-0.1.2.tgz", + "integrity": "sha512-eh9O+hwRHNbG4BLTjEl3nw044CkGm5X6LoaCf7LPp7UU8Qrt47JYNi6nPX8xjW97TKGKm1ouctg0QSpZe9qrnw==", + "dependencies": { + "jsbn": "~0.1.0", + "safer-buffer": "^2.1.0" + } + }, + "node_modules/esprima": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/esprima/-/esprima-4.0.1.tgz", + "integrity": "sha512-eGuFFw7Upda+g4p+QHvnW0RyTX/SVeJBDM/gCtMARO0cLuT2HcEKnTPvhjV6aGeqrCB/sbNop0Kszm0jsaWU4A==", + "bin": { + "esparse": "bin/esparse.js", + "esvalidate": "bin/esvalidate.js" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/extend": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/extend/-/extend-3.0.2.tgz", + "integrity": "sha512-fjquC59cD7CyW6urNXK0FBufkZcoiGG80wTuPujX590cB5Ttln20E2UB4S/WARVqhXffZl2LNgS+gQdPIIim/g==" + }, + "node_modules/extsprintf": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/extsprintf/-/extsprintf-1.3.0.tgz", + "integrity": "sha512-11Ndz7Nv+mvAC1j0ktTa7fAb0vLyGGX+rMHNBYQviQDGU0Hw7lhctJANqbPhu9nV9/izT/IntTgZ7Im/9LJs9g==", + "engines": [ + "node >=0.6.0" + ] + }, + "node_modules/fast-deep-equal": { + "version": "3.1.3", + "resolved": "https://registry.npmjs.org/fast-deep-equal/-/fast-deep-equal-3.1.3.tgz", + "integrity": "sha512-f3qQ9oQy9j2AhBe/H9VC91wLmKBCCU/gDOnKNAYG5hswO7BLKj09Hc5HYNz9cGI++xlpDCIgDaitVs03ATR84Q==" + }, + "node_modules/fast-json-stable-stringify": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/fast-json-stable-stringify/-/fast-json-stable-stringify-2.1.0.tgz", + "integrity": "sha512-lhd/wF+Lk98HZoTCtlVraHtfh5XYijIjalXck7saUtuanSDyLMxnHhSXEDJqHxD7msR8D0uCmqlkwjCV8xvwHw==" + }, + "node_modules/forever-agent": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/forever-agent/-/forever-agent-0.6.1.tgz", + "integrity": "sha512-j0KLYPhm6zeac4lz3oJ3o65qvgQCcPubiyotZrXqEaG4hNagNYO8qdlUrX5vwqv9ohqeT/Z3j6+yW067yWWdUw==", + "engines": { + "node": "*" + } + }, + "node_modules/form-data": { + "version": "2.3.3", + "resolved": "https://registry.npmjs.org/form-data/-/form-data-2.3.3.tgz", + "integrity": "sha512-1lLKB2Mu3aGP1Q/2eCOx0fNbRMe7XdwktwOruhfqqd0rIJWwN4Dh+E3hrPSlDCXnSR7UtZ1N38rVXm+6+MEhJQ==", + "dependencies": { + "asynckit": "^0.4.0", + "combined-stream": "^1.0.6", + "mime-types": "^2.1.12" + }, + "engines": { + "node": ">= 0.12" + } + }, + "node_modules/getpass": { + "version": "0.1.7", + "resolved": "https://registry.npmjs.org/getpass/-/getpass-0.1.7.tgz", + "integrity": "sha512-0fzj9JxOLfJ+XGLhR8ze3unN0KZCgZwiSSDz168VERjK8Wl8kVSdcu2kspd4s4wtAa1y/qrVRiAA0WclVsu0ng==", + "dependencies": { + "assert-plus": "^1.0.0" + } + }, + "node_modules/har-schema": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/har-schema/-/har-schema-2.0.0.tgz", + "integrity": "sha512-Oqluz6zhGX8cyRaTQlFMPw80bSJVG2x/cFb8ZPhUILGgHka9SsokCCOQgpveePerqidZOrT14ipqfJb7ILcW5Q==", + "engines": { + "node": ">=4" + } + }, + "node_modules/har-validator": { + "version": "5.1.5", + "resolved": "https://registry.npmjs.org/har-validator/-/har-validator-5.1.5.tgz", + "integrity": "sha512-nmT2T0lljbxdQZfspsno9hgrG3Uir6Ks5afism62poxqBM6sDnMEuPmzTq8XN0OEwqKLLdh1jQI3qyE66Nzb3w==", + "deprecated": "this library is no longer supported", + "dependencies": { + "ajv": "^6.12.3", + "har-schema": "^2.0.0" + }, + "engines": { + "node": ">=6" + } + }, + "node_modules/http-signature": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/http-signature/-/http-signature-1.2.0.tgz", + "integrity": "sha512-CAbnr6Rz4CYQkLYUtSNXxQPUH2gK8f3iWexVlsnMeD+GjlsQ0Xsy1cOX+mN3dtxYomRy21CiOzU8Uhw6OwncEQ==", + "dependencies": { + "assert-plus": "^1.0.0", + "jsprim": "^1.2.2", + "sshpk": "^1.7.0" + }, + "engines": { + "node": ">=0.8", + "npm": ">=1.3.7" + } + }, + "node_modules/is-typedarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-typedarray/-/is-typedarray-1.0.0.tgz", + "integrity": "sha512-cyA56iCMHAh5CdzjJIa4aohJyeO1YbwLi3Jc35MmRU6poroFjIGZzUzupGiRPOjgHg9TLu43xbpwXk523fMxKA==" + }, + "node_modules/is-utf8": { + "version": "0.2.1", + "resolved": "https://registry.npmjs.org/is-utf8/-/is-utf8-0.2.1.tgz", + "integrity": "sha512-rMYPYvCzsXywIsldgLaSoPlw5PfoB/ssr7hY4pLfcodrA5M/eArza1a9VmTiNIBNMjOGr1Ow9mTyU2o69U6U9Q==" + }, + "node_modules/isstream": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/isstream/-/isstream-0.1.2.tgz", + "integrity": "sha512-Yljz7ffyPbrLpLngrMtZ7NduUgVvi6wG9RJ9IUcyCd59YQ911PBJphODUcbOVbqYfxe1wuYf/LJ8PauMRwsM/g==" + }, + "node_modules/js-yaml": { + "version": "3.13.1", + "resolved": "https://registry.npmjs.org/js-yaml/-/js-yaml-3.13.1.tgz", + "integrity": "sha512-YfbcO7jXDdyj0DGxYVSlSeQNHbD7XPWvrVWeVUujrQEoZzWJIRrCPoyk6kL6IAjAG2IolMK4T0hNUe0HOUs5Jw==", + "dependencies": { + "argparse": "^1.0.7", + "esprima": "^4.0.0" + }, + "bin": { + "js-yaml": "bin/js-yaml.js" + } + }, + "node_modules/jsbn": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/jsbn/-/jsbn-0.1.1.tgz", + "integrity": "sha512-UVU9dibq2JcFWxQPA6KCqj5O42VOmAY3zQUfEKxU0KpTGXwNoCjkX1e13eHNvw/xPynt6pU0rZ1htjWTNTSXsg==" + }, + "node_modules/json-schema": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/json-schema/-/json-schema-0.4.0.tgz", + "integrity": "sha512-es94M3nTIfsEPisRafak+HDLfHXnKBhV3vU5eqPcS3flIWqcxJWgXHXiey3YrpaNsanY5ei1VoYEbOzijuq9BA==" + }, + "node_modules/json-schema-traverse": { + "version": "0.4.1", + "resolved": "https://registry.npmjs.org/json-schema-traverse/-/json-schema-traverse-0.4.1.tgz", + "integrity": "sha512-xbbCH5dCYU5T8LcEhhuh7HJ88HXuW3qsI3Y0zOZFKfZEHcpWiHU/Jxzk629Brsab/mMiHQti9wMP+845RPe3Vg==" + }, + "node_modules/json-stringify-safe": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/json-stringify-safe/-/json-stringify-safe-5.0.1.tgz", + "integrity": "sha512-ZClg6AaYvamvYEE82d3Iyd3vSSIjQ+odgjaTzRuO3s7toCdFKczob2i0zCh7JE8kWn17yvAWhUVxvqGwUalsRA==" + }, + "node_modules/jsprim": { + "version": "1.4.2", + "resolved": "https://registry.npmjs.org/jsprim/-/jsprim-1.4.2.tgz", + "integrity": "sha512-P2bSOMAc/ciLz6DzgjVlGJP9+BrJWu5UDGK70C2iweC5QBIeFf0ZXRvGjEj2uYgrY2MkAAhsSWHDWlFtEroZWw==", + "dependencies": { + "assert-plus": "1.0.0", + "extsprintf": "1.3.0", + "json-schema": "0.4.0", + "verror": "1.10.0" + }, + "engines": { + "node": ">=0.6.0" + } + }, + "node_modules/lodash": { + "version": "4.17.21", + "resolved": "https://registry.npmjs.org/lodash/-/lodash-4.17.21.tgz", + "integrity": "sha512-v2kDEe57lecTulaDIuNTPy3Ry4gLGJ6Z1O3vE1krgXZNrsQ+LFTGHVxVjcXPs17LhbZVGedAJv8XZ1tvj5FvSg==" + }, + "node_modules/mime-db": { + "version": "1.52.0", + "resolved": "https://registry.npmjs.org/mime-db/-/mime-db-1.52.0.tgz", + "integrity": "sha512-sPU4uV7dYlvtWJxwwxHD0PuihVNiE7TyAbQ5SWxDCB9mUYvOgroQOwYQQOKPJ8CIbE+1ETVlOoK1UC2nU3gYvg==", + "engines": { + "node": ">= 0.6" + } + }, + "node_modules/mime-types": { + "version": "2.1.35", + "resolved": "https://registry.npmjs.org/mime-types/-/mime-types-2.1.35.tgz", + "integrity": "sha512-ZDY+bPm5zTTF+YpCrAU9nK0UgICYPT0QtT1NZWFv4s++TNkcgVaT0g6+4R2uI4MjQjzysHB1zxuWL50hzaeXiw==", + "dependencies": { + "mime-db": "1.52.0" + }, + "engines": { + "node": ">= 0.6" + } + }, + "node_modules/oauth-sign": { + "version": "0.9.0", + "resolved": "https://registry.npmjs.org/oauth-sign/-/oauth-sign-0.9.0.tgz", + "integrity": "sha512-fexhUFFPTGV8ybAtSIGbV6gOkSv8UtRbDBnAyLQw4QPKkgNlsH2ByPGtMUqdWkos6YCRmAqViwgZrJc/mRDzZQ==", + "engines": { + "node": "*" + } + }, + "node_modules/performance-now": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/performance-now/-/performance-now-2.1.0.tgz", + "integrity": "sha512-7EAHlyLHI56VEIdK57uwHdHKIaAGbnXPiw0yWbarQZOKaKpvUIgW0jWRVLiatnM+XXlSwsanIBH/hzGMJulMow==" + }, + "node_modules/psl": { + "version": "1.9.0", + "resolved": "https://registry.npmjs.org/psl/-/psl-1.9.0.tgz", + "integrity": "sha512-E/ZsdU4HLs/68gYzgGTkMicWTLPdAftJLfJFlLUAAKZGkStNU72sZjT66SnMDVOfOWY/YAoiD7Jxa9iHvngcag==" + }, + "node_modules/punycode": { + "version": "1.4.1", + "resolved": "https://registry.npmjs.org/punycode/-/punycode-1.4.1.tgz", + "integrity": "sha512-jmYNElW7yvO7TV33CjSmvSiE2yco3bV2czu/OzDKdMNVZQWfxCblURLhf+47syQRBntjfLdd/H0egrzIG+oaFQ==" + }, + "node_modules/qs": { + "version": "6.5.3", + "resolved": "https://registry.npmjs.org/qs/-/qs-6.5.3.tgz", + "integrity": "sha512-qxXIEh4pCGfHICj1mAJQ2/2XVZkjCDTcEgfoSQxc/fYivUZxTkk7L3bDBJSoNrEzXI17oUO5Dp07ktqE5KzczA==", + "engines": { + "node": ">=0.6" + } + }, + "node_modules/request": { + "version": "2.88.0", + "resolved": "https://registry.npmjs.org/request/-/request-2.88.0.tgz", + "integrity": "sha512-NAqBSrijGLZdM0WZNsInLJpkJokL72XYjUpnB0iwsRgxh7dB6COrHnTBNwN0E+lHDAJzu7kLAkDeY08z2/A0hg==", + "deprecated": "request has been deprecated, see https://github.com/request/request/issues/3142", + "dependencies": { + "aws-sign2": "~0.7.0", + "aws4": "^1.8.0", + "caseless": "~0.12.0", + "combined-stream": "~1.0.6", + "extend": "~3.0.2", + "forever-agent": "~0.6.1", + "form-data": "~2.3.2", + "har-validator": "~5.1.0", + "http-signature": "~1.2.0", + "is-typedarray": "~1.0.0", + "isstream": "~0.1.2", + "json-stringify-safe": "~5.0.1", + "mime-types": "~2.1.19", + "oauth-sign": "~0.9.0", + "performance-now": "^2.1.0", + "qs": "~6.5.2", + "safe-buffer": "^5.1.2", + "tough-cookie": "~2.4.3", + "tunnel-agent": "^0.6.0", + "uuid": "^3.3.2" + }, + "engines": { + "node": ">= 4" + } + }, + "node_modules/request-promise-core": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/request-promise-core/-/request-promise-core-1.1.2.tgz", + "integrity": "sha512-UHYyq1MO8GsefGEt7EprS8UrXsm1TxEvFUX1IMTuSLU2Rh7fTIdFtl8xD7JiEYiWU2dl+NYAjCTksTehQUxPag==", + "dependencies": { + "lodash": "^4.17.11" + }, + "engines": { + "node": ">=0.10.0" + }, + "peerDependencies": { + "request": "^2.34" + } + }, + "node_modules/request-promise-native": { + "version": "1.0.7", + "resolved": "https://registry.npmjs.org/request-promise-native/-/request-promise-native-1.0.7.tgz", + "integrity": "sha512-rIMnbBdgNViL37nZ1b3L/VfPOpSi0TqVDQPAvO6U14lMzOLrt5nilxCQqtDKhZeDiW0/hkCXGoQjhgJd/tCh6w==", + "deprecated": "request-promise-native has been deprecated because it extends the now deprecated request package, see https://github.com/request/request/issues/3142", + "dependencies": { + "request-promise-core": "1.1.2", + "stealthy-require": "^1.1.1", + "tough-cookie": "^2.3.3" + }, + "engines": { + "node": ">=0.12.0" + }, + "peerDependencies": { + "request": "^2.34" + } + }, + "node_modules/safe-buffer": { + "version": "5.2.1", + "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz", + "integrity": "sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ==", + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/feross" + }, + { + "type": "patreon", + "url": "https://www.patreon.com/feross" + }, + { + "type": "consulting", + "url": "https://feross.org/support" + } + ] + }, + "node_modules/safer-buffer": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/safer-buffer/-/safer-buffer-2.1.2.tgz", + "integrity": "sha512-YZo3K82SD7Riyi0E1EQPojLz7kpepnSQI9IyPbHHg1XXXevb5dJI7tpyN2ADxGcQbHG7vcyRHk0cbwqcQriUtg==" + }, + "node_modules/sprintf-js": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/sprintf-js/-/sprintf-js-1.0.3.tgz", + "integrity": "sha512-D9cPgkvLlV3t3IzL0D0YLvGA9Ahk4PcvVwUbN0dSGr1aP0Nrt4AEnTUbuGvquEC0mA64Gqt1fzirlRs5ibXx8g==" + }, + "node_modules/sshpk": { + "version": "1.18.0", + "resolved": "https://registry.npmjs.org/sshpk/-/sshpk-1.18.0.tgz", + "integrity": "sha512-2p2KJZTSqQ/I3+HX42EpYOa2l3f8Erv8MWKsy2I9uf4wA7yFIkXRffYdsx86y6z4vHtV8u7g+pPlr8/4ouAxsQ==", + "dependencies": { + "asn1": "~0.2.3", + "assert-plus": "^1.0.0", + "bcrypt-pbkdf": "^1.0.0", + "dashdash": "^1.12.0", + "ecc-jsbn": "~0.1.1", + "getpass": "^0.1.1", + "jsbn": "~0.1.0", + "safer-buffer": "^2.0.2", + "tweetnacl": "~0.14.0" + }, + "bin": { + "sshpk-conv": "bin/sshpk-conv", + "sshpk-sign": "bin/sshpk-sign", + "sshpk-verify": "bin/sshpk-verify" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/stealthy-require": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/stealthy-require/-/stealthy-require-1.1.1.tgz", + "integrity": "sha512-ZnWpYnYugiOVEY5GkcuJK1io5V8QmNYChG62gSit9pQVGErXtrKuPC55ITaVSukmMta5qpMU7vqLt2Lnni4f/g==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/strip-bom": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/strip-bom/-/strip-bom-2.0.0.tgz", + "integrity": "sha512-kwrX1y7czp1E69n2ajbG65mIo9dqvJ+8aBQXOGVxqwvNbsXdFM6Lq37dLAY3mknUwru8CfcCbfOLL/gMo+fi3g==", + "dependencies": { + "is-utf8": "^0.2.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/tough-cookie": { + "version": "2.4.3", + "resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.4.3.tgz", + "integrity": "sha512-Q5srk/4vDM54WJsJio3XNn6K2sCG+CQ8G5Wz6bZhRZoAe/+TxjWB/GlFAnYEbkYVlON9FMk/fE3h2RLpPXo4lQ==", + "dependencies": { + "psl": "^1.1.24", + "punycode": "^1.4.1" + }, + "engines": { + "node": ">=0.8" + } + }, + "node_modules/tunnel-agent": { + "version": "0.6.0", + "resolved": "https://registry.npmjs.org/tunnel-agent/-/tunnel-agent-0.6.0.tgz", + "integrity": "sha512-McnNiV1l8RYeY8tBgEpuodCC1mLUdbSN+CYBL7kJsJNInOP8UjDDEwdk6Mw60vdLLrr5NHKZhMAOSrR2NZuQ+w==", + "dependencies": { + "safe-buffer": "^5.0.1" + }, + "engines": { + "node": "*" + } + }, + "node_modules/tweetnacl": { + "version": "0.14.5", + "resolved": "https://registry.npmjs.org/tweetnacl/-/tweetnacl-0.14.5.tgz", + "integrity": "sha512-KXXFFdAbFXY4geFIwoyNK+f5Z1b7swfXABfL7HXCmoIWMKU3dmS26672A4EeQtDzLKy7SXmfBu51JolvEKwtGA==" + }, + "node_modules/uri-js": { + "version": "4.4.1", + "resolved": "https://registry.npmjs.org/uri-js/-/uri-js-4.4.1.tgz", + "integrity": "sha512-7rKUyy33Q1yc98pQ1DAmLtwX109F7TIfWlW1Ydo8Wl1ii1SeHieeh0HHfPeL2fMXK6z0s8ecKs9frCuLJvndBg==", + "dependencies": { + "punycode": "^2.1.0" + } + }, + "node_modules/uri-js/node_modules/punycode": { + "version": "2.3.1", + "resolved": "https://registry.npmjs.org/punycode/-/punycode-2.3.1.tgz", + "integrity": "sha512-vYt7UD1U9Wg6138shLtLOvdAu+8DsC/ilFtEVHcH+wydcSpNE20AfSOduf6MkRFahL5FY7X1oU7nKVZFtfq8Fg==", + "engines": { + "node": ">=6" + } + }, + "node_modules/uuid": { + "version": "3.4.0", + "resolved": "https://registry.npmjs.org/uuid/-/uuid-3.4.0.tgz", + "integrity": "sha512-HjSDRw6gZE5JMggctHBcjVak08+KEVhSIiDzFnT9S9aegmp85S/bReBVTb4QTFaRNptJ9kuYaNhnbNEOkbKb/A==", + "deprecated": "Please upgrade to version 7 or higher. Older versions may use Math.random() in certain circumstances, which is known to be problematic. See https://v8.dev/blog/math-random for details.", + "bin": { + "uuid": "bin/uuid" + } + }, + "node_modules/verror": { + "version": "1.10.0", + "resolved": "https://registry.npmjs.org/verror/-/verror-1.10.0.tgz", + "integrity": "sha512-ZZKSmDAEFOijERBLkmYfJ+vmk3w+7hOLYDNkRCuRuMJGEmqYNCNLyBBFwWKVMhfwaEF3WOd0Zlw86U/WC/+nYw==", + "engines": [ + "node >=0.6.0" + ], + "dependencies": { + "assert-plus": "^1.0.0", + "core-util-is": "1.0.2", + "extsprintf": "^1.2.0" + } + } + } +} diff --git a/docs/graph/package.json b/docs/graph/package.json new file mode 100644 index 0000000000..ec6e07712d --- /dev/null +++ b/docs/graph/package.json @@ -0,0 +1,11 @@ +{ + "name": "mal_graph", + "version": "0.0.1", + "description": "Graph Mal Languages", + "dependencies": { + "js-yaml": "3.13.1", + "csvtojson": "2.0.8", + "request": "2.88.0", + "request-promise-native": "1.0.7" + } +} diff --git a/docs/graph/so-tags.csv b/docs/graph/so-tags.csv new file mode 100644 index 0000000000..0a28fe1f9a --- /dev/null +++ b/docs/graph/so-tags.csv @@ -0,0 +1,50001 @@ +Rate,TagName +"2532623","javascript" +"2205901","python" +"1919299","java" +"1620836","c#" +"1467322","php" +"1419124","android" +"1188879","html" +"1034208","jquery" +"810400","c++" +"806359","css" +"688094","ios" +"673281","sql" +"661830","mysql" +"508699","r" +"479715","reactjs" +"473356","node.js" +"417506","arrays" +"405875","c" +"374706","asp.net" +"361025","json" +"343110","python-3.x" +"339673",".net" +"338275","ruby-on-rails" +"335747","sql-server" +"334941","swift" +"312746","django" +"306068","angular" +"292176","objective-c" +"288497","excel" +"288305","pandas" +"262606","angularjs" +"260613","regex" +"233158","typescript" +"229218","ruby" +"227898","linux" +"221724","ajax" +"220561","iphone" +"215414","vba" +"214973","xml" +"212693","laravel" +"211908","spring" +"201292","asp.net-mvc" +"195197","database" +"192135","wordpress" +"184749","string" +"178977","flutter" +"177876","postgresql" +"176089","mongodb" +"169898","wpf" +"168390","windows" +"159813","amazon-web-services" +"159792","xcode" +"156259","bash" +"153110","git" +"152311","oracle" +"149763","spring-boot" +"147126","dataframe" +"143815","firebase" +"142273","azure" +"141881","list" +"140679","multithreading" +"140396","vb.net" +"139125","docker" +"138101","react-native" +"124939","eclipse" +"121178","algorithm" +"118255","powershell" +"118073","macos" +"115734","visual-studio" +"114584","numpy" +"114135","image" +"113687","forms" +"112669","scala" +"111504","function" +"108146","vue.js" +"103062","twitter-bootstrap" +"102573","performance" +"100414","selenium" +"99255","winforms" +"96732","kotlin" +"96589","loops" +"95744","express" +"95222","hibernate" +"95118","python-2.7" +"95093","sqlite" +"94997","matlab" +"94667","dart" +"94558","api" +"92871","shell" +"92623","rest" +"92369","apache" +"91885","entity-framework" +"90681","android-studio" +"90480","csv" +"88966","maven" +"86630","linq" +"86273","qt" +"86235","dictionary" +"85732","unit-testing" +"85537","facebook" +"83634","asp.net-core" +"82905","tensorflow" +"82661","apache-spark" +"81612","file" +"81367","swing" +"79894","class" +"77183","sorting" +"77028","unity-game-engine" +"76975","date" +"76077","authentication" +"74257","symfony" +"73691","go" +"73460","opencv" +"73384","t-sql" +"73085",".htaccess" +"72761","google-chrome" +"72579","matplotlib" +"72036","for-loop" +"71268","datetime" +"69528","codeigniter" +"68358","http" +"68197","perl" +"67699","validation" +"66618","sockets" +"66067","google-maps" +"65127","object" +"64404","uitableview" +"62697","xaml" +"62318","oop" +"62222","if-statement" +"61584","cordova" +"61010","ubuntu" +"60154","visual-studio-code" +"59886","web-services" +"59490","email" +"59129","android-layout" +"58654","spring-mvc" +"58605","elasticsearch" +"58402","github" +"58157","kubernetes" +"57861","selenium-webdriver" +"57856","ms-access" +"57637","parsing" +"57566","user-interface" +"56993","ggplot2" +"56850","pointers" +"56741","c++11" +"56583","security" +"56146","machine-learning" +"55938","ruby-on-rails-3" +"55743","flask" +"55663","google-sheets" +"55590","nginx" +"55376","templates" +"55020","google-apps-script" +"53957","variables" +"53780","exception" +"53745","sql-server-2008" +"52689","listview" +"52660","debugging" +"52596","gradle" +"52563","tkinter" +"52193","jpa" +"52128","delphi" +"51935","jsp" +"51895","asynchronous" +"51705","pdf" +"51449","haskell" +"51406","web-scraping" +"51354","ssl" +"50962","amazon-s3" +"50858","jenkins" +"50848","xamarin" +"50769","wcf" +"50607","testing" +"50401","batch-file" +"50383","google-cloud-platform" +"50243","npm" +"50003","generics" +"48643","ionic-framework" +"47653","unix" +"47274","recursion" +"47116","google-app-engine" +"46877","mongoose" +"46559","visual-studio-2010" +"45686","android-fragments" +"45564",".net-core" +"44881","animation" +"44709","assembly" +"44412","hadoop" +"44400","session" +"44388","math" +"44218","web" +"44195","svg" +"43951","curl" +"43899","intellij-idea" +"43848","django-models" +"43721","laravel-5" +"43703","join" +"43554","heroku" +"43522","url" +"43319","http-redirect" +"43224","winapi" +"43141","tomcat" +"42960","next.js" +"42849","google-cloud-firestore" +"42781","webpack" +"42738","inheritance" +"42500","keras" +"42368","image-processing" +"42345","asp.net-mvc-4" +"42120","rust" +"41867","gcc" +"41752","dom" +"41726","logging" +"41261","matrix" +"41120","actionscript-3" +"40884","pyspark" +"40821","post" +"40748","button" +"40153","firebase-realtime-database" +"39887","swiftui" +"39852","optimization" +"39720","jquery-ui" +"39623","cocoa" +"39505","xpath" +"39495","iis" +"39352","d3.js" +"38979","internet-explorer" +"38955","firefox" +"38742","javafx" +"38679","xslt" +"38446","caching" +"38331","asp.net-mvc-3" +"38276","select" +"38253","networking" +"38109","opengl" +"38082","asp.net-web-api" +"38082","events" +"37903","plot" +"37508","magento" +"37311","search" +"37299","dplyr" +"37251","encryption" +"37147","stored-procedures" +"37088","amazon-ec2" +"36756","ruby-on-rails-4" +"36412","memory" +"36155","canvas" +"36093","audio" +"35780","jsf" +"35636","multidimensional-array" +"35548","random" +"35433","redux" +"35346","vector" +"35290","cookies" +"35170","input" +"35129","facebook-graph-api" +"34893","flash" +"34715","xamarin.forms" +"34621","ipad" +"34594","arraylist" +"34507","cocoa-touch" +"34469","indexing" +"34109","video" +"34062","data-structures" +"33597","model-view-controller" +"33489","serialization" +"33425","jdbc" +"33342","apache-kafka" +"33314","razor" +"33298","routes" +"33188","servlets" +"33148","mod-rewrite" +"33144","awk" +"33127","woocommerce" +"32801","iframe" +"32798","beautifulsoup" +"32406","filter" +"32313","docker-compose" +"32245","azure-devops" +"32167","design-patterns" +"32117","excel-formula" +"32115","aws-lambda" +"31946","text" +"31942","django-rest-framework" +"31737","visual-c++" +"31670","cakephp" +"31153","mobile" +"30937","android-intent" +"30841","react-hooks" +"30662","struct" +"30474","methods" +"30299","mvvm" +"30295","groovy" +"30228","ssh" +"30116","lambda" +"29981","ecmascript-6" +"29973","checkbox" +"29899","time" +"29874","grails" +"29828","google-chrome-extension" +"29703","installation" +"29535","sharepoint" +"29355","jakarta-ee" +"29327","android-recyclerview" +"29215","core-data" +"29158","shiny" +"29113","plsql" +"29097","spring-security" +"29086","meteor" +"29045","android-activity" +"28983","cmake" +"28898","types" +"28882","sed" +"28851","bootstrap-4" +"28751","graph" +"28715","activerecord" +"28655","websocket" +"28378","replace" +"28317","scikit-learn" +"28233","file-upload" +"28157","vim" +"28085","group-by" +"28082","junit" +"27930","boost" +"27855","deep-learning" +"27746","import" +"27625","sass" +"27603","memory-management" +"27481","error-handling" +"27403","async-await" +"27362","dynamic" +"27319","eloquent" +"27290","soap" +"27145","silverlight" +"26975","charts" +"26939","layout" +"26922","apache-spark-sql" +"26907","dependency-injection" +"26812","browser" +"26796","gridview" +"26730","svn" +"26706","deployment" +"26489","while-loop" +"26409","vuejs2" +"26212","google-bigquery" +"26147","highcharts" +"26097","dll" +"26087","ffmpeg" +"26085","view" +"25796","foreach" +"25795","c#-4.0" +"25732","cmd" +"25696","plugins" +"25626","reporting-services" +"25624","redis" +"25601","makefile" +"25243","server" +"25240","merge" +"25189","https" +"25187","unicode" +"25175","jupyter-notebook" +"25126","google-maps-api-3" +"25124","reflection" +"25120","twitter" +"24884","extjs" +"24715","axios" +"24643","mysqli" +"24572","oauth-2.0" +"24500","terminal" +"24484","split" +"24389","django-views" +"24369","encoding" +"24319","pytorch" +"24260","pip" +"24147","netbeans" +"24111","collections" +"24110","database-design" +"24056","hash" +"23985","ember.js" +"23913","data-binding" +"23902","automation" +"23897","pdo" +"23828","tcp" +"23821","apache-flex" +"23768","build" +"23694","sqlalchemy" +"23492","command-line" +"23360","printing" +"23255","spring-data-jpa" +"23236","react-redux" +"23233","java-8" +"23164","service" +"23115","jestjs" +"23107","concurrency" +"23088","html-table" +"22993","neo4j" +"22894","entity-framework-core" +"22893","visual-studio-2012" +"22876","ansible" +"22876","parameters" +"22832","lua" +"22792","module" +"22777","material-ui" +"22716","promise" +"22676","enums" +"22596","webview" +"22543","outlook" +"22539","web-applications" +"22521","flexbox" +"22516","jquery-mobile" +"22487","uwp" +"22399","firebase-authentication" +"22371","utf-8" +"22277","datatable" +"22118","python-requests" +"22015","drop-down-menu" +"21932","scroll" +"21925","colors" +"21920","hive" +"21854","tfs" +"21829","parallel-processing" +"21682","count" +"21660","scipy" +"21612","syntax" +"21456","twitter-bootstrap-3" +"21453","ms-word" +"21371","google-analytics" +"21315","ssis" +"21196","fonts" +"21176","three.js" +"21140","file-io" +"21138","constructor" +"21125","graphql" +"21096","paypal" +"21051","rxjs" +"20930","discord" +"20919","cassandra" +"20914","socket.io" +"20791","gwt" +"20746","datatables" +"20707","graphics" +"20608","compiler-errors" +"20605","nlp" +"20597","backbone.js" +"20587","solr" +"20566","url-rewriting" +"20554","react-router" +"20492","powerbi" +"20475","memory-leaks" +"20429","datagridview" +"20363","oracle11g" +"20360","drupal" +"20357","zend-framework" +"20343","oauth" +"20266","knockout.js" +"20213","neural-network" +"20200","django-forms" +"20112","interface" +"20037","triggers" +"20002","google-api" +"19997","casting" +"19947","linked-list" +"19904","angular-material" +"19869","terraform" +"19846","jmeter" +"19731","proxy" +"19689","django-templates" +"19689","timer" +"19678","path" +"19621","parse-platform" +"19611","visual-studio-2015" +"19589","windows-phone-7" +"19583","directory" +"19560","cron" +"19555","orm" +"19451","arduino" +"19441","push-notification" +"19367","conditional-statements" +"19343","primefaces" +"19147","functional-programming" +"19084","model" +"18955","jar" +"18858","xamarin.android" +"18763","hyperlink" +"18727","visual-studio-2013" +"18709","uiview" +"18658","vbscript" +"18496","download" +"18428","swift3" +"18418","gitlab" +"18384","google-cloud-functions" +"18381","azure-active-directory" +"18353","sql-server-2005" +"18316","process" +"18265","jwt" +"18263","rspec" +"18208","properties" +"18196","configuration" +"18186","windows-phone-8" +"18182","callback" +"18166","combobox" +"18085","pygame" +"17916","safari" +"17860","scrapy" +"17827","permissions" +"17799","pagination" +"17769","scripting" +"17768","linux-kernel" +"17767","emacs" +"17736","raspberry-pi" +"17703","clojure" +"17652","scope" +"17620","io" +"17543","angularjs-directive" +"17521","nhibernate" +"17511","mongodb-query" +"17477","responsive-design" +"17468","x86" +"17453","request" +"17420","compilation" +"17342","bluetooth" +"17328","dns" +"17317","binding" +"17293","reference" +"17290","playframework" +"17286","discord.js" +"17275","3d" +"17237","architecture" +"17234","doctrine-orm" +"17231","version-control" +"17202","pyqt" +"17141","get" +"17113","package" +"17102","sql-server-2012" +"17039","pycharm" +"17029","rubygems" +"17019","f#" +"16869","autocomplete" +"16840","kendo-ui" +"16835","datepicker" +"16798","tree" +"16785","azure-functions" +"16763","yii" +"16718","openssl" +"16692","controller" +"16687","jackson" +"16655","xamarin.ios" +"16646","expo" +"16584","grep" +"16573","nested" +"16481","static" +"16415","statistics" +"16359","datagrid" +"16350","null" +"16334","transactions" +"16323","active-directory" +"16320","phpmyadmin" +"16310","uiviewcontroller" +"16227","webforms" +"16160","discord.py" +"16140","notifications" +"16135","dockerfile" +"16080","sas" +"16008","youtube" +"15991","nullpointerexception" +"15988","duplicates" +"15937","mocking" +"15869","computer-vision" +"15868","menu" +"15721","bitmap" +"15719","yaml" +"15642","asp.net-mvc-5" +"15629","visual-studio-2008" +"15626","sum" +"15614","jsf-2" +"15562","stream" +"15550","yii2" +"15526","android-listview" +"15502","time-series" +"15484","electron" +"15481","stl" +"15445","css-selectors" +"15399","ant" +"15339","floating-point" +"15297","hashmap" +"15279","character-encoding" +"15245","frontend" +"15235","cryptography" +"15198","jboss" +"15193","msbuild" +"15178","sdk" +"15113","google-drive-api" +"15082","joomla" +"15065","selenium-chromedriver" +"15026","devise" +"14983","anaconda" +"14965","asp.net-core-mvc" +"14950","navigation" +"14886","background" +"14842","binary" +"14818","camera" +"14809","pyqt5" +"14772","linq-to-sql" +"14745","multiprocessing" +"14677","onclick" +"14675","cors" +"14675","ios7" +"14674","blazor" +"14667","iterator" +"14548","cuda" +"14536","plotly" +"14516","mariadb" +"14508","android-asynctask" +"14456","rabbitmq" +"14417","laravel-4" +"14377","tabs" +"14369","uicollectionview" +"14368","insert" +"14250","amazon-dynamodb" +"14195","linker" +"14193","upload" +"14190","coldfusion" +"14181","environment-variables" +"14171","xsd" +"14170","console" +"14152","ftp" +"14108","textview" +"14052","continuous-integration" +"14044","opengl-es" +"14031","microsoft-graph-api" +"13920","xml-parsing" +"13907","localization" +"13899","operating-system" +"13866","mockito" +"13857","formatting" +"13832","json.net" +"13811","kivy" +"13769","macros" +"13747","type-conversion" +"13728","calendar" +"13719","data.table" +"13710","timestamp" +"13639","integer" +"13603","vuejs3" +"13598","segmentation-fault" +"13578","android-ndk" +"13462","prolog" +"13454","drag-and-drop" +"13406","char" +"13398","android-jetpack-compose" +"13386","jasmine" +"13384","crash" +"13288","automated-tests" +"13253","itext" +"13239","header" +"13215","sprite-kit" +"13211","dependencies" +"13181","geometry" +"13174","nosql" +"13173","android-gradle-plugin" +"13164","mfc" +"13160","attributes" +"13126","fortran" +"13087","format" +"13082","nuxt.js" +"13080","firebase-cloud-messaging" +"13024","jquery-plugins" +"12973","leaflet" +"12907","flutter-layout" +"12892","db2" +"12890","jenkins-pipeline" +"12865","event-handling" +"12842","annotations" +"12841","odoo" +"12825","nestjs" +"12762","keyboard" +"12762","postman" +"12754","julia" +"12732","textbox" +"12688","visual-studio-2017" +"12684","gulp" +"12660","libgdx" +"12593","arm" +"12590","crystal-reports" +"12590","xampp" +"12564","synchronization" +"12550","dom-events" +"12515","uiscrollview" +"12491","timezone" +"12474","wso2" +"12474","azure-pipelines" +"12472","sequelize.js" +"12465","aggregation-framework" +"12465","swagger" +"12465","android-emulator" +"12461","namespaces" +"12403","stripe-payments" +"12400","centos" +"12391","azure-web-app-service" +"12382","jvm" +"12382","chart.js" +"12368","geolocation" +"12368","webdriver" +"12353","com" +"12346","subprocess" +"12320","uikit" +"12258","html5-canvas" +"12257","dialog" +"12217","garbage-collection" +"12214","widget" +"12206","numbers" +"12190","windows-10" +"12177","concatenation" +"12166","mapreduce" +"12151","sql-update" +"12139","ionic2" +"12114","set" +"12096","android-edittext" +"12087","tuples" +"12077","rotation" +"12070","spring-data" +"12068","modal-dialog" +"12068","qml" +"12065","smtp" +"12062","google-sheets-formula" +"12039","radio-button" +"12034","doctrine" +"12033","http-headers" +"11995","grid" +"11993","xmlhttprequest" +"11979","sonarqube" +"11975","lucene" +"11921","nuget" +"11869","java-stream" +"11842","listbox" +"11828","internationalization" +"11813","components" +"11808","initialization" +"11806","switch-statement" +"11797","apache-camel" +"11793","google-play" +"11782","snowflake-cloud-data-platform" +"11777","boolean" +"11726","ios5" +"11724","ldap" +"11716","serial-port" +"11660","return" +"11640","eclipse-plugin" +"11635","youtube-api" +"11613","frameworks" +"11595","pivot" +"11594","tags" +"11540","gdb" +"11509","latex" +"11464","asp-classic" +"11447","dataset" +"11435","containers" +"11433","compiler-construction" +"11413","label" +"11409","subquery" +"11408","foreign-keys" +"11404","network-programming" +"11390","uinavigationcontroller" +"11362","delegates" +"11356","copy" +"11355","struts2" +"11319","protractor" +"11298","sql-server-2008-r2" +"11290","google-cloud-storage" +"11284","base64" +"11275","uibutton" +"11254","find" +"11251","migration" +"11248","queue" +"11184","append" +"11182","arguments" +"11177","composer-php" +"11156","jaxb" +"11151","c++17" +"11133","zip" +"11083","stack" +"11070","cucumber" +"11065","autolayout" +"11029","embedded" +"10979","entity-framework-6" +"10969","ide" +"10966","popup" +"10959","windows-7" +"10920","github-actions" +"10915","iteration" +"10845","vb6" +"10837","r-markdown" +"10835","jqgrid" +"10801","ssl-certificate" +"10801","gmail" +"10793","hover" +"10769","android-viewpager" +"10756","airflow" +"10753","command" +"10732","passwords" +"10713","udp" +"10695","g++" +"10693","range" +"10685","vue-component" +"10682","uiwebview" +"10644","ios4" +"10627","twig" +"10612","uiimageview" +"10608","salesforce" +"10607","conv-neural-network" +"10543","clang" +"10534","authorization" +"10523","local-storage" +"10519","twilio" +"10473","bots" +"10468","pytest" +"10454","angular-ui-router" +"10415","jersey" +"10388","wix" +"10369","constants" +"10368","polymorphism" +"10363","ionic3" +"10309","gps" +"10307","user-controls" +"10296","connection" +"10272","debian" +"10271","time-complexity" +"10264","compare" +"10263","windows-8" +"10237","django-admin" +"10232","localhost" +"10200","slider" +"10187","google-oauth" +"10184","tidyverse" +"10163","cocos2d-iphone" +"10130","python-imaging-library" +"10125","tailwind-css" +"10104","admob" +"10098","ado.net" +"10058","certificate" +"10047","phpunit" +"10031","save" +"10016","azure-sql-database" +"9999","mono" +"9977","jframe" +"9971","sbt" +"9959","pipe" +"9934","cypress" +"9918","fetch" +"9879","cypher" +"9877","output" +"9866","fullcalendar" +"9861","mapping" +"9860","imageview" +"9851","runtime-error" +"9842","timeout" +"9832","apache-poi" +"9830","gson" +"9798","include" +"9786","java-native-interface" +"9777","babeljs" +"9742","coffeescript" +"9741","hex" +"9740","drupal-7" +"9728","seaborn" +"9710","signalr" +"9703","jinja2" +"9697","substring" +"9690","web-crawler" +"9675","bluetooth-lowenergy" +"9674","erlang" +"9665","typo3" +"9663","icons" +"9653","observable" +"9647","command-line-interface" +"9647","odbc" +"9646","filesystems" +"9633","location" +"9633","int" +"9623","cocoapods" +"9616","export" +"9607","log4j" +"9601","elixir" +"9581","syntax-error" +"9576","printf" +"9567","window" +"9560","regression" +"9532","dax" +"9529","treeview" +"9506","telerik" +"9505","key" +"9501","storyboard" +"9492","maps" +"9490","realm" +"9479","thread-safety" +"9467","azure-data-factory" +"9460","iis-7" +"9440","logic" +"9428","build.gradle" +"9418","ruby-on-rails-5" +"9412","botframework" +"9411","kernel" +"9375","click" +"9375","in-app-purchase" +"9351","wordpress-theming" +"9345","asp.net-core-webapi" +"9345","amazon-elastic-beanstalk" +"9339","microservices" +"9338","imagemagick" +"9335","jsx" +"9330","resources" +"9317","compression" +"9310","malloc" +"9299","thymeleaf" +"9296","ip" +"9282","ios8" +"9271","ckeditor" +"9271","wsdl" +"9266","vuetify.js" +"9256","position" +"9256","resize" +"9247","uiimage" +"9242","cloud" +"9239","state" +"9215","dojo" +"9183","repository" +"9169","webrtc" +"9152","gpu" +"9131","where-clause" +"9127","celery" +"9106","actionscript" +"9103","office365" +"9076","cross-browser" +"9073","max" +"9070","asp.net-identity" +"9067","angularjs-ng-repeat" +"9060","gruntjs" +"9035","azure-blob-storage" +"9029","windows-services" +"9028","escaping" +"9008","closures" +"9008","jquery-selectors" +"9004","google-visualization" +"8990","shopify" +"8979","pthreads" +"8974","markdown" +"8962","constraints" +"8953","windows-installer" +"8940","angularjs-scope" +"8933","pattern-matching" +"8921","artificial-intelligence" +"8920","google-chrome-devtools" +"8896","locking" +"8892","android-actionbar" +"8873","styles" +"8866","global-variables" +"8863","backend" +"8859","swift2" +"8839","applescript" +"8820","try-catch" +"8815",".net-4.0" +"8800","many-to-many" +"8799","match" +"8767","gitlab-ci" +"8765","qt5" +"8762","amazon-redshift" +"8755","alignment" +"8752","http-post" +"8724","windows-runtime" +"8704","pandas-groupby" +"8700","web-config" +"8681","ios6" +"8680","video-streaming" +"8658","zend-framework2" +"8657","logstash" +"8646","material-design" +"8645","singleton" +"8622","task" +"8612","data-science" +"8589","spring-batch" +"8578","react-navigation" +"8568","sh" +"8568","c++14" +"8567","operator-overloading" +"8562","retrofit" +"8536","gtk" +"8528","vagrant" +"8523","ef-code-first" +"8521","uitextfield" +"8520","jtable" +"8510","bitbucket" +"8493","mocha.js" +"8458","internet-explorer-8" +"8455","language-lawyer" +"8450","jasper-reports" +"8450","controls" +"8448","testng" +"8447","sharepoint-2010" +"8430","asp.net-mvc-2" +"8395","broadcastreceiver" +"8394","bar-chart" +"8385","aws-cloudformation" +"8384","aggregate" +"8361","language-agnostic" +"8359","double" +"8347","blackberry" +"8298","hdfs" +"8295","conda" +"8294","left-join" +"8289","android-sqlite" +"8278","tinymce" +"8271","pivot-table" +"8270","polymer" +"8260","virtual-machine" +"8258","mercurial" +"8245","client" +"8238","webserver" +"8219","case" +"8216","glsl" +"8214","akka" +"8208","out-of-memory" +"8208","comparison" +"8206","devops" +"8204","themes" +"8172","databricks" +"8168","scheme" +"8166","overriding" +"8156","deserialization" +"8148","app-store" +"8147","momentjs" +"8143","fragment" +"8136","query-optimization" +"8132","parameter-passing" +"8131","accessibility" +"8091","jupyter" +"8087","shared-libraries" +"8074","apple-push-notifications" +"8074","tcl" +"8064","keycloak" +"8059","mule" +"8026","spring-integration" +"8024","puppeteer" +"8018","html5-video" +"8017","usb" +"8011","media-queries" +"8009","full-text-search" +"7995","bigdata" +"7986","apache2" +"7985","refactoring" +"7976","bit-manipulation" +"7954","apk" +"7951","tableview" +"7933","google-colaboratory" +"7909","dynamics-crm" +"7908","cygwin" +"7904","rstudio" +"7889","seo" +"7889","appium" +"7878","aws-api-gateway" +"7867","httprequest" +"7859","angular6" +"7858","runtime" +"7854","classification" +"7840","apache-flink" +"7839","boto3" +"7834","operators" +"7824","protocol-buffers" +"7820","react-router-dom" +"7815","byte" +"7799","typeerror" +"7797","row" +"7793","character" +"7791","filtering" +"7787","coding-style" +"7783","adb" +"7783","single-sign-on" +"7770","python-asyncio" +"7755","air" +"7753","vuex" +"7748","bootstrap-modal" +"7740","openshift" +"7729","sharedpreferences" +"7728","jax-rs" +"7723","asp.net-web-api2" +"7723","requirejs" +"7722","token" +"7719","blob" +"7713","glassfish" +"7707","visual-studio-2019" +"7703","handlebars.js" +"7696","rss" +"7695","windows-phone-8.1" +"7695","sql-order-by" +"7694","expression" +"7689","azure-cosmosdb" +"7678","css-animations" +"7668","odata" +"7644","ocaml" +"7634","oracle-sqldeveloper" +"7632","decimal" +"7631","jms" +"7620","grouping" +"7609","progress-bar" +"7605","sms" +"7604","schema" +"7600","phantomjs" +"7599","2d" +"7588","jpanel" +"7581","phpstorm" +"7569","retrofit2" +"7567","ssms" +"7565","maui" +"7546","pdf-generation" +"7541","virtualenv" +"7537","report" +"7536","signals" +"7522","nunit" +"7501","kendo-grid" +"7495","android-webview" +"7472","laravel-blade" +"7472","scanf" +"7457","firefox-addon" +"7446","webkit" +"7440","applet" +"7421","pine-script" +"7415","data-visualization" +"7413","streaming" +"7406","amazon-cognito" +"7393","registry" +"7393","angular-cli" +"7373","console-application" +"7365","entity-framework-4" +"7338","aes" +"7333","focus" +"7308","xna" +"7301","laravel-8" +"7301","google-cloud-messaging" +"7298","less" +"7290","nativescript" +"7285","jenkins-plugins" +"7271","firebase-storage" +"7266","devexpress" +"7250","wxpython" +"7245","jetty" +"7237","tooltip" +"7236","database-connection" +"7229","google-calendar-api" +"7229","ipython" +"7228","google-cloud-datastore" +"7228","google-play-services" +"7224","scheduled-tasks" +"7218","x86-64" +"7205","notepad++" +"7202","javascript-objects" +"7190","powerpoint" +"7176","load" +"7161","fastapi" +"7151","content-management-system" +"7140","list-comprehension" +"7140","flask-sqlalchemy" +"7123","nltk" +"7116","nsstring" +"7116","mpi" +"7115","oracle10g" +"7112","websphere" +"7112","buffer" +"7109","amazon-rds" +"7101","size" +"7087","uilabel" +"7083","sapui5" +"7077","android-room" +"7049","integration-testing" +"7049","mysql-workbench" +"7043","scrollview" +"7041","flutter-dependencies" +"7037","oracle-apex" +"7035","uml" +"7031","shader" +"7027","http-status-code-404" +"7021","rendering" +"7018","google-kubernetes-engine" +"7014","extract" +"7007","visualization" +"7007","prometheus" +"7006","lisp" +"7006","homebrew" +"7003","lodash" +"6987","vaadin" +"6983","cursor" +"6976","ascii" +"6975","windows-store-apps" +"6969","playframework-2.0" +"6967","ruby-on-rails-3.2" +"6966","rx-java" +"6966","passport.js" +"6965","eslint" +"6961","overloading" +"6948","rsa" +"6947","hbase" +"6912","version" +"6911","pymongo" +"6910","httpclient" +"6890","robotframework" +"6887","domain-driven-design" +"6870","linq-to-entities" +"6869","subset" +"6863","processing" +"6855","big-o" +"6846","django-queryset" +"6845","mingw" +"6844","coordinates" +"6840","undefined" +"6837","relational-database" +"6833","gnuplot" +"6830","binary-tree" +"6816","blockchain" +"6816","ethereum" +"6816","storage" +"6815","png" +"6807","ibm-cloud" +"6787","jsoup" +"6783","webgl" +"6782","google-compute-engine" +"6781","port" +"6778","jq" +"6776","vectorization" +"6774","windows-phone" +"6772","grpc" +"6766","pyinstaller" +"6762","jquery-validate" +"6761","histogram" +"6733","android-volley" +"6731","text-files" +"6729","vite" +"6727","xhtml" +"6708","android-service" +"6707","node-modules" +"6706","solidity" +"6701","fork" +"6700","gis" +"6700","ejb" +"6680","vsto" +"6680","inner-join" +"6666","wildfly" +"6654","heap-memory" +"6631","automapper" +"6628","openmp" +"6603","azure-storage" +"6598","karma-jasmine" +"6590","awt" +"6582","structure" +"6573","mapbox" +"6573","linear-regression" +"6571","sails.js" +"6566","llvm" +"6550","android-camera" +"6539","angular5" +"6535","client-server" +"6521","dropdown" +"6519","ejs" +"6514","scrollbar" +"6513","uitabbarcontroller" +"6505","chef-infra" +"6490","avfoundation" +"6487","java.util.scanner" +"6487","liferay" +"6482","generator" +"6477","metadata" +"6464","sitecore" +"6464","entity" +"6446","mqtt" +"6439","combinations" +"6422","textarea" +"6399","binary-search-tree" +"6395","kibana" +"6383","overflow" +"6382","pug" +"6378","cross-domain" +"6378","spring-webflux" +"6375","kubernetes-helm" +"6375","powerquery" +"6369","bootstrap-5" +"6350","sublimetext3" +"6348","aws-sdk" +"6344","jekyll" +"6341","common-lisp" +"6338","this" +"6335","css-position" +"6331","slice" +"6313","comments" +"6311","ocr" +"6310","touch" +"6307","css-grid" +"6304","css-transitions" +"6295","lstm" +"6292","formula" +"6291","element" +"6279","verilog" +"6274","task-parallel-library" +"6267","carousel" +"6263","nodes" +"6261","line" +"6255","mouseevent" +"6246","telegram" +"6238","excel-2010" +"6232","cluster-analysis" +"6231","interface-builder" +"6228","osgi" +"6225","docusignapi" +"6224","hyperledger-fabric" +"6218","fetch-api" +"6218","prepared-statement" +"6216","vue-router" +"6216","height" +"6215","uinavigationbar" +"6204","config" +"6194","sparql" +"6183","google-sheets-api" +"6176","uri" +"6172","c++-cli" +"6168","unique" +"6165","ssrs-2008" +"6161","azure-ad-b2c" +"6157","instagram" +"6154","couchdb" +"6151","app-store-connect" +"6150","associations" +"6147","navbar" +"6139","tdd" +"6139","zsh" +"6137","jquery-animate" +"6118","swt" +"6116","xcode6" +"6114","gzip" +"6111","64-bit" +"6105","posix" +"6102","xslt-1.0" +"6097","std" +"6091","android-manifest" +"6086","teamcity" +"6077","alamofire" +"6074","sequence" +"6073","width" +"6072","adobe" +"6071","zooming" +"6070","profiling" +"6070","cross-platform" +"6070","ios-simulator" +"6067","ibm-mobilefirst" +"6061","networkx" +"6052","background-image" +"6048","driver" +"6044","python-import" +"6043","svelte" +"6043","ms-access-2010" +"6038","html-parsing" +"6035","weblogic" +"6030","editor" +"6027","transform" +"6014","apply" +"6014","lazy-loading" +"5993","html-lists" +"5983","ms-office" +"5979","wifi" +"5979","mapkit" +"5968","windows-subsystem-for-linux" +"5964","css-float" +"5962","grafana" +"5959","etl" +"5957","exec" +"5949","drawing" +"5942","capybara" +"5942","mips" +"5939","jira" +"5939","toggle" +"5936",".net-3.5" +"5935","xmpp" +"5931","javafx-8" +"5930","field" +"5928","directx" +"5923","border" +"5923",".net-6.0" +"5919","multiple-columns" +"5916","gatsby" +"5914","signal-processing" +"5914","response" +"5908","c-preprocessor" +"5900","textures" +"5897","create-react-app" +"5897","chat" +"5894","warnings" +"5892","sympy" +"5880","racket" +"5875","aggregate-functions" +"5873","prestashop" +"5849","preg-replace" +"5843","average" +"5822","uitextview" +"5811","vhdl" +"5810","moq" +"5800","subdomain" +"5799","navigation-drawer" +"5795","backup" +"5790","interop" +"5769","hook" +"5763","tensorflow2.0" +"5757","opencl" +"5751","echo" +"5749","underscore.js" +"5746","java-me" +"5744","reactive-programming" +"5739","hosting" +"5738","wpf-controls" +"5732","activemq-classic" +"5730","android-widget" +"5723","office-js" +"5720","android-alertdialog" +"5712","converters" +"5696","pipeline" +"5695","ssas" +"5694","maven-2" +"5693","dynamic-programming" +"5672","listener" +"5669","swift4" +"5661","virtualbox" +"5656","relationship" +"5651","openid-connect" +"5647","c++20" +"5645","eclipse-rcp" +"5641","user-input" +"5639","font-awesome" +"5638","openpyxl" +"5636","android-animation" +"5634","progressive-web-apps" +"5632","amazon-iam" +"5625","jquery-select2" +"5623","addition" +"5621","python-3.6" +"5618","teradata" +"5616","win-universal-app" +"5616","spark-streaming" +"5614","protocols" +"5604","pyqt4" +"5592","phpmailer" +"5592","cordova-plugins" +"5582","ionic4" +"5574","rounding" +"5573","keyboard-shortcuts" +"5572","httpwebrequest" +"5571","extjs4" +"5563","firebase-security" +"5551","internet-explorer-11" +"5547","stm32" +"5543","google-cloud-dataflow" +"5539","cluster-computing" +"5510","webstorm" +"5510","hashtable" +"5507","performance-testing" +"5506","wamp" +"5504","bundle" +"5504","exe" +"5501","rename" +"5494","codeigniter-3" +"5494","dialogflow-es" +"5492","fluent-nhibernate" +"5487","push" +"5482","ember-data" +"5480","jstl" +"5478","settings" +"5478","tomcat7" +"5478","cxf" +"5472","lxml" +"5471","branch" +"5468","amazon-ecs" +"5467","microsoft-teams" +"5464","workflow" +"5455","xpages" +"5448","fft" +"5447","npm-install" +"5446","prototype" +"5424","identityserver4" +"5418","instance" +"5417","tableau-api" +"5397","single-page-application" +"5395","speech-recognition" +"5394","cpanel" +"5391","xcode4" +"5388","code-coverage" +"5383","refresh" +"5382","linkedin-api" +"5381","xquery" +"5370","knitr" +"5368","settimeout" +"5365","preg-match" +"5361","sinatra" +"5352","e-commerce" +"5346","google-maps-markers" +"5341","cython" +"5337","nsarray" +"5335","union" +"5333","simulation" +"5331","abstract-class" +"5331","titanium" +"5324","render" +"5321","facebook-javascript-sdk" +"5319","pom.xml" +"5319","opencart" +"5313","apache-nifi" +"5311","parent-child" +"5307","nsmutablearray" +"5307","export-to-csv" +"5303","permutation" +"5300","octave" +"5298","servicestack" +"5298","asp.net-ajax" +"5293","qt4" +"5292","locale" +"5288","counter" +"5280","es6-promise" +"5277","submit" +"5275","load-balancing" +"5271","antd" +"5267","interpolation" +"5263","transition" +"5255","nasm" +"5241","fancybox" +"5239","maven-3" +"5236","ruby-on-rails-3.1" +"5218","reverse-proxy" +"5213","jakarta-mail" +"5212","spring-cloud" +"5211","angular7" +"5196","apache-pig" +"5192","memcached" +"5190","jquery-events" +"5187","spyder" +"5186","sftp" +"5181","html-select" +"5180","cgi" +"5179","blazor-server-side" +"5177","openlayers" +"5167","distinct" +"5166","telegram-bot" +"5166","legend" +"5160","html-email" +"5155","silverlight-4.0" +"5152","query-string" +"5151","spinner" +"5150","sql-insert" +"5139","persistence" +"5130","textfield" +"5130","google-signin" +"5129","linux-device-driver" +"5128","zurb-foundation" +"5127","google-tag-manager" +"5124","newline" +"5124","responsive" +"5120","segue" +"5115","cell" +"5110","url-routing" +"5102","product" +"5093","eclipselink" +"5074","amazon-cloudfront" +"5073","magento2" +"5072","href" +"5072","hql" +"5069","h2" +"5058","command-line-arguments" +"5057","ag-grid" +"5055","special-characters" +"5051","aws-amplify" +"5049","linq-to-xml" +"5042","adapter" +"5038","aem" +"5035","anchor" +"5032","google-places-api" +"5019","netty" +"5017","gstreamer" +"5013","github-pages" +"5001","pickle" +"5000","decorator" +"4998","microsoft-edge" +"4992","mkmapview" +"4992","sdl" +"4972","user-defined-functions" +"4971","jpeg" +"4964","android-notifications" +"4962","android-linearlayout" +"4960","qt-creator" +"4958","server-side-rendering" +"4957","codenameone" +"4956","viewmodel" +"4955","action" +"4952","embed" +"4948","translation" +"4948","nested-loops" +"4947","eval" +"4945","resharper" +"4943","ubuntu-16.04" +"4931","jbutton" +"4931","geospatial" +"4926","alert" +"4917","analytics" +"4911","tortoisesvn" +"4907","python-multiprocessing" +"4902","jhipster" +"4897","rails-activerecord" +"4892","data-analysis" +"4890","integration" +"4881","session-cookies" +"4873","inno-setup" +"4872","netsuite" +"4860","typescript-typings" +"4859","webhooks" +"4858","classpath" +"4858","sharepoint-2013" +"4855","overlay" +"4849","apache-beam" +"4849","javafx-2" +"4842","ubuntu-14.04" +"4836","angular-reactive-forms" +"4834","nsdate" +"4831","project" +"4828","typeorm" +"4820","hiveql" +"4813","exchange-server" +"4809","metaprogramming" +"4809","stdout" +"4808","xslt-2.0" +"4807","angular2-routing" +"4800","monitoring" +"4796","android-mediaplayer" +"4789","azure-databricks" +"4783","datasource" +"4783","core-graphics" +"4782","upgrade" +"4781","screenshot" +"4780","screen" +"4777","native" +"4775","mutex" +"4764","multipartform-data" +"4763","service-worker" +"4763","sprite" +"4758","setinterval" +"4751","hide" +"4748","kotlin-coroutines" +"4745","bokeh" +"4742","webbrowser-control" +"4741","boost-asio" +"4738","sql-server-2014" +"4733","mongoid" +"4733","typescript-generics" +"4732","return-value" +"4729","sencha-touch" +"4724","csrf" +"4723","global" +"4722","augmented-reality" +"4722","threadpool" +"4719","cpu" +"4719","angular8" +"4711","stata" +"4709","autohotkey" +"4703","primeng" +"4699","postgis" +"4696","openapi" +"4696","system" +"4688","documentation" +"4682","categories" +"4682","quarkus" +"4681","xml-serialization" +"4677","middleware" +"4670","gunicorn" +"4668","fabricjs" +"4663","diff" +"4662","mobile-safari" +"4661","vscode-extensions" +"4660","object-detection" +"4658","wildcard" +"4654","web-deployment" +"4651","angular-ui-bootstrap" +"4644","crud" +"4642","calculator" +"4637","owin" +"4635","karate" +"4623","spreadsheet" +"4621","soapui" +"4621","cross-compiling" +"4620","connection-string" +"4620","karma-runner" +"4620","ipc" +"4619","polygon" +"4618","plotly-dash" +"4618","embedded-linux" +"4616","real-time" +"4611","dask" +"4610","centos7" +"4609","customization" +"4606","linear-algebra" +"4602","styled-components" +"4600","alarmmanager" +"4599","precision" +"4596","outlook-addin" +"4592","advanced-custom-fields" +"4591","ngrx" +"4586","razor-pages" +"4583","apollo" +"4579","gcloud" +"4578","static-libraries" +"4574","laravel-5.1" +"4573","admin" +"4573","contextmenu" +"4573","gnu-make" +"4563","primary-key" +"4559","mp3" +"4555","swagger-ui" +"4554","pass-by-reference" +"4551","scale" +"4547","imap" +"4545","clone" +"4545","intellisense" +"4545","vlookup" +"4545","message" +"4542","spring-kafka" +"4537","youtube-data-api" +"4529","svm" +"4508","xss" +"4501","umbraco" +"4501","wolfram-mathematica" +"4500","graph-theory" +"4494","okhttp" +"4494","computer-science" +"4493","nfc" +"4492","smarty" +"4491","psycopg2" +"4487","alias" +"4482","aws-cli" +"4479","uicollectionviewcell" +"4477","log4j2" +"4477","powerbi-desktop" +"4473","cakephp-3.0" +"4472","tesseract" +"4468","addeventlistener" +"4468","heatmap" +"4467","share" +"4459","oledb" +"4457","innodb" +"4456","ibm-mq" +"4452","prism" +"4452","emulation" +"4445","collision-detection" +"4443","bioinformatics" +"4442","powershell-2.0" +"4441","function-pointers" +"4439","proguard" +"4436","dynamics-crm-2011" +"4425","variable-assignment" +"4424","openstreetmap" +"4421","recaptcha" +"4419","shapes" +"4410","visual-studio-2022" +"4406","limit" +"4401","rows" +"4401","inputstream" +"4395","whitespace" +"4389","inversion-of-control" +"4388","wmi" +"4386","plpgsql" +"4386","autodesk-forge" +"4384","gradient" +"4383","internet-explorer-9" +"4381","geojson" +"4379","database-migration" +"4379","mouse" +"4377","android-arrayadapter" +"4373","rake" +"4371","ms-access-2007" +"4370","decode" +"4366","artifactory" +"4364","chromium" +"4360","chatbot" +"4353","nan" +"4352","kafka-consumer-api" +"4348","tidyr" +"4344","gmail-api" +"4339","google-analytics-api" +"4335","autofac" +"4333","codeblocks" +"4322","rdf" +"4318","sparse-matrix" +"4315","string-formatting" +"4302","enzyme" +"4299","amazon-sqs" +"4293","azure-logic-apps" +"4287","greatest-n-per-group" +"4286","antlr" +"4283","paperclip" +"4273","payment-gateway" +"4271","common-table-expression" +"4258","amazon-cloudwatch" +"4257","grails-orm" +"4252","android-imageview" +"4247","terraform-provider-aws" +"4242","stack-overflow" +"4238","window-functions" +"4236","delay" +"4235","wxwidgets" +"4232","laravel-5.3" +"4221","aws-glue" +"4218","call" +"4217","custom-controls" +"4211","cpu-architecture" +"4207","xcode8" +"4205","qr-code" +"4203","iis-7.5" +"4200","command-prompt" +"4199","ctypes" +"4197","valgrind" +"4194","phonegap-plugins" +"4186","netlogo" +"4185","access-token" +"4180","onclicklistener" +"4179","asp.net-core-2.0" +"4177","filenames" +"4174","bundler" +"4166","orientation" +"4163","flutter-web" +"4162","accordion" +"4162","subclass" +"4161","core-animation" +"4158","junit4" +"4157","yarnpkg" +"4156","classloader" +"4156","laravel-5.4" +"4153","ios9" +"4149","asp.net-mvc-routing" +"4145","clipboard" +"4139","rx-java2" +"4123","python-3.7" +"4121","scenekit" +"4121","webclient" +"4120","google-plus" +"4117","uiimagepickercontroller" +"4114","wso2-esb" +"4111","rvm" +"4111","cakephp-2.0" +"4108","puppet" +"4103","nsdictionary" +"4103","android-permissions" +"4101","parquet" +"4098","pixel" +"4096","drools" +"4094","internet-explorer-7" +"4091","raspberry-pi3" +"4088","exchangewebservices" +"4087","z-index" +"4085","programming-languages" +"4083","travis-ci" +"4081","python-multithreading" +"4080","panel" +"4075","md5" +"4073","liquid" +"4073","probability" +"4073","rdd" +"4071","jax-ws" +"4065","react-bootstrap" +"4064","phoenix-framework" +"4062","couchbase" +"4058","django-orm" +"4057","azure-application-insights" +"4056","selection" +"4053","jsonp" +"4051","game-development" +"4047","naming-conventions" +"4044","lapply" +"4043","sublimetext2" +"4038","cdi" +"4033","linker-errors" +"4032","apache-kafka-streams" +"4030","antlr4" +"4026","variadic-templates" +"4026","batch-processing" +"4025","symfony4" +"4022","spotify" +"4013","contacts" +"4012","igraph" +"4011","padding" +"4011","log4net" +"4004","javabeans" +"4003","digital-ocean" +"4002","bind" +"4002","sharepoint-online" +"4000","message-queue" +"3997","oracle12c" +"3994","android-view" +"3988","distance" +"3988","facebook-like" +"3987","winrt-xaml" +"3985","xcode5" +"3984","symfony1" +"3980","mean" +"3974","mdx" +"3967","blazor-webassembly" +"3961","urllib" +"3957","clr" +"3955","ads" +"3955","kubernetes-ingress" +"3953","reverse-engineering" +"3952","media-player" +"3948","facebook-opengraph" +"3946","hadoop-yarn" +"3940","xcode7" +"3935","hyperledger" +"3935","game-physics" +"3934","simplexml" +"3933","entity-framework-5" +"3929","data-manipulation" +"3920","unity-container" +"3919","stdin" +"3914","code-generation" +"3912","opengl-es-2.0" +"3905","replication" +"3905","flex4" +"3905","numpy-ndarray" +"3904","firemonkey" +"3902","wkwebview" +"3901","reshape" +"3895","selector" +"3895","redhat" +"3892","atomic" +"3887","pyodbc" +"3886","manifest" +"3886","minecraft" +"3886","iot" +"3884","marklogic" +"3882","ip-address" +"3881","pentaho" +"3878","mean-stack" +"3877","cocos2d-x" +"3876","yocto" +"3876","future" +"3875","microsoft-metro" +"3874","capistrano" +"3871","apache-kafka-connect" +"3868","ui-automation" +"3866","complexity-theory" +"3865","each" +"3865","google-cloud-sql" +"3864","httpresponse" +"3862","amazon-eks" +"3858","wget" +"3856","liquibase" +"3856","android-relativelayout" +"3853","prisma" +"3853","spacy" +"3852","loading" +"3852","ninject" +"3850","router" +"3849","session-variables" +"3846","sql-server-2016" +"3842","sencha-touch-2" +"3834","openxml" +"3834","activex" +"3833","matlab-figure" +"3830","firebird" +"3830","aws-cdk" +"3829","game-engine" +"3828","automatic-ref-counting" +"3817","reverse" +"3817","sql-injection" +"3816","option-type" +"3815","quartz-scheduler" +"3809","android-canvas" +"3807","raster" +"3805","screen-scraping" +"3804","web-component" +"3803","inline" +"3801","github-api" +"3797","python-sphinx" +"3794","pinvoke" +"3792","system-calls" +"3790","azureservicebus" +"3784","updates" +"3784",".net-4.5" +"3781","django-urls" +"3779","nsuserdefaults" +"3779","logistic-regression" +"3772","text-to-speech" +"3771","elisp" +"3769","marshalling" +"3767","grand-central-dispatch" +"3767","react-testing-library" +"3767","microcontroller" +"3763","gallery" +"3760","tornado" +"3756","avro" +"3755","local" +"3753","wicket" +"3753","margin" +"3747","afnetworking" +"3746","war" +"3746","one-to-many" +"3745","psql" +"3743","angular-routing" +"3741","executable" +"3741","nvidia" +"3738","elastic-stack" +"3736","nuget-package" +"3732","junit5" +"3732","splash-screen" +"3727","handler" +"3724","frame" +"3723","background-color" +"3719","reporting" +"3719","c#-3.0" +"3717","mvvmcross" +"3715","immutability" +"3715","apache-zookeeper" +"3715","pdfbox" +"3713","maven-plugin" +"3712","logback" +"3709","openid" +"3707","random-forest" +"3706","correlation" +"3706","richfaces" +"3706","uisearchbar" +"3703","aop" +"3703","kubectl" +"3694","nokogiri" +"3694","lookup" +"3692","scatter-plot" +"3692","draggable" +"3690","windows-8.1" +"3689","excel-2007" +"3680","facebook-php-sdk" +"3679","paypal-sandbox" +"3673","sql-server-ce" +"3655","python-typing" +"3654","redux-toolkit" +"3653","wrapper" +"3648","export-to-excel" +"3648","office-interop" +"3644","syntax-highlighting" +"3642","drupal-6" +"3639","uigesturerecognizer" +"3636","dynamic-memory-allocation" +"3634","phpexcel" +"3632","ssrs-2012" +"3632","cs50" +"3631","saml" +"3631","mediawiki" +"3630","sfml" +"3629","google-docs" +"3628","azure-aks" +"3623","bit" +"3621","argparse" +"3620","fxml" +"3620","avplayer" +"3619","toolbar" +"3618","gremlin" +"3618","activeadmin" +"3617","pyside" +"3614","passenger" +"3610","atom-editor" +"3610","extension-methods" +"3608","amazon-athena" +"3604","html5-audio" +"3603","series" +"3602","xlsx" +"3602","ubuntu-18.04" +"3602","struts" +"3600","infinite-loop" +"3597","assets" +"3596","biztalk" +"3596","physics" +"3596","benchmarking" +"3595","python-unittest" +"3591","intel" +"3590","appcelerator" +"3590","reduce" +"3588","header-files" +"3584","serverless" +"3584","digital-signature" +"3581","kerberos" +"3580","traits" +"3579","vercel" +"3577","jboss7.x" +"3575","store" +"3572","mern" +"3569","materialize" +"3569","data-cleaning" +"3564","slideshow" +"3564","asset-pipeline" +"3564","curve-fitting" +"3563","android-support-library" +"3560","increment" +"3559","richtextbox" +"3558","acumatica" +"3558","ienumerable" +"3557","rgb" +"3556","xdebug" +"3556","guava" +"3553","draw" +"3549","transparency" +"3544","setuptools" +"3542","alfresco" +"3540","dropbox" +"3538","dotnetnuke" +"3538","haml" +"3538","eigen" +"3536","default" +"3535","android-spinner" +"3533","symbols" +"3529","open-source" +"3523","deadlock" +"3521","purrr" +"3517","jpql" +"3517","monads" +"3517","copy-paste" +"3513","c++builder" +"3513","office-addins" +"3509","lotus-notes" +"3509","use-effect" +"3507","jsonschema" +"3504","fullscreen" +"3503","git-bash" +"3501","importerror" +"3500","backgroundworker" +"3498","k-means" +"3497","actionlistener" +"3493","google-maps-android-api-2" +"3492","footer" +"3492","transformation" +"3491","system-verilog" +"3489","huggingface-transformers" +"3486","scheduler" +"3485","next.js13" +"3484","onchange" +"3481","package.json" +"3474","wait" +"3474","windows-xp" +"3473","mathematical-optimization" +"3473","aggregation" +"3472","ros" +"3472","libraries" +"3471","sqlplus" +"3469","twisted" +"3466","deep-linking" +"3465","html-agility-pack" +"3460","payment" +"3457","mime-types" +"3457","plist" +"3452","sublimetext" +"3450","move" +"3448","load-testing" +"3448","declaration" +"3446","boxplot" +"3446","system.reactive" +"3446","font-face" +"3439","trigonometry" +"3435","abap" +"3431","powershell-3.0" +"3427","block" +"3427","jquery-ui-sortable" +"3422","center" +"3421","mybatis" +"3415","spatial" +"3414","git-merge" +"3409","publish" +"3409","interrupt" +"3409","aurelia" +"3409","bazel" +"3407","wso2-api-manager" +"3406","release" +"3406","amazon-emr" +"3405","x11" +"3405","bdd" +"3404","apollo-client" +"3400","sendgrid" +"3393","semaphore" +"3392","external" +"3392","commit" +"3391","clickonce" +"3391","android-adapter" +"3389","actions-on-google" +"3388","python-3.5" +"3385","facebook-login" +"3382","standards" +"3382","mongoose-schema" +"3378","desktop-application" +"3376","media" +"3375","shared-ptr" +"3372","datetimepicker" +"3371","react-props" +"3369",".net-assembly" +"3368","primes" +"3364","magento-1.7" +"3353","android-espresso" +"3353","aspectj" +"3350","transpose" +"3350","recurrent-neural-network" +"3349","uipickerview" +"3348","root" +"3348","hook-woocommerce" +"3347","project-reactor" +"3345","basic-authentication" +"3345","eclipse-cdt" +"3345","sybase" +"3338","slf4j" +"3335","here-api" +"3333","cloudflare" +"3332","tls1.2" +"3330","zeromq" +"3329","perforce" +"3325","arkit" +"3324","regex-lookarounds" +"3321","flink-streaming" +"3318","vpn" +"3318","playwright" +"3317","mstest" +"3313","spring-data-mongodb" +"3309","uuid" +"3306","turtle-graphics" +"3306","use-state" +"3304","stanford-nlp" +"3302","compiler-optimization" +"3299","tweepy" +"3295","connection-pooling" +"3294","android-custom-view" +"3293","cloud-foundry" +"3293","grammar" +"3287","esp32" +"3287","tfsbuild" +"3286","xunit" +"3286","entity-framework-migrations" +"3283","bufferedreader" +"3282","git-branch" +"3279","box2d" +"3276","actionbarsherlock" +"3275","vertical-alignment" +"3275","webpack-dev-server" +"3274","gtk3" +"3270","jlabel" +"3269","updatepanel" +"3268","array-formulas" +"3263","indentation" +"3263","blender" +"3262","android-constraintlayout" +"3259","slack" +"3259","multer" +"3257","alexa-skills-kit" +"3255","custom-post-type" +"3254","hibernate-mapping" +"3254","httpurlconnection" +"3249","asp.net-membership" +"3247","mod-wsgi" +"3247","auth0" +"3246","quicksort" +"3244","windows-mobile" +"3243","lwjgl" +"3243","multilingual" +"3238","glob" +"3237","watchkit" +"3237","google-forms" +"3234","key-value" +"3229","nested-lists" +"3227","cart" +"3227","presto" +"3226","guice" +"3225","associative-array" +"3223","libcurl" +"3223","geocoding" +"3221","jpa-2.0" +"3221","vmware" +"3220","sql-like" +"3214","sleep" +"3214","repository-pattern" +"3213","mysql-python" +"3208","whatsapp" +"3208","android-contentprovider" +"3206","gif" +"3206","destructor" +"3205","microsoft-dynamics" +"3204","x509certificate" +"3204","partitioning" +"3200","normalization" +"3200","encode" +"3199","background-process" +"3199","dagger-2" +"3198","forms-authentication" +"3197","require" +"3195","docker-swarm" +"3195","visibility" +"3195","doxygen" +"3191","edit" +"3190","nest" +"3190","git-submodules" +"3189","mamp" +"3186","factory" +"3185","repeat" +"3185","shared-memory" +"3178","gitlab-ci-runner" +"3177","datetime-format" +"3177","android-source" +"3166","distribution" +"3162","bouncycastle" +"3162","virtual" +"3159","bower" +"3151","versioning" +"3150","p5.js" +"3150","spring-security-oauth2" +"3146","react-native-ios" +"3145","nexus" +"3142","coronasdk" +"3142","azure-service-fabric" +"3142","thumbnails" +"3136","visual-studio-2005" +"3135","na" +"3134","python-itertools" +"3134","crop" +"3134","web-hosting" +"3132","wear-os" +"3131","codeigniter-2" +"3130","angularfire2" +"3129","userform" +"3128","multi-tenant" +"3125","expandablelistview" +"3123","swift6" +"3122","sql-delete" +"3121","serverless-framework" +"3117","core-location" +"3116","typedef" +"3116","ember-cli" +"3115","file-permissions" +"3114","google-cloud-pubsub" +"3113","barcode" +"3113","ignite" +"3112","app-config" +"3111","docx" +"3111","android-toolbar" +"3111","virtualhost" +"3109","freemarker" +"3104","mp4" +"3103","data-modeling" +"3103","swig" +"3103","crashlytics" +"3103","moodle" +"3102","delphi-7" +"3101","form-submit" +"3101","android-jetpack" +"3100","saml-2.0" +"3100","collision" +"3098","nsurlconnection" +"3097","smartcontracts" +"3097","dashboard" +"3096","bitwise-operators" +"3095","compact-framework" +"3094","remote-access" +"3094","axis" +"3093","uwp-xaml" +"3091","crm" +"3081","dotnet-httpclient" +"3080","cdn" +"3079","rcpp" +"3076","offset" +"3074","windows-authentication" +"3072","e2e-testing" +"3070","data-mining" +"3070","roles" +"3065","video-processing" +"3063","flash-builder" +"3061","pie-chart" +"3061","amazon-sagemaker" +"3060",".net-5" +"3056","jndi" +"3053","v8" +"3052","weka" +"3052","wso2-identity-server" +"3051","min" +"3049","contains" +"3048","data-annotations" +"3045","delimiter" +"3045","equals" +"3044","stdvector" +"3041","wireshark" +"3039","facebook-fql" +"3038","react-context" +"3036","carrierwave" +"3036","sdl-2" +"3033","azure-resource-manager" +"3031","dependency-management" +"3031","nio" +"3028","android-xml" +"3027","rdlc" +"3027","tokenize" +"3025","binary-search" +"3021","abstract-syntax-tree" +"3020","wav" +"3015","amazon-sns" +"3014","xib" +"3014","x86-16" +"3013","gitignore" +"3012","influxdb" +"3012","magento-1.9" +"3011","program-entry-point" +"3009","sharepoint-2007" +"3009","compatibility" +"3008","identity" +"3006","filepath" +"3006","innerhtml" +"3005","record" +"3004","instagram-api" +"3004","obfuscation" +"3003","freeze" +"3002","layout-manager" +"3002","webassembly" +"3000","publish-subscribe" +"2999","document" +"2998","hardware" +"2998","conditional-formatting" +"2997","android-drawable" +"2994","matrix-multiplication" +"2993","anylogic" +"2993","azure-powershell" +"2991","firewall" +"2990","raspbian" +"2988","jenkins-groovy" +"2988","new-operator" +"2987","graphviz" +"2987","java-7" +"2986","image-uploading" +"2985","sendmail" +"2985","javadoc" +"2983","entity-relationship" +"2981","drawable" +"2981","currency" +"2978","breakpoints" +"2978","google-cloud-run" +"2975","jquery-ui-datepicker" +"2970","angular-material2" +"2970","raphael" +"2968","onedrive" +"2965","device" +"2964","highlight" +"2963","graph-databases" +"2963","jtextfield" +"2962","nspredicate" +"2961","coq" +"2961","gd" +"2957","azure-keyvault" +"2956","display" +"2956","urllib2" +"2953","uwsgi" +"2952","database-schema" +"2951","browserify" +"2950","aframe" +"2949","master-pages" +"2949","orchardcms" +"2947","filereader" +"2947","attachment" +"2947","java-11" +"2946","file-handling" +"2945","latitude-longitude" +"2943","windbg" +"2943","intervals" +"2941","rvest" +"2940","slack-api" +"2939","binaryfiles" +"2936","jodatime" +"2935","nsdateformatter" +"2932","hazelcast" +"2931","elementtree" +"2930","tensor" +"2930","gdi+" +"2929","uistoryboard" +"2929","dapper" +"2928","fs" +"2928","chai" +"2922","parent" +"2919","android-livedata" +"2916","cpu-usage" +"2914","blogger" +"2912","fopen" +"2908","browser-cache" +"2904","iis-6" +"2903","formik" +"2902","azure-synapse" +"2902","search-engine" +"2900","sip" +"2895","roslyn" +"2893","entity-framework-4.1" +"2892","content-security-policy" +"2891","simulink" +"2889","private" +"2889","observablecollection" +"2889","angular2-template" +"2886","clion" +"2886","jobs" +"2885","metrics" +"2884","sveltekit" +"2884","nlog" +"2883","number-formatting" +"2882","python-2.x" +"2879","azure-ad-msal" +"2879","plone" +"2879","ld" +"2878","frequency" +"2877","missing-data" +"2877","do-while" +"2877","startup" +"2876","z3" +"2872","distributed-computing" +"2868","hierarchy" +"2867","mask" +"2867","indexoutofboundsexception" +"2866","gnu" +"2865","statsmodels" +"2864","stylesheet" +"2863","calayer" +"2863","environment" +"2862","resttemplate" +"2861","nginx-reverse-proxy" +"2861","fstream" +"2860","strapi" +"2860","googletest" +"2859","es6-modules" +"2857","blogs" +"2856","viewport" +"2855","webcam" +"2852","mvvm-light" +"2851","xgboost" +"2851","ping" +"2850","loopbackjs" +"2849","sudo" +"2847","patch" +"2844","jruby" +"2842","greasemonkey" +"2842","smart-pointers" +"2842","simple-form" +"2838","swipe" +"2835","captcha" +"2835","font-size" +"2834","criteria" +"2834","asterisk" +"2831","sinon" +"2829","slim" +"2826","caffe" +"2826","asmx" +"2826","prediction" +"2824","ibm-midrange" +"2823","data-warehouse" +"2823","trace" +"2823","arcgis" +"2822","static-methods" +"2821","rdbms" +"2820","ios10" +"2820","multi-index" +"2818","drupal-8" +"2817","fpga" +"2815","shinydashboard" +"2813","angularfire" +"2812","spring-cloud-stream" +"2810","breeze" +"2810","autowired" +"2809","paint" +"2809","apple-m1" +"2808","word-wrap" +"2806","avaudioplayer" +"2804","scheduling" +"2803","type-inference" +"2802","talend" +"2802","computational-geometry" +"2800","android-5.0-lollipop" +"2799","ubuntu-12.04" +"2796","contour" +"2794","openai-api" +"2792","jython" +"2791","repeater" +"2790","viewcontroller" +"2789","filestream" +"2789","nullreferenceexception" +"2789","comparator" +"2788","acl" +"2787","keystore" +"2787","mergesort" +"2785","asp.net-core-3.1" +"2784","solaris" +"2783","h.264" +"2781","geopandas" +"2780","c-strings" +"2775","dos" +"2775","expect" +"2772","flex3" +"2771","reload" +"2771","undefined-behavior" +"2771","iphone-sdk-3.0" +"2770","castle-windsor" +"2770","graph-algorithm" +"2768","prototypejs" +"2766","ksh" +"2764","gfortran" +"2764","kivy-language" +"2763","procedure" +"2762","flutter-animation" +"2761","angular-ui" +"2760","twitter-oauth" +"2759","fedora" +"2757","voip" +"2755","android-softkeyboard" +"2754","domdocument" +"2750","jfreechart" +"2747","multiple-inheritance" +"2747","semantic-ui" +"2746","registration" +"2745","google-play-console" +"2743","php-7" +"2742","matching" +"2742","symfony-forms" +"2740","regex-group" +"2739","react-native-flatlist" +"2739","credentials" +"2739","surfaceview" +"2738","jetbrains-ide" +"2738","kendo-asp.net-mvc" +"2738","assert" +"2737","windows-server-2008" +"2737","percentage" +"2736","pca" +"2732","jooq" +"2731","azure-mobile-services" +"2730","paypal-ipn" +"2729","http-live-streaming" +"2728","icloud" +"2728","compiler-warnings" +"2728","amazon-elb" +"2726","tar" +"2724","firebug" +"2722","partial-views" +"2719","cllocationmanager" +"2718","operator-keyword" +"2715","dynamic-sql" +"2712","kinect" +"2712","positioning" +"2711","jscrollpane" +"2711","minikube" +"2708","reinforcement-learning" +"2704","jupyter-lab" +"2701","ado" +"2698","postback" +"2694","pine-script-v5" +"2694","nuxt3.js" +"2693","bing-maps" +"2693","variadic-functions" +"2693","mongodb-.net-driver" +"2691","tomcat8" +"2691","mesh" +"2690","show-hide" +"2688","simd" +"2688","restkit" +"2687","windows-ce" +"2687","continuous-deployment" +"2687","auto-increment" +"2685","shortcut" +"2685","istio" +"2683","amazon-vpc" +"2682","interceptor" +"2681","paramiko" +"2679","power-automate" +"2679","android-appcompat" +"2676","vert.x" +"2675","subdirectory" +"2672","helper" +"2671","masm" +"2670","checkout" +"2670","kml" +"2669","joomla2.5" +"2669","styling" +"2668","orientdb" +"2667","vlc" +"2662","monodevelop" +"2661","remote-debugging" +"2660","singly-linked-list" +"2656","android-virtual-device" +"2656","setstate" +"2654","audio-streaming" +"2654","angular2-forms" +"2653","jspdf" +"2652","simpledateformat" +"2651","hudson" +"2650","daemon" +"2649","derby" +"2648","amazon-route53" +"2644","hdf5" +"2644","d" +"2643","factory-bot" +"2643","mypy" +"2641","phonegap-build" +"2639","server-side" +"2638","watir" +"2638","haproxy" +"2637","erb" +"2637","32bit-64bit" +"2635","instantiation" +"2635","numeric" +"2634","laravel-livewire" +"2633","sensors" +"2633","ironpython" +"2631","priority-queue" +"2630","bison" +"2630","spring-aop" +"2630","email-attachments" +"2629","nsis" +"2628","linear-programming" +"2627","nstimer" +"2626","amcharts" +"2625","jsonb" +"2624","depth-first-search" +"2624","objective-c-blocks" +"2623","pandoc" +"2622","emoji" +"2621","dao" +"2619","keypress" +"2619","logical-operators" +"2617","break" +"2617","exit" +"2616","react-hook-form" +"2616","web-audio-api" +"2614","lubridate" +"2613","picturebox" +"2611","in-app-billing" +"2611","lazy-evaluation" +"2609","fosuserbundle" +"2607","azure-cognitive-services" +"2607","messaging" +"2606","file-get-contents" +"2605","feed" +"2605","cicd" +"2605","rmi" +"2604","database-performance" +"2602","code-signing" +"2601","apex" +"2601","pascal" +"2600","free" +"2597","text-mining" +"2597","webdriverwait" +"2596","sqoop" +"2596","delphi-xe2" +"2595","guzzle" +"2592","lumen" +"2592","el" +"2592","stringr" +"2591","dbcontext" +"2591","attributeerror" +"2588","event-listener" +"2587","add-in" +"2587","accelerometer" +"2587","sql-server-2000" +"2587","redux-thunk" +"2586","query-builder" +"2583","ipv6" +"2582","deprecated" +"2581","python-3.4" +"2581","cross-validation" +"2581","paste" +"2581","maya" +"2579","lotus-domino" +"2578","mapbox-gl-js" +"2577","apache-storm" +"2577","contenteditable" +"2577","axapta" +"2577",".net-2.0" +"2577","zxing" +"2576","mootools" +"2573","resultset" +"2572","owl" +"2572","azure-api-management" +"2570","tcpclient" +"2570","qemu" +"2568","constexpr" +"2567","pydev" +"2561","rpc" +"2561","android-videoview" +"2557","str-replace" +"2555","uialertview" +"2554","multiplication" +"2554","nav" +"2551","barcode-scanner" +"2551","tostring" +"2548","menuitem" +"2545","wampserver" +"2545","abstract" +"2545","iostream" +"2542","picasso" +"2540","hsqldb" +"2540","android-resources" +"2539","development-environment" +"2537","channel" +"2536","ravendb" +"2535","image-segmentation" +"2534","swap" +"2531","bulkinsert" +"2531","ios11" +"2530","amqp" +"2530","tk-toolkit" +"2529","css-transforms" +"2522","intersection" +"2522","nodemailer" +"2521","show" +"2520","scaling" +"2519","androidx" +"2519","google-chrome-app" +"2519","restsharp" +"2518","photoshop" +"2517","decision-tree" +"2516","knex.js" +"2514","windows-forms-designer" +"2514","twilio-api" +"2513","opacity" +"2513","core-bluetooth" +"2513","google-ads-api" +"2511","cloudera" +"2510","mysql-connector" +"2509","ghc" +"2509","powerapps" +"2509","resteasy" +"2508","rtsp" +"2508","desktop" +"2506","nginx-ingress" +"2504","datatemplate" +"2502","android-databinding" +"2499","adt" +"2497","wsgi" +"2496","mechanize" +"2495","meta-tags" +"2494","python-decorators" +"2493","core-audio" +"2492","azure-virtual-machine" +"2492","esp8266" +"2489","telnet" +"2489","sandbox" +"2489","google-cloud-endpoints" +"2488","symlink" +"2488","wkhtmltopdf" +"2487","relative-path" +"2487","title" +"2486","lombok" +"2485","nsdata" +"2485","spark-structured-streaming" +"2484","nsurlsession" +"2484","archive" +"2482","gsub" +"2482","video-capture" +"2479","firebase-hosting" +"2479","mouseover" +"2478","redux-saga" +"2474","laravel-5.5" +"2474","javac" +"2473","slick" +"2473","model-binding" +"2472","trim" +"2472","nullable" +"2471","firebase-analytics" +"2471","rspec-rails" +"2469","icalendar" +"2468","finance" +"2467","rsync" +"2464","implicit-conversion" +"2463","popen" +"2463","systemd" +"2463","plyr" +"2463","communication" +"2461","gensim" +"2460","var" +"2457","keyword" +"2457","glfw" +"2454","lightbox" +"2451","minify" +"2450","xml-namespaces" +"2450","spring-jdbc" +"2450","code-injection" +"2450","speech-to-text" +"2449","python-xarray" +"2449","statusbar" +"2446","jmx" +"2445","theano" +"2443","long-integer" +"2442","casperjs" +"2436","ngfor" +"2436","android-lifecycle" +"2436","sphinx" +"2435","jcombobox" +"2435","executable-jar" +"2434","mailchimp" +"2433","terraform-provider-azure" +"2433","getelementbyid" +"2432","datastax" +"2432","liferay-6" +"2431","ibm-watson" +"2431","offline" +"2429","pcre" +"2427","installshield" +"2426","vulkan" +"2425","copy-constructor" +"2425","race-condition" +"2423","web3js" +"2417","tiff" +"2416","apache-axis" +"2416","ada" +"2413","symfony-1.4" +"2413","openlayers-3" +"2411","jena" +"2411","android-button" +"2411","prompt" +"2410","vtk" +"2410","wysiwyg" +"2409","apple-watch" +"2408","serilog" +"2405","ejabberd" +"2404","date-format" +"2403","spock" +"2401","sidekiq" +"2401","zlib" +"2401","user-agent" +"2399","wagtail" +"2398","snmp" +"2396","redux-form" +"2395","windows-10-universal" +"2394","hybrid-mobile-app" +"2392","json-deserialization" +"2392","azure-table-storage" +"2391","velocity" +"2391","elf" +"2389","readfile" +"2388","models" +"2387","flowtype" +"2387","numba" +"2387","reset" +"2386","code-first" +"2385","actionmailer" +"2384","marionette" +"2384","ehcache" +"2383","dropbox-api" +"2380","assemblies" +"2380","resolution" +"2378","indexeddb" +"2377","utc" +"2376","combinatorics" +"2374","fibonacci" +"2371","template-meta-programming" +"2371","virtualization" +"2370","avr" +"2369","wpfdatagrid" +"2368","boto" +"2368","angular-directive" +"2367","rust-cargo" +"2367","rpm" +"2365","sse" +"2365","client-side" +"2365","flask-wtforms" +"2365","content-type" +"2365","polymer-1.0" +"2365","glibc" +"2363","paging" +"2357","coroutine" +"2357","http-status-code-403" +"2356","yeoman" +"2354","stack-trace" +"2352","visual-studio-debugging" +"2351","omniauth" +"2350","cloudkit" +"2350","unix-timestamp" +"2350","uibarbuttonitem" +"2347","netcdf" +"2346","apache-httpclient-4.x" +"2345","reportviewer" +"2345","ghostscript" +"2345","openstack" +"2345","dreamweaver" +"2344","inner-classes" +"2344","ejb-3.0" +"2344","qtquick2" +"2343","next-auth" +"2343","urlencode" +"2343","bcrypt" +"2341","godot" +"2340","cplex" +"2338","ram" +"2334","logcat" +"2333","dllimport" +"2332","streamlit" +"2331","android-glide" +"2330","splunk" +"2329","unreal-engine4" +"2328","android-cardview" +"2328","executorservice" +"2326","roblox" +"2326","iis-express" +"2325","corda" +"2324","arabic" +"2322","firebase-admin" +"2322","subscription" +"2320","uilocalnotification" +"2319","pyserial" +"2318","bytecode" +"2318","react-apollo" +"2318","forecasting" +"2317","capacitor" +"2316","vps" +"2316","dependency-properties" +"2316","winsock" +"2316","shuffle" +"2314","ssrs-2008-r2" +"2314","scalability" +"2314","pm2" +"2314","string-matching" +"2313","ajaxcontroltoolkit" +"2312","clojurescript" +"2312","uitabbar" +"2312","traefik" +"2311","amp-html" +"2310","terminology" +"2305","fpdf" +"2305","specflow" +"2304","nhibernate-mapping" +"2301","calculated-columns" +"2300","silverstripe" +"2297","jersey-2.0" +"2297","flyway" +"2297","lifetime" +"2296","build-process" +"2296","odoo-8" +"2295","android-mapview" +"2294","azure-cli" +"2294","interpreter" +"2294","itunes" +"2293","division" +"2293","python-3.8" +"2293","word2vec" +"2292","nsfetchedresultscontroller" +"2290","swiper.js" +"2290","hashset" +"2288","api-design" +"2287","kernel-module" +"2286","putty" +"2284","tracking" +"2284","glut" +"2283","countdown" +"2281","ddl" +"2279","soap-client" +"2274","pydantic" +"2274","azure-webjobs" +"2273","netlify" +"2272","fiddler" +"2269","neovim" +"2268","web-worker" +"2267","laravel-7" +"2266","gpgpu" +"2266","amazon-ses" +"2266","dropzone.js" +"2264","nsattributedstring" +"2261","ibeacon" +"2260","distributed" +"2259","html-helper" +"2257","sidebar" +"2256","readline" +"2254","photo" +"2254","child-process" +"2254","pull-request" +"2254","keyboard-events" +"2254","informix" +"2254","breadth-first-search" +"2253","uninstallation" +"2253","rest-assured" +"2252","string-comparison" +"2251","configuration-files" +"2250","infinite-scroll" +"2250","shortcode" +"2248","jsf-2.2" +"2248","metal" +"2246","classnotfoundexception" +"2246","css-tables" +"2246","node-red" +"2244","webapi" +"2243","python-polars" +"2243","put" +"2243","line-breaks" +"2241","pygtk" +"2240","arduino-uno" +"2239","unique-ptr" +"2239","rebase" +"2238","nservicebus" +"2237","apache-spark-mllib" +"2235","gdal" +"2234","pseudo-element" +"2233","video.js" +"2233","laravel-routing" +"2231","yii2-advanced-app" +"2231","sap-commerce-cloud" +"2230","tensorflow-lite" +"2230","tf.keras" +"2229","nstableview" +"2228","mef" +"2227","tabcontrol" +"2225","jquery-ui-dialog" +"2225","andengine" +"2223","clearcase" +"2223","spring-data-rest" +"2223","emgucv" +"2221","selenium-ide" +"2219","gesture" +"2219","parallax" +"2218","dry" +"2217","kohana" +"2216","pyramid" +"2215","dsl" +"2214","inline-assembly" +"2214","shopping-cart" +"2210","equality" +"2210","text-editor" +"2210","logout" +"2210","mpmovieplayercontroller" +"2210","static-analysis" +"2207","scapy" +"2206","ontology" +"2205","bloc" +"2205","osx-lion" +"2205","noclassdeffounderror" +"2204","angular2-services" +"2202","tcpdf" +"2200","implementation" +"2200","searchview" +"2199","vscode-debugger" +"2198","grid-layout" +"2197","image-resizing" +"2196","elementor" +"2195","android-theme" +"2194","popover" +"2194","drupal-modules" +"2194","itext7" +"2188","birt" +"2188","omnet++" +"2186","numerical-methods" +"2186","storybook" +"2184","detection" +"2184","gdi" +"2184","ms-access-2013" +"2183","phaser-framework" +"2182","kdb" +"2177","getter-setter" +"2172","android-bluetooth" +"2171","masstransit" +"2169","google-apps" +"2168","android-6.0-marshmallow" +"2167","centering" +"2166","android-testing" +"2165","git-commit" +"2164","send" +"2163","bufferedimage" +"2162","rx-swift" +"2162","nslayoutconstraint" +"2162","torch" +"2160","mixins" +"2159","joomla3.0" +"2159","ioc-container" +"2159","plotly-python" +"2159","endianness" +"2157","drag" +"2155","oracle-adf" +"2154","kql" +"2154","ifstream" +"2153","lamp" +"2151","dto" +"2149","sizeof" +"2148","move-semantics" +"2148","odoo-10" +"2146","quotes" +"2146","testflight" +"2145","cql" +"2144","analysis" +"2143","apollo-server" +"2141","org-mode" +"2138","anonymous-function" +"2137","social-networking" +"2136","lag" +"2135","explode" +"2134","stringbuilder" +"2133","web2py" +"2127","endpoint" +"2123","clickhouse" +"2122","ios13" +"2121","jquery-ui-autocomplete" +"2120","database-administration" +"2120","spss" +"2119","large-data" +"2118","multi-select" +"2118","hidden" +"2117","langchain" +"2117","angular-promise" +"2117","android-tabhost" +"2115","delete-file" +"2114","spring-test" +"2113","android-fragmentactivity" +"2111","indy" +"2111","expression-trees" +"2111","layer" +"2110","uisplitviewcontroller" +"2109","tensorflow-datasets" +"2109","reactive" +"2108","flex-lexer" +"2108","kineticjs" +"2108","onload" +"2106","nginx-config" +"2105","sitemap" +"2102","fatal-error" +"2102","google-api-php-client" +"2102","npgsql" +"2102","toast" +"2102","genetic-algorithm" +"2101","confluent-platform" +"2101","vb.net-2010" +"2099","sml" +"2099","varnish" +"2097","adfs" +"2097","ruby-on-rails-6" +"2096","placeholder" +"2096","opencv3.0" +"2096","r-caret" +"2094","jwplayer" +"2094","convolution" +"2094","weblogic12c" +"2092","servlet-filters" +"2092","soundcloud" +"2090","internet-explorer-6" +"2087","azure-iot-hub" +"2086","fgets" +"2086","vi" +"2084","python-module" +"2084","cakephp-1.3" +"2083","console.log" +"2083","osx-yosemite" +"2083","pywin32" +"2082","angular-services" +"2082","arm64" +"2081","firefox-addon-sdk" +"2081","bit-shift" +"2081","actor" +"2080","hierarchical-data" +"2076","business-intelligence" +"2075","sonata-admin" +"2073","impala" +"2072","python-re" +"2071","kubernetes-pod" +"2071","shadow" +"2071","angular-components" +"2071","web.xml" +"2070","clang++" +"2070","fadein" +"2070","uipageviewcontroller" +"2070","directive" +"2069","caliburn.micro" +"2069","android-contacts" +"2068","clock" +"2068","sql-server-data-tools" +"2067","angular-forms" +"2066","recursive-query" +"2063","runnable" +"2062","flot" +"2059","exc-bad-access" +"2056","encapsulation" +"2055","glm" +"2054","raku" +"2053","projection" +"2053","combine" +"2053","linechart" +"2052","unzip" +"2052","azure-data-explorer" +"2051","fastcgi" +"2049","mime" +"2047","lets-encrypt" +"2047","point" +"2047","httpd.conf" +"2045","string-concatenation" +"2045","iis-8" +"2044","tumblr" +"2044","exoplayer" +"2044","tkinter-canvas" +"2043","modeling" +"2043","android-tablayout" +"2043","audio-recording" +"2043","hadoop2" +"2043","restore" +"2042","directshow" +"2040","phalcon" +"2040","jtextarea" +"2040","plesk" +"2039","supabase" +"2039","shapefile" +"2039","hashcode" +"2039","powermock" +"2036","signature" +"2036","gerrit" +"2035","jstree" +"2034","looker-studio" +"2033","default-value" +"2032","android-wifi" +"2030","custom-wordpress-pages" +"2028","subplot" +"2026","azure-eventhub" +"2026","dt" +"2026","scenebuilder" +"2025","jdbctemplate" +"2025","jna" +"2025","freebsd" +"2023","appdelegate" +"2021","guid" +"2021","spring-transactions" +"2021","querydsl" +"2020","chromecast" +"2020","java-ee-6" +"2016","lifecycle" +"2016","sticky" +"2015","dompdf" +"2014","data-conversion" +"2014","xctest" +"2013","react-select" +"2013","dropwizard" +"2010","traversal" +"2010","iptables" +"2007","azure-pipelines-release-pipeline" +"2004","dispose" +"2003","conditional-operator" +"1999","xts" +"1999","r-sf" +"1999","cqrs" +"1998","sentiment-analysis" +"1998","jit" +"1998","midi" +"1998","difference" +"1997","azure-ad-graph-api" +"1995","lldb" +"1995","biginteger" +"1994","xlsxwriter" +"1993","sha256" +"1993","mmap" +"1992","gsap" +"1991","google-authentication" +"1990","react-router-v4" +"1990","google-workspace" +"1990","zend-form" +"1989","slick.js" +"1989","ssh-keys" +"1989","software-design" +"1989","rally" +"1988","tensorboard" +"1988","modulo" +"1987","indexof" +"1987","space" +"1986","directx-11" +"1984","react-native-navigation" +"1983","remote-server" +"1983","osx-mavericks" +"1982","typeclass" +"1982","redmine" +"1980","esb" +"1980","ode" +"1978","keychain" +"1978","arangodb" +"1975","p2p" +"1975","azure-devops-rest-api" +"1975","text-processing" +"1974","go-gorm" +"1973","semantic-web" +"1971","internet-explorer-10" +"1971","android-context" +"1970","code-behind" +"1968","hana" +"1968","msmq" +"1967","getjson" +"1966","pgadmin" +"1965","powershell-4.0" +"1964","unmarshalling" +"1964","target" +"1963","mvp" +"1963","packaging" +"1962","volatile" +"1962","spring-jms" +"1961","azure-machine-learning-service" +"1959","nested-forms" +"1956","smartcard" +"1955","atlassian-sourcetree" +"1955","actionscript-2" +"1954","mustache" +"1954","soa" +"1953","dataweave" +"1953","opera" +"1953","streamreader" +"1952","xcode4.2" +"1951","create-table" +"1951","touch-event" +"1950","navigationbar" +"1949","vimeo" +"1949","overlap" +"1949","android-dialogfragment" +"1948","shortest-path" +"1948","outlook-web-addins" +"1948","multiline" +"1946","yolo" +"1946","code-snippets" +"1946","regex-negation" +"1945","blur" +"1943","pseudocode" +"1942","git-svn" +"1941","typoscript" +"1940","equation" +"1940","compass-sass" +"1939","preg-match-all" +"1938","kafka-producer-api" +"1938","mpandroidchart" +"1937","autodesk-viewer" +"1937","predicate" +"1933","jacoco" +"1932","yacc" +"1932","covariance" +"1932","c99" +"1932","dijkstra" +"1932","bean-validation" +"1932","query-performance" +"1931","x509" +"1929","embedded-resource" +"1928","lm" +"1928","imagick" +"1927","void" +"1927","init" +"1926","public-key-encryption" +"1925","multipart" +"1925","transparent" +"1925",".net-8.0" +"1924","epplus" +"1923","oozie" +"1923","scikit-image" +"1922","laravel-9" +"1922","session-state" +"1921","python-datetime" +"1921","django-serializer" +"1920","azure-data-lake" +"1920","android-preferences" +"1919","core-plot" +"1919","delete-row" +"1918","django-authentication" +"1917","mobile-application" +"1917","angular9" +"1916","android-styles" +"1912","hyperledger-composer" +"1912","uart" +"1910","enumeration" +"1909","contact-form-7" +"1909","laravel-6" +"1909","quickbooks" +"1907","win32com" +"1907","substitution" +"1906","slurm" +"1906","checksum" +"1906","broadcast" +"1905","tvos" +"1905","builder" +"1905","diagram" +"1905","azure-rm-template" +"1903","fixed" +"1903","wcf-data-services" +"1901","mobx" +"1901","android-library" +"1900","form-data" +"1900","monogame" +"1897","android-pendingintent" +"1896","pyautogui" +"1895","getter" +"1895","named-pipes" +"1895","joptionpane" +"1895","ncurses" +"1895","elm" +"1894","thrift" +"1893","angular-ui-grid" +"1892","saxon" +"1892","allocation" +"1891","server-sent-events" +"1890","interactive" +"1889","http2" +"1888","qmake" +"1886","h2o" +"1886","google-translate" +"1885","firebaseui" +"1885","synchronized" +"1884","tablesorter" +"1883","selenium-grid" +"1883","portlet" +"1883","code-analysis" +"1883","powerpivot" +"1883","preprocessor" +"1881","counting" +"1879","serversocket" +"1879","flutter-test" +"1879","prestashop-1.6" +"1878","cin" +"1877","similarity" +"1877","tmux" +"1877","css-shapes" +"1876","xls" +"1876","messagebox" +"1874","circleci" +"1874","testcafe" +"1873","fill" +"1872","adsense" +"1872","heap" +"1870","bluebird" +"1869","production-environment" +"1869","snapshot" +"1869","countif" +"1869","schedule" +"1868","windows-phone-7.1" +"1867","aws-fargate" +"1866","alpine-linux" +"1865","jsonpath" +"1865","database-replication" +"1864","angular-router" +"1864","dynamic-arrays" +"1864","com-interop" +"1863","autoscaling" +"1862","scp" +"1861","collation" +"1860","floating-action-button" +"1860","lint" +"1859","ecmascript-5" +"1857","ansible-2.x" +"1857","tomcat6" +"1856","ffi" +"1854","build-automation" +"1853","adodb" +"1853","game-center" +"1851","eof" +"1848","yum" +"1847","face-recognition" +"1847","bubble-sort" +"1847","parse-server" +"1846","dc.js" +"1846","sfinae" +"1845","rtf" +"1845","provisioning-profile" +"1844","host" +"1844","exif" +"1843","coded-ui-tests" +"1843","facebook-android-sdk" +"1842","sha1" +"1842","doubly-linked-list" +"1842","react-admin" +"1841","file-transfer" +"1840","observer-pattern" +"1840","lucene.net" +"1839","laravel-5.6" +"1839","cout" +"1838","pypi" +"1838","pojo" +"1837","jlist" +"1837","operator-precedence" +"1837","progressdialog" +"1836","jmeter-plugins" +"1835","xsl-fo" +"1835","react-query" +"1835","instruments" +"1835","volume" +"1835","informatica" +"1835","lex" +"1835","cabal" +"1833","laravel-5.8" +"1832","bukkit" +"1832","amazon-kinesis" +"1831","htmlunit" +"1829","aix" +"1829","micronaut" +"1829","postgresql-9.1" +"1829","android-viewmodel" +"1828","bootloader" +"1827","uisegmentedcontrol" +"1826","gpio" +"1826","entitymanager" +"1826","html2canvas" +"1826","java-time" +"1824","src" +"1823","gaussian" +"1823","permalinks" +"1822","slide" +"1821","nvd3.js" +"1820","static-linking" +"1820","using" +"1819","drupal-views" +"1819","openldap" +"1819","angular2-directives" +"1819","webdriver-io" +"1818","favicon" +"1818","mongoengine" +"1817","aws-appsync" +"1816","memory-address" +"1815","facelets" +"1814","apache-commons" +"1813","mathjax" +"1813","getline" +"1813","licensing" +"1812","snakemake" +"1811","profile" +"1809","bayesian" +"1808","lme4" +"1808","windows-7-x64" +"1808","cpu-registers" +"1808","http-status-code-301" +"1808","imagebutton" +"1808","alpha" +"1807","phonegap" +"1807","loader" +"1807","colorbox" +"1807","gnupg" +"1806","syncfusion" +"1805","jquery-ui-draggable" +"1804","kivymd" +"1803","implicit" +"1803","valueerror" +"1803","theory" +"1802","i2c" +"1801","windows-server-2008-r2" +"1799","facet" +"1799","boolean-logic" +"1797","invoke" +"1796","githooks" +"1796","bert-language-model" +"1795","uiviewanimation" +"1794","laravel-artisan" +"1794","extjs4.1" +"1794","protobuf-net" +"1793","java-web-start" +"1792","ecto" +"1791","rhel" +"1791","uibezierpath" +"1791","titanium-mobile" +"1790","facebook-ios-sdk" +"1790","exists" +"1788","spring-data-neo4j" +"1787","android-scrollview" +"1785","palindrome" +"1785","facebook-c#-sdk" +"1783","mulesoft" +"1782","kentico" +"1781","tampermonkey" +"1779","path-finding" +"1779","java-io" +"1778","gettext" +"1778","yui" +"1777","bitcoin" +"1777","django-celery" +"1777","azure-cognitive-search" +"1777","knn" +"1777","arcore" +"1776","categorical-data" +"1776","android-bitmap" +"1775","fwrite" +"1775","wikipedia" +"1775","sax" +"1775","qt-designer" +"1775","training-data" +"1774","jsdoc" +"1774","azure-pipelines-yaml" +"1773","super" +"1772","rx-android" +"1772","simulator" +"1772","setter" +"1770","goroutine" +"1769","bitnami" +"1769","keylistener" +"1769","libreoffice" +"1768","member" +"1767","cobol" +"1766","virtual-reality" +"1766","pylint" +"1766","xcode9" +"1765","execution" +"1764","aptana" +"1763","cefsharp" +"1763","angular-universal" +"1763","setup.py" +"1763","mount" +"1763","autoit" +"1762","composition" +"1761","bottomnavigationview" +"1760","circular-dependency" +"1760","akka-stream" +"1760","provider" +"1759","decoding" +"1759","ubuntu-20.04" +"1758","ternary-operator" +"1757","infragistics" +"1756","netbeans-8" +"1756","okta" +"1755","visual-studio-extensions" +"1754","websphere-liberty" +"1754","spring-boot-actuator" +"1754","loss-function" +"1753","specifications" +"1752","password-protection" +"1751","popupwindow" +"1751","excel-2013" +"1751","state-machine" +"1749","semantics" +"1749","key-bindings" +"1748","pyside2" +"1744","docker-registry" +"1743","profiler" +"1743","mule-studio" +"1742","yield" +"1742","foreign-key-relationship" +"1740","realloc" +"1739","windows-server-2012" +"1737","production" +"1737","signals-slots" +"1737","cx-freeze" +"1736","optaplanner" +"1735","ng-bootstrap" +"1735","sql-server-express" +"1731","kotlin-multiplatform" +"1730","filenotfoundexception" +"1729","react-typescript" +"1728","gatling" +"1728","git-push" +"1727","face-detection" +"1727","mozilla" +"1726","structuremap" +"1724","pid" +"1722","sugarcrm" +"1720","git-rebase" +"1719","preview" +"1719","naming" +"1719","qgis" +"1717","flash-cs5" +"1717","android-architecture-components" +"1717","rcp" +"1716","large-files" +"1715","frame-rate" +"1715","spree" +"1714","python-tesseract" +"1714","cas" +"1714","extends" +"1713","xml-rpc" +"1713","date-formatting" +"1713","uipopovercontroller" +"1713","tfs-2015" +"1711","smalltalk" +"1711","django-allauth" +"1711","http-status-codes" +"1709","classcastexception" +"1709","aiohttp" +"1707","solver" +"1707","google-play-games" +"1707","google-search" +"1703","jface" +"1702","prettier" +"1701","assign" +"1700","bigdecimal" +"1700","user-experience" +"1699","archlinux" +"1696","sample" +"1696","postgresql-9.3" +"1695","unions" +"1695","blocking" +"1694","translate" +"1693","web-parts" +"1693","watch" +"1693","countdowntimer" +"1692","ribbon" +"1692","uialertcontroller" +"1691","jsfiddle" +"1691","outer-join" +"1691","asp.net-core-2.1" +"1690","olap" +"1690","cut" +"1689","owl-carousel" +"1689","docker-machine" +"1689","jqplot" +"1688","rules" +"1686","fade" +"1686","winjs" +"1684","rtmp" +"1683","directory-structure" +"1682","cloudinary" +"1682","pear" +"1681","onesignal" +"1678","mingw-w64" +"1677","robolectric" +"1677","android-camera2" +"1676","text-classification" +"1676","bigcommerce" +"1675","sharding" +"1673","simple-html-dom" +"1672","graphics2d" +"1671","final" +"1671","jquery-isotope" +"1671","swagger-2.0" +"1670","disassembly" +"1670","hlsl" +"1670","iron-router" +"1669","django-class-based-views" +"1668","jsch" +"1667","hibernate-criteria" +"1667","large-language-model" +"1666","contact-form" +"1666","cryptojs" +"1665","cheerio" +"1665","ini" +"1664","template-specialization" +"1664","axis-labels" +"1664","swiftmailer" +"1664","parcelable" +"1663","xsd-validation" +"1663","c#-2.0" +"1663","tablet" +"1662","temp-tables" +"1662","paintcomponent" +"1661","vue-composition-api" +"1661","feature-extraction" +"1661","ranking" +"1661","netflix-eureka" +"1659","synchronous" +"1658","rank" +"1657","ts-jest" +"1657","datastax-enterprise" +"1655","baseadapter" +"1655","pic" +"1654","conflict" +"1653","google-cloud-dataproc" +"1652","backtracking" +"1652","private-key" +"1652","database-trigger" +"1652","spring-amqp" +"1652","uidatepicker" +"1652","autoload" +"1651","template-engine" +"1651","nsview" +"1650","django-channels" +"1649","vcl" +"1649","py2exe" +"1649","bootstrap-vue" +"1649","nsurl" +"1648","right-to-left" +"1647","public" +"1646","date-range" +"1646","xor" +"1646","wcf-binding" +"1646","xcode4.5" +"1646","ethernet" +"1645","back-button" +"1645","android-progressbar" +"1645","amazon-aurora" +"1644","telerik-grid" +"1644","mysql-error-1064" +"1644","android-studio-3.0" +"1644","excel-interop" +"1643","delphi-2010" +"1643","nested-attributes" +"1642","marker" +"1642","readonly" +"1640","scala-collections" +"1639","workflow-foundation-4" +"1639","shiny-server" +"1639","plsqldeveloper" +"1639","multicast" +"1636","functor" +"1636",".net-standard" +"1636","signalr-hub" +"1635","samsung-mobile" +"1635","haxe" +"1634","vue-cli" +"1634","orders" +"1634","tastypie" +"1633","http-get" +"1631","cx-oracle" +"1630","dynamic-linking" +"1629","children" +"1629","angular-ngmodel" +"1629","fread" +"1628","algolia" +"1627","setup-project" +"1627","code-formatting" +"1627","rack" +"1626","flux" +"1625","delayed-job" +"1625","cpu-word" +"1625","sampling" +"1624","android-sensors" +"1621","geoserver" +"1620","gradle-plugin" +"1620","supervisord" +"1620","android-gridview" +"1619","watir-webdriver" +"1618","flutter-getx" +"1617","shared-hosting" +"1616","adal" +"1616","aws-step-functions" +"1616","spring-restcontroller" +"1616","google-analytics-4" +"1615","datediff" +"1614","fixtures" +"1614","acrobat" +"1613","claims-based-identity" +"1613","boot" +"1612","java-9" +"1612","scalatest" +"1611","history" +"1610","glassfish-3" +"1609","binary-data" +"1609","dump" +"1609","predict" +"1608","calculation" +"1608","kill" +"1608","wordpress-rest-api" +"1608","higher-order-functions" +"1607","unityscript" +"1606","truncate" +"1606","flask-restful" +"1606","ivy" +"1605","flatten" +"1605","t4" +"1605","uislider" +"1603","codable" +"1602","tabbar" +"1602","linear-gradients" +"1602","solrj" +"1601","octobercms" +"1601","google-api-client" +"1601","screen-orientation" +"1601","nonblocking" +"1600","webrequest" +"1600","unordered-map" +"1599","memcpy" +"1599","yup" +"1598","jolt" +"1598","tic-tac-toe" +"1597","python-telegram-bot" +"1596","vuforia" +"1595","tensorflow.js" +"1595","intentfilter" +"1595","picker" +"1595","activemq-artemis" +"1595","linux-mint" +"1594","devtools" +"1593","uniqueidentifier" +"1593","service-accounts" +"1592","winui-3" +"1591","definition" +"1591","producer-consumer" +"1591","google-api-python-client" +"1590","nsmanagedobject" +"1590","viewstate" +"1590","laravel-passport" +"1589","hpc" +"1589","shadow-dom" +"1587","literals" +"1586","google-docs-api" +"1585","qtp" +"1584","treemap" +"1583","enterprise-library" +"1582","nsnotificationcenter" +"1581","class-diagram" +"1581","cassandra-3.0" +"1581","meteor-blaze" +"1581","naudio" +"1581","pyomo" +"1579","live" +"1579","database-backups" +"1578","access-violation" +"1577","bamboo" +"1577","rollback" +"1577","windows-vista" +"1577","centos6" +"1576","fortran90" +"1576","taxonomy" +"1575","partition" +"1574","permission-denied" +"1573","firefox-addon-webextensions" +"1571","homestead" +"1569","configure" +"1568","aws-codepipeline" +"1568","genymotion" +"1567","browser-history" +"1567","openxml-sdk" +"1567","google-glass" +"1567","spotfire" +"1567","glib" +"1566","iad" +"1565","packet" +"1565","r-leaflet" +"1565","autofill" +"1565","cycle" +"1564","nutch" +"1563","mongodb-atlas" +"1563","google-admin-sdk" +"1561","figure" +"1561","extjs4.2" +"1559","symbolic-math" +"1559","differential-equations" +"1558","mailgun" +"1558","timepicker" +"1557","multiplayer" +"1557","windows-server-2012-r2" +"1557","minitest" +"1557","schema.org" +"1557","autoencoder" +"1555","netbeans-7" +"1555","uistoryboardsegue" +"1554","playback" +"1553","twitter4j" +"1549","quickblox" +"1548","appkit" +"1548","shopware" +"1548","webfonts" +"1547","crash-reports" +"1546","sentry" +"1546","virtual-functions" +"1546","return-type" +"1545","logstash-grok" +"1544","inotifypropertychanged" +"1544","android-coordinatorlayout" +"1543","extend" +"1542","mapstruct" +"1541","wcf-ria-services" +"1541","foursquare" +"1540","autotools" +"1539","horizontal-scrolling" +"1539","fragment-shader" +"1539","android-image" +"1539","custom-fields" +"1538","python-venv" +"1538","api-platform.com" +"1538","poco" +"1538","qthread" +"1537","pusher" +"1536","friend" +"1536","laravel-query-builder" +"1535","impersonation" +"1534","eager-loading" +"1534","stock" +"1533","self" +"1533","criteria-api" +"1532","braintree" +"1532","streamwriter" +"1532","excel-2016" +"1532","flutter-provider" +"1531","jira-rest-api" +"1531","restart" +"1531","preferences" +"1530","live-streaming" +"1530","buffer-overflow" +"1529","progress" +"1529","arrow-functions" +"1528","keras-layer" +"1528","pouchdb" +"1528","macos-sierra" +"1527","privileges" +"1527","spring-data-elasticsearch" +"1527","libxml2" +"1526","pool" +"1526","angular-httpclient" +"1525","file-rename" +"1525","angularjs-service" +"1524","cat" +"1524","sql-server-2017" +"1524","memoization" +"1523","mpdf" +"1523","has-many-through" +"1522","crosstab" +"1522","branching-and-merging" +"1521","borrow-checker" +"1521","pypdf" +"1520","hyper-v" +"1520","visio" +"1520","google-cloud-build" +"1520","median" +"1519","python-packaging" +"1519","alarm" +"1519","fastlane" +"1519","http-proxy" +"1519","cvs" +"1519","tradingview-api" +"1517","ms-access-2016" +"1516","txt" +"1516","apt" +"1515","instance-variables" +"1515","processbuilder" +"1514","jquery-autocomplete" +"1513","apex-code" +"1513","i18next" +"1513","postfix-mta" +"1511","silverlight-3.0" +"1511","mosquitto" +"1510","dbt" +"1510","rxjs5" +"1510","openfire" +"1509","quaternions" +"1508","django-migrations" +"1508","quartz.net" +"1508","linked-server" +"1507","grails-plugin" +"1507","read-eval-print-loop" +"1507","sonarqube-scan" +"1506","wtforms" +"1504","one-to-one" +"1502","hololens" +"1501","python-turtle" +"1501","functional-testing" +"1501",".net-7.0" +"1501","extern" +"1501","macos-catalina" +"1501","ieee-754" +"1500","named-entity-recognition" +"1500","delphi-xe" +"1500","stdmap" +"1499","install4j" +"1499","subtraction" +"1498","image-manipulation" +"1498","android-sdcard" +"1498","suitescript" +"1498","web-development-server" +"1497","deep-copy" +"1496","back" +"1495","unmanaged" +"1495","uicollectionviewlayout" +"1495","nightwatch.js" +"1495","dagger" +"1495","bearer-token" +"1494","gsm" +"1494","outputstream" +"1494","project-management" +"1492","feature-selection" +"1492","smoothing" +"1492","akka-http" +"1492","high-availability" +"1491","datacontext" +"1491","mex" +"1491","direct3d" +"1488","pagespeed" +"1488","codec" +"1487","rollup" +"1487","bottle" +"1486","filebeat" +"1486","newrelic" +"1486","radix" +"1484","fluid" +"1483","relation" +"1483","django-cms" +"1483","superclass" +"1482","flags" +"1482","salt-project" +"1482","cumulative-sum" +"1481","graphql-js" +"1481","umbraco7" +"1481","spring-boot-test" +"1480","fadeout" +"1480","typescript2.0" +"1480","qwidget" +"1479","spring-websocket" +"1479","hibernate-search" +"1479","odoo-9" +"1478","fluentvalidation" +"1478","android-4.4-kitkat" +"1477","bitbake" +"1477","factory-pattern" +"1477","assertion" +"1476","smack" +"1476","jsp-tags" +"1476","gradient-descent" +"1476","codeception" +"1475","php-carbon" +"1475","overwrite" +"1475","sql-execution-plan" +"1475","quasar-framework" +"1475","partial" +"1474","python-docx" +"1474","aws-codebuild" +"1474","mobile-website" +"1473","docker-volume" +"1473","fabric" +"1473","monitor" +"1473","iqueryable" +"1472","portforwarding" +"1472","xamarin-studio" +"1471","electron-builder" +"1470","dagger-hilt" +"1469","remote-desktop" +"1468","anova" +"1468","geckodriver" +"1468","stomp" +"1468","embedding" +"1465","apache-zeppelin" +"1465","wai-aria" +"1464","duration" +"1464","jailbreak" +"1463","polling" +"1463","google-maps-api-2" +"1462","file-descriptor" +"1462","language-design" +"1462","text-extraction" +"1461","python-idle" +"1461","osx-mountain-lion" +"1461","directed-acyclic-graphs" +"1460","imacros" +"1459","capture" +"1457","ioexception" +"1457","android-dialog" +"1456","varchar" +"1456","nsfilemanager" +"1455","voice-recognition" +"1455","openedge" +"1455","hmac" +"1454","vega-lite" +"1454","uistackview" +"1454","web-frontend" +"1453","verification" +"1453","portability" +"1453","globalization" +"1452","database-normalization" +"1452","epoch" +"1452","io-redirection" +"1452","sqldatatypes" +"1452","gaps-and-islands" +"1451","jbpm" +"1451","uac" +"1451","autocompletetextview" +"1450","react-component" +"1450","coldfusion-9" +"1450","has-many" +"1449","xmlserializer" +"1449","chess" +"1449","monorepo" +"1449","sd-card" +"1448","recommendation-engine" +"1448","at-command" +"1448","modelica" +"1448","autocad" +"1447","riverpod" +"1447","landscape" +"1447","animated-gif" +"1447","restful-authentication" +"1445","extbase" +"1445","substr" +"1444","x++" +"1444","spell-checking" +"1444","completable-future" +"1444","status" +"1443","robots.txt" +"1442","dbus" +"1442","keydown" +"1442","cache-control" +"1442","egit" +"1441","google-sheets-query" +"1440","rtp" +"1440","dtd" +"1439","vertica" +"1437","boost-spirit" +"1437","webpack-2" +"1436","prestashop-1.7" +"1436","idisposable" +"1435","rethinkdb" +"1434","nginx-location" +"1434","7zip" +"1432","bitbucket-pipelines" +"1432","ontouchlistener" +"1432","gnome" +"1431","spi" +"1430","stderr" +"1428","react-leaflet" +"1427","jdeveloper" +"1427","wiki" +"1427","xilinx" +"1427","cortex-m" +"1427","lua-table" +"1426","angle" +"1426","xcodebuild" +"1426","complex-numbers" +"1424","labview" +"1424","android-tv" +"1422","vaadin7" +"1421","skspritenode" +"1421","workflow-foundation" +"1420","imagemagick-convert" +"1420","pcap" +"1420","bson" +"1420","ref" +"1419","timing" +"1417","filesize" +"1417","strtok" +"1416","shared" +"1415","porting" +"1415","uicolor" +"1414","git-clone" +"1414","portable-class-library" +"1414","silverlight-5.0" +"1414","java.util.concurrent" +"1414","mixed-models" +"1414","tizen" +"1413","dynamics-crm-2013" +"1412","visualforce" +"1412","webpack-4" +"1412","submenu" +"1411","hikaricp" +"1410","ssrs-tablix" +"1410","appdomain" +"1410","pyaudio" +"1409","kettle" +"1409","huawei-mobile-services" +"1406","echarts" +"1406","jnlp" +"1406","point-cloud-library" +"1405","camera-calibration" +"1404","zabbix" +"1403","32-bit" +"1402","raspberry-pi4" +"1402","screen-resolution" +"1401","google-cast" +"1401","spring-tool-suite" +"1400","cancan" +"1399","swashbuckle" +"1399","systemjs" +"1399","aspnetboilerplate" +"1399","embedded-jetty" +"1398","delta-lake" +"1398","audio-player" +"1396","point-clouds" +"1395","openssh" +"1391","selenium-rc" +"1391","unpivot" +"1391","appium-android" +"1391","java-6" +"1391","access-control" +"1390","void-pointers" +"1390","cpython" +"1390","auto-update" +"1389","uppercase" +"1389","react-table" +"1389","osx-snow-leopard" +"1388","nfs" +"1388","mainframe" +"1387","dbi" +"1387","laravel-5.7" +"1387","cascade" +"1387","text-parsing" +"1384","react-native-firebase" +"1384","rectangles" +"1383","unique-constraint" +"1383","blackberry-10" +"1383","tkinter-entry" +"1383","context-free-grammar" +"1382","cruisecontrol.net" +"1382","riscv" +"1382","timedelta" +"1380","xtext" +"1380","tabular" +"1380","webdav" +"1379","nsmanagedobjectcontext" +"1379","meta" +"1378","pymysql" +"1378","maven-surefire-plugin" +"1376","tablelayout" +"1376","policy" +"1375","factorial" +"1375","nodemon" +"1375","image-gallery" +"1374","bookmarklet" +"1374","has-and-belongs-to-many" +"1374","trading" +"1373","csproj" +"1373","spring-rabbit" +"1373","paypal-rest-sdk" +"1373","google-maps-sdk-ios" +"1372","ssis-2012" +"1371","cherrypy" +"1371","biopython" +"1371","fingerprint" +"1371","android-8.0-oreo" +"1371","azure-language-understanding" +"1371","cucumber-jvm" +"1371","q" +"1371","altair" +"1370","floating-accuracy" +"1370","elasticsearch-5" +"1370","textinput" +"1369","django-filter" +"1369","netezza" +"1369","openmpi" +"1369","between" +"1367","destructuring" +"1367","asp.net-4.0" +"1367","tail-recursion" +"1367","handle" +"1367","laravel-mix" +"1367","area" +"1367","glm-math" +"1366","tibble" +"1365","xlrd" +"1365","jquery-ui-tabs" +"1364","html-entities" +"1364","hapi.js" +"1364","ipa" +"1363","flex4.5" +"1363","identifier" +"1362","seekbar" +"1361","material-components-android" +"1361","python-poetry" +"1361","apache-superset" +"1360","silex" +"1360","seam" +"1359","freepascal" +"1359","hangfire" +"1359","perl-module" +"1359","beagleboneblack" +"1358","intrinsics" +"1358","evaluation" +"1358","linq-to-objects" +"1357","apache-karaf" +"1357","m" +"1357","nonetype" +"1356","assignment-operator" +"1356","android-location" +"1356","zoo" +"1354","job-scheduling" +"1354","mnist" +"1353","markup" +"1353","absolute" +"1353","prefix" +"1352","nswindow" +"1351","enterprise-architect" +"1351","android-workmanager" +"1351","tabulator" +"1351","solana" +"1350","excel-addins" +"1350","strip" +"1349","intellij-plugin" +"1349","master-detail" +"1349","durandal" +"1349","restful-url" +"1348","yahoo-finance" +"1348","image-recognition" +"1348","swift-playground" +"1347","client-certificates" +"1347","robotics" +"1347","projects-and-solutions" +"1346","pipenv" +"1346","gradle-kotlin-dsl" +"1345","group-concat" +"1344","facebook-apps" +"1343","worksheet-function" +"1342","api-gateway" +"1342","execute" +"1342","google-fusion-tables" +"1341","atl" +"1341","dst" +"1340","firebase-dynamic-links" +"1340","appstore-approval" +"1340","azure-virtual-network" +"1340","numerical-integration" +"1340","collectionview" +"1340","folium" +"1339","delete-operator" +"1339","android-architecture-navigation" +"1339","curve" +"1338","dbpedia" +"1338","boost-python" +"1338","h5py" +"1338","lazarus" +"1338","hugo" +"1336","yesod" +"1336","agent" +"1336","cube" +"1335","fluentd" +"1335","ibm-cloud-infrastructure" +"1335","shopify-app" +"1335","commonjs" +"1334","sha" +"1334","userscripts" +"1333","xul" +"1333","avx" +"1333","r-package" +"1333","ormlite" +"1330","matlab-guide" +"1328","php-curl" +"1328","pythonanywhere" +"1328","odp.net" +"1327","sklearn-pandas" +"1327","cassandra-2.0" +"1326","progress-4gl" +"1326","telethon" +"1326","sas-macro" +"1326","ls" +"1325","checkstyle" +"1325","properties-file" +"1324","tsconfig" +"1324","keytool" +"1324","rfid" +"1324","wordpress-gutenberg" +"1324","iterable" +"1324","cgal" +"1323","chmod" +"1323","gsp" +"1322","dynamodb-queries" +"1322","sumifs" +"1321","local-variables" +"1321","data-wrangling" +"1321","xargs" +"1320","ireport" +"1320","webmethod" +"1320","powermockito" +"1318","apache-fop" +"1318","python-2.6" +"1318","microphone" +"1317","identityserver3" +"1316","skype" +"1316","asihttprequest" +"1316","arduino-ide" +"1315","smtplib" +"1315","m2eclipse" +"1315","bezier" +"1314","spring-annotations" +"1314","tinymce-4" +"1312","pdf.js" +"1312","codeigniter-4" +"1312","restructuredtext" +"1312","powerbuilder" +"1312","tf-idf" +"1311","amd" +"1311","scons" +"1310","filemaker" +"1310","polymorphic-associations" +"1309","insert-update" +"1309","spring-rest" +"1308","coredump" +"1308","strtotime" +"1308","auto" +"1307","xcode11" +"1307","react-functional-component" +"1306","reportlab" +"1306","dispatcher" +"1306","data-migration" +"1306","watchos" +"1306","jquery-chosen" +"1306","postgresql-9.4" +"1306","storekit" +"1305","django-haystack" +"1305","spring-cloud-dataflow" +"1305","nsmutabledictionary" +"1305","mule4" +"1304","distributed-system" +"1304","jquery-file-upload" +"1304","shopware6" +"1303","llvm-ir" +"1303","survival-analysis" +"1303","office365api" +"1303","summary" +"1302","swiftui-list" +"1302","google-search-console" +"1301","api-key" +"1301","fiware" +"1301","dql" +"1300","slidetoggle" +"1300","apache-tika" +"1300","disk" +"1300","sap-ase" +"1300","account" +"1299","spring-webflow" +"1299","httpserver" +"1299","ole" +"1298","microsoft-graph-sdks" +"1298","open-telemetry" +"1298","angular-dart" +"1296","multi-touch" +"1296","spring-cloud-gateway" +"1296","launch" +"1295","modalviewcontroller" +"1295","tiles" +"1294","google-cloud-composer" +"1293","hid" +"1292","azure-cosmosdb-sqlapi" +"1292","algorithmic-trading" +"1291","slickgrid" +"1291","leiningen" +"1291","google-api-dotnet-client" +"1291","colorbar" +"1290","case-sensitive" +"1290","grails-2.0" +"1289","data-access-layer" +"1288","or-tools" +"1287","app-engine-ndb" +"1287","nameerror" +"1287","worker" +"1287","strongloop" +"1287","emscripten" +"1286","php-5.3" +"1286","wcf-security" +"1286","facebook-messenger" +"1286","montecarlo" +"1285","session-timeout" +"1285","angularjs-routing" +"1285","ktor" +"1285","jackson-databind" +"1285","activiti" +"1284","swift-package-manager" +"1284","informatica-powercenter" +"1284","memory-alignment" +"1284","generic-programming" +"1283","haskell-stack" +"1282","salesforce-lightning" +"1282","normal-distribution" +"1281","undefined-reference" +"1281","uitoolbar" +"1281","ngrx-store" +"1281","windows-server" +"1281","cytoscape.js" +"1280","smtpclient" +"1280","self-join" +"1280","type-traits" +"1278","typeahead.js" +"1278","event-log" +"1276","wif" +"1276","designer" +"1276","visual-studio-cordova" +"1275","qtableview" +"1274","unicorn" +"1273","repaint" +"1273","aws-iot" +"1273","upsert" +"1273","shiro" +"1273","nopcommerce" +"1273","es6-class" +"1272","slug" +"1272","rubymine" +"1272","mkannotation" +"1271","memorystream" +"1270","java-17" +"1270","cairo" +"1269","django-staticfiles" +"1269","unsigned" +"1269","uisearchcontroller" +"1269","toad" +"1268","spring-roo" +"1268","android-sdk-tools" +"1267","createjs" +"1267","bottom-sheet" +"1267","rails-activestorage" +"1267","loopback" +"1266","react-state" +"1266","android-menu" +"1266","angular2-nativescript" +"1264","backpropagation" +"1264","uiactivityviewcontroller" +"1264","authorize.net" +"1263","nsxmlparser" +"1263","subview" +"1263","powershell-remoting" +"1263","subroutine" +"1262","spring-ws" +"1261","loadrunner" +"1261","survey" +"1261","mouselistener" +"1261","restlet" +"1260","expressionengine" +"1260","comparable" +"1259","smartgwt" +"1259","keyevent" +"1259","gradlew" +"1259","express-session" +"1259","pysimplegui" +"1259","gxt" +"1258","tensorflow-serving" +"1258","shutdown" +"1258","bundling-and-minification" +"1258","lattice" +"1257","vsix" +"1257","quill" +"1257","logstash-configuration" +"1255","avcapturesession" +"1255","aws-serverless" +"1255","reddit" +"1255","string-literals" +"1254","attr" +"1253","chef-recipe" +"1253","visual-foxpro" +"1253","solrcloud" +"1252","afnetworking-2" +"1252","r-raster" +"1252","objective-c++" +"1252","hashicorp-vault" +"1252","modbus" +"1252","argv" +"1251","vim-plugin" +"1250","xmldocument" +"1249","event-sourcing" +"1248","airflow-scheduler" +"1248","httphandler" +"1248","email-validation" +"1247","matplotlib-basemap" +"1247","android-4.0-ice-cream-sandwich" +"1246","core-image" +"1246","codemirror" +"1245","w3c" +"1245","unobtrusive-validation" +"1245","git-pull" +"1244","ear" +"1244",".net-4.8" +"1242","dynamics-365" +"1242","angularjs-controller" +"1242","latency" +"1242","struts-1" +"1242","multicore" +"1241","sign" +"1241","dimensions" +"1241","pgadmin-4" +"1240","jquery-masonry" +"1239","django-testing" +"1239","android-broadcast" +"1239","expression-blend" +"1239","togglebutton" +"1238","chromium-embedded" +"1238","angular-ng-if" +"1238","libsvm" +"1238","lotusscript" +"1237","puma" +"1237","sapply" +"1237","koa" +"1237","dpi" +"1237","mesos" +"1236","publishing" +"1236","android-collapsingtoolbarlayout" +"1236","arima" +"1235","clean-architecture" +"1235","appcelerator-titanium" +"1235","worksheet" +"1234","phone-number" +"1234","hibernate-validator" +"1234","angularjs-filter" +"1233","filesystemwatcher" +"1233","row-number" +"1233","android-tabs" +"1233","raspberry-pi2" +"1233","rider" +"1233","ntlm" +"1232","inertiajs" +"1232","c++-concepts" +"1232","iis-10" +"1231","initializer-list" +"1231","double-quotes" +"1230","instrumentation" +"1229","sendkeys" +"1229","swi-prolog" +"1229","url-parameters" +"1228","cloudant" +"1228","one-hot-encoding" +"1228","layout-inflater" +"1227","rxjs6" +"1227","type-hinting" +"1227","network-protocols" +"1227","headless" +"1226","addclass" +"1226","hortonworks-data-platform" +"1226","rdp" +"1225","sharing" +"1225","raycasting" +"1224","gridbaglayout" +"1224","friendly-url" +"1224","rollupjs" +"1224","camunda" +"1224","orbeon" +"1224","rhino-mocks" +"1224","gateway" +"1224","peewee" +"1224","idioms" +"1223","optional-parameters" +"1223","waterline" +"1223","can-bus" +"1222","node-webkit" +"1221","uitapgesturerecognizer" +"1221","docker-container" +"1221","java-ee-7" +"1221","qtablewidget" +"1220","nagios" +"1220","android-tablelayout" +"1220","webmatrix" +"1220","solid-principles" +"1219","jtree" +"1219","dynamics-ax-2012" +"1218","pyarrow" +"1218","setcookie" +"1218","android-navigation" +"1218","utf-16" +"1218","webdeploy" +"1217","fullpage.js" +"1217","outliers" +"1217","lines" +"1216","confluence" +"1216","windows-server-2003" +"1216","osmdroid" +"1216","aspect-ratio" +"1215","mapbox-gl" +"1215","asp.net-core-identity" +"1215","spline" +"1215","achartengine" +"1213","rpy2" +"1213","variant" +"1213","postgresql-9.5" +"1213","virtual-memory" +"1213","protege" +"1213","quarto" +"1212","netflix-zuul" +"1212","mkdir" +"1212","healthkit" +"1212","quartz-graphics" +"1211","phone-call" +"1211","rust-tokio" +"1210","adobe-indesign" +"1210","dynamics-crm-online" +"1210","protected" +"1210","state-management" +"1210","sudoku" +"1209","azure-ad-b2c-custom-policy" +"1209","ramda.js" +"1209","ace-editor" +"1209","stdstring" +"1208","paho" +"1208","password-encryption" +"1208","cpan" +"1207","mutable" +"1207","metaclass" +"1206","immutable.js" +"1205","key-value-observing" +"1205","dereference" +"1205","derived-class" +"1205","custom-taxonomy" +"1204","itemscontrol" +"1201","xna-4.0" +"1201","watermark" +"1200","websphere-8" +"1200","osx-elcapitan" +"1200","a-star" +"1200","android-mediacodec" +"1198","gherkin" +"1198","credit-card" +"1198","terraform-provider-gcp" +"1198","scrolltop" +"1197","r-plotly" +"1197","explorer" +"1197","static-members" +"1195","openapi-generator" +"1195","hierarchical-clustering" +"1195","tomcat9" +"1195","transfer" +"1195","subsonic" +"1194","crossfilter" +"1194","information-retrieval" +"1193","built-in" +"1192","workspace" +"1192","lda" +"1192","quantmod" +"1191","ksoap2" +"1191","stringstream" +"1190","flickr" +"1190","csh" +"1190","ionic-native" +"1190","controltemplate" +"1190","pass-by-value" +"1189","fancybox-2" +"1189","ttk" +"1189","shutil" +"1189","shinyapps" +"1188","timeline" +"1188","transformer-model" +"1188","mschart" +"1187","retina-display" +"1187","objectmapper" +"1186","steam" +"1185","jscript" +"1185","keyerror" +"1185","ag-grid-angular" +"1185","cognos" +"1185","scrollviewer" +"1184","user-permissions" +"1183","reshape2" +"1182","fluent" +"1182","system.text.json" +"1182","rbenv" +"1181","erd" +"1180","google-chrome-headless" +"1180","android-alarms" +"1179","populate" +"1179","custom-attributes" +"1179","having" +"1178","plc" +"1178","restful-architecture" +"1178","zk" +"1177","masking" +"1177","jfilechooser" +"1176","anypoint-studio" +"1176","kaggle" +"1176","timespan" +"1176","android-gallery" +"1176","geo" +"1175","hotkeys" +"1175","syslog" +"1174","public-key" +"1173","func" +"1173","facebook-sdk-4.0" +"1173","spring-cloud-config" +"1172","page-refresh" +"1171","lan" +"1171","nearest-neighbor" +"1171","mahout" +"1171","google-closure-compiler" +"1171","sqlcmd" +"1171","android-listfragment" +"1169","shapely" +"1169","azure-log-analytics" +"1169","confidence-interval" +"1168","react-dom" +"1168","automator" +"1168","zapier" +"1167","privacy" +"1167","hostname" +"1167","fold" +"1166","wizard" +"1166","xcode-ui-testing" +"1166","httpcontext" +"1164","osdev" +"1163","consul" +"1163","emr" +"1163","powerbi-embedded" +"1162","dbeaver" +"1162","dart-pub" +"1161","joomla1.5" +"1161","navigator" +"1161","bcp" +"1160","tridion" +"1160","confluent-schema-registry" +"1160","breadcrumbs" +"1160","asp.net-core-6.0" +"1160","cultureinfo" +"1159","case-insensitive" +"1159","propel" +"1159","cucumber-java" +"1158","opencart2.x" +"1157","ansible-inventory" +"1157","rbac" +"1156","onsen-ui" +"1156","nvm" +"1155","datadog" +"1155","sanitization" +"1154","audit" +"1154","c3p0" +"1154","dart-null-safety" +"1153","google-api-java-client" +"1153","conventions" +"1153","qgraphicsview" +"1152","weak-references" +"1152","rspec2" +"1152","same-origin-policy" +"1152","opensearch" +"1151","gevent" +"1151","objectify" +"1151","google-query-language" +"1150","swift-protocols" +"1150","callstack" +"1150","oracleforms" +"1150","crc" +"1149","file-extension" +"1149","dataflow" +"1149","infowindow" +"1149","browser-automation" +"1149","dicom" +"1149","nib" +"1149","googlemock" +"1148","vector-graphics" +"1147","debezium" +"1147","jdo" +"1147","remoting" +"1147","owasp" +"1147","jquery-deferred" +"1147",".net-framework-version" +"1146","extjs5" +"1146","framebuffer" +"1144","fileinputstream" +"1144","jta" +"1144","sharepoint-designer" +"1144","system.reflection" +"1144","url-scheme" +"1143","stackexchange.redis" +"1143","freertos" +"1143","pybind11" +"1143","uinavigationitem" +"1142","system.drawing" +"1141","symfony5" +"1141","autoconf" +"1140","distutils" +"1140","aws-application-load-balancer" +"1140","measure" +"1139","python-3.3" +"1139","filewriter" +"1139","sqldatareader" +"1139","ios14" +"1139","mediastore" +"1138","cjk" +"1138","nat" +"1137","fifo" +"1137","azure-web-roles" +"1137","android-maps-v2" +"1136","flume" +"1136","http-status-code-401" +"1136","isabelle" +"1135","with-statement" +"1134","datamapper" +"1134","tortoisehg" +"1133","dask-distributed" +"1133","postgresql-9.2" +"1133","lighttpd" +"1132","flush" +"1132","python-3.9" +"1132","abstraction" +"1132","alter-table" +"1131","radgrid" +"1130","voice" +"1130","micropython" +"1130","object-detection-api" +"1130","elk" +"1129","python-c-api" +"1129","gurobi" +"1129","spawn" +"1128","alfresco-share" +"1128","google-app-maker" +"1128","textmate" +"1127","webservice-client" +"1127","fileoutputstream" +"1127","libc" +"1127","rate-limiting" +"1127","2d-games" +"1127","railstutorial.org" +"1126","ebay-api" +"1126","ckeditor5" +"1126","source-maps" +"1125","flexslider" +"1124","xlwings" +"1124","bootstrap-datepicker" +"1124","appsettings" +"1124","c3.js" +"1124","gdscript" +"1124","event-loop" +"1124","spacing" +"1123","class-design" +"1123","recordset" +"1123","bpmn" +"1123","asp.net-3.5" +"1122","add-on" +"1122","react-three-fiber" +"1122","dynamically-generated" +"1122","buildozer" +"1122","scipy-optimize" +"1122","string-interpolation" +"1121","bookmarks" +"1121","parse-cloud-code" +"1120","intentservice" +"1120","cloud9-ide" +"1120","mailto" +"1120","kvm" +"1120","rich-text-editor" +"1120","reactiveui" +"1120","illegalstateexception" +"1120","threadpoolexecutor" +"1119","mxml" +"1119","regexp-replace" +"1118","git-diff" +"1118","cdata" +"1118","hp-uft" +"1118","word-embedding" +"1118","sql-server-2019" +"1118","behat" +"1117","diacritics" +"1116","checkboxlist" +"1116","xmlreader" +"1115","getusermedia" +"1115","window.open" +"1115","nsfetchrequest" +"1115","android-cursor" +"1115","elasticsearch-aggregation" +"1115","stub" +"1114","refresh-token" +"1114","dotnetopenauth" +"1114","custom-data-attribute" +"1113","flask-socketio" +"1113","simple-injector" +"1113","handsontable" +"1113","tortoisegit" +"1112","trie" +"1112","playframework-2.2" +"1112","rvalue-reference" +"1112","digits" +"1112","lift" +"1111","backbone-views" +"1111","cakephp-2.3" +"1111","jmeter-5.0" +"1111","bmp" +"1111","qunit" +"1111","perf" +"1111","throttling" +"1110","rolling-computation" +"1109","integer-overflow" +"1109","ebean" +"1108","maze" +"1107","gridfs" +"1107","git-checkout" +"1107","database-partitioning" +"1107","bounding-box" +"1107","migrate" +"1106","date-arithmetic" +"1106","pubnub" +"1106","nancy" +"1106","sys" +"1106","comet" +"1106","tor" +"1104","confusion-matrix" +"1104","uploadify" +"1104","aws-code-deploy" +"1104","device-driver" +"1103","clob" +"1103","dlib" +"1103","infinispan" +"1103","knapsack-problem" +"1103","stdio" +"1102","sitecore6" +"1102","expand" +"1101","maven-assembly-plugin" +"1101","irc" +"1101","long-polling" +"1101","mediarecorder" +"1100","sqlconnection" +"1100","ejb-3.1" +"1100","alsa" +"1099","automake" +"1099","alpine.js" +"1098","listviewitem" +"1098","macports" +"1096","git-flow" +"1096","jasperserver" +"1096","javax.imageio" +"1096","mousewheel" +"1096","testcontainers" +"1096","msdeploy" +"1095","llvm-clang" +"1095","calling-convention" +"1095","infinite" +"1095","dot" +"1094","posixct" +"1094","pdfkit" +"1094","custom-component" +"1093","symfony-2.1" +"1093","nsurlrequest" +"1092","jogl" +"1092","bluej" +"1092","openjpa" +"1091","ag-grid-react" +"1091","msdn" +"1090","flask-login" +"1090","html.dropdownlistfor" +"1090","qlikview" +"1089","angularjs-ng-click" +"1089","box-api" +"1089","exit-code" +"1088","discrete-mathematics" +"1088","wikipedia-api" +"1087","mobile-development" +"1087","vaadin-flow" +"1086","ghci" +"1086","lexer" +"1086","provisioning" +"1086","zend-db" +"1085","typing" +"1085","android-logcat" +"1084","edge-detection" +"1083","react-native-maps" +"1083","cil" +"1083","doctype" +"1083","tm" +"1082","deferred" +"1082","textblock" +"1082","geom-bar" +"1082","autodesk" +"1081","docker-network" +"1080","listadapter" +"1080","huffman-code" +"1079","decompiling" +"1079","rtk-query" +"1079","java-2d" +"1079","forward-declaration" +"1079","resourcedictionary" +"1077","raytracing" +"1077","npm-scripts" +"1077","ipv4" +"1077","shell-exec" +"1076","salt-cryptography" +"1076","portable-executable" +"1076","openfiledialog" +"1076","ionic5" +"1076","libvlc" +"1076","google-contacts-api" +"1075","truffle" +"1075","enterprise" +"1074","docker-image" +"1074","currying" +"1073","apexcharts" +"1073","swiftui-navigationlink" +"1073","ibatis" +"1073","postscript" +"1073","u-boot" +"1073","msys2" +"1072","insertion-sort" +"1072","joomla-extensions" +"1072","surface" +"1072","wsh" +"1072","visual-studio-lightswitch" +"1072","timezone-offset" +"1071","rounded-corners" +"1071","servicenow" +"1070","ngrok" +"1070","ng-grid" +"1070","sitecore8" +"1070","revit-api" +"1070","moving-average" +"1069","pjsip" +"1069","goto" +"1069","crystal-reports-2008" +"1069","postcss" +"1069","non-ascii-characters" +"1068","backwards-compatibility" +"1068","unit-of-work" +"1068","spring-data-redis" +"1068","java-threads" +"1068","behavior" +"1067","servicebus" +"1067","resque" +"1067","performancecounter" +"1066","xlib" +"1066","winscp" +"1066","minimum" +"1066","azure-servicebus-queues" +"1065","python-unicode" +"1065","scaffolding" +"1065","microsoft-graph-teams" +"1065","iso" +"1065","asp.net-identity-2" +"1064","saas" +"1064","azure-cloud-services" +"1064","boolean-expression" +"1064","polyline" +"1064","uipangesturerecognizer" +"1064","gnu-assembler" +"1064","pretty-print" +"1063","cpu-cache" +"1063","android-framelayout" +"1063","shift" +"1062","oracle19c" +"1062","openai-gym" +"1062","business-objects" +"1062","azure-pipelines-build-task" +"1062","zero" +"1061","runtimeexception" +"1061","apt-get" +"1061","allure" +"1060","temporary-files" +"1060","tslint" +"1060","locationmanager" +"1060","updating" +"1060","roc" +"1060","access-denied" +"1059","signing" +"1059","httpwebresponse" +"1059","string-length" +"1058","coldfusion-10" +"1058","glew" +"1057","internal-server-error" +"1057","armadillo" +"1057","transactionscope" +"1057","avaudiosession" +"1056","inappbrowser" +"1056","facebook-page" +"1056","android-viewholder" +"1055","ssh-tunnel" +"1055","effects" +"1055","att" +"1055","mac-address" +"1055","access-modifiers" +"1054","asp.net-web-api-routing" +"1054","custom-action" +"1054","heroku-postgres" +"1053","sweetalert" +"1053","mdm" +"1053","suitescript2.0" +"1052","many-to-one" +"1052","firebase-tools" +"1052","radio-group" +"1052","gac" +"1051","yahoo" +"1051","xcode4.3" +"1050","scalaz" +"1049","selenium-firefoxdriver" +"1049","cisco" +"1049","mongodb-java" +"1049","drawrect" +"1048","laravel-10" +"1048","pixi.js" +"1048","visual-studio-mac" +"1048","hl7-fhir" +"1048","android-file" +"1047","chrome-extension-manifest-v3" +"1047","voiceover" +"1047","nsoperationqueue" +"1047","buttonclick" +"1047","httr" +"1047","gmp" +"1046","recurrence" +"1046","ios-autolayout" +"1045","greedy" +"1045","modx" +"1045","tail" +"1045","eigen3" +"1044","tcpdump" +"1044","preload" +"1044","parentheses" +"1043","monaco-editor" +"1043","spring-webclient" +"1042","cell-array" +"1042","agora.io" +"1042","watin" +"1042","brackets" +"1042","bookdown" +"1042","c++-chrono" +"1042","uikeyboard" +"1042","imageicon" +"1041","git-lfs" +"1041","nant" +"1041","android-contentresolver" +"1041","ms-project" +"1040","unsafe" +"1040","docker-desktop" +"1040","deno" +"1040","global-asax" +"1039","lapack" +"1039","shapeless" +"1039","logarithm" +"1038","php-extension" +"1038","samba" +"1037","stack-memory" +"1036","class-library" +"1036","youtube-dl" +"1036","wildfly-8" +"1036","rails-migrations" +"1036","lowercase" +"1036","menubar" +"1035","proc" +"1035","jtextpane" +"1035","nstextfield" +"1035","spam" +"1034","naivebayes" +"1034","linqpad" +"1033","detect" +"1033","nose" +"1033","promql" +"1033","parallel.foreach" +"1032","localdb" +"1032","adobe-illustrator" +"1032","geodjango" +"1032","binance" +"1031","xunit.net" +"1031","agile" +"1031","intuit-partner-platform" +"1030","vega" +"1030","introspection" +"1029","android-proguard" +"1028","dalvik" +"1027","aws-sam" +"1026","multiple-instances" +"1026","semantic-markup" +"1026","mongoose-populate" +"1026","searchbar" +"1026","dart-polymer" +"1025","least-squares" +"1024","ggmap" +"1024","opencsv" +"1023","jdialog" +"1023","gravity-forms-plugin" +"1023","wpftoolkit" +"1023","bucket" +"1022","pointer-to-member" +"1022","curses" +"1022","gnu-screen" +"1022","zebra-printers" +"1021","multitasking" +"1021","keyword-argument" +"1021","paypal-adaptive-payments" +"1021","esri" +"1020","fish" +"1020","konvajs" +"1020","huggingface" +"1020","custom-element" +"1019","package-managers" +"1019","myisam" +"1019","django-south" +"1019","taskbar" +"1019","resx" +"1019","ipywidgets" +"1018","sqlsrv" +"1018","swifty-json" +"1018","xml-deserialization" +"1018","sql-loader" +"1017","selecteditem" +"1017","testcase" +"1016","xstream" +"1016","sqlclr" +"1016","isset" +"1016","pem" +"1015","extjs3" +"1015","spaces" +"1014","anonymous-types" +"1014","cloudera-cdh" +"1014","sql-view" +"1014","datastax-java-driver" +"1013","flutter-bloc" +"1013","inject" +"1013","ofstream" +"1012","bandwidth" +"1012","xml-validation" +"1012","kotlin-flow" +"1012","vhosts" +"1011","cosine-similarity" +"1011","chaining" +"1010","pyqtgraph" +"1010","google-cloud-ml" +"1010","amazon-neptune" +"1009","javacard" +"1008","truetype" +"1008","knockout-2.0" +"1008","pyparsing" +"1007","onmouseover" +"1007","polynomials" +"1007","deque" +"1007","aar" +"1007","async.js" +"1006","vala" +"1006","cakephp-2.1" +"1006","javascript-framework" +"1006","frames" +"1006","tinkerpop" +"1006","scene" +"1006","pywinauto" +"1006","spark-cassandra-connector" +"1005","backslash" +"1005","jboss-arquillian" +"1005","findbugs" +"1005","windows-server-2016" +"1005","easeljs" +"1005","infopath" +"1004","jquery-ui-accordion" +"1004","eloquent-relationship" +"1004","arduino-esp8266" +"1003","spfx" +"1003","subscribe" +"1002","jslint" +"1002","easymock" +"1002","pascalscript" +"1001","joi" +"1001","android-download-manager" +"1000","telerik-mvc" +"1000","interaction" +"1000","azure-bot-service" +"1000","shiny-reactivity" +"999","managed-bean" +"998","bluez" +"998","uiactionsheet" +"998","oncreate" +"997","swagger-codegen" +"997","android-calendar" +"997","url-encoding" +"996","playframework-2.1" +"996","macos-big-sur" +"996","asyncstorage" +"996","signed" +"996","node-gyp" +"994","vagrantfile" +"994","opc-ua" +"993","framer-motion" +"993","onactivityresult" +"992","python-dataclasses" +"992","pdflatex" +"992","winsock2" +"992","typo3-9.x" +"991","spring-el" +"991","dynamic-data" +"990","smooth-scrolling" +"990","robotium" +"990","hta" +"990","destroy" +"990","miniconda" +"989","n-tier-architecture" +"988","datastore" +"988","javacv" +"988","mode" +"988","uitabbaritem" +"988","google-geocoder" +"988","composite-primary-key" +"987","db2-400" +"987","pseudo-class" +"987","body-parser" +"987","minio" +"987","topic-modeling" +"986","function-definition" +"986","rule-engine" +"986","cryptocurrency" +"986","android-appwidget" +"986","reusability" +"986","brute-force" +"986","uiactivityindicatorview" +"986","gdata" +"986","resampling" +"986","concurrent.futures" +"985","playframework-2.3" +"985","tty" +"984","docker-for-windows" +"984","enumerate" +"984","axes" +"984","rhino" +"984","android-keystore" +"984","amazon-ecr" +"983","native-base" +"983","opentk" +"983","google-custom-search" +"982","appendchild" +"982","ruby-on-rails-7" +"982",".net-core-3.1" +"982","mkannotationview" +"982","membership-provider" +"982","custom-adapter" +"981","file-format" +"981","nsoperation" +"981","texture-mapping" +"980","vscode-remote" +"980","sage" +"980","onitemclicklistener" +"979","primitive" +"979","antialiasing" +"979","grayscale" +"979","jshint" +"979","fine-uploader" +"979","pyside6" +"979","cocoa-bindings" +"979","string-parsing" +"978","levenshtein-distance" +"978","foundation" +"978","tapestry" +"978","android-camera-intent" +"978","gawk" +"978","illegalargumentexception" +"977","preventdefault" +"977","rselenium" +"977","gspread" +"977","audiokit" +"977","regex-greedy" +"977","nodemcu" +"977","eventemitter" +"977","cgcontext" +"977","membership" +"977","composite" +"976","pulp" +"976","ntfs" +"976","python-wheel" +"975","arcgis-js-api" +"974","jboss6.x" +"974","csom" +"974","woocommerce-rest-api" +"974","xcode10" +"974","monkeypatching" +"972","datalist" +"972","dispatch" +"972","turbolinks" +"972","android-10.0" +"972","mousemove" +"971","json-ld" +"971","simplecursoradapter" +"971","gpuimage" +"971","pull" +"971","wso2-enterprise-integrator" +"971","uiinterfaceorientation" +"971","webapp2" +"970","apache-spark-dataset" +"970","azure-automation" +"970","posts" +"970","osgi-bundle" +"970","sqldatasource" +"970","rest-client" +"969","bootstrap-table" +"969","outlook-restapi" +"969","sqlbulkcopy" +"969","rails-routing" +"969","nonlinear-optimization" +"968","google-fit" +"968","google-earth" +"968","compile-time" +"967","tsc" +"967","stackdriver" +"967","extjs6" +"967","elasticsearch-plugin" +"967","angular-http" +"966","instanceof" +"966","cartopy" +"966","separator" +"966","apache-tomee" +"966","scala-cats" +"966","quasar" +"966","user-roles" +"965","templating" +"965","fuzzy-search" +"965","thrust" +"964","realitykit" +"964","random-seed" +"964","system-administration" +"964","rails-admin" +"964","uiswitch" +"964","strong-parameters" +"964","beanshell" +"963","ngx-bootstrap" +"963","gtkmm" +"963","video-encoding" +"963","text-alignment" +"962","mysql-5.7" +"962","delphi-2009" +"962","elmah" +"961","serial-communication" +"961","cakephp-3.x" +"961","wiremock" +"961","color-scheme" +"960","vapor" +"960","macvim" +"960","spray" +"959","git-log" +"959","imputation" +"959","x509certificate2" +"959","titan" +"958","mat" +"958","ngrx-effects" +"957","adaptive-cards" +"957","openwrt" +"957","strcmp" +"957","git-remote" +"956","processor" +"956","bootstrapping" +"956","overlapping" +"956","speech" +"955","cashapelayer" +"955","apc" +"955","jgit" +"955","ws-security" +"955","visible" +"954","masonry" +"954","mysql-8.0" +"954","noise" +"954","propertygrid" +"954","google-cloud-vertex-ai" +"953","taglib" +"953","oh-my-zsh" +"953","strcpy" +"952","terminate" +"952","sendmessage" +"952","winston" +"952","coordinate-systems" +"952","hue" +"951","mandrill" +"951","dockerhub" +"951","android-youtube-api" +"951","outlook-2010" +"950","magento-1.8" +"950","pyopengl" +"950","asp.net-mvc-partialview" +"950","screen-readers" +"950","euclidean-distance" +"950","hdl" +"949","bulk" +"949","tile" +"948","hidden-field" +"947","odoo-11" +"946","nativescript-angular" +"946","aws-secrets-manager" +"945","pageload" +"945","grpc-java" +"945","epub" +"945","mdi" +"944","coalesce" +"944","coreml" +"944","pop3" +"944","extendscript" +"944","bulma" +"943","db2-luw" +"943","serde" +"943","dev-c++" +"943","space-complexity" +"942","banner" +"942","appium-ios" +"942","azure-bicep" +"942","movieclip" +"941","mysql2" +"941","browser-sync" +"941","asp.net-core-2.2" +"941","drive" +"941","look-and-feel" +"941","getchar" +"940","cron-task" +"940","node-sass" +"939","background-service" +"939","apache-spark-ml" +"939","django-settings" +"939","xcode-storyboard" +"939","azure-managed-identity" +"939","odoo-12" +"938","file-writing" +"938","azure-hdinsight" +"937","apache2.4" +"937","laravel-backpack" +"937","servlet-3.0" +"937","avl-tree" +"937","box" +"937","summernote" +"936","graphite" +"936","horizontalscrollview" +"936","scatter" +"935","saxparser" +"935","form-for" +"935","wordnet" +"935","minimax" +"935","jaas" +"935","sqflite" +"935","force-layout" +"934","sequential" +"934","abi" +"934","azure-stream-analytics" +"933","snowflake-schema" +"933","robocopy" +"932","wildfly-10" +"932","javasound" +"931","gimp" +"931","pharo" +"931","tcplistener" +"930","ng-options" +"930","docx4j" +"929","cname" +"929","bios" +"928","fasta" +"928","rancher" +"927","blas" +"927","facet-wrap" +"927","ksqldb" +"927","google-assistant-sdk" +"927","pyqt6" +"926","windows-task-scheduler" +"926","iso8601" +"926","amazon-elasticache" +"925","python-logging" +"925","pyglet" +"925","bytebuffer" +"924","data-transfer" +"924","addressbook" +"924","typeahead" +"924","observers" +"924","sqlcommand" +"924","google-cloud-vision" +"923","sql-function" +"923","openvpn" +"923","generative-adversarial-network" +"923","restangular" +"923","array-broadcasting" +"922","symfony-3.4" +"922","micro-optimization" +"922","macos-mojave" +"922","openoffice.org" +"922","android-networking" +"922","powershell-5.0" +"922","mcrypt" +"921","regular-language" +"921","class-method" +"921","wikidata" +"921","go-gin" +"921","vertex-shader" +"920","release-management" +"920","swingworker" +"920","rbind" +"920","fortify" +"920","tibco" +"919","smb" +"919","fiware-orion" +"919","kendo-ui-angular2" +"919","timertask" +"919","tagging" +"919","bxslider" +"919","onbeforeunload" +"919","gltf" +"918","include-path" +"918","neon" +"918","isolatedstorage" +"917","editing" +"917","libreoffice-calc" +"917","titanium-alloy" +"917","mule-component" +"916","adjacency-matrix" +"916","w3c-validation" +"916","supertest" +"916","knockout-mapping-plugin" +"916","csvhelper" +"915","antlr3" +"915","session-storage" +"915","developer-tools" +"915","postsharp" +"915","weblogic-10.x" +"914","try-except" +"914","reportingservices-2005" +"914","alembic" +"914","boot2docker" +"914","dvcs" +"914","asp.net-2.0" +"914","sonar-runner" +"913","jboss5.x" +"913","mfmailcomposeviewcontroller" +"912","apache-felix" +"912","data-processing" +"912","facebook-access-token" +"911","paypal-subscriptions" +"911","c11" +"910","renderer" +"910","chunks" +"910","cgo" +"910","lockscreen" +"909","onnx" +"909","delphi-xe7" +"909","subnet" +"908","multi-module" +"908","phpdoc" +"908","gekko" +"907","azure-application-gateway" +"907","asp.net-core-signalr" +"907","glade" +"906","feature-detection" +"906","data-extraction" +"906","vbo" +"906","android-uiautomator" +"906","abp-framework" +"906","pyenv" +"906","signalr.client" +"906","autosuggest" +"906","glassfish-4" +"906","batch-rename" +"905","reportbuilder3.0" +"905","fftw" +"905","yii-extensions" +"905","netcat" +"905","locust" +"905","imagej" +"904","dygraphs" +"904","required" +"903","caret" +"903","pycrypto" +"903","spring-integration-dsl" +"903","polyfills" +"902","bitmapimage" +"902","datacontractserializer" +"902","pdfsharp" +"902","android-textinputlayout" +"901","django-users" +"901","iboutlet" +"901","nsobject" +"901","laravel-nova" +"901","qt-quick" +"901","liferay-7" +"900","lwuit" +"900","colormap" +"900","elasticsearch-dsl" +"900","qgraphicsscene" +"899","nrwl-nx" +"899","keep-alive" +"899","quickbooks-online" +"899","nuget-package-restore" +"898","controllers" +"897","materialized-views" +"897","graalvm" +"897","serializable" +"897","postmessage" +"897","modernizr" +"896","guard" +"896","launcher" +"896","throw" +"896","powershell-cmdlet" +"895","carriage-return" +"895","e4" +"895","pdb" +"895","moss" +"894","intel-fortran" +"894","ibaction" +"894","in-memory-database" +"894","devextreme" +"894","npx" +"893","bing" +"893","symbian" +"893","payload" +"893","janusgraph" +"893","exponential" +"892","datanucleus" +"892","windows-11" +"892","django-signals" +"892","formatter" +"892","android-build" +"892","amazon-ami" +"891","application-pool" +"891","sbcl" +"890","ssas-tabular" +"890","managed" +"890","hibernate-envers" +"890","sdwebimage" +"890","usability" +"889","ormlite-servicestack" +"889","args" +"889","webpack-5" +"888","jedis" +"888","vitest" +"888","android-jetpack-navigation" +"887","cartesian-product" +"887","web.py" +"886","spring-cloud-netflix" +"886","typo3-7.6.x" +"886","color-picker" +"886","laravel-validation" +"886","solr4" +"885","php-5.6" +"885","xpages-ssjs" +"885","enter" +"885","dice" +"884","standard-deviation" +"884","hyperparameters" +"884","libusb" +"884","android-3.0-honeycomb" +"884","angular-http-interceptors" +"883","bit-fields" +"883","malware" +"883","datatrigger" +"883","sqlexception" +"883","cucumberjs" +"883","tex" +"882","indices" +"882","pg" +"881","debug-symbols" +"881","dma" +"881","algebra" +"881","ms-media-foundation" +"880","n-gram" +"880","xelement" +"880","case-when" +"880","delphi-xe5" +"880","code-reuse" +"880","facebook-ads-api" +"880","dictionary-comprehension" +"880","dotenv" +"880","lotus" +"880","three20" +"879","fluid-layout" +"879","runtime.exec" +"879","names" +"879","data-fitting" +"879","reverse-geocoding" +"878","effect" +"878","ngroute" +"878","win32gui" +"878","boost-thread" +"878","tasm" +"878","double-click" +"878","asp.net-core-1.0" +"877","pinia" +"877","sikuli" +"877","android-cursoradapter" +"877","android-orientation" +"877","moxy" +"877","meanjs" +"877","summarize" +"876","gsutil" +"876","android-7.0-nougat" +"876","android-camerax" +"876","mediaelement" +"875","phpspreadsheet" +"875","dex" +"874","feathersjs" +"874","ng-class" +"874","smlnj" +"874","openerp-7" +"874","pmd" +"874","nstextview" +"874","std-function" +"873","badge" +"873","microdata" +"873","entity-attribute-value" +"873","cfml" +"873","mql4" +"872","grid-search" +"872","clang-format" +"872","pinterest" +"872","magicalrecord" +"872","branch.io" +"872","gamekit" +"872","battery" +"872","thinking-sphinx" +"872","utf" +"872","beacon" +"872","amazon-cloudwatchlogs" +"871","sling" +"871","semantic-ui-react" +"871","packer" +"871","nix" +"871","cesiumjs" +"870","rpmbuild" +"870","twitter-fabric" +"870","blueimp" +"870","windows-store" +"870","scilab" +"870","iterm2" +"870","maven-release-plugin" +"869","contentful" +"869","markerclusterer" +"869","selected" +"869","red5" +"869","lottie" +"869","accessor" +"868","undo" +"868","failover" +"868","html-framework-7" +"868","forum" +"868","hadoop-streaming" +"868","morphia" +"865","xmppframework" +"865","universal-image-loader" +"864","flicker" +"864","jbossfuse" +"864","smt" +"864","mahapps.metro" +"863","imagemap" +"863","passport-local" +"863","memory-mapped-files" +"863","css-sprites" +"863","z3py" +"862","derivative" +"862","applicationcontext" +"862","cran" +"862","model-associations" +"862","dummy-variable" +"862","link-to" +"861","flash-cs6" +"861","keyframe" +"861","google-speech-api" +"860","rmagick" +"860","azure-notificationhub" +"860","reactive-cocoa" +"859","jenkins-job-dsl" +"859","eclipse-jdt" +"859","will-paginate" +"859","aws-security-group" +"859","pentaho-spoon" +"859","multilabel-classification" +"858","basic" +"858","platform" +"858","uber-api" +"858","points" +"858","highlighting" +"858","mobx-react" +"858","actioncable" +"858","panel-data" +"857","web-sql" +"857","minimize" +"857","android-broadcastreceiver" +"857","aspose" +"857","tablerow" +"857","google-fabric" +"856","phpseclib" +"856","documentation-generation" +"856","go-templates" +"856","maxima" +"855","gantt-chart" +"854","pageobjects" +"854","gcc-warning" +"854","openweathermap" +"853","envoyproxy" +"853","drawerlayout" +"853","podman" +"853","ellipse" +"853","google-drive-android-api" +"853","reachability" +"852","findall" +"852","windows-10-mobile" +"852","database-cursor" +"852","kestrel-http-server" +"852","uglifyjs" +"852","formbuilder" +"852","foxpro" +"852","android-handler" +"852","prototypal-inheritance" +"852","pentaho-data-integration" +"852","sunspot" +"852","urlfetch" +"851","trino" +"851","doc" +"851","sap-fiori" +"851","android-2.2-froyo" +"850","scala.js" +"850","atmega" +"850","android-maps" +"849","ggplotly" +"849","image-rotation" +"849","keycode" +"849","absolute-path" +"849","mlab" +"849","asp.net-core-3.0" +"849","melt" +"849","ios-charts" +"849","metamask" +"848","wifi-direct" +"848","blobstore" +"848","control-flow" +"847","lexical-analysis" +"847","sigabrt" +"847","stylus" +"846","agda" +"846","delphi-2007" +"846","pecl" +"845","kohana-3" +"845","dom-manipulation" +"845","alter" +"845","qt6" +"844","modulenotfounderror" +"844","stat" +"843","pki" +"843","mod-proxy" +"843","buildroot" +"842","palantir-foundry" +"842","jsf-1.2" +"842","modulus" +"842","azure-worker-roles" +"842","stopwatch" +"842","pyyaml" +"842","use-case" +"841","youtube-javascript-api" +"841","connection-timeout" +"841","proof" +"841","angular2-observables" +"840","intellij-14" +"840","file-type" +"840","connector" +"840","watchos-2" +"840","entities" +"840","numberformatexception" +"840","ethers.js" +"840","subclassing" +"839","firedac" +"839","flat-file" +"839","hosts" +"839","keil" +"838","google-api-nodejs-client" +"838","hashtag" +"838","pep8" +"837","vue-test-utils" +"837","intel-xdk" +"837","bioconductor" +"837","jsdom" +"837","android-external-storage" +"837","ios-universal-links" +"836","integral" +"836","multiple-monitors" +"835","default-constructor" +"835","triangulation" +"835","tree-traversal" +"835","apigee" +"835","rating" +"835","autofilter" +"834","rundeck" +"834","gulp-watch" +"834","vimeo-api" +"834","ubuntu-server" +"834","pygobject" +"834","type-mismatch" +"834","drake" +"833","enthought" +"833","android-4.2-jelly-bean" +"833","cgaffinetransform" +"832","ef-fluent-api" +"832","squarespace" +"832","rtti" +"832","newsletter" +"832","ria" +"831","pi" +"831","aerospike" +"831","kable" +"831","stored-functions" +"831","array-merge" +"830","flexdashboard" +"830","intel-mkl" +"830","django-crispy-forms" +"830","cp" +"830","postgresql-9.6" +"829","map-function" +"829","failed-installation" +"829","mailkit" +"829","httpmodule" +"829","google-developers-console" +"828","relationships" +"828","pylons" +"827","squid" +"827","imshow" +"827","twitch" +"826","multiple-tables" +"826","datatables-1.10" +"826","cumsum" +"826","spam-prevention" +"826","qtreeview" +"825","gravity" +"825","printwriter" +"825","ef-core-3.1" +"825","ui-testing" +"825","jtabbedpane" +"825","capistrano3" +"825","workbox" +"825","android-appbarlayout" +"825","sift" +"825","titlebar" +"824","jira-plugin" +"824","interstitial" +"824","google-places" +"824","tfvc" +"823","jersey-client" +"823","pexpect" +"823","web-api-testing" +"823","thread-sleep" +"823","amazon-mws" +"822","teechart" +"822","listitem" +"822","webview2" +"822","pgp" +"822","facebook-oauth" +"822","interrupt-handling" +"822","code-completion" +"822","geb" +"822","uisearchdisplaycontroller" +"822","culture" +"822","olap-cube" +"822","http-status-code-400" +"822","image-compression" +"821","jmockit" +"821","angular10" +"821","reactjs-flux" +"820","rlang" +"820","facebook-authentication" +"820","drupal-theming" +"820","webgrid" +"819","primitive-types" +"819","dbf" +"819","indy10" +"819","sweetalert2" +"819","setup-deployment" +"818","tycho" +"818","reducers" +"818","lighting" +"817","ckan" +"817","screen-capture" +"817","opentok" +"817","requestanimationframe" +"816","telephony" +"816","xslt-3.0" +"816","legacy" +"816","fractions" +"815","skphysicsbody" +"815","aws-event-bridge" +"815","suppress-warnings" +"815","shopify-api" +"815","azure-monitoring" +"815","lookup-tables" +"815","eventhandler" +"815","concurrenthashmap" +"814","proc-sql" +"814","ckeditor4.x" +"814","bittorrent" +"814","cells" +"814","corruption" +"814","sprockets" +"813","youtube-iframe-api" +"813","checked" +"813","led" +"813","c++03" +"812","smo" +"812","p-value" +"812","abaddressbook" +"812","organization" +"812","type-erasure" +"812","yql" +"812","billing" +"812","paragraph" +"811","websphere-7" +"811","bitbucket-server" +"811","rodbc" +"810","erp" +"810","libstdc++" +"810","opensuse" +"810","mudblazor" +"810","urlsession" +"809","epoll" +"809","gtk#" +"809","azure-media-services" +"809","qliksense" +"809","octopus-deploy" +"808","cllocation" +"808","dylib" +"808","error-logging" +"808","cqlsh" +"808","java-bytecode-asm" +"808","head" +"807","facebook-messenger-bot" +"807","gyroscope" +"807","google-earth-engine" +"806","greenplum" +"806","yii2-basic-app" +"806","static-variables" +"805","self-signed" +"805","hough-transform" +"805","mingw32" +"805","minecraft-forge" +"805","mlflow" +"805","c++-cx" +"805","touchscreen" +"805","webpacker" +"804","floating" +"804","windows-10-iot-core" +"804","puzzle" +"804","libpcap" +"804","ms-access-2003" +"803","weather" +"803","constraint-programming" +"803","firebase-cli" +"803","fosrestbundle" +"802","markers" +"802","fastify" +"802","pypy" +"802","caesar-cipher" +"802","glyphicons" +"801","polymer-2.x" +"801","sqliteopenhelper" +"801","memory-barriers" +"801","paperjs" +"800","psexec" +"800","bloomberg" +"800",".net-standard-2.0" +"800","sparkr" +"799","datacontract" +"799","springfox" +"799","vis.js" +"799","exploit" +"799","openmodelica" +"799","lighthouse" +"798","opengl-3" +"798","emu8086" +"797","listactivity" +"797","python-3.10" +"797","fusioncharts" +"797","azure-appservice" +"797","erlang-otp" +"797","sanity" +"797","tabview" +"797","generic-list" +"797","persistent-volumes" +"797","url-rewrite-module" +"797","qtstylesheets" +"795","function-call" +"795","recharts" +"795","velo" +"795","asymptotic-complexity" +"795","vivado" +"794","window-resize" +"794","sankey-diagram" +"794","scala-macros" +"794","tbb" +"794","azureportal" +"794","static-files" +"794","user-defined-types" +"793","union-all" +"793","spring-bean" +"793","buddypress" +"793","macos-high-sierra" +"793","android-datepicker" +"793","byte-buddy" +"793","v-for" +"793","certbot" +"793","qstring" +"792","veins" +"792","iso-8859-1" +"792","idris" +"791","apdu" +"791","icefaces" +"791","pcm" +"791","machine-code" +"791","typeof" +"791","settext" +"791","is-empty" +"791","notepad" +"791","moviepy" +"791","flv" +"791","yuv" +"791","hebrew" +"790","grepl" +"790","multisite" +"790","rxjs-observables" +"790","watson-conversation" +"790","facebook-comments" +"790","ambari" +"790","rds" +"790","strptime" +"790","foreground-service" +"789","master-slave" +"789","ownership" +"789","android-11" +"789","android-audiomanager" +"789","geofencing" +"788","whm" +"788","backbone-events" +"788","telephonymanager" +"788","sony" +"787","application-settings" +"787","rails-engines" +"787","mediaelement.js" +"786","self-hosting" +"786","roslyn-code-analysis" +"786","simplify" +"786","quantitative-finance" +"785","edmx" +"785","json-schema-validator" +"785","icu" +"785","uipath" +"785","c#-5.0" +"785","eventtrigger" +"785","http-status-code-500" +"784","snap.svg" +"784","crtp" +"784","stress-testing" +"784","sparklyr" +"784","particles" +"783","jcr" +"783","sequel" +"783","inkscape" +"783","visitor-pattern" +"783","dimension" +"783","rails-i18n" +"783","urllib3" +"783","google-iam" +"782","file-conversion" +"782","replaceall" +"782","overload-resolution" +"782","nsnumber" +"782","ransack" +"782","asn.1" +"781","marquee" +"781","katalon-studio" +"781","navigationview" +"781","typo3-6.2.x" +"781","std-pair" +"780","listboxitem" +"780","datareader" +"780","finder" +"780","pkcs#11" +"780","azure-durable-functions" +"780","equation-solving" +"780","merge-conflict-resolution" +"780","google-home" +"780","zend-framework3" +"779","yahoo-api" +"779","kong" +"779","uibinder" +"778","airflow-2.x" +"778","html-input" +"778","typechecking" +"778","aspxgridview" +"778","xcode12" +"778","composite-component" +"778","quantile" +"777","jcomponent" +"777","reactstrap" +"777","spring-hateoas" +"777","event-dispatch-thread" +"777","parseint" +"777","zoho" +"777","bin" +"776","vertex" +"776","argument-passing" +"776","multimap" +"776","webp" +"776","heredoc" +"775","confirm" +"775","keyup" +"775","modelsim" +"775","obiee" +"775","typo3-8.x" +"775","dhcp" +"775","resnet" +"775","node-redis" +"775","sublist" +"775","comparison-operators" +"774","removing-whitespace" +"774","choropleth" +"774","unreal-engine5" +"774","recovery" +"774","irb" +"774","mouse-cursor" +"774","persistent" +"774","stenciljs" +"774","pragma" +"774","sublime-text-plugin" +"773","ebpf" +"773","directoryservices" +"773","riak" +"773","mockmvc" +"772","sitefinity" +"772","circular-reference" +"772","bounds" +"772","region" +"772","drawer" +"771","pythonpath" +"771","windows-shell" +"771","twilio-twiml" +"771","gtsummary" +"771","ostream" +"771","b-tree" +"771","oledbconnection" +"771","prometheus-alertmanager" +"770","symfony-2.3" +"770","variance" +"770","dllexport" +"770","spring-oauth2" +"770","galaxy" +"770","android-mvvm" +"770","google-geocoding-api" +"770","gnu-parallel" +"769","qgraphicsitem" +"769","ipfs" +"769","soql" +"769","u-sql" +"768","appcelerator-mobile" +"768","socks" +"768","video-player" +"768","task-queue" +"768","dialogflow-es-fulfillment" +"768","messenger" +"767","spring-3" +"766","wdk" +"766","x-editable" +"766","jplayer" +"766","docstring" +"766","monad-transformers" +"766","ray" +"765","applepay" +"765","spring-session" +"765","blend" +"765","wix3.5" +"765","radiobuttonlist" +"765","hardhat" +"765","user-accounts" +"764","python-pptx" +"764","google-apps-marketplace" +"764","terra" +"764","transactional" +"764","multiclass-classification" +"763","crypto++" +"763","delegation" +"763","librosa" +"763","coordinate-transformation" +"763","rails-api" +"763","geocode" +"762","flashdevelop" +"762","adonis.js" +"762","unhandled-exception" +"762","oracle-apex-5.1" +"762","jvm-hotspot" +"762","core-text" +"762","exoplayer2.x" +"762","eigenvalue" +"762","partials" +"761","php-ziparchive" +"761","callable" +"761","tableau-desktop" +"761","cocos2d-x-3.0" +"761","java-module" +"760","icc" +"760","info.plist" +"760","custom-cell" +"760","ellipsis" +"760","arcpy" +"759","bitset" +"759","scrum" +"759","headless-browser" +"758","audiounit" +"758","notify" +"758","openshift-origin" +"758","resourcebundle" +"758","scrollto" +"758","belongs-to" +"757","wowza" +"757","svelte-3" +"757","playlist" +"757","non-linear-regression" +"757","splice" +"757","encryption-symmetric" +"756","clips" +"756","tsx" +"756","datarow" +"756","google-vision" +"756","portal" +"756","spring-saml" +"756","bufferedwriter" +"755","declare" +"755","traveling-salesman" +"755","angular-resource" +"755","wallpaper" +"755","svd" +"755","msbuild-task" +"754","bing-api" +"754","jquery-templates" +"754","ios-ui-automation" +"754","amazon-quicksight" +"754","sticky-footer" +"753","implode" +"753","diskspace" +"753","wcf-client" +"753","twitter-bootstrap-4" +"753","aws-sdk-js" +"753","m3u8" +"753","astropy" +"753","direct2d" +"753","flutter-navigation" +"753","composite-key" +"752","ubuntu-22.04" +"752","reflection.emit" +"752","xcopy" +"752","android-design-library" +"751","sap-gui" +"751","gulp-sass" +"751","spring-cloud-feign" +"751","typography" +"751","parsley.js" +"751","altbeacon" +"750","decltype" +"750","recording" +"750","quickfix" +"750","timescaledb" +"750","percentile" +"750","allocator" +"749","margins" +"749","meteor-accounts" +"749","android-transitions" +"749","google-cardboard" +"749","office-automation" +"749","ip-camera" +"748","microsoft-sync-framework" +"748","hammer.js" +"748","subreport" +"748","google-sites" +"747","instruction-set" +"747","cd" +"747","firebase-notifications" +"747","bootstrap-datetimepicker" +"747","episerver" +"747","facebook-marketing-api" +"747","hamburger-menu" +"747","angular-filters" +"747","chakra-ui" +"747","splunk-query" +"747","emmet" +"747","conan" +"746","fxcop" +"746","python-internals" +"746","ruby-on-rails-2" +"746","let" +"745","file-copying" +"745","relayjs" +"745","cancellation" +"745","isolation-level" +"745","dhtml" +"745","uipagecontrol" +"745","flutter-listview" +"745","gnuradio" +"745","amazon-kms" +"744","ansible-facts" +"744","web-testing" +"744","annotation-processing" +"744","kableextra" +"744","erase" +"744","css-modules" +"744","conditional-compilation" +"743","visualsvn-server" +"743","qcombobox" +"742","celery-task" +"742","smartphone" +"742","bitmask" +"742","playframework-1.x" +"742","rsyslog" +"742","depth" +"742","siblings" +"742","condition-variable" +"741","gsl" +"741","invoice" +"741","c#-6.0" +"741","traceback" +"740","import-from-excel" +"740","keystonejs" +"740","modem" +"740","azure-data-lake-gen2" +"740","rasa" +"740","jaxb2" +"740","bigint" +"740","transfer-learning" +"739","flip" +"739","angular-test" +"739","nativescript-vue" +"739","android-ksoap2" +"739","queryover" +"738","sencha-architect" +"738","calculated-field" +"738","m2e" +"738","tinkerpop3" +"738","hasura" +"738","screen-size" +"738","zope" +"737","xjc" +"737","disqus" +"737","kde-plasma" +"737","apscheduler" +"737","rcurl" +"737","active-model-serializers" +"737","amazon-lex" +"736","ef-database-first" +"736","pinchzoom" +"736","sitecore7" +"736","android-gps" +"736","uifont" +"736","strftime" +"735","pointer-arithmetic" +"735","android-checkbox" +"735","continue" +"735","ctags" +"734","clip" +"734","ftp-client" +"734","avx2" +"734","oracle-cloud-infrastructure" +"734","operation" +"734","dio" +"734","google-cloud-stackdriver" +"733","citrix" +"733","gitlab-api" +"733","ngx-translate" +"733","assertions" +"732","rvalue" +"732","image-upload" +"732","py2neo" +"732","word-cloud" +"732","execution-time" +"732","compareto" +"732","collectors" +"732","http-error" +"732","qualtrics" +"731","react-navigation-v5" +"731","renderscript" +"731","adobe-analytics" +"731","rpa" +"731","microchip" +"731","formulas" +"731","poco-libraries" +"731","android-multidex" +"731","alphabetical" +"731","bids" +"730","template-argument-deduction" +"730","connectivity" +"730","dji-sdk" +"730","readability" +"730","perspective" +"729","os.walk" +"729","japplet" +"729","npapi" +"729","business-process-management" +"729","redis-cluster" +"729","strategy-pattern" +"729","pytz" +"729","restriction" +"729","restkit-0.20" +"729","ios-app-extension" +"729","arel" +"729","autodesk-model-derivative" +"728","yammer" +"728","ecdsa" +"728","content-script" +"728","hystrix" +"728","easy-install" +"728","internal" +"728","nsthread" +"728","google-gdk" +"728","autoplay" +"728","gluon" +"727","typescript-eslint" +"727","android-gridlayout" +"726","background-task" +"726","php-7.2" +"726","slick2d" +"726","fitnesse" +"726","magnific-popup" +"726","poisson" +"726","getopt" +"726","sonarlint" +"725","dataview" +"725","seq" +"725","datagrip" +"725","modularity" +"725","neo4j-apoc" +"725","google-cloud-iam" +"725","custom-keyboard" +"725","low-level" +"724","babel-loader" +"724","angular-translate" +"724","crash-dumps" +"724","nsregularexpression" +"724","mifare" +"724","browserstack" +"724","stringify" +"724","mongo-shell" +"723","skip" +"723","packet-sniffers" +"723","twilio-php" +"723","wmic" +"723","nohup" +"722","joblib" +"722","rpgle" +"722","gam" +"721","material-table" +"721","unix-socket" +"721","pushviewcontroller" +"721","dependent-type" +"721","authlogic" +"721","sccm" +"721","tcsh" +"721","google-cloud-spanner" +"721","avaudiorecorder" +"720","clip-path" +"720","divide-and-conquer" +"720","core-motion" +"720","visual-sourcesafe" +"720","viewdidload" +"720","c++-winrt" +"720","hamcrest" +"720","strpos" +"720","compass" +"719","antivirus" +"719","remix" +"719","case-class" +"719","nashorn" +"719","onsubmit" +"719","svg-animate" +"719","nvcc" +"719","sql-grant" +"719","lazy-initialization" +"719","trac" +"718","yeoman-generator" +"718","portfolio" +"718","corpus" +"718","core-foundation" +"718","code-duplication" +"718","nokia" +"718","draftjs" +"718","cgrect" +"718","heroku-cli" +"718","alphanumeric" +"717","xero-api" +"717","document-ready" +"717","caption" +"717","thermal-printer" +"716","flink-sql" +"716","jssor" +"716","flexbuilder" +"716","sonata" +"715","debouncing" +"715","oracle-apex-5" +"715","rhel7" +"715","gemfile" +"715","android-launcher" +"715","threshold" +"714","onresume" +"714","virtuemart" +"713","reactor" +"713","ef-core-2.0" +"713","firefox-developer-tools" +"713","android-viewpager2" +"713","spring-social" +"713","viewbag" +"713","gameobject" +"713","nmap" +"712","ruby-on-rails-plugins" +"712","database-restore" +"712","kotlin-android-extensions" +"712","anaconda3" +"712","corba" +"712","offline-caching" +"711","faker" +"711","nsjsonserialization" +"711","sql++" +"711","angular-cdk" +"711","user-profile" +"711","sections" +"710","reportbuilder" +"710","android-vectordrawable" +"710","tcpserver" +"709","github-for-windows" +"709","csrf-protection" +"709","istream" +"709","activity-lifecycle" +"709","ios-provisioning" +"709","subclipse" +"708","anonymous-class" +"708","json-api" +"708","findstr" +"708","administrator" +"708","google-apis-explorer" +"708","npm-start" +"708","powerpc" +"707","mailmerge" +"707","ioctl" +"707","isnull" +"707","logfile" +"707","elliptic-curve" +"706","insert-into" +"706","trigger.io" +"706","sylius" +"706","mapi" +"706","dnx" +"706","jvm-arguments" +"706","type-safety" +"706","direction" +"706","activemodel" +"706","automata" +"706","linkedhashmap" +"705","awtrobot" +"705","boost-graph" +"705","dynamics-crm-2016" +"705","nine-patch" +"705","strsplit" +"705","prawn" +"704","clickable" +"704","crystal-reports-2010" +"704","blazor-client-side" +"704","strlen" +"703","kill-process" +"703","browser-extension" +"702","replit" +"702","private-members" +"702","vcf-vcard" +"702","pow" +"702","spring-cache" +"702","aws-ssm" +"702","android-mediarecorder" +"702","amazon-lightsail" +"702","parceljs" +"701","bindingsource" +"701","xpath-2.0" +"701","ruby-on-rails-4.2" +"701","django-registration" +"701","react-i18next" +"701","shellcode" +"701","google-street-view" +"701","google-project-tango" +"700","date-conversion" +"700","pact" +"700","vcpkg" +"700","scientific-notation" +"700","ca" +"699","apache-phoenix" +"699","azure-container-instances" +"699","correlated-subquery" +"699","ojdbc" +"699","node-mysql" +"698","vue-cli-3" +"698","graphicsmagick" +"698","getstream-io" +"698","google-app-engine-python" +"698","android-nestedscrollview" +"698","lightgbm" +"698","preloader" +"697","imaplib" +"697","rebol" +"697","fragmentmanager" +"697","right-click" +"697","android-c2dm" +"696","photos" +"696","vnc" +"696","dayofweek" +"696","binning" +"696","initializer" +"696","formtastic" +"696","pymc3" +"696","azure-servicebus-topics" +"696","assetic" +"696","gmaps4rails" +"695","live-wallpaper" +"695","chisel" +"695","dymola" +"695","payment-processing" +"695","forward" +"695","ubuntu-10.04" +"695","geoip" +"694","apache-arrow" +"694","decodable" +"694","lit-element" +"694","graphing" +"694","micrometer" +"694","dlopen" +"694","reactivex" +"694","beta" +"694","thin" +"693","any" +"693","photoshop-script" +"693","boost-spirit-qi" +"693","bootstrapper" +"693","visual-studio-app-center" +"693","directed-graph" +"693","android-fileprovider" +"693","export-to-pdf" +"692","pack" +"692","magento-1.4" +"692","modelform" +"692","nls" +"692","angular11" +"691","kernel-density" +"691","tweets" +"691","rake-task" +"691","drawimage" +"691","nosuchmethoderror" +"691","git-stash" +"690","anonymous" +"690","mxnet" +"690","grails-domain-class" +"690","angular-pipe" +"689","divide" +"689","firmware" +"689","pika" +"689","flask-admin" +"689","phpword" +"689","twos-complement" +"689","word-count" +"689","atom-feed" +"689","scientific-computing" +"689","heuristics" +"689","tidymodels" +"688","base-class" +"688","cloudbees" +"688","appfabric" +"688","verify" +"688","c++98" +"688","spartacus-storefront" +"687","standard-library" +"687","varnish-vcl" +"687","angular-template" +"687","variadic" +"687","words" +"687","workbench" +"687","internals" +"687","sqldf" +"687","nim-lang" +"687","flutter-futurebuilder" +"686","swiperefreshlayout" +"686","r-sp" +"686","mojolicious" +"686","azure-iot-edge" +"686","foreground" +"686","arithmetic-expressions" +"685","selectize.js" +"685","safari-extension" +"685","configparser" +"685","myfaces" +"685","simplemodal" +"685","pull-to-refresh" +"685","nsimage" +"685","pynput" +"685","ios12" +"684","react-proptypes" +"684","jquery-ui-slider" +"684","ntp" +"684","redux-observable" +"683","slim-lang" +"683","jenkins-cli" +"683","json-rpc" +"683","outputcache" +"683","dpdk" +"683","autoresize" +"682","fuse" +"682","ftplib" +"682","facet-grid" +"682","rtos" +"682","inventory" +"682","astrojs" +"682","proxypass" +"682","angular-animations" +"682","email-client" +"681","ansi-escape" +"681","flurry" +"681","rubymotion" +"681","asp.net-core-5.0" +"681","torchvision" +"680","cmusphinx" +"680","xcuitest" +"679","whitelist" +"679","freeswitch" +"679","software-distribution" +"679","packet-capture" +"679","wireless" +"679","handshake" +"679","lock-free" +"679","qprocess" +"679","excel-2003" +"678","aforge" +"678","biometrics" +"678","end-to-end" +"678","suds" +"678","preferenceactivity" +"677","vpc" +"677","selinux" +"677","dynamics-crm-4" +"677","popupmenu" +"677","system.diagnostics" +"677","opennlp" +"677","device-tree" +"677","pg-dump" +"676","removechild" +"676","quicktime" +"676","requirements.txt" +"676","sharpdx" +"675","mutation-observers" +"675","stacked-chart" +"675","semantic-versioning" +"675","sms-gateway" +"675","akka.net" +"675","fmdb" +"674","web-push" +"674","reloaddata" +"674","chocolatey" +"674","request-headers" +"674","qpainter" +"674","sumo" +"673","django-database" +"673","opc" +"673","ml" +"673","ivalueconverter" +"673","tfs-workitem" +"673","solution" +"673","gitolite" +"673","powerbi-datasource" +"672","maple" +"672","nslog" +"672","oculus" +"672","stop-words" +"672","tr" +"672","font-family" +"671","urlconnection" +"671","sicp" +"671","love2d" +"670","f-string" +"670","recv" +"670","variable-declaration" +"670","records" +"670","build-error" +"670","lvalue" +"670","plotly.js" +"669","photon" +"669","vb6-migration" +"669","jax" +"669","jackrabbit" +"669","thread-synchronization" +"669","quartz-2d" +"668","skaction" +"668","localdate" +"668","mapper" +"668","window.location" +"668","app-inventor" +"668","silverlight-toolkit" +"667","consumer" +"667","micro-frontend" +"667","delphi-xe3" +"667","raspberry-pi-pico" +"667","milliseconds" +"667","coinbase-api" +"667","vaadin8" +"666","clipping" +"666","keycloak-services" +"666","abort" +"666","mailer" +"666","scanning" +"666","texture2d" +"666","laravel-sanctum" +"665","clearinterval" +"665","angular-library" +"665","ajaxform" +"665","pathlib" +"665","getelementsbyclassname" +"665","google-cloud-logging" +"665","ninja" +"665","pre-commit-hook" +"665","auto-generate" +"664","decimalformat" +"664","uitouch" +"664","facebook-social-plugins" +"664","iar" +"664","jquery-ui-droppable" +"664","swift4.2" +"664","kalman-filter" +"664","wsdl2java" +"664","netcdf4" +"664","cordova-3" +"664","ondraw" +"663","square" +"663","sockjs" +"663","html-to-pdf" +"663","visualvm" +"663","iis-8.5" +"663","google-mlkit" +"663","complex-event-processing" +"662","vsphere" +"662","wifimanager" +"662","nft" +"662","directx-9" +"662","crystal-lang" +"662","nsoutlineview" +"662","virtualenvwrapper" +"662","android-actionbar-compat" +"662","zpl" +"662","scss-mixins" +"662","thingsboard" +"661","adjacency-list" +"661","indicator" +"661","jpa-2.1" +"661","curly-braces" +"661","multi-factor-authentication" +"660","react-navigation-stack" +"660","flash-cs4" +"660","r-s4" +"660","jupyterhub" +"660","holoviews" +"660","member-functions" +"660","custom-error-pages" +"660","qsort" +"660","hateoas" +"659","freetds" +"659","vee-validate" +"659","net-snmp" +"659","qlabel" +"659","httpsession" +"659","customtkinter" +"658","back-stack" +"658","serenity-bdd" +"658","cql3" +"658","nsubstitute" +"658","onblur" +"658","ldap-query" +"658","mediapipe" +"657","multiple-conditions" +"657","tensorflow-estimator" +"657","method-chaining" +"657","android-seekbar" +"657","html2pdf" +"657","richtext" +"657","java.util.logging" +"657","mq" +"656","rscript" +"656","roxygen2" +"656","azure-eventgrid" +"656","rasa-nlu" +"656","system-tray" +"656","pytorch-lightning" +"656","angular12" +"656","iife" +"656","webautomation" +"655","relay" +"655","skscene" +"655","image-scaling" +"655","file-read" +"655","unicode-string" +"655","ida" +"655","react-state-management" +"655","android-security" +"655","des" +"655","freebase" +"655","css-variables" +"655","arduino-c++" +"655","stdatomic" +"654","ternary" +"654","filezilla" +"654","spring-cloud-sleuth" +"654","payara" +"654","lerna" +"654","messagebroker" +"654","eigenvector" +"654","hybrid" +"653","cobertura" +"653","git-config" +"653","savefiledialog" +"653","shinyjs" +"653","reveal.js" +"653","gmail-imap" +"652","defaultdict" +"652","appbar" +"652","index-error" +"652","django-csrf" +"652","astronomy" +"652","angular-datatables" +"651","telegraf" +"651","werkzeug" +"651","sabre" +"651","windowbuilder" +"651","nearprotocol" +"651","google-cloud-bigtable" +"650","apache-drill" +"650","apache-servicemix" +"650","firebird2.5" +"650","svg-filters" +"650","android-inflate" +"650","stylecop" +"649","pdb-files" +"649","extjs-mvc" +"649","ratchet" +"649","uicontainerview" +"649","busybox" +"649","vertical-scrolling" +"648","load-data-infile" +"648","uiwindow" +"648","oracle-call-interface" +"648","spring-ldap" +"648","bootstrap-typeahead" +"648","code-contracts" +"648","drm" +"648","amazon-ebs" +"648","cvxpy" +"647","livecode" +"647","chi-squared" +"647","dismiss" +"647","caml" +"647","mips32" +"647","android-app-bundle" +"647","c89" +"647","launchd" +"647","light" +"647","secret-key" +"647","custom-view" +"646","integer-division" +"646","xerces" +"646","ng-animate" +"646","mgo" +"646","intersect" +"646","google-analytics-firebase" +"646","resolve" +"646","google-search-api" +"645","lambda-calculus" +"645","distinct-values" +"645","urbanairship.com" +"645","inference" +"645","hard-drive" +"645","quanteda" +"644","viewflipper" +"644","mininet" +"644","linkage" +"644","webm" +"644","stax" +"643","administration" +"643","named-ranges" +"643","android-toast" +"643","inotify" +"643","zos" +"643","msp430" +"643","zod" +"643","qtwebkit" +"642","stage" +"642","php-mongodb" +"642","powerapps-canvas" +"642","libgit2" +"642","code-cleanup" +"642","system.data.sqlite" +"642","ml.net" +"641","feign" +"641","eclipse-juno" +"641","service-discovery" +"641","crystal-reports-xi" +"641","iconv" +"641","analyzer" +"641","ext.net" +"641","quote" +"641","uvicorn" +"640","bad-request" +"640","material-design-lite" +"640","avr-gcc" +"640","callkit" +"640","review" +"640","nusoap" +"640","percona" +"640","mediawiki-api" +"639","temperature" +"639","babel-jest" +"639","check-constraints" +"639","firebase-mlkit" +"639","grafana-loki" +"639","os.system" +"639","system-design" +"639","iphone-x" +"639","elasticsearch-query" +"638","discord.net" +"638","database-project" +"638","unixodbc" +"638","openam" +"638","google-hangouts" +"638","subscript" +"637","xlwt" +"637","adc" +"637","pine-script-v4" +"637","sessionid" +"637","sap-erp" +"637","drivers" +"637","items" +"637","computation-theory" +"636","closedxml" +"636","spring-java-config" +"636","polynomial-math" +"636","forwarding" +"636","google-api-js-client" +"636","contextmanager" +"636","toolchain" +"636","stream-builder" +"636","mouseclick-event" +"635","group" +"635","vtable" +"635","processing-efficiency" +"635","django-tables2" +"635","rect" +"635","postgresql-10" +"635","godot4" +"635","osmnx" +"635","qpushbutton" +"635","tpl-dataflow" +"635","seed" +"634","segment" +"634","pushstate" +"634","wso2-data-services-server" +"634","html-encode" +"634","android-9.0-pie" +"634","arduino-esp32" +"633","datagram" +"633","read-write" +"633","abaqus" +"633","notation" +"633","modalpopupextender" +"633","etag" +"633","huawei-developers" +"633","image-classification" +"632","datastage" +"632","database-deadlocks" +"632","factors" +"632","ns2" +"632","business-logic" +"631","stackpanel" +"631","treeset" +"631","bitmapfactory" +"631","recode" +"631","objective-c-runtime" +"631",".net-core-3.0" +"631","quota" +"631","mplab" +"631","pre-signed-url" +"631","amazon-kinesis-firehose" +"631","autofixture" +"630","daterangepicker" +"630","druid" +"630","zshrc" +"630","http-status-code-302" +"630","irvine32" +"629","treenode" +"629","php-8" +"629","selectonemenu" +"629","xmlstarlet" +"629","xpages-extlib" +"629","inet" +"629","tween" +"629","pymssql" +"629","short" +"629","npoi" +"629","istanbul" +"629","laravel-socialite" +"628","ansi-c" +"628","fluent-nhibernate-mapping" +"628","instagram-graph-api" +"628","cryptoapi" +"628","delphi-10-seattle" +"628","dynamic-cast" +"628","detox" +"628","didselectrowatindexpath" +"628","encoder" +"628","concurrentmodification" +"628","textwatcher" +"627","flextable" +"627","println" +"627","localnotification" +"627","vue-i18n" +"627","multiple-databases" +"627","eclipse-pdt" +"627","fix-protocol" +"627","azure-app-service-plans" +"627","neo4jclient" +"627","magic-methods" +"627","google-classroom" +"627","spring.net" +"627","pyzmq" +"627","evernote" +"627","stringtokenizer" +"627","darkmode" +"626","probability-density" +"626","weighted" +"626","code-organization" +"626","msxml" +"625","ansible-template" +"625","xorg" +"625","units-of-measurement" +"625","python.net" +"625","wine" +"625","sqlperformance" +"625","eventmachine" +"624","repo" +"624","install.packages" +"624","mv" +"624","file-not-found" +"624","selection-sort" +"624","2sxc" +"624","r.java-file" +"624","ognl" +"624","weblogic11g" +"624","linq-to-nhibernate" +"623","graphene-python" +"623","py2app" +"623","http-authentication" +"623","restify" +"623","action-filter" +"623","iphone-5" +"623","maximo" +"622","socketexception" +"622","cdc" +"622","swfobject" +"622","objectinputstream" +"621","graphql-java" +"621","classname" +"621","react-native-router-flux" +"621","unpack" +"621","atmel" +"621","plupload" +"621","element-ui" +"621","emotion" +"621","behaviorsubject" +"621","statistics-bootstrap" +"620","universal" +"620","realm-mobile-platform" +"620","java-home" +"620","httparty" +"620","odoo-13" +"619","decompiler" +"619","datetimeoffset" +"619","createprocess" +"619","spring-data-cassandra" +"619","forever" +"619","raw-input" +"619","ambiguous" +"619","libpng" +"619","pytables" +"619","hardware-acceleration" +"619","burn" +"618","square-connect" +"618","deb" +"618","language-features" +"618","react-tsx" +"618","unsupervised-learning" +"618","ttl" +"618","jquery-hover" +"618","gwt-rpc" +"618","completionhandler" +"618","traffic" +"617","removeclass" +"617","rjava" +"617","jsonparser" +"617","single-table-inheritance" +"617","javassist" +"617","spring-4" +"617","mssql-jdbc" +"617","bbcode" +"616","alassetslibrary" +"616","windows-console" +"616","wcf-rest" +"616","forge" +"616","objectdatasource" +"616","libav" +"616","referrer" +"616","polar-coordinates" +"616","pfx" +"616","stdthread" +"616","praw" +"616","web-frameworks" +"615","ngtable" +"615","density-plot" +"615","nscalendar" +"615","html5-history" +"615","freeglut" +"615","azure-webapps" +"615","ashx" +"614","dbunit" +"614","ddms" +"614","ballerina" +"614","ftpwebrequest" +"614","vegan" +"614","android-facebook" +"614","android-music-player" +"613","jcheckbox" +"613","inspect" +"613","scala-3" +"613","omnifaces" +"613","glmnet" +"613","arraybuffer" +"612","jointjs" +"612","kinect-sdk" +"612","hornetq" +"612","spring-camel" +"612","modx-revolution" +"612","minimum-spanning-tree" +"612","shopify-template" +"612","amcharts4" +"612","asp.net-4.5" +"612","explain" +"612","qlineedit" +"612","email-notifications" +"612","argocd" +"612","topojson" +"611","gorilla" +"611","tunnel" +"611","odoo-14" +"611","parsec" +"610","slidedown" +"610","entropy" +"610","nscoding" +"610","raii" +"610","moose" +"610","encryption-asymmetric" +"609","oracle9i" +"609","kibana-4" +"609","unity-webgl" +"609","equinox" +"609","swiftdata" +"609","aac" +"609","alloy" +"608","sliding-window" +"608","file-exists" +"608","swiftui-navigationview" +"608","self-reference" +"608","pycurl" +"608","sequence-diagram" +"608","unsigned-integer" +"608","wix3" +"608","quoting" +"608","conways-game-of-life" +"608","sdn" +"607","gridsearchcv" +"607","symfony-2.8" +"607","xforms" +"607","facebook-unity-sdk" +"607","axon" +"607","google-cloud-speech" +"607","node-postgres" +"606","week-number" +"606","underline" +"606","enumerable" +"606","for-in-loop" +"606","except" +"606","actionlink" +"606","angular4-forms" +"606","loss" +"606","armv7" +"606","mule-esb" +"606","mayavi" +"605","flowplayer" +"605","reinterpret-cast" +"605","datamodel" +"605","reboot" +"605","negative-number" +"605","android-syncadapter" +"605","leaderboard" +"605","google-pay" +"604","deflate" +"604","mat-table" +"604","masm32" +"604","matlab-cvst" +"604","displaytag" +"604","landscape-portrait" +"604","ui-thread" +"604","android-things" +"604","detailsview" +"604","azure-container-registry" +"604","rfc" +"604","sqlcipher" +"604","preprocessor-directive" +"604","subtitle" +"603","printers" +"603","unc" +"603","symfony-sonata" +"603","biztalk-2010" +"603","azure-deployment" +"603","go-modules" +"603","linq-expressions" +"602","marshmallow" +"602","formarray" +"601","yfinance" +"601","blazeds" +"601","distributed-transactions" +"601","purescript" +"601","intersection-observer" +"601","fragmentpageradapter" +"601","out" +"601","spark-submit" +"600","docker-build" +"600","password-hash" +"600","downcast" +"600","paraview" +"600","tqdm" +"600","solrnet" +"600","gluon-mobile" +"599","webvr" +"599","replicaset" +"599","cascading-deletes" +"599","simplemembership" +"599","azure-artifacts" +"599","codedom" +"599","networkstream" +"599","android-assets" +"599","cabasicanimation" +"598","widgetkit" +"598","yolov5" +"598","jetty-9" +"598","finite-automata" +"598","icmp" +"598","autoscroll" +"598","arp" +"597","laravel-echo" +"597","configurationmanager" +"597","r-mice" +"597","unset" +"597","bpel" +"597","boxing" +"597","one-time-password" +"597","magento-1.5" +"597","diagonal" +"597","soundpool" +"596","slidingmenu" +"596","data-uri" +"596","red-black-tree" +"596","facebook-sharer" +"596","value-type" +"596","dendrogram" +"596","pause" +"596","homescreen" +"596","exponent" +"596","charles-proxy" +"595","greendao" +"595","tridion-2011" +"595","wicked-pdf" +"595","functional-interface" +"595","calabash" +"595","lxc" +"595","word-addins" +"595","stargazer" +"594","file-sharing" +"594","aidl" +"594","magnolia" +"594","mpeg-dash" +"593","bare-metal" +"593","firebase-remote-config" +"593","dynamics-ax-2009" +"593","bookshelf.js" +"593","taskmanager" +"593","geom-text" +"593","thread-local" +"593","toolkit" +"592","edges" +"592","onenote" +"592","crc32" +"592","sqlanywhere" +"592","dhtmlx" +"592","scoping" +"592","qlistwidget" +"592","amazon-efs" +"591","chatgpt-api" +"591","database-indexes" +"591","django-rest-auth" +"591","bootstrap-select" +"591","gsoap" +"591","midp" +"591","codesign" +"591","openoffice-calc" +"591","qweb" +"591","onbackpressed" +"591","text-align" +"591","terrain" +"591","acceptance-testing" +"590","flowchart" +"590","openal" +"590","application-server" +"590","scala-2.10" +"590","netbeans-platform" +"590","mirror" +"590","jagged-arrays" +"590","xamarin.mac" +"590","morris.js" +"589","ggpubr" +"589","firebase-console" +"589","mail-server" +"589","rstudio-server" +"589","goland" +"589","typo3-extensions" +"589","maatwebsite-excel" +"589","notifydatasetchanged" +"589","scrapy-splash" +"589","droppable" +"589","azure-storage-account" +"589","preact" +"588","weld" +"588","photo-gallery" +"588","vscode-tasks" +"588","deprecation-warning" +"588","3dsmax" +"588","response.redirect" +"588","android-productflavors" +"588","gesture-recognition" +"588","strict-aliasing" +"588","thunderbird" +"588","webpack-module-federation" +"587","antiforgerytoken" +"587","insertion" +"587","laravel-excel" +"587","calculus" +"587","surf" +"587","asyncsocket" +"587","expandablelistadapter" +"587","substrate" +"586","sweave" +"586","byte-order-mark" +"586","android-database" +"586","motion" +"586","mousehover" +"585","mapbox-android" +"585","ngcordova" +"585","service-broker" +"585","coreos" +"585","pos-tagger" +"585","core-data-migration" +"585","visual-studio-express" +"585","wininet" +"585","formset" +"585","continuous-delivery" +"585","zap" +"584","gridgain" +"584","instructions" +"584","apple-silicon" +"584","ordereddictionary" +"584","dfa" +"584","gcov" +"584","geotools" +"584","web-controls" +"583","mutation" +"583","skype-for-business" +"583","firefox-os" +"583","manifest.json" +"583","unrecognized-selector" +"583","virtual-environment" +"583","mailchimp-api-v3.0" +"583","hierarchical" +"583","azure-qna-maker" +"583","nosuchelementexception" +"583","angular-bootstrap" +"583","qtextedit" +"583","tidy" +"583","scrollable" +"583","use-context" +"583","compute-shader" +"582","blackberry-simulator" +"582","imgur" +"582","rpm-spec" +"582","sharepoint-workflow" +"582","aws-codecommit" +"582","intranet" +"582","rgdal" +"582","mms" +"582","coldfusion-8" +"582","concrete5" +"582","computed-properties" +"581","udpclient" +"581","activesupport" +"581","log4net-configuration" +"581","laravel-middleware" +"580","relational-algebra" +"580","swrevealviewcontroller" +"580","address-sanitizer" +"580","method-reference" +"580","bonjour" +"580","getelementsbytagname" +"580","android-json" +"580","custom-function" +"580","flutter-widget" +"579","ef-core-2.2" +"579","trello" +"579","typeconverter" +"579","delphi-10.1-berlin" +"579","envdte" +"579","synology" +"579","gatt" +"579","exchange-server-2010" +"578","angular-module" +"578","applicative" +"578","jquery-cycle" +"578","postfix-notation" +"578","terraform0.12+" +"577","faceted-search" +"577","samsung-smart-tv" +"577","video-recording" +"577","c#-8.0" +"577","mouseenter" +"577","street-address" +"577","web-inspector" +"576","postgresql-performance" +"576","retain" +"576","stm32f4discovery" +"575","uitextfielddelegate" +"575","cardview" +"575","rgl" +"575","asp.net-mvc-areas" +"575","ios7.1" +"575","persist" +"574","pygame-surface" +"574","object-oriented-analysis" +"574","geofire" +"574","react-chartjs" +"573","fbml" +"573","imageresizer" +"573","windows-explorer" +"573","windows-server-2019" +"573","nested-class" +"573","dynamic-linq" +"573","invalidation" +"573","razorengine" +"572","markov-chains" +"572","affinetransform" +"572","django-generic-views" +"572","read-the-docs" +"572","blueprism" +"572","nskeyedarchiver" +"572","invoke-command" +"572","wms" +"572","azure-function-app" +"572","azure-sdk-.net" +"572","event-bubbling" +"572","cucumber-junit" +"572","web3py" +"571","jet" +"571","livereload" +"571","semantic-segmentation" +"571","ibeacon-android" +"571","kaminari" +"571","blending" +"571","errno" +"571","eventkit" +"571","stm32f4" +"571","tfs-sdk" +"571","gnome-terminal" +"570","xslt-grouping" +"570","material-components" +"570","flowdocument" +"570","pdfmake" +"570","post-increment" +"570","lync" +"570","objectoutputstream" +"570","linegraph" +"570","cyrillic" +"569","gganimate" +"569","vxworks" +"569","read.table" +"569","postgresql-12" +"569","nsbundle" +"569","object-literal" +"569","r-highcharter" +"569","string.format" +"569","android-package-managers" +"569","forecast" +"569","weather-api" +"569","alphablending" +"568","graph-visualization" +"568","websphere-portal" +"568","fullcalendar-5" +"568","direct-line-botframework" +"568","lcd" +"568","cgimage" +"568","parse-error" +"568","beamer" +"567","eclipse-adt" +"567","union-types" +"567","jsplumb" +"567","aptana3" +"567","formview" +"567","http-referer" +"567","response-headers" +"567","usb-drive" +"567","sts-springsourcetoolsuite" +"567","ascx" +"567","quartus" +"567","spark-java" +"566","react-native-reanimated" +"566","watchdog" +"566","android-windowmanager" +"566","nsdatecomponents" +"566","normalize" +"565","yaxis" +"565","adfs2.0" +"565","waveform" +"565","calloc" +"565","mac-catalyst" +"565","spring-xd" +"565","contiki" +"565","shibboleth" +"565","idl" +"564","closest" +"564","marklogic-8" +"564","claims" +"564","jcarousel" +"564","doc2vec" +"564","apple-tv" +"564","delphi-10.2-tokyo" +"564","uefi" +"564","outlook-2007" +"564","xamarin.uwp" +"564","ios15" +"564","user32" +"564","presentmodalviewcontroller" +"564","customvalidator" +"563","gridextra" +"563","full-text-indexing" +"563","cardlayout" +"563","key-value-store" +"563","opencart-3" +"563","htmx" +"563","gecko" +"563","nixos" +"562","oxyplot" +"562","days" +"562","freeradius" +"562","error-code" +"562","nsnumberformatter" +"562","bnf" +"562","revert" +"562","asmack" +"562","sonatype" +"561","xterm" +"561","bi-publisher" +"561","universal-analytics" +"561","sinch" +"561","opayo" +"561","postgresql-11" +"561","android-geofence" +"561","android-jobscheduler" +"560","matomo" +"560","lnk2019" +"560","template-literals" +"560","phpbb" +"560","loadlibrary" +"560","python-os" +"560","libvirt" +"560","coldfusion-11" +"560","codepen" +"560","accessibilityservice" +"560","avaudioengine" +"559","decoder" +"559","procedural-generation" +"559","mapply" +"559","python-requests-html" +"559","reader" +"559","information-schema" +"559","referenceerror" +"559","google-dfp" +"559","chain" +"559","proto" +"559","bazaar" +"559","particle-system" +"558","apache-beam-io" +"558","python-social-auth" +"558","findviewbyid" +"558","ngxs" +"558","intern" +"558","createelement" +"558","googlebot" +"558","expander" +"558","google-pagespeed" +"558","msysgit" +"557","ddos" +"557","delphi-10.3-rio" +"557","dosbox" +"557","audio-processing" +"557","cad" +"557","itemtemplate" +"557","http-status-code-405" +"557","git-tag" +"557","sox" +"557","dafny" +"556","temp" +"556","apache-httpcomponents" +"556","dynamics-crm-2015" +"556","spring-boot-maven-plugin" +"556","android-instant-apps" +"556","qimage" +"556","mediatr" +"556","subsonic3" +"556","preg-split" +"555","next.js14" +"555","blackberry-webworks" +"555","jqgrid-asp.net" +"555","free-jqgrid" +"555","convex-hull" +"555","perfect-forwarding" +"554","rule" +"554","avplayerviewcontroller" +"554","mixpanel" +"554","numpy-slicing" +"554","mockk" +"553","dbscan" +"553","localstack" +"553","vtiger" +"553","mysql-connector-python" +"553","nas" +"553","middleman" +"553","winrm" +"552","functional-dependencies" +"552","image-size" +"552","dml" +"552","aws-sdk-nodejs" +"552","uiaccessibility" +"552","fortran77" +"552","dpkg" +"552","openmdao" +"552","http-delete" +"552","tox" +"552","parcel" +"551","remix.run" +"551","angular-material-table" +"551","crypt" +"551","nomethoderror" +"551","prerender" +"551","bigtable" +"550","fillna" +"550","nsscrollview" +"550","domparser" +"550","javaagents" +"550","moshi" +"550","heapsort" +"550","git-subtree" +"550","maxlength" +"549","jbehave" +"549","jboss-eap-6" +"549","divide-by-zero" +"549","fsm" +"549","flatmap" +"549","aws-java-sdk" +"549","namedtuple" +"549","hittest" +"549","change-password" +"549","chainlink" +"548","xvfb" +"548","floating-point-precision" +"548","contactscontract" +"548","fullcalendar-4" +"548","kie" +"548","tap" +"548","xbee" +"548","contravariance" +"548","exceljs" +"548","spf" +"548","get-childitem" +"548","specs2" +"548","use-ref" +"547","jcrop" +"547","yarn-workspaces" +"547","git-fork" +"547","adhoc" +"547","ftps" +"547","sharepoint-list" +"547","karaf" +"547","rgba" +"547","git-merge-conflict" +"546","ghost-blog" +"546","jspm" +"546","upstart" +"546","delphi-xe4" +"546","bugzilla" +"546","macos-carbon" +"546","mockery" +"546","ios-frameworks" +"546","angularjs-e2e" +"546","resume" +"546","google-font-api" +"546","http-status-code-503" +"546","maven-shade-plugin" +"546","spannablestring" +"545","addsubview" +"545","adobe-brackets" +"545","gql" +"545","android-video-player" +"545","wmi-query" +"545","continuations" +"545","talkback" +"545","google-people-api" +"544","voronoi" +"544","undertow" +"544","recursive-datastructures" +"544","gs-conditional-formatting" +"544","type-providers" +"544","fractals" +"544","exist-db" +"544","nivo-slider" +"544","glsurfaceview" +"543","tee" +"543","python-click" +"543","nexus3" +"543","unresolved-external" +"543","ruby-on-rails-5.2" +"543","qtgui" +"542","reactor-netty" +"542","graphdb" +"542","mutate" +"542","discriminated-union" +"542","smartsheet-api" +"542","rm" +"542","infix-notation" +"542","podio" +"542","angular-google-maps" +"542","std-ranges" +"542","powercli" +"541","github-flavored-markdown" +"541","staging" +"541","jql" +"541","mixed-integer-programming" +"541","netstat" +"541","uiprogressview" +"540","apache-commons-httpclient" +"540","file-management" +"540","id3" +"540","watson" +"540","android-12" +"540","qwebview" +"540","azure-sql-server" +"540","user-management" +"539","teradata-sql-assistant" +"539","discord-jda" +"539","configmap" +"539","aws-opsworks" +"539","readr" +"539","ros2" +"539","auc" +"539","esper" +"539","uvm" +"539","avaloniaui" +"539","multi-level" +"538","temporary" +"538","playframework-2.4" +"538","graalvm-native-image" +"538","cross-join" +"538","upnp" +"538","jmespath" +"538","svelte-component" +"538","ports" +"538","android-sharedpreferences" +"538","seek" +"537","federated-identity" +"537","jsonserializer" +"537","sequences" +"537","amd-processor" +"537","udf" +"537","atmosphere" +"537","scalar" +"537","butterknife" +"537","alm" +"537","stemming" +"537","msal.js" +"536","appharbor" +"536","jsondecoder" +"536","sencha-cmd" +"536","keystroke" +"536","type-parameter" +"536","android-install-apk" +"536","azure-policy" +"536","httpconnection" +"536","android-paging" +"535","ps" +"535","wakelock" +"535","aws-sam-cli" +"535","azure-authentication" +"535","nssortdescriptor" +"535","nsbutton" +"535","supervised-learning" +"535","outlook-redemption" +"535","3g" +"535","minimization" +"535","razorpay" +"535","strcat" +"534","sslhandshakeexception" +"534","python-behave" +"534","approximation" +"534","jquery-waypoints" +"534","fpm" +"534","hidden-markov-models" +"534","uiswipegesturerecognizer" +"534","pytube" +"534","responsive-images" +"534","amazon-product-api" +"533","dblink" +"533","fixed-point" +"533","spring-mybatis" +"533","nsarraycontroller" +"533","saucelabs" +"533","java-websocket" +"533","non-static" +"533","itk" +"533","taxonomy-terms" +"533","autorotate" +"533","array.prototype.map" +"533","qtreewidget" +"533","steam-web-api" +"532","remember-me" +"532","freetype" +"532","selectlist" +"532","aiogram" +"532","csr" +"532","critical-section" +"532","doctrine-odm" +"532","sapb1" +"532","dropdownbox" +"532","gdata-api" +"532","android-instrumentation" +"532","columnsorting" +"532","powershell-core" +"532","parameterized" +"532","prefetch" +"531","fileapi" +"531","openembedded" +"531","google-chrome-os" +"531",".htpasswd" +"531","hhvm" +"531","hal" +"530","gremlin-server" +"530","pg-promise" +"530","jeditorpane" +"530","swipe-gesture" +"530","manytomanyfield" +"530","angularjs-ng-model" +"530","google-closure" +"530","anagram" +"530",".net-maui" +"530","virtual-directory" +"530","gutenberg-blocks" +"530","geopy" +"529","matlab-deployment" +"529","ng2-charts" +"529","apostrophe-cms" +"529","watson-assistant" +"529","docusaurus" +"529","portaudio" +"529","opendaylight" +"529","boolean-operations" +"529","java-platform-module-system" +"529","dozer" +"529","sqlclient" +"529","static-site" +"529","line-endings" +"528","data-synchronization" +"528","pagespeed-insights" +"528","softmax" +"528","cakephp-4.x" +"528","couchbase-lite" +"528","boilerplate" +"528","onkeydown" +"528","rad" +"528","iphone-privateapi" +"528","monolog" +"528","specialization" +"528","http-caching" +"528","steganography" +"527","clpfd" +"527","consistency" +"527","ng-show" +"527","react-virtualized" +"527","css-loader" +"527","blogdown" +"527","openframeworks" +"527","gt" +"527","apriori" +"527","homography" +"527","angular13" +"527","presentviewcontroller" +"527","querying" +"526","relational" +"526","unreal-blueprint" +"526","canopy" +"526","jprofiler" +"526","sbt-assembly" +"526","uiapplicationdelegate" +"526","android-pay" +"526","requirements" +"526","mouseleave" +"526","email-verification" +"526","enable-if" +"526","avassetwriter" +"526","shellexecute" +"525","fieldset" +"525","in-app-subscription" +"525","simple-framework" +"525","virtuoso" +"525","android-browser" +"525","asio" +"525","timber" +"524","webrick" +"524","cifilter" +"524","avi" +"524","spring-cloud-stream-binder-kafka" +"524","save-as" +"524","stateless" +"524","git-reset" +"523","backbone.js-collections" +"523","catalyst" +"523","chef-solo" +"523","unlink" +"523","revit" +"523","plm" +"523","collada" +"523","qooxdoo" +"523","odoo-15" +"523","userdefaults" +"523","powershell-ise" +"523","emacs24" +"523","asana" +"522","ime" +"522","data-preprocessing" +"522","named-query" +"522","pycaffe" +"522","pattern-recognition" +"522","libavcodec" +"522","pymc" +"522","dsc" +"522","express-checkout" +"522","nmake" +"522","seeding" +"522","quartz" +"521","php-5.5" +"521","size-classes" +"521","unique-key" +"521","marathon" +"521","ngresource" +"521","chm" +"521","read.csv" +"521","icecast" +"521","fallback" +"521","bsd" +"521","koin" +"521","knife" +"521","qmainwindow" +"521","acts-as-taggable-on" +"520","fuelphp" +"520","snackbar" +"520","celerybeat" +"520","pdftk" +"520","redux-persist" +"520","scorm" +"520","event-tracking" +"520","google-directions-api" +"520","collaboration" +"519","fckeditor" +"519","prime-factoring" +"519","file-access" +"519","animate.css" +"519","kiosk-mode" +"519","scene2d" +"519","mobilefirst-adapters" +"519","google-drive-realtime-api" +"519","persistence.xml" +"519","scriptmanager" +"519","static-cast" +"519","heroku-toolbelt" +"518","php-7.1" +"518","react-scripts" +"518","cmis" +"518","psychopy" +"518","iokit" +"518","errorbar" +"518","neo4j-ogm" +"518","lwc" +"518","dspace" +"518","nunjucks" +"518","google-cloud-sdk" +"518","cytoscape" +"517","process.start" +"517","stack-navigator" +"517","flex-spark" +"517","datagridviewcolumn" +"517","worklight-adapters" +"517","device-orientation" +"517","memgraphdb" +"517","user-data" +"517","stereo-3d" +"516","product-variations" +"516","unauthorized" +"516","ad-hoc-distribution" +"516","kendo-treeview" +"516","keycloak-rest-api" +"516","canvasjs" +"516","jquery-select2-4" +"516","bpf" +"516","html5-appcache" +"516","spring-data-neo4j-4" +"516","artifacts" +"515","client-side-validation" +"515","after-effects" +"515","fuzzywuzzy" +"515","smsmanager" +"515","python-sockets" +"515","suse" +"515","browser-detection" +"515","tabindex" +"515","cookbook" +"515","diagnostics" +"515","hibernate-annotations" +"515","geotiff" +"515","stretch" +"515","gestures" +"515","ogg" +"515","huggingface-tokenizers" +"514","instances" +"514","ts-node" +"514","invalidoperationexception" +"514","post-build-event" +"514","knockout-validation" +"514","period" +"514","nlme" +"514","reactivemongo" +"514","meson-build" +"514","accountmanager" +"514","actix-web" +"513","php-7.4" +"513","datasnap" +"513","disable" +"513","windows-firewall" +"513","eas" +"513","domain-name" +"513","open-liberty" +"513","electron-packager" +"513","geography" +"512","whmcs" +"512","jsonlite" +"512","sequelize-cli" +"512","systemctl" +"512","microsoft-graph-mail" +"512","f2py" +"512","tmap" +"512","pnpm" +"512","hl7" +"512","memset" +"512","laravel-migrations" +"512","ipod" +"512","cgpoint" +"512","pre-trained-model" +"511","clustered-index" +"511","jeditable" +"511","blackberry-eclipse-plugin" +"511","owl-api" +"511","unobtrusive-javascript" +"511","fastreport" +"511","kiosk" +"511","bluetooth-gatt" +"511","mirth" +"511","pfquery" +"511","qnx" +"511","git-revert" +"511","measurement" +"511","suitecrm" +"510","react-router-redux" +"510","pkcs#7" +"510","symfony6" +"510","dkim" +"510","roku" +"510","rocksdb" +"510","nsindexpath" +"510","springdoc" +"510","rapidminer" +"510","odeint" +"510","eslintrc" +"510","spectrogram" +"510","autostart" +"509","python-class" +"509","microbenchmark" +"509","mongomapper" +"509","wordpress-shortcode" +"509","viewer" +"509","nunit-3.0" +"509","android-imagebutton" +"509","playwright-python" +"509","c#-7.0" +"509","autodesk-bim360" +"508","fbx" +"508","edi" +"508","fullcalendar-scheduler" +"508","readlines" +"508","databricks-sql" +"508","virus" +"508","pylance" +"508","tableadapter" +"508","tire" +"508","qpixmap" +"508","angular2-components" +"508","requiredfieldvalidator" +"508","gitpython" +"507","pjax" +"507","date-fns" +"507","udev" +"507","issue-tracking" +"507","textcolor" +"507","user-registration" +"507","msys" +"506","mars-simulator" +"506","group-policy" +"506","matrix-inverse" +"506","where-in" +"506","algebraic-data-types" +"506","annotate" +"506","android-viewbinding" +"506","savon" +"506","viewgroup" +"506","business-rules" +"506","timestamp-with-timezone" +"506","tableofcontents" +"506","qt-signals" +"505","whenever" +"505","playframework-2.5" +"505","working-directory" +"505","dropzone" +"505","angular14" +"504","jks" +"504","meteor-autoform" +"504","dynamic-allocation" +"504","coefficients" +"504","regedit" +"504","android-ffmpeg" +"504","gemfire" +"504","screen-rotation" +"504","react-datepicker" +"504","google-identity" +"503","cntk" +"503","date-parsing" +"503","saga" +"503","csrf-token" +"503","infrastructure-as-code" +"503","delphi-xe6" +"503","pde" +"503","navigationcontroller" +"503","osb" +"503","openiddict" +"502","ant-design-pro" +"502","dateadd" +"502","ado.net-entity-data-model" +"502","uploading" +"502","cakephp-model" +"502","wave" +"502","angularjs-material" +"502","descriptor" +"502","os.path" +"502","buffering" +"502","libgit2sharp" +"502","tablecellrenderer" +"502","raw-sockets" +"502","android-cursorloader" +"502","gesturedetector" +"502","office365-apps" +"502","mpi4py" +"502","stdclass" +"501","manpage" +"501","admin-on-rest" +"501","cck" +"501","unsatisfiedlinkerror" +"501","ajax4jsf" +"501","fasterxml" +"501","gs-vlookup" +"501","mod-security" +"501","synonym" +"501","shap" +"501","dotnet-cli" +"501","color-space" +"501","flutter-plugin" +"501","static-code-analysis" +"501","email-templates" +"500","multipeer-connectivity" +"500","ef-core-2.1" +"500","eclipse-emf" +"500","phabricator" +"500","x-frame-options" +"500","apostrophe" +"500","sendgrid-api-v3" +"500","wsimport" +"500","rdfs" +"500","toggleclass" +"500","polly" +"500","peoplesoft" +"500","prepend" +"499","television" +"499","multiplatform" +"499","json-server" +"499","ruamel.yaml" +"499","onfocus" +"499","cox-regression" +"499","coupon" +"499","viewpagerindicator" +"499","dokku" +"499","strace" +"499","zurb-foundation-6" +"499","httplistener" +"499","asciidoc" +"499","searchkick" +"499","bidirectional" +"498","react-native-web" +"498","fltk" +"498","dealloc" +"498","friendly-id" +"498","dataprovider" +"498","mgcv" +"498","invisible" +"498","r-factor" +"498","reticulate" +"498","sprite-sheet" +"498","asp.net-mvc-viewmodel" +"498","mcmc" +"498","fog" +"498","autosize" +"497","nextcloud" +"497","pulumi" +"497","psutil" +"497","ndef" +"497","writefile" +"497","cocoon-gem" +"497","levels" +"497","sql-server-agent" +"497","tablelayoutpanel" +"497","stateful" +"497","compiler-flags" +"496","tshark" +"496","ng-file-upload" +"496","pkg-config" +"496","jss" +"496","django-sessions" +"496","pci" +"496","delaunay" +"496","domxpath" +"496","android-annotations" +"496","formgroups" +"496","type-systems" +"496","np" +"496","actionview" +"496","spotipy" +"496","angular17" +"496","bho" +"496","artifact" +"496","tikz" +"495","skiasharp" +"495","kurento" +"495","facebook-prophet" +"495","aws-dms" +"495","t-test" +"495","modelstate" +"495","libtool" +"495","refinerycms" +"495","mjpeg" +"494","basex" +"494","fgetcsv" +"494","page-break" +"494","rcharts" +"494","rdl" +"494","android-billing" +"494","uirefreshcontrol" +"494","google-text-to-speech" +"493","xmlwriter" +"493","akka-cluster" +"493","ruby-1.9.3" +"493","android-snackbar" +"493","code-signing-certificate" +"493","bubble-chart" +"493","java-3d" +"493","assimp" +"493","health-monitoring" +"493","having-clause" +"492","intel-fpga" +"492","function-declaration" +"492","wchar-t" +"492","joystick" +"492","angular-meteor" +"492","gstreamer-1.0" +"492","pdfminer" +"492","delphi-xe8" +"492","azure-webjobssdk" +"492","reduction" +"492","nvarchar" +"492","tizen-web-app" +"492","strict" +"492","google-earth-plugin" +"492","custom-font" +"492","berkeley-db" +"492","theorem-proving" +"491","separation-of-concerns" +"491","jprogressbar" +"491","coverage.py" +"491","two-factor-authentication" +"491","rate" +"491","lucee" +"491","normals" +"491","drop" +"491","history.js" +"491","angular2-changedetection" +"490","unity3d-2dtools" +"490","chrome-web-store" +"490","plaintext" +"490","blackberry-jde" +"490","pager" +"490","agent-based-modeling" +"490","mongodb-compass" +"490","swagger-editor" +"490","buildpack" +"490","javacc" +"490","number-theory" +"490","scipy-optimize-minimize" +"490","resizable" +"490","heap-dump" +"489","relational-division" +"489","pkcs#12" +"489","magrittr" +"489","objdump" +"489","poltergeist" +"489","stringbuffer" +"489","stroke" +"488","dcg" +"488","cascadingdropdown" +"488","symfony-3.3" +"488","icommand" +"488","pwm" +"488","eps" +"488","8051" +"488","form-control" +"488","objectid" +"488","npm-package" +"488","elasticsearch-painless" +"488","shebang" +"487","candlestick-chart" +"487","fault" +"487","document.write" +"487","desktop-bridge" +"487","android-studio-2.2" +"487","twincat" +"487","pysnmp" +"487","point-of-sale" +"487","numerical" +"487","cstring" +"487","estimation" +"487","dacpac" +"487","msvcrt" +"486","grok" +"486","ggvis" +"486","slick-3.0" +"486","mamp-pro" +"486","survival" +"486","libc++" +"486","winui" +"486","game-loop" +"486","dreamhost" +"486","uiapplication" +"486","jags" +"486","project-structure" +"486","flutter-packages" +"486","usbserial" +"485","ecmascript-2016" +"485","grizzly" +"485","paas" +"485","xmlnode" +"485","spring-retry" +"485","hot-reload" +"485","azure-devops-extensions" +"485","brightness" +"485","asp.net-authorization" +"485","node-mongodb-native" +"485","perceptron" +"485","hubspot" +"485","tidyeval" +"485","mechanicalturk" +"484","primeng-datatable" +"484","truststore" +"484","addthis" +"484","data-augmentation" +"484","microprocessors" +"484","ring" +"484","android-2.3-gingerbread" +"484","rails-postgresql" +"484","gearman" +"484","higher-order-components" +"484","persistent-storage" +"483","slideup" +"483","jdom" +"483","processing.js" +"483","jenkins-declarative-pipeline" +"483","weighted-average" +"483","xssf" +"483","jcl" +"483","laravel-dusk" +"483","android-sdk-manager" +"483","ocmock" +"483","digital-certificate" +"483","loopback4" +"483","quantization" +"482","vue-props" +"482","jmsserializerbundle" +"482","onkeyup" +"482","android-sdk-2.3" +"482","gtk2" +"482","jquery-dialog" +"482","infinity" +"482","doparallel" +"482","side-effects" +"482","legacy-code" +"482","iterable-unpacking" +"482","ceph" +"482","qtwebengine" +"481","babylonjs" +"481","laravel-cashier" +"481","fasttext" +"481","dna-sequence" +"481","opcode" +"481","wordpress-plugin-creation" +"481","mismatch" +"481","itemrenderer" +"481","eve" +"481","euler-angles" +"481","etcd" +"481","evaluate" +"481","flutter-sliver" +"481","autobahn" +"480","dll-injection" +"480","dock" +"480","dynamic-library" +"480","turing-machines" +"480","twebbrowser" +"480","pyopenssl" +"480","format-specifiers" +"480","jaws-screen-reader" +"480","memory-efficient" +"480","passbook" +"480","google-polyline" +"480","heap-corruption" +"479","flood-fill" +"479","nsdocument" +"479","mondrian" +"479","inverse" +"479","boundary" +"479","suspend" +"479","ripple" +"479","express-handlebars" +"479","executor" +"479","spark-graphx" +"479","dart-html" +"479","static-assert" +"478","reindex" +"478","ftdi" +"478","sharp" +"478","famo.us" +"478","denormalization" +"478","mojarra" +"478","pong" +"478","sieve-of-eratosthenes" +"478","outline" +"478","asp.net-mvc-5.2" +"478","rails-activejob" +"478","textselection" +"478","genexus" +"478","qdialog" +"478","power-management" +"477","eclipse-kepler" +"477","data-storage" +"477","pam" +"477","aws-documentdb" +"477","inputbox" +"477","rascal" +"477","vertices" +"477","google-slides" +"476","sqlxml" +"476","app-engine-flexible" +"476","python-mock" +"476","unnest" +"476","nsnotifications" +"476","magento-1.6" +"476","express-validator" +"476","abstract-data-type" +"476","sqlite-net" +"476","autodoc" +"476","il" +"475","filechooser" +"475","class-variables" +"475","multiprocess" +"475","chromebook" +"475","meteorite" +"475","google-tv" +"475","nested-routes" +"475","building" +"475","orc" +"475","revision" +"475","mitmproxy" +"475","ui-grid" +"475","screensaver" +"475","gem5" +"475","tokbox" +"475","memory-model" +"475","monkeyrunner" +"475","flutter-go-router" +"474","yolov8" +"474","marklogic-9" +"474","page-lifecycle" +"474","jsrender" +"474","carthage" +"474","ruby-on-rails-4.1" +"474","ruby-2.0" +"474","jquery-tools" +"474","aapt" +"474","short-circuiting" +"474","stun" +"474","precompile" +"473","opl" +"473","ptrace" +"473","pci-e" +"473","java-ee-8" +"473","fork-join" +"473","mac-app-store" +"473","nettcpbinding" +"473","largenumber" +"473","last-modified" +"473","rerender" +"473","start-activity" +"472","weekday" +"472","eclipse-pde" +"472","matcher" +"472","multimedia" +"472","blackjack" +"472","createfile" +"472","k3s" +"472","samesite" +"472","typo3-10.x" +"472","presentation" +"472","alpha-transparency" +"472","zend-studio" +"471","file-manager" +"471","catia" +"471","checkedlistbox" +"471","rubocop" +"471","hstore" +"471","dyld" +"471","hsv" +"471","f#-interactive" +"471","dialogfragment" +"471","reference-counting" +"471","react-google-maps" +"471","zendesk" +"470","mathml" +"470","matlab-compiler" +"470","slash" +"470","fixed-width" +"470","smpp" +"470","manim" +"470","imessage" +"470","htmlspecialchars" +"470","sha512" +"470","asp.net-apicontroller" +"470","poker" +"470","polygons" +"470","react-final-form" +"470","submission" +"470","statements" +"470","linker-scripts" +"469","intercept" +"469","imaging" +"469","capybara-webkit" +"469","ucanaccess" +"469","vgg-net" +"469","ipod-touch" +"469","amazon-data-pipeline" +"469","mrtk" +"468","eclipse-luna" +"468","git-filter-branch" +"468","ssrs-2016" +"468","jsessionid" +"468","imagepicker" +"468","confirmation" +"468","kdtree" +"468","internet-connection" +"468","onelogin" +"468","macos-monterey" +"468","caanimation" +"468","azure-static-web-app" +"468","strophe" +"468","google-cloud-datalab" +"468","pytorch-dataloader" +"468","use-reducer" +"467","anychart" +"467","grails-controller" +"467","angularjs-ng-include" +"467","input-field" +"467","code-splitting" +"467","jackson2" +"467","gauge" +"467","mobilefirst-server" +"467","game-maker" +"467","cfc" +"467","spatstat" +"467","autofocus" +"466","webpack-style-loader" +"466","localtime" +"466","data-retrieval" +"466","postman-collection-runner" +"466","openresty" +"466","laravel-queue" +"466","queryselector" +"466","su" +"465","laravel-filament" +"465","pandas-datareader" +"465","jsr223" +"465","openerp-8" +"464","skmaps" +"464","map-projections" +"464","cherry-pick" +"464","django-middleware" +"464","rss-reader" +"464","facebook-wall" +"464","onpause" +"464","blowfish" +"464","codepages" +"464","dotnetzip" +"463","ddd-repositories" +"463","clisp" +"463","apache-spark-2.0" +"463","hour" +"463","frama-c" +"463","redundancy" +"463","geckofx" +"463","dimensional-modeling" +"463","nodatime" +"463","react-chartjs-2" +"463","haskell-lens" +"463","google-slides-api" +"462","fedex" +"462","xquery-sql" +"462","plantuml" +"462","wallet" +"462","mezzanine" +"462","depth-buffer" +"462","intervention" +"462","writer" +"462","spring-scheduled" +"462","motionevent" +"462","react-highcharts" +"462","layoutparams" +"462","precompiled-headers" +"462","foreman" +"461","cbind" +"461","managed-c++" +"461","html-webpack-plugin" +"461","portrait" +"461","pocketsphinx" +"461","excel-charts" +"460","feature-engineering" +"460","integer-arithmetic" +"460","ngx-datatable" +"460","nextflow" +"460","uniq" +"460","urldecode" +"460","django-import-export" +"460","pure-virtual" +"460","intl" +"460","bootbox" +"460","erc20" +"460","rdflib" +"460","cockroachdb" +"460","asynccallback" +"460","download-manager" +"460","hoisting" +"460","sqldependency" +"460","android-intentservice" +"460","nswag" +"460","commandbutton" +"460","testcomplete" +"460","actionresult" +"460","linear-interpolation" +"460","iif" +"460","folding" +"459","graphic" +"459","filehelpers" +"459","wildcard-subdomain" +"459","calc" +"459","razor-2" +"459","mink" +"459","letter" +"459","nstask" +"459","logrotate" +"459","android-keypad" +"459","ios16" +"459","etw" +"459","laravel-jetstream" +"459","google-smart-home" +"458","pry" +"458","supabase-database" +"458","attached-properties" +"458","tabitem" +"458","today-extension" +"458","scheduledexecutorservice" +"458","openni" +"458","lasso-regression" +"458","proximity" +"458","electron-forge" +"457","ffprobe" +"457","clang-tidy" +"457","django-tests" +"457","aws-batch" +"457","dynamics-crm-365" +"457","blockingqueue" +"457","playwright-test" +"457","okta-api" +"457","lightbox2" +"457","userid" +"456","content-disposition" +"456","froala" +"456","cancancan" +"456","windows-sharepoint-services" +"456","recipe" +"456","native-code" +"456","aggregateroot" +"456","boost-serialization" +"456","kafka-python" +"456","net-http" +"456","extentreports" +"456","google-cloud-data-fusion" +"456","q-learning" +"456","google-container-registry" +"456","nightmare" +"455","phasset" +"455","phpbb3" +"455","catalog" +"455","castle-activerecord" +"455","doctest" +"455","service-reference" +"455","scaffold" +"455","visualsvn" +"455","directions" +"455","nodelist" +"455","monotouch.dialog" +"455","node-fetch" +"455","darknet" +"455","zipkin" +"454","date-difference" +"454","pan" +"454","json4s" +"454","unordered-set" +"454","android-developer-api" +"454","oledbcommand" +"454","android-layout-weight" +"454","google-fonts" +"454","google-openid" +"453","in-memory" +"453","jxl" +"452","jconsole" +"452","mvcsitemapprovider" +"452","selectors-api" +"452","airplay" +"452","creation" +"452","optionmenu" +"452","country" +"452","entry-point" +"452","aql" +"452","atg" +"452","fragmenttransaction" +"452","esp-idf" +"452","angular-formly" +"452","angular-flex-layout" +"452","cgpath" +"452","touchesbegan" +"452","array-map" +"451","jboss-eap-7" +"451","mysql-5.6" +"451","punctuation" +"451","viewchild" +"451","visual-studio-addins" +"451","netflix" +"451","azure-openai" +"451","radius" +"451","elastic-map-reduce" +"451","speech-synthesis" +"451","stm32cubeide" +"451","stdarray" +"451","pre-commit" +"451","gmt" +"450","ddev" +"450","window-managers" +"450","single-responsibility-principle" +"450","recurring-billing" +"450","pdi" +"450","azure-cdn" +"450","azure-cosmosdb-mongoapi" +"450","ws-federation" +"450","corrupt" +"450","ionic-view" +"450","wix3.7" +"450","android-graphview" +"450","azure-functions-runtime" +"450","tls1.3" +"450","locks" +"450","peerjs" +"450","centos8" +"450","mediator" +"450","mbed" +"450","linode" +"450","google-mirror-api" +"449","frp" +"449","filepicker" +"449","simulate" +"449","vbulletin" +"449","uistatusbar" +"449","uiappearance" +"449","v4l2" +"448","maven-archetype" +"448","gravityforms" +"448","ssis-2008" +"448","sharekit" +"448","react-spring" +"448","fat-free-framework" +"448","vibration" +"448","rasa-core" +"448","strong-typing" +"447","finalizer" +"447","rpart" +"447","intune" +"447","application.properties" +"447","easyadmin" +"447","radgridview" +"447","sceneform" +"447","sql-scripts" +"447","android-motionlayout" +"447","parallels" +"447","font-awesome-5" +"446","anomaly-detection" +"446","locationlistener" +"446","shared-element-transition" +"446","alerts" +"446","rollover" +"446","crashlytics-android" +"446","monetdb" +"446","visual-c++-6" +"446","nullable-reference-types" +"446","openxlsx" +"446","angularjs-factory" +"446","getopts" +"446","using-statement" +"446","google-nativeclient" +"445","adminlte" +"445","vs-extensibility" +"445","kubernetes-secrets" +"445","formidable" +"445",".net-4.6" +"445","visual-web-developer" +"445","libjpeg" +"445","azure-queues" +"445","xcode13" +"445","asp.net-webpages" +"445","esbuild" +"445","event-bus" +"445","preference" +"445","health-check" +"444","anti-patterns" +"444","nameservers" +"444","jradiobutton" +"444","ota" +"444","office-scripts" +"444","node.js-connect" +"444","testng-dataprovider" +"444","partial-classes" +"444","compojure" +"443","react-pdf" +"443","python-dateutil" +"443","kubeflow" +"443","aws-elasticsearch" +"443","sessionfactory" +"443","jqtouch" +"443","luajit" +"443","rasterio" +"443","rails-console" +"443","mesosphere" +"443","google-cloud-monitoring" +"443","automl" +"443","haxm" +"443","alt" +"443","powerbi-custom-visuals" +"443","mshtml" +"442","programmatically-created" +"442","roi" +"442","aws-msk" +"442","windows-scripting" +"442","pbkdf2" +"442","dust.js" +"442","hotchocolate" +"442","sasl" +"442","minizinc" +"442","bridge" +"442","syntactic-sugar" +"442","timeoutexception" +"442","garbage" +"442","uicontrol" +"442","railo" +"442","com+" +"442","message-driven-bean" +"442","linkbutton" +"442","sub-array" +"441","interactive-brokers" +"441","slidingdrawer" +"441","fips" +"441","voxel" +"441","metatrader4" +"441","pty" +"441","error-reporting" +"441","bug-tracking" +"441","ratingbar" +"441","lemmatization" +"441","xcode4.6" +"441","tabpanel" +"441","sqldataadapter" +"441","officer" +"441","vaadin-grid" +"441","google-play-developer-api" +"440","react-navigation-bottom-tab" +"440","termux" +"440","fluent-interface" +"440","decimal-point" +"440","try-catch-finally" +"440","slot" +"440","function-templates" +"440","pundit" +"440","android-screen-support" +"440","google-account" +"440","legend-properties" +"440","aspect" +"440","google-finance" +"440","monit" +"440","chart.js2" +"440","zipcode" +"440","avatar" +"440","zend-db-table" +"439","mxgraph" +"439","clearcase-ucm" +"439","kubernetes-service" +"439","calibration" +"439","hp-quality-center" +"439","diffie-hellman" +"439","requestfactory" +"439","zedgraph" +"439","solidworks" +"439","stdtuple" +"438","keyvaluepair" +"438","kendo-chart" +"438","optimistic-locking" +"438","grpc-python" +"438","htmlwidgets" +"438","appstore-sandbox" +"438","sapi" +"438","rigid-bodies" +"438","synthesis" +"438","ampersand" +"438","go-ethereum" +"438","setfocus" +"438","dir" +"438","androiddesignsupport" +"438","digest" +"438","opengl-4" +"438","continuous" +"438","esxi" +"438","web-analytics" +"438","haversine" +"438","lidar" +"437","greatest-common-divisor" +"437","dispatch-async" +"437","modelmapper" +"437","ns-3" +"437","atoi" +"437","v-model" +"437","retry-logic" +"437","jaeger" +"437","sql-agent-job" +"437","preflight" +"437","tflearn" +"437","vaadin14" +"436","recyclerview-layout" +"436","hyperledger-chaincode" +"436","dask-dataframe" +"436","ringtone" +"436","misra" +"436","mirroring" +"436","ab-testing" +"436","dft" +"436","android-jetpack-compose-material3" +"436","perlin-noise" +"436","glkit" +"436","spacebars" +"435","fluent-ui" +"435","yii-components" +"435","find-occurrences" +"435","gprs" +"435","sass-loader" +"435","grunt-contrib-watch" +"435","hashlib" +"435","expansion" +"435","activexobject" +"435","bayesian-networks" +"435","bem" +"435","tpu" +"435","autodesk-designautomation" +"434","decrement" +"434","dataloader" +"434","jtds" +"434","app-router" +"434","posix-select" +"434","scala-gatling" +"434","gojs" +"434","kryo" +"434","associative" +"434","j" +"434","c++23" +"434","cursor-position" +"434","google-places-autocomplete" +"433","jce" +"433","llama" +"433","datomic" +"433","ibm-doors" +"433","oracle11gr2" +"433","jmh" +"433","azure-batch" +"433","tx-news" +"433","nested-if" +"433","ractivejs" +"433","mpeg" +"433","emf" +"433","precision-recall" +"432","skin" +"432","distributed-caching" +"432","fusedlocationproviderapi" +"432","dataadapter" +"432","angular-validation" +"432","pbs" +"432","ensemble-learning" +"432","rijndael" +"432","build-tools" +"432","setattribute" +"432","angular2-aot" +"432","custom-renderer" +"432","android-navigationview" +"432","beagleboard" +"432","gnat" +"432","autologin" +"432","embedded-database" +"431","multinomial" +"431","class-validator" +"431","transpiler" +"431","physics-engine" +"431","xml-signature" +"431","bitbucket-api" +"431","fast-ai" +"431","navision" +"431","quickcheck" +"431","office-ui-fabric" +"430","category-theory" +"430","rust-diesel" +"430","datetime-parsing" +"430","myeclipse" +"430","savechanges" +"430","pydub" +"430","objective-c-category" +"430","spy" +"430","azure-repos" +"430","motorola" +"429","fuseki" +"429","kudu" +"429","ruby-1.9" +"429","variable-length-array" +"429","derived" +"429","spring-data-r2dbc" +"429","border-layout" +"429","jvectormap" +"429","jung" +"429","typesafe-activator" +"429","minidom" +"429","rangeslider" +"429","geany" +"429","google-directory-api" +"429","spatial-query" +"429","metalkit" +"429","event-driven" +"429","text-analysis" +"429","parser-combinators" +"429","subset-sum" +"428","case-statement" +"428","xen" +"428","aes-gcm" +"428","ibm-integration-bus" +"428","django-permissions" +"428","microsoft-entra-id" +"428","mysql-json" +"428","delphi-11-alexandria" +"428","nscollectionview" +"428","virtual-inheritance" +"428","actioncontroller" +"428","movie" +"428","android-pageradapter" +"428","mdf" +"427","yodlee" +"427","floor" +"427","vs-web-site-project" +"427","vmware-workstation" +"427","disabled-input" +"427","function-composition" +"427","azure-api-apps" +"427","jquery-tabs" +"427","android-input-method" +"427","android-debug" +"427","rabbitmq-exchange" +"427","gdbserver" +"427","petapoco" +"427","gets" +"427","throughput" +"427","webgl2" +"427","asciidoctor" +"426","xmlpullparser" +"426","biztalk-2013" +"426","rtc" +"426","metro-bundler" +"426","katana" +"426","newtons-method" +"426","facebook-insights" +"426","view-helpers" +"426","angularjs-http" +"426","linphone" +"425","deeplearning4j" +"425","plane" +"425","vscode-snippets" +"425","django-apps" +"425","p2" +"425","binutils" +"425","push-back" +"425","canonical-link" +"425","hmvc" +"425","low-latency" +"425","move-constructor" +"425","tfrecord" +"425","concourse" +"425","train-test-split" +"424","backtrace" +"424","fbo" +"424","llvm-c++-api" +"424","manjaro" +"424","sentinel" +"424","mako" +"424","service-locator" +"424","wpml" +"424","internet-radio" +"424","audiotrack" +"424","newman" +"424","netfilter" +"424","winhttp" +"424","brightscript" +"424","openquery" +"424","msgpack" +"424","theming" +"423","cloudflare-workers" +"423","chunked-encoding" +"423","django-2.0" +"423","jinternalframe" +"423","google-vr" +"423","aws-lambda-layers" +"423","grpc-go" +"423","vmware-clarity" +"423","16-bit" +"423","build-system" +"423","plink" +"423","contract" +"423","python-zipfile" +"423","perspectivecamera" +"422","xpath-1.0" +"422","fseek" +"422","ccsprite" +"422","camelcasing" +"422","windows-media-player" +"422","microsoft-fakes" +"422","pdf-viewer" +"422","mod-jk" +"422","wpf-4.0" +"422","octal" +"422","frameset" +"422","javascriptserializer" +"422","motion-detection" +"422","cups" +"422","mousedown" +"422","react-dnd" +"422","startswith" +"421","gitkraken" +"421","matplotlib-animation" +"421","directshow.net" +"421","picasa" +"421","xps" +"421","rmysql" +"421","grails-3.0" +"421","kendo-mobile" +"421","spring-micrometer" +"421","nrwl" +"421","ampl" +"421","donut-chart" +"421","scip" +"421","responsiveness" +"421","login-script" +"421","quadratic" +"421","maven-dependency-plugin" +"421","stubbing" +"420","ansible-awx" +"420","vue-reactivity" +"420","undefined-symbol" +"420","circular-buffer" +"420","flash-media-server" +"420","nested-function" +"420","spring-mongodb" +"420","turbo-c++" +"420","turn" +"420","pyrocms" +"420","forgot-password" +"420","mobile-browser" +"420","uima" +"420","spinnaker" +"420","gephi" +"420","google-nearby" +"419","react-native-webview" +"419","stan" +"419","vue-chartjs" +"419","vscode-devcontainer" +"419","phylogeny" +"419","flake8" +"419","swingx" +"419","shared-objects" +"419","siri" +"419","design-time" +"419","vlcj" +"419","minesweeper" +"419","azure-vm-scale-set" +"419","dimensionality-reduction" +"419","meta-boxes" +"419","mel" +"419","bibtex" +"418","git-extensions" +"418","backbone-routing" +"418","whois" +"418","groupbox" +"418","rrdtool" +"418","spring-cloud-contract" +"418","open3d" +"418","android-service-binding" +"418","entitlements" +"418","buildpath" +"418","col" +"418","coding-efficiency" +"418","magento-soap-api" +"418","itunes-store" +"418","evolutionary-algorithm" +"418","acs" +"418","papaparse" +"418","qsqlquery" +"417","xtend" +"417","gregorian-calendar" +"417","slim-3" +"417","apache-iotdb" +"417","fbconnect" +"417","capitalization" +"417","superscript" +"417","onvif" +"417","windows-update" +"417","systems-programming" +"417","leveldb" +"417","netsh" +"417","httpcookie" +"417","message-passing" +"417","autorelease" +"417","scrollmagic" +"417","qt3d" +"417","mql5" +"417","power-bi-report-server" +"417","stimulusjs" +"416","transient" +"416","php-openssl" +"416","livecharts" +"416","language-server-protocol" +"416","python-importlib" +"416","card" +"416","varbinary" +"416","jquery-easyui" +"416","tizen-wearable-sdk" +"416","androidhttpclient" +"416","react-fullstack" +"416","getdate" +"416","text-formatting" +"415","ssrs-grouping" +"415","sqrt" +"415","git-fetch" +"415","telerik-reporting" +"415","vuetifyjs3" +"415","wcag" +"415","blueprint-osgi" +"415","svcutil.exe" +"415","output-buffering" +"415","model-fitting" +"415","xalan" +"415","mnesia" +"415","excel-tables" +"415","elevated-privileges" +"415","heidisql" +"414","django-socialauth" +"414","serverside-javascript" +"414","robo3t" +"414","keylogger" +"414","enterprise-guide" +"414","gwt2" +"414","node-streams" +"414","scnnode" +"414","drone.io" +"414","longlistselector" +"414","get-request" +"414","spread-syntax" +"414","google-drive-shared-drive" +"414","sortedlist" +"413","apache-commons-net" +"413","filehandle" +"413","yelp" +"413","fbsdk" +"413","fetchxml" +"413","squeak" +"413","fuzzy-logic" +"413","adblock" +"413","microk8s" +"413","pycuda" +"413","interprocess" +"413","azure-container-service" +"413","brush" +"413","wix3.6" +"413","asp.net-core-middleware" +"413","nsviewcontroller" +"413","uianimation" +"413","xacml" +"413","mpich" +"413","google-cloud-shell" +"413","storage-access-framework" +"413","qobject" +"413","preg-replace-callback" +"413","multi-gpu" +"413","qtip2" +"412","definitelytyped" +"412","translate-animation" +"412","bitmapdata" +"412","angular-service-worker" +"412","django-oscar" +"412","awesome-wm" +"412","htmlpurifier" +"412","worklight-server" +"412","shoutcast" +"412","xcode-instruments" +"412","table-valued-parameters" +"412","not-exists" +"412","isapi" +"412","touch-id" +"411","reminders" +"411","prisma-graphql" +"411","implements" +"411","firebreath" +"411","first-responder" +"411","python-3.11" +"411","hsm" +"411","superagent" +"411","moment-timezone" +"411","woocommerce-subscriptions" +"411","virtual-keyboard" +"411","openlayers-6" +"411","jacoco-maven-plugin" +"411","spread" +"411","computation" +"411","usort" +"411","utf8mb4" +"411","line-plot" +"410","file-association" +"410","voyager" +"410","google-webfonts" +"410","openacc" +"410","nslocalizedstring" +"410","sanitize" +"410","gedit" +"410","openrefine" +"410","haar-classifier" +"410","strongly-typed-dataset" +"410","hazelcast-imap" +"410","flying-saucer" +"410","msgbox" +"410","state-monad" +"410","url-shortener" +"409","tensorflow-federated" +"409","xpcom" +"409","laravel-elixir" +"409","uiviewanimationtransition" +"409","circe" +"409","android-search" +"409","build.xml" +"409","siddhi" +"409","knockout-3.0" +"409","hapi" +"409","cagradientlayer" +"409","qnetworkaccessmanager" +"409","email-headers" +"409","auto-indent" +"409","scriptlet" +"409","theos" +"409","zeep" +"408","eclipse-wtp" +"408","flash-message" +"408","kustomize" +"408","jmeter-4.0" +"408","awesomium" +"408","cppcheck" +"408","box2d-iphone" +"408","pytest-django" +"408","amazon-dynamodb-streams" +"408","iisnode" +"408","avalonia" +"407","maui-blazor" +"407","snakeyaml" +"407","filepicker.io" +"407","explicit" +"407","azure-runbook" +"407","protoc" +"407","node-oracledb" +"407","mongotemplate" +"407","ember-router" +"407","flutter-hive" +"406","dbplyr" +"406","ecmascript-next" +"406","divider" +"406","disconnect" +"406","rowcount" +"406","gpo" +"406","singlestore" +"406","dataimporthandler" +"406","azure-diagnostics" +"406","ambiguity" +"406","libuv" +"406","system.out" +"406","lettuce" +"406","tauri" +"406","tablemodel" +"406","dialogflow-cx" +"406","penetration-testing" +"406","quantlib" +"406","sunspot-rails" +"406","msdtc" +"405","jboss-weld" +"405","slime" +"405","gridlayoutmanager" +"405","fluent-assertions" +"405","frequency-analysis" +"405","inline-styles" +"405","audit-logging" +"405","python-webbrowser" +"405","require-once" +"405","quantum-computing" +"404","listobject" +"404","ckfinder" +"404","slicers" +"404","square-root" +"404","sirikit" +"404","cancellation-token" +"404","uno-platform" +"404","apple-sign-in" +"404","android-statusbar" +"404","attention-model" +"404","codeigniter-url" +"404","scopes" +"404","timeit" +"404","google-crawlers" +"404","forceclose" +"404","solace" +"403","xserver" +"403","github-desktop" +"403","discount" +"403","language-translation" +"403","placement-new" +"403","runge-kutta" +"403","wavelet" +"403","postal-code" +"403","type-constraints" +"403","type-alias" +"403","svg.js" +"403","java-10" +"403","shallow-copy" +"403","gadt" +"403","galera" +"403","podfile" +"403","assertj" +"403","nvidia-jetson" +"403","hwnd" +"403","quartz-core" +"402","cloud-hosting" +"402","vue-resource" +"402","multiple-select" +"402","gil" +"402","circuit-breaker" +"402","chrome-custom-tabs" +"402","opticalflow" +"402","aws-auto-scaling" +"402","inline-formset" +"402","java-security" +"402","coercion" +"402","do-loops" +"402","external-tables" +"402","showdialog" +"402","asp.net-routing" +"402","uielement" +"402","beanstalkd" +"402","pandas-styles" +"402","qtip" +"402","flutter-state" +"401","jelastic" +"401","imdb" +"401","owncloud" +"401","microsoft-graph-calendar" +"401","object-lifetime" +"401","redisson" +"401","cglib" +"401","subtotal" +"401","maven-jetty-plugin" +"401","avasset" +"400","php-5.4" +"400","backreference" +"400","react-navigation-drawer" +"400","websecurity" +"400","srand" +"400","php-ini" +"400","fluent-bit" +"400","bintray" +"400","checkin" +"400","rebus" +"400","row-level-security" +"400","keymapping" +"400","html-datalist" +"400","typeface" +"400","py-langchain" +"400","coq-tactic" +"400","sql-server-2012-express" +"400","web-essentials" +"400","conditional-rendering" +"399","xtragrid" +"399","dcom" +"399","cassandra-2.1" +"399","django-1.8" +"399","advantage-database-server" +"399","selectedvalue" +"399","configuration-management" +"399","sitecore-mvc" +"399","delphi-5" +"399","saprfc" +"399","oracle-xe" +"399","extjs6-classic" +"399","rails-geocoder" +"399","google-distancematrix-api" +"399","excel-dna" +"399","react-intl" +"399","amadeus" +"399","subform" +"399","autoboxing" +"398","xtable" +"398","sails-mongo" +"398","xmltype" +"398","opus" +"398","service-provider" +"398","in-place" +"398","twilio-programmable-chat" +"398","swashbuckle.aspnetcore" +"398","miglayout" +"398","timeserieschart" +"398","tag-helpers" +"398","tkinter-button" +"398","azure-sdk" +"398","leanback" +"398","google-cloud-automl" +"398","nodejs-server" +"398","ienumerator" +"398","autosave" +"397","smartcard-reader" +"397","srcset" +"397","pixelsense" +"397","ngmodel" +"397","cidr" +"397","chinese-locale" +"397","service-layer" +"397","venn-diagram" +"397","jfrog-cli" +"397","ruby-on-rails-5.1" +"397","mongodb-indexes" +"397","navigation-properties" +"397","direct3d11" +"397","spring-validator" +"397","tkinter-layout" +"397","uiscrollviewdelegate" +"397","stoppropagation" +"397","google-rich-snippets" +"397","arr" +"397","multibinding" +"397","hexdump" +"396","standards-compliance" +"396","lit" +"396","social-media" +"396","manual" +"396","undo-redo" +"396","ankhsvn" +"396","azure-devops-server-2019" +"396","applinks" +"396","bootstrap-multiselect" +"396","intersystems-cache" +"396","azure-analysis-services" +"396","migradoc" +"396","audiorecord" +"396","fragmentstatepageradapter" +"396","plotly-express" +"396","exiftool" +"396","r2dbc" +"396","npm-publish" +"396","spectrum" +"396","prometheus-operator" +"396","commonsware-cwac" +"396","restfb" +"396","mule-el" +"396","prestashop-1.5" +"396","emit" +"396","sdp" +"396","bgi" +"396","tiled" +"396","yq" +"395","eclipse-indigo" +"395","skinning" +"395","instant-messaging" +"395","recaptcha-v3" +"395","vendor" +"395","kernel-extension" +"395","wand" +"395","data-class" +"395","swift-extensions" +"395","springdoc-openapi-ui" +"395","ribbonx" +"395","objectbox" +"395","microsoft-test-manager" +"395","re2" +"395","tfidfvectorizer" +"395","struts2-jquery" +"395","autograd" +"394","django-1.7" +"394","lang" +"394","functools" +"394","capl" +"394","aws-xray" +"394","atk4" +"394","broker" +"394","express-graphql" +"394","mplot3d" +"394","mouseout" +"394","mono.cecil" +"394","subject" +"394","batik" +"394","zbar" +"393","lmfit" +"393","clean-urls" +"393","flume-ng" +"393","sliding" +"393","indexoutofrangeexception" +"393","filepond" +"393","alexa-voice-service" +"393","epson" +"393","pyproject.toml" +"393","dot-product" +"393","angular15" +"393","reselect" +"393","cudnn" +"393","batch-normalization" +"392","jdbi" +"392","griddb" +"392","flatbuffers" +"392","jszip" +"392","ruby-grape" +"392","pycord" +"392","apple-developer" +"392","box-shadow" +"392","powerapps-formula" +"392","postgresql-13" +"392","formal-languages" +"392","javers" +"392","android-anr-dialog" +"392","py-telegram-bot-api" +"392","egl" +"392","ios8.1" +"392","android-loadermanager" +"392","string-aggregation" +"392","webpack-encore" +"391","apache-commons-dbcp" +"391","renderpartial" +"391","laravel-3" +"391","firebase-app-check" +"391","xml-documentation" +"391","pandas-loc" +"391","method-call" +"391","spring-data-couchbase" +"391","surveymonkey" +"391","nested-sets" +"391","formal-verification" +"391","cocos2d-android" +"391","orchestration" +"391","fabric8" +"391","generic-collections" +"391","launch4j" +"390","pagedlist" +"390","role" +"390","infrastructure" +"390","devart" +"390","vim-syntax-highlighting" +"390","java-memory-model" +"390","network-analysis" +"390","nosetests" +"390","lookbehind" +"390","angular2-http" +"390","parfor" +"390","emv" +"389","mvc-mini-profiler" +"389","jmf" +"389","named" +"389","django-rest-framework-simplejwt" +"389","jquery-callback" +"389","koala" +"389","xcode15" +"389","azure-rest-api" +"389","express-jwt" +"389","subversive" +"389","tornadofx" +"389","maximize" +"388","sshd" +"388","ecmascript-2017" +"388","image-loading" +"388","fullcalendar-3" +"388","circular-list" +"388","platformio" +"388","receiver" +"388","key-value-coding" +"388","windows-mobile-6.5" +"388","error-log" +"388","jquery-ui-resizable" +"388","violin-plot" +"388","facebook-canvas" +"388","rapidjson" +"388","azure-front-door" +"388","azure-storage-queues" +"388","redraw" +"388","texas-instruments" +"388","ember-simple-auth" +"387","ssh.net" +"387","graphene-django" +"387","git-cherry-pick" +"387","socketserver" +"387","laravel-authentication" +"387","soft-delete" +"387","dm-script" +"387","doctrine-1.2" +"387","android-studio-2.3" +"387","jquery-jtable" +"387","facade" +"387","amazon-simpledb" +"387","azure-maps" +"387","cert-manager" +"387","meshlab" +"387","perl-data-structures" +"387","autoloader" +"387","authorize-attribute" +"387","gmail-addons" +"387","has-one" +"387","array-push" +"386","background-position" +"386","vstest" +"386","skew" +"386","aeson" +"386","rxtx" +"386","roleprovider" +"386","boost-geometry" +"386","twitter-streaming-api" +"386","wstring" +"386","eol" +"386","visualstatemanager" +"386","azure-iot-sdk" +"386","quarkus-panache" +"386","ascii-art" +"385","cloning" +"385","jsqmessagesviewcontroller" +"385","bipartite" +"385","fsockopen" +"385","facebook-sdk-3.0" +"385","nsset" +"385","popper.js" +"385","object-storage" +"385","code-translation" +"385","kotlin-native" +"385","digest-authentication" +"385","spring-web" +"385","nonlinear-functions" +"385","cupy" +"385","getattr" +"385","sti" +"385","autocad-plugin" +"384","xulrunner" +"384","dbix-class" +"384","directx-12" +"384","incomplete-type" +"384","singularity-container" +"384","avx512" +"384","ajv" +"384","boost-program-options" +"384","easing" +"384","dynamic-loading" +"384","enumerator" +"384","facebook-audience-network" +"384","pyobjc" +"384","ui-select" +"384","opensaml" +"384","contourf" +"384","activereports" +"384","quadtree" +"384","pre" +"384","qtabwidget" +"384","allegro" +"383","matplotlib-3d" +"383","phing" +"383","llama-index" +"383","jslider" +"383","mapr" +"383","named-parameters" +"383","data-driven-tests" +"383","k6" +"383","html-rendering" +"383","html-escape-characters" +"383","onkeypress" +"383","nerdtree" +"383","tablecell" +"383","cognos-10" +"383","typegraphql" +"383","xcode6.1" +"383","dsn" +"383","bytecode-manipulation" +"383","string-conversion" +"383","ocx" +"383","offlineapps" +"383","login-control" +"383","qsub" +"382","bixby" +"382","piecewise" +"382","catel" +"382","overpass-api" +"382","chunking" +"382","adafruit" +"382","calendarview" +"382","angular-ngselect" +"382","twitter-bootstrap-2" +"382","shoulda" +"382","redmine-plugins" +"382","podspec" +"382","test-coverage" +"382","leakcanary" +"382","usage-statistics" +"382","url-pattern" +"382","qtcore" +"381","template-haskell" +"381","youtrack" +"381","file-locking" +"381","castle" +"381","gpx" +"381","rspec3" +"381","javadb" +"381","code-documentation" +"381","exponentiation" +"381","openscenegraph" +"381","custom-lists" +"381","medical" +"380","stacked" +"380","ef-core-3.0" +"380","flash-memory" +"380","import-from-csv" +"380","python-2.5" +"380","rotational-matrices" +"380","azure-app-service-envrmnt" +"380","network-drive" +"380","radar-chart" +"380","scoring" +"380","copying" +"380","iscroll" +"380","cgridview" +"380","angular-changedetection" +"380","collectionviewsource" +"380","scrollpane" +"379","yajra-datatable" +"379","try-with-resources" +"379","blackberry-cascades" +"379","chroot" +"379","db4o" +"379","simplesamlphp" +"379","kestrel" +"379","blueprint" +"379","julia-jump" +"379","dynamics-nav" +"379","sapper" +"379","oci8" +"379","shipping-method" +"379","testthat" +"379","webos" +"378","mvc-editor-templates" +"378","jcenter" +"378","graph-traversal" +"378","react-native-paper" +"378","apl" +"378","swr" +"378","sniffing" +"378","image-stitching" +"378","dataverse" +"378","aws-amplify-cli" +"378","angular-strap" +"378","sigint" +"378","qwt" +"378","rest-assured-jsonpath" +"378","liferay-theme" +"378","autosys" +"378","zig" +"377","figma" +"377","cloudera-manager" +"377","friend-function" +"377","jxbrowser" +"377","ndk-build" +"377","deobfuscation" +"377","visual-composer" +"377","caddy" +"377","azure-rm" +"377","gams-math" +"377","cgroups" +"377","stripes" +"377","lc3" +"377","spl" +"377","argument-dependent-lookup" +"376","chown" +"376","content-length" +"376","wayland" +"376","windows-community-toolkit" +"376","nsdocumentdirectory" +"376","equivalent" +"376","easyphp" +"376","boost-interprocess" +"376","android-background" +"376","sightly" +"376","openurl" +"376","nswindowcontroller" +"376","x264" +"376","metabase" +"376","ms-release-management" +"375","jenkins-workflow" +"375","php-gd" +"375","anorm" +"375","back4app" +"375","findcontrol" +"375","plaid" +"375","frida" +"375","kubernetes-statefulset" +"375","simultaneous" +"375","nested-resources" +"375","mongoimport" +"375","asp.net-core-tag-helpers" +"375","isometric" +"375","currency-formatting" +"375","summarization" +"375","topology" +"375","starling-framework" +"375","stdbind" +"374","fluent-ffmpeg" +"374","tensorrt" +"374","smarty3" +"374","padrino" +"374","android-timepicker" +"374","facebook-iframe" +"374","null-pointer" +"374","dexie" +"374","openvino" +"374","mle" +"374","http-method" +"374","scylla" +"374","stl-algorithm" +"374","complextype" +"374","article" +"373","decoupling" +"373","hyperledger-fabric-ca" +"373","mysql-real-escape-string" +"373","darwin" +"373","doctrine-query" +"373","cross-reference" +"373","delta" +"373","google-closure-library" +"373","f#-data" +"373","pysftp" +"373","windows-terminal" +"373","objectlistview" +"373","itemssource" +"373","dimple.js" +"373","digit" +"373","mpmovieplayer" +"373","mpmusicplayercontroller" +"373","resolver" +"373","image-capture" +"373","web-deployment-project" +"373","mediastream" +"373","maven-failsafe-plugin" +"372","template-matching" +"372","directus" +"372","laravel-collection" +"372","snappy" +"372","unusernotificationcenter" +"372","pulseaudio" +"372","windows-container" +"372","jls" +"372","openflow" +"372","writetofile" +"372","audiotoolbox" +"372","azure-redis-cache" +"372","drilldown" +"372","nonce" +"372","getattribute" +"372","qfiledialog" +"372","webauthn" +"372","linked-data" +"372","yugabytedb" +"371","ef-core-6.0" +"371","interbase" +"371","catboost" +"371","apache-pulsar" +"371","sharepoint-api" +"371","aws-glue-data-catalog" +"371","psd" +"371","sifr" +"371","attributerouting" +"371",".net-1.1" +"371","dropshadow" +"371","android-deep-link" +"371","prometheus-node-exporter" +"371","activation" +"371","array-filter" +"371","idp" +"370","flink-cep" +"370","default-parameters" +"370","sentence" +"370","python-unittest.mock" +"370","indexer" +"370","packets" +"370","flashlight" +"370","django-i18n" +"370","crt" +"370","jgroups" +"370","onnxruntime" +"370","nativequery" +"370","delphi-10.4-sydney" +"370","branch-prediction" +"370","execvp" +"370","ply" +"370","css-specificity" +"370","line-numbers" +"370","star-schema" +"370","for-comprehension" +"370","solana-web3js" +"369","declarative" +"369","ssi" +"369","defaulttablemodel" +"369","sql-server-profiler" +"369","palette" +"369","binaryformatter" +"369","mandelbrot" +"369","rounding-error" +"369","windows-10-desktop" +"369","data-import" +"369","just-audio" +"369",".so" +"369","hint" +"369","plinq" +"369","azure-files" +"369","android-optionsmenu" +"369","ews-managed-api" +"369","qtquickcontrols2" +"368","gist" +"368","whoosh" +"368","render-to-texture" +"368","pimcore" +"368","swiftui-tabview" +"368","fuseesb" +"368","django-nonrel" +"368","pdftotext" +"368","android-wake-lock" +"368","nsmutableurlrequest" +"368","libevent" +"368","cocos2d-js" +"368","3-tier" +"368","3d-reconstruction" +"368","tab-completion" +"368","magento-rest-api" +"368","rails-models" +"368","regexp-substr" +"368","x-axis" +"368","generate" +"368","testunit" +"368","mtom" +"367","default-arguments" +"367","filedialog" +"367","jspdf-autotable" +"367","p4v" +"367","paginator" +"367","sencha-touch-2.1" +"367","avkit" +"367","cross-apply" +"367","django-rest-viewsets" +"367","cross-entropy" +"367","mib" +"367","signtool" +"367","nsmenu" +"367","navicat" +"367","jrubyonrails" +"367","lua-patterns" +"367","lwp" +"367","setvalue" +"367","udid" +"367","mach-o" +"367","netbeans-6.9" +"367","raml" +"367","javascript-debugger" +"367","uid" +"367","android-r8" +"367","iphone-developer-program" +"367","hevc" +"367","identity-column" +"366","kubernetes-pvc" +"366","cross-correlation" +"366","sequelize-typescript" +"366","facebook-pixel" +"366","django-validation" +"366","modifier" +"366","www-mechanize" +"366","two-way-binding" +"366","sap-basis" +"366","mongodump" +"366","google-checkout" +"366","brunch" +"366","netbeans-plugins" +"366","asp.net-mvc-scaffolding" +"366","dotnetnuke-module" +"366","openrowset" +"366","spnego" +"366","react-bootstrap-table" +"366","transcoding" +"366","image-conversion" +"366","utility" +"366","prettyphoto" +"365","jsni" +"365","cascading" +"365","single-quotes" +"365","methodology" +"365","windows-phone-8-emulator" +"365","documentum" +"365","django-template-filters" +"365","cancellationtokensource" +"365","savestate" +"365","dynamic-import" +"365","hotmail" +"365","viewbox" +"365","strstr" +"365","glpk" +"365","urlopen" +"365","scriptaculous" +"364","fileinfo" +"364","ansi-sql" +"364","xmllint" +"364","kendo-scheduler" +"364","readxl" +"364","azure-boards" +"364","hp-ux" +"364","nstimeinterval" +"364","existential-type" +"364","hibernate-5.x" +"364","textjoin" +"364","changeset" +"364","accounting" +"364","youtube-livestreaming-api" +"364","script-task" +"364","arrow-keys" +"364","ticker" +"363","vspackage" +"363","primevue" +"363","primereact" +"363","mapped-types" +"363","simpy" +"363","sbt-native-packager" +"363","jvisualvm" +"363","microsoft-translator" +"363","randomaccessfile" +"363","notifyicon" +"363","tanstackreact-query" +"363","mobile-phones" +"363","azure-load-balancer" +"363","android-memory" +"363","request-promise" +"363","conceptual" +"363","structured-data" +"363","arcmap" +"362","truncation" +"362","fakeiteasy" +"362","readme" +"362","rebuild" +"362","desire2learn" +"362","sim-card" +"362","nsight" +"362","samsung-galaxy" +"362","postgresql-8.4" +"362","expandoobject" +"362","numberpicker" +"362","c#-to-f#" +"362","collaborative-filtering" +"362","chartkick" +"362","zustand" +"362","hector" +"362","url-mapping" +"361","jmenu" +"361","reason" +"361","saving-data" +"361","visual-c++-2010" +"361","cognos-bi" +"361","android-fonts" +"361","laravel-sail" +"361","memorycache" +"361","react-animated" +"361","google-translation-api" +"361","cythonize" +"361","bignum" +"361","measurement-protocol" +"360","gitlab-ce" +"360","rust-polars" +"360","catalina" +"360","firebase-test-lab" +"360","faye" +"360","boost-filesystem" +"360","android-storage" +"360","deterministic" +"360","pdftron" +"360","3des" +"360","3dtouch" +"360","orange" +"360","javafxports" +"360","winpcap" +"360","spring-test-mvc" +"360","xcode7.3" +"360","reactive-streams" +"360","event-viewer" +"360","late-binding" +"360","change-tracking" +"360","qlistview" +"360","compiler-bug" +"360","google-plus-one" +"360","pre-commit.com" +"359","aot" +"359","backspace" +"359","feedparser" +"359","ulimit" +"359","app.yaml" +"359","react-three-drei" +"359","oracle-data-integrator" +"359","inflate" +"359","spring-data-jdbc" +"359","nsmutableattributedstring" +"359","jasypt" +"359","buildout" +"359","type-deduction" +"359","bridging-header" +"359","type-families" +"359","ubercart" +"359","isomorphic-javascript" +"359","mkoverlay" +"359","nullptr" +"359","compare-and-swap" +"359","toolbox" +"359","android-management-api" +"358","skrollr" +"358","treeviewitem" +"358","unbind" +"358","fresco" +"358","distortion" +"358","flatlist" +"358","kendo-dropdown" +"358","scala-2.8" +"358","silverstripe-4" +"358","dense-rank" +"358","domain-model" +"358","libpq" +"358","objectanimator" +"358","radial-gradients" +"358","bulk-load" +"358","stringio" +"358","test-kitchen" +"358","strip-tags" +"358","android-popupwindow" +"357","gitlab-omnibus" +"357","ssh-agent" +"357","rxjs-pipeable-operators" +"357","jspinner" +"357","factory-boy" +"357","ibm-rad" +"357","nao-robot" +"357","spring-integration-sftp" +"357","system.io.file" +"357","machine-translation" +"357","dojox.grid.datagrid" +"357","time-format" +"357","referential-integrity" +"357","openpgp" +"357","google-datalayer" +"357","stripe-connect" +"357","android-notification-bar" +"357","ios-extensions" +"357","second-level-cache" +"356","ebnf" +"356","grocery-crud" +"356","blazemeter" +"356","wc" +"356","appveyor" +"356","inode" +"356","rar" +"356","registrykey" +"356","collect" +"355","list-initialization" +"355","vsx" +"355","fuzzy-comparison" +"355","fasm" +"355","alfresco-webscripts" +"355","init.d" +"355","visionos" +"355","fragment-backstack" +"355","restrict" +"355","http-request" +"355","egg" +"355","strongname" +"355","statefulwidget" +"355","amazon-connect" +"355","hdf" +"355","ussd" +"354","decomposition" +"354","termination" +"354","fuzzy" +"354","marketplace" +"354","caldav" +"354","modular" +"354","spring-profiles" +"354","boost-propertytree" +"354","r-grid" +"354","pymupdf" +"354","video-editing" +"354","shorthand" +"354","aspose.words" +"354","dgrid" +"354","tapply" +"354","scrapyd" +"354","prototype-programming" +"354","duckdb" +"354","activeresource" +"354","angular-fullstack" +"354","duplicate-data" +"354","traefik-ingress" +"353","xv6" +"353","gridpane" +"353","dd" +"353","dcos" +"353","react-native-video" +"353","cdo-climate" +"353","rs485" +"353","nsrunloop" +"353","ioerror" +"353","rhandsontable" +"353","fputcsv" +"353","scandir" +"353","prop" +"353","http-response-codes" +"353","androidplot" +"353","ilmerge" +"353","usergroups" +"353","arules" +"353","avassetexportsession" +"353","mbeans" +"352","livecycle" +"352","flowlayout" +"352","base-url" +"352","selectedindex" +"352","silent" +"352","nebular" +"352","boxlayout" +"352","dxf" +"352","dynamicquery" +"352","iocp" +"352","mixed-content" +"352","coldfusion-2016" +"352","fortran95" +"352","dropdownlistfor" +"352","android-paging-3" +"352","ignore" +"351","xsd.exe" +"351","cloud-init" +"351","web-standards" +"351","maui-community-toolkit" +"351","in-app" +"351","piping" +"351","django-mptt" +"351","docbook" +"351","gpu-shared-memory" +"351","spring-boot-admin" +"351","boost-bind" +"351","oscommerce" +"351","mermaid" +"351","acfpro" +"351","google-coral" +"351","qabstractitemmodel" +"351","octopress" +"351","active-directory-group" +"351","topshelf" +"351","zoneddatetime" +"351","web-chat" +"350","multiset" +"350","skia" +"350","php-telegram-bot" +"350","progress-db" +"350","mailmessage" +"350","n-queens" +"350","mod-perl" +"350","android-studio-2.0" +"350","wndproc" +"350","broom" +"350","android-homebutton" +"350","elevation" +"350","angularjs-components" +"350","shelve" +"350","as.date" +"350","subscriptions" +"349","economics" +"349","vs-unit-testing-framework" +"349","mupdf" +"349","ef-core-5.0" +"349","imbalanced-data" +"349","flame" +"349","cdf" +"349","checkmarx" +"349","pagerank" +"349","unirest" +"349","shared-directory" +"349","reagent" +"349","rssi" +"349","avcapturedevice" +"349","bower-install" +"349","vigenere" +"349","atmelstudio" +"349","kops" +"349","convention" +"349","angular-controller" +"349","dtype" +"349","request-mapping" +"349","ogre" +"349","acumatica-kb" +"349","pre-increment" +"349","automated-refactoring" +"349","avalondock" +"348","tensorflow-probability" +"348","ng-view" +"348","function-calls" +"348","filesystemobject" +"348","packing" +"348","aws-device-farm" +"348","java-5" +"348","3d-model" +"348","winscp-net" +"348","drush" +"348","ivr" +"348","activation-function" +"348","android-radiobutton" +"348","either" +"348","resilience4j" +"348","google-code" +"348","zoom-sdk" +"348","qtimer" +"348","arrows" +"347","multi-user" +"347","multipleselection" +"347","listagg" +"347","photoswipe" +"347","salesforce-communities" +"347","jarsigner" +"347","minimagick" +"347","nvda" +"347","testng-eclipse" +"347","text-rendering" +"347","leaflet.markercluster" +"347","reserved-words" +"347","genetic-programming" +"347","iphone-6" +"347","qpid" +"347","google-maps-static-api" +"347","spacy-3" +"347","stimulsoft" +"346","size-t" +"346","vpython" +"346","xmonad" +"346","dateformatter" +"346","hypothesis-test" +"346","jitsi" +"346","cpack" +"346","boost-log" +"346","rhomobile" +"346","wlst" +"346","synchronize" +"346","random-access" +"346","siebel" +"346","difflib" +"346","radix-sort" +"346","toastr" +"346","noexcept" +"346","xbap" +"346","dijit.form" +"346","quirks-mode" +"346","color-palette" +"346","react-native-camera" +"346","nimbus" +"346","leap-motion" +"346","scrollspy" +"345","aem-6" +"345","ultrawingrid" +"345","ng-template" +"345","icarousel" +"345","cakephp-2.4" +"345","dynamics-business-central" +"345","networkd3" +"345","gwtp" +"345","ios17" +"345","excel-365" +"345","command-line-tool" +"345","elasticsearch-2.0" +"345","paper-elements" +"345","gml" +"345","concurrentdictionary" +"344","vuelidate" +"344","data-recovery" +"344","data-partitioning" +"344","nextjs-image" +"344","silent-installer" +"344","android-auto" +"344","double-pointer" +"344","downgrade" +"344","bulletphysics" +"344","cabal-install" +"344","reference-type" +"344","css-multicolumn-layout" +"344","sumproduct" +"344","sos" +"344","mediawiki-extensions" +"343","multivalue" +"343","git-add" +"343","const-correctness" +"343","owl-carousel-2" +"343","bindinglist" +"343","cp-sat" +"343","workflow-activity" +"343","scala-ide" +"343","azcopy" +"343","post-processing" +"343","microsoft-identity-platform" +"343","obd-ii" +"343","magmi" +"343",".net-4.7.2" +"343",".net-core-2.0" +"343","netlink" +"343","luigi" +"343","xbox" +"343","scoped-storage" +"343","qwebengineview" +"343","dts" +"343","gethashcode" +"343","memory-profiling" +"343","aruco" +"343","imagefield" +"343","amazon-cloudsearch" +"343","sunburst-diagram" +"342","vue-apollo" +"342","listeners" +"342","unique-index" +"342","financial" +"342","smartgit" +"342","rust-macros" +"342","iccube" +"342","ibm-datapower" +"342","document-root" +"342","mongo-java-driver" +"342","jquery-validation-engine" +"342","demo" +"342","nsrange" +"342","entity-framework-4.3" +"342","bluehost" +"342","pyopencl" +"342","android-api-levels" +"342","lwip" +"342","javafx-11" +"342","dovecot" +"342","expert-system" +"342","proxy-classes" +"342","customdialog" +"342","elixir-mix" +"342","webpack-hmr" +"342","flutter-ios" +"342","maven-jaxb2-plugin" +"341","inspector" +"341","castle-dynamicproxy" +"341","connection-refused" +"341","vnet" +"341","uncaught-exception" +"341","appender" +"341","jmenuitem" +"341","datainputstream" +"341","word-frequency" +"341","abcpdf" +"341","form-helpers" +"341","type-level-computation" +"341","screen-recording" +"341","drawtext" +"341","drupal-webform" +"341","textblob" +"341","arraycollection" +"340","dita" +"340","contentcontrol" +"340","ovh" +"340","flex4.6" +"340","fits" +"340","crosswalk" +"340","application-loader" +"340","tablecelleditor" +"340","gobject" +"340","libsodium" +"340","quickfixj" +"340","hadoop-partitioning" +"340","spray-json" +"340","duplex" +"340","cublas" +"340","spacemacs" +"339","eeprom" +"339","cleartool" +"339","manifest.mf" +"339","volumes" +"339","facebook-share" +"339","canoe" +"339","named-scope" +"339","sitecore7.2" +"339","kernighan-and-ritchie" +"339","bootstrap-popover" +"339","gtag.js" +"339","opencv3.1" +"339","fpdi" +"339","pyright" +"339","sql-server-2014-express" +"339","np-complete" +"339","redis-sentinel" +"339","mmenu" +"339","sql-merge" +"339","opengl-compat" +"339","spring-thymeleaf" +"339","iterm" +"339","identity-management" +"339","gnuradio-companion" +"338","eclipse-neon" +"338","swiftui-navigationstack" +"338","file-watcher" +"338","sni" +"338","vault" +"338","recycle" +"338","angularjs-ng-options" +"338","cs-cart" +"338","mongodb-replica-set" +"338","onlongclicklistener" +"338","ws" +"338","paytm" +"338","kotlin-extension" +"338","f5" +"338","code-readability" +"338","author" +"338","titanium-modules" +"338","escpos" +"338","activity-finish" +"338","heremaps" +"338","seconds" +"337","jbuilder" +"337","imagesource" +"337","affinity" +"337","file-processing" +"337","dayjs" +"337","vba7" +"337","publisher" +"337","html5boilerplate" +"337","countvectorizer" +"337",".obj" +"337","facebook-likebox" +"337","android-fusedlocation" +"337","openstack-nova" +"337","sql-server-2008-express" +"337","event-delegation" +"337","moodle-api" +"337","android-lint" +"337","thinktecture-ident-server" +"337","google-secret-manager" +"337","solaris-10" +"337","git-rewrite-history" +"337","arrayobject" +"336","flutter-desktop" +"336","dataformat" +"336","django-unittest" +"336","server-push" +"336","hsts" +"336","susy-compass" +"336","postman-pre-request-script" +"336","javascriptcore" +"336","code-access-security" +"336","ondestroy" +"336","permgen" +"336","accumulate" +"336","linter" +"336","gmsmapview" +"335","multi-project" +"335","renaming" +"335","switching" +"335","value-objects" +"335","root-framework" +"335","country-codes" +"335","simpleadapter" +"335","information-extraction" +"335","typename" +"335","guzzle6" +"335","pepper" +"335","zend-form-element" +"335","glyph" +"335","z-order" +"334","sknode" +"334","teams-toolkit" +"334","python-3.2" +"334","veracode" +"334","cpu-cores" +"334","2-way-object-databinding" +"334","facebook-chatbot" +"334","vertex-buffer" +"334","uidocumentinteraction" +"334","monthcalendar" +"334","sungridengine" +"334","tflite" +"334","flutter-local-notification" +"334","securityexception" +"333","mwaa" +"333","json-serialization" +"333","python-extensions" +"333","namecheap" +"333","r-lavaan" +"333","nsmenuitem" +"333","crc16" +"333","azure-container-apps" +"333","bootstrap-selectpicker" +"333","hottowel" +"333","android-fullscreen" +"333","scipy.stats" +"333","asp.net-blazor" +"333","reset-password" +"333","node-request" +"333","compass-geolocation" +"333","amazon-glacier" +"333","maxmind" +"332","gridpanel" +"332","flowlayoutpanel" +"332","next-router" +"332","appearance" +"332","data-integrity" +"332","robovm" +"332","docplex" +"332","scala-java-interop" +"332","modular-arithmetic" +"332","gbm" +"332","mlr" +"332","acid" +"332","multibyte" +"331","mux" +"331","datetime-conversion" +"331","date-comparison" +"331","connected-components" +"331","var-dump" +"331","django-email" +"331","nats.io" +"331","justify" +"331","android-audiorecord" +"331","quicklook" +"331","tabwidget" +"331","rackspace-cloud" +"331","httpsurlconnection" +"331","scribe" +"331","media-source" +"330","remotewebdriver" +"330","telemetry" +"330","wifip2p" +"330","feedback" +"330","voting" +"330","lagom" +"330","import-csv" +"330","rust-rocket" +"330","django-file-upload" +"330","faster-rcnn" +"330","auditing" +"330","osx-leopard" +"330","microsoft-ui-automation" +"330","tablespace" +"330","coordinate" +"330","azure-sdk-python" +"330","devexpress-windows-ui" +"330","bzip2" +"330","test-suite" +"330","splinter" +"330","force.com" +"330","emmeans" +"330","idl-programming-language" +"330","starlette" +"329","mutablelivedata" +"329","remoteview" +"329","localizable.strings" +"329","react-native-fbsdk" +"329","flask-migrate" +"329","firebase-crash-reporting" +"329","django-widget" +"329","datagridcomboboxcolumn" +"329","one-definition-rule" +"329","onenote-api" +"329","network-traffic" +"329","object-reference" +"329","nosql-aggregation" +"329","elastic-load-balancer" +"329","odoo-16" +"329","md5sum" +"328","matter.js" +"328","probability-distribution" +"328","datetimeindex" +"328","snort" +"328","data-access" +"328","recover" +"328","roboguice" +"328","oracle18c" +"328","wavefront" +"328","angularjs-ng-route" +"328","rollingfileappender" +"328","onscroll" +"328","twitterapi-python" +"328","java.util.date" +"328","minimal-apis" +"328","context-switch" +"328","openshift-client-tools" +"328","xa" +"328","playing-cards" +"328","spinlock" +"328","nic" +"328","monomac" +"328","geode" +"328","mrjob" +"328","statsd" +"328","array-algorithms" +"328","static-initialization" +"327","tensorflow-hub" +"327","deezer" +"327","php-8.1" +"327","sql-tuning" +"327","apk-expansion-files" +"327","smart-table" +"327","chilkat" +"327","kusto-explorer" +"327","flask-restplus" +"327","vonage" +"327","model-validation" +"327","jquery-cookie" +"327","range-v3" +"327","3d-modelling" +"327","associated-types" +"327","gdk" +"327","google-cloud-scheduler" +"327","spoofing" +"327","limits" +"327","tidesdk" +"327","parser-generator" +"326","trend" +"326","disabled-control" +"326","contactless-smartcard" +"326","data-integration" +"326","capitalize" +"326","opscenter" +"326","dwr" +"326","inflate-exception" +"326","pymongo-3.x" +"326","terragrunt" +"326","angular16" +"326","httplib" +"326","amazon-linux" +"326","topological-sort" +"326","submit-button" +"326","partial-specialization" +"325","yield-return" +"325","phpcodesniffer" +"325","backbone-model" +"325","cifs" +"325","unicode-escapes" +"325","sender" +"325","gprof" +"325","supportmapfragment" +"325","wit.ai" +"325","jasmine-node" +"325","tabula" +"325","react-beautiful-dnd" +"325","office-2007" +"325","persian" +"325","qtwidgets" +"325","argo-workflows" +"325","google-picker" +"325","static-ip-address" +"325","arbitrary-precision" +"324","cloud9" +"324","telecommunication" +"324","datepickerdialog" +"324","symfony-3.2" +"324","function-parameter" +"324","vuex-modules" +"324","unity-editor" +"324","asynchttpclient" +"324","typescript1.8" +"324","dom4j" +"324","convex-optimization" +"324","lead" +"324","lotus-formula" +"324","hcl" +"324","qt4.8" +"324","mui-datatable" +"323","bash-completion" +"323","anonymous-methods" +"323","mass-assignment" +"323","pandas-resample" +"323","django-1.11" +"323","bitcode" +"323","mallet" +"323","pimpl-idiom" +"323","unsigned-char" +"323","database-relations" +"323","coverity" +"323","opencart-module" +"323","spring-repositories" +"323","html5-filesystem" +"323","nsstream" +"323","viewdata" +"323","gzipstream" +"323","openlayers-5" +"323","modbus-tcp" +"323","android-fingerprint-api" +"323","custom-errors" +"323","react-big-calendar" +"323","text-recognition" +"323","duck-typing" +"323","script-tag" +"323","bazel-rules" +"322","dbnull" +"322","termios" +"322","webviewclient" +"322","integer-programming" +"322","phar" +"322","flask-security" +"322","uiwebviewdelegate" +"322","round-robin" +"322","win32-process" +"322","react-transition-group" +"322","aws-php-sdk" +"322","pci-compliance" +"322","karma-mocha" +"322","revolution-slider" +"322","ordinal" +"322","typescript-decorator" +"322","bus" +"322","azure-rbac" +"322","command-pattern" +"322","react-lifecycle" +"322","changelog" +"322","conditional-types" +"322","allegro5" +"322","linguistics" +"322","autosar" +"322","dart-async" +"322","autoprefixer" +"322","amazon-rekognition" +"322","fmt" +"321","yii2-model" +"321","jsoncpp" +"321","python-appium" +"321","router-outlet" +"321","kindle-fire" +"321","django-storage" +"321","del" +"321","coreclr" +"321","ext4" +"321","mimekit" +"321","drupal-taxonomy" +"321","plumber" +"321","xamarin.uitest" +"321","sqlparameter" +"321","asp.net-core-7.0" +"321","last.fm" +"321","lru" +"321","pester" +"321","pgbouncer" +"321","angular4-router" +"321","qscrollarea" +"321","user-interaction" +"321","webix" +"321","top-n" +"320","editorconfig" +"320","math.h" +"320","cl" +"320","temporary-objects" +"320","yaml-cpp" +"320","flatpickr" +"320","page-object-gem" +"320","filesaver.js" +"320","data-management" +"320","g1gc" +"320","microprofile" +"320","akamai" +"320","android-sharing" +"320","apple-maps" +"320","android-textinputedittext" +"320","pymodbus" +"320","rackspace" +"320","xcode14" +"320","text-size" +"320","react-konva" +"320","mbprogresshud" +"320","hce" +"320","ifs" +"320","thread-local-storage" +"319","teamcity-9.0" +"319","graylog" +"319","php4" +"319","bitwise-and" +"319","name-mangling" +"319","velocity.js" +"319","wso2-iot" +"319","silverlight-2.0" +"319","pearson-correlation" +"319","tabactivity" +"319","orthographic" +"319","accelerate-framework" +"319","tmp" +"319","play-json" +"319","vfs" +"319","scraper" +"319","gentoo" +"319","test-bench" +"319","gen-server" +"319","genesis" +"319","peer" +"319","laravel-seeding" +"319","msbuild-4.0" +"319","hdmi" +"319","quandl" +"319","alphabet" +"319","zend-route" +"319","web-mediarecorder" +"319","panoramas" +"318","rxdart" +"318","aws-cloudwatch-log-insights" +"318","windows-messages" +"318","database-table" +"318","keyboard-hook" +"318","routerlink" +"318","boost-variant" +"318","sap-cloud-sdk" +"318","sfsafariviewcontroller" +"318","object-files" +"318","shoes" +"318","digital" +"318","android-event" +"318","spidermonkey" +"318","towers-of-hanoi" +"318","amazon-opensearch" +"318","mdbootstrap" +"318","msix" +"318","glimpse" +"317","jenkins-agent" +"317","telnetlib" +"317","yahoo-pipes" +"317","kubernetes-cronjob" +"317","kernel32" +"317","swarm" +"317","jquery-load" +"317","twython" +"317","borrowing" +"317","inorder" +"317","blogspot" +"317","libtorch" +"317","sql-limit" +"317","qlist" +"317","projects" +"317","on-duplicate-key" +"317","esapi" +"317","zepto" +"317","imagelist" +"317","google-sheets-macros" +"317","google-schemas" +"316","eclipse-mars" +"316","fluentui-react" +"316","backticks" +"316","chipmunk" +"316","advanced-installer" +"316","waf" +"316","jgrasp" +"316","recursive-backtracking" +"316","rte" +"316","bourbon" +"316","nestedscrollview" +"316","spring-batch-admin" +"316","buildbot" +"316","outlook-web-app" +"316","drawstring" +"316","jackson-dataformat-xml" +"316","xcb" +"316","hudson-plugins" +"316","elasticsearch-7" +"316","cufon" +"316","sonarqube5.1" +"316","sortedset" +"315","replacewith" +"315","pg-restore" +"315","telegram-api" +"315","slots" +"315","php-7.3" +"315","runas" +"315","xml-attribute" +"315","design-principles" +"315","ar.js" +"315","nserror" +"315","pyrogram" +"315","broadleaf-commerce" +"315","orchardcms-1.6" +"315","openstack-swift" +"315","uigraphicscontext" +"315","nsurlsessiondownloadtask" +"315","nouislider" +"315","xceed" +"315","dup2" +"315","google-cloud-dns" +"315","eventlet" +"315","ofbiz" +"314","tryparse" +"314","consensus" +"314","apache-mina" +"314","runtime-permissions" +"314","fxmlloader" +"314","real-time-data" +"314","cakephp-1.2" +"314","unwind-segue" +"314","bolt-cms" +"314","dynamic-forms" +"314","oozie-coordinator" +"314","object-recognition" +"314","modelattribute" +"314","operands" +"314","dart-isolates" +"314","mdichild" +"314","autopostback" +"313","phonegap-pushplugin" +"313","circuit" +"313","socialengine" +"313","mapquest" +"313","apache-tiles" +"313","python-embedding" +"313","jira-rest-java-api" +"313","recurring" +"313","gpt-3" +"313","workitem" +"313","apple-vision" +"313","jrebel" +"313","salesforce-service-cloud" +"313","libtiff" +"313","overhead" +"313","wireshark-dissector" +"313","convergence" +"313","notin" +"313","notion-api" +"313","galleria" +"313","tabpage" +"313","android-radiogroup" +"313","search-suggestion" +"312","eddystone" +"312","pingfederate" +"312","appcompatactivity" +"312","datefield" +"312","ups" +"312","mongo-java" +"312","nsnotification" +"312","audit-trail" +"312","woocommerce-theming" +"312","azure-service-principal" +"312","scim" +"312","long-press" +"312","cometd" +"312","zurb-foundation-5" +"312","octobercms-plugins" +"312","autodesk-data-management" +"312","powershell-5.1" +"311","xticks" +"311","wechat" +"311","checkpoint" +"311","laravel-11" +"311","image-preprocessing" +"311","xml-comments" +"311","pagemethods" +"311","oraclereports" +"311","psr-4" +"311","metatrader5" +"311","virtualtreeview" +"311","doorkeeper" +"311","numa" +"311","cordova-2.0.0" +"311","ios5.1" +"311","httponly" +"311","spool" +"311","qiskit" +"311","webcrypto-api" +"311","zombie-process" +"311","alpha-beta-pruning" +"311","subsequence" +"311","google-photos" +"311","google-search-appliance" +"310","ansible-tower" +"310","liskov-substitution-principle" +"310","mvccontrib" +"310","symmetricds" +"310","aws-cloud9" +"310","name-lookup" +"310","angular-router-guards" +"310","nest-api" +"310","infrared" +"310","dynamic-controls" +"310","open-uri" +"310","jai" +"310","centos5" +"310","cellular-network" +"310","http-compression" +"310","qbxml" +"310","multibranch-pipeline" +"309","pixel-shader" +"309","undetected-chromedriver" +"309","xiaomi" +"309","mfcc" +"309","fault-tolerance" +"309","azure-devops-self-hosted-agent" +"309","dynamic-columns" +"309","ganache" +"309","dotnetnuke-7" +"309","mktime" +"309","bulkupdate" +"309","estimote" +"309","es6-proxy" +"309","activemerchant" +"309","ctest" +"309","ios-4.2" +"309","sharpsvn" +"309","stylelint" +"308","replicate" +"308","jdbc-odbc" +"308","removeall" +"308","data-transform" +"308","ceil" +"308","nfa" +"308","servo" +"308","fancytree" +"308","pybrain" +"308","jmeter-3.2" +"308","rownum" +"308","pose-estimation" +"308","appointment" +"308","dill" +"308","scalatra" +"308","actionevent" +"308","qfile" +"308","stocks" +"308","android-lvl" +"308","msbi" +"308","maxscript" +"308","amazon-redshift-spectrum" +"308","stdset" +"307","reliability" +"307","mutability" +"307","chrome-native-messaging" +"307","adobe-reader" +"307","seq2seq" +"307","windows-kernel" +"307","grape-api" +"307","mongojs" +"307","svnkit" +"307","typed-arrays" +"307","externalinterface" +"307","vk" +"307","orientation-changes" +"307","pmml" +"307","centroid" +"307","react-map-gl" +"307","launch-screen" +"307","omnisharp" +"307","utm" +"307","compile-time-constant" +"306","standard-error" +"306","gridcontrol" +"306","python-jira" +"306","goutte" +"306","crosswalk-runtime" +"306","angular-material-6" +"306","detach" +"306","twilio-click-to-call" +"306","opcache" +"306","worklight-studio" +"306","nsmutablestring" +"306","tlb" +"306","tclientdataset" +"306","gamepad" +"306","android-navigation-graph" +"306","genetics" +"306","pelican" +"306","ipados" +"306","always-encrypted" +"305","primefaces-extensions" +"305","defined" +"305","selectedindexchanged" +"305","playframework-2.6" +"305","maintainability" +"305","data-protection" +"305","function-prototypes" +"305","akka-persistence" +"305","cruisecontrol" +"305","session-management" +"305","jgrapht" +"305","variadic-macros" +"305","bootstrap-sass" +"305","eonasdan-datetimepicker" +"305","cornerradius" +"305","sandcastle" +"305","pyflink" +"305","nw.js" +"305","hierarchicaldatatemplate" +"305","notnull" +"305","numericupdown" +"305","azure-java-sdk" +"305","openocd" +"305","large-data-volumes" +"305","shell-extensions" +"305","tpm" +"305","arc4random" +"305","power-platform" +"305","maven-compiler-plugin" +"305","subgraph" +"305","linefeed" +"304","cmyk" +"304","react-native-image-picker" +"304","debian-based" +"304","addressing-mode" +"304","django-autocomplete-light" +"304","incompatibility" +"304","blurry" +"304","infopath2010" +"304","detailview" +"304","mkdocs" +"304","android-bundle" +"304","nomachine-nx" +"304","retain-cycle" +"304","perfmon" +"304","eventbrite" +"304","questdb" +"304","autorun" +"304","email-spam" +"304","startactivityforresult" +"303","lithium" +"303","mute" +"303","litespeed" +"303","intellij-13" +"303","listen" +"303","runspace" +"303","selenide" +"303","vowpalwabbit" +"303","chronometer" +"303","appdata" +"303","css-filters" +"303","readdir" +"303","dask-delayed" +"303","waitpid" +"303","wpf-style" +"303","cowplot" +"303","forex" +"303","tablecolumn" +"303","aspose-cells" +"303","higher-kinded-types" +"303","memory-segmentation" +"303","mopub" +"303","pentaho-cde" +"303","paper-trail-gem" +"303","emoticons" +"303","webmin" +"303","flutter-image" +"302","sjplot" +"302","matrix-indexing" +"302","imgui" +"302","xml2" +"302","meteor-helper" +"302","joomla1.7" +"302","csc" +"302","jms-topic" +"302","nse" +"302","bounce" +"302","codelite" +"302","objectcontext" +"302","kubeadm" +"302","knime" +"302","ocelot" +"302","noise-reduction" +"302","tailwind-ui" +"302","opensql" +"302","getch" +"302","leaflet.draw" +"302","stringi" +"302","cumulocity" +"302","nodejs-stream" +"302","param" +"302","spannable" +"302","stdlist" +"302","stepper" +"302","qtcpsocket" +"301","integrity" +"301","clang-static-analyzer" +"301","apache2.2" +"301","mutual-authentication" +"301","stack-frame" +"301","cimg" +"301","django-3.0" +"301","advanceddatagrid" +"301","docker-toolbox" +"301","twitter-typeahead" +"301","pos" +"301","poppler" +"301","nbconvert" +"301","typelib" +"301","tabbarcontroller" +"301","hibernate-4.x" +"301","asp.net-mvc-5.1" +"301","android-icons" +"301","expandable" +"301","itfoxtec-identity-saml2" +"301","textkit" +"301","angular-chart" +"301","megamenu" +"301","iphone-4" +"301","subshell" +"300","flock" +"300","ciimage" +"300","chemistry" +"300","nano" +"300","vehicle-routing" +"300","cakephp-2.x" +"300","django-taggit" +"300","html-editor" +"300","neat" +"300","influxdb-2" +"300","konva" +"300","network-interface" +"300","ubuntu-11.04" +"300","mlr3" +"300","controlsfx" +"300","cg" +"300","parameterized-query" +"300","concept" +"300","glass-mapper" +"300","amazon-cloudtrail" +"300","mediacontroller" +"300","tidytext" +"299","fgetc" +"299","uniswap" +"299","apim" +"299","django-filters" +"299","turfjs" +"299","gtk4" +"299","forth" +"299","extending" +"299","libssh2" +"299","system.net" +"299","node-sqlite3" +"299","burp" +"299","cab" +"299","execcommand" +"299","eureka-forms" +"299","mov" +"299","yui3" +"299","mdc" +"299","solid-js" +"299","lightningchart" +"298","flutter-bottomnavigation" +"298","jsse" +"298","content-assist" +"298","apktool" +"298","css3pie" +"298","sesame" +"298","route-provider" +"298","simplejson" +"298","calllog" +"298","simplepie" +"298","serial-number" +"298","passport-facebook" +"298","kapt" +"298","settings.bundle" +"298","ksoap" +"298","c++-coroutine" +"298","asp.net-core-1.1" +"298","cakebuild" +"298","azure-form-recognizer" +"298","qtspim" +"298","touchableopacity" +"297","template10" +"297","filefield" +"297","sna" +"297","kubeflow-pipelines" +"297","jsdoc3" +"297","cc" +"297","django-pagination" +"297","intptr" +"297","amf" +"297","winforms-interop" +"297","to-date" +"297","google-image-search" +"297","zigbee" +"296","printdocument" +"296","squash" +"296","live-tile" +"296","stacked-bar-chart" +"296","xilinx-ise" +"296","anime.js" +"296","googlevis" +"296","realsense" +"296","kendo-datasource" +"296","onion-architecture" +"296","dwarf" +"296","sat" +"296","960.gs" +"296","rhel6" +"296","sql-date-functions" +"296","spring-webflow-2" +"296","copy-elision" +"296","hmacsha1" +"296","testing-library" +"296","angular-elements" +"296","textureview" +"296","project-template" +"296","logparser" +"296","odoo-view" +"296","ninject.web.mvc" +"296","glsles" +"296","sunspot-solr" +"296","sharpdevelop" +"296","pane" +"295","procfile" +"295","team-explorer" +"295","xtrareport" +"295","django-annotate" +"295","dbase" +"295","adview" +"295","rocket.chat" +"295","factorization" +"295","hypervisor" +"295","asyncfileupload" +"295","bufferedinputstream" +"295","microstrategy" +"295","vm-implementation" +"295","hockeyapp" +"295","polymer-3.x" +"295","pointfree" +"295","omnipay" +"295","using-directives" +"295","webpack-file-loader" +"294","apache-age" +"294","stable-baselines" +"294","relaycommand" +"294","dbmigrate" +"294","smtp-auth" +"294","rpg" +"294","operations" +"294","boost-regex" +"294","sap-iq" +"294","tunneling" +"294","onerror" +"294","spring-logback" +"294","wrappanel" +"294","signal-handling" +"294","abstracttablemodel" +"294","videochat" +"294","richedit" +"294","magento-2.3" +"294","gatsby-image" +"294","c#-to-vb.net" +"294","tinymce-5" +"294","sql-optimization" +"294","husky" +"294","react-css-modules" +"294","long-running-processes" +"294","sony-smartwatch" +"294","soundmanager2" +"294","transactional-replication" +"294","cyanogenmod" +"293","floating-point-conversion" +"293","graph-tool" +"293","tempdata" +"293","representation" +"293","jcifs" +"293","smime" +"293","simplehttpserver" +"293","ndepend" +"293","boost-spirit-x3" +"293","opam" +"293","erlang-shell" +"293","kaa" +"293","godaddy-api" +"293","visual-studio-2003" +"293","outlook-2013" +"293","rabl" +"293","contextmenustrip" +"293","ta-lib" +"293","nuget-server" +"293","peg" +"293","es6-module-loader" +"293","react-dropzone" +"293","daphne" +"292","smali" +"292","yeoman-generator-angular" +"292","multipage" +"292","triplestore" +"292","xmlbeans" +"292","laragon" +"292","rstan" +"292","fancybox-3" +"292","blit" +"292","spring-data-gemfire" +"292","bloom-filter" +"292","invisible-recaptcha" +"292","vimeo-player" +"292","r-dbi" +"292","fragment-tab-host" +"292","audiocontext" +"292","extensibility" +"292","contrast" +"292","gate" +"292","iso8583" +"292","android-ibeacon" +"292","azure-resource-group" +"292","node.js-addon" +"292","accord.net" +"292","charat" +"292","ios-camera" +"292","storefront" +"292","looker" +"292","ppm" +"292","subdocument" +"291","background-subtraction" +"291","livy" +"291","psych" +"291","key-pair" +"291","android-wear-data-api" +"291","openai-whisper" +"291","cortana" +"291","spring-authorization-server" +"291","android-settings" +"291","boost-beast" +"291","brightcove" +"291","mit-scratch" +"291","system.net.mail" +"291","viewwillappear" +"291","observableobject" +"291","playn" +"291","bullet" +"291","mlogit" +"291","xcframework" +"291","hamming-distance" +"291","logitech" +"291","collatz" +"291","pervasive" +"291","mql" +"291","eslint-config-airbnb" +"291","cucumber-serenity" +"291","cyclomatic-complexity" +"291","ie8-compatibility-mode" +"291","mdns" +"291","panic" +"291","paradigms" +"290","nextjs-dynamic-routing" +"290","jsonresponse" +"290","django-cors-headers" +"290","blackberry-playbook" +"290","xmltable" +"290","page-load-time" +"290","pycryptodome" +"290","documents" +"290","variable-length" +"290","superfish" +"290","swift-concurrency" +"290","swc" +"290","visual-studio-sdk" +"290","excel-indirect" +"290","copy-item" +"290","android-compose-textfield" +"290","azure-functions-core-tools" +"290","getresource" +"290","elasticsearch-java-api" +"290","huggingface-datasets" +"290","collider" +"290","flutter-pageview" +"290","static-classes" +"290","zend-view" +"290","arff" +"289","squirrel-sql" +"289","laradock" +"289","lampp" +"289","kubelet" +"289","adfs3.0" +"289","fiware-cygnus" +"289","aero" +"289","dnsmasq" +"289","grails3" +"289","docker-swarm-mode" +"289","winappdriver" +"289","urlclassloader" +"289","bold" +"289","delimited" +"289","inkcanvas" +"289","android-version" +"289","abac" +"289","notice" +"289","pebble-watch" +"289","persistent-volume-claims" +"289","angular2-testing" +"289","change-data-capture" +"289","laravel-lighthouse" +"289","genfromtxt" +"289","eiffel" +"289","google-cloud-tasks" +"289","stockquotes" +"289","msg" +"289","google-my-business-api" +"288","yoast" +"288","fizzbuzz" +"288","nextjs14" +"288","xfce" +"288","animated" +"288","html.actionlink" +"288","jquery-effects" +"288","kartik-v" +"288","password-recovery" +"288","mod-python" +"288","onmouseout" +"288","openejb" +"288","macos-ventura" +"288","libavformat" +"288","mobile-devices" +"288","logitech-gaming-software" +"288","lte" +"288","hybridauth" +"288","charindex" +"288","toolstrip" +"288","sparc" +"288","yui-compressor" +"287","ec2-ami" +"287","skshapenode" +"287","listpreference" +"287","websphere-6.1" +"287","sketchup" +"287","teradatasql" +"287","terminal-services" +"287","adal.js" +"287","affiliate" +"287","marketo" +"287","nhibernate-criteria" +"287","xml.etree" +"287","self-signed-certificate" +"287","containerd" +"287","django-login" +"287","avmutablecomposition" +"287","airtable" +"287","optparse" +"287","karma-coverage" +"287","boost-mpl" +"287","paw-app" +"287","luxon" +"287","pydicom" +"287","c++-modules" +"287","protobuf-java" +"287","column-width" +"287","log4net-appender" +"287","textchanged" +"287","storing-data" +"287","ld-preload" +"287","ios-bluetooth" +"287","leading-zero" +"287","binance-api-client" +"287","ikvm" +"287","bibliography" +"287","thickbox" +"287","bc" +"287","custom-server-controls" +"286","trayicon" +"286","flutter-android" +"286","file-storage" +"286","bitarray" +"286","pairwise" +"286","apm" +"286","bin-packing" +"286","mysql-error-1054" +"286","keyboardinterrupt" +"286","oracle-spatial" +"286","sirishortcuts" +"286","rasterizing" +"286",".class-file" +"286","hibernate-entitymanager" +"286","eventual-consistency" +"286","beego" +"285","repr" +"285","cloud-document-ai" +"285","slimdx" +"285","react-slick" +"285","tedious" +"285","full-outer-join" +"285","addchild" +"285","real-mode" +"285","real-time-updates" +"285","docker-in-docker" +"285","writeablebitmap" +"285","tweak" +"285","gssapi" +"285","minmax" +"285","pygraphviz" +"285","typescript-types" +"285","pypyodbc" +"285","broadcasting" +"285","scjp" +"285","nvidia-jetson-nano" +"285","azure-sql-managed-instance" +"285","hk2" +"285","memory-layout" +"285","http-request-parameters" +"285","uv-mapping" +"285","iequalitycomparer" +"284","square-bracket" +"284","dct" +"284","private-methods" +"284","treegrid" +"284","wicket-6" +"284","react-native-gesture-handler" +"284","imei" +"284","lame" +"284","jlink" +"284","julian-date" +"284","spring-restdocs" +"284","gtfs" +"284","openblas" +"284","jquery-ui-tooltip" +"284","spring-security-ldap" +"284","delayed-execution" +"284","android-adapterview" +"284","android-5.1.1-lollipop" +"284","kotlinx.serialization" +"284","spring-statemachine" +"284","r.js" +"284","noscript" +"284","drools-guvnor" +"284","ios-universal-app" +"284","http-status-code-504" +"284","ipsec" +"284","launching-application" +"284","elasticsearch-6" +"284","nock" +"284","array-difference" +"283","fclose" +"283","stackexchange-api" +"283","sendfile" +"283","flet" +"283","soft-keyboard" +"283","voice-recording" +"283","symfony-security" +"283","django-custom-user" +"283","aiml" +"283","windowsiot" +"283","rom" +"283","aws-lambda-edge" +"283","postman-testcase" +"283","azure-cosmosdb-gremlinapi" +"283","path-variables" +"283","exim" +"283","istio-gateway" +"283","dexterity" +"283","diamond-problem" +"283","point-in-polygon" +"283","qlpreviewcontroller" +"283","lcov" +"283","tetris" +"283","ekevent" +"283","spatial-index" +"283","prerequisites" +"283","parent-pom" +"283","idempotent" +"282","react-native-svg" +"282","jformattedtextfield" +"282","github-copilot" +"282","socat" +"282","adobe-edge" +"282","packagist" +"282","unary-operator" +"282","receipt" +"282","durandal-2.0" +"282","set-intersection" +"282","scenarios" +"282","chartjs-2.6.0" +"282","mpeg2-ts" +"282","linear-search" +"282","zen-cart" +"282","preloading" +"281","wia" +"281","flutterflow" +"281","stable-diffusion" +"281","phpwebsocket" +"281","kindle" +"281","rotativa" +"281","aws-sdk-go" +"281","sharepoint-clientobject" +"281","cardinality" +"281","rowfilter" +"281","internal-storage" +"281","gui-testing" +"281","rfcomm" +"281","for-xml-path" +"281","opentracing" +"281","xaf" +"281","scala-reflect" +"281","uint8t" +"281","android-nested-fragment" +"281","longitudinal" +"281","ios8-share-extension" +"281","laravel-valet" +"281","ess" +"281","beeline" +"281","cydia" +"281","begininvoke" +"280","skaffold" +"280","cnosdb" +"280","banner-ads" +"280","weibull" +"280","laravelcollective" +"280","finally" +"280","play-billing-library" +"280","uniform" +"280","avplayeritem" +"280","agents-jade" +"280","wildfly-9" +"280","google-client" +"280",".net-remoting" +"280","r-forestplot" +"280","typeid" +"280","pyscript" +"280","android-bottomnav" +"280","devstack" +"280","hibernate-onetomany" +"280","redis-cli" +"280","mkv" +"280","activator" +"280","node.js-fs" +"280","multifile-uploader" +"280","haskell-platform" +"280","fmod" +"280","folderbrowserdialog" +"280","hexo" +"279","class-hierarchy" +"279","sse2" +"279","trendline" +"279","disaster-recovery" +"279","confluence-rest-api" +"279","smartface.io" +"279","ruta" +"279","ibooks" +"279","redbean" +"279","air-native-extension" +"279","hotspot" +"279","jquery-tokeninput" +"279","azure-data-studio" +"279","junit-jupiter" +"279","postgresql-14" +"279","lexical-scope" +"279","objection.js" +"279","systemc" +"279","shadcnui" +"279","redefinition" +"279","hindi" +"279","mlops" +"279","sql-job" +"279","android-mvp" +"279","memory-mapping" +"279","mean.io" +"279","ilist" +"279","tibco-ems" +"278","livechat" +"278","gridster" +"278","temporal" +"278","react-native-elements" +"278","xuggler" +"278","snmp4j" +"278","nextcord" +"278","chromadb" +"278","i386" +"278","icollection" +"278","serve" +"278","twain" +"278","opencmis" +"278","spring-cloud-function" +"278","surefire" +"278","bloodhound" +"278",".net-4.6.1" +"278","ribbon-control" +"278","android-date" +"278","highmaps" +"278","android-ble" +"278","tizen-native-app" +"278","hubot" +"278","ctrl" +"278","partition-by" +"278","mui-x-data-grid" +"278","webmail" +"277","gitattributes" +"277","graylog2" +"277","federation" +"277","sql-timestamp" +"277","s3cmd" +"277","k-fold" +"277","inequality" +"277","angularjs-resource" +"277","indoor-positioning-system" +"277","datagridtemplatecolumn" +"277","angular-observable" +"277","ibdesignable" +"277","dynamic-language-runtime" +"277","invoke-webrequest" +"277","code-conversion" +"277","rdkit" +"277","shake" +"277","xcode3.2" +"277","acra" +"277","google-geolocation" +"277","http-put" +"277","access-rights" +"277","lazy-sequences" +"277","zynq" +"277","gmap.net" +"276","mutt" +"276","react-rails" +"276","matlab-coder" +"276","graphql-subscriptions" +"276","django-formwizard" +"276","idataerrorinfo" +"276","data-ingestion" +"276","pushwoosh" +"276","realurl" +"276","jlayeredpane" +"276","coverflow" +"276","pdf-reader" +"276","code-metrics" +"276","org.json" +"276","vml" +"276","uimenucontroller" +"276","android-gesture" +"276","azure-signalr" +"276","taskkill" +"276","stream-processing" +"276","iphone-6-plus" +"276","sheetjs" +"276","autotest" +"276","web.config-transform" +"276","cypress-cucumber-preprocessor" +"275","deedle" +"275","relevance" +"275","react-ref" +"275","ujs" +"275","xml-drawable" +"275","divi" +"275","undirected-graph" +"275","segment-tree" +"275","python-curses" +"275","importrange" +"275","wasm-bindgen" +"275","dmg" +"275","canny-operator" +"275","faraday" +"275","wcag2.0" +"275","roman-numerals" +"275","ontouch" +"275","turtle-rdf" +"275","nattable" +"275","openfl" +"275","domino-designer-eclipse" +"275","outofrangeexception" +"275","pytest-mock" +"275","kotlin-stateflow" +"275","dht" +"275","pytorch-geometric" +"275","mongorestore" +"275","lpsolve" +"275","lazycolumn" +"275","eleventy" +"275","node-inspector" +"275","flutter-video-player" +"275","autolisp" +"274","cmake-gui" +"274","blacklist" +"274","django-1.5" +"274","data-stream" +"274","jpackage" +"274","nested-object" +"274","scalacheck" +"274","delphi-6" +"274","innertext" +"274","coremltools" +"274","hotwire-rails" +"274","onitemclick" +"274","r-corrplot" +"274","codesandbox" +"274","syslog-ng" +"274","netlify-cms" +"274","railscasts" +"274","azure-search-.net-sdk" +"274","g-wan" +"274","location-services" +"274","toml" +"274","ektron" +"274","idhttp" +"274","google-plus-signin" +"274","amazon-dynamodb-index" +"274","heat" +"274","search-box" +"274","sharpziplib" +"274","conemu" +"274","usart" +"273","yii1.x" +"273","jclouds" +"273","decentralized-applications" +"273","sqlyog" +"273","page-title" +"273","ng-zorro-antd" +"273","docking" +"273","djongo" +"273","turbo-c" +"273","android-13" +"273","mahout-recommender" +"273","knockout-mvc" +"273","lenses" +"273","kotlin-exposed" +"273","visual-c#-express-2010" +"273","copy-protection" +"273","busboy" +"273","tld" +"273","highcharts-ng" +"273","resource-files" +"273","across" +"273","quantstrat" +"273","static-typing" +"273","scripting-language" +"272","terminal-emulator" +"272","yocto-recipe" +"272","cloud-storage" +"272","vue-loader" +"272","pkce" +"272","imread" +"272","xlsm" +"272","adsi" +"272","redactor" +"272","axlsx" +"272","opencover" +"272","pdflib" +"272","octobercms-backend" +"272","pyephem" +"272",".post" +"272","m2crypto" +"272","nvidia-docker" +"272","nominatim" +"272","spritebuilder" +"272","nunit-console" +"272","ollydbg" +"272","google-cloud-load-balancer" +"272","textformfield" +"272","laravel-permission" +"272","offline-mode" +"272","mtls" +"272","sonos" +"272","traceroute" +"272","emma" +"271","class-template" +"271","weasyprint" +"271","dcast" +"271","clojure-java-interop" +"271","django-1.9" +"271","undefined-index" +"271","jsonresult" +"271","r-tree" +"271","jquery-forms-plugin" +"271","nsautoreleasepool" +"271","opencpu" +"271","applescript-objc" +"271","observablelist" +"271","kotlin-js" +"271","browser-plugin" +"271","null-coalescing-operator" +"271","accumulator" +"271","qbytearray" +"271","hyper" +"271","subscriber" +"271","toplevel" +"271","imagedownload" +"270","mathematical-expressions" +"270","ansi" +"270","cmath" +"270","ng-style" +"270","fileserver" +"270","dynamic-tables" +"270","nested-for-loop" +"270","code-inspection" +"270","rijndaelmanaged" +"270","wix3.8" +"270","uipopover" +"270","xcode5.1" +"270","screensharing" +"270","ios-darkmode" +"270","specman" +"270","getfiles" +"269","barrier" +"269","ffmpeg-php" +"269","template-toolkit" +"269","processstartinfo" +"269","fine-tuning" +"269","kubernetes-deployment" +"269","rx.net" +"269","rxandroidble" +"269","fuzzing" +"269","xmldom" +"269","calico" +"269","document-body" +"269","grafana-variable" +"269","inline-editing" +"269","pdf-conversion" +"269","modern-ui" +"269","core-telephony" +"269","boost-test" +"269","r-exams" +"269","express-router" +"269","abc" +"269","jaspersoft-studio" +"269","exchange-server-2007" +"269","azure-storage-files" +"269","quotation-marks" +"269","sqlgeography" +"269","nlohmann-json" +"269","proj" +"269","resourcemanager" +"269","react-helmet" +"269","imagefilter" +"268","back-testing" +"268","php-internals" +"268","bindparam" +"268","json-query" +"268","sinon-chai" +"268","data-distribution-service" +"268","fail2ban" +"268","dynamic-variables" +"268","aws-sdk-net" +"268","jqxgrid" +"268","degrees" +"268","javafx-webengine" +"268","pydrive" +"268","isolation" +"268","bytesio" +"268","po" +"268","angular-i18n" +"268","node-http-proxy" +"268","mpmediaitem" +"268","accumulo" +"268","comma-operator" +"268","google-talk" +"268","time.h" +"268","medical-imaging" +"267","template-templates" +"267","multiple-choice" +"267","apache-iceberg" +"267","app-id" +"267","symfony-2.7" +"267","ng2-bootstrap" +"267","cscope" +"267","windows-iot-core-10" +"267","wcf-web-api" +"267","facebook-timeline" +"267","spring-cloud-task" +"267","portainer" +"267","hsl" +"267","bootstrap-carousel" +"267","google-apps-script-addon" +"267","wix-react-native-navigation" +"267","uidocument" +"267","ironruby" +"267","geom" +"267","heartbeat" +"267","array-splice" +"267","start-process" +"266","flurl" +"266","maskedtextbox" +"266","photosframework" +"266","webtest" +"266","weak-ptr" +"266","apache-calcite" +"266","underscore.js-templating" +"266","jscrollbar" +"266","laravel-forge" +"266","casbah" +"266","avspeechsynthesizer" +"266","icomparable" +"266","induction" +"266","oracle-coherence" +"266","dynamics-365-operations" +"266","wshttpbinding" +"266","invalid-argument" +"266","svn-checkout" +"266","coin-change" +"266","shadowbox" +"266","viewengine" +"266","pygments" +"266","amazon-selling-partner-api" +"266","m2m" +"266","osascript" +"266","drupal-9" +"266","nsurlsessiondatatask" +"266","nsurlcache" +"266","c#-9.0" +"266","mlp" +"266","mmu" +"266","versions" +"266","trailing-slash" +"266","web-application-firewall" +"266","webflow" +"266","empty-list" +"266","artoolkit" +"266","pascals-triangle" +"265","siteminder" +"265","citations" +"265","locate" +"265","overleaf" +"265","in-clause" +"265","jmenubar" +"265","keras-2" +"265","spring-messaging" +"265","android-studio-2.1" +"265","pcsc" +"265","pcf" +"265","wss-3.0" +"265","azure-devops-pipelines" +"265","mit-scheme" +"265","codesys" +"265","fpu" +"265","azure-vm" +"265","dtrace" +"265","react-modal" +"265","stringtemplate" +"265","alteryx" +"265","torrent" +"264","babel-polyfill" +"264","react-navigation-v6" +"264","prism-4" +"264","skypedeveloper" +"264","fields-for" +"264","bad-alloc" +"264","tripledes" +"264","mutual-exclusion" +"264","int64" +"264","sshfs" +"264","selectionchanged" +"264","unboxing" +"264","dbal" +"264","chutzpah" +"264","jsonstore" +"264","angularjs-ng-change" +"264","ibm-connections" +"264","jira-agile" +"264","azure-app-configuration" +"264","opendir" +"264","salesforce-marketing-cloud" +"264","opa" +"264","azerothcore" +"264","atomikos" +"264","libreoffice-basic" +"264","dom-traversal" +"264","amazon-waf" +"264","fortran-iso-c-binding" +"264","kotlinx.coroutines" +"264","numpy-einsum" +"264","hash-function" +"264","raft" +"264","opengl-es-3.0" +"264","android-push-notification" +"264","memory-limit" +"264","elasticsearch-net" +"264","angular-cli-v6" +"264","mongrel" +"264","google-data-api" +"264","dancer" +"264","gnome-shell" +"263","graphical-logo" +"263","apache-config" +"263","youtube-analytics-api" +"263","catkin" +"263","afnetworking-3" +"263","datepart" +"263","appcelerator-alloy" +"263","mapbox-marker" +"263","circleci-2.0" +"263","data-persistence" +"263","django-q" +"263","avconv" +"263","server-error" +"263","fastq" +"263","aws-aurora-serverless" +"263","uno" +"263","delphi-2006" +"263","mongo-cxx-driver" +"263","jvm-crash" +"263","inputmismatchexception" +"263","dynamics-ax-2012-r2" +"263","typesafe" +"263","wordpress-jetpack" +"263","schematron" +"263","uipasteboard" +"263","uiresponder" +"263","ocunit" +"263","spotlight" +"263","before-filter" +"263","webhdfs" +"263","transaction-isolation" +"263","linkify" +"262","telegram-webhook" +"262","multiple-domains" +"262","yadcf" +"262","edit-distance" +"262","bjam" +"262","runner" +"262","credential-providers" +"262","jmonkeyengine" +"262","dxgi" +"262","guile" +"262","rc" +"262","amazon-swf" +"262","mithril.js" +"262","midlet" +"262","modelbinders" +"262","x87" +"262","numerical-analysis" +"262","nuspec" +"262","cache-manifest" +"262","hiera" +"262","pyusb" +"262","proxmox" +"262","angular2-formbuilder" +"262","spreadsheetgear" +"262","ldd" +"262","authorize" +"262","webdriver-manager" +"262","batterylevel" +"262","helix-3d-toolkit" +"261","react-server-components" +"261","lmdb" +"261","yarn-v2" +"261","dead-letter" +"261","debian-buster" +"261","filenet-p8" +"261","react-quill" +"261","photokit" +"261","cng" +"261","connect-by" +"261","nexus-7" +"261","file-structure" +"261","page-tables" +"261","flash-cs3" +"261","data-generation" +"261","datagridviewcombobox" +"261","angularjs-orderby" +"261","recoiljs" +"261","angular-unit-test" +"261","natural-sort" +"261","botocore" +"261","magnetometer" +"261","face-api" +"261","system-properties" +"261","hapi-fhir" +"261","plsql-package" +"261","taylor-series" +"261","qlayout" +"261","http-proxy-middleware" +"261","lcdui" +"261","google-fit-sdk" +"261","ipopt" +"261","ursina" +"261","here-maps-rest" +"261","web-forms-for-marketers" +"261","armv8" +"260","mutiny" +"260","procedures" +"260","jetpack-compose-navigation" +"260","maven-central" +"260","citrus-framework" +"260","contentobserver" +"260","django-2.2" +"260","socket-timeout-exception" +"260","dbexpress" +"260","undeclared-identifier" +"260","chatterbot" +"260","variable-names" +"260","vagrant-windows" +"260","pushsharp" +"260","optgroup" +"260","turborepo" +"260","arabic-support" +"260","nsexception" +"260","e4x" +"260","android-async-http" +"260","view-scope" +"260","rating-system" +"260","tnsnames" +"260","elastica" +"260","google-cloud-networking" +"260","restler" +"260","iphone-standalone-web-app" +"260","google-cloud-console" +"260","cgi-bin" +"260","spark-streaming-kafka" +"260","parallel.for" +"259","remap" +"259","relocation" +"259","ssms-2012" +"259","basichttpbinding" +"259","data-science-experience" +"259","distributed-tracing" +"259","laravel-api" +"259","xfbml" +"259","xp-cmdshell" +"259","owin-middleware" +"259","pycairo" +"259","microsoft-edge-extension" +"259","vcenter" +"259","farsi" +"259","blink" +"259","model-view" +"259","android-tabactivity" +"259","cppunit" +"259","html-heading" +"259","nwjs" +"259","wolframalpha" +"259","shim" +"259","mime-message" +"259","orb" +"259","buefy" +"259","viewdidappear" +"259","azure-traffic-manager" +"259","ack" +"259","merge-replication" +"259","license-key" +"259","thumb" +"259","liferay-aui" +"259","statistical-test" +"259","headset" +"258","listiterator" +"258","math.net" +"258","dataoutputstream" +"258","run-length-encoding" +"258","language-model" +"258","imageurl" +"258","angular-upgrade" +"258","simple-schema" +"258","jitpack" +"258","pthread-join" +"258","jmock" +"258","jpopupmenu" +"258","dynamic-binding" +"258","ooad" +"258","dynamic-content" +"258","boost-multi-index" +"258","wsadmin" +"258","sap-cloud-platform" +"258","winrar" +"258","rights" +"258","android-7.1-nougat" +"258","osrm" +"258","mixed" +"258","nucleo" +"258","proxy-server" +"258","react-native-cli" +"258","nmea" +"258","panels" +"258","auto-populate" +"258","conduit" +"258","partial-application" +"258","embedded-v8" +"257","react-native-reanimated-v2" +"257","transliteration" +"257","local-database" +"257","cncontact" +"257","templatetags" +"257","multivariate-testing" +"257","webusercontrol" +"257","ng-packagr" +"257","pitch" +"257","imx6" +"257","constructor-injection" +"257","fileshare" +"257","unity3d-editor" +"257","socketchannel" +"257","factory-method" +"257","favorites" +"257","anko" +"257","rollapply" +"257","swfupload" +"257","kali-linux" +"257","nslocale" +"257","on-screen-keyboard" +"257","nsinteger" +"257","setting" +"257","sigmoid" +"257","sphinx4" +"257","projectile" +"257","zio" +"257","zingchart" +"257","qtquickcontrols" +"257","autoresizingmask" +"257","mui-x" +"257","prettyfaces" +"257","flutterwebviewplugin" +"257","suffix" +"257","premake" +"256","ant-contrib" +"256","data-sharing" +"256","mapkitannotation" +"256","sendinput" +"256","cbc-mode" +"256","google-vpc" +"256","cannot-find-symbol" +"256","angular-leaflet-directive" +"256","dwm" +"256","jquery-svg" +"256","kanban" +"256","random-effects" +"256","halide" +"256","leap-year" +"256","laravel-mail" +"256","solid-state-drive" +"256","arcgis-server" +"256","sonarcloud" +"256","ie-developer-tools" +"256","user-defined" +"255","integrate" +"255","truncated" +"255","reply" +"255","apache-curator" +"255","backbone-relational" +"255","swiftui-animation" +"255","bisection" +"255","selenium-iedriver" +"255","python-c-extension" +"255","appendto" +"255","unsafe-pointers" +"255","aws-pinpoint" +"255","microsoft365" +"255","django-managers" +"255","watchconnectivity" +"255","nslookup" +"255","moles" +"255","otrs" +"255","abstract-factory" +"255","google-ad-manager" +"255","javascript-automation" +"255","setuid" +"255","setlocale" +"255","redhawksdr" +"255","sqlite.swift" +"255","qmenu" +"255","stormpath" +"255","pyttsx3" +"255","event-driven-design" +"255","strncpy" +"255","hwioauthbundle" +"255","activity-diagram" +"255","string-search" +"255","terraform-template-file" +"255","getaddrinfo" +"255","webots" +"255","zfs" +"255","predis" +"255","pass-data" +"254","tel" +"254","deck.gl" +"254","procedural-programming" +"254","dde" +"254","xelatex" +"254","pairing" +"254","console.writeline" +"254","variable-expansion" +"254","rotatetransform" +"254","puppet-enterprise" +"254","docpad" +"254","negation" +"254","entity-framework-6.1" +"254","openfeign" +"254","facebook-graph-api-v2.0" +"254","ringcentral" +"254","random-walk" +"254","bundle-identifier" +"254","nstimezone" +"254","no-www" +"254","plone-4.x" +"254","vga" +"254","plunker" +"254","stochastic" +"254","chapel" +"254","menustrip" +"254","ctime" +"254","google-maps-flutter" +"254","tracker" +"254","completion" +"254","ideavim" +"254","torque" +"254","flyout" +"253","tree-shaking" +"253","eclipse-gef" +"253","dbgrid" +"253","react-native-textinput" +"253","socket.io-1.0" +"253","xmp" +"253","snapchat" +"253","microsoft-band" +"253","svn-externals" +"253","bot-framework-composer" +"253","sammy.js" +"253","code-editor" +"253","ubuntu-11.10" +"253","android-binder" +"253","f#-3.0" +"253","opentsdb" +"253","tabnavigator" +"253","vespa" +"253","poedit" +"253","companion-object" +"253","geometry-surface" +"253","office-2010" +"253","react-forms" +"253","automapping" +"253","gke-networking" +"252","groovyshell" +"252","backendless" +"252","clause" +"252","fitbit" +"252","apiblueprint" +"252","uiviewrepresentable" +"252","nanohttpd" +"252","dart-webui" +"252","window-handles" +"252","nativescript-plugin" +"252","nco" +"252","mongoexport" +"252","mixed-mode" +"252","magento-2.0" +"252","type-punning" +"252","r-faq" +"252","opentype" +"252","isapi-rewrite" +"252","open-policy-agent" +"252","sql-null" +"252","sql-server-ce-4" +"252","c1-cms" +"252","strawberry-perl" +"252","custom-events" +"252","staticresource" +"252","glusterfs" +"252","multilinestring" +"252","eml" +"251","markov" +"251","php-include" +"251","barcode-printing" +"251","laminas-api-tools" +"251","mapbox-ios" +"251","ng2-smart-table" +"251","adaboost" +"251","mantis" +"251","simplification" +"251","robospice" +"251","data-entry" +"251","jqgrid-formatter" +"251","wso2-cep" +"251","detours" +"251","wso2-micro-integrator" +"251","tuckey-urlrewrite-filter" +"251","amazon-textract" +"251","shortcut-file" +"251","java-metro-framework" +"251","vichuploaderbundle" +"251","amd-gpu" +"251","scatter3d" +"251","tcpsocket" +"251","scintilla" +"251","splitter" +"251","test-data" +"251","propagation" +"251","geom-point" +"251","laravel-scout" +"251","google-deployment-manager" +"251","throws" +"251","urlrequest" +"251","archiva" +"250","cloud-sql-proxy" +"250","py4j" +"250","google-trends" +"250","faunadb" +"250","windows-mixed-reality" +"250","criteriaquery" +"250","capacity" +"250","cakephp-2.2" +"250","aws-certificate-manager" +"250","open-closed-principle" +"250","dynamics-crm-webapi" +"250","bootstrap-grid" +"250","gulp-uglify" +"250","blockui" +"250","libclang" +"250","forkjoinpool" +"250","viewport-units" +"250","virtual-destructor" +"250","assetbundle" +"250","spork" +"250","beep" +"250","sparklines" +"250","zone" +"250","sugarorm" +"249","flask-mail" +"249","keyboard-layout" +"249","jitsi-meet" +"249","wal" +"249","winbugs" +"249","single-instance" +"249","calabash-android" +"249","warden" +"249","dataform" +"249","jmeter-maven-plugin" +"249","red" +"249","hotswap" +"249","spring-orm" +"249","visualizer" +"249","osx-server" +"249","letters" +"249","object-oriented-database" +"249","regsvr32" +"249","podcast" +"249","openjdk-11" +"249","devise-confirmable" +"249","hashicorp" +"249","radcombobox" +"249","pointer-events" +"249","rad-studio" +"249","hive-metastore" +"249","actionfilterattribute" +"249","python-watchdog" +"249","locked" +"249","dailymotion-api" +"249","amazon-elasticsearch" +"249","scroller" +"248","baseline" +"248","cleardb" +"248","webpage-screenshot" +"248","editorfor" +"248","django-cache" +"248","blast" +"248","sequelpro" +"248","purely-functional" +"248","cross-site" +"248","svelte-store" +"248","sigterm" +"248","html4" +"248","mod-pagespeed" +"248","turbo" +"248","spring-mongo" +"248","nsimageview" +"248","cowboy" +"248","bootstrap-accordion" +"248","lzma" +"248","outlook-2016" +"248","setwindowshookex" +"248","kohana-orm" +"248","xcode9-beta" +"248","sproutcore" +"248","tomahawk" +"248","generate-series" +"248","mpeg-4" +"248","cfquery" +"248","tomcat5.5" +"248","odac" +"248","mbunit" +"248","conditional-comments" +"248","beyondcompare" +"247","sql-to-linq-conversion" +"247","flex-mobile" +"247","white-framework" +"247","anonymous-inner-class" +"247","greenrobot-eventbus" +"247","gridlines" +"247","pinax" +"247","bitrate" +"247","datastep" +"247","ngx-charts" +"247","cdo.message" +"247","avplayerlayer" +"247","ibm-blockchain" +"247","docker-multi-stage-build" +"247","ajp" +"247","spring-mvc-test" +"247","shrink" +"247","visual-studio-setup-proje" +"247","lego-mindstorms" +"247","differentiation" +"247","gwt-platform" +"247","olingo" +"247","custom-data-type" +"247","google-cloud-kms" +"247","hunspell" +"247","party" +"247","static-content" +"247","compiler-options" +"247","ignite-ui" +"246","gitlab-ci.yml" +"246","apache-commons-fileupload" +"246","background-fetch" +"246","telebot" +"246","dead-code" +"246","marmalade" +"246","getview" +"246","finite-element-analysis" +"246","confluent-kafka-python" +"246","python-cryptography" +"246","django-2.1" +"246","rrule" +"246","mysql-5.5" +"246","camunda-modeler" +"246","react-suspense" +"246","oracleclient" +"246","kdevelop" +"246","app-transport-security" +"246","polymer-starter-kit" +"246","inventory-management" +"246","ion-auth" +"246","mojo" +"246","dynatree" +"246","format-string" +"246","google-artifact-registry" +"246","foselasticabundle" +"246","codeigniter-datamapper" +"246","sigma.js" +"246","pfobject" +"246","asgi" +"246","touchesmoved" +"246","linq-to-twitter" +"246","amazon-linux-2" +"246","flutter-http" +"246","usb-debugging" +"245","cisco-ios" +"245","vs-web-application-project" +"245","phpoffice" +"245","transport" +"245","vuepress" +"245","uitest" +"245","flac" +"245","chronicle" +"245","cartesian" +"245","binaryreader" +"245","puppeteer-sharp" +"245","bounded-wildcard" +"245","hotlinking" +"245","openedx" +"245","openwhisk" +"245","uipinchgesturerecognizer" +"245","model-checking" +"245","executenonquery" +"245","non-deterministic" +"245","contingency" +"245","cursors" +"245","q-lang" +"245","omniauth-facebook" +"245","metaplex" +"245","argc" +"245","emacs23" +"245","spark-ar-studio" +"245","sun" +"245","ihttphandler" +"245","maven-profiles" +"244","php-5.2" +"244","mutators" +"244","clistctrl" +"244","github-enterprise" +"244","xmlslurper" +"244","file-put-contents" +"244","wasapi" +"244","unity3d-unet" +"244","google-workspace-add-ons" +"244","upcasting" +"244","guidewire" +"244","dynamic-typing" +"244","appx" +"244","jqwidget" +"244","fragment-identifier" +"244","shadowing" +"244","netstream" +"244","codeigniter-routing" +"244","t4mvc" +"244","tabbedpage" +"244","java-ee-5" +"244","isodate" +"244","sp-send-dbmail" +"244","openzeppelin" +"244","exchangelib" +"244","openvswitch" +"244","azure-vpn" +"244","google-groups" +"244","sorl-thumbnail" +"243","mathnet-numerics" +"243","intel-pin" +"243","printing-web-page" +"243","sitemesh" +"243","flexigrid" +"243","flow-router" +"243","multiplexing" +"243","lit-html" +"243","integer-promotion" +"243","socrata" +"243","json-web-token" +"243","python-ldap" +"243","snapkit" +"243","ng-bind-html" +"243","childviewcontroller" +"243","cross-origin-read-blocking" +"243","reasoning" +"243","vacuum" +"243","postconstruct" +"243","openbsd" +"243","sbatch" +"243","grunt-contrib-uglify" +"243","mongo-go" +"243","pbx" +"243","interlocked" +"243","nested-table" +"243","appium-desktop" +"243","google-ai-platform" +"243","google-authenticator" +"243","dojox.grid" +"243","osc" +"243","external-accessory" +"243","brightway" +"243","libpqxx" +"243","jasmine-jquery" +"243","6502" +"243","analytic-functions" +"243","pointer-to-pointer" +"243","nlb" +"243","nlp-question-answering" +"243","nitrousio" +"243","access-log" +"243","access-specifier" +"243","angular2-highcharts" +"243","preferencefragment" +"243","ilogger" +"243","autoformatting" +"243","automationanywhere" +"243","encog" +"242","jaydata" +"242","antlrworks" +"242","pgpool" +"242","pacman" +"242","select-string" +"242","sniffer" +"242","aws-glue-spark" +"242","ajax.beginform" +"242","ruby-datamapper" +"242","android-support-design" +"242","nsdecimalnumber" +"242","satellite" +"242","atlas" +"242","code-push" +"242","builder-pattern" +"242","typescript-compiler-api" +"242","retina" +"242","raise" +"242","sysfs" +"242","68000" +"242","libx264" +"242","drupal-forms" +"242","mixing" +"242","hashchange" +"242","text-manipulation" +"242","spatialite" +"242","glassfish-4.1" +"242","sonarqube-ops" +"242","predicatebuilder" +"242","heading" +"242","qtmultimedia" +"241","stackblitz" +"241","procfs" +"241","vscode-code-runner" +"241","apn" +"241","unchecked" +"241","dashing" +"241","recycle-bin" +"241","dms" +"241","kibana-7" +"241","vao" +"241","cracking" +"241","spring-boot-starter" +"241","jquery-ui-selectable" +"241","pooling" +"241","howler.js" +"241","application-restart" +"241","twitter-bootstrap-tooltip" +"241","juce" +"241","lexicographic" +"241","codeceptjs" +"241","virtual-hosts" +"241","netflix-ribbon" +"241","reflector" +"241","notificationcenter" +"241","dev-to-production" +"241","expo-router" +"241","custom-exceptions" +"241","geos" +"241","ejb-2.x" +"241","sonata-user-bundle" +"241","zappa" +"241","quantifiers" +"240","eclipse-oxygen" +"240","filamentphp" +"240","print-preview" +"240","transitive-dependency" +"240","mapfragment" +"240","malware-detection" +"240","safearealayoutguide" +"240","blank-line" +"240","database-permissions" +"240","unlock" +"240","aws-policies" +"240","false-positive" +"240","single-spa" +"240","grpc-web" +"240","hash-collision" +"240","gazebo-simu" +"240","dryioc" +"240","asp.net-core-viewcomponent" +"240","restcomm" +"240","command-substitution" +"240","oembed" +"240","httpservice" +"240","zsh-completion" +"240","project-organization" +"240","hexagonal-tiles" +"240","zeroclipboard" +"240","qtsql" +"240","hdp" +"240","ti-basic" +"239","fcntl" +"239","phase" +"239","producer" +"239","dispatch-queue" +"239","software-quality" +"239","bins" +"239","pinch" +"239","chunked" +"239","ruby-on-rails-6.1" +"239","rowwise" +"239","pycaret" +"239","intro.js" +"239","coremidi" +"239","application-design" +"239","android-selector" +"239","jwplayer6" +"239","wtl" +"239","delve" +"239","orchardcms-1.8" +"239","google-books" +"239","raylib" +"239","double-precision" +"239","tinymce-plugins" +"239","non-nullable" +"239","monoids" +"239","promisekit" +"239","logic-programming" +"239","passkit" +"239","alpha-vantage" +"238","react-native-scrollview" +"238","react-native-stylesheet" +"238","material-design-in-xaml" +"238","ecmascript-harmony" +"238","construct" +"238","xhtml2pdf" +"238","ngoninit" +"238","data-munging" +"238","sentence-transformers" +"238","rx-cocoa" +"238","rx-kotlin" +"238","django-media" +"238","rebar" +"238","cakephp-2.5" +"238","craftcms" +"238","payumoney" +"238","bluestacks" +"238","m4a" +"238","device-admin" +"238","exp" +"238","xcode6.3" +"238","eventaggregator" +"238","event-propagation" +"238","reactable" +"238","propertyinfo" +"238","loopj" +"238","text-based" +"238","log-likelihood" +"237","flutter-appbar" +"237","repeatingalarm" +"237","inbox" +"237","selenium2library" +"237","method-signature" +"237","crossrider" +"237","facebox" +"237","ndis" +"237","jquery-click-event" +"237","superglobals" +"237","delta-live-tables" +"237","victory-charts" +"237","libphonenumber" +"237","video-thumbnails" +"237","jar-signing" +"237","xcasset" +"237","isinstance" +"237","performselector" +"237","geth" +"237","argumentexception" +"237","sublimerepl" +"236","wicket-1.5" +"236","slack-commands" +"236","gremlinpython" +"236","mailx" +"236","incompatibletypeerror" +"236","pandasql" +"236","fileutils" +"236","cropperjs" +"236","animate-cc" +"236","wikitude" +"236","icomparer" +"236","routed-events" +"236","blockingcollection" +"236","ionic-react" +"236","invocationtargetexception" +"236","hpa" +"236","borland-c++" +"236","navmesh" +"236","onsaveinstancestate" +"236","form-fields" +"236","lftp" +"236","rhodes" +"236","broken-pipe" +"236","right-join" +"236","regasm" +"236","non-clustered-index" +"236","xbrl" +"236","null-layout-manager" +"236","gatsby-plugin" +"236","android-chips" +"236","react-devtools" +"236","ios-app-group" +"236","projection-matrix" +"236","node-crypto" +"236","sp-executesql" +"236","sudoers" +"236","quadratic-programming" +"236","footable" +"236","energy" +"236","qstandarditemmodel" +"236","google-identity-toolkit" +"236","thread-priority" +"236","pango" +"236","alloy-ui" +"235","xwpf" +"235","apache-commons-logging" +"235","react-redux-form" +"235","apacheds" +"235","json-normalize" +"235","childwindow" +"235","json-simple" +"235","const-cast" +"235","imessage-extension" +"235","cbcentralmanager" +"235","aws-cloudformation-custom-resource" +"235","cakeyframeanimation" +"235","rserve" +"235","vector-database" +"235","jpos" +"235","input-mask" +"235","horizontal-scaling" +"235","mining" +"235","winrt-async" +"235","visual-studio-templates" +"235","netflix-feign" +"235","network-share" +"235",".net-micro-framework" +"235","koa2" +"235","android-actionbaractivity" +"235","azure-pipelines-tasks" +"235","cookiecutter-django" +"235","chartist.js" +"235","pep" +"235","genome" +"235","cfnetwork" +"235","parity" +"235","usecallback" +"234","ghost" +"234","jekyll-extensions" +"234","deeplink" +"234","coap" +"234","sizing" +"234","my.cnf" +"234","gravatar" +"234","github-package-registry" +"234","xliff" +"234","flask-mongoengine" +"234","sentence-similarity" +"234","distribute" +"234","python-socketio" +"234","pushkit" +"234","server-side-includes" +"234","ready-api" +"234","cronexpression" +"234","animator" +"234","ruby-1.9.2" +"234","kibana-5" +"234","document-database" +"234","core-ui" +"234","dynamics-ax-2012-r3" +"234","jquery-steps" +"234","asyncpg" +"234","formattable" +"234","ui-design" +"234","exec-maven-plugin" +"234","notificationmanager" +"234","redis-py" +"234","mplayer" +"234","lsof" +"234","chaquopy" +"234","textedit" +"234","http-streaming" +"234","reqwest" +"233","multipartentity" +"233","phonegap-cli" +"233","yo" +"233","ef-model-first" +"233","sqltransaction" +"233","plasticscm" +"233","vnc-server" +"233","pic18" +"233","catransform3d" +"233","kendo-dataviz" +"233","inetaddress" +"233","keyword-search" +"233","do.call" +"233","post-redirect-get" +"233","tweetsharp" +"233","couchbase-sync-gateway" +"233","grpc-node" +"233","module-pattern" +"233","jquery-mobile-listview" +"233","android-app-signing" +"233","word-2010" +"233","libssh" +"233","domaincontroller" +"233","typeguards" +"233","virtual-address-space" +"233","lexikjwtauthbundle" +"233","significance" +"233","mkfifo" +"233","nodetool" +"233","downsampling" +"233","azure-identity" +"233","qdockwidget" +"233","achievements" +"233","speaker" +"233","haskell-snap-framework" +"233","custom-validators" +"233","mechanize-python" +"233","starttls" +"233","sonarqube-web" +"233","globalplatform" +"233","gnome-shell-extensions" +"233","spark-avro" +"232","sta" +"232","webservices-client" +"232","reproducible-research" +"232","sslstream" +"232","web-storage" +"232","teamcity-8.0" +"232","vst" +"232","prisma2" +"232","phone-state-listener" +"232","slowdown" +"232","daxstudio" +"232","jsreport" +"232","hyperthreading" +"232","fax" +"232","jms-serializer" +"232","alexa-slot" +"232","wp-api" +"232","android-wear-2.0" +"232","detectron" +"232","spring-data-solr" +"232","revision-history" +"232","android-8.1-oreo" +"232","build-server" +"232","xctestcase" +"232","reentrantlock" +"232","scala-option" +"232","bun" +"232","azure-sentinel" +"232","bytearrayoutputstream" +"232","qmessagebox" +"232","restlet-2.0" +"232","react-data-grid" +"232","collectd" +"232","nm" +"232","android-screen" +"232","string-view" +"232","restrictions" +"232","geometry-shader" +"232","preorder" +"232","google-location-services" +"232","powershell-7.0" +"232","shieldui" +"232","tr1" +"231","insomnia" +"231","banking" +"231","prng" +"231","fluent-migrator" +"231","sl4a" +"231","ng-modules" +"231","pageviews" +"231","windows-rt" +"231","docker-run" +"231","windowing" +"231","document-classification" +"231","cprofile" +"231","deneb" +"231","kannel" +"231","ionic6" +"231","monaca" +"231","woothemes" +"231","libvlcsharp" +"231","revenuecat" +"231","codemagic" +"231","minix" +"231","libtorrent" +"231","mipmaps" +"231","codeship" +"231","vis.js-network" +"231","digital-logic" +"231","tarfile" +"231","core.async" +"231","asp.net-identity-3" +"231","generated-code" +"231","activeandroid" +"231","latin1" +"231","ios8-today-widget" +"231","touches" +"231","glu" +"231","sortablejs" +"231","concurrent-programming" +"231","section508" +"231","ilnumerics" +"230","cmder" +"230","clearfix" +"230","laravel-authorization" +"230","rust-crates" +"230","python-cffi" +"230","jsgrid" +"230","ico" +"230","rolify" +"230","windows-desktop-gadgets" +"230","alasql" +"230","wss4j" +"230","cost-management" +"230","ax" +"230","determinants" +"230","pebble-sdk" +"230","magento2.2" +"230","syntastic" +"230","google-apps-script-api" +"230","orleans" +"230","google-cast-sdk" +"230","typesafe-config" +"230","azure-management-api" +"230","uicollectionviewcompositionallayout" +"230","openjfx" +"230","directadmin" +"230","directory-listing" +"230","scikits" +"230","xbox360" +"230","maven-publish" +"230","thor" +"230","ifc" +"230","usb-otg" +"230","archetypes" +"230","cvxopt" +"230","linux-containers" +"230","headless-cms" +"230","mse" +"229","pheatmap" +"229","react-native-push-notification" +"229","tensorflow2.x" +"229","getuikit" +"229","featuretools" +"229","unification" +"229","categorization" +"229","pagerslidingtabstrip" +"229","xml-libxml" +"229","servicestack.redis" +"229","rsocket" +"229","ps1" +"229","appinsights" +"229","swift4.1" +"229","jwk" +"229","coredns" +"229","application-lifecycle" +"229","absolute-value" +"229","google-assistant" +"229","network-printers" +"229","lwp-useragent" +"229","hibernate-ogm" +"229","die" +"229","uipath-studio" +"229","assembly-resolution" +"229","directoryinfo" +"229","comexception" +"229","activesync" +"229","ios6.1" +"229","text-cursor" +"229","google-material-icons" +"229","sctp" +"229","amazon-fire-tv" +"229","binance-smart-chain" +"229","maven-javadoc-plugin" +"228","clgeocoder" +"228","web-performance" +"228","report-viewer2010" +"228","soapheader" +"228","apiconnect" +"228","cellular-automata" +"228","xlconnect" +"228","binary-heap" +"228","ccavenue" +"228","appcode" +"228","finalize" +"228","discriminator" +"228","avcapture" +"228","optimistic-concurrency" +"228","mysql5" +"228","jpgraph" +"228","vbe" +"228","angular-routerlink" +"228","dynamic-proxy" +"228","bootstrap-tags-input" +"228","errorlevel" +"228","wso2-das" +"228","foundry-code-repositories" +"228","ko.observablearray" +"228","magento-1.9.1" +"228","nxp-microcontroller" +"228","f#-fake" +"228","android-4.3-jelly-bean" +"228","devenv" +"228","geopoints" +"228","office-2013" +"228","logstash-file" +"227","dbset" +"227","mx-record" +"227","laravel-controller" +"227","jsonata" +"227","aesthetics" +"227","fusion" +"227","django-1.4" +"227","cassini" +"227","ng-build" +"227","keystone" +"227","django-rest-framework-jwt" +"227","rsqlite" +"227","windows-mobile-6" +"227","nativescript-telerik-ui" +"227","wso2-integration-studio" +"227","brownie" +"227","android-backup-service" +"227","python-2.4" +"227","rakefile" +"227","cordova-plugin-fcm" +"227","asp.net5" +"227","redgate" +"227","openoffice-writer" +"227","game-theory" +"227","android-internet" +"227","lsf" +"227","response-time" +"227","commerce" +"227","lightswitch-2013" +"227","suffix-tree" +"227","securestring" +"227","maven-dependency" +"227","image-caching" +"227","max-flow" +"227","endpoints" +"227","git-squash" +"227","qt5.5" +"226","background-thread" +"226","replaykit" +"226","ssrs-expression" +"226","dbconnection" +"226","smil" +"226","displayobject" +"226","marklogic-10" +"226","constructor-overloading" +"226","constant-expression" +"226","xerces-c" +"226","metasploit" +"226","realm-list" +"226","uploader" +"226","fbjs" +"226","junction-table" +"226","pdfa" +"226","aws-sts" +"226","kafkajs" +"226","kodi" +"226","sid" +"226","riot.js" +"226","timedelay" +"226","x11-forwarding" +"226","rabbitmqctl" +"226","uistepper" +"226","r5rs" +"226","isr" +"226","asp.net-roles" +"226","azure-security" +"226","pex" +"226","certificate-authority" +"226","testlink" +"226","sourcetree" +"226","flutter-inappwebview" +"226","maven-war-plugin" +"226","zend-server" +"226","google-photos-api" +"225","flickity" +"225","treetable" +"225","whatsapi" +"225","ansible-role" +"225","ggraph" +"225","flat" +"225","uitextviewdelegate" +"225","python-gstreamer" +"225","laravel-6.2" +"225","unexpected-token" +"225","chrome-devtools-protocol" +"225","dashdb" +"225","rpath" +"225","django-wsgi" +"225","micronaut-data" +"225","canjs" +"225","django-debug-toolbar" +"225","nestjs-config" +"225","onhover" +"225","spring-boot-3" +"225","oserror" +"225","lexical" +"225","orbit" +"225","formatexception" +"225","pygithub" +"225","kmz" +"225","nuget-spec" +"225","null-check" +"225","scrapy-pipeline" +"225","refit" +"225","tint" +"225","xaringan" +"225","assemble" +"225","itextpdf" +"225","tiptap" +"225","httpbackend" +"225","zpl-ii" +"225","nicedit" +"225","spl-autoload-register" +"225","powerset" +"225","scriptengine" +"225","tiktok" +"225","traminer" +"224","basic4android" +"224","git-gui" +"224","clerk" +"224","edx" +"224","vue-directives" +"224","ggrepel" +"224","dateinterval" +"224","apache-synapse" +"224","fipy" +"224","frequency-distribution" +"224","metpy" +"224","dockpanel" +"224","win64" +"224","jib" +"224","django-deployment" +"224","gradio" +"224","nsevent" +"224","svc" +"224","rangy" +"224","komodo" +"224","shutdown-hook" +"224","sql-agent" +"224","gamma-distribution" +"224","handlers" +"224","pointcut" +"224","uirepeat" +"224","control-characters" +"224","nszombie" +"224","mesa" +"224","odm" +"224","urlloader" +"224","parallel-foreach" +"224","asdf" +"224","mdiparent" +"224","web-farm" +"224","composable" +"223","apache-commons-beanutils" +"223","clangd" +"223","firebase-extensions" +"223","adbannerview" +"223","capturing-group" +"223","purge" +"223","watchservice" +"223","unity-ui" +"223","database-metadata" +"223","boost-fusion" +"223","onload-event" +"223","kamailio" +"223","couchapp" +"223","inverted-index" +"223","google-analytics-sdk" +"223","java-21" +"223","seurat" +"223","luarocks" +"223",".net-core-2.2" +"223","fp-ts" +"223","mixture-model" +"223","normalizr" +"223","regression-testing" +"223","dot-emacs" +"223","xbmc" +"223","asp.net-core-routing" +"223","taskscheduler" +"223","excel-web-addins" +"223","gaussianblur" +"223","laravel-request" +"223","textscan" +"223","propertychanged" +"223","string-to-datetime" +"223","android-kernel" +"223","metamodel" +"223","spim" +"223","zend-validate" +"223","mt4" +"223","gnucobol" +"223","trace32" +"223","alpakka" +"222","transmission" +"222","graphlab" +"222","contentpresenter" +"222","package-lock.json" +"222","uivisualeffectview" +"222","ccxt" +"222","cartesian-coordinates" +"222","djoser" +"222","joomla-k2" +"222","ruby-2.1" +"222","css-in-js" +"222","sharepoint-2016" +"222","aws-userpools" +"222","invariants" +"222","knights-tour" +"222","new-window" +"222","8-bit" +"222","tdengine" +"222","nsundomanager" +"222","sql-in" +"222","istringstream" +"222","sqlmodel" +"222","sql-server-2008r2-express" +"222","asp.net-core-mvc-2.0" +"222","mouseup" +"222","terracotta" +"222","office365-restapi" +"222","laravel-spark" +"222","moqui" +"222","lateral-join" +"222","protected-mode" +"222","memory-corruption" +"222","thread-dump" +"222","parsefloat" +"222","subtype" +"222","fmi" +"222","enhanced-ecommerce" +"222","qualifiers" +"222","bellman-ford" +"222","email-ext" +"221","cobalt" +"221","slam" +"221","dbvisualizer" +"221","graphiql" +"221","uitableviewsectionheader" +"221","firebird-3.0" +"221","chatroom" +"221","sharepoint-rest-api" +"221","rms" +"221","aws-databricks" +"221","simpleitk" +"221","optional-arguments" +"221","informatica-cloud" +"221","ioredis" +"221","der" +"221","env" +"221","google-api-ruby-client" +"221","object-slicing" +"221","orientdb2.2" +"221","to-char" +"221","table-relationships" +"221","dropout" +"221","exceptionhandler" +"221","moc" +"221","mpns" +"221","metafor" +"221","react-class-based-component" +"221","currentlocation" +"221","lossless-compression" +"221","string-substitution" +"221","stormcrawler" +"221","pfuser" +"221","ip-geolocation" +"221","ios8.3" +"221","ifft" +"221","automatic-properties" +"221","static-site-generation" +"220","react-player" +"220","apachebench" +"220","file-manipulation" +"220","react-native-fs" +"220","webspeech-api" +"220","cbperipheral" +"220","chrome-web-driver" +"220","rsacryptoserviceprovider" +"220","call-graph" +"220","css-calc" +"220","native-ads" +"220","android-viewgroup" +"220","erpnext" +"220","spring-resttemplate" +"220","raspberry-pi-zero" +"220","rhel8" +"220","contextual-action-bar" +"220","xamdatagrid" +"220","polylang" +"220","azure-logic-app-standard" +"220","non-english" +"220","open-telemetry-collector" +"220","tableviewer" +"220","sqlite3-ruby" +"220","dtmf" +"220","elfinder" +"220","qpython" +"220","angular-formbuilder" +"220","react-boilerplate" +"220","angular4-httpclient" +"220","git-post-receive" +"220","zombie.js" +"220","alv" +"220","toplink" +"219","ecma" +"219","deferred-execution" +"219","localserver" +"219","youtube-channels" +"219","mat-file" +"219","intel-edison" +"219","vstack" +"219","github-for-mac" +"219","immer.js" +"219","selectall" +"219","keypad" +"219","data-files" +"219","android-vision" +"219","jquery-cycle2" +"219","jvmti" +"219","gtktreeview" +"219","mikro-orm" +"219","oauth2client" +"219","orocommerce" +"219","kruskals-algorithm" +"219","viber" +"219","java-annotations" +"219","cadence-workflow" +"219","copy-on-write" +"219","hidden-files" +"219","dropdownbutton" +"219","referer" +"219","istio-sidecar" +"219","diagrammer" +"219","spdy" +"219","morse-code" +"219","layer-list" +"219","trailing" +"219","yslow" +"219","qtreewidgetitem" +"219","uti" +"219","seam2" +"218","graphhopper" +"218","classnotfound" +"218","adventureworks" +"218","ftp-server" +"218","selenium-extent-report" +"218","mapserver" +"218","ag-grid-ng2" +"218","valueconverter" +"218","database-security" +"218","docker-for-mac" +"218","mylyn" +"218","grafana-alerts" +"218","appwrite" +"218","grunt-usemin" +"218","inputstreamreader" +"218","nsstatusitem" +"218","hoverintent" +"218","macruby" +"218","libspotify" +"218","rcpparmadillo" +"218","pyo3" +"218","m4" +"218","outbound" +"218","android-bottomsheetdialog" +"218","cookie-httponly" +"218","android-hardware" +"218","execve" +"218","asp.net-dynamic-data" +"218","tarantool" +"218","control-m" +"218","periodic-task" +"218","getimagedata" +"218","tess4j" +"218","google-gemini" +"218","lower-bound" +"218","qmediaplayer" +"218","foreach-loop-container" +"218","berkshelf" +"218","secure-coding" +"218","spark-view-engine" +"218","scrollbars" +"218","ifconfig" +"217","installshield-le" +"217","matplotlib-widget" +"217","jboss-tools" +"217","clover" +"217","sqlx" +"217","selectinput" +"217","fisheye" +"217","bitcoind" +"217","s3fs" +"217","kubernetes-networkpolicy" +"217","mapnik" +"217","xml-sitemap" +"217","datacolumn" +"217","fat32" +"217","service-fabric-stateful" +"217","opshub" +"217","singlepage" +"217","csla" +"217","oracle-jet" +"217","capacitor-plugin" +"217","django-errors" +"217","error-correction" +"217","android-webservice" +"217","twitter-api-v2" +"217","azure-caching" +"217","interrupted-exception" +"217","influxql" +"217","scalafx" +"217","design-by-contract" +"217","jquery-tooltip" +"217","ucma" +"217","android.mk" +"217","coda" +"217","lg" +"217","javascript-intellisense" +"217","isenabled" +"217","devise-invitable" +"217","plots.jl" +"217","android-holo-everywhere" +"217","reentrancy" +"217","http-verbs" +"217","httplib2" +"217","elastic-ip" +"217","activejdbc" +"217","lora" +"217","sdl-ttf" +"217","fluttermap" +"217","securitymanager" +"217","gitversion" +"217","best-in-place" +"217","zbar-sdk" +"216","llvm-gcc" +"216","yolov4" +"216","stackview" +"216","ts-loader" +"216","yii-url-manager" +"216","jaxp" +"216","ng-hide" +"216","flannel" +"216","adorner" +"216","swisscomdev" +"216","man-in-the-middle" +"216","biztalk-2016" +"216","dispatchertimer" +"216","rowsum" +"216","pusher-js" +"216","real-time-clock" +"216","gpt-2" +"216","recursive-descent" +"216","waterfall" +"216","updatemodel" +"216","servicestack-text" +"216","watson-discovery" +"216","cpprest-sdk" +"216","inter-process-communicat" +"216","patchwork" +"216","raw" +"216","wix3.11" +"216","miktex" +"216","android-augmented-reality" +"216","android-automotive" +"216","build-definition" +"216","libusb-1.0" +"216","ocsp" +"216","node-serialport" +"216","timetable" +"216","asteriskami" +"216","azureml-python-sdk" +"216","tinyxml" +"216","hmisc" +"216","contextpath" +"216","channel-api" +"216","strimzi" +"216","exact-match" +"216","proxies" +"216","powershell-module" +"216","mscorlib" +"216","state-pattern" +"216","hawtio" +"216","haxeflixel" +"216","parametric-polymorphism" +"215","background-size" +"215","sspi" +"215","maven-antrun-plugin" +"215","installscript" +"215","symbolicatecrash" +"215","sendto" +"215","kubernetes-health-check" +"215","cics" +"215","sensormanager" +"215","owner" +"215","rpostgresql" +"215","vcl-styles" +"215","jira-xray" +"215","denial-of-service" +"215","inputaccessoryview" +"215","nspopover" +"215","http-1.1" +"215","spring-security-rest" +"215","cover" +"215","rapids" +"215","typo3-11.x" +"215","virtual-dom" +"215","object-initializers" +"215","hls.js" +"215","gwidgets" +"215","izpack" +"215","mobile-chrome" +"215","tintcolor" +"215","homekit" +"215","angular-ivy" +"215","logfiles" +"215","odt" +"215","alibaba-cloud" +"215","mspec" +"214","bapi" +"214","dbms-scheduler" +"214","vue-router4" +"214","ssid" +"214","jspx" +"214","datastax-enterprise-graph" +"214","unboundid-ldap-sdk" +"214","xml-twig" +"214","data-loss" +"214","rowid" +"214","unsubscribe" +"214","joomla-template" +"214","vagrant-provision" +"214","realm-migration" +"214","fb-hydra" +"214","receipt-validation" +"214","wadl" +"214","alasset" +"214","windowsformshost" +"214","react-table-v7" +"214","jts" +"214","net.tcp" +"214","gulp-concat" +"214","svn-hooks" +"214","macos-sonoma" +"214","android-biometric-prompt" +"214","dqn" +"214","openshift-3" +"214","register-transfer-level" +"214","eventsource" +"214","last-insert-id" +"214","google-gadget" +"214","angular-dynamic-components" +"214","ogr" +"214","flutter-textformfield" +"214","qtnetwork" +"214","particles.js" +"214","ava" +"213","probability-theory" +"213","phpstan" +"213","intel-oneapi" +"213","trusted-web-activity" +"213","sleep-mode" +"213","live555" +"213","affix" +"213","datawindow" +"213","bitrise" +"213","binomial-coefficients" +"213","cats-effect" +"213","s#arp-architecture" +"213","laravel-4.2" +"213","facebook-sdk-4.x" +"213","crossdomain.xml" +"213","ptvs" +"213","servercontrols" +"213","single-threaded" +"213","blueprint-css" +"213","eofexception" +"213","dynamic-routing" +"213","html-content-extraction" +"213","htmlunit-driver" +"213","frappe" +"213","rdoc" +"213","luhn" +"213","null-terminated" +"213","tag-cloud" +"213","spyne" +"213","sqlpackage" +"213","resource-leak" +"213","qgridlayout" +"213","oledbdataadapter" +"213","google-cloud-python" +"213","msw" +"213","stm" +"213","ifttt" +"213","media-library" +"213","web-bluetooth" +"213","tftp" +"213","git-tfs" +"212","truthtable" +"212","react-native-gifted-chat" +"212","yandex" +"212","apollo-federation" +"212","nfc-p2p" +"212","phrase" +"212","rjs" +"212","jmstemplate" +"212","css-frameworks" +"212","share-extension" +"212","rnotebook" +"212","win32ole" +"212","groupwise-maximum" +"212","negative-lookbehind" +"212","spring-form" +"212","apple-watch-complication" +"212","orocrm" +"212","visual-studio-2008-sp1" +"212",".env" +"212","microsoft-graph-files" +"212","rich-snippets" +"212","directoryentry" +"212","numpy-ufunc" +"212","gcp-ai-platform-notebook" +"212","mod-alias" +"212","asset-catalog" +"212","devicetoken" +"212","aspectj-maven-plugin" +"212","dotcover" +"212","angular2-ngmodel" +"212","csv-import" +"212","activity-indicator" +"212","requestdispatcher" +"212","states" +"212","multer-s3" +"212","webcam-capture" +"212","sourcegenerators" +"212","quarkus-rest-client" +"212","baud-rate" +"212","embedded-tomcat-8" +"211","trial" +"211","grav" +"211","webusb" +"211","client-go" +"211","file-browser" +"211","ll-grammar" +"211","philips-hue" +"211","gradle-dependencies" +"211","hyperledger-sawtooth" +"211","django-postgresql" +"211","servant" +"211","singlechildscrollview" +"211","dl4j" +"211","couchdb-futon" +"211","kafka-topic" +"211","spring-cloud-config-server" +"211","android-textwatcher" +"211","mongoid3" +"211","jquery-jscrollpane" +"211","influxdb-python" +"211","jquery-gmap3" +"211","developer-console" +"211","orchardcms-1.7" +"211","atlassian-plugin-sdk" +"211","net-ssh" +"211","drawrectangle" +"211","redistributable" +"211","dig" +"211","nstoolbar" +"211","tns" +"211","asprepeater" +"211","node.js-typeorm" +"211","android-maven-plugin" +"211","generated" +"211","collapsable" +"211","ogre3d" +"211","par" +"211","automatic-differentiation" +"211","sts" +"211","componentone" +"211","qsqltablemodel" +"211","iis-5" +"211","gnu-coreutils" +"211","qtablewidgetitem" +"210","jco" +"210","deconvolution" +"210","class-transformer" +"210","remote-control" +"210","multiple-file-upload" +"210","selendroid" +"210","jsviews" +"210","agi" +"210","mybb" +"210","mysqlimport" +"210","kedro" +"210","onmousedown" +"210","html-parser" +"210","sanic" +"210","dynatrace" +"210","pci-dss" +"210","twilio-studio" +"210","craco" +"210","blobstorage" +"210","code-folding" +"210","knative" +"210","highdpi" +"210","dotfiles" +"210","uicollectionviewflowlayout" +"210","asp.net-core-8" +"210","jakarta-migration" +"210","elementwise-operations" +"210","google-console-developer" +"210","cgfloat" +"210","maximo-anywhere" +"210","autoregressive-models" +"210","utilities" +"210","ticket-system" +"210","panning" +"210","liferay-ide" +"209","printer-control-language" +"209","clientid" +"209","jca" +"209","graphml" +"209","stacked-area-chart" +"209","contain" +"209","datamember" +"209","xdp-bpf" +"209","optuna" +"209","vcf-variant-call-format" +"209","angular-mock" +"209","vast" +"209","angularjs-ng-transclude" +"209","airprint" +"209","nskeyedunarchiver" +"209","erlang-supervisor" +"209","saved-searches" +"209","type-theory" +"209","anchor-solana" +"209","amfphp" +"209","google-apps-script-editor" +"209","code-structure" +"209","abbreviation" +"209","janus" +"209","form-authentication" +"209","jacob" +"209","business-logic-layer" +"209","loose-coupling" +"209","ninject-2" +"209","moya" +"209","rescue" +"209","loess" +"209","spiral" +"209","lcs" +"209","webfaction" +"209","dapr" +"209","identification" +"209","archiving" +"209","thunderbird-addon" +"209","maven-site-plugin" +"209","beta-testing" +"209","autocorrect" +"209","stencil-buffer" +"209","autocommit" +"208","floyd-warshall" +"208","prims-algorithm" +"208","jfoenix" +"208","ggally" +"208","multiple-users" +"208","phpredis" +"208","jdbcrealm" +"208","listpicker" +"208","ebcdic" +"208","django-aggregation" +"208","futuretask" +"208","meteor-react" +"208","sip-server" +"208","namenode" +"208","rebol3" +"208","windows-identity" +"208","html-sanitizing" +"208","opencart2.3" +"208","android-vibration" +"208","sam" +"208","mongodb-update" +"208","azure-alerts" +"208","visual-studio-macros" +"208","build-script" +"208","javascript-injection" +"208","mobile-webkit" +"208","playsound" +"208","android-elevation" +"208","drupal-commerce" +"208","bytestring" +"208","google-cloud-iot" +"208","chars" +"208","spotify-app" +"208","meld" +"208","qabstracttablemodel" +"208","commandlink" +"208","commoncrypto" +"208","node-mssql" +"208","protobuf-c" +"208","trackbar" +"208","start-job" +"208","struts-tags" +"208","limesurvey" +"208","flutter-streambuilder" +"208","zimbra" +"208","bigcartel" +"208","transclusion" +"208","flutter-windows" +"208","use-case-diagram" +"207","jexcelapi" +"207","tsqlt" +"207","debian-jessie" +"207","grib" +"207","gitk" +"207","js-amd" +"207","django-1.6" +"207","api-manager" +"207","selenium4" +"207","kube-dns" +"207","verifyerror" +"207","metricbeat" +"207","calabash-ios" +"207","aws-iot-core" +"207","angular-ui-typeahead" +"207","facebook-webhooks" +"207","spring-boot-gradle-plugin" +"207","nsopenpanel" +"207","twilio-functions" +"207","world-of-warcraft" +"207","couchbase-view" +"207","sustainsys-saml2" +"207","video-conferencing" +"207","extended-ascii" +"207","facebook-app-requests" +"207","rdata" +"207","ranorex" +"207","setattr" +"207","visual-glitch" +"207","wordpress-hook" +"207","assemblyinfo" +"207","open-json" +"207","regexp-like" +"207","dotfuscator" +"207","redirecttoaction" +"207","buttongroup" +"207","tag-it" +"207","irq" +"207","ekeventstore" +"207","geometryreader" +"207","columnstore" +"207","ace" +"207","okd" +"207","excel-2019" +"207","comobject" +"207","image-comparison" +"207","securesocial" +"207","sourceforge" +"207","searchable" +"206","vtigercrm" +"206","ssms-2014" +"206","widechar" +"206","ssas-2008" +"206","apache-commons-math" +"206","matlab-app-designer" +"206","slave" +"206","apify" +"206","imblearn" +"206","labeling" +"206","choicefield" +"206","symbol-table" +"206","chdir" +"206","watchos-3" +"206","card.io" +"206","crontrigger" +"206","reconnect" +"206","unordered" +"206","sign-in-with-apple" +"206","jxls" +"206","scala-2.11" +"206","twig-extension" +"206","post-commit" +"206","susy" +"206","brainfuck" +"206","android-x86" +"206","kmdf" +"206","set-difference" +"206","go-fiber" +"206","java-http-client" +"206","buildconfiguration" +"206","todataurl" +"206","uialertaction" +"206","xcode9.2" +"206","asp.net-boilerplate" +"206","tkinter-text" +"206","mobx-state-tree" +"206","project-planning" +"206","accurev" +"206","ninject-extensions" +"206","generic-type-argument" +"206","moto" +"206","mpfr" +"206","webmethods" +"206","alloc" +"206","parameter-pack" +"206","utf8-decode" +"206","linkedin-jsapi" +"205","graphql-codegen" +"205","pg-search" +"205","flower" +"205","git-bare" +"205","vtl" +"205","rel" +"205","configurable-product" +"205","data-masking" +"205","firebase-performance" +"205","manage.py" +"205","jtableheader" +"205","python-hypothesis" +"205","python-ggplot" +"205","camel-ftp" +"205","database-optimization" +"205","jpeg2000" +"205","pdf-form" +"205","opendj" +"205","ncbi" +"205","bootstrap-tabs" +"205","tui" +"205","application-cache" +"205","wt" +"205","sap-gateway" +"205","mailjet" +"205","kramdown" +"205","audioqueue" +"205","revel" +"205","levelplot" +"205","lyx" +"205","outsystems" +"205","pyhook" +"205","order-of-execution" +"205","mobilenet" +"205","gunzip" +"205","cordova-ios" +"205","uiblureffect" +"205","lasagne" +"205","accounts" +"205","lua-api" +"205","httpbuilder" +"205","google-cloud-dataprep" +"205","trait-objects" +"205","autocorrelation" +"205","allennlp" +"205","prepare" +"205","git-status" +"204","removeeventlistener" +"204","liveserver" +"204","squish" +"204","mvel" +"204","listdir" +"204","live-templates" +"204","mxmlc" +"204","xrm" +"204","unicode-normalization" +"204","jsonconvert" +"204","binary-operators" +"204","app.xaml" +"204","address-bar" +"204","rjdbc" +"204","key-events" +"204","ruby-1.8.7" +"204","pubmed" +"204","dynamicform" +"204","androidviewclient" +"204","sap-dotnet-connector" +"204","networkonmainthread" +"204","dollar-sign" +"204","dokuwiki" +"204","3nf" +"204","build-dependencies" +"204","tabcontainer" +"204","gcdasyncsocket" +"204","dragula" +"204","text-search" +"204","node.js-stream" +"204","linear-equation" +"204","linked-tables" +"204","sublimelinter" +"203","ef-core-7.0" +"203","wijmo" +"203","staggered-gridview" +"203","jersey-1.0" +"203","multiuserchat" +"203","django-comments" +"203","datapump" +"203","disparity-mapping" +"203","fsevents" +"203","celltable" +"203","freetype2" +"203","avrdude" +"203","jqgrid-php" +"203","io-monad" +"203","supercsv" +"203","android-togglebutton" +"203","android-switch" +"203","jython-2.7" +"203","onmousemove" +"203","ranking-functions" +"203","orgchart" +"203","android-actionmode" +"203","ezpublish" +"203","facebook-chat" +"203","sql-query-store" +"203","opentbs" +"203","uikit-dynamics" +"203","vhd" +"203","hardware-interface" +"203","expo-av" +"203","itemizedoverlay" +"203","nomad" +"203","android-inapp-purchase" +"203","google-cloud-endpoints-v2" +"203","oidc-client-js" +"203","commandbinding" +"203","merging-data" +"203","qtcharts" +"203","bevy" +"202","background-music" +"202","fibers" +"202","umbraco6" +"202","jshell" +"202","cds" +"202","angular-nvd3" +"202","wakeup" +"202","servicenow-rest-api" +"202","readprocessmemory" +"202","rpn" +"202","cpu-speed" +"202","ioncube" +"202","azure-ad-b2b" +"202","payflowpro" +"202","spring-framework-beans" +"202","information-theory" +"202","pydot" +"202","raw-data" +"202","side-menu" +"202","code-composer" +"202","game-maker-studio-2" +"202","custom-object" +"202","google-cloud-print" +"202","cfhttp" +"202","activity-recognition" +"202","elgg" +"202","laravel-pagination" +"202","qsortfilterproxymodel" +"202","maven-tomcat-plugin" +"202","google-speech-to-text-api" +"202","zend-auth" +"202","parallel-testing" +"202","heightmap" +"202","forcats" +"202","gitosis" +"202","panorama-control" +"201","ddp" +"201","multiple-definition-error" +"201","main-activity" +"201","bit.ly" +"201","ng-map" +"201","flash-cc" +"201","disjoint-sets" +"201","pandas.excelwriter" +"201","adwhirl" +"201","cross-domain-policy" +"201","falconframework" +"201","pst" +"201","mfc-feature-pack" +"201","mysql-cluster" +"201","rna-seq" +"201","rrd" +"201","spring-cloud-aws" +"201","wp-admin" +"201","lync-2013" +"201","shadow-mapping" +"201","vimdiff" +"201","siemens" +"201","dolphindb" +"201","polkadot" +"201","hibernate-tools" +"201","azure-servicebus-subscriptions" +"201","azure-postgresql" +"201","policies" +"201","bytea" +"201","executioncontext" +"201","httpx" +"201","strikethrough" +"201","request.querystring" +"201","special-folders" +"201","custom-url" +"201","ijulia-notebook" +"201","email-address" +"201","compiler-theory" +"201","zend-navigation" +"201","prefect" +"201","powerdesigner" +"201","msal-angular" +"200","github-cli" +"200","ansible-vault" +"200","profiles" +"200","localdatetime" +"200","youcompleteme" +"200","api-versioning" +"200","symfony-routing" +"200","python-camelot" +"200","language-interoperability" +"200","jtag" +"200","kubernetes-apiserver" +"200","mysql-slow-query-log" +"200","wavesurfer.js" +"200","wchar" +"200","pyc" +"200","canonicalization" +"200","operations-research" +"200","growl" +"200","nestjs-typeorm" +"200","twitter-bootstrap-rails" +"200","guacamole" +"200","inline-code" +"200","facebook-group" +"200","visual-c++-2008" +"200","browsermob-proxy" +"200","rakudo" +"200","mage" +"200","fparsec" +"200","hgignore" +"200","ods" +"200","lean" +"200","text-segmentation" +"200","duende-identity-server" +"200","color-mapping" +"200","geohashing" +"200","reactcsstransitiongroup" +"200","dart2js" +"200","auto-py-to-exe" +"200","computer-forensics" +"200","transaction-log" +"200","glreadpixels" +"200","querystringparameter" +"200","preferencescreen" +"199","jess" +"199","phpspec" +"199","maskedinput" +"199","material3" +"199","gettype" +"199","yard" +"199","base-conversion" +"199","fflush" +"199","phpcs" +"199","multiple-axes" +"199","cloudwatch-alarms" +"199","squeryl" +"199","xll" +"199","python-imageio" +"199","meteor-collection2" +"199","dmd" +"199","docker-api" +"199","katex" +"199","coupling" +"199","invite" +"199","twisted.web" +"199","wql" +"199","inversifyjs" +"199","scala-breeze" +"199","asynctaskloader" +"199","javafx-3d" +"199","forwarding-reference" +"199","amplifyjs" +"199","javaparser" +"199","shinywidgets" +"199","netmiko" +"199","iverilog" +"199","garrys-mod" +"199","sqlmembershipprovider" +"199","aslr" +"199","uint64" +"199","scorm2004" +"199","dsym" +"199","context.xml" +"199","getpixel" +"199","android-savedstate" +"199","getimagesize" +"199","lauterbach" +"199","qaf" +"199","custom-error-handling" +"199","git-workflow" +"199","tiles2" +"199","identify" +"199","identity-experience-framework" +"198","bacon.js" +"198","maui-windows" +"198","loaddata" +"198","treepanel" +"198","flowbite" +"198","whatsapp-cloud-api" +"198","jflex" +"198","phphotolibrary" +"198","flutter-change-notifier" +"198","import.io" +"198","json-path-expression" +"198","biztalk-mapper" +"198","switchmap" +"198","umd" +"198","servletcontextlistener" +"198","angular-moment" +"198","sequence-points" +"198","factor-analysis" +"198","mfmessagecomposeviewcontroller" +"198","hyphenation" +"198","recorder" +"198","onunload" +"198","sap-web-ide" +"198","sbt-plugin" +"198","nestedrecyclerview" +"198","spring-social-facebook" +"198","google-assist-api" +"198","minifilter" +"198","ubuntu-13.10" +"198","google-chat" +"198","go-cd" +"198","pyperclip" +"198","nuxt-auth" +"198","android-contextmenu" +"198","angular-cdk-drag-drop" +"198","custom-routes" +"198","ios8-extension" +"198","android-loader" +"198","curl-multi" +"198","mouse-position" +"198","compose-recomposition" +"198","gnustep" +"198","hbm2ddl" +"198","bcd" +"198","solution-explorer" +"198","gmm" +"198","mediawiki-templates" +"198","linq2db" +"198","stdoptional" +"198","urlparse" +"198","usrp" +"197","sklabelnode" +"197","ssms-17" +"197","multiview" +"197","mathematica-8" +"197","trust" +"197","declarative-services" +"197","product-quantity" +"197","file-search" +"197","dired" +"197","symfony-3.1" +"197","cartalyst-sentry" +"197","pubspec" +"197","jnienv" +"197","varchar2" +"197","hot-module-replacement" +"197","twilio-video" +"197","bnd" +"197","postdata" +"197","jasmine2.0" +"197","codeplex" +"197","rational-team-concert" +"197","cognos-11" +"197","java-stored-procedures" +"197","ufw" +"197","rethinkdb-javascript" +"197","360-degrees" +"197","iscroll4" +"197","dingo-api" +"197","devexpress-mvc" +"197","chainer" +"197","du" +"197","node-cron" +"197","centos6.5" +"197","getselection" +"197","angularjs-digest" +"197","bigbluebutton" +"197","mdxjs" +"197","ilog" +"197","dart-editor" +"197","auto-ptr" +"196","git-for-windows" +"196","jdatechooser" +"196","slcomposeviewcontroller" +"196","gridsplitter" +"196","getvalue" +"196","installation-package" +"196","mutation-testing" +"196","remove-if" +"196","smart-tv" +"196","json-patch" +"196","image-scanner" +"196","rust-sqlx" +"196","django-compressor" +"196","kinvey" +"196","win2d" +"196","create-react-native-app" +"196","kendo-ui-grid" +"196","onpaint" +"196","jquery-post" +"196","android-touch-event" +"196","easygui" +"196","blockly" +"196","extrapolation" +"196","lvm" +"196","networkextension" +"196","astyanax" +"196","objectdisposedexception" +"196","shopify-api-node" +"196","rdma" +"196","java-14" +"196","retention" +"196","drupal-fapi" +"196","plotnine" +"196","gallio" +"196","timefold" +"196","ui-select2" +"196","testrail" +"196","elapsedtime" +"196","geonames" +"196","compose-multiplatform" +"196","ash" +"196","artisan-migrate" +"196","dart-io" +"196","alternate" +"196","alwayson" +"195","marklogic-dhf" +"195","base-class-library" +"195","ssrs-2014" +"195","clos" +"195","cloudera-quickstart-vm" +"195","slick-2.0" +"195","vuedraggable" +"195","stage3d" +"195","flutter-cupertino" +"195","page-fault" +"195","jsplitpane" +"195","mantine" +"195","dockerpy" +"195","watchman" +"195","watson-studio" +"195","avqueueplayer" +"195","caliburn" +"195","crf" +"195","pruning" +"195","android-typeface" +"195","native-web-component" +"195","braces" +"195","border-radius" +"195","swiftlint" +"195","wp-cli" +"195","inf" +"195","nedb" +"195","enyo" +"195","code-complexity" +"195","obsolete" +"195","mix-blend-mode" +"195","orika" +"195","gwt-gin" +"195","regional-settings" +"195","isql" +"195","hardlink" +"195","elasticsearch-py" +"195","android-mediaprojection" +"195","ipdb" +"195","qos" +"195","ms-access-forms" +"195","zeroconf" +"195","batching" +"195","gjs" +"195","gnome-3" +"195","mbstring" +"194","cmsis" +"194","cmakelists-options" +"194","backoffice" +"194","intellij-15" +"194","yaws" +"194","ssh-keygen" +"194","ng-switch" +"194","sobel" +"194","image-thresholding" +"194","xlookup" +"194","appauth" +"194","find-replace" +"194","imagenet" +"194","callable-statement" +"194","databricks-connect" +"194","datagridviewcomboboxcell" +"194","recompose" +"194","icon-fonts" +"194","capture-group" +"194","input-type-file" +"194","apple-music" +"194","pathos" +"194","nscoder" +"194","invalid-characters" +"194","android-scroll" +"194","create-directory" +"194","setcontentview" +"194","pyshark" +"194","magic-numbers" +"194","android-doze" +"194","xc8" +"194","longest-substring" +"194","spigot" +"194","z80" +"194","binaries" +"194","arcobjects" +"194","arrayfire" +"194","bcc" +"194","zend-mail" +"194","part-of-speech" +"194","zfcuser" +"193","temporal-tables" +"193","eclipse-rap" +"193","regularized" +"193","jenkins-blueocean" +"193","apache-commons-io" +"193","yamldotnet" +"193","filechannel" +"193","apache-hudi" +"193","liquid-layout" +"193","sshpass" +"193","cider" +"193","kvc" +"193","vmware-player" +"193","server.xml" +"193","validationrules" +"193","mysql-connect" +"193","recompile" +"193","docutils" +"193","roundcube" +"193","aws-organizations" +"193","validationerror" +"193","method-resolution-order" +"193","puts" +"193","hortonworks-sandbox" +"193","equalizer" +"193","jvm-bytecode" +"193","spring-ioc" +"193","jquery-inputmask" +"193","supabase-js" +"193","librdkafka" +"193","sigkill" +"193","pyscripter" +"193","system.in" +"193","ancestry" +"193","knowledge-graph" +"193","expression-evaluation" +"193","todo" +"193","sql-server-2005-express" +"193","xamarin.essentials" +"193","northwind" +"193","opensl" +"193","hydration" +"193","ios-animations" +"193","ipython-parallel" +"193","textnode" +"193","sonata-media-bundle" +"193","qtconcurrent" +"193","zodb" +"193","zend-search-lucene" +"193","mechanize-ruby" +"193","themoviedb-api" +"193","compose-desktop" +"192","yarnpkg-v2" +"192","jenssegers-mongodb" +"192","livecycle-designer" +"192","appdynamics" +"192","apache-tez" +"192","waitress" +"192","dlsym" +"192","docker-entrypoint" +"192","kendo-combobox" +"192","jfr" +"192","watson-iot" +"192","jitter" +"192","ruby-hash" +"192","fat" +"192","appwidgetprovider" +"192","apr" +"192","satellite-image" +"192","pass-through" +"192","android-shape" +"192","derived-table" +"192","boost-hana" +"192","superuser" +"192","equations" +"192","envelope" +"192","dojox.charting" +"192","midl" +"192","wmp" +"192","uint" +"192","itemtouchhelper" +"192","xcode10.1" +"192","npm-run" +"192","redirectstandardoutput" +"192","azure-python-sdk" +"192","ios-keyboard-extension" +"192","resource-cleanup" +"192","react-hot-loader" +"192","laravel-websockets" +"192","pentaho-report-designer" +"192","multi-device-hybrid-apps" +"192","alu" +"192","sonarscanner" +"192","biml" +"192","url-parsing" +"192","webjars" +"192","google-mobile-ads" +"192","scripting-bridge" +"191","yosys" +"191","unet-neural-network" +"191","django-1.10" +"191","casablanca" +"191","rtweet" +"191","wildfly-swarm" +"191","simulated-annealing" +"191","was" +"191","wakanda" +"191","iomanip" +"191","visa" +"191","javascriptmvc" +"191","rdfa" +"191","refluxjs" +"191","isnumeric" +"191","xap" +"191","associativity" +"191","lpc" +"191","google-cloud-tpu" +"191","angular-file-upload" +"191","qmap" +"191","mtp" +"191","quart" +"191","google-tasks-api" +"191","muenchian-grouping" +"191","hexagonal-architecture" +"191","totp" +"191","zenity" +"190","vtd-xml" +"190","procedural" +"190","trinidad" +"190","get-wmiobject" +"190","vocabulary" +"190","kubernetes-dashboard" +"190","aws-parameter-store" +"190","windows-defender" +"190","docker-stack" +"190","pushdown-automaton" +"190","iaas" +"190","ingress-controller" +"190","twitch-api" +"190","libs" +"190","coil" +"190","asp.net-authentication" +"190","uicollectionreusableview" +"190","nuitka" +"190","non-greedy" +"190","home-directory" +"190","asp.net-core-localization" +"190","qbfc" +"190","activitygroup" +"190","glow" +"190","amazon-appstore" +"190","bidi" +"190","maven-resources-plugin" +"190","asana-api" +"190","steamworks-api" +"190","script#" +"190","tfx" +"189","trix" +"189","jcache" +"189","gitea" +"189","class-members" +"189","matrix-factorization" +"189","symfony-2.2" +"189","xml-layout" +"189","include-guards" +"189","xpc" +"189","circle-pack" +"189","cargo" +"189","sharepoint-apps" +"189","w3wp" +"189","grafana-templating" +"189","avd-manager" +"189","airflow-webserver" +"189","rufus-scheduler" +"189","sink" +"189","core-video" +"189","dynamic-class-loaders" +"189","entity-framework-ctp5" +"189","save-image" +"189","worker-thread" +"189","openfoam" +"189","aws-sdk-java-2.0" +"189","twilio-programmable-voice" +"189","pyppeteer" +"189","winlogon" +"189","lzw" +"189","fragmentation" +"189","observedobject" +"189","scaletransform" +"189","business-catalyst" +"189","dexguard" +"189","tapi" +"189","drjava" +"189","drizzle" +"189","android-configchanges" +"189","gameplay-kit" +"189","xcode-server" +"189","r6" +"189","http-status-code-429" +"189","android-runonuithread" +"189","getopt-long" +"189","ipad-2" +"189","test-runner" +"189","zephyr-rtos" +"189","avalonedit" +"189","alphabetical-sort" +"188","react-redux-firebase" +"188","primeng-turbotable" +"188","filelock" +"188","intel-vtune" +"188","livesearch" +"188","in-app-update" +"188","xeon-phi" +"188","bixbystudio" +"188","mapactivity" +"188","kendo-datepicker" +"188","django-fixtures" +"188","aws-elb" +"188","data-dictionary" +"188","datacontractjsonserializer" +"188","django-manage.py" +"188","payu" +"188","derived-types" +"188","pathname" +"188","invocation" +"188","oozie-workflow" +"188","outlook-calendar" +"188","bspline" +"188","sieve-algorithm" +"188","java-server" +"188","build-agent" +"188","milo" +"188","ob-start" +"188","amcharts5" +"188","mini-css-extract-plugin" +"188","magento2.4" +"188","face" +"188","rhel5" +"188","referrals" +"188","quotations" +"188","execute-immediate" +"188","openstack-neutron" +"188","scd" +"188","changelistener" +"188","huge-pages" +"188","pyttsx" +"188","httppostedfilebase" +"188","getscript" +"188","elasticsearch-mapping" +"188","stateless-session-bean" +"188","embedded-fonts" +"188","emplace" +"187","tron" +"187","matlab-engine" +"187","apache-cordova" +"187","litedb" +"187","caroufredsel" +"187","carplay" +"187","union-find" +"187","chicken-scheme" +"187","adk" +"187","adventure" +"187","kingfisher" +"187","sitecore8.1" +"187","warbler" +"187","unity-networking" +"187","puphpet" +"187","angular-standalone-components" +"187","angular-providers" +"187","vugen" +"187","angularjs-module" +"187","jibx" +"187","easynetq" +"187","enum-class" +"187","on-the-fly" +"187","epplus-4" +"187","authenticode" +"187","formclosing" +"187","minidump" +"187","rft" +"187","vips" +"187","abstract-methods" +"187","drf-yasg" +"187","mixer" +"187","gcp-load-balancer" +"187","acpi" +"187","terraform-modules" +"187","mercurial-hook" +"187","google-developer-tools" +"187","looper" +"187","logstash-jdbc" +"187","android-paging-library" +"187","angular2-pipe" +"187","sealed" +"187","pre-build-event" +"187","tooltipster" +"187","som" +"187","hazelcast-jet" +"187","state-space" +"186","intercom" +"186","gridsome" +"186","graphframes" +"186","file-attributes" +"186","int32" +"186","gio" +"186","jenkins-api" +"186","template-classes" +"186","panda3d" +"186","cheat-engine" +"186","vote" +"186","ng-controller" +"186","apache-modules" +"186","swipeview" +"186","appfog" +"186","binary-compatibility" +"186","cedet" +"186","unwrap" +"186","metatable" +"186","vendor-prefix" +"186","ibm-mobile-services" +"186","dependabot" +"186","boosting" +"186","infiniband" +"186","mongodb-csharp-2.0" +"186","detachedcriteria" +"186","mailitem" +"186","uberjar" +"186","formio" +"186","min-heap" +"186","wkt" +"186","otto" +"186","network-security" +"186","dokan" +"186","android-14" +"186","np-hard" +"186","nuke" +"186","tasklist" +"186","spritebatch" +"186","mobaxterm" +"186","handwriting-recognition" +"186","polybase" +"186","dsa" +"186","iphone-web-app" +"186","progressive-enhancement" +"186","promtail" +"186","http-status-code-304" +"186","qfilesystemmodel" +"186","evil-mode" +"186","qglwidget" +"186","parseexception" +"186","submatrix" +"185","slowcheetah" +"185","try-finally" +"185","cleartimeout" +"185","apache-jena" +"185","apache-kafka-mirrormaker" +"185","xhtml-1.0-strict" +"185","ownerdrawn" +"185","seh" +"185","distcp" +"185","distributed-database" +"185","xml-configuration" +"185","content-negotiation" +"185","first-order-logic" +"185","narrowing" +"185","simple-form-for" +"185","pushpin" +"185","optional-chaining" +"185","unreachable-code" +"185","public-method" +"185","dynamic-reports" +"185","delphi-prism" +"185","tws" +"185","port-scanning" +"185","netweaver" +"185","system-verilog-assertions" +"185","ubuntu-10.10" +"185","kombu" +"185","signed-apk" +"185","mailcore2" +"185","vertx-verticle" +"185","didreceivememorywarning" +"185","uimanageddocument" +"185","openshift-enterprise" +"185","azure-synapse-analytics" +"185","c#-10.0" +"185","execv" +"185","android-diffutils" +"185","gcc4" +"185","xcode4.4" +"185","aspose.pdf" +"185","mention" +"185","node-async" +"185","ehcache-3" +"185","google-cloud-ml-engine" +"185","custom-authentication" +"185","google-reader" +"185","parse-tree" +"185","maven-deploy-plugin" +"185","dart-js-interop" +"185","scsi" +"185","qsettings" +"185","qtkit" +"185","usernotifications" +"185","bbc-microbit" +"184","staleelementreferenceexception" +"184","master-theorem" +"184","gitbook" +"184","tstringgrid" +"184","datastax-startup" +"184","db2-zos" +"184","unique-id" +"184","nexus-5" +"184","malformed" +"184","xmlunit" +"184","iasyncenumerable" +"184","validationattribute" +"184","journal" +"184","serverless-architecture" +"184","data-driven" +"184","documentviewer" +"184","keypoint" +"184","windows-1252" +"184","create-view" +"184","pdfview" +"184","android-studio-3.1" +"184","twisted.internet" +"184","inline-functions" +"184","typecasting-operator" +"184","hstack" +"184","oauth-1.0a" +"184","set-theory" +"184","rapidxml" +"184","domcrawler" +"184","pyrebase" +"184","kriging" +"184","openscad" +"184","spservices" +"184","mockserver" +"184","qvariant" +"184","scichart" +"184","android-mediasession" +"184","qregexp" +"184","combinators" +"184","pyvmomi" +"184","monk" +"184","changestream" +"184","iperf" +"184","fody" +"184","alljoyn" +"184","web-inf" +"184","tramp" +"184","std-filesystem" +"184","bde" +"184","user-stories" +"184","sunos" +"184","iformfile" +"183","release-mode" +"183","jekyll-theme" +"183","webvtt" +"183","webrat" +"183","react-native-testing-library" +"183","instance-methods" +"183","templatefield" +"183","clojure.spec" +"183","python-descriptors" +"183","ng-bind" +"183","smote" +"183","packagemaker" +"183","page-numbering" +"183","ngrx-entity" +"183","biztalk-2013r2" +"183","swrl" +"183","biztalk-2009" +"183","joomla-component" +"183","dat.gui" +"183","oracle-fusion-middleware" +"183","kendo-multiselect" +"183","oracle-ebs" +"183","kind" +"183","tukey" +"183","gtkmm3" +"183","formcollection" +"183","google-chrome-storage" +"183","java-compiler-api" +"183","rickshaw" +"183","word-boundary" +"183","attask" +"183","pymel" +"183","android-dark-theme" +"183","spymemcached" +"183","bytestream" +"183","spoon" +"183","etherscan" +"183","project.json" +"183","active-form" +"183","census" +"183","predictionio" +"182","prismic.io" +"182","class-attributes" +"182","relative-import" +"182","rep" +"182","srt" +"182","phonon" +"182","swiftui-scrollview" +"182","pinning" +"182","v-select" +"182","datapager" +"182","python-sounddevice" +"182","findelement" +"182","django-timezone" +"182","row-height" +"182","server-configuration" +"182","docusigncompositetmplts" +"182","angular-schematics" +"182","gradle-eclipse" +"182","aio" +"182","android-sliding" +"182","pdf-parsing" +"182","sbjson" +"182","sim900" +"182","postfix-operator" +"182","libreoffice-base" +"182","kong-plugin" +"182","video-conversion" +"182","pyproj" +"182","bucklescript" +"182","setjmp" +"182","orbital-mechanics" +"182","rippledrawable" +"182","hole-punching" +"182","x3d" +"182","uimanager" +"182","dtls" +"182","homebrew-cask" +"182","difftime" +"182","chartboost" +"182","access-point" +"182","eventstoredb" +"182","pessimistic-locking" +"182","lost-focus" +"182","spine.js" +"182","oid" +"182","oculusquest" +"182","geocoder" +"182","transcription" +"182","thunk" +"182","sulu" +"181","smallrye" +"181","client-side-scripting" +"181","mathematical-morphology" +"181","jbox2d" +"181","page-factory" +"181","pic32" +"181","jspinclude" +"181","python-2to3" +"181","chord-diagram" +"181","datetimeformatter" +"181","jgraphx" +"181","mysql-num-rows" +"181","psobject" +"181","ruby-c-extension" +"181","mysql-error-1045" +"181","aggregates" +"181","windows-security" +"181","turkish" +"181","apportable" +"181","nsapplication" +"181","android-sdk-2.1" +"181","power-automate-desktop" +"181","winhttprequest" +"181","exuberant-ctags" +"181","pymunk" +"181","ocl" +"181","library-project" +"181","wireframe" +"181","magick++" +"181","rhapsody" +"181","redux-reducers" +"181","openseadragon" +"181","jackson-modules" +"181","scenegraph" +"181","android-internal-storage" +"181","context-free-language" +"181","scalding" +"181","byref" +"181","asp.net-mvc-validation" +"181","assembly-binding-redirect" +"181","r.net" +"181","log4cxx" +"181","mounted-volumes" +"181","most-vexing-parse" +"181","lr-grammar" +"181","qbasic" +"181","ninja-forms" +"181","lowpass-filter" +"181","seaside" +"181","automation-testing" +"181","glx" +"181","subviews" +"181","linq-to-dataset" +"181","array-unique" +"181","webpack-3" +"181","mediainfo" +"181","linux-capabilities" +"181","zendesk-api" +"181","subtyping" +"181","stata-macros" +"180","effective-java" +"180","ssas-2012" +"180","jelly" +"180","phonegap-desktop-app" +"180","slack-block-kit" +"180","technical-indicator" +"180","firebase-app-distribution" +"180","selenium-edgedriver" +"180","data-representation" +"180","unix-ar" +"180","watershed" +"180","fact" +"180","varnish-4" +"180","icloud-drive" +"180","anki" +"180","meteor-up" +"180","postdelayed" +"180","blpapi" +"180","bounded-contexts" +"180","worklight-security" +"180","extjs7" +"180","significant-digits" +"180","minecraft-fabric" +"180","system.net.httpwebrequest" +"180","acceleration" +"180","home-assistant" +"180","pocketpc" +"180","tms" +"180","mkpolyline" +"180","uidocumentpickerviewcontroller" +"180","galaxy-tab" +"180","gyp" +"180","scrapinghub" +"180","ios9.3" +"180","duplication" +"180","tomcat10" +"180","streamsets" +"180","dagster" +"180","maven-jar-plugin" +"180","zelle-graphics" +"180","hclust" +"180","paradox" +"180","thonny" +"179","multi-window" +"179","jes" +"179","xsd-1.1" +"179","tekton" +"179","jdb" +"179","grouplayout" +"179","tray" +"179","tstringlist" +"179","bitbucket-cloud" +"179","cons" +"179","incognito-mode" +"179","fivem" +"179","snapcraft" +"179","voting-system" +"179","dirent.h" +"179","django-admin-filters" +"179","marginal-effects" +"179","vcr" +"179","simplecv" +"179","service-fabric-stateless" +"179","angular-local-storage" +"179","dynamic-pivot" +"179","apprequests" +"179","dynamic-dispatch" +"179","passport-google-oauth" +"179","apple-musickit" +"179","jquery-slider" +"179","revealing-module-pattern" +"179","return-value-optimization" +"179",".net-core-2.1" +"179","sys-refcursor" +"179","bstr" +"179","luasocket" +"179","xbox-one" +"179","azure-speech" +"179","tabulate" +"179","sqldatetime" +"179","asp.net-mvc-controller" +"179","azure-iot-central" +"179","double-click-advertising" +"179","non-relational-database" +"179","uint32" +"179","bundles" +"179","nul" +"179","retaincount" +"179","geom-col" +"179","text-decorations" +"179","evm" +"179","tethering" +"179","dup" +"179","spelling" +"179","mongorepository" +"179","generic-method" +"179","solr-query-syntax" +"179","d3-force-directed" +"179","arch" +"178","defaultlistmodel" +"178","loadimage" +"178","backcolor" +"178","fido" +"178","basecamp" +"178","reactphp" +"178","ghostdriver" +"178","bad-gateway" +"178","jsonschema2pojo" +"178","binary-serialization" +"178","smooks" +"178","appcmd" +"178","lalr" +"178","chronicle-queue" +"178","selectlistitem" +"178","doctrine-extensions" +"178","ibm-was" +"178","windows-embedded-compact" +"178","ibm-cloud-functions" +"178","kendo-ui-mvc" +"178","unused-variables" +"178","vcalendar" +"178","wagtail-streamfield" +"178","pscustomobject" +"178","bootstrapvalidator" +"178","nspopupbutton" +"178","azure-cloud-shell" +"178","spring-config" +"178","svnadmin" +"178","spring-portlet-mvc" +"178","app-startup" +"178","openapi-generator-maven-plugin" +"178","side-by-side" +"178","left-recursion" +"178","visnetwork" +"178","objective-c-2.0" +"178","wkwebviewconfiguration" +"178","object-pooling" +"178","auth-guard" +"178","buildx" +"178","domainservices" +"178","typo3-6.1.x" +"178","scrapy-shell" +"178","playwright-typescript" +"178","doublebuffered" +"178","mmc" +"178","c++builder-6" +"178","angular-aot" +"178","react-grid-layout" +"178","android-ion" +"178","mplfinance" +"178","mpmath" +"178","laravel-testing" +"178","source-code-protection" +"178","webi" +"178","argmax" +"178","vaadin23" +"178","glmmtmb" +"178","image-editing" +"178","scss-lint" +"178","mbedtls" +"178","hdr" +"178","fontforge" +"178","tiling" +"178","dac" +"178","pgm" +"177","jboss-4.2.x" +"177","vuefire" +"177","dedicated-server" +"177","clrs" +"177","printdialog" +"177","volatility" +"177","mariadb-10.3" +"177","apartment-gem" +"177","sharepointdocumentlibrary" +"177","icheck" +"177","mfi" +"177","ibm-sbt" +"177","alamofireimage" +"177","html.beginform" +"177","ponyorm" +"177","application.cfc" +"177","jqxhr" +"177","jaxb2-maven-plugin" +"177","synchronizationcontext" +"177","vmware-fusion" +"177","bresenham" +"177","review-board" +"177","lz4" +"177","openx" +"177","android-mediascanner" +"177","http-status-code-406" +"177","char-pointer" +"177","oledbdatareader" +"177","mongoskin" +"177","luabind" +"177","pyvisa" +"177","headless-ui" +"177","media-type" +"177","struts1" +"177","becomefirstresponder" +"177","web-config-transform" +"176","relaxng" +"176","lnk2001" +"176","debian-stretch" +"176","privacy-policy" +"176","interception" +"176","connexion" +"176","firefox4" +"176","unique-values" +"176","discourse" +"176","select-query" +"176","unistd.h" +"176","freepbx" +"176","semantic-release" +"176","putchar" +"176","pvlib" +"176","vxml" +"176","aggregate-initialization" +"176","kendo-mvvm" +"176","graphael" +"176","grails-3.1" +"176","wikidata-query-service" +"176","css-content" +"176","psychtoolbox" +"176","wallet-connect" +"176","fading" +"176","upi" +"176","rootscope" +"176","mysql-event" +"176","bootsfaces" +"176","coturn" +"176","nestjs-swagger" +"176","crawler4j" +"176","scalac" +"176","write.table" +"176","core-web-vitals" +"176","tvml" +"176","javax" +"176","microsoft-r" +"176","sgx" +"176","javascript-engine" +"176","shinymodules" +"176","microsoft-teams-js" +"176","4gl" +"176","rego" +"176","uicomponents" +"176","npm-link" +"176","plot-annotations" +"176","har" +"176","elastic-apm" +"176","custom-model-binder" +"176","strtol" +"176","test-explorer" +"176","cudf" +"176","stringification" +"176","android-runtime" +"176","sorteddictionary" +"176","textwrangler" +"176","hcatalog" +"176","shift-reduce-conflict" +"176","endeca" +"176","mbtiles" +"176","subgrid" +"175","wic" +"175","vue-script-setup" +"175","react-native-sectionlist" +"175","jedi" +"175","intel-ipp" +"175","location-href" +"175","photolibrary" +"175","printstream" +"175","pitest" +"175","symfony3" +"175","django-ckeditor" +"175","disruptor-pattern" +"175","variable-variables" +"175","databound" +"175","face-id" +"175","neo4j.rb" +"175","dyalog" +"175","dynamic-jasper" +"175","grub" +"175","grunt-contrib-concat" +"175","population" +"175","atexit" +"175","360-virtual-reality" +"175","freeimage" +"175","building-github-actions" +"175","ktor-client" +"175",".when" +"175","lerp" +"175","h.265" +"175","iwebbrowser2" +"175","nuxt-i18n" +"175","tail-call-optimization" +"175","hacklang" +"175","azure-monitor" +"175","reactjs.net" +"175","react-google-charts" +"175","qcheckbox" +"175","nifti" +"175","members" +"175","mpmediapickercontroller" +"175","subtree" +"175","encodeuricomponent" +"175","tfs-power-tools" +"175","toupper" +"175","lilypond" +"175","ms-query" +"175","auto-renewing" +"175","amazon-polly" +"175","stereoscopy" +"175","batch-updates" +"174","featherlight.js" +"174","yahoo-mail" +"174","yasm" +"174","pretty-urls" +"174","weebly" +"174","clap" +"174","react-native-listview" +"174","procmail" +"174","pandas-apply" +"174","pid-controller" +"174","symmetric" +"174","umbraco8" +"174","imagettftext" +"174","cartodb" +"174","symfony-cmf" +"174","snowflake-connector" +"174","image-preloader" +"174","ibm-api-management" +"174","metronic" +"174","pugixml" +"174","ptx" +"174","microsoft-distributed-file-system" +"174","jpype" +"174","sharethis" +"174","android-securityexception" +"174","jwe" +"174","equals-operator" +"174","azure-deployment-slots" +"174","surfaceholder" +"174","wpallimport" +"174","surveyjs" +"174","cocoa-design-patterns" +"174","network-monitoring" +"174","netbeans6.8" +"174","brave" +"174","word-2007" +"174","pyqgis" +"174","system.web" +"174","dopostback" +"174","rexx" +"174","sysctl" +"174","time-t" +"174","dih" +"174","draw.io" +"174","qvector" +"174","handles" +"174","plpython" +"174","asp.net-optimization" +"174","operand" +"174","redcap" +"174","ejabberd-module" +"174","node-cluster" +"174","launchmode" +"174","fogbugz" +"174","solr6" +"174","mtu" +"174","array-intersect" +"174","tilde" +"174","ieee" +"174","partial-page-refresh" +"173","eclipse-che" +"173","web-reference" +"173","liquibase-hibernate" +"173","flow-control" +"173","bitwise-xor" +"173","filereference" +"173","picture-in-picture" +"173","safaridriver" +"173","laravel-facade" +"173","swig-template" +"173","self-tracking-entities" +"173","mhtml" +"173","recurly" +"173","uptime" +"173","nrf52" +"173","application-shutdown" +"173","jwilder-nginx-proxy" +"173","posthoc" +"173","dynamic-html" +"173","botkit" +"173","couchbase-java-api" +"173","pygal" +"173","ocean" +"173","audioqueueservices" +"173","extent" +"173","dotnetnuke-5" +"173","taurus" +"173","targeting" +"173","tankauth" +"173","reflow" +"173","wysihtml5" +"173","expo-go" +"173","spotbugs" +"173","cubit" +"173","nio2" +"173","topmost" +"173","multilevel-analysis" +"173","emeditor" +"173","mediamuxer" +"173","if-constexpr" +"173","daisyui" +"172","render.com" +"172","ssms-16" +"172","mastercard" +"172","jax-rpc" +"172","backup-strategies" +"172","sqoop2" +"172","bank" +"172","data-pipeline" +"172","fyne" +"172","social-framework" +"172","django-context" +"172","adafruit-circuitpython" +"172","appcelerator-studio" +"172","xmla" +"172","fitnesse-slim" +"172","next-i18next" +"172","oxygenxml" +"172","adminhtml" +"172","windowlistener" +"172","dllregistration" +"172","databricks-unity-catalog" +"172","cs193p" +"172","universe" +"172","database-first" +"172","camera-roll" +"172","routed-commands" +"172","blue-green-deployment" +"172","errordocument" +"172","dynamicobject" +"172","onscrolllistener" +"172","pydoc" +"172","typhoon" +"172","typescript1.5" +"172","sys.path" +"172","asynchronous-javascript" +"172","auctex" +"172","plotmath" +"172","table-variable" +"172","james" +"172","tabletools" +"172","tanstack" +"172","devforce" +"172","asp.net-controls" +"172","testng.xml" +"172","ldap3" +"172","ollama" +"172","performanceanalytics" +"172","qcustomplot" +"172","textmatebundles" +"172","mp4parser" +"172","tomcat8.5" +"172","amazon-cloudwatch-metrics" +"172","lines-of-code" +"172","dangling-pointer" +"172","particle-swarm" +"172","parameter-expansion" +"172","zipoutputstream" +"172","suitetalk" +"172","utl-file" +"172","helm3" +"172","tosca" +"171","phpactiverecord" +"171","livewires" +"171","anythingslider" +"171","sliding-tile-puzzle" +"171","debuggervisualizer" +"171","federated-learning" +"171","bash-trap" +"171","flash-builder4.5" +"171","dispatchevent" +"171","saaj" +"171","jsxgraph" +"171","python-rq" +"171","xfa" +"171","uitableviewrowaction" +"171","binarywriter" +"171","imagesharp" +"171","fuzzyjoin" +"171","google-voice" +"171","serviceloader" +"171","rtools" +"171","ora-00904" +"171","kie-workbench" +"171","windows-app-sdk" +"171","oracle-pro-c" +"171","away3d" +"171","angularjs-ng-show" +"171","pcntl" +"171","modelsummary" +"171","fotorama" +"171","newsstand-kit" +"171","absolutelayout" +"171","4g" +"171","systemtime" +"171","plivo" +"171","dotcloud" +"171","chained" +"171","electronic-signature" +"171","httpclientfactory" +"171","ldif" +"171","react-forwardref" +"171","angular-event-emitter" +"171","using-declaration" +"171","maya-api" +"171","userprincipal" +"171","qt5.4" +"171","struts-config" +"171","script-component" +"170","webxr" +"170","xwiki" +"170","reinstall" +"170","wgs84" +"170","listings" +"170","incremental-build" +"170","finagle" +"170","sahi" +"170","fileparsing" +"170","page-curl" +"170","package-name" +"170","impdp" +"170","semantic-mediawiki" +"170","ng-messages" +"170","chr" +"170","safari-web-inspector" +"170","selenium-grid2" +"170","distance-matrix" +"170","implicits" +"170","datebox" +"170","vaex" +"170","mysqli-multi-query" +"170","document-library" +"170","mgtwitterengine" +"170","workday-api" +"170","suppress" +"170","karma-webpack" +"170","wso2-bam" +"170","wow64" +"170","type-declaration" +"170","pyro" +"170","magit" +"170","authlib" +"170","wordpress-featured-image" +"170","formik-material-ui" +"170","google-chrome-arc" +"170","vitamio" +"170","braintree-sandbox" +"170",".net-core-rc2" +"170","devexpress-wpf" +"170","hibernate-spatial" +"170","hivemq" +"170","uidevice" +"170","c++-faq" +"170","regions" +"170","handlebarshelper" +"170","radians" +"170","pervasive-sql" +"170","cubic-spline" +"170","member-variables" +"170","httpresponsemessage" +"170","mount-point" +"170","ipython-magic" +"170","string.h" +"170","batch-insert" +"170","linearlayoutmanager" +"170","transactionmanager" +"170","encoder-decoder" +"170","bfg-repo-cleaner" +"169","answer-set-programming" +"169","eclipse-emf-ecore" +"169","primeng-dropdowns" +"169","ssrs-2017" +"169","default-method" +"169","repair" +"169","flutter-build" +"169","backpressure" +"169","pipelining" +"169","directsound" +"169","mariadb-10.4" +"169","dbd" +"169","ng-pattern" +"169","api-ai" +"169","flask-session" +"169","js-scrollintoview" +"169","cascade-classifier" +"169","v-data-table" +"169","family-tree" +"169","keras-tuner" +"169","angular-ui-select" +"169","grafana-api" +"169","equivalence" +"169","nss" +"169","boost-build" +"169","horizontallist" +"169","enum-flags" +"169","hotdeploy" +"169","spring-properties" +"169","libtooling" +"169","system.net.webexception" +"169","magicmock" +"169","sideloading" +"169","wiredtiger" +"169","bsxfun" +"169","kiwi-tcms" +"169","brotli" +"169","ransac" +"169","visual-recognition" +"169","code-signing-entitlements" +"169","luau" +"169","node-telegram-bot-api" +"169","hippocms" +"169","android-googleapiclient" +"169","mpmediaquery" +"169","long-double" +"169","csvreader" +"169","resignfirstresponder" +"169","odata-v4" +"169","loop-unrolling" +"169","nnet" +"169","preferredsize" +"169","iequatable" +"169","amazon-elastic-transcoder" +"169","dart-mirrors" +"169","stm32f7" +"169","liipimaginebundle" +"169","lightgallery" +"169","qt4.7" +"168","fetchall" +"168","bag" +"168","stack-pointer" +"168","multiple-value" +"168","ecdf" +"168","city" +"168","function-object" +"168","jsonexception" +"168","function-handle" +"168","sensu" +"168","distributed-cache" +"168","bitblt" +"168","ice" +"168","grails-2.3" +"168","role-base-authorization" +"168","html-pdf" +"168","dwg" +"168","hresult" +"168","in-house-distribution" +"168","codekit" +"168","for-xml" +"168","libsndfile" +"168","cocos3d" +"168","vlan" +"168","network-connection" +"168","signaturepad" +"168","android-connectivitymanager" +"168","dialect" +"168","highslide" +"168","rad-controls" +"168","direct3d9" +"168","mersenne-twister" +"168","octokit" +"168","custom-domain" +"168","geosphere" +"168","resin" +"168","resthighlevelclient" +"168","channelfactory" +"168","thrift-protocol" +"168","webmock" +"168","lightning" +"168","user-defined-literals" +"168","preconditions" +"168","sonarqube-4.5" +"168","mddialog" +"167","markup-extensions" +"167","remote-validation" +"167","load-time-weaving" +"167","flowable" +"167","vue-material" +"167","php-java-bridge" +"167","flink-batch" +"167","ssm" +"167","principal" +"167","ssml" +"167","gigya" +"167","fusedlocationproviderclient" +"167","kubernetes-operator" +"167","contao" +"167","unhandled" +"167","volttron" +"167","rust-axum" +"167","const-iterator" +"167","confluent-kafka-dotnet" +"167","pandas-profiling" +"167","jsonmodel" +"167","fscalendar" +"167","aws-mobilehub" +"167","ruby-2.3" +"167","vector-tiles" +"167","alchemyapi" +"167","crystal-reports-8.5" +"167","aws-powershell" +"167","docusignconnect" +"167","mfmailcomposer" +"167","axwindowsmediaplayer" +"167","portable-applications" +"167","module-info" +"167","htmltidy" +"167","countdownlatch" +"167","derived-column" +"167","gulp-sourcemaps" +"167","external-process" +"167","object-model" +"167","newlib" +"167","oc4j" +"167","pygsheets" +"167","netmq" +"167","google-analytics-filters" +"167","showcaseview" +"167","gooddata" +"167","sysinternals" +"167","drupal-themes" +"167","gamma" +"167","double-buffering" +"167","bulkloader" +"167","isnullorempty" +"167","tofixed" +"167","x-cart" +"167","laravel-relations" +"167","angular-e2e" +"167","splat" +"167","nintex-workflow" +"167","ctf" +"167","conda-build" +"167","msal-react" +"167","image-formats" +"167","sony-xperia" +"167","bbpress" +"167","ms-wopi" +"167","argb" +"167","ember-cli-mirage" +"167","mdc-components" +"167","aliases" +"167","automata-theory" +"167","ietf-netmod-yang" +"167","std-variant" +"167","stm32f1" +"166","deap" +"166","skeleton-css-boilerplate" +"166","multiscreen" +"166","ff" +"166","jsfl" +"166","vqmod" +"166","apiary.io" +"166","indexpath" +"166","mapped-drive" +"166","cassandra-cli" +"166","adyen" +"166","session-scope" +"166","dmarc" +"166","windows-api-code-pack" +"166","cancel-button" +"166","jhipster-registry" +"166","indirection" +"166","postgresql-15" +"166","http4s" +"166","opencascade" +"166","boost-preprocessor" +"166","deploying" +"166","jquery-on" +"166","silverlight-oob" +"166","jquery-pagination" +"166","2checkout" +"166",".app" +"166","ancestor" +"166","wmv" +"166","typescript3.0" +"166","extractor" +"166","fqdn" +"166","async-ctp" +"166","mobiscroll" +"166","jain-sip" +"166","asp.net-mvc-views" +"166","continuation-passing" +"166","quicklisp" +"166","highlight.js" +"166","uint8array" +"166","ekeventkit" +"166","action-button" +"166","stringdist" +"166","lcm" +"166","ios9.1" +"166","cubes" +"166","dummy-data" +"166","columnheader" +"166","lazyvgrid" +"166","throwable" +"166","stdasync" +"166","likert" +"166","solr5" +"166","hbm" +"166","traitsui" +"166","sts-securitytokenservice" +"166","google-optimize" +"166","armv6" +"166","usps" +"165","flutter-alertdialog" +"165","jcreator" +"165","trunk" +"165","gii" +"165","react-native-vector-icons" +"165","sizzle" +"165","phppgadmin" +"165","llblgenpro" +"165","phishing" +"165","sycl" +"165","directx-10" +"165","catch2" +"165","apache-spark-standalone" +"165","symfony-2.4" +"165","api-doc" +"165","simpletest" +"165","wikidata-api" +"165","update-attributes" +"165","gplots" +"165","puredata" +"165","two-way" +"165","jquery-blockui" +"165","cpuid" +"165","mongodb-stitch" +"165","pyjnius" +"165","mach" +"165","wix4" +"165","minimongo" +"165","attr-accessor" +"165",".net-4.6.2" +"165","nsurlconnectiondelegate" +"165","mkpinannotationview" +"165","game-center-leaderboard" +"165","openvms" +"165","tinybutstrong" +"165","android-looper" +"165","google-cloud-cdn" +"165","chaincode" +"165","string-interning" +"165","pyvista" +"165","startupscript" +"165","autocompleteextender" +"165","argumentnullexception" +"165","email-bounces" +"165","structural-equation-model" +"164","widevine" +"164","react-native-tabnavigator" +"164","groovy-console" +"164","temporal-workflow" +"164","jdom-2" +"164","mat-select" +"164","clipboarddata" +"164","instant" +"164","yahoo-weather-api" +"164","php-password-hash" +"164","cloneable" +"164","banno-digital-toolkit" +"164","fdt" +"164","uniform-distribution" +"164","sendgrid-templates" +"164","xdotool" +"164","configurable" +"164","fuelux" +"164","pjsua2" +"164","saiku" +"164","consolidation" +"164","django-jsonfield" +"164","dashcode" +"164","crx" +"164","fastercsv" +"164","jmap" +"164","c-api" +"164","interpretation" +"164","azure-app-registration" +"164","spring-cloud-gcp" +"164","azure-cli2" +"164","wso2-governance-registry" +"164","word-web-addins" +"164","invoke-sqlcmd" +"164","intershop" +"164","android-wallpaper" +"164",".d.ts" +"164","video-codecs" +"164","broccolijs" +"164","system.data" +"164","non-standard-evaluation" +"164","reformatting" +"164","aspnet-compiler" +"164","asp.net-core-hosted-services" +"164","tchar" +"164","npm-build" +"164","sql-drop" +"164","devextreme-angular" +"164","gdlib" +"164","mod-deflate" +"164","xcode-bots" +"164","pmap" +"164","toctree" +"164","property-binding" +"164","react-custom-hooks" +"164","elki" +"164","project-reference" +"164","static-block" +"164","sparqlwrapper" +"164","spark-jobserver" +"164","subproject" +"164","tibco-business-works" +"164","zipinputstream" +"164","qsqldatabase" +"163","flipview" +"163","background-foreground" +"163","clingo" +"163","ecslidingviewcontroller" +"163","teensy" +"163","temenos-quantum" +"163","yii2-user" +"163","cloudhub" +"163","file-comparison" +"163","filelist" +"163","catiledlayer" +"163","python-interactive" +"163","symfony-2.6" +"163","datejs" +"163","freezed" +"163","file-pointer" +"163","flann" +"163","conflicting-libraries" +"163","laminas" +"163","select-case" +"163","datalog" +"163","cannon.js" +"163","shareactionprovider" +"163","createobject" +"163","joomla1.6" +"163","vbox" +"163","service-principal" +"163","angular-material-7" +"163","grapesjs" +"163","capifony" +"163","kendo-window" +"163","unsigned-long-long-int" +"163","svnignore" +"163","path-dependent-type" +"163","dynamic-url" +"163","powerapps-modeldriven" +"163","boost-iostreams" +"163","neighbours" +"163","aquamacs" +"163","pomelo-entityframeworkcore-mysql" +"163","dynamic-feature-module" +"163","winreg" +"163","browser-feature-detection" +"163","ocamlbuild" +"163","libcrypto" +"163","fpc" +"163","woocommerce-bookings" +"163","cadvisor" +"163","drupal-blocks" +"163","drop-duplicates" +"163","redux-framework" +"163","poi-hssf" +"163","drools-fusion" +"163","ets" +"163","qapplication" +"163","httpexception" +"163","actiontext" +"163","react-18" +"163","reach-router" +"163","geomesa" +"163","sdl-image" +"163","webhttpbinding" +"163","bbedit" +"163","torchtext" +"163","cxfrs" +"163","mediadevices" +"163","compiled" +"163","time-and-attendance" +"163","usdz" +"163","parameterization" +"162","gridfs-stream" +"162","flutter-design" +"162","stack-smash" +"162","react-native-image" +"162","defineproperty" +"162","apache-echarts" +"162","music21" +"162","closed-captions" +"162","great-expectations" +"162","slate.js" +"162","phpquery" +"162","unauthorizedaccessexcepti" +"162","paintevent" +"162","free-monad" +"162","fs2" +"162","servicehost" +"162","verbose" +"162","wavelet-transform" +"162","window.opener" +"162","w2ui" +"162","react-test-renderer" +"162","cortex-a" +"162","bonecp" +"162","sap-business-technology-platform" +"162","jquery-draggable" +"162","dynamic-rdlc-generation" +"162","error-messaging" +"162","jquery-traversing" +"162","hpricot" +"162","inversion" +"162","rampart" +"162","rfe" +"162","tabbed" +"162","reverse-dns" +"162","r-haven" +"162","libwebsockets" +"162","asp.net-mvc-3-areas" +"162","wxmaxima" +"162","gcsfuse" +"162","dotnetbrowser" +"162","controlvalueaccessor" +"162","uiscenedelegate" +"162","targets" +"162","export-csv" +"162","android-jetpack-datastore" +"162","testbed" +"162","collate" +"162","genetic" +"162","hud" +"162","resize-image" +"162","ether" +"162","react-native-code-push" +"162","office-store" +"162","exact-online" +"162","ifnull" +"162","webjob" +"162","footnotes" +"161","local-files" +"161","flatpak" +"161","sybase-asa" +"161","catransition" +"161","pagedown" +"161","castor" +"161","ng-upgrade" +"161","make.com" +"161","connection-reset" +"161","run-configuration" +"161","ng-dialog" +"161","dita-ot" +"161","oracle-golden-gate" +"161","angular-module-federation" +"161","oracle-aq" +"161","data-lake" +"161","wagtail-admin" +"161","jmc" +"161","fb.ui" +"161","gradle-task" +"161","pybluez" +"161","docker-buildkit" +"161","blogengine.net" +"161","dynpro" +"161","nspasteboard" +"161","boost-function" +"161","erl" +"161","dendextend" +"161","payment-method" +"161","jupyter-irkernel" +"161","do-notation" +"161","word-automation" +"161","syntaxhighlighter" +"161","lxml.html" +"161","exslt" +"161","opensocial" +"161","c++-amp" +"161","hive-serde" +"161","azure-yaml-pipelines" +"161","tinytex" +"161","xcrun" +"161","hashable" +"161","peek" +"161","cfwheels" +"161","hvplot" +"161","elastic4s" +"161","irrlicht" +"161","project-server" +"161","eventargs" +"161","elasticsearch-jest" +"161","autonumber" +"161","scriptblock" +"160","trpc" +"160","apache-commons-vfs" +"160","apache-httpclient-5.x" +"160","local-network" +"160","phoenix-live-view" +"160","musl" +"160","github-graphql" +"160","ln" +"160","literate-programming" +"160","confluent-cloud" +"160","socialshare" +"160","findby" +"160","jsonobjectrequest" +"160","fingerprinting" +"160","soda" +"160","aviary" +"160","ready" +"160","ibm-cloud-private" +"160","simplewebrtc" +"160","epsilon" +"160","mod-perl2" +"160","type-assertion" +"160","boost-phoenix" +"160","bootcompleted" +"160","sample-rate" +"160","pdf-scraping" +"160","neovim-plugin" +"160","attiny" +"160","build-pipeline" +"160","typed-racket" +"160","libssl" +"160","object-destructuring" +"160","audacity" +"160","caffeine-cache" +"160","mlcp" +"160","tally" +"160","mkmapviewdelegate" +"160","http-status-code-502" +"160","iplimage" +"160","personalization" +"160","stride" +"160","custom-functions-excel" +"160","hessian" +"160","multi-agent" +"160","ember-qunit" +"160","conditional-breakpoint" +"160","pgi" +"160","hbox" +"160","arcgis-runtime" +"160","multicastsocket" +"160","touchstart" +"160","sony-camera-api" +"159","proc-open" +"159","stability" +"159","flurry-analytics" +"159","gridstack" +"159","x-www-form-urlencoded" +"159","grid-system" +"159","triangular" +"159","xuggle" +"159","feof" +"159","xquery-3.0" +"159","python-attrs" +"159","python-babel" +"159","select-into" +"159","ngen" +"159","frustum" +"159","find-in-set" +"159","python-chess" +"159","ryu" +"159","recordrtc" +"159","angular-signals" +"159","database-tuning" +"159","robust" +"159","sequencefile" +"159","css-counter" +"159","microsoft-fabric" +"159","wcf-endpoint" +"159","ibmhttpserver" +"159","data-collection" +"159","role-based-access-control" +"159","wpf-animation" +"159","dvc" +"159","anglesharp" +"159","passport-jwt" +"159","entitydatasource" +"159","infobox" +"159","apple-id" +"159","nssplitview" +"159","mod-mono" +"159","spring-native" +"159","e2e" +"159","java.nio.file" +"159","mailing" +"159","rdf4j" +"159","mailboxer" +"159","javascript-namespaces" +"159","extended-sql" +"159","kotlin-null-safety" +"159","expss" +"159","reflections" +"159","hashbang" +"159","tailwind-3" +"159","tmx" +"159","generic-handler" +"159","nhibernate-mapping-by-code" +"159","node-canvas" +"159","responsetext" +"159","chain-of-responsibility" +"159","esp8266wifi" +"159","promela" +"159","flvplayback" +"159","autocompletebox" +"159","zend-translate" +"159","quarkus-reactive" +"159","google-plugin-eclipse" +"159","soil" +"159","amazon-mq" +"159","soundex" +"159","touchpad" +"159","custom-type" +"158","phpfox" +"158","ecore" +"158","vsync" +"158","fiddlercore" +"158","cmp" +"158","intellij-lombok-plugin" +"158","smartclient" +"158","sles" +"158","filenet-content-engine" +"158","munit" +"158","primefaces-datatable" +"158","grouped-bar-chart" +"158","adobe-animate" +"158","python-3.12" +"158","jsf-2.3" +"158","soapserver" +"158","swiftui-charts" +"158","appfabric-cache" +"158","self-modifying" +"158","datetime2" +"158","adam" +"158","aws-media-convert" +"158","pulse" +"158","angular-material-5" +"158","server-side-scripting" +"158","microformats" +"158","w3-total-cache" +"158","capslock" +"158","django-piston" +"158","r-maptools" +"158","gpsd" +"158","data-kinds" +"158","infusionsoft" +"158","one-liner" +"158","boxapiv2" +"158","interpreted-language" +"158","mod-security2" +"158","entity-component-system" +"158","setenv" +"158","for-of-loop" +"158","bsod" +"158","browser-support" +"158","branching-strategy" +"158","vlfeat" +"158","orchard-modules" +"158","or-operator" +"158","refs" +"158","tdbgrid" +"158","ntdll" +"158","x12" +"158","device-policy-manager" +"158","mergetool" +"158","angularjs-1.6" +"158","lto" +"158","loop-invariant" +"158","rescale" +"158","mpld3" +"158","qqmlcomponent" +"158","before-save" +"157","greenlets" +"157","mvcjqgrid" +"157","skip-lists" +"157","yii2-validation" +"157","packery" +"157","kylin" +"157","mainwindow" +"157","j-security-check" +"157","firebase-job-dispatcher" +"157","snmp-trap" +"157","market-basket-analysis" +"157","jsonlines" +"157","angular-lifecycle-hooks" +"157","vba6" +"157","keycloak-connect" +"157","facebook-permissions" +"157","oracle-apex-19.1" +"157","kendo-template" +"157","django-messages" +"157","aws-iot-greengrass" +"157","jquery-bootgrid" +"157","gtk2hs" +"157","htmlcollection" +"157","posting" +"157","dynamic-languages" +"157","fable-f#" +"157","visual-paradigm" +"157","amazon-timestream" +"157","caddyfile" +"157","hana-sql-script" +"157","reference-class" +"157","uimodalpresentationstyle" +"157","gaussian-process" +"157","device-owner" +"157","tlistview" +"157","npm-request" +"157","onconfigurationchanged" +"157","http-status-code-415" +"157","spin" +"157","prolog-toplevel" +"157","chalice" +"157","heroku-api" +"157","always-on-top" +"157","sorbet" +"157","prettytable" +"157","flutter-method-channel" +"157","userinfo" +"156","backlog" +"156","tsung" +"156","grob" +"156","mat-tab" +"156","giraph" +"156","multi-step" +"156","renv" +"156","xtk" +"156","skemitternode" +"156","content-encoding" +"156","jsr352" +"156","vsftpd" +"156","package-management" +"156","flask-appbuilder" +"156","xively" +"156","r-s3" +"156","joomla-module" +"156","vavr" +"156","credential-manager" +"156","django-grappelli" +"156","in-operator" +"156","enoent" +"156","azure-blob-trigger" +"156","eoferror" +"156","ingres" +"156","pdf-extraction" +"156","postgrest" +"156","postgres-fdw" +"156","kohana-3.3" +"156","mina" +"156","formal-methods" +"156","sysdate" +"156","minute" +"156","versionone" +"156","azure-private-link" +"156","hierarchyid" +"156","mockwebserver" +"156","aspell" +"156","xamlparseexception" +"156","nsworkspace" +"156","asp.net-profiles" +"156","uiscreen" +"156","numberformatter" +"156","movesense" +"156","column-alias" +"156","react-draft-wysiwyg" +"156","ewsjavaapi" +"156","activeperl" +"156","http-patch" +"156","stunnel" +"156","array-key" +"156","biblatex" +"156","step" +"156","cvpixelbuffer" +"156","structural-search" +"155","wicket-1.6" +"155","vue-multiselect" +"155","filenet" +"155","skybox" +"155","github-actions-self-hosted-runners" +"155","websharper" +"155","process-management" +"155","fee" +"155","tei" +"155","voltdb" +"155","mamba" +"155","app-code" +"155","bitvector" +"155","pac" +"155","pac4j" +"155","french" +"155","checkedtextview" +"155","fiona" +"155","socialauth" +"155","rjags" +"155","laravel-breeze" +"155","serde-json" +"155","csharpcodeprovider" +"155","oracle-maf" +"155","wandb" +"155","inlining" +"155","correctness" +"155","nsmutabledata" +"155","html5-fullscreen" +"155","payum" +"155","pearson" +"155","ampps" +"155","acceleo" +"155","kotlin-multiplatform-mobile" +"155","codebase" +"155","newtype" +"155","woff" +"155","videocall" +"155","node-soap" +"155","drop-table" +"155","modalpopup" +"155","b2b" +"155","gdprconsentform" +"155","hardcode" +"155","zxing.net" +"155","elixir-iex" +"155","getboundingclientrect" +"155","odoo-17" +"155","google-cloud-billing" +"155","memory-access" +"155","script-fu" +"155","fold-expression" +"155","custom-tags" +"155","tf.data.dataset" +"155","max-pooling" +"155","hex-editors" +"155","foreign-data-wrapper" +"155","auto-vectorization" +"155","flux.jl" +"155","web3-java" +"155","embedded-tomcat-7" +"155","gmail-contextual-gadgets" +"154","edsdk" +"154","echarts4r" +"154","webrtc-android" +"154","phaserjs" +"154","mat-dialog" +"154","live-sdk" +"154","x-sendfile" +"154","chrome-options" +"154","volt" +"154","xlink" +"154","bitwise-or" +"154","addressing" +"154","planning" +"154","reality-composer" +"154","oracle-apps" +"154","recursive-cte" +"154","nscache" +"154","nsinvocation" +"154","onpress" +"154","htc-vive" +"154","ane" +"154","mojibake" +"154","wpbakery" +"154","nested-generics" +"154","android-searchmanager" +"154","twine" +"154","error-checking" +"154","synthesizer" +"154","atan2" +"154","signal-strength" +"154","fable-r" +"154","org-babel" +"154","systrace" +"154",".doc" +"154","go-cobra" +"154","nx-monorepo" +"154","word-contentcontrol" +"154","360-panorama" +"154","branding" +"154","j2mepolish" +"154","digraphs" +"154","tiny-tds" +"154","dotless" +"154","uisearchbardelegate" +"154","dhtmlx-scheduler" +"154","high-load" +"154","cakedc" +"154","redisearch" +"154","openid-provider" +"154","itemlistener" +"154","dpapi" +"154","qaction" +"154","latin" +"154","logstash-forwarder" +"154","qprogressbar" +"154","react-dates" +"154","cgrectmake" +"154","source-control-explorer" +"154","helidon" +"154","suffix-array" +"154","solarium" +"154","structured-bindings" +"154","query-cache" +"154","liferay-6.2" +"154","cypress-component-test-runner" +"154","steroids" +"154","precompiled" +"154","quad" +"153","stagefright" +"153","load-time" +"153","term-document-matrix" +"153","clamp" +"153","antixsslibrary" +"153","cloudify" +"153","six" +"153","remoteobject" +"153","feather" +"153","xstate" +"153","teiid" +"153","masked-array" +"153","clutter" +"153","socketcan" +"153","piranha-cms" +"153","fusionauth" +"153","unreal-development-kit" +"153","optimizely" +"153","farseer" +"153","angularjs-rootscope" +"153","methodinfo" +"153","joomla3.1" +"153","oracle-ords" +"153","rmdir" +"153","joomla3.2" +"153","dword" +"153","posixlt" +"153","junit3" +"153","twilio-flex" +"153","spring-cloud-consul" +"153","spring-batch-tasklet" +"153","cosmicmind" +"153","cosmos" +"153","build-settings" +"153","newrelic-platform" +"153","aapt2" +"153","revitpythonshell" +"153","milvus" +"153","ord" +"153","ramdisk" +"153","32feet" +"153","ucwa" +"153","buildfire" +"153","nyc" +"153","go-echo" +"153","typegoose" +"153","wix3.10" +"153","pnp-js" +"153","non-type" +"153","exporter" +"153","isomorphism" +"153","azure-storage-emulator" +"153","italic" +"153","tcxgrid" +"153","nofollow" +"153","quit" +"153","iscsi" +"153","android-module" +"153","getmethod" +"153","octree" +"153","activecollab" +"153","speex" +"153","streambuf" +"153","custom-binding" +"153","google-groups-api" +"153","zone.js" +"153","quic" +"153","bcnf" +"153","hedera-hashgraph" +"153","qslider" +"153","max-heap" +"153","gnu-toolchain" +"152","filehandler" +"152","bada" +"152","ansi-colors" +"152","flappy-bird-clone" +"152","symfony-2.5" +"152","impresspages" +"152","apns-php" +"152","indexed" +"152","xposed" +"152","imu" +"152","directwrite" +"152","django-tinymce" +"152","valueinjecter" +"152","animatewithduration" +"152","aws-codeartifact" +"152","iccube-reporting" +"152","ruby-debug" +"152","enterprise-library-5" +"152","turbogears2" +"152","tvirtualstringtree" +"152","scada" +"152","blocked" +"152","invoke-restmethod" +"152","spring-async" +"152","out-of-browser" +"152","reuseidentifier" +"152","osclass" +"152","nettopologysuite" +"152","extjs6-modern" +"152","copy-assignment" +"152","gear-vr" +"152","ganglia" +"152","jack" +"152","contiguous" +"152","executescalar" +"152","hl7-v2" +"152","radwindow" +"152","cufft" +"152","persistent-connection" +"152","community-toolkit-mvvm" +"152","split-apply-combine" +"152","layoutsubviews" +"152","emberfire" +"152","linkedhashset" +"152","weaviate" +"152","pander" +"152","lightweight-charts" +"152","flutter-integration-test" +"152","structured-array" +"152","ytdl" +"152","gnutls" +"151","cmmotionmanager" +"151","mason" +"151","treetableview" +"151","fluid-dynamics" +"151","translucency" +"151","fscheck" +"151","disk-partitioning" +"151","checklistbox" +"151","jsr" +"151","python-mode" +"151","swizzling" +"151","jstack" +"151","python-twitter" +"151","checkmark" +"151","flask-cors" +"151","fiware-wirecloud" +"151","oversampling" +"151","ng-tags-input" +"151","underflow" +"151","aws-billing" +"151","react-usememo" +"151","database-concurrency" +"151","mysql-error-1005" +"151","animationdrawable" +"151","sessionstorage" +"151","w3.css" +"151","canactivate" +"151","akeneo" +"151","rtcpeerconnection" +"151","pwd" +"151","dlna" +"151","dash-shell" +"151","internal-tables" +"151","tun" +"151","workflowservice" +"151","nsbezierpath" +"151","bndtools" +"151","bochs" +"151","android-titlebar" +"151","patindex" +"151",".net-native" +"151","kryonet" +"151","cocoaasyncsocket" +"151","settings.settings" +"151","codefluent" +"151","word-break" +"151","leptonica" +"151","kohana-3.2" +"151","jasig" +"151","rawstring" +"151","less-mixins" +"151","orthogonal" +"151","xcode10.2" +"151","xamarin.forms.shell" +"151","tolower" +"151","nsurlsessionuploadtask" +"151","isin" +"151","android-framework" +"151","x3dom" +"151","memoryview" +"151","node-ffi" +"151","texturepacker" +"151","office365connectors" +"151","nodeclipse" +"151","spagobi" +"151","qt-installer" +"151","webdrivermanager-java" +"151","stdcall" +"151","automotive" +"150","backgrid" +"150","multiple-projects" +"150","websphere-commerce" +"150","phantom-dsl" +"150","listselectionlistener" +"150","mutagen" +"150","git-amend" +"150","eclipse-3.6" +"150","tridion-content-delivery" +"150","getstring" +"150","picamera" +"150","dataproc" +"150","data-transfer-objects" +"150","map-directions" +"150","p12" +"150","jtextcomponent" +"150","cellrenderer" +"150","celeryd" +"150","fzf" +"150","universal-binary" +"150","icriteria" +"150","fastparquet" +"150","gracenote" +"150","ibm-bpm" +"150","rman" +"150","kbuild" +"150","jquery-ajaxq" +"150","swagger-php" +"150","azure-communication-services" +"150","wso2-streaming-integrator" +"150","supersized" +"150","android-thread" +"150","coroutinescope" +"150","postgresql-copy" +"150","nsinputstream" +"150","pcl" +"150","broken-links" +"150","mintty" +"150","rapidapi" +"150","lxd" +"150","lync-2010" +"150","java.util.calendar" +"150","ostringstream" +"150","qwebkit" +"150","ntlm-authentication" +"150","xcode8.2" +"150","dotnetrdf" +"150","play-reactivemongo" +"150","garmin" +"150","activesupport-concern" +"150","mpnowplayinginfocenter" +"150","stochastic-process" +"150","account-kit" +"150","pencilkit" +"150","office-2016" +"150","excel-2011" +"150","generator-expression" +"150","cgimageref" +"150","launchimage" +"150","cts" +"150","ode45" +"150","healpy" +"150","zend-gdata" +"150","maxdate" +"150","google-swiffy" +"150","flutter-showmodalbottomsheet" +"150","google-maps-react" +"150","flux-influxdb" +"149","griffon" +"149","dcmtk" +"149","dcm4che" +"149","instantclient" +"149","flip-flop" +"149","listfield" +"149","jenkins-shared-libraries" +"149","insertafter" +"149","safearray" +"149","ngx-leaflet" +"149","aero-glass" +"149","smp" +"149","smart-device" +"149","findwindow" +"149","picking" +"149","kundera" +"149","rootview" +"149","angular-pwa" +"149","cappuccino" +"149","dnn9" +"149","kinect-v2" +"149","alchemy" +"149","bootstrap-cards" +"149","dynamo-local" +"149","apple-mail" +"149","open-basedir" +"149","pch" +"149","kaltura" +"149","popstate" +"149","jvm-languages" +"149","facebook-events" +"149","eye-tracking" +"149","should.js" +"149","fragment-lifecycle" +"149","visual-web-developer-2010" +"149","occi" +"149","opentext" +"149","hlist" +"149","mjml" +"149","hijri" +"149","home-automation" +"149","azure-purview" +"149","column-chart" +"149","memo" +"149","lorawan" +"149","elasticsearch-analyzers" +"149","spring4d" +"149","react-icons" +"149","event-binding" +"149","userlocation" +"149","amazon-sagemaker-studio" +"149","conda-forge" +"149","qtserialport" +"149","flutter-riverpod" +"149","git-worktree" +"148","ecma262" +"148","localforage" +"148","defensive-programming" +"148","template-strings" +"148","prism-6" +"148","remote-branch" +"148","mat-autocomplete" +"148","remote-connection" +"148","apache-commons-config" +"148","advanced-search" +"148","vpc-endpoint" +"148","import-maps" +"148","swiftui-environment" +"148","xnu" +"148","umask" +"148","bind-variables" +"148","jjwt" +"148","microsoft-chart-controls" +"148","agora-web-sdk-ng" +"148","sequencing" +"148","i3" +"148","django-select-related" +"148","faces-config" +"148","jqlite" +"148","database-cleaner" +"148","validationsummary" +"148","keyguard" +"148","intermediate-language" +"148","initialization-list" +"148","springmockito" +"148","susy-sass" +"148","azure-configuration" +"148","nested-form-for" +"148","opencms" +"148","wsse" +"148","mongohq" +"148","jquery-widgets" +"148","info" +"148","sample-data" +"148","microsoft-web-deploy" +"148","wiringpi" +"148","cognos-8" +"148","cocoalibspotify-2.0" +"148","networkcredentials" +"148","sqldelight" +"148","pluralize" +"148","drools-planner" +"148","sqlite-net-extensions" +"148","sql-parser" +"148","android-navigation-bar" +"148","mongoose-web-server" +"148","google-cloud-memorystore" +"148","protein-database" +"148","noaa" +"148","cfloop" +"148","laravel-storage" +"148","resource-management" +"148","mouse-listeners" +"148","http-token-authentication" +"148","ios-permissions" +"148","qitemdelegate" +"148","laravel-notification" +"148","color-profile" +"148","memmove" +"148","qstyleditemdelegate" +"148","user-tracking" +"148","qspinbox" +"148","linqkit" +"148","linux-namespaces" +"148","zipline" +"148","pandas-to-sql" +"148","zend-framework-mvc" +"148","google-now" +"148","qualcomm" +"148","availability" +"148","idictionary" +"147","badimageformatexception" +"147","eclipse-scout" +"147","transitive-closure" +"147","geturl" +"147","eel" +"147","dbms-output" +"147","standby" +"147","ecdh" +"147","filemtime" +"147","skype4com" +"147","firebasesimplelogin" +"147","catch-block" +"147","smooch" +"147","adminer" +"147","rust-proc-macros" +"147","flask-jwt-extended" +"147","checked-exceptions" +"147","rx-java3" +"147","image-registration" +"147","picklist" +"147","indexed-view" +"147","documentlistener" +"147","cross-product" +"147","microsoft-custom-vision" +"147","docopt" +"147","twitterizer" +"147","ionicons" +"147","twirl" +"147","hosts-file" +"147","bluecove" +"147","popviewcontroller" +"147","satellizer" +"147","nsscanner" +"147","mongodb-aggregation" +"147","letter-spacing" +"147","system-variable" +"147","2d-vector" +"147",".net-cf-3.5" +"147","m3u" +"147","magic-square" +"147","openrasta" +"147","android-compatibility" +"147","exploratory-data-analysis" +"147","toarray" +"147","quorum" +"147","scalamock" +"147","hierarchical-query" +"147","dotconnect" +"147","coordinator-layout" +"147","table-per-type" +"147","bulletedlist" +"147","numerical-computing" +"147","uilongpressgesturerecogni" +"147","redis-cache" +"147","cookiecutter" +"147","restrict-qualifier" +"147","storagefile" +"147","petsc" +"147","custom-painting" +"147","argument-unpacking" +"147","msbuildcommunitytasks" +"147","glog" +"147","a-records" +"147","autoresetevent" +"147","flutter-routes" +"147","ppp" +"147","bigquery-udf" +"147","illegal-characters" +"147","uwp-maps" +"147","sealed-class" +"147","il2cpp" +"146","multisampling" +"146","webresource.axd" +"146","lob" +"146","appicon" +"146","firebase-in-app-messaging" +"146","marching-cubes" +"146","undefined-function" +"146","xmlrpclib" +"146","maproute" +"146","bitrix" +"146","phyloseq" +"146","gpflow" +"146","r-recipes" +"146","database-versioning" +"146","rtsp-client" +"146","icefaces-3" +"146","kernel-mode" +"146","ical4j" +"146","nanotime" +"146","angular-oauth2-oidc" +"146","valuetuple" +"146","keyof" +"146","rootviewcontroller" +"146","equatable" +"146","worldwind" +"146","sap-bw" +"146","passphrase" +"146","sim800" +"146","spring-dsl" +"146","bootswatch" +"146","mirc" +"146","network-flow" +"146","out-parameters" +"146","code128" +"146","extjs-grid" +"146","android-app-indexing" +"146","right-align" +"146",".a" +"146","kofax" +"146","objcopy" +"146","revmob" +"146","3d-secure" +"146","videogular" +"146","object-persistence" +"146","gcp-ai-platform-training" +"146","hive-partitions" +"146","conversion-operator" +"146","quoted-identifier" +"146","railway" +"146","bus-error" +"146","quickfixn" +"146","quickblox-android" +"146","explicit-instantiation" +"146","iso-prolog" +"146","dotnethighcharts" +"146","radeditor" +"146","target-platform" +"146","core.autocrlf" +"146","cordova-plugin-file" +"146","memory-dump" +"146","tess-two" +"146","perlbrew" +"146","charsequence" +"146","str-to-date" +"146","textpad" +"146","morelikethis" +"146","prestashop-modules" +"146","qtranslate" +"146","embeddable" +"146","msal" +"146","comtypes" +"146","helios" +"146","query-planner" +"146","condor" +"146","linq-to-excel" +"146","cyclic-reference" +"145","clarity" +"145","pgrouting" +"145","sktexture" +"145","citus" +"145","matlab-struct" +"145","relaymodern" +"145","background-audio" +"145","tsvector" +"145","bacpac" +"145","edismax" +"145","telerik-open-access" +"145","language-detection" +"145","mariasql" +"145","picocli" +"145","front-controller" +"145","json-extract" +"145","ngx-admin" +"145","datagridviewcheckboxcell" +"145","servlet-listeners" +"145","createuser" +"145","failovercluster" +"145","angularjs-validation" +"145","google-url-shortener" +"145","hyperledger-fabric-sdk-js" +"145","public-html" +"145","cakephp-3.2" +"145","molecule" +"145","jquery-ui-selectmenu" +"145","hosted" +"145","pdcurses" +"145","jqxwidgets" +"145","tween.js" +"145","nssm" +"145","nreco" +"145","android-splashscreen" +"145","block-cipher" +"145","block-device" +"145","dynamic-data-display" +"145","scaladoc" +"145","4d" +"145","javafx-css" +"145","libreoffice-writer" +"145","3ds" +"145","bslib" +"145","pyspark-pandas" +"145","wiql" +"145","virtualmin" +"145","framerjs" +"145","raw-types" +"145","machinekey" +"145","draw2d" +"145","convex" +"145","control-flow-graph" +"145","screen-brightness" +"145","nios" +"145","cffi" +"145","elasticsearch-dsl-py" +"145","property-based-testing" +"145","human-readable" +"145","proto3" +"145","angularjs-compile" +"145","layout-gravity" +"145","text-styling" +"145","longtext" +"145","log-rotation" +"145","computercraft" +"145","daml" +"145","struts-validation" +"145","sorcery" +"145","spamassassin" +"145","theano-cuda" +"145","web-notifications" +"145","flutter-text" +"144","fig" +"144","localbroadcastmanager" +"144","wdm" +"144","ed25519" +"144","multiple-versions" +"144","web-traffic" +"144","balanced-payments" +"144","clipboard.js" +"144","react-native-native-module" +"144","triangle" +"144","match-against" +"144","cloudfoundry-uaa" +"144","mattermost" +"144","listview-adapter" +"144","deferred-rendering" +"144","tensorflowjs-converter" +"144","weighted-graph" +"144","reportserver" +"144","imperative-programming" +"144","contentplaceholder" +"144","app-bundle" +"144","kubernetes-jobs" +"144","xml2js" +"144","uncrustify" +"144","vscodevim" +"144","service-worker-events" +"144","fact-table" +"144","vcs-checkout" +"144","django-imagekit" +"144","doctrine-migrations" +"144","dnf" +"144","simple-salesforce" +"144","mgwt" +"144","unknown-host" +"144","unity3d-gui" +"144","jquery-knob" +"144","jri" +"144","hp-alm" +"144","sikuli-script" +"144","ionic-v1" +"144","type-bounds" +"144","fpic" +"144","rc4-cipher" +"144","bugsnag" +"144","fortran2003" +"144","overlapped-io" +"144","codespaces" +"144","showmodaldialog" +"144","tablename" +"144","tde" +"144","gun" +"144","tabula-py" +"144","busyindicator" +"144","tippyjs" +"144","azure-marketplace" +"144","diazo" +"144","azure-functions-isolated" +"144","mobilefirst-cli" +"144","nvl" +"144","hash-of-hashes" +"144","opensea" +"144","angular1.6" +"144","splunk-dashboard" +"144","etsy" +"144","spawning" +"144","angularjs-injector" +"144","colorama" +"144","mpvolumeview" +"144","requestjs" +"144","event-stream" +"144","exceldatareader" +"144","ppl" +"144","medium-trust" +"144","zend-acl" +"144","msvc12" +"144","google-oauth-java-client" +"144","linux-from-scratch" +"144","headphones" +"144","parsley" +"144","helmet.js" +"144","mdx-query" +"144","qt5.6" +"144","stdmove" +"144","prettify" +"144","mtm" +"143","civicrm" +"143","processmaker" +"143","loaded" +"143","interface-implementation" +"143","webview-flutter" +"143","translate3d" +"143","listboxitems" +"143","treeviewer" +"143","ssh2" +"143","clarifai" +"143","jaybird" +"143","gforth" +"143","jaydebeapi" +"143","xtermjs" +"143","django-contenttypes" +"143","admob-rewardedvideoad" +"143","pkgbuild" +"143","datatemplateselector" +"143","packet-loss" +"143","dirname" +"143","jose" +"143","readelf" +"143","docusign-sdk" +"143","angular-storybook" +"143","varbinarymax" +"143","kibana-6" +"143","workbox-webpack-plugin" +"143","gulp-browser-sync" +"143","spring-integration-http" +"143","azure-ai" +"143","blueprintjs" +"143","wow.js" +"143","axiom" +"143","bootstrap-daterangepicker" +"143","gtable" +"143","jquery-ui-multiselect" +"143","mogrify" +"143","shopware6-app" +"143","wiremock-standalone" +"143","authenticator" +"143","mailing-list" +"143","missingmethodexception" +"143","android-beam" +"143","formhelper" +"143","attachedbehaviors" +"143","sf-symbols" +"143","rfc5545" +"143","pysqlite" +"143","facebook-friends" +"143","amazon-transcribe" +"143","setsockopt" +"143","double-checked-locking" +"143","hibernate-6.x" +"143","opensso" +"143","norm" +"143","drupal-hooks" +"143","expected-condition" +"143","nstextattachment" +"143","tinker" +"143","collection-select" +"143","android-safe-args" +"143","eucalyptus" +"143","propensity-score-matching" +"143","prototyping" +"143","http-status-code-413" +"143","laravel-horizon" +"143","rdtsc" +"143","tomee-7" +"143","mediatemple" +"143","webpack-loader" +"143","end-of-line" +"143","mclapply" +"143","static-constructor" +"143","automatic-updates" +"143","traffic-simulation" +"143","transfer-encoding" +"143","presenter" +"142","standardized" +"142","xmi" +"142","adobecreativesdk" +"142","causality" +"142","cdap" +"142","index-match" +"142","pkix" +"142","xinput" +"142","python-daemon" +"142","language-implementation" +"142","choregraphe" +"142","angular-resolver" +"142","recurring-events" +"142","rooted-device" +"142","updateprogress" +"142","akka-typed" +"142","django-guardian" +"142","url.action" +"142","faiss" +"142","record-linkage" +"142","android-websettings" +"142","azure-data-sync" +"142","hprof" +"142","onfling" +"142","neoscms" +"142","modularization" +"142","bolt" +"142","pc-lint" +"142","htmlelements" +"142","scalable" +"142","jwplayer7" +"142","typeinfo" +"142","orientdb-2.1" +"142","miui" +"142","android-applicationinfo" +"142","oauth2-playground" +"142","extra" +"142","setbackground" +"142","java.time.instant" +"142","nette" +"142","signalr-backplane" +"142","libjingle" +"142","amplitude" +"142","coin-flipping" +"142","system-testing" +"142","uipicker" +"142","nsurlprotocol" +"142","xcode7.2" +"142","android-inputtype" +"142","nokia-s40" +"142","take" +"142","schema-design" +"142","re-frame" +"142","dragonfly-gem" +"142","ondemand" +"142","monkey" +"142","nlopt" +"142","google-eclipse-plugin" +"142","mptt" +"142","activescaffold" +"142","cereal" +"142","http-options-method" +"142","powermail" +"142","vaadin10" +"142","cypress-intercept" +"142","gitops" +"142","tfs-2010" +"142","glad" +"142","preserve" +"142","hci" +"142","google-reporting-api" +"142","papyrus" +"141","tempdb" +"141","react-native-flexbox" +"141","eclipse-marketplace" +"141","repast-simphony" +"141","sku" +"141","file-move" +"141","jcalendar" +"141","gettime" +"141","yargs" +"141","backand" +"141","multipartfile" +"141","biztalk-orchestrations" +"141","add-filter" +"141","import-module" +"141","swtbot" +"141","app-actions" +"141","rvo" +"141","rvm-capistrano" +"141","make-shared" +"141","camera2" +"141","kerning" +"141","fastboot" +"141","oracle-manageddataaccess" +"141","docker-secrets" +"141","verbosity" +"141","windows-8.1-universal" +"141","ruby-1.8" +"141","value-of" +"141","akka-testkit" +"141","deriving" +"141","dynamics-gp" +"141","spring-kafka-test" +"141","mongodb-atlas-search" +"141","shopware6-api" +"141","rethinkdb-python" +"141","google-cdn" +"141","winmerge" +"141","kobold2d" +"141","less-unix" +"141","facebook-analytics" +"141","nsurlsessionconfiguration" +"141","sqlfiddle" +"141","cordova-cli" +"141","ivar" +"141","nom" +"141","uitableviewautomaticdimension" +"141","response.write" +"141","laravel-jobs" +"141","node-pdfkit" +"141","eksctl" +"141","currentculture" +"141","certificate-revocation" +"141","geokit" +"141","react-day-picker" +"141","dual-sim" +"141","timage" +"141","archunit" +"141","hdpi" +"141","qtcpserver" +"141","spark-notebook" +"141","struts2-interceptors" +"141","conference" +"141","powerpoint-2010" +"140","livebindings" +"140","photogrammetry" +"140","eclipse-memory-analyzer" +"140","github-codespaces" +"140","floating-point-exceptions" +"140","gitlab-pages" +"140","fixed-header-tables" +"140","bitlocker" +"140","adjustment" +"140","flashvars" +"140","firewalld" +"140","redash" +"140","jison" +"140","google-web-designer" +"140","jquery-easing" +"140","eager-execution" +"140","azure-devops-server" +"140","borderless" +"140","nsfilehandle" +"140","jquery-data" +"140","rayon" +"140","coderush" +"140","obs" +"140","fossil" +"140","google-chrome-console" +"140","ubuntu-15.04" +"140","formvalidation-plugin" +"140","video-compression" +"140","coldbox" +"140","scim2" +"140","control-structure" +"140","directinput" +"140","plotrix" +"140","asplinkbutton" +"140","driving-directions" +"140","culling" +"140","petrel" +"140","oledbexception" +"140","merge-module" +"140","law-of-demeter" +"140","octopus" +"140","python-vlc" +"140","node-mysql2" +"140","prettier-eslint" +"140","structural-typing" +"140","scrypt" +"140","zerobrane" +"140","papervision3d" +"140","linqdatasource" +"140","qtestlib" +"140","pprof" +"140","arrow-kt" +"139","deduplication" +"139","ecb" +"139","webshop" +"139","inspect-element" +"139","private-subnet" +"139","maven-cargo" +"139","feature-branch" +"139","multiple-forms" +"139","pgx" +"139","templatebinding" +"139","grequests" +"139","laravel-fortify" +"139","discretization" +"139","catextlayer" +"139","vp8" +"139","adoptopenjdk" +"139","final-form" +"139","data-quality" +"139","pacman-package-manager" +"139","bitstring" +"139","python-sip" +"139","soapfault" +"139","bitconverter" +"139","method-invocation" +"139","gradienttape" +"139","vb.net-to-c#" +"139","ibm-rational" +"139","fatjar" +"139","jquery-datatables-editor" +"139","appserver" +"139","passwordbox" +"139","nautilus" +"139","kdiff3" +"139","pcap.net" +"139","cratedb" +"139","openbravo" +"139","postorder" +"139","into-outfile" +"139","designated-initializer" +"139","pastebin" +"139","nxt" +"139","buffer-geometry" +"139","raiserror" +"139","shrine" +"139","orca" +"139","code-golf" +"139","vlsi" +"139","amortized-analysis" +"139","sgml" +"139","amr" +"139","modal-window" +"139","tizen-emulator" +"139","tizen-studio" +"139","hiredis" +"139","j2objc" +"139","spy++" +"139","tdb" +"139","janrain" +"139","xbuild" +"139","hadoop-plugins" +"139","redcarpet" +"139","assembly-references" +"139","harmonyos" +"139","activity-stack" +"139","gethostbyname" +"139","om" +"139","textmate2" +"139","odroid" +"139","tessellation" +"139","android-remoteview" +"139","elasticsearch-x-pack" +"139","zul" +"139","elmah.mvc" +"139","zend-pdf" +"139","this-pointer" +"139","maximize-window" +"139","custom-widgets" +"139","zend-session" +"139","linearmodels" +"139","haskell-pipes" +"139","qtextbrowser" +"139","pprint" +"138","jdl" +"138","skview" +"138","clickjacking" +"138","mautic" +"138","fedora-25" +"138","triples" +"138","flutter-container" +"138","smartsheet-api-2.0" +"138","disk-io" +"138","kube-proxy" +"138","segments" +"138","bitmapsource" +"138","contentoffset" +"138","crossbar" +"138","rome" +"138","kif" +"138","jlayer" +"138","rowdatabound" +"138","angularjs-ng-form" +"138","ag-grid-vue" +"138","gpt-4" +"138","server-administration" +"138","intrusion-detection" +"138","tt-news" +"138","wwdc" +"138","pdfrenderer" +"138","dvd" +"138","enunciate" +"138","kaniko" +"138","brace-expansion" +"138","scala-compiler" +"138","module.exports" +"138","aqueduct" +"138","blazorise" +"138","paypal-buttons" +"138","apple-appclips" +"138","breakout" +"138","s-expression" +"138","systemtap" +"138",".net-4.5.2" +"138","xamarin.auth" +"138","hogan.js" +"138","android-filterable" +"138","mnemonics" +"138","cadisplaylink" +"138","azure-http-trigger" +"138","executemany" +"138","spss-modeler" +"138","generic-constraints" +"138","react-native-calendars" +"138","screeps" +"138","google-iap" +"138","tfs-process-template" +"138","touchmove" +"138","spark-csv" +"138","linq-group" +"138","powershell-1.0" +"138","pox" +"138","search-form" +"138","url-launcher" +"138","lighttable" +"137","flexible-array-member" +"137","principalcontext" +"137","cmake-modules" +"137","discovery" +"137","adsense-api" +"137","image-masking" +"137","vscode-python" +"137","vnc-viewer" +"137","sendbird" +"137","xmlworker" +"137","adobe-xd" +"137","gorouter" +"137","aws-acm" +"137","singular" +"137","rjson" +"137","upperbound" +"137","micrometer-tracing" +"137","rubiks-cube" +"137","bonita" +"137","cortana-intelligence" +"137","pchart" +"137","swfloader" +"137","wse" +"137","samsung-galaxy-gear" +"137","dynamicresource" +"137","html-templates" +"137","ncover" +"137","tumblr-themes" +"137","formwizard" +"137","rets" +"137","networkmanager" +"137","javacompiler" +"137","otool" +"137","sicstus-prolog" +"137","java-client" +"137","sha2" +"137","uiactivity" +"137","scom" +"137","assembla" +"137","android-bottomappbar" +"137","mobile-ad-mediation" +"137","screen-lock" +"137","drf-spectacular" +"137","xamarin.forms.listview" +"137","openkinect" +"137","comm" +"137","accessoryview" +"137","terser" +"137","android-native-library" +"137","event-receiver" +"137","log4cplus" +"137","elastalert" +"137","pellet" +"137","promotions" +"137","required-field" +"137","bean-io" +"137","flysystem" +"137","startmenu" +"137","urp" +"137","statechart" +"137","globalize" +"137","webchromeclient" +"136","relative-url" +"136","flops" +"136","matlab-table" +"136","deepzoom" +"136","remote-notifications" +"136","imagemapster" +"136","apiary" +"136","cell-formatting" +"136","vscode-keybinding" +"136","daydream" +"136","immediate-window" +"136","python-django-storages" +"136","python-db-api" +"136","mysqlbinlog" +"136","robotframework-ide" +"136","sharepoint-jsom" +"136","cakephp-2.6" +"136","gosu" +"136","angular-ssr" +"136","rubyzip" +"136","canopen" +"136","cakephp-3.4" +"136","dependency-inversion" +"136","nrpe" +"136","android-strictmode" +"136","post-commit-hook" +"136","wpa" +"136","opendata" +"136","paxos" +"136","k2" +"136","counting-sort" +"136","epub3" +"136","superview" +"136","svn2git" +"136","gstat" +"136","samsung-mobile-sdk" +"136","spring-graphql" +"136","set-returning-functions" +"136","facebook-instant-articles" +"136","outlook-2003" +"136","koa-router" +"136","observablehq" +"136","osgeo" +"136","tasker" +"136","azure-log-analytics-workspace" +"136","rack-pow" +"136","excel-match" +"136","devops-services" +"136","asp.net-charts" +"136","hibernate3" +"136","radial" +"136","gcc4.7" +"136","android-build-flavors" +"136","spdlog" +"136","ios-pdfkit" +"136","qplaintextedit" +"136","actionmethod" +"136","getelementsbyname" +"136","combinelatest" +"136","etherpad" +"136","react-loadable" +"136","getresponse" +"136","sdkman" +"136","quartz-composer" +"136","hdfstore" +"136","structured-text" +"136","lightswitch-2012" +"136","msxml6" +"135","apache-cayenne" +"135","mat-datepicker" +"135","report-designer" +"135","jdesktoppane" +"135","cloudbuild.yaml" +"135","intel-syntax" +"135","yew" +"135","graphql-ruby" +"135","multi-table" +"135","fdf" +"135","yaml-front-matter" +"135","webresponse" +"135","symfony-messenger" +"135","js-xlsx" +"135","maintenance-mode" +"135","chefspec" +"135","data-url" +"135","content-management" +"135","nextgen-gallery" +"135","uncertainty" +"135","incoming-call" +"135","fts3" +"135","selenoid" +"135","s4sdk" +"135","data-layers" +"135","s60" +"135","jgraph" +"135","facebook-sdk-3.1" +"135","react-window" +"135","fastmm" +"135","cross-language" +"135","hyperopt" +"135","grails-2.2" +"135","nand2tetris" +"135","django-viewflow" +"135","roxygen" +"135","sharepoint-search" +"135","fast-enumeration" +"135","angular-schema-form" +"135","opos" +"135","inmobi" +"135","android-studio-4.0" +"135","mongoosastic" +"135","pax-exam" +"135","passwd" +"135","coreldraw" +"135","dyno" +"135","sanitizer" +"135","wix-extension" +"135","raven" +"135","java-12" +"135","libtiff.net" +"135","vispy" +"135","buildr" +"135","audio-service" +"135","windows-xp-sp3" +"135","itemsource" +"135","gwt-celltable" +"135","expo-notifications" +"135","xcode9.3" +"135","scorm1.2" +"135","uideviceorientation" +"135","screen-density" +"135","uiedgeinsets" +"135","sqlite3-python" +"135","opennetcf" +"135","property-wrapper" +"135","cube.js" +"135","iphone-softkeyboard" +"135","activity-manager" +"135","long-long" +"135","lastinsertid" +"135","laravel-vapor" +"135","google-cloud-dlp" +"135","commit-message" +"135","spp" +"135","webgpu" +"135","timeago" +"135","mbr" +"135","ends-with" +"135","iframe-resizer" +"135","state-restoration" +"135","spark-shell" +"135","ember-model" +"134","stack-unwinding" +"134","vue-class-components" +"134","terminator" +"134","deeplab" +"134","treelist" +"134","graph-coloring" +"134","yepnope" +"134","imultivalueconverter" +"134","symfony-validator" +"134","fishpig" +"134","first-class-functions" +"134","self-organizing-maps" +"134","const-reference" +"134","manualresetevent" +"134","snmpd" +"134","metric" +"134","angularjs-select2" +"134","native-activity" +"134","jpcap" +"134","sequence-alignment" +"134","valuechangelistener" +"134","icollectionview" +"134","angularjs-ng-init" +"134","sitecore-dms" +"134","rocket-chip" +"134","mod-expires" +"134","tweetinvi" +"134","environmentobject" +"134","crate" +"134","ingress-nginx" +"134","postmark" +"134","lync-client-sdk" +"134","type-narrowing" +"134","rajawali" +"134","browser-addons" +"134","go-http" +"134","short-url" +"134","accelerated-mobile-page" +"134","siamese-network" +"134","overfitting-underfitting" +"134","rgraph" +"134","xades4j" +"134","isbn" +"134","gammu" +"134","table-per-hierarchy" +"134","halcon" +"134","spring-vault" +"134","performancepoint" +"134","sparse-checkout" +"134","member-initialization" +"134","element-plus" +"134","motordriver" +"134","elastic-cloud" +"134","angular-guards" +"134","nidaqmx" +"134","strava" +"134","cxf-client" +"134","amazon-advertising-api" +"134","ember-testing" +"134","preemption" +"134","urwid" +"134","liferay-velocity" +"134","git-p4" +"134","compound-literals" +"134","computation-expression" +"134","parallel-port" +"133","webproxy" +"133","phpexcelreader" +"133","bandwidth-throttling" +"133","django-1.3" +"133","unetstack" +"133","js-cookie" +"133","castle-monorail" +"133","uniform-initialization" +"133","semantic-analysis" +"133","platform-independent" +"133","python-jsonschema" +"133","self-referencing-table" +"133","wikimedia" +"133","airflow-taskflow" +"133","django-syncdb" +"133","angular-slickgrid" +"133","valence" +"133","robustness" +"133","go-testing" +"133","w3c-geolocation" +"133","post-build" +"133","countries" +"133","htdocs" +"133","keen-io" +"133","keda" +"133","information-hiding" +"133","hotfix" +"133","navigateurl" +"133","oclazyload" +"133","winpe" +"133","domain-events" +"133","foxx" +"133","audio-fingerprinting" +"133","tableheader" +"133","rewardedvideoad" +"133","machine-learning-model" +"133","android-app-links" +"133","victoriametrics" +"133","executequery" +"133","time-limiting" +"133","tin-can-api" +"133","asm.js" +"133","game-maker-language" +"133","openstack-horizon" +"133","taglib-sharp" +"133","drf-queryset" +"133","hangouts-api" +"133","highest" +"133","hmmlearn" +"133","tailwind-in-js" +"133","asp.net-web-api-odata" +"133","logback-classic" +"133","oim" +"133","message-digest" +"133","geronimo" +"133","stringtemplate-4" +"133","character-arrays" +"133","angularjs-forms" +"133","logical-or" +"133","custom-membershipprovider" +"133","sublimetext4" +"133","batterymanager" +"133","gitweb" +"133","dalli" +"133","computed-observable" +"133","google-news" +"132","insets" +"132","ghdl" +"132","insert-select" +"132","wfp" +"132","vue-tables-2" +"132","tsibble" +"132","file-recovery" +"132","xenforo" +"132","impex" +"132","symfony-console" +"132","adomd.net" +"132","ng2-dragula" +"132","jtoolbar" +"132","biztalk2006r2" +"132","kubernetes-custom-resources" +"132","manual-testing" +"132","sybase-ase15" +"132","apache-kudu" +"132","nextui" +"132","mapster" +"132","vaticle-typedb" +"132","docfx" +"132","django-modeladmin" +"132","createuserwizard" +"132","database-locking" +"132","aws-java-sdk-2.x" +"132","canvg" +"132","worldpay" +"132","jquery-terminal" +"132","boo" +"132","enterprise-integration" +"132","port80" +"132","bokehjs" +"132","descendant" +"132","botan" +"132","appsflyer" +"132","type-coercion" +"132","visual-studio-2017-build-tools" +"132","attoparsec" +"132","fql.multiquery" +"132","komodoedit" +"132","kotest" +"132","winusb" +"132","aabb" +"132","codahale-metrics" +"132","output-parameter" +"132","minishift" +"132","outlet" +"132","opera-mini" +"132","opensips" +"132","xacml3" +"132","nstreecontroller" +"132","column-count" +"132","cerberus" +"132","stripe.net" +"132","nms" +"132","google-cloud-api-gateway" +"132","string-pool" +"132","getparameter" +"132","angular2-modules" +"132","splitview" +"132","motorola-emdk" +"132","flutter-notification" +"132","sonarqube-5.0" +"132","component-scan" +"132","parse-android-sdk" +"132","webpack-plugin" +"132","sumologic" +"132","email-parsing" +"132","bcc-bpf" +"131","cmake-language" +"131","eclemma" +"131","maven-bundle-plugin" +"131","greenfoot" +"131","x-ua-compatible" +"131","ebextensions" +"131","process-substitution" +"131","trpc.io" +"131","file-encodings" +"131","xs" +"131","react-native-hermes" +"131","ffimageloading" +"131","pickadate" +"131","snappydata" +"131","imdbpy" +"131","symfony2-easyadmin" +"131","jsctypes" +"131","sensor-fusion" +"131","selectable" +"131","fixture" +"131","fadeto" +"131","akka-actor" +"131","jqmodal" +"131","kendo-react-ui" +"131","server.mappath" +"131","database-mirroring" +"131","gqlquery" +"131","microsoft-account" +"131","wan" +"131","roblox-studio" +"131","share-button" +"131","microfocus" +"131","twilio-conversations" +"131","intersystems" +"131","couchdb-nano" +"131","eager" +"131","intraweb" +"131","modx-evolution" +"131","inotifycollectionchanged" +"131","opencypher" +"131","booleanquery" +"131","atof" +"131","retrieval-augmented-generation" +"131","typekit" +"131","anchor-scroll" +"131","android-biometric" +"131","microsoft-identity-web" +"131","shinobi" +"131","aasm" +"131","winmain" +"131","vision-api" +"131","abpeoplepickerview" +"131","shacl" +"131","sql-server-2022" +"131","android-color" +"131","sprint" +"131","uint16" +"131","diagramming" +"131","npm-audit" +"131","acrobat-sdk" +"131","proxy-pattern" +"131","angular2-meteor" +"131","excel-automation" +"131","nightwatch" +"131","ioslides" +"131","oncheckedchanged" +"131","lti" +"131","splash-js-render" +"131","search-path" +"131","soundplayer" +"131","suite" +"131","linker-flags" +"131","compiler-directives" +"131","yt-dlp" +"131","zonejs" +"131","scrolltrigger" +"131","glide-golang" +"131","user-presence" +"131","tortoise-orm" +"131","ember-components" +"131","lift-json" +"131","sonarqube-msbuild-runner" +"130","weak" +"130","renderaction" +"130","ghidra" +"130","whitenoise" +"130","react-native-fetch-blob" +"130","ansible-galaxy" +"130","anypoint-platform" +"130","ggforce" +"130","seleniumbase" +"130","consistent-hashing" +"130","python-collections" +"130","fileobserver" +"130","datarepeater" +"130","phusion" +"130","binary-image" +"130","aws-sdk-cpp" +"130","jnetpcap" +"130","datagridcolumn" +"130","django-related-manager" +"130","ibinspectable" +"130","cropper" +"130","servicemesh" +"130","spring-cloud-vault-config" +"130","intl-tel-input" +"130","nscolor" +"130","porter-stemmer" +"130","pdfplumber" +"130","supercollider" +"130","corespotlight" +"130","neo4j-spatial" +"130","depth-testing" +"130","twitter-digits" +"130","s-function" +"130","magick.net" +"130","brms" +"130","libsass" +"130","dojox.mobile" +"130","object-object-mapping" +"130","virtocommerce" +"130","javascript-import" +"130","r-colnames" +"130","excel-online" +"130","tchromium" +"130","generalization" +"130","gwt-super-dev-mode" +"130","haddock" +"130","xaudio2" +"130","jackcess" +"130","collectionfs" +"130","getenv" +"130","elasticsearch-opendistro" +"130","accesscontrolexception" +"130","android-profiler" +"130","texture-atlas" +"130","tfs-migration" +"130","mayavi.mlab" +"130","stm32f0" +"130","staruml" +"130","spaceship-operator" +"130","md-autocomplete" +"130","automaton" +"130","heap-size" +"130","soot" +"129","templating-engine" +"129","teamcity-7.0" +"129","clearcase-remote-client" +"129","terminfo" +"129","declarative-authorization" +"129","matlab-uitable" +"129","basehttpserver" +"129","relativesource" +"129","cllocationcoordinate2d" +"129","cl.exe" +"129","apache-commons-cli" +"129","r-xlsx" +"129","jsbin" +"129","blame" +"129","blazegraph" +"129","datamatrix" +"129","image-optimization" +"129","selenium-java" +"129","ngx-quill" +"129","pixelformat" +"129","datastax-astra" +"129","sensenet" +"129","kubernetes-go-client" +"129","runloop" +"129","pad" +"129","mysql-backup" +"129","angularjs-watch" +"129","oracle-autonomous-db" +"129","fb-graph" +"129","recvfrom" +"129","internal-load-balancer" +"129","appxmanifest" +"129","pdfium" +"129","counter-cache" +"129","boringssl" +"129","postcss-loader" +"129","grunt-contrib-copy" +"129","designmode" +"129","springboard" +"129","nsrangeexception" +"129","gtts" +"129","formatdatetime" +"129","legacy-database" +"129","a2dp" +"129","uft14" +"129","overlays" +"129","pytest-cov" +"129","virtualscroll" +"129","typo3-8.7.x" +"129","pythagorean" +"129","devise-token-auth" +"129","android-bottomnavigationview" +"129","c#-ziparchive" +"129","hibernate-session" +"129","histogram2d" +"129","experimental-design" +"129","c3" +"129","noindex" +"129","istream-iterator" +"129","q#" +"129","node-opcua" +"129","perfect" +"129","prototype-chain" +"129","logical-replication" +"129","proj4js" +"129","loginview" +"129","mercurial-subrepos" +"129","commandparameter" +"129","hyperion" +"129","node-addon-api" +"129","log-analysis" +"129","autocloseable" +"129","auth-token" +"129","quick.db" +"129","altitude" +"129","threadgroup" +"129","zip4j" +"129","amazon-kinesis-analytics" +"129","static-pages" +"129","ms-jet-ace" +"129","trackpad" +"129","dart-ffi" +"129","shell32" +"128","installshield-2012" +"128","sslsocketfactory" +"128","smallrye-reactive-messaging" +"128","proftpd" +"128","edgar" +"128","squeel" +"128","in-subquery" +"128","stackedbarseries" +"128","intellitrace" +"128","grasshopper" +"128","editbox" +"128","choco" +"128","pythoninterpreter" +"128","pivot-chart" +"128","snow" +"128","ngui" +"128","g++4.8" +"128","file-ownership" +"128","fulltext-index" +"128","date-math" +"128","unidata" +"128","ftrace" +"128","ngonchanges" +"128","pacemaker" +"128","swiftui-foreach" +"128","filetable" +"128","jfrog-xray" +"128","mysql-error-1062" +"128","realpath" +"128","wcs" +"128","albumart" +"128","keyboard-navigation" +"128","readonly-attribute" +"128","calendarextender" +"128","aws-config" +"128","datagridcell" +"128","core-nfc" +"128","simple.data" +"128","createinstance" +"128","injectable" +"128","interruption" +"128","appsdk2" +"128","cp1252" +"128","asyncore" +"128","system-clock" +"128","shading" +"128","kqueue" +"128",".lib" +"128","browsermob" +"128","audit.net" +"128","domcontentloaded" +"128","mikroc" +"128","ubuntu-12.10" +"128","nsstringencoding" +"128","tab-ordering" +"128","redis-server" +"128","caffeine" +"128","expo-camera" +"128","nomenclature" +"128","model-driven" +"128","play-slick" +"128","ej2-syncfusion" +"128","proof-of-correctness" +"128","acr122" +"128","iprincipal" +"128","gerrit-trigger" +"128","angular-decorator" +"128","perfect-numbers" +"128","iphone-sdk-3.2" +"128","mpu6050" +"128","android-jetpack-compose-lazy-column" +"128","colormatrix" +"128","automapper-3" +"128","static-functions" +"128","custom-tag" +"128","usermanager" +"128","starteam" +"128","topdown" +"128","webapi2" +"128","maven-scm" +"128","pressed" +"128","parallel-coordinates" +"127","multiple-languages" +"127","reorderlist" +"127","fernet" +"127","installutil" +"127","debug-mode" +"127","clipboardmanager" +"127","feature-file" +"127","ssh2-sftp" +"127","jedit" +"127","pixmap" +"127","child-nodes" +"127","language-specifications" +"127","cartography" +"127","vscode-remote-ssh" +"127","kik" +"127","readystate" +"127","simplex" +"127","pure-function" +"127","read-data" +"127","wake-on-lan" +"127","serverxmlhttp" +"127","unity3d-mirror" +"127","nd4j" +"127","satchmo" +"127","epic" +"127","mongo-c-driver" +"127","spring-reactive" +"127","saxparseexception" +"127","dynamic-compilation" +"127","bootstrap-tour" +"127","navigationservice" +"127","twitter-card" +"127","deltaspike" +"127","bonobo" +"127","pathgeometry" +"127","spring-aspects" +"127","boost-date-time" +"127","fputs" +"127","coldfusion-2018" +"127","rive" +"127","pylucene" +"127","kotlin-reflect" +"127","rdcomclient" +"127","kolmogorov-smirnov" +"127","knppaginator" +"127","java-record" +"127","oracle-text" +"127","tamil" +"127","holtwinters" +"127","dronekit-python" +"127","azure-tablequery" +"127","ui-sref" +"127","executereader" +"127","react-jsonschema-forms" +"127","textile" +"127","omnithreadlibrary" +"127","angularjs-1.5" +"127","pega" +"127","android-layoutparams" +"127","offline-browsing" +"127","meta-inf" +"127","accessory" +"127","webcenter" +"127","power-law" +"127","sparkling-water" +"127","sticky-session" +"127","therubyracer" +"127","heightforrowatindexpath" +"127","sharppcap" +"127","query-expressions" +"127","linphone-sdk" +"127","bgp" +"127","altova" +"126","white-labelling" +"126","lite-server" +"126","react-native-modal" +"126","lnk" +"126","rendertargetbitmap" +"126","websub" +"126","selectsinglenode" +"126","django-3.2" +"126","rust-analyzer" +"126","django-3.1" +"126","pinecone" +"126","datashader" +"126","bind9" +"126","appgallery" +"126","kendo-upload" +"126","pumping-lemma" +"126","data-consistency" +"126","cakephp-bake" +"126","graphaware" +"126","jolokia" +"126","failure-slice" +"126","mysqlnd" +"126","aws-documentdb-mongoapi" +"126","fatfs" +"126","callgrind" +"126","wazuh" +"126","silhouette" +"126","delayedvariableexpansion" +"126","aws-vpc" +"126","devcontainer" +"126","htc-android" +"126","pddl" +"126","nsalert" +"126","inotifywait" +"126","onitemselectedlistener" +"126","signed-applet" +"126","virtual-serial-port" +"126","google-ads-script" +"126","cocoalumberjack" +"126","syntaxnet" +"126","shake-build-system" +"126","krl" +"126","java-16" +"126","video-tracking" +"126","riot-games-api" +"126","osx-gatekeeper" +"126","outlook.com" +"126","pyodide" +"126","synthesize" +"126","rfc822" +"126","qwik" +"126","spry" +"126","expectation-maximization" +"126","mobilefirst-studio" +"126","assistant" +"126","azure-nsg" +"126","drupal-rules" +"126","tcc" +"126","curves" +"126","react-bootstrap-typeahead" +"126","geofirestore" +"126","custom-headers" +"126","qchart" +"126","qnx-neutrino" +"126","changelist" +"126","strdup" +"126","splitcontainer" +"126","collectstatic" +"126","curb" +"126","pegjs" +"126","lastindexof" +"126","tilemill" +"126","mdriven" +"126","line-intersection" +"126","yubico" +"126","flutter-theme" +"126","secondary-indexes" +"126","automated-deploy" +"126","hawq" +"126","autorest" +"126","powerbi-paginated-reports" +"125","livequery" +"125","ssjs" +"125","lis" +"125","ffserver" +"125","gimpfu" +"125","reportportal" +"125","fso" +"125","xmltextreader" +"125","pisa" +"125","xdebug-3" +"125","jsonencoder" +"125","volusion" +"125","snowflake-task" +"125","page-layout" +"125","jsonnet" +"125","runtime-compilation" +"125","faultexception" +"125","captiveportal" +"125","windows-error-reporting" +"125","wamp-protocol" +"125","mezzio" +"125","capability" +"125","windows-embedded" +"125","djcelery" +"125","readinessprobe" +"125","htop" +"125","jquery-mobile-collapsible" +"125","boolean-algebra" +"125","natural-join" +"125","covariance-matrix" +"125","spring-integration-aws" +"125","samtools" +"125","epl" +"125","nawk" +"125","wpa-supplicant" +"125","nelmioapidocbundle" +"125","postgraphile" +"125","otel" +"125","object-fit" +"125","microsoft-graph-toolkit" +"125","viper-architecture" +"125","pyenchant" +"125","javap" +"125","kiwi" +"125","ambiguous-grammar" +"125","sqlmap" +"125","copyright-display" +"125","xcode-6.2" +"125","dotliquid" +"125","hiddenfield" +"125","tabstop" +"125","harbor" +"125","drools-flow" +"125","dijit.layout" +"125","device-manager" +"125","honeypot" +"125","nstablecellview" +"125","stringwithformat" +"125","test-plan" +"125","accessibility-api" +"125","petalinux" +"125","evdev" +"125","android-media3" +"125","ligature" +"125","google-scholar" +"125","zend-decorators" +"125","scroll-snap" +"125","google-one-tap" +"125","usb-flash-drive" +"125","statelesswidget" +"125","array-initialization" +"124","jetpack-compose-accompanist" +"124","prismjs" +"124","git-alias" +"124","sliverappbar" +"124","ycsb" +"124","multitargeting" +"124","vue-select" +"124","swiftui-form" +"124","apache-ranger" +"124","rust-wasm" +"124","content-pages" +"124","owlready" +"124","sense" +"124","symbolicate" +"124","serialversionuid" +"124","document-management" +"124","recreate" +"124","wap" +"124","mysql-insert-id" +"124","django-paypal" +"124","captivenetwork" +"124","workfront-api" +"124","jquery-selectbox" +"124","cpanm" +"124","android-task" +"124","grpc-c#" +"124","spring-jmx" +"124","couchdb-2.0" +"124","wordprocessingml" +"124","dynamic-queries" +"124","horizontal-pod-autoscaling" +"124","entity-framework-core-2.1" +"124","mod-fcgid" +"124","rexml" +"124","facebook-instant-games" +"124","ucs2" +"124","sfguard" +"124","java-melody" +"124","machine.config" +"124","javalite" +"124","konvajs-reactjs" +"124","setneedsdisplay" +"124","codeigniter-hmvc" +"124","fosoauthserverbundle" +"124","vivado-hls" +"124","azure-monitor-workbooks" +"124","polish" +"124","cordova-android" +"124","driverkit" +"124","gdb-python" +"124","redux-devtools" +"124","android-flavors" +"124","gwt-mvp" +"124","hackage" +"124","nurbs" +"124","h3" +"124","tinyos" +"124","researchkit" +"124","elasticsearch-jdbc-river" +"124","projector" +"124","acrofields" +"124","cfmail" +"124","perforce-client-spec" +"124","pywikibot" +"124","nl2br" +"124","character-set" +"124","prometheus-blackbox-exporter" +"124","angular-dom-sanitizer" +"124","protege4" +"124","angular2-cli" +"124","email-confirmation" +"124","qtextdocument" +"124","security-roles" +"124","pari" +"124","autodesk-inventor" +"124","parameterized-unit-test" +"124","solr-boost" +"124","zkteco" +"124","google-meet" +"124","parallel-extensions" +"123","multiple-records" +"123","jenkins-2" +"123","php-8.2" +"123","git-blame" +"123","slimerjs" +"123","replay" +"123","cjson" +"123","react-native-ui-kitten" +"123","telescope" +"123","graphql-mutation" +"123","cni" +"123","jsonconverter" +"123","jtogglebutton" +"123","apparmor" +"123","makecert" +"123","rworldmap" +"123","ngx-formly" +"123","apache-wink" +"123","configurationsection" +"123","snap" +"123","language-comparisons" +"123","wcsession" +"123","roracle" +"123","singularitygs" +"123","method-missing" +"123","canvas-lms" +"123","docker-daemon" +"123","variable-initialization" +"123","metastore" +"123","unsupported-class-version" +"123","rospy" +"123","gpib" +"123","rtd" +"123","pdu" +"123","paypal-webhooks" +"123","coveralls" +"123","initialization-vector" +"123","describe" +"123","createml" +"123","azure-billing-api" +"123","writable" +"123","nslayoutmanager" +"123","swagger-3.0" +"123","video-toolbox" +"123","netlify-function" +"123","javacpp" +"123","migrating" +"123","google-beacon-platform" +"123","kube-apiserver" +"123","object-type" +"123","shunting-yard" +"123","atomicinteger" +"123","reflect" +"123","spyon" +"123","tms-web-core" +"123","azure-mysql-database" +"123","drift" +"123","conversion-specifier" +"123","permanent" +"123","qregularexpression" +"123","commandbar" +"123","angular-dependency-injection" +"123","mercator" +"123","tone.js" +"123","spatial-interpolation" +"123","morgan" +"123","merge-request" +"123","exacttarget" +"123","qabstractlistmodel" +"123","zeos" +"123","google-tasks" +"123","beam" +"123","fminsearch" +"122","mat-form-field" +"122","clonenode" +"122","dbref" +"122","ggts" +"122","list-manipulation" +"122","instrumented-test" +"122","jersey-test-framework" +"122","inspec" +"122","xmltodict" +"122","jsonslurper" +"122","xmltextwriter" +"122","data-race" +"122","maplibre-gl" +"122","firebird2.1" +"122","pins" +"122","bitflags" +"122","label-encoding" +"122","xdomainrequest" +"122","kinematics" +"122","robobrowser" +"122","ajax-request" +"122","database-management" +"122","variable-types" +"122","rollbar" +"122","gpg-signature" +"122","jmdns" +"122","google-workflows" +"122","waffle" +"122","vundle" +"122","kendo-tabstrip" +"122","vdsp" +"122","jpa-criteria" +"122","kerberos-delegation" +"122","angular-material-stepper" +"122","routeparams" +"122","nsprogressindicator" +"122","mongodb-kafka-connector" +"122","junit-runner" +"122","paypal-nvp" +"122","nspersistentstore" +"122","junction" +"122","spring-boot-2" +"122","bootstrap-switch" +"122","u2" +"122","tyrus" +"122","system32" +"122","visualize" +"122","ext3" +"122","god" +"122","extract-text-plugin" +"122","rgeo" +"122","magento2.1" +"122","exchange-server-2013" +"122","notarize" +"122","dropbox-php" +"122","node-worker-threads" +"122","opengl-es-1.1" +"122","controlpanel" +"122","haptic-feedback" +"122","azure-triggers" +"122","redo" +"122","android-darkmode" +"122","gzipinputstream" +"122","nuxeo" +"122","radtreeview" +"122","numpad" +"122","azure-iot-hub-device-management" +"122","scope-identity" +"122","charset" +"122","spartan" +"122","cuba-platform" +"122","mesh-network" +"122","reactive-swift" +"122","google-feed-api" +"122","bearing" +"122","arcade" +"122","flutter-sharedpreference" +"122","ems" +"122","idle-timer" +"122","query-tuning" +"121","template-function" +"121","anyobject" +"121","cloudflare-pages" +"121","weekend" +"121","interact.js" +"121","listcellrenderer" +"121","primeng-calendar" +"121","reporters" +"121","cncontactstore" +"121","instantsearch.js" +"121","jetty-8" +"121","js-test-driver" +"121","runbook" +"121","kue" +"121","inbound" +"121","selectnodes" +"121","adaptive-design" +"121","xmlsec" +"121","chronicle-map" +"121","xojo" +"121","python-oracledb" +"121","swingutilities" +"121","fulfillment" +"121","pycassa" +"121","idatareader" +"121","unreal" +"121","unityads" +"121","data-export" +"121","akka-remote-actor" +"121","ag" +"121","hypermedia" +"121","react-toastify" +"121","description-logic" +"121","wp-list-categories" +"121","polymerfire" +"121","turbo-pascal" +"121","onselect" +"121","ndjson" +"121","jump-list" +"121","entity-framework-core-3.1" +"121","spring-shell" +"121","san" +"121","ios10.3" +"121","powerapps-collection" +"121","maf" +"121","build-runner" +"121","knpmenubundle" +"121","vignette" +"121","2captcha" +"121","typeloadexception" +"121","accelerator" +"121","riscv32" +"121","goodness-of-fit" +"121","networkimageview" +"121","origen-sdk" +"121","gcovr" +"121","jackrabbit-oak" +"121","ref-cursor" +"121","express-gateway" +"121","tivoli" +"121","nowjs-sockets" +"121","gcc4.8" +"121","nstableviewcell" +"121","no-op" +"121","expectations" +"121","uievent" +"121","notsupportedexception" +"121","azure-resource-graph" +"121","peoplepicker" +"121","access-keys" +"121","omnicomplete" +"121","android-recents" +"121","react-native-animatable" +"121","reactive-extensions-js" +"121","react-native-ble-plx" +"121","react-flow" +"121","testdriven.net" +"121","lsa" +"121","qevent" +"121","layered-navigation" +"121","activestate" +"121","sphinxql" +"121","messageui" +"121","ihttpmodule" +"121","scriptable-object" +"121","cxf-codegen-plugin" +"121","partialfunction" +"121","cyclic-dependency" +"121","cydia-substrate" +"121","idispatch" +"121","hessian-matrix" +"121","usertype" +"121","subject-observer" +"121","stm32cubemx" +"121","ie11-developer-tools" +"121","parallax.js" +"121","spark-koalas" +"121","avahi" +"120","material-components-web" +"120","flutter-doctor" +"120","liquibase-sql" +"120","yourkit" +"120","yandex-maps" +"120","trident" +"120","ansys" +"120","web-platform-installer" +"120","template-method-pattern" +"120","xsp" +"120","ffmpeg-python" +"120","jssc" +"120","dataservice" +"120","django-admin-tools" +"120","childbrowser" +"120","jt400" +"120","discord-buttons" +"120","bioperl" +"120","contentsize" +"120","xpathnavigator" +"120","psr-0" +"120","roboflow" +"120","airwatch" +"120","univocity" +"120","session-hijacking" +"120","dataflowtask" +"120","ionic-cli" +"120","money-format" +"120","azure-dns" +"120","sap-data-dictionary" +"120","inputview" +"120","nscombobox" +"120","frameworkelement" +"120","object-properties" +"120","abstract-base-class" +"120","java-canvas" +"120","net-use" +"120","netrw" +"120","winrt-xaml-toolkit" +"120","bug-reporting" +"120","lzo" +"120","kraken.js" +"120","outlook-api" +"120","wmd" +"120","google-app-engine-php" +"120","setw" +"120","modelandview" +"120","devkit" +"120","schema-compare" +"120","hardcoded" +"120","notserializableexception" +"120","numeric-limits" +"120","tkcalendar" +"120","xcode7.1" +"120","horizon" +"120","certificate-store" +"120","android-jetpack-compose-text" +"120","c-standard-library" +"120","proximitysensor" +"120","http-content-length" +"120","qprinter" +"120","combn" +"120","cybersource" +"120","bcel" +"120","multi-database" +"120","yui-datatable" +"120","weave" +"120","pari-gp" +"120","arcanist" +"120","stdint" +"120","tournament" +"120","uvc" +"120","solana-cli" +"120","stl-format" +"120","sparkpost" +"120","praat" +"120","mediaextractor" +"119","jest-puppeteer" +"119","renovate" +"119","clojure-core.logic" +"119","printscreen" +"119","edittextpreference" +"119","wearables" +"119","sites" +"119","sshj" +"119","tegra" +"119","webpack-splitchunks" +"119","edifact" +"119","master-data-services" +"119","ssdp" +"119","mariadb-10.5" +"119","blackberry-storm" +"119","xmlnodelist" +"119","select-menu" +"119","filter-var" +"119","graceful-degradation" +"119","rml" +"119","canon-sdk" +"119","varray" +"119","ruby-2.2" +"119","vapor-fluent" +"119","grails-4" +"119","ibm-odm" +"119","gui-builder" +"119","invokelater" +"119","boost-any" +"119","e" +"119","density-independent-pixel" +"119","intermittent" +"119","bootstrap-slider" +"119","nebula-graph" +"119","gulp-less" +"119","inverse-kinematics" +"119","abbyy" +"119","code-standards" +"119","kpi" +"119","pymol" +"119","oauth-provider" +"119","visual-c++-2012" +"119","codepoint" +"119","observability" +"119","sfspeechrecognizer" +"119","output-formatting" +"119","object-tag" +"119","rexster" +"119","buildship" +"119","typescript1.4" +"119","java1.4" +"119","scramble" +"119","radzen" +"119","tadoquery" +"119","gemspecs" +"119","redisjson" +"119","assume-role" +"119","byebug" +"119","chameleon" +"119","spongycastle" +"119","dtw" +"119","react-360" +"119","qcompleter" +"119","react-data-table-component" +"119","off-screen" +"119","angular-activatedroute" +"119","angular-cookies" +"119","angular2-router" +"119","liferay-service-builder" +"119","sdl-mixer" +"119","stateful-session-bean" +"119","image-generation" +"119","better-sqlite3" +"119","sortedmap" +"119","heterogeneous" +"119","mstsc" +"119","google-index" +"118","backtrader" +"118","stack-size" +"118","flow-typed" +"118","flutter-freezed" +"118","lld" +"118","lambda-authorizer" +"118","firebase-admob" +"118","cdialog" +"118","firebase-invites" +"118","makemigrations" +"118","date-pipe" +"118","next-intl" +"118","swift-package" +"118","fileset" +"118","select2-rails" +"118","window-soft-input-mode" +"118","jint" +"118","job-queue" +"118","aws-lex" +"118","r-rownames" +"118","walmart-api" +"118","unrar" +"118","django-sites" +"118","facter" +"118","session-replication" +"118","modulation" +"118","mod-ssl" +"118","grpc-c++" +"118","samsung" +"118","satisfiability" +"118","erc721" +"118","core-js" +"118","applovin" +"118","aws-sqs-fifo" +"118","spring-security-kerberos" +"118","crash-log" +"118","porter-duff" +"118","nssavepanel" +"118","spring-autoconfiguration" +"118","shader-graph" +"118","branch-and-bound" +"118","knative-serving" +"118","domexception" +"118","pytest-asyncio" +"118","kotlin-interop" +"118","lexicaljs" +"118","sysml" +"118","objective-c-swift-bridge" +"118","ex-unit" +"118","browser-tab" +"118","shortest" +"118","visualworks" +"118","visited" +"118","rda" +"118","non-recursive" +"118","cookieless" +"118","cacti" +"118","controller-advice" +"118","xcode6.4" +"118","haar-wavelet" +"118","nowrap" +"118","polyglot" +"118","gcc4.9" +"118","deviceiocontrol" +"118","hiveddl" +"118","execl" +"118","gembox-spreadsheet" +"118","g-code" +"118","converse.js" +"118","openmaptiles" +"118","account-management" +"118","monospace" +"118","motif" +"118","mosaic" +"118","messagedialog" +"118","log4js-node" +"118","ldapjs" +"118","elementhost" +"118","qnetworkreply" +"118","onclientclick" +"118","geotagging" +"118","elasticsearch-rails" +"118","office-js-helpers" +"118","ctype" +"118","stripe.js" +"118","iqkeyboardmanager" +"118","tf-cli" +"118","themeroller" +"118","batchsize" +"118","structuremap3" +"118","amazon-keyspaces" +"118","illuminate-container" +"118","forall" +"118","userspace" +"118","automapper-6" +"118","compound-index" +"118","gm" +"118","artifactory-query-lang" +"118","custom-scrolling" +"118","git-rm" +"118","cyclic" +"118","amazon-pay" +"117","site-prism" +"117","git-filter-repo" +"117","st" +"117","graphcool" +"117","slimscroll" +"117","lnk2005" +"117","xsd2code" +"117","remedy" +"117","slidify" +"117","ssis-2017" +"117","github-app" +"117","reportviewer2008" +"117","youtube-analytics" +"117","ccnet-config" +"117","containable" +"117","jsapi" +"117","jsonreader" +"117","sendinblue" +"117","main-method" +"117","cedar" +"117","operator-sdk" +"117","oracle8i" +"117","readxml" +"117","unsafemutablepointer" +"117","airdrop" +"117","windows-server-2022" +"117","rebar3" +"117","server-side-validation" +"117","push-api" +"117","angular-ngrx-data" +"117","mongodb-shell" +"117","onstart" +"117","superpowered" +"117","dynamicmethod" +"117","nsexpression" +"117","nebula" +"117","ordereddict" +"117","virtualpathprovider" +"117","system.timers.timer" +"117","sidenav" +"117","wkhtmltoimage" +"117","ezdxf" +"117","golang-migrate" +"117","browserify-shim" +"117","mips64" +"117","sfdc" +"117","lynx" +"117",".net-maui.shell" +"117","typemock" +"117","typo3-flow" +"117","rewriting" +"117","gogs" +"117","amazon-workspaces" +"117","fabricjs2" +"117","asp.net-mvc-ajax" +"117","reformat" +"117","openlaszlo" +"117","hadoop3" +"117","android-gradle-3.0" +"117","tlf" +"117","openpose" +"117","scite" +"117","openshift-cartridge" +"117","expires-header" +"117","differentialequations.jl" +"117","laravel-localization" +"117","chai-as-promised" +"117","iptc" +"117","textinputlayout" +"117","proxyquire" +"117","logstash-logback-encoder" +"117","qnap" +"117","texreg" +"117","strict-mode" +"117","angular-cdk-virtual-scroll" +"117","custom-properties" +"117","property-list" +"117","goal-tracking" +"117","mean-square-error" +"117","cyclejs" +"117","zebra-puzzle" +"117","tilt" +"116","gitblit" +"116","apache-commons-csv" +"116","clicklistener" +"116","fiji" +"116","cmake-custom-command" +"116","cloudcontrol" +"116","probe" +"116","editorjs" +"116","wdf" +"116","livenessprobe" +"116","phpthumb" +"116","console.readline" +"116","xlc" +"116","ngrx-store-4.0" +"116","select-object" +"116","flask-restless" +"116","image-quality" +"116","ccl" +"116","adfs4.0" +"116","kubernetes-security" +"116","xgbclassifier" +"116","kubernetes-networking" +"116","ruby-mocha" +"116","grails-2.4" +"116","dnspython" +"116","urlconf" +"116","facial-identification" +"116","namevaluecollection" +"116","vcredist" +"116","windows-dev-center" +"116","ibm-cloud-storage" +"116","sharepoint-2019" +"116","share-open-graph" +"116","wildfly-11" +"116","callout" +"116","data-acquisition" +"116","waithandle" +"116","watch-face-api" +"116","kafka-rest" +"116","border-image" +"116","onsen-ui2" +"116","create-function" +"116","crafter-cms" +"116","worker-process" +"116","htmlbars" +"116","gulp-protractor" +"116","angstrom-linux" +"116","natvis" +"116","hssf" +"116","wp-nav-walker" +"116","winmm" +"116","libev" +"116","codelens" +"116","kmm" +"116","reversing" +"116","libmysql" +"116","kong-ingress" +"116","libgosu" +"116","model.matrix" +"116","opennms" +"116","opera-extension" +"116","hololens-emulator" +"116","playwright-java" +"116","timer-jobs" +"116","reference-wrapper" +"116","tablerowsorter" +"116","caffe2" +"116","nvenc" +"116","regfreecom" +"116","characteristics" +"116","essbase" +"116","text-indent" +"116","spir-v" +"116","chart.js3" +"116","log-shipping" +"116","iggrid" +"116","seam3" +"116","hasownproperty" +"116","stb-image" +"116","ember-old-router" +"116","idn" +"116","toolstripmenu" +"116","texturing" +"116","zend-db-select" +"116","subsampling" +"116","auto-value" +"116","force-download" +"116","tf-slim" +"116","avaudioplayernode" +"116","quartile" +"115","primality-test" +"115","jenkins-docker" +"115","github-api-v3" +"115","trojan" +"115","treesitter" +"115","instruction-encoding" +"115","reactor-kafka" +"115","react-on-rails" +"115","graphql-tools" +"115","sstream" +"115","phonetics" +"115","co" +"115","carryflag" +"115","appfuse" +"115","voicexml" +"115","laravel-events" +"115","cinder" +"115","cclayer" +"115","saleor" +"115","smartfoxserver" +"115","catalan" +"115","angular-ui-router-extras" +"115","pscp" +"115","id3v2" +"115","vdproj" +"115","ajax-upload" +"115","cs4" +"115","windows-mobile-5.0" +"115","aws-cdk-typescript" +"115","createprocessasuser" +"115","nscell" +"115","errai" +"115","payara-micro" +"115","turing-complete" +"115","initializing" +"115","native-module" +"115","android-usb" +"115","azimuth" +"115","borderpane" +"115","infix-operator" +"115","modular-design" +"115","deployd" +"115","ar.drone" +"115","nssearchfield" +"115","appintents" +"115","entrust" +"115","8085" +"115","ampscript" +"115","pyjwt" +"115","viewexpiredexception" +"115","setupapi" +"115","neventstore" +"115","oracle-ucm" +"115","4d-database" +"115","asyncdisplaykit" +"115","domready" +"115","ixmlserializable" +"115","hitcounter" +"115","android-gui" +"115","cooja" +"115","quicksand" +"115","hiphop" +"115","protobuf.js" +"115","layered" +"115","launchpad" +"115","odf" +"115","pen" +"115","location-provider" +"115","mesibo" +"115","off-canvas-menu" +"115","react-native-debugger" +"115","qbs" +"115","google-fit-api" +"115","node-fibers" +"115","maxent" +"115","qtscript" +"115","mbaas" +"115","gnu-smalltalk" +"115","url-masking" +"115","line-by-line" +"115","elsa-workflows" +"115","beaker" +"115","fontmetrics" +"115","std-bitset" +"115","zclip" +"115","google-smartlockpasswords" +"115","sup" +"115","zbuffer" +"114","muse" +"114","websocket-sharp" +"114","widestring" +"114","process-pool" +"114","decibel" +"114","multiple-views" +"114","graphstream" +"114","backing-beans" +"114","multiple-processes" +"114","sketchapp" +"114","conio" +"114","xinclude" +"114","mapsforge" +"114","runatserver" +"114","connect-mongo" +"114","socket.io-redis" +"114","filenotfounderror" +"114","software-defined-radio" +"114","laravel-filesystem" +"114","smooth-streaming" +"114","construct-2" +"114","python-playsound" +"114","physx" +"114","firefox3.6" +"114","gpars" +"114","factories" +"114","jpasswordfield" +"114","docker-engine" +"114","captions" +"114","data-connections" +"114","agens-graph" +"114","episerver-7" +"114","dynamics-al" +"114","demandware" +"114","azure-devops-migration-tools" +"114","gulp-4" +"114","system-shutdown" +"114","uiaccelerometer" +"114","shinybs" +"114","typeform" +"114","visual-format-language" +"114","azure-notebooks" +"114","hm-10" +"114","taco" +"114","dimensional" +"114","azure-spatial-anchors" +"114","android-instant-run" +"114","vetur" +"114","hamiltonian-cycle" +"114","asp.net-1.1" +"114","opensearch-dashboards" +"114","low-memory" +"114","google-cloud-identity" +"114","angularjs-animation" +"114","specification-pattern" +"114","acm-java-libraries" +"114","offloading" +"114","generic-lambda" +"114","reactive-banana" +"114","pyvis" +"114","collabnet" +"114","pardot" +"114","libxslt" +"114","sdf" +"114","flutter-objectbox" +"114","zapier-cli" +"114","complement" +"114","struts2-json-plugin" +"114","autocmd" +"114","zend-controller" +"114","qt5.3" +"114","shellsort" +"114","zero-padding" +"113","eclipse-virgo" +"113","jenkins-email-ext" +"113","inspection" +"113","feedburner" +"113","squirrel.windows" +"113","react-router-component" +"113","tempus-dominus-datetimepicker" +"113","clasp" +"113","primeng-table" +"113","xslcompiledtransform" +"113","tree-structure" +"113","nexus-4" +"113","flask-restx" +"113","jsr310" +"113","freshdesk" +"113","xpsdocument" +"113","construction" +"113","jsonapi-resources" +"113","futex" +"113","serverless-offline" +"113","oracle-apex-18.2" +"113","meta-search" +"113","django-simple-history" +"113","icinga" +"113","avaya" +"113","avurlasset" +"113","django-flatpages" +"113","facescontext" +"113","rllib" +"113","kingswaysoft" +"113","document-based" +"113","angularjs-select" +"113","alfresco-enterprise" +"113","unnotificationrequest" +"113","khan-academy" +"113","keytab" +"113","angular-openlayers" +"113","aws-sdk-ios" +"113","jquery-1.9" +"113","svn-merge" +"113","wp-graphql" +"113","corner-detection" +"113","survminer" +"113","ttkwidgets" +"113","bottom-navigation-bar" +"113","delphi-12-athens" +"113","html5lib" +"113","native-methods" +"113","appletviewer" +"113","error-detection" +"113","rightbarbuttonitem" +"113","rational-number" +"113","virtual-pc" +"113","system.componentmodel" +"113","janus-gateway" +"113","buck" +"113","code.org" +"113","rasa-x" +"113","extras" +"113","ravendb-studio" +"113","object-graph" +"113","virtual-attribute" +"113","wmode" +"113","organizer" +"113","pydantic-v2" +"113","vertical-text" +"113","schannel" +"113","expression-templates" +"113","bunyan" +"113","xcdatamodel" +"113","gwt-ext" +"113","happy" +"113","timed" +"113","android-intent-chooser" +"113","acr" +"113","splidejs" +"113","chai-http" +"113","ceylon" +"113","oncreateoptionsmenu" +"113","qlistwidgetitem" +"113","google-cloud-armor" +"113","memcmp" +"113","mps" +"113","respond-to" +"113","customtaskpane" +"113","amazonsellercentral" +"113","zend-paginator" +"113","embedded-sql" +"113","automapper-2" +"113","mechanicalsoup" +"113","qtoolbar" +"113","maven-enforcer-plugin" +"113","web-developer-toolbar" +"112","listctrl" +"112","srgb" +"112","ef-core-8.0" +"112","xrandr" +"112","dbx" +"112","clearance" +"112","flipclock" +"112","ec2-api-tools" +"112","skype-bots" +"112","ebay-sdk" +"112","site-packages" +"112","class-constructors" +"112","mvcmailer" +"112","vue-cli-4" +"112","mura" +"112","intel-galileo" +"112","xz" +"112","file-uri" +"112","image-morphology" +"112","freetext" +"112","django-admin-actions" +"112","fitdistrplus" +"112","self-contained" +"112","uiview-hierarchy" +"112","flash-cs5.5" +"112","pact-jvm" +"112","pushbullet" +"112","agents" +"112","react-testing" +"112","mysql-5.1" +"112","jmodelica" +"112","rot13" +"112","datagridtextcolumn" +"112","method-swizzling" +"112","rowlocking" +"112","django-model-field" +"112","avro-tools" +"112","micronaut-client" +"112","django-static" +"112","pspdfkit" +"112","blazor-jsinterop" +"112","jquery-lazyload" +"112","mongodb-realm" +"112","opencv-stitching" +"112","arangojs" +"112","mod-headers" +"112","surrogate-key" +"112","surrogate-pairs" +"112","post-meta" +"112","easyocr" +"112","typecast-operator" +"112","wurfl" +"112","mongo-collection" +"112","winrt-component" +"112","java.library.path" +"112","rhadoop" +"112","ocaml-dune" +"112","formflow" +"112",".net-3.0" +"112","gob" +"112","sql-returning" +"112","reed-solomon" +"112","droplet" +"112","dgraph" +"112","directorysearcher" +"112","happens-before" +"112","business-objects-sdk" +"112","dialyzer" +"112","excel-web-query" +"112","dotnetnuke-9" +"112","mockups" +"112","c++builder-2010" +"112","spring-tools-4" +"112","storage-class-specifier" +"112","angularjs-controlleras" +"112","cfspreadsheet" +"112","geomap" +"112","test-environments" +"112","moovweb" +"112","nodejitsu" +"112","react-animations" +"112","android-parser" +"112","mbox" +"112","suave" +"112","web-animations" +"112","solana-program-library" +"112","multi-layer" +"112","google-prediction" +"112","thorntail" +"112","glcm" +"112","focusout" +"111","balloon" +"111","federated" +"111","ggsave" +"111","deferred-loading" +"111","sitemap.xml" +"111","apache-cloudstack" +"111","remoteapp" +"111","bacnet" +"111","db-browser-sqlite" +"111","apache-spark-1.6" +"111","landsat" +"111","black-box-testing" +"111","apache-stringutils" +"111","python-newspaper" +"111","checkpointing" +"111","apache-poi-4" +"111","connection-pool" +"111","chron" +"111","ccache" +"111","grails-3.3" +"111","oracle21c" +"111","roguelike" +"111","datagridviewrow" +"111","django-pipeline" +"111","fast-forward" +"111","watson-dialog" +"111","valarray" +"111","jodit" +"111","share-intent" +"111","jongo" +"111","hyperledger-indy" +"111","database-link" +"111","keynote" +"111","iasyncresult" +"111","rootfs" +"111","wcf-configuration" +"111","nest-device-access" +"111","pcfdev" +"111","infopath-2007" +"111","paster" +"111","turbine" +"111","turbogears" +"111","appium-java" +"111","nsnetservice" +"111","path-parameter" +"111","boost-signals2" +"111","enterprise-distribution" +"111","dwt" +"111","epsg" +"111","pdfjs-dist" +"111","sidecar" +"111","uglifyjs2" +"111","syntax-checking" +"111","microtime" +"111",".net-4.7" +"111","wixsharp" +"111","libmemcached" +"111","osi" +"111","uclibc" +"111","gdt" +"111","mmx" +"111","scalapb" +"111","digital-ocean-spaces" +"111","happstack" +"111","expr" +"111","expression-blend-4" +"111","efxclipse" +"111","restheart" +"111","testify" +"111","spectron" +"111","memory-consumption" +"111","hxt" +"111","react-error-boundary" +"111","qdap" +"111","laravel-scheduler" +"111","log4perl" +"111","mcu" +"111","three-tier" +"111","bass" +"111","lime" +"111","dajaxice" +"111","array-column" +"111","web-component-tester" +"111","yui-pure-css" +"111","thai" +"111","subgit" +"111","heic" +"111","googlesigninaccount" +"111","urlhelper" +"110","defaults" +"110","phalcon-routing" +"110","dbghelp" +"110","vue-native" +"110","stackmob" +"110","github-issues" +"110","getserversideprops" +"110","instafeedjs" +"110","munin" +"110","flutter-cubit" +"110","web-publishing" +"110","sslv3" +"110","backstage" +"110","remarkjs" +"110","multiplicity" +"110","xxd" +"110","team-explorer-everywhere" +"110","remote-execution" +"110","flipper" +"110","seleniumwire" +"110","freshmvvm" +"110","xquartz" +"110","xml-simple" +"110","laravel-form" +"110","frontpage" +"110","voila" +"110","data-mapping" +"110","xlsb" +"110","ng-admin" +"110","kubeconfig" +"110","run-script" +"110","micro-architecture" +"110","jobservice" +"110","documentfilter" +"110","aws-ebs" +"110","aws-ecr" +"110","fal" +"110","ibm-jazz" +"110","recaptcha-enterprise" +"110","database-sequence" +"110","rolling-average" +"110","boost-multi-array" +"110","ncdf4" +"110","salesforce-chatter" +"110","nested-json" +"110","ionic7" +"110","spring-cloud-kubernetes" +"110","katalon-recorder" +"110","cortex-a8" +"110","n-dimensional" +"110","nspersistentcloudkitcontainer" +"110","worklight-runtime" +"110","azure-backup-vault" +"110","android-tabbed-activity" +"110","neo4jphp" +"110","cpu-time" +"110","konsole" +"110","visual-c++-2005" +"110","extended-events" +"110","type-definition" +"110","golem" +"110","netbeans-11" +"110","java-15" +"110","knuth-morris-pratt" +"110","javapos" +"110","google-breakpad" +"110","pocketsphinx-android" +"110","differential-evolution" +"110","to-json" +"110","didset" +"110","draft-js-plugins" +"110","bullmq" +"110","cac" +"110","difftool" +"110","asp-net-core-spa-services" +"110","plural" +"110","openoffice-basic" +"110","vertex-array" +"110","dottrace" +"110","sql-data-warehouse" +"110","dronekit" +"110","executors" +"110","android-immersive" +"110","schemacrawler" +"110","messagekit" +"110","responsive-slides" +"110","testfx" +"110","splunk-formula" +"110","ceres-solver" +"110","ios-background-mode" +"110","odp.net-managed" +"110","odata4j" +"110","cold-start" +"110","text2vec" +"110","everyauth" +"110","google-pixel" +"110","urql" +"110","webkitgtk" +"110","lint-staged" +"110","imagecreatefrompng" +"110","shift-jis" +"110","mds" +"110","font-lock" +"110","mta" +"110","thread-sanitizer" +"110","arity" +"110","endpoints-proto-datastore" +"110","prettier-vscode" +"110","powerpoint-2013" +"110","engineyard" +"110","git-patch" +"109","multiversx" +"109","efk" +"109","react-portal" +"109","ckrecord" +"109","flutter-custompainter" +"109","tekton-pipelines" +"109","telepot" +"109","vstest.console.exe" +"109","livewire-3" +"109","teardown" +"109","ggridges" +"109","pkcs#8" +"109","json-serializable" +"109","dbcc" +"109","pkcs11interop" +"109","appgallery-connect" +"109","chrome-debugging" +"109","snowsql" +"109","pandas-melt" +"109","flashbuilder4" +"109","fullcalendar-6" +"109","self-invoking-function" +"109","dithering" +"109","oz" +"109","salat" +"109","meteor-publications" +"109","fairplay" +"109","icinga2" +"109","cakephp-3.1" +"109","recursion-schemes" +"109","mysql-variables" +"109","methodhandle" +"109","hyperterminal" +"109","html.textboxfor" +"109","popcornjs" +"109","android-xmlpullparser" +"109","spring-context" +"109","gtmetrix" +"109","openfeint" +"109","scala-2.13" +"109","info-plist" +"109","android-vpn-service" +"109","opencv-solvepnp" +"109","twitterkit" +"109","rinside" +"109","formsauthentication" +"109","wing-ide" +"109","brython" +"109","eyeshot" +"109","py-datatable" +"109","pyrevit" +"109","rasterize" +"109","async-pipe" +"109","forgerock" +"109","type-signature" +"109","vertx-eventbus" +"109","xcode9.4" +"109","openpop" +"109","xcode11.3" +"109","xcode11.4" +"109","time-wait" +"109","cadence" +"109","openrewrite" +"109","drools-kie-server" +"109","bz2" +"109","dstream" +"109","mixitup" +"109","hibernate-native-query" +"109","qvtkwidget" +"109","asp.net-web-api-helppages" +"109","stripslashes" +"109","cfdocument" +"109","mercurial-extension" +"109","lark-parser" +"109","laravel-medialibrary" +"109","meta-key" +"109","prolog-dif" +"109","challenge-response" +"109","lsmeans" +"109","mp4box" +"109","getcwd" +"109","esi" +"109","nodegit" +"109","longest-path" +"109","angular-calendar" +"109","react-markdown" +"109","currency-exchange-rates" +"109","specs" +"109","generic-foreign-key" +"109","global-scope" +"109","yubikey" +"109","qt5.7" +"109","secure-gateway" +"109","powermanager" +"109","array-multisort" +"109","quantile-regression" +"109","maven-module" +"109","bcrypt-ruby" +"109","cvx" +"109","artillery" +"109","touchxml" +"109","tidygraph" +"108","cmsamplebuffer" +"108","multiple-dispatch" +"108","wdio" +"108","flutter-form-builder" +"108","treemodel" +"108","git-bisect" +"108","econnrefused" +"108","apacheignite" +"108","wicked-gem" +"108","clojure-contrib" +"108","musicbrainz" +"108","trimesh" +"108","fido-u2f" +"108","eda" +"108","yasnippet" +"108","closest-points" +"108","frege" +"108","carrot2" +"108","bisect" +"108","flask-mysql" +"108","uncaughtexceptionhandler" +"108","oxygene" +"108","firefox-marionette" +"108","fl-chart" +"108","congestion-control" +"108","pythoncom" +"108","adaptive-layout" +"108","kentor-authservices" +"108","vue-transitions" +"108","windows-search" +"108","aggregator" +"108","johnsnowlabs-spark-nlp" +"108","crossover" +"108","candy-machine" +"108","options-menu" +"108","gradle-experimental" +"108","uppy" +"108","mysqldatareader" +"108","hyperledger-explorer" +"108","bpmn.io" +"108","easyhook" +"108","ndimage" +"108","html5-template" +"108","kademlia" +"108","errorprovider" +"108","julia-plots" +"108","gulp-inject" +"108","viewstub" +"108","microsoft-planner" +"108","java-service-wrapper" +"108","rich-internet-application" +"108","go-interface" +"108","sigaction" +"108","wma" +"108","viewparams" +"108","microsoft-information-protection" +"108","vis.js-timeline" +"108","ext2" +"108","pytest-html" +"108","downtime" +"108","gd2" +"108","notion" +"108","isis" +"108","mlmodel" +"108","assembly-loading" +"108","npm-live-server" +"108","numerical-stability" +"108","hierarchical-bayesian" +"108","device-detection" +"108","tango" +"108","mlt" +"108","http-status-code-422" +"108","acronym" +"108","mozilla-deepspeech" +"108","ltree" +"108","laravel-resource" +"108","angular7-router" +"108","elasticsearch-hadoop" +"108","messageformat" +"108","android-lru-cache" +"108","propertychangelistener" +"108","getprocaddress" +"108","sphero-api" +"108","pffile" +"108","hc-05" +"108","amazon-kcl" +"108","arduino-yun" +"108","encodable" +"108","autovacuum" +"108","bessel-functions" +"108","predicates" +"108","successor-arithmetics" +"108","zoho-deluge" +"108","studio3t" +"108","linq.js" +"108","argo" +"107","telerik-appbuilder" +"107","program-counter" +"107","jdi" +"107","mutual-recursion" +"107","feature-descriptor" +"107","sql-workbench-j" +"107","matlab-gui" +"107","ggbiplot" +"107","ape" +"107","vs-community-edition" +"107","pageable" +"107","rx-kotlin2" +"107","software-packaging" +"107","xml-dsig" +"107","advanced-filter" +"107","vmware-tools" +"107","next-images" +"107","safe-mode" +"107","python-black" +"107","page-size" +"107","sakai" +"107","uninitialized-constant" +"107","readonly-collection" +"107","windows-live" +"107","keyboard-input" +"107","meta-query" +"107","validating" +"107","camanjs" +"107","surrealdb" +"107","delete-directory" +"107","enqueue" +"107","boundfield" +"107","pdfptable" +"107","juniper" +"107","sarama" +"107","kaldi" +"107","ion-slides" +"107","jasny-bootstrap" +"107","codecov" +"107","r-future" +"107","orange-pi" +"107","magickwand" +"107","visualstates" +"107","tabbing" +"107","ambiguous-call" +"107","forums" +"107","shadowjar" +"107","android-authenticator" +"107","go-html-template" +"107","visual-tree" +"107","shaka" +"107","external-project" +"107","rfc3339" +"107","javapoet" +"107","bucket-sort" +"107","system.management" +"107","libjpeg-turbo" +"107","virus-scanning" +"107","openvz" +"107","sqlproj" +"107","cookiecontainer" +"107","wxtextctrl" +"107","xcode-command-line-tools" +"107","uicollectionviewdelegate" +"107","novacode-docx" +"107","azure-hybrid-connections" +"107","openproject" +"107","dotty" +"107","tinyxml2" +"107","r2dbc-postgresql" +"107","xamlreader" +"107","drawing2d" +"107","android-implicit-intent" +"107","jamstack" +"107","c++-templates" +"107","react-google-maps-api" +"107","office-app" +"107","lokijs" +"107","cfstring" +"107","pgcrypto" +"107","on-demand-resources" +"107","cf-bosh" +"107","qlik-expression" +"107","lockfile" +"107","spinnaker-halyard" +"107","multer-gridfs-storage" +"107","parallelism-amdahl" +"107","transfer-function" +"107","daemons" +"107","ford-fulkerson" +"107","v4l2loopback" +"107","glossary" +"107","seccomp" +"107","linklabel" +"107","amazon-echo" +"107","embedded-video" +"107","usergrid" +"107","linkageerror" +"107","google-play-integrity-api" +"107","gnu-prolog" +"106","web-user-controls" +"106","github-webhook" +"106","coc.nvim" +"106","trustzone" +"106","installshield-2010" +"106","cloudfiles" +"106","slidingpanelayout" +"106","filefilter" +"106","class-table-inheritance" +"106","x-ray" +"106","jde" +"106","jcarousellite" +"106","mumin" +"106","xdocreport" +"106","mappedsuperclass" +"106","fsync" +"106","python-fu" +"106","console-output" +"106","unison" +"106","apollostack" +"106","smarty2" +"106","connect-flash" +"106","freopen" +"106","python-object" +"106","sef" +"106","doevents" +"106","jimp" +"106","rn-fetch-blob" +"106","unobtrusive-ajax" +"106","singleton-type" +"106","ib-api" +"106","server.transfer" +"106","realbasic" +"106","docblocks" +"106","server-action" +"106","warehouse" +"106","azure-digital-twins" +"106","nsresponder" +"106","cornerstone" +"106","android-sms" +"106","twitter-search" +"106","patsy" +"106","bootstrap-material-design" +"106","openaiembeddings" +"106","nestjs-passport" +"106","grunt-contrib-connect" +"106","infovis" +"106","application-error" +"106","apple-wallet" +"106","gst-launch" +"106","spring-boot-devtools" +"106","spring-security-saml2" +"106","android-account" +"106","codeigniter-form-helper" +"106","typescript1.6" +"106","shinyproxy" +"106","systray" +"106","doobie" +"106","wordpress-admin" +"106","javax.validation" +"106","kruskal-wallis" +"106","shrinkwrap" +"106","pyhive" +"106","android-build-type" +"106","tlv" +"106","hipaa" +"106","bull" +"106","springsource" +"106","explicit-conversion" +"106","handwriting" +"106","quoted-printable" +"106","express-4" +"106","hivecontext" +"106","expdp" +"106","rabin-karp" +"106","nvim-lspconfig" +"106","redmine-api" +"106","xcode-project" +"106","gameboy" +"106","xauth" +"106","scipy-spatial" +"106","nicescroll" +"106","large-file-upload" +"106","qdatastream" +"106","stretching" +"106","angular-highcharts" +"106","qheaderview" +"106","android-jetpack-compose-list" +"106","eip" +"106","speed-test" +"106","memory-fences" +"106","getgauge" +"106","locomotive-scroll" +"106","compound-assignment" +"106","utilization" +"106","sparkle" +"106","automapper-5" +"106","spark-kafka-integration" +"106","sdcc" +"106","transcode" +"106","automatic-license-plate-recognition" +"106","dartium" +"106","tracelistener" +"106","imagekit" +"106","text-widget" +"106","linear-discriminant" +"105","vt100" +"105","tsd" +"105","matlab-class" +"105","git-difftool" +"105","feed-forward" +"105","cls-compliant" +"105","graph-drawing" +"105","graphicimage" +"105","apache-chemistry" +"105","graphql-dotnet" +"105","python-install" +"105","aether" +"105","ultraedit" +"105","fixest" +"105","cinema-4d" +"105","xodus" +"105","fileopendialog" +"105","mail-sender" +"105","packagereference" +"105","fts4" +"105","snowpack" +"105","cdr" +"105","soci" +"105","switchcompat" +"105","aweber" +"105","windows64" +"105","callouts" +"105","vuex4" +"105","i18n-gem" +"105","aws-iam-policy" +"105","serverspec" +"105","sitecore9" +"105","windev" +"105","faust" +"105","icloud-api" +"105","django-redis" +"105","boost-process" +"105","pdfstamper" +"105","boost-range" +"105","enterprisedb" +"105","http3" +"105","deleted-functions" +"105","sas-studio" +"105","android-wrap-content" +"105","craftyjs" +"105","createcriteria" +"105","sap-pi" +"105","mongoose-im" +"105","hpple" +"105","objectdb" +"105","rich" +"105","new-project" +"105","object-construction" +"105","atg-dynamo" +"105","pytesser" +"105","facebooker" +"105","sigar" +"105","bsp" +"105","dongle" +"105","ats" +"105","rclone" +"105","xapian" +"105","tkinter-label" +"105","scotty" +"105","sqlfilestream" +"105","hgrc" +"105","number-systems" +"105","bytearrayinputstream" +"105","ml-agent" +"105","podscms" +"105","cookie-authentication" +"105","numpy-memmap" +"105","coqide" +"105","stompjs" +"105","espeak" +"105","ldapconnection" +"105","event-dispatching" +"105","office-ui-fabric-react" +"105","iris-dataset" +"105","metafile" +"105","cgpdfdocument" +"105","exc-bad-instruction" +"105","ole-automation" +"105","resharper-8.0" +"105","textmeshpro" +"105","mosek" +"105","terraform-cloud" +"105","react-android" +"105","stty" +"105","dam" +"105","url-validation" +"105","auto-renewable" +"105","tidb" +"105","architectural-patterns" +"105","bcmath" +"105","fody-costura" +"104","gridviewcolumn" +"104","matrix-decomposition" +"104","background-attachment" +"104","repa" +"104","eflags" +"104","git-credential-manager" +"104","ssl-client-authentication" +"104","phinx" +"104","php-amqplib" +"104","phong" +"104","relu" +"104","procrun" +"104","datetime-comparison" +"104","symfony-process" +"104","volume-rendering" +"104","rweka" +"104","cbor" +"104","safetynet" +"104","xgettext" +"104","sw-precache" +"104","nginfinitescroll" +"104","pivotviewer" +"104","flask-peewee" +"104","pikaday" +"104","adlds" +"104","casl" +"104","ng2-file-upload" +"104","microblaze" +"104","roo" +"104","jira-zephyr" +"104","airbrake" +"104","ora-01722" +"104","angular-kendo" +"104","metaspace" +"104","akka-supervision" +"104","wcftestclient" +"104","psycopg3" +"104","jqassistant" +"104","capnproto" +"104","sinatra-activerecord" +"104","psake" +"104","servicecontroller" +"104","simperium" +"104","dyndns" +"104","justmock" +"104","sas-token" +"104","mongoid4" +"104","android-wear-notification" +"104","post-install" +"104","htmltext" +"104","aws-sdk-ruby" +"104","guice-3" +"104","passport-azure-ad" +"104","horizontal-line" +"104","wordpress-thesis-theme" +"104","wordsearch" +"104","bpl" +"104","onreadystatechange" +"104","bq" +"104","coin-or-cbc" +"104","orphan" +"104","wns" +"104","java-13" +"104","pysvn" +"104","return-code" +"104","cocos2d-x-2.x" +"104","net-sftp" +"104","krakend" +"104","donations" +"104","attr-accessible" +"104","ou" +"104","wix3.9" +"104","facebook-credits" +"104","sql-convert" +"104","home-button" +"104","tcserver" +"104","azure-servicebusrelay" +"104","sql-mode" +"104","hkhealthstore" +"104","model-comparison" +"104","aspnetdb" +"104","uicontrolevents" +"104","gwt-maven-plugin" +"104","hiccup" +"104","nsusernotification" +"104","open-with" +"104","redhat-containers" +"104","requesthandler" +"104","hungarian-algorithm" +"104","angularfire5" +"104","tomtom" +"104","chaos" +"104","geoxml3" +"104","android-number-picker" +"104","flwor" +"104","ms-yarp" +"104","prefab" +"104","stem" +"104","sharpssh" +"104","git-tower" +"104","benchmarkdotnet" +"104","powerview" +"104","amazon-qldb" +"104","sonarlint-eclipse" +"104","spanning-tree" +"104","max-msp-jitter" +"104","webmatrix-2" +"103","editmode" +"103","base64url" +"103","pgzero" +"103","efficientnet" +"103","php-di" +"103","ghostscript.net" +"103","widget-test-flutter" +"103","greasemonkey-4" +"103","lms" +"103","mutablelist" +"103","webresource" +"103","ggtern" +"103","php-deployer" +"103","yandex-api" +"103","flutter-dropdownbutton" +"103","photoimage" +"103","ecs-taskdefinition" +"103","flask-marshmallow" +"103","soc" +"103","ng-init" +"103","plack" +"103","file-properties" +"103","fitness" +"103","display-templates" +"103","immediate-operand" +"103","datetime64" +"103","admin-rights" +"103","cdecl" +"103","circlize" +"103","googleway" +"103","database-agnostic" +"103","django-modeltranslation" +"103","routines" +"103","serviceconnection" +"103","dmn" +"103","sharepointframework" +"103","key-generator" +"103","meter" +"103","ibm-cloud-tools" +"103","gopath" +"103","roots-sage" +"103","hyperjaxb" +"103","dm" +"103","azure-devops-server-2020" +"103","spring-boot-configuration" +"103","enumset" +"103","position-independent-code" +"103","jquery-countdown" +"103","mongolite" +"103","nscopying" +"103","nats-streaming-server" +"103","jquerydatetimepicker" +"103","jquery-dynatree" +"103","deinit" +"103","extension-function" +"103","wolfram-language" +"103","google-chrome-frame" +"103","luaj" +"103","java.lang.class" +"103","osmf" +"103","object-relational-model" +"103","microsoft-reporting" +"103","synthetic" +"103","word-2013" +"103","external-links" +"103","uber-cadence" +"103","google-anthos" +"103","retrolambda" +"103","luminus" +"103","tds" +"103","tipsy" +"103","azure-pipelines-release-task" +"103","uiautomatorviewer" +"103","busy-waiting" +"103","expressionbuilder" +"103","tclsh" +"103","export-to-word" +"103","tapku" +"103","diameter-protocol" +"103","higher-rank-types" +"103","request-uri" +"103","colorfilter" +"103","android-jetpack-compose-canvas" +"103","csvtojson" +"103","esri-maps" +"103","httpie" +"103","angular18" +"103","angular-hybrid" +"103","logoff" +"103","huggingface-trainer" +"103","promise.all" +"103","pyuic" +"103","google-code-prettify" +"103","combiners" +"103","ejabberd-api" +"103","laravel-session" +"103","ids" +"103","identity-insert" +"103","array-agg" +"103","security-context" +"103","zend-cache" +"103","embeddedwebserver" +"103","asdf-vm" +"103","idfa" +"103","amazon-personalize" +"103","zero-copy" +"103","web-extension" +"103","biginsights" +"103","lightopenid" +"103","flutter-platform-channel" +"103","gloss" +"103","qtconsole" +"103","gkturnbasedmatch" +"103","lifetime-scoping" +"103","git-repo" +"103","submitchanges" +"103","foldleft" +"103","google-shopping-api" +"102","multi-master-replication" +"102","jcr-sql2" +"102","ggtree" +"102","eclim" +"102","xval" +"102","phoenix-channels" +"102","trigram" +"102","sslcontext" +"102","multiple-resultsets" +"102","grinder" +"102","installed-applications" +"102","clrstoredprocedure" +"102","truthiness" +"102","class-extensions" +"102","filesort" +"102","sails-postgresql" +"102","adx" +"102","rivets.js" +"102","sendasynchronousrequest" +"102","p4python" +"102","ui-virtualization" +"102","aeron" +"102","python-datamodel" +"102","s4hana" +"102","consteval" +"102","xpo" +"102","circleci-workflows" +"102","datamaps" +"102","cinnamon" +"102","data-security" +"102","crosstalk" +"102","go-reflect" +"102","rebol2" +"102","johnny-five" +"102","rotateanimation" +"102","microsoft-bits" +"102","kendo-listview" +"102","rowcommand" +"102","simple-peer" +"102","password-less" +"102","sar" +"102","android-twitter" +"102","epicorerp" +"102","openexr" +"102","dymo" +"102","nscharacterset" +"102","boost-optional" +"102","approximate" +"102","inherited" +"102","scala-2.9" +"102","neomodel" +"102","silktest" +"102","jquery-calculation" +"102","netbsd" +"102","codewarrior" +"102","retrypolicy" +"102","video-embedding" +"102","raty" +"102","visual-studio-6" +"102","r-bigmemory" +"102","system-information" +"102","code-sharing" +"102","abstract-type" +"102","razorgenerator" +"102","scalaz7" +"102","plug" +"102","sqlalchemy-migrate" +"102","talend-mdm" +"102","sqlcipher-android" +"102","tinyint" +"102","gcdwebserver" +"102","gdbus" +"102","redefine" +"102","openpdf" +"102","android-dialer" +"102","table-locking" +"102","common-controls" +"102","reactivesearch" +"102","stream-socket-client" +"102","testcontainers-junit5" +"102","node-amqp" +"102","cubic" +"102","string-function" +"102","mpv" +"102","customizing" +"102","texteditingcontroller" +"102","activedirectorymembership" +"102","maven-ear-plugin" +"102","webkit-transform" +"102","alternating" +"102","quickbase" +"102","linkerd" +"102","shdocvw" +"102","fly" +"102","traceur" +"102","git-stage" +"102","qt-jambi" +"102","ms-project-server-2013" +"102","cypress-custom-commands" +"102","autolink" +"102","pass-by-pointer" +"102","glassfish-embedded" +"102","powerline" +"102","alpacajs" +"101","massive" +"101","staggeredgridlayout" +"101","markov-models" +"101","grommet" +"101","annotation-processor" +"101","ghcjs" +"101","defaultmodelbinder" +"101","cloudpebble" +"101","gettimeofday" +"101","file-listing" +"101","distinct-on" +"101","select-options" +"101","appframework" +"101","vorbis" +"101","rx-binding" +"101","pythonista" +"101","swoole" +"101","nexus-s" +"101","marie" +"101","django-extensions" +"101","cryptographic-hash-function" +"101","kie-server" +"101","agenda" +"101","kendo-editor" +"101","tuleap" +"101","dependencyobject" +"101","surfaceflinger" +"101","wpd" +"101","typed" +"101","delegatecommand" +"101","inout" +"101","jython-2.5" +"101","android-shapedrawable" +"101","google-amp" +"101","java-package" +"101","ubuntu-15.10" +"101","form-api" +"101","google-app-invites" +"101","coff" +"101","ab-initio" +"101","ucp" +"101","type-variables" +"101","extended-properties" +"101","double-free" +"101","contenttype" +"101","titleview" +"101","execjs" +"101","xcconfig" +"101","android-graphics" +"101","convex-polygon" +"101","aspnet-regiis.exe" +"101","dstu2-fhir" +"101","dtexec" +"101","gae-eclipse-plugin" +"101","null-character" +"101","tombstone" +"101","dotcms" +"101","azure-scheduler" +"101","jama" +"101","character-class" +"101","tombstoning" +"101","google-cloud-source-repos" +"101","membase" +"101","meilisearch" +"101","android-renderscript" +"101","hy" +"101","hydra" +"101","huawei-push-notification" +"101","qscintilla" +"101","compareobject" +"101","strongly-typed-view" +"101","getcomputedstyle" +"101","node-commander" +"101","omxplayer" +"101","angular-compiler" +"101","celluloid" +"101","activity-transition" +"101","zstd" +"101","mpxj" +"101","amazon-dynamodb-dax" +"101","glasspane" +"101","tornado-motor" +"101","quantreg" +"101","customscrollview" +"101","subrepos" +"101","com-port" +"101","multidatatrigger" +"101","gn" +"100","sketchflow" +"100","intel-pmu" +"100","edge-list" +"100","renpy" +"100","apache-atlas" +"100","local-datastore" +"100","class-visibility" +"100","mvn-repo" +"100","x-xsrf-token" +"100","skyfield" +"100","editcontrol" +"100","webui" +"100","flare" +"100","immutables-library" +"100","jsobject" +"100","adobe-captivate" +"100","volume-shadow-service" +"100","cedit" +"100","sage-erp" +"100","chord" +"100","xdt-transform" +"100","language-theory" +"100","container-view" +"100","flask-bootstrap" +"100","blackberry-android" +"100","maintenance-plan" +"100","nameof" +"100","documentfragment" +"100","ora-00933" +"100","jmx-exporter" +"100","kendo-autocomplete" +"100","django-logging" +"100","gopro" +"100","ajax-polling" +"100","dmz" +"100","recarray" +"100","iboutletcollection" +"100","carddav" +"100","simplecart" +"100","dep" +"100","bpopup" +"100","cpputest" +"100","postgres-9.6" +"100","jrules" +"100","jrockit" +"100","corona-storyboard" +"100","onlyoffice" +"100","postgresql-9.0" +"100","guice-servlet" +"100","border-box" +"100","ws-addressing" +"100","nsoutputstream" +"100","inherited-resources" +"100","wsp" +"100","http.client" +"100","apple-developer-account" +"100","viper-go" +"100","system.xml" +"100","3gp" +"100","missing-features" +"100","mahalanobis" +"100","netapp" +"100","otree" +"100","shadows" +"100","typesetting" +"100","kogito" +"100","formvalidation.io" +"100","returnurl" +"100","netflow" +"100","time-tracking" +"100","target-framework" +"100","scopus" +"100","sqlite.net" +"100","deviation" +"100","tcmalloc" +"100","gacutil" +"100","gadfly" +"100","assembly-signing" +"100","mkpointannotation" +"100","xceed-datagrid" +"100","tablet-pc" +"100","uisplitview" +"100","galleryview" +"100","non-printing-characters" +"100","mercure" +"100","specrun" +"100","android-resolution" +"100","mpd" +"100","duplicate-symbol" +"100","memory-leak-detector" +"100","elasticsearch-curator" +"100","quest" +"100","use-strict" +"100","start-stop-daemon" +"100","gluonfx" +"100","webflux" +"100","stardog" +"100","concurrent-collections" +"100","forced-unwrapping" +"100","parametric-equations" +"100","webpack-dev-middleware" +"100","webpack-html-loader" +"100","powerpoint-addins" +"100","zarr" +"100","questasim" +"99","background-mode" +"99","ggproto" +"99","react-relay" +"99","git-detached-head" +"99","maven-bom" +"99","photography" +"99","php-ews" +"99","yarn-lock.json" +"99","cmtime" +"99","mybatis-generator" +"99","mathjs" +"99","client-side-templating" +"99","listgrid" +"99","ecm" +"99","eclipse-gmf" +"99","grid-computing" +"99","multi-tier" +"99","reloading" +"99","paintcode" +"99","affdex-sdk" +"99","ng-content" +"99","xfs" +"99","mapdb" +"99","advertisement-server" +"99","sentinel2" +"99","django-auth-ldap" +"99","rstatix" +"99","crittercism" +"99","fastlane-match" +"99","vagrant-plugin" +"99","false-sharing" +"99","aws-codestar" +"99","unitywebrequest" +"99","rmongodb" +"99","aif" +"99","oracle-sql-data-modeler" +"99","microsoft-dynamics-nav" +"99","nscollectionviewitem" +"99","kcachegrind" +"99","cpp-core-guidelines" +"99","android-textureview" +"99","nested-repeater" +"99","postgresql-json" +"99","sigpipe" +"99","pax" +"99","pdftools" +"99","application-state" +"99","satellite-assembly" +"99","bluesnap" +"99","app-update" +"99","entitygraph" +"99","entity-sql" +"99","android-binding-adapter" +"99","pysolr" +"99","winzip" +"99","extending-classes" +"99","word-interop" +"99","obsidian" +"99","output-redirect" +"99","orchardcms-1.9" +"99","atmega32" +"99","ublas" +"99","systemd-journald" +"99","object-composition" +"99","return-by-reference" +"99","devil" +"99","nvme" +"99","nvelocity" +"99","c4" +"99","nodeunit" +"99","caemitterlayer" +"99","novell" +"99","excel-udf" +"99","mod-auth-openidc" +"99","tmlanguage" +"99","tmpfs" +"99","quine" +"99","modeless" +"99","assemblyscript" +"99","exim4" +"99","handheld" +"99","r2jags" +"99","scalaquery" +"99","gdcm" +"99","expandablerecyclerview" +"99","leanft" +"99","css-mask" +"99","ios6-maps" +"99","hunchentoot" +"99","angularjs-bootstrap" +"99","monkeytalk" +"99","nixpkgs" +"99","ios9.2" +"99","eshell" +"99","qdebug" +"99","strchr" +"99","menu-items" +"99","protovis" +"99","iptv" +"99","qeventloop" +"99","suitecommerce" +"99","bidirectional-relation" +"99","imagej-macro" +"99","ms-solver-foundation" +"99","google-translator-toolkit" +"99","hello.js" +"99","zipper" +"99","qstackedwidget" +"99","autodiff" +"99","parametrized-testing" +"99","sector" +"99","sectionheader" +"99","iedriverserver" +"99","asiformdatarequest" +"99","elytron" +"99","tika-server" +"99","spacy-transformers" +"99","query-by-example" +"99","qtabbar" +"99","best-fit-curve" +"99","ildasm" +"99","zeus" +"99","topicmodels" +"99","ieaddon" +"98","jboss-mdb" +"98","cnc" +"98","ssis-2016" +"98","temporary-directory" +"98","class-constants" +"98","jcanvas" +"98","phobos" +"98","jest-fetch-mock" +"98","sliders" +"98","fiber" +"98","jettison" +"98","self-type" +"98","xenapp" +"98","distributed-testing" +"98","inappsettingskit" +"98","python-trio" +"98","xmlspy" +"98","language-concepts" +"98","jtidy" +"98","rust-warp" +"98","rust-actix" +"98","dmv" +"98","watchpoint" +"98","call-by-value" +"98","database-connectivity" +"98","server-response" +"98","jobintentservice" +"98","uproot" +"98","aws-nlb" +"98","airplane-mode" +"98","urdu" +"98","ajax.net" +"98","django-request" +"98","windows-live-id" +"98","rsvp.js" +"98","readwritelock" +"98","sbrk" +"98","svmlight" +"98","awstats" +"98","svnsync" +"98","gtk-rs" +"98","application-bar" +"98","erase-remove-idiom" +"98","denodo" +"98","workmanagers" +"98","gui-designer" +"98","dynamoose" +"98","http-accept-language" +"98","jwindow" +"98","android-studio-3.2" +"98","sas-iml" +"98","dwscript" +"98","nested-sortable" +"98","rawsql" +"98","accelerate" +"98","at-job" +"98","javax.sound.sampled" +"98","shapedrawable" +"98","domain-object" +"98","android-application-class" +"98","typedoc" +"98","shopify-storefront-api" +"98","formpanel" +"98","gomobile" +"98","network-security-groups" +"98","google-api-console" +"98","diffabledatasource" +"98","android-drawer" +"98","playwright-dotnet" +"98","nstoolbaritem" +"98","taipy" +"98","non-type-template-parameter" +"98","non-member-functions" +"98","dot-matrix" +"98","aspx-user-control" +"98","null-safety" +"98","radlistview" +"98","azure-web-app-for-containers" +"98","vesta" +"98","polaris" +"98","title-case" +"98","plot3d" +"98","redux-actions" +"98","double-dispatch" +"98","holoviz" +"98","janitor" +"98","css-reset" +"98","proportions" +"98","login-page" +"98","string-decoding" +"98","certutil" +"98","spring5" +"98","no-cache" +"98","cffile" +"98","activitynotfoundexception" +"98","react-lazy-load" +"98","projective-geometry" +"98","elasticsearch-indices" +"98","google-natural-language" +"98","amazon-dynamodb-local" +"98","argoproj" +"98","third-party-cookies" +"98","ignore-case" +"98","authorize.net-cim" +"98","flutter-gridview" +"98","ember-app-kit" +"98","glulookat" +"98","dapper-extensions" +"97","reql" +"97","edit-in-place" +"97","clregion" +"97","printk" +"97","web-scripting" +"97","teamviewer" +"97","sld" +"97","debugdiag" +"97","edmx-designer" +"97","anycpu" +"97","sizetofit" +"97","ydn-db" +"97","clsid" +"97","mvcc" +"97","econnreset" +"97","clique" +"97","slim-4" +"97","install-referrer" +"97","gridview-sorting" +"97","php-cs-fixer" +"97","graphicspath" +"97","locality-sensitive-hash" +"97","getstaticprops" +"97","trilateration" +"97","php-socket" +"97","flow-project" +"97","jemalloc" +"97","fire-and-forget" +"97","jsonnode" +"97","unit-conversion" +"97","advanced-queuing" +"97","snyk" +"97","laravel-formrequest" +"97","package-control" +"97","church-encoding" +"97","bindy" +"97","x-forwarded-for" +"97","rx-py" +"97","datamart" +"97","page-caching" +"97","data-objects" +"97","rundll32" +"97","js-beautify" +"97","xmldatasource" +"97","fann" +"97","call-recording" +"97","oraclelinux" +"97","sitecore8.2" +"97","keychainitemwrapper" +"97","nanoc" +"97","google-vr-sdk" +"97","jodconverter" +"97","servermanager" +"97","unmount" +"97","oracle-bi" +"97","named-entity-extraction" +"97","candidate-key" +"97","vaticle-typeql" +"97","grpc-dotnet" +"97","apprtc" +"97","kapacitor" +"97","pdfclown" +"97","applicationpoolidentity" +"97","svgpanzoom" +"97","crashlytics-beta" +"97","http.sys" +"97","wso2-business-process" +"97","openair" +"97","audiobuffer" +"97","pyexcel" +"97","pydroid" +"97","visual-editor" +"97","wireguard" +"97","format-conversion" +"97","klocwork" +"97","formsets" +"97","network-scan" +"97","wmf" +"97","uclinux" +"97","buildconfig" +"97","pyquery" +"97","fabric.io" +"97","gobject-introspection" +"97","codeigniter-restserver" +"97","gocql" +"97","virsh" +"97","plex" +"97","non-interactive" +"97","azure-timeseries-insights" +"97","toggleswitch" +"97","mne-python" +"97","notification-channel" +"97","npoco" +"97","cookiestore" +"97","targetsdkversion" +"97","uidocumentpickervc" +"97","tinydb" +"97","mochawesome" +"97","titanium-android" +"97","xattr" +"97","control-theory" +"97","vertx-httpclient" +"97","iosdeployment" +"97","angular2-jwt" +"97","long-click" +"97","peripherals" +"97","nice" +"97","ogr2ogr" +"97","loggly" +"97","text-justify" +"97","qnetworkrequest" +"97","perltk" +"97","memcheck" +"97","color-detection" +"97","pgagent" +"97","message-hub" +"97","certificate-pinning" +"97","android-query" +"97","moralis" +"97","tesseract.js" +"97","mercurial-queue" +"97","beeware" +"97","threetenbp" +"97","static-polymorphism" +"97","custom-training" +"97","thucydides" +"97","thinktecture-ident-model" +"97","flutter-image-picker" +"97","mediametadataretriever" +"97","passkey" +"97","amazon-bedrock" +"97","flutter-moor" +"97","google-guava-cache" +"97","autopep8" +"97","google-maps-embed" +"97","cve" +"97","zend-debugger" +"97","arm-none-eabi-gcc" +"97","mri" +"97","tiles-3" +"96","stackexchange" +"96","xsockets.net" +"96","locals" +"96","apache-hive" +"96","murmurhash" +"96","matcaffe" +"96","ssdt-bi" +"96","baidu" +"96","git-history" +"96","phpoffice-phpspreadsheet" +"96","flutter-audioplayers" +"96","listcollectionview" +"96","request.form" +"96","bindable" +"96","djangoappengine" +"96","addressof" +"96","smslib" +"96","playframework-evolutions" +"96","pkg-resources" +"96","function-expression" +"96","snipmate" +"96","sentestingkit" +"96","ng-storage" +"96","self-extracting" +"96","filetime" +"96","ultisnips" +"96","selenium-server" +"96","jscript.net" +"96","cd-rom" +"96","jscolor" +"96","jsonpickle" +"96","segger-jlink" +"96","window-object" +"96","dash.js" +"96","kendonumerictextbox" +"96","simplecov" +"96","oracle-nosql" +"96","aide-ide" +"96","shared-project" +"96","angularjs-templates" +"96","dj-rest-auth" +"96","cross-database" +"96","airflow-api" +"96","keystrokes" +"96","hyperloglog" +"96","angular-renderer2" +"96","aleagpu" +"96","winapp" +"96","realm-java" +"96","database-mail" +"96","rpyc" +"96","joomla3.3" +"96","pdf417" +"96","spring-boot-jpa" +"96","bpy" +"96","corretto" +"96","bll" +"96","jqvmap" +"96","earlgrey" +"96","ws-trust" +"96","jquery-ui-button" +"96","jquery-address" +"96","fouc" +"96","shlex" +"96","code-templates" +"96","atmega16" +"96","visitor-statistic" +"96","codeigniter-query-builder" +"96","pyfpdf" +"96","mail-form" +"96","kprobe" +"96","winscard" +"96","buffered" +"96","javaw" +"96","asset-management" +"96","scalikejdbc" +"96","hidapi" +"96","android-enterprise" +"96","dining-philosopher" +"96","azurite" +"96","gwtquery" +"96","uipresentationcontroller" +"96","expat-parser" +"96","gcloud-node" +"96","azure-file-share" +"96","hamming-code" +"96","iseries-navigator" +"96","dialogresult" +"96","device-emulation" +"96","ipconfig" +"96","request-timed-out" +"96","propertynotfoundexception" +"96","esx" +"96","active-record-query" +"96","peer-dependencies" +"96","custom-titlebar" +"96","iif-function" +"96","usagestatsmanager" +"96","scroll-position" +"96","struts-action" +"96","beyondcompare4" +"96","hbitmap" +"96","prefix-operator" +"96","parse-url" +"96","tph" +"96","avassetreader" +"96","pgf" +"96","light-inject" +"96","eloqua" +"96","idoc" +"96","utop" +"96","concurrent-queue" +"96","emacs-faces" +"95","phpcassa" +"95","ebcli" +"95","mashup" +"95","dbm" +"95","smartbanner" +"95","apache-commons-compress" +"95","little-man-computer" +"95","clickatell" +"95","multirow" +"95","react-native-fcm" +"95","eclipse-classpath" +"95","cls" +"95","sizer" +"95","php-pgsql" +"95","xpi" +"95","unassigned-variable" +"95","consumption" +"95","firebase-ab-testing" +"95","piano" +"95","blackboard" +"95","configurationproperties" +"95","sensitive-data" +"95","dirichlet" +"95","firebird-embedded" +"95","rustup" +"95","xms" +"95","vptr" +"95","imageswitcher" +"95","addtarget" +"95","datapicker" +"95","valuestack" +"95","method-hiding" +"95","alertify" +"95","dns-sd" +"95","session-bean" +"95","fba" +"95","docker-cloud" +"95","waze" +"95","jfxtras" +"95","psr-7" +"95","dynamic-text" +"95","nessus" +"95","kate" +"95","android-signing" +"95","invokerequired" +"95","informatica-powerexchange" +"95","povray" +"95","jupyter-console" +"95","passthru" +"95","dos2unix" +"95","nxlog" +"95",".profile" +"95","system.io.directory" +"95","overflow-menu" +"95","extjs6.2" +"95","view-source" +"95","side-scroller" +"95","and-operator" +"95","pylintrc" +"95","luainterface" +"95","typhoeus" +"95","google-auth-library" +"95","retrieve-and-rank" +"95","facebook-ads" +"95","version-numbering" +"95","openthread" +"95","xamarin-binding" +"95","redis-streams" +"95","redisgraph" +"95","plotly.graph-objects" +"95","openlitespeed" +"95","registerhotkey" +"95","openhab" +"95","happybase" +"95","exponential-distribution" +"95","android-customtabs" +"95","xcode-cloud" +"95","redoc" +"95","timer-trigger" +"95","itoa" +"95","numexpr" +"95","nstabview" +"95","poloniex" +"95","mencoder" +"95","mendix" +"95","odoo-website" +"95","getopenfilename" +"95","lockbits" +"95","propertysheet" +"95","hybris-data-hub" +"95","memory-pool" +"95","genexus-sd" +"95","angular2-ngcontent" +"95","mpmediaplayercontroller" +"95","officedev" +"95","genie" +"95","monix" +"95","duktape" +"95","cgcolor" +"95","pedometer" +"95","angular-cli-v7" +"95","euro" +"95","movabletype" +"95","liferay-dxp" +"95","embedded-documents" +"95","torchscript" +"95","flutter-ios-build" +"95","paragraphs" +"95","emacsclient" +"95","composite-controls" +"95","line-segment" +"95","asic" +"95","subitem" +"95","qsplitter" +"95","dart-sass" +"95","scroll-paging" +"95","gitorious" +"94","dcgan" +"94","multimethod" +"94","clearquest" +"94","php-parse-error" +"94","file-location" +"94","xrange" +"94","y-combinator" +"94","sketch-3" +"94","mustache.php" +"94","repository-design" +"94","ef-code-first-mapping" +"94","rendertransform" +"94","sslexception" +"94","selectedtext" +"94","xlpagertabstrip" +"94","bitstream" +"94","uiviewpropertyanimator" +"94","discrete" +"94","blank-nodes" +"94","vnext" +"94","addhandler" +"94","checkboxpreference" +"94","cellid" +"94","picketlink" +"94","connected-react-router" +"94","documentfile" +"94","css-gradients" +"94","django-oauth" +"94","calendly" +"94","warp" +"94","rocketmq" +"94","jgoodies" +"94","single-spa-angular" +"94","oracle-commerce" +"94","nanopb" +"94","validates-uniqueness-of" +"94","dnd-kit" +"94","sitecore7.5" +"94","keycloak-gatekeeper" +"94","sequence-to-sequence" +"94","ibm-data-studio" +"94","unmanaged-memory" +"94","joomla-sef-urls" +"94","angular-route-guards" +"94","databricks-community-edition" +"94","tthread" +"94","dynamic-image-generation" +"94","htl" +"94","near" +"94","opencl-c" +"94","wordpress-login" +"94","couchdb-mango" +"94","android-viewbinder" +"94","nsstatusbar" +"94","password-generator" +"94","applepayjs" +"94","environment-modules" +"94","twitter-rest-api" +"94","derbyjs" +"94","html-imports" +"94","turnjs" +"94","wwwroot" +"94","entitylisteners" +"94","nrf51" +"94","blobs" +"94","htmlcleaner" +"94","table-functions" +"94","mailcore" +"94","visualtreehelper" +"94","minim" +"94","ocamllex" +"94","razor-components" +"94","synth" +"94","obout" +"94","virtual-threads" +"94","signalr-2" +"94","sevenzipsharp" +"94","12factor" +"94","ambassador" +"94","built-in-types" +"94","libffi" +"94","buckets" +"94","netoffice" +"94","range-query" +"94","uhd" +"94","lwuit-form" +"94","nstextfieldcell" +"94","gdkpixbuf" +"94","c64" +"94","mmo" +"94","wxformbuilder" +"94","radio-transmission" +"94","dfm" +"94","npm-workspaces" +"94","xamarin-test-cloud" +"94","metaio" +"94","laravel-models" +"94","perforce-integrate" +"94","iron.io" +"94","textrange" +"94","react-app-rewired" +"94","react-16" +"94","mpc" +"94","ejb-3.2" +"94","splunk-calculation" +"94","reserved" +"94","lttng" +"94","css-paged-media" +"94","get-aduser" +"94","linaro" +"94","qtopengl" +"94","statnet" +"94","amazon-rds-proxy" +"94","gitpod" +"94","statefulset" +"94","aloha-editor" +"94","prebid.js" +"94","usleep" +"94","tez" +"94","ifilter" +"94","sparse-array" +"94","quadprog" +"94","ppi" +"94","compose-db" +"94","heremaps-android-sdk" +"93","editortemplates" +"93","decidable" +"93","sln-file" +"93","jboss-cli" +"93","apache-httpasyncclient" +"93","git-husky" +"93","maven-checkstyle-plugin" +"93","great-circle" +"93","temporal-database" +"93","telegraf-inputs-plugin" +"93","ddd-service" +"93","phpass" +"93","ddd-debugger" +"93","material-react-table" +"93","ggiraph" +"93","mainclass" +"93","ngsanitize" +"93","ng-submit" +"93","datasheet" +"93","bitmap-fonts" +"93","catch-unit-test" +"93","full-trust" +"93","vrml" +"93","imagesloaded" +"93","pafy" +"93","findandmodify" +"93","symfony-4.4" +"93","containment" +"93","kubernetes-python-client" +"93","immutable-collections" +"93","datefilter" +"93","choroplethr" +"93","icacls" +"93","angularjs-ng-disabled" +"93","dojo.gridx" +"93","optionparser" +"93","valet" +"93","data-dumper" +"93","gqlgen" +"93","go-swagger" +"93","databricks-autoloader" +"93","meteor-velocity" +"93","service-fabric-actor" +"93","sikuli-ide" +"93","aws-toolkit" +"93","eai" +"93","azure-elasticpool" +"93","azure-compute-emulator" +"93","jvcl" +"93","ionos" +"93","wunderground" +"93","design-decisions" +"93","android-scrollbar" +"93","sapjco3" +"93","passport-google-oauth2" +"93","karatsuba" +"93","durandal-navigation" +"93","dependency-parsing" +"93","razor-class-library" +"93","vim-fugitive" +"93","audio-analysis" +"93","koala-gem" +"93","ati" +"93","android-2.1-eclair" +"93","sgen" +"93","pymqi" +"93","eyed3" +"93","raw-ethernet" +"93","formatted" +"93","plesk-onyx" +"93","gzipoutputstream" +"93","gwt-2.2-celltable" +"93","gae-search" +"93","xcode9.1" +"93","nstextstorage" +"93","sqlitestudio" +"93","c9.io" +"93","redirect-loop" +"93","exception-safety" +"93","sqlmetal" +"93","dfsort" +"93","scnscene" +"93","uihostingcontroller" +"93","dotnet-sdk" +"93","tmemo" +"93","hints" +"93","cumulative-frequency" +"93","custom-protocol" +"93","google-finance-api" +"93","qmouseevent" +"93","launchctl" +"93","ipb" +"93","mouse-hook" +"93","android-min-sdk" +"93","splistitem" +"93","metallb" +"93","action-mapping" +"93","laravel-vue" +"93","es6-map" +"93","prose-mirror" +"93","event-simulation" +"93","nightly-build" +"93","android-night-mode" +"93","ikimagebrowserview" +"93","amazon-s3-select" +"93","mcc" +"93","computer-science-theory" +"93","webkitspeechrecognition" +"93","sound-synthesis" +"93","tidyselect" +"93","quarkus-native" +"93","ember-addon" +"93","tidyquant" +"93","git-reflog" +"93","zipalign" +"93","spark-thriftserver" +"93","heapq" +"93","amazon-cognito-triggers" +"93","quickaction" +"93","powershell-workflow" +"93","google-publisher-tag" +"93","amazon-kinesis-video-streams" +"93","mdb2" +"93","cytoscape-web" +"93","google-latitude" +"93","google-play-billing" +"93","google-play-core" +"92","mvccontrib-grid" +"92","file-mapping" +"92","php-7.0" +"92","graph-neural-network" +"92","intelephense" +"92","background-agents" +"92","instr" +"92","yii-booster" +"92","wiimote" +"92","edit-and-continue" +"92","xml-binding" +"92","django-celery-beat" +"92","bitboard" +"92","bing-ads-api" +"92","dismax" +"92","dbflow" +"92","malformedurlexception" +"92","pivotal-web-services" +"92","smtpappender" +"92","sails.io.js" +"92","chez-scheme" +"92","paket" +"92","adempiere" +"92","unicode-literals" +"92","rowdeleting" +"92","rubber" +"92","ora-00907" +"92","angularjs-ng-if" +"92","calibre" +"92","aws-regions" +"92","django-mysql" +"92","unsupportedoperation" +"92","servicestack-bsd" +"92","angular-lazyloading" +"92","server-explorer" +"92","csl" +"92","aws-amplify-sdk-js" +"92","serilog-sinks-file" +"92","aws-alb" +"92","ibm-appid" +"92","satis" +"92","opalrb" +"92","ionic-storage" +"92","dynamic-list" +"92","opendocument" +"92","bnlearn" +"92","android-studio-3.5" +"92","surround" +"92","cpu-cycles" +"92","appimage" +"92","box2dweb" +"92","bodymovin" +"92","ones-complement" +"92","postmortem-debugging" +"92","objectinstantiation" +"92","browser-testing" +"92","pytest-bdd" +"92","ammap" +"92","lumen-5.2" +"92","pytest-xdist" +"92","kogrid" +"92","cocoscreator" +"92","nppexec" +"92","ml-gradle" +"92","dpc++" +"92","tinymce-6" +"92","haproxy-ingress" +"92","cairngorm" +"92","xcode-template" +"92","xcode-organizer" +"92","direct3d12" +"92","uibackgroundcolor" +"92","tlbimp" +"92","isar" +"92","controlled-component" +"92","h2db" +"92","polarion" +"92","nunit-2.5" +"92","downloadstring" +"92","uipickerviewcontroller" +"92","hydrogen" +"92","cgsize" +"92","custom-action-filter" +"92","getc" +"92","streaminsight" +"92","google-cloud-nl" +"92","log4php" +"92","odk" +"92","ctad" +"92","locomotivecms" +"92","geolocator" +"92","comaddin" +"92","offsetof" +"92","protocol-handler" +"92","character-properties" +"92","ie-compatibility-mode" +"92","zillow" +"92","glove" +"92","utf-32" +"92","trailing-return-type" +"92","header-only" +"92","imagebrush" +"92","archer" +"92","fontconfig" +"92","struts2-jquery-plugin" +"92","zend-autoloader" +"92","armcc" +"92","ytplayerview" +"92","threejs-editor" +"92","arm7" +"92","mcustomscrollbar" +"92","custom-theme" +"92","fo-dicom" +"92","static-memory-allocation" +"91","figures" +"91","cloudsim" +"91","groq" +"91","ggpmisc" +"91","fest" +"91","transitive-closure-table" +"91","instapy" +"91","yolov7" +"91","listjs" +"91","github-mantle" +"91","graphql-spqr" +"91","jeromq" +"91","carla" +"91","carrier" +"91","celltemplate" +"91","cbir" +"91","date-manipulation" +"91","configserver" +"91","jsprit" +"91","l2cap" +"91","symantec" +"91","contentpane" +"91","adcolony" +"91","fixpoint-combinators" +"91","fitbounds" +"91","symfony-flex" +"91","froogaloop" +"91","xom" +"91","django-uploads" +"91","pyd" +"91","jfugue" +"91","dataframes.jl" +"91","windows-networking" +"91","crossword" +"91","server-name" +"91","ruby-3" +"91","ibm-content-navigator" +"91","datagridviewtextboxcell" +"91","key-management" +"91","kentico-12" +"91","micronaut-rest" +"91","scala-dispatch" +"91","jquery-3" +"91","html-head" +"91","supercomputers" +"91","boost-multiprecision" +"91","jquery-form-validator" +"91","nspanel" +"91","htk" +"91","jquery-scrollify" +"91","password-storage" +"91","rappid" +"91","viewport3d" +"91","pygooglechart" +"91","knuth" +"91","visual-studio-community" +"91","nvprof" +"91","video-subtitles" +"91","virtualizingstackpanel" +"91","wordle-game" +"91","netbeans-8.1" +"91","set-union" +"91","py-shiny" +"91","fraud-prevention" +"91","wmplib" +"91","google-advertising-id" +"91","iso-15693" +"91","hocon" +"91","c++builder-xe2" +"91","cookie-session" +"91","uiimagejpegrepresentation" +"91","sql-server-2016-express" +"91","mks" +"91","gutter" +"91","scala-quasiquotes" +"91","conversation-scope" +"91","mobility" +"91","hgsubversion" +"91","requestcontext" +"91","progress-indicator" +"91","prolog-cut" +"91","test-reporting" +"91","geom-tile" +"91","ohlc" +"91","large-object-heap" +"91","qicon" +"91","http-tunneling" +"91","android-maps-utils" +"91","common-data-service" +"91","protocol-extension" +"91","splitpane" +"91","ios-sharesheet" +"91","learning-rate" +"91","custom-pages" +"91","ejbca" +"91","activemq-cpp" +"91","color-management" +"91","alluxio" +"91","autokey" +"91","soundeffect" +"91","zalenium" +"91","mcafee" +"91","google-provisioning-api" +"91","medoo" +"91","seekg" +"91","multiautocompletetextview" +"91","ihtmldocument2" +"91","flutter-localizations" +"91","compile-time-weaving" +"91","autofac-configuration" +"91","arraydeque" +"91","google-python-api" +"91","helix" +"91","webex" +"91","glassfish-5" +"91","bilinear-interpolation" +"91","ihostedservice" +"91","aruba" +"91","web-content" +"90","photoeditorsdk" +"90","filegroup" +"90","file-monitoring" +"90","gray-code" +"90","sql-types" +"90","integrated-pipeline-mode" +"90","jekyll-bootstrap" +"90","skeletal-animation" +"90","jexl" +"90","loadview" +"90","barbajs" +"90","teraterm" +"90","xtensor" +"90","phpickerviewcontroller" +"90","print-spooler-api" +"90","multiprocessing-manager" +"90","firefox-3" +"90","soft-references" +"90","swingbuilder" +"90","python-bindings" +"90","firefox-profile" +"90","sendmailr" +"90","pint" +"90","rx-scala" +"90","sabredav" +"90","angularjs-model" +"90","reason-react" +"90","rowversion" +"90","campaign-monitor" +"90","oracle-apex-19.2" +"90","wacom" +"90","watchface" +"90","dataexplorer" +"90","windows-phone-7.1.1" +"90","id3-tag" +"90","croppie" +"90","watchify" +"90","aws-ecs" +"90","rtmfp" +"90","workload-scheduler" +"90","boggle" +"90","bltoolkit" +"90","twitter-gem" +"90","wpmu" +"90","pos-for-.net" +"90","boost-mutex" +"90","jung2" +"90","posix-ere" +"90","bolts-framework" +"90","ini-set" +"90","world-map" +"90","easy68k" +"90","gruntfile" +"90","design-guidelines" +"90","ncrunch" +"90","nsdatepicker" +"90","invoices" +"90","hostapd" +"90","natural-logarithm" +"90","minimized" +"90","octave-gui" +"90","ocamlyacc" +"90","libharu" +"90","viola-jones" +"90","levenberg-marquardt" +"90","freeipa" +"90","video-card" +"90","shadow-copy" +"90","shadow-cljs" +"90","netnamedpipebinding" +"90","javax.crypto" +"90","kodein" +"90","external-dependencies" +"90","winsxs" +"90","cookieconsent" +"90","mod-cluster" +"90","registerstartupscript" +"90","nusmv" +"90","azure-vm-role" +"90","nvidia-digits" +"90","nolock" +"90","bunny" +"90","directdraw" +"90","hanami" +"90","redux-middleware" +"90","cacerts" +"90","hit" +"90","mmdrawercontroller" +"90","qdatetime" +"90","metadata-extractor" +"90","exasol" +"90","stringreader" +"90","irr" +"90","evopdf" +"90","memory-bandwidth" +"90","cuda-gdb" +"90","login-required" +"90","late-static-binding" +"90","curlpp" +"90","google-experiments" +"90","lbph-algorithm" +"90","dumpbin" +"90","text-coloring" +"90","angular2-router3" +"90","http-status-code-410" +"90","colorize" +"90","actualwidth" +"90","coldfusionbuilder" +"90","cubism.js" +"90","string-hashing" +"90","android-print-framework" +"90","cgcontextref" +"90","megaparsec" +"90","arrayofarrays" +"90","sharpgl" +"90","steamvr" +"90","mavlink" +"90","stencil-component" +"90","qtextstream" +"90","iexpress" +"90","sdi" +"90","solidus" +"90","parsexml" +"90","aries" +"90","gnat-gps" +"90","google-map-react" +"90","arduino-due" +"90","user-feedback" +"90","argonaut" +"90","static-class" +"90","threadabortexception" +"89","renjin" +"89","base32" +"89","load-csv" +"89","template-tal" +"89","matillion" +"89","yii-events" +"89","figwheel" +"89","clientscript" +"89","file.readalllines" +"89","matchmedia" +"89","transport-stream" +"89","flexmojos" +"89","multivariate-time-series" +"89","mumps" +"89","flink-statefun" +"89","flutter2.0" +"89","productivity-power-tools" +"89","paketo" +"89","image-rendering" +"89","ng2-translate" +"89","symbolic-integration" +"89","uitextinput" +"89","imagemin" +"89","jsr286" +"89","cscore" +"89","ibm-infosphere" +"89","operationalerror" +"89","agrep" +"89","aginity" +"89","joincolumn" +"89","pug-loader" +"89","createwindow" +"89","mysql-function" +"89","serving" +"89","akavache" +"89","crud-repository" +"89","payfort" +"89","spring-remoting" +"89","twinx" +"89","pathogen" +"89","apply-templates" +"89","sas-ods" +"89","application-start" +"89","sap-cloud-foundry" +"89","polynomial-approximations" +"89","android-threading" +"89","error-suppression" +"89","enlive" +"89","entityreference" +"89","bsearch" +"89","kubebuilder" +"89","system-error" +"89","audiosession" +"89","wistia" +"89","netscaler" +"89","libvpx" +"89","btrfs" +"89","netbeans-12" +"89","rhino3d" +"89","set-operations" +"89","macbookpro-touch-bar" +"89","raw-pointer" +"89","system.configuration" +"89","code-hinting" +"89","objectdataprovider" +"89","javalin" +"89","explicit-interface" +"89","expected-exception" +"89","podofo" +"89","spring-test-dbunit" +"89","azure-node-sdk" +"89","drupal-nodes" +"89","polkadot-js" +"89","scd2" +"89","dotnetnuke-6" +"89","sqlkata" +"89","scikit-learn-pipeline" +"89","polyhedra" +"89","half-precision-float" +"89","tls1.0" +"89","hla" +"89","c++builder-10.2-tokyo" +"89","npm-update" +"89","nsuseractivity" +"89","bunit" +"89","dotvvm" +"89","command-objects" +"89","chaco" +"89","logistics" +"89","ltpa" +"89","perfect-scrollbar" +"89","resharper-6.0" +"89","google-generativeai" +"89","get-headers" +"89","split-screen" +"89","google-sso" +"89","linkedin-j" +"89","zend-framework-modules" +"89","alloca" +"89","web2py-modules" +"89","folder-permissions" +"89","pgloader" +"89","quartz.net-2.0" +"89","iframe-app" +"89","stateflow" +"89","flyweight-pattern" +"89","stubs" +"89","subversion-edge" +"89","static-initializer" +"89","paperclip-validation" +"89","transcrypt" +"89","arduino-ultra-sonic" +"89","flutter-textinputfield" +"89","msn" +"88","stacklayout" +"88","tensorflow-model-garden" +"88","lmer" +"88","react-native-windows" +"88","jcs" +"88","git-index" +"88","ggtext" +"88","anti-cheat" +"88","gflags" +"88","phpdotenv" +"88","default-scope" +"88","flutterdriver" +"88","clientcredential" +"88","jboss-logging" +"88","debian-packaging" +"88","xmgrace" +"88","rust-chrono" +"88","cassandra-driver" +"88","xlutils" +"88","dism" +"88","function-qualifier" +"88","diskimage" +"88","rust-futures" +"88","distributed-training" +"88","checker-framework" +"88","contention" +"88","chromakey" +"88","voicemail" +"88","nhibernate.search" +"88","manipulators" +"88","inclusion" +"88","swiftui-navigationsplitview" +"88","vora" +"88","overscroll" +"88","swiftui-picker" +"88","kitura" +"88","django-tagging" +"88","uppaal" +"88","callcc" +"88","react-starter-kit" +"88","rt" +"88","rtcdatachannel" +"88","angularjs-nvd3-directives" +"88","mysql-error-1111" +"88","server-variables" +"88","angular-seed" +"88","react-toolbox" +"88","pwntools" +"88","rncryptor" +"88","opencensus" +"88","twilio-taskrouter" +"88","modelmetadata" +"88","dynamictype" +"88","onrestoreinstancestate" +"88","jquery-backstretch" +"88","passport-saml" +"88","workload-identity" +"88","bottombar" +"88","eregi" +"88","inotifydataerrorinfo" +"88","htmleditorkit" +"88","nrvo" +"88","sarimax" +"88","jquery-ui-map" +"88","htmltextwriter" +"88","wordml" +"88","pyspark-schema" +"88","codeql" +"88","sfx" +"88","pyelasticsearch" +"88","128-bit" +"88","pyfits" +"88","kotlin-dokka" +"88","netmsmqbinding" +"88","cognos-tm1" +"88","type-promotion" +"88","osticket" +"88","nevpnmanager" +"88","aurelia-templating" +"88","wkinterfacetable" +"88","drake-r-package" +"88","refer" +"88","gupshup" +"88","tla+" +"88","ithit-webdav-server" +"88","openvr" +"88","azure-gov" +"88","c#-7.3" +"88","tkmessagebox" +"88","game-ai" +"88","execfile" +"88","ispconfig" +"88","gelf" +"88","rails-3-upgrade" +"88","galois-field" +"88","asp.net-session" +"88","tkinter-menu" +"88","radix-ui" +"88","react-apollo-hooks" +"88","css-purge" +"88","terraform-cdk" +"88","progressive-download" +"88","dunit" +"88","android-phone-call" +"88","mprotect" +"88","periodicity" +"88","actionviewhelper" +"88","strncmp" +"88","nitrogen" +"88","elastix" +"88","reactjs-testutils" +"88","auto-import" +"88","autodiscovery" +"88","lineageos" +"88","glance-appwidget" +"88","gksession" +"88","lifting" +"88","bim" +"88","beta-distribution" +"88","ms-access-2000" +"88","zeitwerk" +"88","webdynpro" +"88","torquebox" +"88","tframe" +"88","webdatarocks" +"88","stylish" +"88","if-modified-since" +"88","struts2-jquery-grid" +"88","steambot" +"87","react-native-vision-camera" +"87","groovy-grape" +"87","mashape" +"87","instantiation-error" +"87","slackware" +"87","trusted-timestamp" +"87","jenkins-scriptler" +"87","tensorflow-slim" +"87","gevent-socketio" +"87","apache-commons-exec" +"87","webrole" +"87","wfastcgi" +"87","jetpack-compose-animation" +"87","phplist" +"87","rendertarget" +"87","primavera" +"87","wercker" +"87","flexjson" +"87","music-notation" +"87","edge.js" +"87","multiprecision" +"87","rename-item-cmdlet" +"87","jdk1.7" +"87","bindvalue" +"87","xmlrpcclient" +"87","api-authorization" +"87","datestamp" +"87","nghttp2" +"87","cardslib" +"87","dbatools" +"87","filesplitting" +"87","django-4.0" +"87","python-s3fs" +"87","python-pdfkit" +"87","js-ipfs" +"87","pii" +"87","safari-app-extension" +"87","python-can" +"87","pivotitem" +"87","jsonkit" +"87","catplot" +"87","smbus" +"87","directory-traversal" +"87","finalbuilder" +"87","uitraitcollection" +"87","fla" +"87","symbol-server" +"87","lando" +"87","pkcs#1" +"87","jline" +"87","jose4j" +"87","verdaccio" +"87","wavesplatform" +"87","aws-chime-sdk" +"87","unnotificationserviceextension" +"87","mysql++" +"87","oql" +"87","jqbootstrapvalidation" +"87","r-mapview" +"87","publish-profiles" +"87","google-wave" +"87","hypertable" +"87","avcam" +"87","fastscroll" +"87","callbyname" +"87","boomi" +"87","core-media" +"87","wro4j" +"87","nrepl" +"87","tweetstream" +"87","dvb" +"87","open62541" +"87","eos" +"87","sikuli-x" +"87","opaque-pointers" +"87","dynatable" +"87","attribution" +"87","knox-amazon-s3-client" +"87","java-ws" +"87","amp-email" +"87","augeas" +"87","viewswitcher" +"87","r-car" +"87","google-benchmark" +"87","level-of-detail" +"87","jasmine-marbles" +"87","vision" +"87","object-tracking" +"87","mini-batch" +"87","ui5-tooling" +"87","javah" +"87","netbeans6.7" +"87","netbeans6.5" +"87","lib-nfc" +"87","libv8" +"87","ratpack" +"87","mks-integrity" +"87","sqljdbc" +"87","dpkt" +"87","azuremlsdk" +"87","scoverage" +"87","diagrams" +"87","d-pad" +"87","openmax" +"87","mkdirs" +"87","openstack-heat" +"87","isolate-scope" +"87","drupal-templates" +"87","modelchoicefield" +"87","xaml-designer" +"87","openxava" +"87","express-generator" +"87","null-conditional-operator" +"87","bulk-collect" +"87","octokit-js" +"87","react-hooks-testing-library" +"87","memory-fragmentation" +"87","resque-scheduler" +"87","getorgchart" +"87","cglayer" +"87","angular-builder" +"87","perfect-square" +"87","android-picture-in-picture" +"87","tesla" +"87","hugo-shortcode" +"87","ctrlp" +"87","pentaho-design-studio" +"87","terraform-provider-databricks" +"87","getlasterror" +"87","papi" +"87","dagre-d3" +"87","weblogic9.x" +"87","conditional-aggregation" +"87","flutter-workmanager" +"87","tool-uml" +"87","ihp" +"87","papaja" +"87","security-constraint" +"87","spanned" +"86","eclipse-clp" +"86","proc-r-package" +"86","primary-key-design" +"86","xxe" +"86","vue-events" +"86","localauthentication" +"86","react-native-tab-view" +"86","ef4-code-only" +"86","vsvim" +"86","ssim" +"86","multipleoutputs" +"86","json-view" +"86","jssip" +"86","apollo-angular" +"86","function-module" +"86","binary-decision-diagram" +"86","selenium3" +"86","unhandled-promise-rejection" +"86","umdf" +"86","json-c" +"86","pidgin" +"86","apache-ode" +"86","ng-container" +"86","bitcoinj" +"86","wcm" +"86","camera-overlay" +"86","grails-2.5" +"86","jfrog-container-registry" +"86","server-side-swift" +"86","sitecore-media-library" +"86","falcon" +"86","factoextra" +"86","ora-00942" +"86","awss3transfermanager" +"86","alertview" +"86","django-pyodbc" +"86","servicecontract" +"86","purchase-order" +"86","database-testing" +"86","waitforsingleobject" +"86","simplex-noise" +"86","android-studio-import" +"86","cortana-skills-kit" +"86","spring-dm" +"86","html5shiv" +"86","sanctum" +"86","signpost" +"86","nav-pills" +"86","katalon" +"86","gtksourceview" +"86","onlinebanking" +"86","android-sinch-api" +"86","bottom-up" +"86","azul-zulu" +"86","dynamic-scope" +"86","az" +"86","cpp-netlib" +"86","inquirer" +"86","neo4j-driver" +"86","oscilloscope" +"86","codesmith" +"86","ubuntu-9.10" +"86","out-of-process" +"86","ui.bootstrap" +"86","wiredep" +"86","shtml" +"86","forfiles" +"86","woodstox" +"86","obex" +"86","visual-sourcesafe-2005" +"86","objectarx" +"86","synchronized-block" +"86","visual-studio-designer" +"86","foundry-workshop" +"86","android-attributes" +"86","return-type-deduction" +"86","visual-studio-project" +"86","burndowncharts" +"86","mklink" +"86","hibernate-cascade" +"86","gae-module" +"86","hmail-server" +"86","high-order-component" +"86","drc" +"86","screens" +"86","quickselect" +"86","hamlet" +"86","iwork" +"86","metacharacters" +"86","google-gears" +"86","custom-formatting" +"86","ip-restrictions" +"86","electron-vue" +"86","lseek" +"86","esmodules" +"86","logical-and" +"86","strong-references" +"86","metal-performance-shaders" +"86","omap" +"86","stream-analytics" +"86","cuda-streams" +"86","okio" +"86","meego" +"86","common.logging" +"86","examine" +"86","elm327" +"86","pq" +"86","pptp" +"86","usb-mass-storage" +"86","argument-error" +"86","helpermethods" +"86","custom-transition" +"86","transducer" +"86","web-midi" +"86","preemptive" +"86","secure-random" +"86","user-inactivity" +"86","top-command" +"86","sonarqube5.6" +"86","tie" +"86","youtubeplayer" +"86","prebuild" +"86","fma" +"86","linq-query-syntax" +"86","linux-disk-free" +"86","maven-install-plugin" +"86","searchlogic" +"86","multi-dimensional-scaling" +"85","treetop" +"85","liquidsoap" +"85","xregexp" +"85","trending" +"85","mat-stepper" +"85","react-native-navigation-v2" +"85","multi-query" +"85","anyevent" +"85","template-instantiation" +"85","location-client" +"85","apache-commons-dbutils" +"85","graphite-carbon" +"85","clear-cache" +"85","apache-commons-lang3" +"85","cleartype" +"85","jenkins-job-builder" +"85","tensorflow-xla" +"85","apache-spark-xml" +"85","nhibernate-3" +"85","page-editor" +"85","sencha-charts" +"85","findersync" +"85","smart-wizard" +"85","flask-babel" +"85","app-distribution" +"85","data-link-layer" +"85","manova" +"85","addrange" +"85","checkboxfor" +"85","ape-phylo" +"85","mapview" +"85","realm-object-server" +"85","credits" +"85","oracle-service-bus" +"85","unrealscript" +"85","django-mongodb-engine" +"85","oracle-soa" +"85","vectormath" +"85","ibpy" +"85","rotator" +"85","kernlab" +"85","cross-fade" +"85","boyer-moore" +"85","denormalized" +"85","nservicebus4" +"85","dev-appserver" +"85","craigslist" +"85","working-copy" +"85","pathinfo" +"85","writeablebitmapex" +"85","html5-animation" +"85","nsslider" +"85","html5-draggable" +"85","ridgeline-plot" +"85","knockout-sortable" +"85","reverse-iterator" +"85","analytical" +"85","javax.sound.midi" +"85","rational-numbers" +"85","visualbrush" +"85","pystan" +"85","lumia-imaging-sdk" +"85","viterbi" +"85","minimalmodbus" +"85","netbeans-8.2" +"85","nvp" +"85","browser-refresh" +"85","shallow-clone" +"85","visual-assist" +"85","nstouchbar" +"85","uipath-orchestrator" +"85","uipath-activity" +"85","tinder" +"85","noir" +"85","isolatedstoragefile" +"85","timsort" +"85","cache-invalidation" +"85","iterparse" +"85","xcache" +"85","openwebrtc" +"85","executionpolicy" +"85","non-exhaustive-patterns" +"85","dotnetbar" +"85","tbxml" +"85","nonlinear-equation" +"85","null-object-pattern" +"85","hibernate.cfg.xml" +"85","mkstorekit" +"85","reflect-metadata" +"85","c#-7.2" +"85","pex-and-moles" +"85","angular-component-router" +"85","ctl" +"85","qdir" +"85","qjson" +"85","no-data" +"85","commercetools" +"85","node-schedule" +"85","spn" +"85","mousemotionlistener" +"85","qpython3" +"85","leaflet-routing-machine" +"85","textangular" +"85","launch-daemon" +"85","qmenubar" +"85","glidejs" +"85","bimap" +"85","sonarqube5.3" +"85","libzip" +"85","web-optimization" +"85","identitymodel" +"85","sourceforge-appscript" +"85","enctype" +"85","amazon-policy" +"85","googlesheets4" +"85","composite-index" +"85","big-ip" +"85","webpack-cli" +"85","emacs-helm" +"85","computed-field" +"84","instamojo" +"84","cmsmadesimple" +"84","weighting" +"84","y86" +"84","skproduct" +"84","github-organizations" +"84","jboss-developer-studio" +"84","graph-layout" +"84","installshield-2011" +"84","materialdrawer" +"84","apache-commons-email" +"84","apache-cocoon" +"84","grass" +"84","flink-table-api" +"84","field-names" +"84","teamspeak" +"84","jdoql" +"84","anti-join" +"84","gretty" +"84","vue-sfc" +"84","cloudmade" +"84","ggalluvial" +"84","gridworld" +"84","afhttprequestoperation" +"84","xml-formatting" +"84","platypus" +"84","cartalyst-sentinel" +"84","impress.js" +"84","voximplant" +"84","django-contrib" +"84","friend-class" +"84","adobe-premiere" +"84","lambdaj" +"84","check-mk" +"84","xidel" +"84","frozenset" +"84","xperf" +"84","fireworks" +"84","uitypeeditor" +"84","firewatir" +"84","symmetric-key" +"84","python-pika" +"84","page-jump" +"84","chicagoboss" +"84","xming" +"84","g1ant" +"84","conky" +"84","catalina.out" +"84","wincrypt" +"84","databags" +"84","grails-validation" +"84","watchos-6" +"84","oracle-enterprise-manager" +"84","database-abstraction" +"84","caliper" +"84","react-swiper" +"84","read-csv" +"84","joomla3.4" +"84","wcf-hosting" +"84","keras-rl" +"84","uribuilder" +"84","simscape" +"84","mysql-error-1093" +"84","sequence-generators" +"84","jooq-codegen-maven" +"84","pts" +"84","django-filebrowser" +"84","vdi" +"84","canary-deployment" +"84","public-activity" +"84","routeconfig" +"84","nano-server" +"84","verifone" +"84","punycode" +"84","doclet" +"84","negate" +"84","dwolla" +"84","easyadmin3" +"84","wso2-message-broker" +"84","power-automate-custom-connector" +"84","swc-compiler" +"84","k8s-serviceaccount" +"84","erasure" +"84","savefig" +"84","ttkbootstrap" +"84","money-rails" +"84","spring-security-acl" +"84","android-wireless" +"84","twitter-follow" +"84","aws-sso" +"84","simba" +"84","extern-c" +"84","nyromodal" +"84","externals" +"84","pygit2" +"84","netflix-dgs" +"84","godoc" +"84","code-assist" +"84","shoutem" +"84","google-caja" +"84","facebook-invite" +"84","viewmodellocator" +"84","revolution-r" +"84","ubuntu-17.10" +"84","video-intelligence-api" +"84","pyflakes" +"84","freecad" +"84","timecodes" +"84","nstablecolumn" +"84","sql-server-2012-datatools" +"84","taskfactory" +"84","convertapi" +"84","registerforactivityresult" +"84","qwebpage" +"84","nstokenfield" +"84","hindley-milner" +"84","plyr.js" +"84","xamarin-community-toolkit" +"84","devexpress-gridcontrol" +"84","time-frequency" +"84","export-to-text" +"84","android-filter" +"84","gemfile.lock" +"84","playready" +"84","access-levels" +"84","elastic-beats" +"84","ctor-initializer" +"84","protobuf-go" +"84","resample" +"84","monte-carlo-tree-search" +"84","messagecontract" +"84","ios-enterprise" +"84","generic-function" +"84","requirejs-optimizer" +"84","splint" +"84","rescript" +"84","react-instantsearch" +"84","lockless" +"84","lossless" +"84","mpeg-2" +"84","isalpha" +"84","elementref" +"84","centralized" +"84","actiondispatch" +"84","color-depth" +"84","morphological-analysis" +"84","acme" +"84","terraform-provider-kubernetes" +"84","berkeley-db-je" +"84","qubole" +"84","web3-react" +"84","gnu-findutils" +"84","soundcard" +"84","endlessscroll" +"84","battery-saver" +"84","preloadjs" +"84","spark3" +"84","tiddlywiki" +"84","gmlib" +"84","git-tf" +"84","sudzc" +"84","embedded-language" +"84","foreach-object" +"83","wgpu-rs" +"83","edk2" +"83","instantsearch" +"83","jdedwards" +"83","productbuild" +"83","ckquery" +"83","festival" +"83","ssmtp" +"83","clockify" +"83","eclipse-jee" +"83","definitions" +"83","llblgen" +"83","integrated-security" +"83","biztalk-deployment" +"83","mali" +"83","adldap" +"83","social-authentication" +"83","lapacke" +"83","languagetool" +"83","import-contacts" +"83","firefox-developer-edition" +"83","sendasync" +"83","finite-field" +"83","constraint-satisfaction" +"83","symphony-cms" +"83","datapoint" +"83","chessboard.js" +"83","ngx-bootstrap-modal" +"83","wcfserviceclient" +"83","rnw" +"83","window-management" +"83","iana" +"83","iconbutton" +"83","awesome-notifications" +"83","camel-sql" +"83","alfa" +"83","rpm-maven-plugin" +"83","jmagick" +"83","microsoft-exchange" +"83","rjsonio" +"83","metro-ui-css" +"83","mysql.data" +"83","kirby" +"83","android-studio-3.3" +"83","equality-operator" +"83","android-studio-arctic-fox" +"83","appleevents" +"83","sap-business-one-di-api" +"83","swapfile" +"83","swank" +"83","suricata" +"83","openapi-generator-cli" +"83","azure-ai-search" +"83","pdfviewer" +"83","wtelegramclient" +"83","twincat-ads" +"83","onresize" +"83","twill" +"83","coverlet" +"83","pony" +"83","popularity" +"83","nsnull" +"83","3d-rendering" +"83","amq" +"83","knowledge-management" +"83","absinthe" +"83","shaderlab" +"83","r-glue" +"83","oak" +"83","libiconv" +"83","libx265" +"83","facebook-java-api" +"83","go-get" +"83","dom-node" +"83","browser-link" +"83","cohesion" +"83","netmask" +"83","libreadline" +"83","atlassian-crowd" +"83","rattle" +"83","browserfield" +"83","azure-webjobs-triggered" +"83","c++builder-xe" +"83","aspbutton" +"83","itunes-sdk" +"83","quickreports" +"83","digital-design" +"83","pls" +"83","nsuinteger" +"83","byobu" +"83","xbase" +"83","iup" +"83","opensolaris" +"83","hana-xs" +"83","drupal-fields" +"83","uipath-robot" +"83","sqlcl" +"83","taskcompletionsource" +"83","mobicents" +"83","draper" +"83","assemblybinding" +"83","ntfs-mft" +"83","tlist" +"83","deviceid" +"83","scalaz-stream" +"83","convertview" +"83","wxhaskell" +"83","mkreversegeocoder" +"83","dia" +"83","spherical-coordinate" +"83","proxy-authentication" +"83","n-layer" +"83","percent-encoding" +"83","nivo-react" +"83","color-codes" +"83","peoplecode" +"83","memory-optimization" +"83","mendeley" +"83","stringescapeutils" +"83","cfchart" +"83","spotify-scio" +"83","google-container-os" +"83","cursive" +"83","qoq" +"83","office-2003" +"83","nibabel" +"83","stm8" +"83","getproperty" +"83","tidycensus" +"83","msaa" +"83","bcs" +"83","source-sets" +"83","globalize3" +"83","vaadin24" +"83","ms-access-reports" +"83","dart-http" +"83","bigrquery" +"83","glmm" +"83","stylus-pen" +"83","solana-transaction-instruction" +"83","tools.jar" +"83","argon2-ffi" +"83","usernametoken" +"83","webexception" +"83","autofac-module" +"83","hbs" +"83","usersession" +"82","fetching-strategy" +"82","telegraf.js" +"82","wicket-7" +"82","clockkit" +"82","websphere-mq-fte" +"82","smallbasic" +"82","client-library" +"82","mupad" +"82","xubuntu" +"82","eclipse-hono" +"82","xml-to-json" +"82","blaze" +"82","kudan" +"82","ngb-datepicker" +"82","pixate" +"82","smf" +"82","flashing" +"82","firefox-addon-restartless" +"82","apic" +"82","symfony-mailer" +"82","social-media-like" +"82","datanode" +"82","p3p" +"82","pitch-shifting" +"82","addslashes" +"82","biztalk-2020" +"82","n2cms" +"82","django-reversion" +"82","ora-06550" +"82","awakefromnib" +"82","server-to-server" +"82","puremvc" +"82","react-styleguidist" +"82","django-nose" +"82","gpiozero" +"82","csharp-source-generator" +"82","cryptoswift" +"82","nativeapplication" +"82","puppetlabs-apache" +"82","uploadcare" +"82","modeshape" +"82","mongoose-plugins" +"82","kcfinder" +"82","brain.js" +"82","ensembles" +"82","eaglview" +"82","early-stopping" +"82","interopservices" +"82","htmltools" +"82","posh-git" +"82","input-devices" +"82","poster" +"82","pdfnet" +"82","iobluetooth" +"82","kadanes-algorithm" +"82","poptoviewcontroller" +"82","booksleeve" +"82","nsopenglview" +"82","http-accept-header" +"82","code-rally" +"82","knockout-components" +"82","microsoft-speech-api" +"82","java-batch" +"82","atlassian-fisheye" +"82","mime-mail" +"82","kotlintest" +"82","abpersonviewcontroller" +"82","oboe" +"82","organic-groups" +"82","jasmin" +"82","virtual-device-manager" +"82","shockwave" +"82","audioformat" +"82","typesafe-stack" +"82","mkcoordinateregion" +"82","notification-listener" +"82","xcode7-beta5" +"82","hipchat" +"82","redeclare" +"82","quosure" +"82","ntl" +"82","playstation3" +"82","versions-maven-plugin" +"82","hikvision" +"82","geddy" +"82","gated-recurrent-unit" +"82","gamepad-api" +"82","hashref" +"82","logfile-analysis" +"82","android-junit" +"82","mosaic-plot" +"82","nhibernate-projections" +"82","angular2-material" +"82","spreadsheetml" +"82","cup" +"82","morphing" +"82","menhir" +"82","lazylist" +"82","curly-brackets" +"82","ios7-statusbar" +"82","member-pointers" +"82","lov" +"82","storage-duration" +"82","custom-rom" +"82","stocktwits" +"82","log-level" +"82","react-leaflet-v3" +"82","pyvirtualdisplay" +"82","utf-16le" +"82","parentviewcontroller" +"82","bicubic" +"82","zcat" +"82","iirf" +"82","heartbleed-bug" +"82","ember-rails" +"82","heroku-ci" +"82","mqttnet" +"82","computability" +"82","webpack-hot-middleware" +"82","struts2-convention-plugin" +"82","illegalaccessexception" +"82","sun-codemodel" +"82","dalekjs" +"82","mule-connector" +"82","autogen" +"82","shelljs" +"82","flutter-hooks" +"82","zend-layout" +"82","spark-jdbc" +"82","mui-x-date-picker" +"82","beyondcompare3" +"82","subsonic2.2" +"82","zend-form2" +"82","pressure" +"82","authy" +"82","hdiv" +"81","deepl" +"81","flutter-canvas" +"81","ssreflect" +"81","deepface" +"81","deepstream.io" +"81","cncontactviewcontroller" +"81","multiple-insert" +"81","gitlab-pipelines" +"81","bash4" +"81","flexunit" +"81","phpmd" +"81","xsd-1.0" +"81","jazz" +"81","insmod" +"81","process-monitoring" +"81","feathers-sequelize" +"81","eclipse-3.4" +"81","clickhouse-client" +"81","listbox-control" +"81","apache-commons-lang" +"81","mup" +"81","jbossws" +"81","symbolic-computation" +"81","maptiler" +"81","selectoneradio" +"81","containskey" +"81","selectionmodel" +"81","platform-builder" +"81","syncdb" +"81","addressbookui" +"81","management-studio-express" +"81","cefpython" +"81","lambdify" +"81","packed" +"81","apache-samza" +"81","pandas-bokeh" +"81","fsi" +"81","ibm-jdk" +"81","putimagedata" +"81","sharedarraybuffer" +"81","django-facebook" +"81","vcxproj" +"81","route-me" +"81","wagmi" +"81","vader" +"81","rsa-archer-grc" +"81","windowinsets" +"81","meteor-collections" +"81","kif-framework" +"81","myob" +"81","pdf-annotations" +"81","jquery-bbq" +"81","suphp" +"81","eabi" +"81","android-soong" +"81","azure-devops-wiki" +"81","online-game" +"81","moleculer" +"81","pdf-to-html" +"81","invantive-sql" +"81","opencv-contrib" +"81","jzmq" +"81","opends" +"81","nsfilewrapper" +"81","openfaas" +"81","model-viewer" +"81","android-studio-4.1" +"81","apple-touch-icon" +"81","entity-framework-core-2.2" +"81","sample-size" +"81","typo3-12.x" +"81","osmosis" +"81","system.web.optimization" +"81","pyinotify" +"81","mindate" +"81","riemann" +"81","authenticity-token" +"81","ubuntu-unity" +"81","richeditbox" +"81",".net-reflector" +"81","minhash" +"81","uddi" +"81","codenvy" +"81","sframe" +"81","syndication" +"81","magicsuggest" +"81","nx-workspace" +"81","cocoonjs" +"81","sha-3" +"81","homogenous-transformation" +"81","iterative-deepening" +"81","cactivedataprovider" +"81","ragel" +"81","pmdarima" +"81","nsunknownkeyexception" +"81","xbl" +"81","gwt-designer" +"81","expando" +"81","geckoview" +"81","sceneview" +"81","tdlib" +"81","azure-waf" +"81","hardware-security-module" +"81","gamlss" +"81","bulbs" +"81","nuxt-content" +"81","mkbundle" +"81","ploneformgen" +"81","modeladmin" +"81","angular2-animation" +"81","stm32ldiscovery" +"81","current-time" +"81","propertydescriptor" +"81","elapsed" +"81","comctl32" +"81","google-document-viewer" +"81","pythonw" +"81","personal-access-token" +"81","oggvorbis" +"81","odb" +"81","office-fabric" +"81","textmatching" +"81","persistence-unit" +"81","commandargument" +"81","iphone-3gs" +"81","omr" +"81","leadtools-sdk" +"81","parameterized-types" +"81","zest" +"81","partiql" +"81","hdbscan" +"81","bayeux" +"81","google-ima" +"81","flutter-isar" +"81","image-augmentation" +"81","qtembedded" +"81","mud" +"81","ilspy" +"81","partial-ordering" +"81","web-administration" +"81","font-awesome-4" +"81","gmpy" +"81","pre-compilation" +"81","qttest" +"81","preset" +"81","iiop" +"80","jenkins-x" +"80","print-css" +"80","jena-rules" +"80","babel-node" +"80","dbml" +"80","vue-devtools" +"80","php-gettext" +"80","live-preview" +"80","basehttprequesthandler" +"80","backbarbuttonitem" +"80","weinre" +"80","truecrypt" +"80","removable-storage" +"80","tree-balancing" +"80","backport" +"80","localreport" +"80","xsltforms" +"80","tree-conflict" +"80","xrdp" +"80","selectmanycheckbox" +"80","jsonbuilder" +"80","function-signature" +"80","pivottable.js" +"80","filetree" +"80","frisby.js" +"80","undocumented-behavior" +"80","json-value" +"80","python-stackless" +"80","django-commands" +"80","socketrocket" +"80","adaptive-threshold" +"80","xmldataprovider" +"80","mysqladmin" +"80","jparepository" +"80","dask-ml" +"80","fastly" +"80","psgi" +"80","react-vis" +"80","dash-bootstrap-components" +"80","databricks-workflows" +"80","callbackurl" +"80","crystal-reports-server" +"80","rouge" +"80","serializearray" +"80","uritemplate" +"80","optional-values" +"80","wagtail-snippet" +"80","win32exception" +"80","cryptostream" +"80","hreflang" +"80","coursera-api" +"80","grunt-contrib-requirejs" +"80","boost-signals" +"80","ionic-popup" +"80","invalidargumentexception" +"80","boost-mpi" +"80","twitter-login" +"80","onmouseup" +"80","spring-boot-security" +"80","azure-devtest-labs" +"80","inner-query" +"80","pdf2image" +"80","wsgen" +"80","jqueryform" +"80","wps" +"80","app-launcher" +"80","supabase-flutter" +"80","jxtreetable" +"80","jxtable" +"80","cost-based-optimizer" +"80","aquery" +"80","initrd" +"80","pci-bus" +"80","blazor-hybrid" +"80","wrapall" +"80","nestjs-jwt" +"80","sat-solvers" +"80","postman-newman" +"80","modin" +"80","ocpjp" +"80","system.printing" +"80","outerhtml" +"80","virtual-server" +"80","atmosphere.js" +"80","visual-studio-emulator" +"80","rewritemap" +"80","rfc2445" +"80","libp2p" +"80","osquery" +"80","typedescriptor" +"80","visual-studio-monaco" +"80","formatted-text" +"80","libmosquitto" +"80","kotlin-lateinit" +"80","bsc" +"80","rastervis" +"80","news-ticker" +"80","viewpage" +"80","javax.xml" +"80","system.drawing.imaging" +"80","javax.comm" +"80","code-climate" +"80","nutiteq" +"80","ti-nspire" +"80","referential-transparency" +"80","exitstatus" +"80","sqlresultsetmapping" +"80","hakyll" +"80","dotnet-publish" +"80","android-device-monitor" +"80","jacoco-plugin" +"80","directcompute" +"80","dropdownchoice" +"80","r2winbugs" +"80","bundle-install" +"80","itunes-app" +"80","asp.net-mvc-2-validation" +"80","hive-query" +"80","node-xmpp" +"80","spliterator" +"80","tex-live" +"80","cunit" +"80","colorbrewer" +"80","mozart" +"80","officedown" +"80","string-constant" +"80","acts-as-votable" +"80","dumpsys" +"80","gen-tcp" +"80","google-cloud-data-transfer" +"80","progressive" +"80","stofdoctrineextensions" +"80","ios8.4" +"80","angular-devkit" +"80","mplcursors" +"80","node-amqplib" +"80","cubic-bezier" +"80","qbwc" +"80","tfs-code-review" +"80","ietf-netconf" +"80","arscnview" +"80","cyberduck" +"80","focuslistener" +"80","git-show" +"80","trafficshaping" +"80","gnuwin32" +"80","compoundjs" +"80","id-generation" +"80","linestyle" +"80","ember-cli-addons" +"80","step-into" +"80","mediarecorder-api" +"80","z3c.form" +"80","endl" +"80","quercus" +"80","pre-authentication" +"80","sharp-snmp" +"80","shellexecuteex" +"80","maxscale" +"80","compass-lucene" +"80","mc" +"80","soundjs" +"79","math.sqrt" +"79","groupingby" +"79","grouped-table" +"79","installanywhere" +"79","program-files" +"79","flir" +"79","my.settings" +"79","vue-storefront" +"79","private-constructor" +"79","deflatestream" +"79","sitemapprovider" +"79","ssrs-2019" +"79","multistore" +"79","integrated" +"79","get-winevent" +"79","phash" +"79","map-files" +"79","chokidar" +"79","imp" +"79","child-theming" +"79","rustdoc" +"79","flask-oauthlib" +"79","symmetry" +"79","uniformgrid" +"79","flask-pymongo" +"79","contentful-management" +"79","flask-testing" +"79","contentful-api" +"79","vp9" +"79","cilk-plus" +"79","flamegraph" +"79","picturefill" +"79","socket.io-client" +"79","service-fabric-on-premises" +"79","pugjs" +"79","psi" +"79","windows-phone-7-emulator" +"79","agile-project-management" +"79","pyalgotrade" +"79","reader-monad" +"79","crosstool-ng" +"79","pycparser" +"79","cardano" +"79","robotlegs" +"79","databricks-cli" +"79","django-filer" +"79","readerwriterlockslim" +"79","rtcp" +"79","avvideocomposition" +"79","mysql-error-1241" +"79","updatesourcetrigger" +"79","industrial" +"79","jpl" +"79","dnu" +"79","window-messages" +"79","gpath" +"79","agora" +"79","wikitext" +"79","jpm" +"79","simplexmlrpcserver" +"79","capacity-planning" +"79","aws-credentials" +"79","momentum" +"79","navigationitem" +"79","inputbinding" +"79","pbo" +"79","postal" +"79","kendo-angular-ui" +"79","interval-tree" +"79","bottomsheetdialogfragment" +"79","jquery-scrollable" +"79","swift3.2" +"79","nsformatter" +"79","dynamic-pages" +"79","invokedynamic" +"79","postgresql-extensions" +"79","syndication-feed" +"79","libconfig" +"79","domo" +"79","objective-sharpie" +"79","word-list" +"79","java-opts" +"79","amazon-systems-manager" +"79","libbpf" +"79","system-sounds" +"79","luke" +"79","mailman" +"79","extjs-stores" +"79","anchorpoint" +"79","external-sorting" +"79","system.io.fileinfo" +"79","winsockets" +"79","sfdoctrineguard" +"79","virtual-earth" +"79","overflowexception" +"79","android-espresso-recorder" +"79","aspdotnetstorefront" +"79","tanstack-table" +"79","gcc5" +"79","xamarin.ios-binding" +"79","azure-information-protection" +"79","pnpm-workspace" +"79","handbrake" +"79","noise-generator" +"79","numba-pro" +"79","timelapse" +"79","exponential-backoff" +"79","mklocalsearch" +"79","drillthrough" +"79","noflo" +"79","conversion-tracking" +"79","doubleanimation" +"79","android-handlerthread" +"79","openglcontext" +"79","ischecked" +"79","asp.net-bundling" +"79","railsapps" +"79","dropbox-sdk" +"79","convert-tz" +"79","tcltk" +"79","ojalgo" +"79","custom-activity" +"79","moodle-mobile" +"79","qkeyevent" +"79","text-to-column" +"79","string-agg" +"79","qgroupbox" +"79","ctc" +"79","lostfocus" +"79","http-status" +"79","eunit" +"79","request-validation" +"79","activepivot" +"79","acquia" +"79","testautomationfx" +"79","promotion-code" +"79","angular-custom-validators" +"79","lookbackapi" +"79","spotfire-analyst" +"79","maven-cobertura-plugin" +"79","static-html" +"79","multikey" +"79","vaadin4spring" +"79","automoq" +"79","gnus" +"79","daemonset" +"79","imagebackground" +"79","embedded-kafka" +"79","prefix-sum" +"79","google-maps-mobile" +"79","focusable" +"79","gmsplacepicker" +"79","glkview" +"79","spark-ui" +"79","fody-propertychanged" +"79","gmaps.js" +"78","multiple-input" +"78","fileappender" +"78","sjcl" +"78","mvvm-toolkit" +"78","react-scroll" +"78","vuejs-slots" +"78","jayway" +"78","effective-c++" +"78","declared-property" +"78","jcuda" +"78","skype4py" +"78","anonymize" +"78","declarative-programming" +"78","chrome-extension-manifest-v2" +"78","connectexception" +"78","next-link" +"78","python-gitlab" +"78","apache-storm-topology" +"78","chrome-gcm" +"78","ngx-pagination" +"78","smoothstate.js" +"78","selectpdf" +"78","syncfusion-chart" +"78","unbound" +"78","pipenv-install" +"78","adaptor" +"78","uiviewcontrollerrepresentable" +"78","unidac" +"78","window.onunload" +"78","name-collision" +"78","akka.net-cluster" +"78","puppeteer-cluster" +"78","windowserror" +"78","nanomsg" +"78","cs3" +"78","django-url-reverse" +"78","roboto" +"78","rsk" +"78","servlet-container" +"78","csslint" +"78","django-shell" +"78","keyset" +"78","oprofile" +"78","icefaces-1.8" +"78","csg" +"78","roaming" +"78","nsd" +"78","onmouseclick" +"78","boilerpipe" +"78","dynamic-usercontrols" +"78","jquery-mobile-popup" +"78","desktop-app-converter" +"78","savepoints" +"78","dynamic-class-creation" +"78","jquery-1.7" +"78","dynamic-function" +"78","hpcc-ecl" +"78","appjs" +"78","blockquote" +"78","gulp-imagemin" +"78","jupyter-contrib-nbextensions" +"78","tttattributedlabel" +"78","samsung-knox" +"78","pdfrw" +"78","mollie" +"78","wsod" +"78","azman" +"78","aws-vpn" +"78","couchdb-python" +"78","wrl" +"78","turbo-rails" +"78","go-chi" +"78","codex" +"78","vine" +"78","brakeman" +"78","objective-j" +"78","legacy-sql" +"78","foundry-slate" +"78","orangehrm" +"78","winsound" +"78","midp-2.0" +"78","wm-paint" +"78","lf" +"78","browser-security" +"78","acaccount" +"78","ubuntu-17.04" +"78","diamond-operator" +"78","tokyo-cabinet" +"78","c#-11.0" +"78","timeline.js" +"78","numpy-random" +"78","gwt-editors" +"78","mlxtend" +"78","byte-shifting" +"78","xcode-workspace" +"78","mmapi" +"78","gwtbootstrap3" +"78","ply-file-format" +"78","hammerspoon" +"78","tink" +"78","reentrantreadwritelock" +"78","timthumb" +"78","noncopyable" +"78","uiinclude" +"78","sqlcachedependency" +"78","b2" +"78","android-ndk-r5" +"78","property-placeholder" +"78","custom-build-step" +"78","communication-protocol" +"78","google-cloud-error-reporting" +"78","mpremotecommandcenter" +"78","esqueleto" +"78","actions-builder" +"78","qquickitem" +"78","geographic-distance" +"78","android-log" +"78","cgeventtap" +"78","perforce-stream" +"78","ex" +"78","http-conduit" +"78","lpr" +"78","texttrimming" +"78","zenject" +"78","google-sites-2016" +"78","mqtt-vernemq" +"78","autodesk-construction-cloud" +"78","mscapi" +"78","subforms" +"78","subpixel" +"78","qtandroidextras" +"78","d3plus" +"78","spannablestringbuilder" +"78","subresource-integrity" +"78","md-select" +"78","zend-router" +"78","allegrograph" +"78","tooling" +"78","prawnto" +"78","solr8" +"78","flycheck" +"78","presentation-layer" +"78","msbuildextensionpack" +"77","mate" +"77","wicketstuff" +"77","instaloader" +"77","skins" +"77","weakhashmap" +"77","tensorflow-transform" +"77","react-native-iap" +"77","yajl" +"77","jberet" +"77","mutated" +"77","eclipse-3.5" +"77","maui-android" +"77","webshim" +"77","fibonacci-heap" +"77","pagecontrol" +"77","xmlgregoriancalendar" +"77","check-constraint" +"77","jspsych" +"77","celementtree" +"77","jscs" +"77","next-redux-wrapper" +"77","python-mss" +"77","sendmail.exe" +"77","selenium-webdriver-python" +"77","filter-driver" +"77","packaged-task" +"77","packrat" +"77","pic24" +"77","address-space" +"77","appcenter" +"77","data-vault" +"77","constructor-chaining" +"77","wasm-pack" +"77","angular-template-form" +"77","kendo-treelist" +"77","mysql-error-1242" +"77","kiln" +"77","rolling-sum" +"77","r-portfolioanalytics" +"77","data-comparison" +"77","rp2040" +"77","servlet-mapping" +"77","graniteds" +"77","microsoft-edge-chromium" +"77","type-constructor" +"77","scalajs-react" +"77","core-elements" +"77","jqtree" +"77","mojolicious-lite" +"77","io-completion-ports" +"77","desiredcapabilities" +"77","html-tag-details" +"77","spring-integration-amqp" +"77","jquery-droppable" +"77","nsbuttoncell" +"77","junit-rule" +"77","k" +"77","pcregrep" +"77","jupyter-kernel" +"77","blogger-dynamic-views" +"77","onmeasure" +"77","aqgridview" +"77","port-number" +"77","reverse-ajax" +"77","attachment-fu" +"77","bufferedoutputstream" +"77","magnification" +"77","rational-rsa" +"77","rcs" +"77","netbios" +"77","analytics.js" +"77","seven-segment-display" +"77","vim-airline" +"77","jaro-winkler" +"77","build-time" +"77","ocamlfind" +"77","lemon" +"77","taglist" +"77","redigo" +"77","expression-encoder" +"77","dpi-aware" +"77","gaps-in-data" +"77","butterworth" +"77","notimplementedexception" +"77","plone-5.x" +"77","asp.net-webcontrol" +"77","dsharp+" +"77","halting-problem" +"77","hidpi" +"77","caf" +"77","dspic" +"77","azurekinect" +"77","ragged" +"77","task-runner-explorer" +"77","highland.js" +"77","aspects" +"77","opengrok" +"77","scala-macro-paradise" +"77","cookiejar" +"77","npm-registry" +"77","coloranimation" +"77","elasticsearch-bulk-api" +"77","nitro" +"77","commando" +"77","react-native-chart-kit" +"77","eventqueue" +"77","one2many" +"77","stringwriter" +"77","tomcat-valve" +"77","genshi" +"77","qmodelindex" +"77","google-drive-picker" +"77","custom-code" +"77","geometric-arc" +"77","prometheus-pushgateway" +"77","mouse-picking" +"77","httpcontent" +"77","testng-annotation-test" +"77","ipad-mini" +"77","angular-factory" +"77","com-automation" +"77","acoustics" +"77","array-indexing" +"77","suid" +"77","urn" +"77","qt-mobility" +"77","threadx" +"77","idiorm" +"77","hg-git" +"77","webpack.config.js" +"77","iio" +"77","dagre" +"77","complex-data-types" +"77","statelistdrawable" +"77","ignition" +"77","darkflow" +"77","lineargradientbrush" +"77","areas" +"77","fmp4" +"76","flume-twitter" +"76","react-native-track-player" +"76","multiple-repositories" +"76","gitlab-runner" +"76","traversable" +"76","ballerina-swan-lake" +"76","gridjs" +"76","jcodec" +"76","graphics32" +"76","fenwick-tree" +"76","whiteboard" +"76","princexml" +"76","grecaptcha" +"76","private-pub" +"76","marshalbyrefobject" +"76","tendermint" +"76","interactive-shell" +"76","release-builds" +"76","skflow" +"76","transloadit" +"76","tryton" +"76","prime31" +"76","swiftui-view" +"76","adp" +"76","voltrb" +"76","python-elixir" +"76","db-first" +"76","vmware-server" +"76","chromedp" +"76","softhsm" +"76","connection-leaks" +"76","circos" +"76","json-lib" +"76","advapi32" +"76","app-certification-kit" +"76","xla" +"76","picocontainer" +"76","uitabview" +"76","soaplite" +"76","soappy" +"76","sencha-touch-2.3" +"76","data-oriented-design" +"76","fully-qualified-naming" +"76","vanity-url" +"76","singleton-methods" +"76","servicemanager" +"76","sitecore-ecm" +"76","ibrokers" +"76","robolectric-gradle-plugin" +"76","awkward-array" +"76","waffle-chart" +"76","go-redis" +"76","gpgme" +"76","graceful-shutdown" +"76","goquery" +"76","document-oriented-db" +"76","pub.dev" +"76","microsoft-file-explorer" +"76","dnvm" +"76","go-to-definition" +"76","aws-http-api" +"76","createquery" +"76","django-inheritance" +"76","simpledom" +"76","mylocationoverlay" +"76","r-ranger" +"76","carbon-design-system" +"76","hspec" +"76","wufoo" +"76","appmobi" +"76","grunt-contrib-cssmin" +"76","scala-2.12" +"76","nsfont" +"76","powerapps-selected-items" +"76","axios-mock-adapter" +"76","dynamic-properties" +"76","cox" +"76","eaaccessory" +"76","boost-lambda" +"76","jquery-append" +"76","android-update-app" +"76","infopath-forms-services" +"76","dx" +"76","wlanapi" +"76","extracttextwebpackplugin" +"76","pyobject" +"76","ringtonemanager" +"76","coerce" +"76","javascript-databinding" +"76","bufferstrategy" +"76","javapackager" +"76","javascript-api-for-office" +"76","broken-image" +"76","newid" +"76","typescript1.7" +"76","gomock" +"76","vimperator" +"76","raiseevent" +"76","libalsa" +"76","code-migration" +"76","pytest-fixtures" +"76","domc" +"76","aura-framework" +"76","400-bad-request" +"76","polymer-cli" +"76","nodevalue" +"76","timesten" +"76","cordova-plugin-proguard" +"76","uikeyboardtype" +"76","c1flexgrid" +"76","target-sdk" +"76","gamecontroller" +"76","node-set" +"76","radare2" +"76","gcc7" +"76","drawingcontext" +"76","assetslibrary" +"76","azure-git-deployment" +"76","expired-sessions" +"76","memento" +"76","laravel-snappy" +"76","iqr" +"76","androidpdfviewer" +"76","nmf" +"76","electron-updater" +"76","node-debugger" +"76","iostat" +"76","com4j" +"76","ipcrenderer" +"76","react-google-login" +"76","actionpack" +"76","node-csv-parse" +"76","proxysql" +"76","texmaker" +"76","ironpdf" +"76","elasticsearch-watcher" +"76","c-str" +"76","project-settings" +"76","react-dom-server" +"76","oltp" +"76","longtable" +"76","scriptresource.axd" +"76","identity-aware-proxy" +"76","stdafx.h" +"76","global-temp-tables" +"76","image-file" +"76","zend-server-ce" +"76","flutter-future" +"76","web-application-design" +"76","msr" +"76","google-style-guide" +"76","iis-logs" +"76","igrouping" +"76","arq" +"76","tga" +"76","arpack" +"76","concurrent-processing" +"76","powerbi-api" +"76","touchimageview" +"76","compound-key" +"76","quantlib-swig" +"76","thinktecture" +"76","parsekit" +"76","seal" +"76","prefuse" +"76","thesaurus" +"76","helmfile" +"76","subsystem" +"76","ilasm" +"76","autodesk-navisworks" +"76","thin-client" +"75","cllocationdistance" +"75","clearscript" +"75","grel" +"75","graphical-layout-editor" +"75","ggfortify" +"75","featuretoggle" +"75","react-native-sound" +"75","ansible-module" +"75","antbuilder" +"75","sling-models" +"75","sktextureatlas" +"75","ssh-config" +"75","echosign" +"75","github3.py" +"75","interceptorstack" +"75","easyrtc" +"75","xquery-update" +"75","weak-linking" +"75","apache-commons-collection" +"75","groff" +"75","sql-server-migration-assi" +"75","indesign-server" +"75","fileresult" +"75","front-camera" +"75","jstat" +"75","catransaction" +"75","package-development" +"75","self-updating" +"75","fileprovider" +"75","cdma" +"75","fixnum" +"75","fileversioninfo" +"75","rubinius" +"75","doctrine-mongodb" +"75","airconsole" +"75","kendo-datetimepicker" +"75","aws-data-pipeline" +"75","dnssec" +"75","rosetta" +"75","windows-phone-store" +"75","dockpanel-suite" +"75","windows-phone-8-sdk" +"75","grpc-gateway" +"75","simpleaudioengine" +"75","neopixel" +"75","defragmentation" +"75","entity-framework-plus" +"75","jquery-filter" +"75","gtkbuilder" +"75","popup-blocker" +"75","jquery-mask" +"75","jquery-mobile-button" +"75","boost-iterators" +"75","interleave" +"75","openebs" +"75","bonfire" +"75","internalsvisibleto" +"75","spring-filter" +"75","azure-database-mysql" +"75","native-sql" +"75","html-safe" +"75","workgroup" +"75","nerddinner" +"75","bounded-types" +"75","visual-studio-test-runner" +"75","visual-styles" +"75","lego-mindstorms-ev3" +"75","range-based-loop" +"75","mistral-7b" +"75","jawbone" +"75","cocossharp" +"75","domain-mapping" +"75","pyffmpeg" +"75","code-size" +"75","fragment-caching" +"75","orientjs" +"75","magnitude" +"75",".net-standard-2.1" +"75","video-watermarking" +"75","coinmarketcap" +"75","objective-function" +"75","mirth-connect" +"75","setbounds" +"75","netconnection" +"75","library-path" +"75","openpgp.js" +"75","azure-sas" +"75","explicit-specialization" +"75","nosuchfileexception" +"75","cordova-admob" +"75","openhtmltopdf" +"75","pls-00103" +"75","italics" +"75","uiprintinteractioncntrler" +"75","gcj" +"75","businessworks" +"75","vertex-attributes" +"75","gce-instance-group" +"75","gamma-function" +"75","quickgraph" +"75","uicollectionviewdiffabledatasource" +"75","tao" +"75","dictation" +"75","xbind" +"75","android-flexboxlayout" +"75","uint32-t" +"75","dotpeek" +"75","hill-climbing" +"75","azure-linux" +"75","octokit.net" +"75","exasolution" +"75","http-chunked" +"75","cflags" +"75","android-room-relation" +"75","android-powermanager" +"75","resume-download" +"75","elassandra" +"75","message-handlers" +"75","qmail" +"75","ipad-3" +"75","react-google-recaptcha" +"75","r-dygraphs" +"75","logql" +"75","spooler" +"75","leadfoot" +"75","google-closure-templates" +"75","qhull" +"75","resharper-7.1" +"75","qsharedpointer" +"75","complexheatmap" +"75","foregroundnotification" +"75","cvc4" +"75","toolstripdropdown" +"75","tform" +"75","shedlock" +"75","computer-name" +"75","startapp" +"75","automatonymous" +"75","webkitaudiocontext" +"75","heif" +"75","autovivification" +"75","theforeman" +"75","solr-schema" +"75","aria2" +"75","trackball" +"75","arduino-nano" +"75","dart-analyzer" +"75","pandoc-citeproc" +"75","spark-hive" +"75","qtlocation" +"75","web-analytics-tools" +"74","apache-commons-digester" +"74","jdk1.4" +"74","github-packages" +"74","yahoo-oauth" +"74","tensorflow1.15" +"74","tsconfig-paths" +"74","reporting-services-2012" +"74","sslengine" +"74","fieldtype" +"74","lirc" +"74","listtile" +"74","sqr" +"74","file-import" +"74","babel-plugin" +"74","teamcity-7.1" +"74","skphysicsjoint" +"74","badpaddingexception" +"74","giphy-api" +"74","templavoila" +"74","eeglab" +"74","jedi-vim" +"74","giphy" +"74","react-native-onesignal" +"74","rust-tracing" +"74","nfsclient" +"74","file-organization" +"74","adjustpan" +"74","data-paging" +"74","python-iris" +"74","ownership-semantics" +"74","bit-depth" +"74","apache-nifi-registry" +"74","jsmpp" +"74","fw1" +"74","advanced-rest-client" +"74","pairwise.wilcox.test" +"74","filterrific" +"74","safe-browsing" +"74","dayofmonth" +"74","flask-uploads" +"74","select-for-update" +"74","cheetah" +"74","selection-api" +"74","pinojs" +"74","firephp" +"74","container-registry" +"74","pim" +"74","kura" +"74","josephus" +"74","docker-maven-plugin" +"74","rparallel" +"74","aiortc" +"74","dng" +"74","crm-ribbon-workbench" +"74","kepler.gl" +"74","robocode" +"74","aws-nat-gateway" +"74","facebook-test-users" +"74","r-stars" +"74","rle" +"74","value-categories" +"74","gperftools" +"74","avcomposition" +"74","vector-search" +"74","azure-disk" +"74","jquery-ui-widget-factory" +"74","mod-fastcgi" +"74","gsuite-addons" +"74","svprogresshud" +"74","gulp-karma" +"74","onupdate" +"74","bounding" +"74","nsentitydescription" +"74","spring-batch-job-monitoring" +"74","pebble-js" +"74","cp1251" +"74","dependency-walker" +"74","initial-context" +"74","ensime" +"74","depends" +"74","bosun" +"74","app-offline.htm" +"74","desolve" +"74","poodle-attack" +"74","nsmetadataquery" +"74","destruction" +"74","nsmutableset" +"74","dynamic-ip" +"74","sign-extension" +"74","magnetic-cards" +"74","shadow-root" +"74","virtualfilesystem" +"74","buffer-overrun" +"74",".net-client-profile" +"74","miniprofiler" +"74","kotlinpoet" +"74","libm" +"74","mit-kerberos" +"74","external-script" +"74","network-shares" +"74","libgcrypt" +"74","objloader" +"74","code-separation" +"74","breeze-sharp" +"74","audio-capture" +"74","java-wireless-toolkit" +"74","rethrow" +"74","google-apps-for-education" +"74","tacit-programming" +"74","sqlite-net-pcl" +"74","refcell" +"74","openvas" +"74","aspmenu" +"74","azure-synapse-pipeline" +"74","scaletype" +"74","pocketbase" +"74","aspnet-contrib" +"74","azure-function-app-proxy" +"74","jail" +"74","tinyioc" +"74","itemdatabound" +"74","nsxml" +"74","screencast" +"74","dsl-tools" +"74","drupal-exposed-filter" +"74","sql-server-ce-3.5" +"74","guptateamdeveloper" +"74","taps" +"74","tampering" +"74","openmesh" +"74","speechsynthesizer" +"74","lockbox-3" +"74","mouse-coordinates" +"74","google-email-settings-api" +"74","android-jetifier" +"74","custom-configuration" +"74","persian-calendar" +"74","qframe" +"74","ltac" +"74","strassen" +"74","memory-footprint" +"74","android-listadapter" +"74","meetup" +"74","proteus" +"74","cfbundleidentifier" +"74","perl-hash" +"74","android-market-filtering" +"74","custom-dimensions" +"74","get-display-media" +"74","excel-import" +"74","oidc-client" +"74","common-crawl" +"74","cgcontextdrawimage" +"74","acts-as-list" +"74","accepts-nested-attributes" +"74","userfrosting" +"74","flymake" +"74","user-friendly" +"74","qudpsocket" +"74","total.js" +"74","qtextcursor" +"74","tput" +"74","gmsh" +"74","cwnd" +"74","mediasoup" +"74","torchaudio" +"74","line-count" +"74","subtlecrypto" +"74","statet" +"74","google-tag-manager-server-side" +"74","foldable" +"74","parceler" +"74","image-enhancement" +"74","custom-sort" +"74","sdlc" +"74","composite-types" +"74","zinnia" +"74","stellar.js" +"74","webdatagrid" +"74","sunstudio" +"74","premature-optimization" +"74","arcgis-runtime-net" +"74","im4java" +"73","reorganize" +"73","clang-ast-matchers" +"73","xtify" +"73","tridion2009" +"73","php-parser" +"73","yield-keyword" +"73","react-native-mapbox-gl" +"73","php-imap" +"73","sktilemapnode" +"73","masm64" +"73","remoteio" +"73","cksubscription" +"73","multiprocessor" +"73","dds-format" +"73","transparentproxy" +"73","flutter-dialog" +"73","class-names" +"73","material-components-ios" +"73","laravel-datatables" +"73","pixel-perfect" +"73","apcu" +"73","ftell" +"73","pact-broker" +"73","paddle-paddle" +"73","fixeddocument" +"73","fixed-data-table" +"73","snowball" +"73","imagemagick.net" +"73","langchain-js" +"73","ngzone" +"73","plagiarism-detection" +"73","impromptu" +"73","fill-parent" +"73","xmlstreamreader" +"73","nftables" +"73","umbraco-contour" +"73","ultralytics" +"73","planar-graph" +"73","package-explorer" +"73","cardreader" +"73","contentmode" +"73","fromcharcode" +"73","furrr" +"73","pickerview" +"73","agiletoolkit" +"73","datafeed" +"73","rmiregistry" +"73","unity-interception" +"73","rootless" +"73","kendo-tooltip" +"73","aws-data-wrangler" +"73","mybatis-mapper" +"73","warm-up" +"73","django-endless-pagination" +"73","public-folders" +"73","facebook-requests" +"73","kitematic" +"73","aws-lake-formation" +"73","ahoy" +"73","ruby-2.4" +"73","sequencematcher" +"73","databinder" +"73","jomsocial" +"73","cake-pattern" +"73","sharp-architecture" +"73","pose" +"73","bootstrap5-modal" +"73","hssfworkbook" +"73","mogenerator" +"73","aptitude" +"73","dynamic-feature" +"73","jquery-1.4" +"73","turi-create" +"73","workload" +"73","karnaugh-map" +"73","salesforce-commerce-cloud" +"73","inform7" +"73","sbteclipse" +"73","openalpr" +"73","modifiers" +"73","password-policy" +"73","twitter-feed" +"73","dependency-resolver" +"73","openears" +"73","frank" +"73","lwrp" +"73","wonderware" +"73","sysv" +"73","lejos-nxj" +"73","ordinals" +"73","signedxml" +"73","object-property" +"73","foxit" +"73","magnet-uri" +"73","system.threading.channels" +"73","google-awareness" +"73","facebook-graph-api-v2.2" +"73","system.io.compression" +"73","ubuntu-19.04" +"73","google-api-gateway" +"73","system-center" +"73","ambient" +"73","javapns" +"73","revisions" +"73","pokeapi" +"73","high-contrast" +"73","non-latin" +"73","gcloud-cli" +"73","azure-video-indexer" +"73","dexclassloader" +"73","mockjax" +"73","gemini" +"73","android-doze-and-standby" +"73","td-agent" +"73","openh264" +"73","referrer-policy" +"73","nuclide-editor" +"73","scancodes" +"73","n-triples" +"73","mootools-events" +"73","react-native-component" +"73","google-forms-api" +"73","python-zip" +"73","custom-field-type" +"73","react-calendar" +"73","column-family" +"73","textlabel" +"73","esoteric-languages" +"73","request-cancelling" +"73","qr-decomposition" +"73","google-cloud-filestore" +"73","stopiteration" +"73","peft" +"73","pyviz" +"73","low-level-io" +"73","duplicity" +"73","merkle-tree" +"73","best-fit" +"73","hbmxml" +"73","concrete5-5.7" +"73","betfair" +"73","powerpoint-2007" +"73","concrete" +"73","powershell-7.2" +"73","maven-metadata" +"73","haskell-wai" +"73","multichoiceitems" +"73","textwriter" +"73","maven-eclipse-plugin" +"73","power-saving" +"73","ppapi" +"73","dangerouslysetinnerhtml" +"73","concordion" +"73","tigase" +"73","heapster" +"73","trampolines" +"73","sorm" +"73","iics" +"73","cvs2svn" +"73","ember-controllers" +"73","stetho" +"73","md5-file" +"73","query-analyzer" +"73","google-knowledge-graph" +"73","embedded-ruby" +"73","predictive" +"73","styledtext" +"73","amazon-app-runner" +"73","bgr" +"73","queuing" +"73","flutter-onpressed" +"73","webdev.webserver" +"72","skphysicscontact" +"72","jetson-xavier" +"72","babel-preset-env" +"72","jdbc-pool" +"72","fbsdkloginkit" +"72","srv" +"72","termcap" +"72","weakmap" +"72","stamp" +"72","jdwp" +"72","fennec" +"72","well-formed" +"72","filecontentresult" +"72","matplotlib-venn" +"72","class-instance-variables" +"72","mass" +"72","websphere-9" +"72","phonejs" +"72","fluid-styled-content" +"72","printjs" +"72","clp" +"72","truezip" +"72","flooding" +"72","self-host-webapi" +"72","bit.dev" +"72","admin-generator" +"72","umbraco-blog" +"72","symfony-components" +"72","bisonc++" +"72","freetts" +"72","firemonkey-fm3" +"72","aec" +"72","cilk" +"72","xmlmapper" +"72","impressions" +"72","laravel-envoy" +"72","bitcoin-testnet" +"72","xdist" +"72","pingdom" +"72","addtextchangedlistener" +"72","fiware-cosmos" +"72","page-index-changed" +"72","variable-substitution" +"72","createthread" +"72","simpletransformers" +"72","against" +"72","falcor" +"72","cap-theorem" +"72","narrator" +"72","wcf-callbacks" +"72","readerwriterlock" +"72","serenity-js" +"72","inline-images" +"72","blotter" +"72","guitar" +"72","era5" +"72","sap-data-services" +"72","app-secret" +"72","navigationlink" +"72","postgresql-16" +"72","junit5-extension-model" +"72","app-themes" +"72","sap" +"72","positional-parameter" +"72","mongock" +"72","worker-service" +"72","infinite-recursion" +"72","deform" +"72","svnserve" +"72","simics" +"72","ionide" +"72","coderunner" +"72","sigchld" +"72","colander" +"72","system.exit" +"72","kotlin-dsl" +"72","ksort" +"72","form-post" +"72","with-clause" +"72","mailboxprocessor" +"72","pyes" +"72","windowstate" +"72","magic-quotes-gpc" +"72","google-blockly" +"72","audit-tables" +"72","facebook-fbml" +"72","register-allocation" +"72","openxr" +"72","explicit-constructor" +"72","redux-firestore" +"72","togglz" +"72","bullseye" +"72","scope-resolution" +"72","null-coalescing" +"72","tabulizer" +"72","dfu" +"72","drupal-panels" +"72","hibernate-cache" +"72","device-mapper" +"72","control-center" +"72","scalate" +"72","sqlobject" +"72","tagname" +"72","doxygen-wizard" +"72","logentries" +"72","custom-cursor" +"72","evp-cipher" +"72","pfquerytableviewcontrolle" +"72","charactercount" +"72","pythonxy" +"72","character-replacement" +"72","react-d3" +"72","merb" +"72","angular-compiler-cli" +"72","esprima" +"72","getdirectories" +"72","cubemx" +"72","messagepack" +"72","center-align" +"72","ios8.2" +"72","httrack" +"72","react-ga" +"72","geoviews" +"72","http-host" +"72","olap4j" +"72","mergefield" +"72","commonschunkplugin" +"72","react-fiber" +"72","message-bus" +"72","splunk-sdk" +"72","qradiobutton" +"72","propertyeditor" +"72","stripping" +"72","ilgenerator" +"72","sony-smarteyeglass" +"72","user-preferences" +"72","computer-algebra-systems" +"72","zend-amf" +"72","mci" +"72","bazel-cpp" +"72","structure-from-motion" +"72","utorrent" +"72","fontello" +"72","compatibility-mode" +"72","solace-mq" +"72","urlsearchparams" +"72","parallel-arrays" +"72","weborb" +"72","qt5.2" +"72","parents" +"72","global-hotkey" +"72","emq" +"72","google-managed-vm" +"72","alpn" +"72","stdany" +"71","floppy" +"71","xtratreelist" +"71","vue-meta" +"71","cmsamplebufferref" +"71","cloudways" +"71","flopy" +"71","eclipse-photon" +"71","grid.mvc" +"71","graphql-tag" +"71","photo-upload" +"71","multiple-matches" +"71","slicknav" +"71","react-routing" +"71","youtube.net-api" +"71","web-setup-project" +"71","edititemtemplate" +"71","installation-path" +"71","ssh2-exec" +"71","standardization" +"71","pgvector" +"71","multiple-return-values" +"71","background-repeat" +"71","nextsibling" +"71","pact-lang" +"71","adaptive-bitrate" +"71","xpdf" +"71","cbperipheralmanager" +"71","python-dedupe" +"71","firebug-lite" +"71","distinguishedname" +"71","mainloop" +"71","next-generation-plugin" +"71","implicit-typing" +"71","connectycube" +"71","undefined-variable" +"71","cheminformatics" +"71","pipfile" +"71","firmata" +"71","python-nonlocal" +"71","varcharmax" +"71","alertifyjs" +"71","jni4net" +"71","grafika" +"71","angular-ui-tree" +"71","angular-templatecache" +"71","alarms" +"71","unspecified-behavior" +"71","rmq" +"71","cap" +"71","rpivottable" +"71","jocl" +"71","callable-object" +"71","cakephp-2.7" +"71","kissfft" +"71","facetime" +"71","operationcontract" +"71","pyarmor" +"71","micro-orm" +"71","cradle" +"71","kdoc" +"71","android-shortcut" +"71","cqlengine" +"71","nspersistentdocument" +"71","dynamics-crm-portals" +"71","inquirerjs" +"71","android-studio-bumblebee" +"71","nsorderedset" +"71","delete-record" +"71","popen3" +"71","nesc" +"71","apptrackingtransparency" +"71","applicationhost" +"71","covariant" +"71","opendds" +"71","auth0-lock" +"71","risc" +"71","build-numbers" +"71","minikanren" +"71","ubsan" +"71","signed-integer" +"71","2phase-commit" +"71","pyenv-virtualenv" +"71","2dsphere" +"71","netduino" +"71","rfc2616" +"71","vimeo-android" +"71","winium" +"71","facebook-business-sdk" +"71","google-books-api" +"71","eye-detection" +"71","occlusion" +"71","object-create" +"71","schemaless" +"71","honeywell" +"71","nugetgallery" +"71","ds-5" +"71","redux-devtools-extension" +"71","hilo" +"71","scala-template" +"71","openimaj" +"71","hammingweight" +"71","devicemotion" +"71","gemset" +"71","mkpolygon" +"71","mobile-country-code" +"71","c17" +"71","playing" +"71","targetinvocationexception" +"71","timeslots" +"71","uisearchbardisplaycontrol" +"71","j48" +"71","message-loop" +"71","compact-framework2.0" +"71","spray-client" +"71","cgaffinetransformscale" +"71","angular-fontawesome" +"71","storage-engines" +"71","stripe-payment-intent" +"71","ektorp" +"71","dundas" +"71","mpmediaitemcollection" +"71","cudafy.net" +"71","eventlog-source" +"71","elasticsearch-high-level-restclient" +"71","qqmlapplicationengine" +"71","currentuiculture" +"71","perfview" +"71","prometheus-java" +"71","color-blending" +"71","google-cloud-vpn" +"71","permute" +"71","angular-grid" +"71","long-format-data" +"71","qb64" +"71","lua-5.1" +"71","bep20" +"71","state-diagram" +"71","google-hadoop" +"71","availability-zone" +"71","mdt" +"71","hcl-notes" +"71","webharvest" +"71","parsing-error" +"71","papermill" +"71","automount" +"71","tiktok-api" +"71","query-hints" +"71","glance" +"71","alternative-functor" +"71","quasiquotes" +"71","vaadin-charts" +"71","parrot-os" +"71","bernoulli-probability" +"71","glteximage2d" +"70","jdeps" +"70","trichedit" +"70","program-flow" +"70","processors" +"70","privilege" +"70","cnf" +"70","proc-report" +"70","phpldapadmin" +"70","printstacktrace" +"70","multi-upload" +"70","debug-information" +"70","cldc" +"70","gridex" +"70","ef-power-tools" +"70","mastodon" +"70","lipo" +"70","jform" +"70","react-native-snap-carousel" +"70","feedzirra" +"70","muxer" +"70","anytree" +"70","martini" +"70","cloudamqp" +"70","yellowbrick" +"70","bitronix" +"70","over-the-air" +"70","swinject" +"70","mailtrap" +"70","apache-velocity" +"70","connector-j" +"70","pkg-file" +"70","physijs" +"70","xml-nil" +"70","firebase-polymer" +"70","pageant" +"70","bing-search" +"70","rule-of-three" +"70","lab-color-space" +"70","uitoolbaritem" +"70","vsixmanifest" +"70","pitch-tracking" +"70","adonisjs-ace" +"70","cinemachine" +"70","python-keyring" +"70","adox" +"70","mappoint" +"70","data-lineage" +"70","planetscale" +"70","rxdatasources" +"70","content-editor" +"70","microsoft.codeanalysis" +"70","value-initialization" +"70","watcom" +"70","joined-subclass" +"70","mysql-select-db" +"70","canexecute" +"70","rugged" +"70","variable-templates" +"70","kentico-mvc" +"70","gpg-agent" +"70","rowtype" +"70","josso" +"70","fastled" +"70","document-conversion" +"70","dllnotfoundexception" +"70","aws-backup" +"70","mysql-error-1452" +"70","avcapturemoviefileoutput" +"70","swarmplot" +"70","environments" +"70","blazor-editform" +"70","enquire.js" +"70","ion-range-slider" +"70","android-timer" +"70","sap-xi" +"70","azure-connect" +"70","dynamic-resizing" +"70","azure-dashboard" +"70","ncache" +"70","corrupt-data" +"70","nat-traversal" +"70","wso2-as" +"70","twa" +"70","group-summaries" +"70","awt-eventqueue" +"70","infobubble" +"70","bluetooth-peripheral" +"70","pdfhtml" +"70","forward-list" +"70","typescript-declarations" +"70","netbeans-7.1" +"70","vlc-android" +"70","ktable" +"70","winget" +"70","shift-register" +"70","pyrfc" +"70","audio-converter" +"70","wofstream" +"70","coinbase-php" +"70","richtextblock" +"70","attunity" +"70","system.data.oracleclient" +"70","atlassian-crucible" +"70","codeeffects" +"70","korma" +"70","ocmockito" +"70","viewhelper" +"70","jaxb2-basics" +"70","victory-native" +"70","reward" +"70","vertex-array-object" +"70","radiant" +"70","qutip" +"70","dropbox-sdk-js" +"70","azure-sdk-for-java" +"70","open-session-in-view" +"70","scatterview" +"70","pluck" +"70","dev-null" +"70","sqlcommandbuilder" +"70","uitabcontroller" +"70","tkinter.checkbutton" +"70","drupal-10" +"70","uibackgroundtask" +"70","modalpopups" +"70","directoryindex" +"70","xbox-live" +"70","non-convex" +"70","azure-management" +"70","no-duplicates" +"70","c++builder-xe5" +"70","angular2-form-validation" +"70","angular-content-projection" +"70","react-lifecycle-hooks" +"70","petri-net" +"70","splay-tree" +"70","prolog-setof" +"70","angular-dragdrop" +"70","electron.net" +"70","chaplinjs" +"70","mergeddictionaries" +"70","mesi" +"70","chained-payments" +"70","event-triggers" +"70","ethercat" +"70","stroke-dasharray" +"70","storyblok" +"70","personality-insights" +"70","leaf" +"70","merchant-account" +"70","zypper" +"70","httpentity" +"70","generated-columns" +"70","weblate" +"70","toolstripbutton" +"70","sonarlint-intellij" +"70","google-shopping" +"70","thread-abort" +"70","thanos" +"70","webcam.js" +"70","flutter-sliverappbar" +"70","static-resource" +"70","sumoselect.js" +"70","image-editor" +"70","tibco-rv" +"70","statusstrip" +"70","elmo" +"70","heartrate" +"70","archlinux-arm" +"70","mu" +"70","amazon-comprehend" +"70","autodeploy" +"70","user-activity" +"70","mujoco" +"70","median-of-medians" +"70","parallel-execution" +"70","parasoft" +"70","cyclicbarrier" +"70","parse-javascript-sdk" +"70","powershell-7.3" +"70","zend-soap" +"70","shelveset" +"70","std-span" +"70","solar" +"69","template-aliases" +"69","cloudkit-web-services" +"69","github-actions-runners" +"69","mat-sidenav" +"69","remoteapi" +"69","team-project" +"69","phpdocumentor2" +"69","mathprog" +"69","tempo" +"69","dbo" +"69","ssa" +"69","debug-backtrace" +"69","int128" +"69","stable-sort" +"69","multipass" +"69","related-content" +"69","jcolorchooser" +"69","jax-ws-customization" +"69","transloco" +"69","yank" +"69","trx" +"69","sssd" +"69","xlsread" +"69","disambiguation" +"69","xmlunit-2" +"69","xdgutils" +"69","snipcart" +"69","swiftui-text" +"69","const-char" +"69","app-data" +"69","flask-jwt" +"69","incanter" +"69","swift-structs" +"69","rust-ndarray" +"69","flask-cache" +"69","apng" +"69","consul-template" +"69","catch-all" +"69","self-attention" +"69","pagerduty" +"69","containstable" +"69","python-exec" +"69","camel-http" +"69","myspace" +"69","windows-nt" +"69","roo-gem" +"69","icsharpcode" +"69","jitterbit" +"69","angular-validator" +"69","rollout" +"69","job-control" +"69","redaction" +"69","journaling" +"69","roberta-language-model" +"69","agsxmpp" +"69","realex-payments-api" +"69","fastlane-gym" +"69","serilog-aspnetcore" +"69","csquery" +"69","index-signature" +"69","svg-sprite" +"69","interfacing" +"69","enum-map" +"69","suppression" +"69","dynamic-links" +"69","neoload" +"69","apprtcdemo" +"69","nservicebus5" +"69","jquery-clone" +"69","module-path" +"69","mod-php" +"69","applozic" +"69","applicationdomain" +"69","gstring" +"69","svn-repository" +"69","core-api" +"69","inline-svg" +"69","swift-dictionary" +"69","mongodb-oplog" +"69","houghlinesp" +"69","nshttpcookie" +"69","libgcc" +"69","gollum-wiki" +"69","typo3-4.5" +"69","typst" +"69","ribboncontrolslibrary" +"69","coefplot" +"69","amphp" +"69","reverse-shell" +"69","lexicon" +"69","lexical-cast" +"69","bro" +"69","formats" +"69","fabrication-gem" +"69","kohana-auth" +"69","go-colly" +"69","kraft" +"69","btle" +"69","coingecko" +"69","pysdl2" +"69","visual-c++-2015" +"69","hashids" +"69","nsubiquitouskeyvaluestore" +"69","doxywizard" +"69","azure-webjobs-continuous" +"69","tkinter-scale" +"69","mochiweb" +"69","taint" +"69","hangfire-sql" +"69","mknetworkkit" +"69","scala-swing" +"69","dsolve" +"69","mobx-react-lite" +"69","tinyurl" +"69","spynner" +"69","dremio" +"69","uiimagepngrepresentation" +"69","continuous-fourier" +"69","bulksms" +"69","downloadfileasync" +"69","dotnet-test" +"69","mlpack" +"69","hashbytes" +"69","bulk-email" +"69","harfbuzz" +"69","espressif-idf" +"69","active-relation" +"69","move-assignment-operator" +"69","zscaler" +"69","responsive-filemanager" +"69","lua-5.2" +"69","resharper-9.0" +"69","ios-navigationview" +"69","spreadsheet-protection" +"69","react-cookie" +"69","launching" +"69","excanvas" +"69","accessible" +"69","terraform-provider" +"69","compact-database" +"69","http-status-code-200" +"69","zstack" +"69","spiffs" +"69","motherboard" +"69","chartjs-plugin-zoom" +"69","mercurialeclipse" +"69","tfs-web-access" +"69","ms-project-server-2010" +"69","linked-service" +"69","amazon-redshift-serverless" +"69","query-parser" +"69","qtvirtualkeyboard" +"69","usb4java" +"69","amazon-cloudwatch-events" +"69","amazon-chime" +"69","transactional-email" +"69","iec61131-3" +"69","usermode" +"69","haxelib" +"69","folly" +"68","federated-queries" +"68","apache2-module" +"68","clarion" +"68","relational-operators" +"68","click-through" +"68","flow-js" +"68","defects" +"68","websocket++" +"68","xsbt-web-plugin" +"68","trustmanager" +"68","fedora-23" +"68","webseal" +"68","ggpairs" +"68","slrequest" +"68","match-phrase" +"68","whiptail" +"68","tripadvisor" +"68","function-binding" +"68","major-upgrade" +"68","json2html" +"68","vscodium" +"68","page-break-inside" +"68","xmlhttprequest-level2" +"68","mariadb-10.1" +"68","data-virtualization" +"68","runc" +"68","data-members" +"68","black-box" +"68","laravel-factory" +"68","circuit-sdk" +"68","after-save" +"68","imapclient" +"68","binary-reproducibility" +"68","swiftui-button" +"68","imutils" +"68","admin-ajax" +"68","fs-extra" +"68","kylo" +"68","fixed-length-record" +"68","segment-io" +"68","confirmation-email" +"68","pandas-explode" +"68","date-sorting" +"68","jpa-2.2" +"68","jodd" +"68","url-design" +"68","rsh" +"68","pulsar" +"68","database-server" +"68","winavr" +"68","aws-appsync-resolver" +"68","oracle-fusion-apps" +"68","kgdb" +"68","react-sortable-hoc" +"68","alexa-internet" +"68","watchos-4" +"68","data-handling" +"68","inequalities" +"68","mysql-proxy" +"68","twig-filter" +"68","supplier" +"68","blazor-component" +"68","boost-gil" +"68","tvjs" +"68","inference-engine" +"68","naturallyspeaking" +"68","jquery-migrate" +"68","wp-editor" +"68","hortonworks-dataflow" +"68","sap-r3" +"68","mongo-express" +"68","detekt" +"68","easing-functions" +"68","typed.js" +"68","bootable" +"68","anemic-domain-model" +"68","write-host" +"68","positional-argument" +"68","boost-msm" +"68","nssegmentedcontrol" +"68","hostheaders" +"68","guizero" +"68","jquery-1.5" +"68","dynamic-css" +"68","pdf-lib.js" +"68","go-build" +"68","broadcom" +"68","kotlin-reified-type-parameters" +"68","bringtofront" +"68","android-architecture-lifecycle" +"68","nx.dev" +"68","showdown" +"68","google-appsheet" +"68","type-kinds" +"68","tzinfo" +"68","outlook-object-model" +"68","rbm" +"68","rapache" +"68","amibroker" +"68","3d-engine" +"68","shippo" +"68","known-types" +"68","pygame-clock" +"68","woff2" +"68","wkinterfacecontroller" +"68","wmd-editor" +"68","liblinear" +"68","typesense" +"68","java-security-manager" +"68","sigbus" +"68","macos-system-extension" +"68","digital-ocean-apps" +"68","execute-script" +"68","execute-sql-task" +"68","xcode6-beta6" +"68","tinyscrollbar" +"68","itemcommand" +"68","vibed" +"68","android-for-work" +"68","c++builder-xe7" +"68","xcode8-beta6" +"68","copy-and-swap" +"68","ui-calendar" +"68","dfc" +"68","sqlgeometry" +"68","mlm" +"68","android-chrome" +"68","sqlitemanager" +"68","mockito-kotlin" +"68","c23" +"68","drawbitmap" +"68","isort" +"68","copyonwritearraylist" +"68","timestamping" +"68","strictness" +"68","elgamal" +"68","prophet" +"68","geoalchemy2" +"68","change-management" +"68","string-algorithm" +"68","huggingface-hub" +"68","qdbus" +"68","custom-arrayadapter" +"68","qgraphicstextitem" +"68","splist" +"68","http-kit" +"68","genomicranges" +"68","android-paint" +"68","actor-model" +"68","strawberry-graphql" +"68","comparevalidator" +"68","pendulum" +"68","monochrome" +"68","mosby" +"68","react-memo" +"68","etw-eventsource" +"68","spectral-density" +"68","request-response" +"68","actioncontext" +"68","eventfilter" +"68","angular2-mdl" +"68","protractor-net" +"68","scriptrunner-for-jira" +"68","space-efficiency" +"68","solr-cell" +"68","automocking" +"68","glazedlists" +"68","webarchive" +"68","user-event" +"68","security-testing" +"68","mtproto" +"68","thephpleague" +"68","bias-neuron" +"68","tfjs-node" +"68","liclipse" +"68","imageai" +"68","ijson" +"68","sonarlint-vs" +"68","webdriverjs" +"68","zend-inputfilter" +"68","googletrans" +"68","helpfile" +"68","ember.js-2" +"68","ierrorhandler" +"68","parental-control" +"68","msxsl" +"68","the-little-schemer" +"68","multiboot" +"68","email-forwarding" +"68","utility-method" +"68","secp256k1" +"68","queuetrigger" +"68","concatmap" +"68","emc" +"68","compiled-query" +"67","trusted" +"67","xsi" +"67","fedora20" +"67","fedora-21" +"67","ginkgo" +"67","gini" +"67","github-secret" +"67","git-gc" +"67","webtorrent" +"67","renewal" +"67","gibbon" +"67","github-linguist" +"67","processing-instruction" +"67","clockwork" +"67","profanity" +"67","flutter-animatedlist" +"67","ghost.py" +"67","deepsecurity" +"67","reportmanager" +"67","markupbuilder" +"67","ecj" +"67","multiple-select-query" +"67","integrator" +"67","mutation-events" +"67","yang" +"67","clamav" +"67","reification" +"67","list-comparison" +"67","filemerge" +"67","clipper" +"67","year2038" +"67","sms-verification" +"67","x-macros" +"67","ulong" +"67","apksigner" +"67","aescryptoserviceprovider" +"67","biomart" +"67","finch" +"67","swift-optionals" +"67","mapping-model" +"67","bjyauthorize" +"67","smart-on-fhir" +"67","file-security" +"67","cassandra-4.0" +"67","language-ext" +"67","constraint-layout-chains" +"67","ng-idle" +"67","divio" +"67","chat-gpt-4" +"67","database-cluster" +"67","unmodifiable" +"67","rubular" +"67","angular-redux" +"67","cakephp-3.7" +"67","rowset" +"67","unmanagedresources" +"67","pubspec.yaml" +"67","google-weather-api" +"67","indic" +"67","facebook-workplace" +"67","docker-java" +"67","psr-2" +"67","oracle-adf-mobile" +"67","polyml" +"67","boost-units" +"67","epel" +"67","tweenjs" +"67","justgage" +"67","working-set" +"67","dynamic-analysis" +"67","htmlcontrols" +"67","spring-android" +"67","sweet.js" +"67","nested-documents" +"67","nspredicateeditor" +"67","keccak" +"67","azure-acs" +"67","juno-ide" +"67","pbr" +"67","jquery-ui-timepicker" +"67","azure-cosmosdb-changefeed" +"67","worklight-appcenter" +"67","sangria" +"67","wise" +"67","viewbuilder" +"67","pys60" +"67","librsvg" +"67","code-maintainability" +"67","oauth2-proxy" +"67","siesta-swift" +"67","coda-slider" +"67","abtest" +"67","buildnumber-maven-plugin" +"67","pysal" +"67","android-6.0.1-marshmallow" +"67","netsuite-rest-api" +"67","klee" +"67","retool" +"67","analysisservices" +"67","ucontext" +"67","ras" +"67","lzx" +"67","external-js" +"67","left-to-right" +"67","bs4dash" +"67","vmc" +"67","milestone" +"67","visitors" +"67","object-comparison" +"67","ranged-loops" +"67","pyral" +"67","radiobuttonfor" +"67","nt" +"67","jad" +"67","ntlmv2" +"67","ivyde" +"67","mlrun" +"67","tkinter.optionmenu" +"67","scraperwiki" +"67","button-to" +"67","sqlc" +"67","hilbert-curve" +"67","byval" +"67","scalameta" +"67","openj9" +"67","android-identifiers" +"67","non-linear" +"67","dotted-line" +"67","cache-expiration" +"67","devtoolset" +"67","spree-auth-devise" +"67","accumarray" +"67","laravel-views" +"67","custom-draw" +"67","custom-directive" +"67","google-cloud-trace" +"67","irony" +"67","isam" +"67","stripos" +"67","stringindexoutofbounds" +"67","long-filenames" +"67","lateral" +"67","qhash" +"67","sparse-file" +"67","textreader" +"67","cgbitmapcontextcreate" +"67","oculusgo" +"67","luabridge" +"67","custompaging" +"67","hubspot-crm" +"67","straight-line-detection" +"67","linden-scripting-language" +"67","google-maps-engine" +"67","zomato-api" +"67","thingworx" +"67","google-http-client" +"67","emcee" +"67","concave" +"67","qstandarditem" +"67","thickness" +"67","tilde-expansion" +"67","array-key-exists" +"67","suhosin" +"67","line-height" +"67","berkeley-sockets" +"67","avaudiofile" +"67","stencils" +"67","suggestbox" +"67","cvzone" +"67","compositing" +"66","flixel" +"66","fileloadexception" +"66","materialized" +"66","mathematica-frontend" +"66","feathers-authentication" +"66","cloudcustodian" +"66","mutating-table" +"66","anonymous-users" +"66","intel-mic" +"66","backblaze" +"66","private-messaging" +"66","stagewebview" +"66","multi-page-application" +"66","welcome-file" +"66","graphicscontext" +"66","balloon-tip" +"66","eclipse-ditto" +"66","rendered-attribute" +"66","stack-corruption" +"66","phantom-types" +"66","matconvnet" +"66","jboss-esb" +"66","cmocka" +"66","cleditor" +"66","lmertest" +"66","livescript" +"66","dd-wrt" +"66","clients" +"66","matrix-transform" +"66","musicxml" +"66","matblazor" +"66","skstorereviewcontroller" +"66","declspec" +"66","tsne" +"66","primefaces-mobile" +"66","lmax" +"66","sencha-touch-2.2" +"66","vosk" +"66","js-of-ocaml" +"66","laravel-dompdf" +"66","laravel-admin" +"66","firebase-app-indexing" +"66","data-scrubbing" +"66","managed-property" +"66","cherokee" +"66","cefsharp.offscreen" +"66","segmentedcontrol" +"66","xmltask" +"66","dbaccess" +"66","rosetta-stone" +"66","sitecore7.1" +"66","doi" +"66","django-profiles" +"66","mfp" +"66","docusignapextoolkit" +"66","jgrowl" +"66","rows-affected" +"66","mysqljs" +"66","jhipster-gateway" +"66","sitecollection" +"66","alexa-smart-home-skill" +"66","rlike" +"66","rspec-mocks" +"66","method-parameters" +"66","nativecall" +"66","canalyzer" +"66","vueuse" +"66","icenium" +"66","root-certificate" +"66","camlp4" +"66","wiktionary" +"66","readdirectorychangesw" +"66","servletexception" +"66","agm" +"66","gs1-128" +"66","twitpic" +"66","svg-edit" +"66","ion-select" +"66","openfaces" +"66","early-binding" +"66","dependent-name" +"66","onem2m" +"66","wpf-extended-toolkit" +"66","mom" +"66","appsource" +"66","nsdatadetector" +"66","grunt-contrib-sass" +"66","spring-junit" +"66","swagger-maven-plugin" +"66","table-alias" +"66","ray-tune" +"66","android-architecture" +"66","outer-apply" +"66","kraken.com" +"66","brave-browser" +"66","google-appengine-node" +"66","kotlin-sharedflow" +"66","rancher-desktop" +"66","macvlan" +"66","system.net.sockets" +"66","machine-instruction" +"66","system-alert-window" +"66","magenta" +"66","build-variant" +"66","libgphoto2" +"66","wml" +"66","microsoft-speech-platform" +"66","javascript-marked" +"66","dom-repeat" +"66","pyfftw" +"66","library-design" +"66","bubble.io" +"66","24-bit" +"66","ammonite" +"66","tmuxinator" +"66","jalali-calendar" +"66","targets-r-package" +"66","scanpy" +"66","cookiemanager" +"66","target-action" +"66","sqlitejdbc" +"66","asp.net-core-scaffolding" +"66","time-measurement" +"66","plumatic-schema" +"66","dropnet" +"66","devserver" +"66","spring-social-twitter" +"66","pointer-aliasing" +"66","dialog-preference" +"66","noty" +"66","ispostback" +"66","wxgrid" +"66","tix" +"66","openmeetings" +"66","hal-json" +"66","nsurlcredential" +"66","redisclient" +"66","excellibrary" +"66","google-datastream" +"66","qmdiarea" +"66","protobuf-python" +"66","prolog-findall" +"66","splines" +"66","propel2" +"66","loglog" +"66","google-dl-platform" +"66","ton" +"66","lavalamp" +"66","cfqueryparam" +"66","mellanox" +"66","google-cloud-code" +"66","http-status-code-204" +"66","hugs" +"66","iota" +"66","layout-animation" +"66","memory-optimized-tables" +"66","nlua" +"66","lstm-stateful" +"66","launch-agent" +"66","commutativity" +"66","angularjs-bindings" +"66","cssom" +"66","locomotivejs" +"66","colima" +"66","prepros" +"66","sublime-anaconda" +"66","google-maps-urls" +"66","automated-deployment" +"66","elmish" +"66","lifelines" +"66","solidworksapi" +"66","panresponder" +"66","urlvariables" +"66","webengine" +"66","line-profiler" +"66","google-pagespeed-insights-api" +"66","zoneinfo" +"66","web-garden" +"66","parallel-python" +"66","ie8-browser-mode" +"66","mdbreact" +"66","linearization" +"66","urlrewriter.net" +"65","report-builder2.0" +"65","jaxws-maven-plugin" +"65","ed" +"65","materialbutton" +"65","jenkins-build-flow" +"65","cluetip" +"65","skpaymenttransaction" +"65","react-native-webrtc" +"65","ecmascript-2020" +"65","local-class" +"65","react-native-swiper" +"65","react-native-permissions" +"65","defaultbutton" +"65","git-interactive-rebase" +"65","troposphere" +"65","getstream-chat" +"65","cloudwatch" +"65","instagram-story" +"65","vue-mixin" +"65","background-transfer" +"65","aos.js" +"65","principles" +"65","matlab-load" +"65","classloading" +"65","multiple-entries" +"65","pg-trgm" +"65","react-native-drawer" +"65","teamsite" +"65","wii" +"65","mapinfo" +"65","directxtk" +"65","switch-expression" +"65","apache-toree" +"65","snapping" +"65","xposed-framework" +"65","markitup" +"65","ngx-extended-pdf-viewer" +"65","apache-royale" +"65","firebird-.net-provider" +"65","db2-connect" +"65","adehabitathr" +"65","incoming-mail" +"65","jsvc" +"65","kube-prometheus-stack" +"65","l2tp" +"65","django-ajax-selects" +"65","jsperf" +"65","distcc" +"65","jsdt" +"65","funq" +"65","pivotaltracker" +"65","afp" +"65","python-regex" +"65","bit-packing" +"65","pades" +"65","disnake" +"65","function-fitting" +"65","pixel-density" +"65","px4" +"65","go-sqlmock" +"65","readable" +"65","iban" +"65","jpda" +"65","hyperledger-fabric-sdk-go" +"65","value-class" +"65","icepdf" +"65","recursive-type" +"65","docker-exec" +"65","cross-origin-resource-policy" +"65","database-view" +"65","django-notification" +"65","rss2" +"65","microsoft-forms" +"65","cross-cutting-concerns" +"65","roundtrip" +"65","mysql-x-devapi" +"65","server-side-attacks" +"65","datadirectory" +"65","n-api" +"65","metis" +"65","candlesticks" +"65","factor-lang" +"65","docxtemplater" +"65","jqmobi" +"65","input-parameters" +"65","spring-mvc-initbinders" +"65","dynamic-ui" +"65","opencv-mat" +"65","design-view" +"65","swift-framework" +"65","password-manager" +"65","iolanguage" +"65","guard-clause" +"65","openconnect" +"65","application-verifier" +"65","android-studio-4.2" +"65","wscript.shell" +"65","patroni" +"65","html-object" +"65","android-studio-3.6" +"65","insecure-connection" +"65","apple-app-site-associate" +"65","dynamic-script-loading" +"65","onejar" +"65","payflowlink" +"65","risk-analysis" +"65","visual-prolog" +"65","ripgrep" +"65",".emf" +"65","codenarc" +"65","rave-reports" +"65","microsoft-graph-intune" +"65","for-json" +"65","libarchive" +"65","fortran2008" +"65","browser-console" +"65","viewmodifier" +"65","viridis" +"65","codehighlighter" +"65","wolfssl" +"65",".aspxauth" +"65","ammo.js" +"65","gccgo" +"65","rails-3.1" +"65","asp.net-development-serv" +"65","handlebars.java" +"65","schema-migration" +"65","non-alphanumeric" +"65","draggesture" +"65","reflex" +"65","dijit.tree" +"65","cookielib" +"65","regex-replace" +"65","rack-middleware" +"65","numpy-indexing" +"65","hive-udf" +"65","android-gravity" +"65","nme" +"65","pg8000" +"65","ipojo" +"65","mpi-io" +"65","lpt" +"65","esri-leaflet" +"65","geosparql" +"65","memory-warning" +"65","pywavelets" +"65","android-jack-and-jill" +"65","react-native-community-netinfo" +"65","perl-pod" +"65","cfgrid" +"65","eulers-number" +"65","reactive-kafka" +"65","qmetaobject" +"65","comonad" +"65","leaflet-geoman" +"65","iphoto" +"65","message-listener" +"65","coldfusion-7" +"65","omniorb" +"65","stringgrid" +"65","custom-backend" +"65","billboard.js" +"65","statamic" +"65","global-state" +"65","google-nearby-connections" +"65","gnn" +"65","heaps-algorithm" +"65","amazon-cognito-facebook" +"65","gl-triangle-strip" +"65","cvi" +"65","foolproof-validation" +"65","authzforce" +"65","automapper-4" +"65","styleddocument" +"65","google-pie-chart" +"65","ido" +"65","foreign-collection" +"65","qt5.9" +"65","ie-automation" +"65","quantization-aware-training" +"65","flutter-in-app-purchase" +"65","paredit" +"65","sparkcore" +"65","mqtt.js" +"65","git-shell" +"65","std-future" +"65","tr24731" +"65","medium-editor" +"65","linker-warning" +"65","zend-tool" +"65","stm32h7" +"64","phpexcel-1.8.0" +"64","github-release" +"64","cldr" +"64","yara" +"64","react-native-sqlite-storage" +"64","trivy" +"64","remotecommand" +"64","back-button-control" +"64","matroska" +"64","photologue" +"64","ffbase" +"64","profile-picture" +"64","great-firewall-of-china" +"64","marko" +"64","intel-mpi" +"64","vuetify-datatable" +"64","c-libraries" +"64","liquid-template" +"64","yii-widgets" +"64","snowfall" +"64","kubernetes-rbac" +"64","addin-express" +"64","ccaction" +"64","implicit-declaration" +"64","adodb-php" +"64","django-cron" +"64","chronoforms" +"64","ovirt" +"64","pixel-bender" +"64","adxstudio-portals" +"64","xdr" +"64","function-approximation" +"64","bionic" +"64","full-table-scan" +"64","flashback" +"64","apollo-cache-inmemory" +"64","managed-directx" +"64","first-chance-exception" +"64","smoke-testing" +"64","xhtml-transitional" +"64","pipedrive-api" +"64","palm" +"64","alex" +"64","dojo-build" +"64","ptc-windchill" +"64","alfred" +"64","datafield" +"64","dataflow-diagram" +"64","nanoframework" +"64","routetable" +"64","documentum6.5" +"64","rstanarm" +"64","docbook-5" +"64","jil" +"64","venmo" +"64","google-website-optimizer" +"64","rope" +"64","nativewind" +"64","negamax" +"64","opc-da" +"64","enterprise-library-6" +"64","nesper" +"64","nservicebus-sagas" +"64","bootstrap-tokenfield" +"64","spring-data-mongodb-reactive" +"64","android-virtual-keyboard" +"64","spring-data-envers" +"64","dynamics-ax7" +"64","modi" +"64","axacropdf" +"64","tufte" +"64","axis2c" +"64","hp-nonstop" +"64","inherited-widget" +"64","delicious-api" +"64","boofcv" +"64","entity-framework-core-migrations" +"64","onos" +"64","pdl" +"64","cosign-api" +"64","woocommerce-memberships" +"64","object-serialization" +"64","orchardcms-1.10" +"64","winnovative" +"64","accent-insensitive" +"64","osisoft" +"64","r-googlesheets" +"64","sigfpe" +"64","vline" +"64","godeps" +"64","libimobiledevice" +"64","goo.gl" +"64","asyncapi" +"64","wm-copydata" +"64","rangevalidator" +"64","lvalue-to-rvalue" +"64","misspelling" +"64","typescript-class" +"64","ripple-effect" +"64","visual-c++-2013" +"64","nethereum" +"64","facebook-feed" +"64","virtual-desktop" +"64","numpydoc" +"64","refile" +"64","dhall" +"64","dotnet-aspire" +"64","bybit" +"64","sqlbase" +"64","scalapack" +"64","rabbitmq-shovel" +"64","coords" +"64","xcodeproj" +"64","point-of-interest" +"64","nsvalue" +"64","dreamfactory" +"64","redmi-device" +"64","uiinputviewcontroller" +"64","handoff" +"64","gaps-in-visuals" +"64","sqlite-json1" +"64","pnotify" +"64","numeric-keypad" +"64","exchange-server-2016" +"64","taffydb" +"64","tao-framework" +"64","openoffice-base" +"64","ironsource" +"64","motorola-droid" +"64","geoip2" +"64","spreadsheetlight" +"64","nls-lang" +"64","iri" +"64","spfx-extension" +"64","angular-daterangepicker" +"64","google-domain-api" +"64","nlu" +"64","android-jetpack-compose-layout" +"64","geom-hline" +"64","exadata" +"64","performance-monitor" +"64","customer-account-data-api" +"64","respond.js" +"64","resty-gwt" +"64","electron-react-boilerplate" +"64","node-orm2" +"64","ldflags" +"64","mule-cluster" +"64","arithmeticexception" +"64","partial-postback" +"64","scriptella" +"64","pantheon" +"64","web-architecture" +"64","stateserver" +"64","dandelion" +"64","mrunit" +"64","fluxcd" +"64","zend-date" +"64","autogeneratecolumn" +"64","autogrow" +"64","amazon-appflow" +"64","qstyle" +"64","git-untracked" +"64","secure-crt" +"64","starscream" +"64","scrollcontroller" +"64","glitch-framework" +"64","alivepdf" +"64","articulate-storyline" +"64","uwamp" +"63","web-share" +"63","github-codereviews" +"63","background-application" +"63","reportng" +"63","xvalue" +"63","tealium" +"63","ef-model-builder" +"63","ssziparchive" +"63","template-inheritance" +"63","ssg" +"63","reportgenerator" +"63","mxe" +"63","graphical-programming" +"63","localtunnel" +"63","backbone-forms" +"63","ssao" +"63","private-inheritance" +"63","smartadmin" +"63","greenhills" +"63","fhir-server-for-azure" +"63","process-explorer" +"63","webpagetest" +"63","react-native-linking" +"63","apache-beam-kafkaio" +"63","llvmlite" +"63","liveedit" +"63","xml-dml" +"63","packageinstaller" +"63","p6spy" +"63","xoom" +"63","unit-type" +"63","umbraco-ucommerce" +"63","imap-open" +"63","uncaught-reference-error" +"63","mantissa" +"63","xlabs" +"63","fstab" +"63","python-textfsm" +"63","distribution-list" +"63","xinetd" +"63","adminjs" +"63","datamodule" +"63","jscience" +"63","fitsharp" +"63","flask-script" +"63","choetl" +"63","cim" +"63","smartsvn" +"63","pixelate" +"63","data-tier-applications" +"63","cielab" +"63","microsoft-ajax" +"63","angularjs-ng-class" +"63","fantom" +"63","wcf-routing" +"63","go-zap" +"63","rubaxa-sortable" +"63","rubber-band" +"63","shared-data" +"63","rtems" +"63","kitti" +"63","sitecore-workflow" +"63","named-graphs" +"63","mysql-error-1146" +"63","vwdexpress" +"63","angular-material-datetimepicker" +"63","granularity" +"63","graaljs" +"63","server-rendering" +"63","datahandler" +"63","wamp64" +"63","myget" +"63","aggregateexception" +"63","invitation" +"63","html-help" +"63","type-2-dimension" +"63","httpapplication" +"63","sast" +"63","nested-map" +"63","jump-table" +"63","boost-coroutine" +"63","android-unity-plugin" +"63","apps-for-office" +"63","pdfpages" +"63","azure-devops-hosted-agent" +"63","svndump" +"63","deployment-target" +"63","nats-jetstream" +"63","passport-twitter" +"63","delphi-ide" +"63","springlayout" +"63","houdini" +"63","blockchain.info-api" +"63","saxon-js" +"63","android-speech-api" +"63","appstorage" +"63","cppyy" +"63","nservicebus3" +"63","ws-client" +"63","visual-artifacts" +"63","fortrabbit" +"63","browsershot" +"63","ratchet-2" +"63","system.security" +"63","richtextfx" +"63","8thwall-xr" +"63","libmemcache" +"63","ableton-live" +"63","objectscript" +"63","2048" +"63","object-to-string" +"63","tablefilter" +"63","vimage" +"63","cocos2d-html5" +"63","osqa" +"63","vms" +"63","google-bucket" +"63","rd" +"63","authority" +"63","rgui" +"63","go-map" +"63","typo3-7.x" +"63","tablegateway" +"63","rcw" +"63","outlook-for-mac" +"63","ocra" +"63","coco" +"63","attr-encrypted" +"63",".net-4.7.1" +"63","rauth" +"63","shred" +"63","retro-computing" +"63","luminance" +"63","retrywhen" +"63","virtual-network" +"63","wordcloud2" +"63","oas" +"63",".npmrc" +"63","vidyo" +"63","redeclaration" +"63","contracts" +"63","uiprogressbar" +"63","directfb" +"63","contiki-ng" +"63","j#" +"63","timeofday" +"63","nullif" +"63","dotcmis" +"63","dtf" +"63","item-decoration" +"63","mo" +"63","harmon.ie" +"63","qurl" +"63","gatling-plugin" +"63","uisearchresultscontroller" +"63","gdataxml" +"63","mobilefirst-appcenter" +"63","coordinator-pattern" +"63","harp" +"63","azure-site-recovery" +"63","general-network-error" +"63","table-structure" +"63","openmq" +"63","asp.net-webhooks" +"63","oneclick" +"63","mpiexec" +"63","pfrelation" +"63","terraform-aws-modules" +"63","android-pagetransformer" +"63","ofx" +"63","get-mapping" +"63","collapsiblepanelextender" +"63","perl-critic" +"63","leadbolt" +"63","generic-type-parameters" +"63","qpropertyanimation" +"63","qproperty" +"63","http-unit" +"63","tesselation" +"63","test-class" +"63","elixir-poison" +"63","strongswan" +"63","member-access" +"63","logos" +"63","react-hoc" +"63","tomcat-jdbc" +"63","google-shared-contacts" +"63","ember-octane" +"63","lifo" +"63","quectel" +"63","asammdf" +"63","mecab" +"63","auto-close" +"63","structlog" +"63","pascalcasing" +"63","iis-manager" +"63","embedded-browser" +"63","illegal-instruction" +"63","qualified-name" +"63","zabbix-api" +"63","qtplugin" +"63","elpy" +"63","haskell-mode" +"63","mediabrowserservicecompat" +"63","querypath" +"63","seesaw" +"63","parameterized-tests" +"63","complex-networks" +"63","powerdns" +"63","beancreationexception" +"63","focusmanager" +"63","zendesk-app" +"63","flutterwave" +"63","alibaba-cloud-ecs" +"63","arbor.js" +"62","apache-commons-daemon" +"62","debugview" +"62","photon-pun" +"62","apache-commons-codec" +"62","install-name-tool" +"62","sql-server-json" +"62","loadnibnamed" +"62","llama-cpp-python" +"62","tritium" +"62","instantiationexception" +"62","load-path" +"62","photosphere" +"62","easyslider" +"62","clique-problem" +"62","master-data-management" +"62","massif" +"62","gh-unit" +"62","mwphotobrowser" +"62","graphql-schema" +"62","clientbundle" +"62","when-js" +"62","skyscanner" +"62","xunit2" +"62","private-network" +"62","mathquill" +"62","default-interface-member" +"62","deface" +"62","vows" +"62","chomsky-normal-form" +"62","running-count" +"62","s3-kafka-connector" +"62","nhibernate-envers" +"62","dbfit" +"62","appgyver" +"62","pkgdown" +"62","umbraco5" +"62","labwindows" +"62","ims" +"62","pintos" +"62","adgroup" +"62","unchecked-exception" +"62","addobserver" +"62","xhprof" +"62","uncss" +"62","fiware-wilma" +"62","makie.jl" +"62","pancakeswap" +"62","binlog" +"62","firefox-quantum" +"62","windows-2000" +"62","hyperledger-caliper" +"62","dll-reference" +"62","windows-rs" +"62","camel-cxf" +"62","albumentations" +"62","update-site" +"62","ropensci" +"62","routerlinkactive" +"62","rprofile" +"62","database-diagram" +"62","pvs-studio" +"62","meta-predicate" +"62","simpsons-rule" +"62","reasoner" +"62","pure-css" +"62","kendo-validator" +"62","vaapi" +"62","rpython" +"62","keypaths" +"62","nagiosxi" +"62","unity-web-player" +"62","universal-reference" +"62","kepler" +"62","name-clash" +"62","jquery-ui-touch-punch" +"62","keepass" +"62","box-sizing" +"62","aws-sdk-js-v3" +"62","wsdualhttpbinding" +"62","counterclockwise" +"62","jxta" +"62","juggernaut" +"62","hpcc" +"62","www-authenticate" +"62","dynamic-type-feature" +"62","jqtransform" +"62","on-premises-instances" +"62","initializecomponent" +"62","pdp" +"62","jquery-mobile-navbar" +"62","poplib" +"62","spring-initializr" +"62","lucidworks" +"62","setrlimit" +"62","lucid" +"62","audio-worklet" +"62","windows-users" +"62","form-load" +"62","go-context" +"62","buildah" +"62","visual-studio-app-center-distribute" +"62","audiovideoplayback" +"62","libnet" +"62","android-autofill-manager" +"62","kotlin-js-interop" +"62","google-api-javascript-client" +"62","pyngrok" +"62","ubuntu-9.04" +"62","lgpl" +"62","java-19" +"62","viewdidunload" +"62","mailcatcher" +"62","system-requirements" +"62","visionkit" +"62","facebook-messages" +"62","build-events" +"62","android-4.1-jelly-bean" +"62","virtualalloc" +"62","vlang" +"62","driver-signing" +"62","jacorb" +"62","exe4j" +"62","poller" +"62","versioninfo" +"62","dredd" +"62","contextroot" +"62","highcharts-gantt" +"62","bump-mapping" +"62","playstation" +"62","hardware-id" +"62","scala-xml" +"62","azure-media-player" +"62","redistogo" +"62","pointerlock" +"62","modal-view" +"62","playorm" +"62","exchange-online" +"62","excel-lambda" +"62","gvnix" +"62","assisted-inject" +"62","directory-permissions" +"62","digital-persona-sdk" +"62","dotmemory" +"62","quicksight-embedding" +"62","azure-stack" +"62","mkmapitem" +"62","opennebula" +"62","redcloth" +"62","android-custom-attributes" +"62","gant" +"62","gdax-api" +"62","pocket" +"62","terratest" +"62","generic-variance" +"62","iperf3" +"62","textctrl" +"62","ironworker" +"62","eula" +"62","perfect-hash" +"62","lastpass" +"62","okta-signin-widget" +"62","property-injection" +"62","google-cloud-pubsub-emulator" +"62","spookyjs" +"62","custom-attribute" +"62","node-html-pdf" +"62","lpcwstr" +"62","strtod" +"62","csvwriter" +"62","project-panama" +"62","eventtocommand" +"62","omegaconf" +"62","toolsapi" +"62","use-form" +"62","predix" +"62","security-policy" +"62","msbuild-target" +"62","authorized-keys" +"62","scxml" +"62","alter-column" +"62","soundfile" +"62","papertrail-app" +"62","zend-config" +"62","autobean" +"62","google-maps-styling" +"62","usmap" +"62","zend-http-client" +"62","auto-responder" +"62","imagedata" +"62","auto-route" +"62","tortoisecvs" +"62","image-clipping" +"62","user-variables" +"62","authsub" +"62","scriptlab" +"62","structural-pattern-matching" +"62","trailblazer" +"62","beast" +"62","mser" +"62","tilelist" +"62","thunderclient" +"62","userdetailsservice" +"61","phpdocx" +"61","stanza" +"61","vue-formulate" +"61","prism-5" +"61","sql-server-native-client" +"61","maui-ios" +"61","intellij-idea-2016" +"61","phpdesktop" +"61","matisse" +"61","installscript-msi" +"61","edb" +"61","background-sync" +"61","fluentftp" +"61","apache-directory" +"61","github-ci" +"61","react-pdfrenderer" +"61","r-environment" +"61","git-annex" +"61","marklogic-7" +"61","fieldofview" +"61","php-pest" +"61","integromat-apps" +"61","wgsl" +"61","slack-dialog" +"61","yourls" +"61","babel-cli" +"61","github-oauth" +"61","skphysicsworld" +"61","insertadjacenthtml" +"61","xemacs" +"61","frombodyattribute" +"61","swiftui-ontapgesture" +"61","swiftui-previews" +"61","dirty-data" +"61","paceautomationframework" +"61","xmpppy" +"61","swirl" +"61","swift-nio" +"61","rythm" +"61","adal4j" +"61","nexus-prisma" +"61","chomp" +"61","dataspell" +"61","rsl" +"61","akka-remoting" +"61","dmp" +"61","session-fixation" +"61","recent-file-list" +"61","rtl-sdr" +"61","oracle-rest-data-services" +"61","docx-mailmerge" +"61","go-pg" +"61","jnativehook" +"61","cryptarithmetic-puzzle" +"61","name-decoration" +"61","unreachable-statement" +"61","upstream-branch" +"61","oracleapplications" +"61","aws-s3-client" +"61","variants" +"61","fast-csv" +"61","angular-ng-class" +"61","urbancode" +"61","serverless-application-model" +"61","rtcmulticonnection" +"61","dlookup" +"61","windows-clustering" +"61","meteor-packages" +"61","postgresql-8.3" +"61","aws-vpc-peering" +"61","hotjar" +"61","supertype" +"61","core-file" +"61","popsql" +"61","dynamics-crm-365-v9" +"61","neo4j-java-api" +"61","nscursor" +"61","dvorak" +"61","erlang-nif" +"61","html-generation" +"61","pdf-writer" +"61","neo4j-browser" +"61","pausing-execution" +"61","azure-cosmosdb-tables" +"61","aptos" +"61","applicationcontroller" +"61","post-conditions" +"61","passport-local-mongoose" +"61","botman" +"61","nested-views" +"61","desctools" +"61","jwrapper" +"61","gulp-typescript" +"61","deselect" +"61","sap-successfactors" +"61","epoxy" +"61","modifier-key" +"61","silent-notification" +"61","java-calendar" +"61","video-upload" +"61","amp-list" +"61","codemirror-modes" +"61","fortran-common-block" +"61","wmi-service" +"61","codacy" +"61","attach-to-process" +"61","system-tables" +"61","google-app-engine-go" +"61","kotlinc" +"61","systemcolors" +"61","uci" +"61","midje" +"61","breakpoint-sass" +"61","word-2003" +"61","udeploy" +"61","rfc2822" +"61","formmail" +"61","knockout-templating" +"61","magento-layout-xml" +"61","abseil" +"61","codesourcery" +"61","knp-snappy" +"61","codeanywhere" +"61","maemo" +"61","bulk-operations" +"61","dotnet-tool" +"61","historian" +"61","convention-over-configur" +"61","gchart" +"61","drupal-comments" +"61","context-switching" +"61","gcloud-python" +"61","drbd" +"61","radchart" +"61","model-driven-development" +"61","android-image-capture" +"61","gated-checkin" +"61","mod-dav-svn" +"61","quick-search" +"61","modelbinder" +"61","r6rs" +"61","redux-mock-store" +"61","non-unicode" +"61","xamarin.forms.maps" +"61","npm-shrinkwrap" +"61","export-to-xml" +"61","sql-server-group-concat" +"61","tcpreplay" +"61","nsvaluetransformer" +"61","xctestexpectation" +"61","nsurlerrordomain" +"61","gwt-bootstrap" +"61","genson" +"61","node-config" +"61","officewriter" +"61","spreadjs" +"61","lowest-common-ancestor" +"61","respect-validation" +"61","ipaf" +"61","office-communicator" +"61","resiliency" +"61","zurb-joyride" +"61","hungarian-notation" +"61","hung" +"61","custom-event" +"61","locked-files" +"61","comfortable-mexican-sofa" +"61","android-layout-editor" +"61","project-loom" +"61","httpoison" +"61","njsonschema" +"61","colon-equals" +"61","angular-cli-v8" +"61","android-photoview" +"61","moped" +"61","geom-vline" +"61","elementary-os" +"61","react-image" +"61","cfform" +"61","resource-scheduling" +"61","tiki-wiki" +"61","hcaptcha" +"61","security-framework" +"61","msflexgrid" +"61","sttwitterapi" +"61","cyber-panel" +"61","lineseries" +"61","dacl" +"61","emblem.js" +"61","asciidoctor-pdf" +"61","font-style" +"61","stdev" +"61","auto-keras" +"61","allocatable-array" +"61","autoit-c#-wrapper" +"61","google-play-internal-testing" +"61","concourse-pipeline" +"61","flutter-positioned" +"61","tracesource" +"61","haystack" +"61","search-engine-bots" +"61","web-console" +"60","websolr" +"60","yearmonth" +"60","echonest" +"60","sitefinity-4" +"60","antenna-house" +"60","f-bounded-polymorphism" +"60","ant-colony" +"60","multitexturing" +"60","file-in-use" +"60","squishit" +"60","dbms-job" +"60","web-search" +"60","feature-flags" +"60","smalldatetime" +"60","slugify" +"60","react-snap" +"60","render-to-string" +"60","defer-keyword" +"60","skeleton-code" +"60","trellis" +"60","jdk6" +"60","widgetliveactivity" +"60","clicking" +"60","proget" +"60","flutter-aws-amplify" +"60","jet-sql" +"60","apache-apisix" +"60","tronweb" +"60","marklogic-optic-api" +"60","skobbler-maps" +"60","symfony-http-foundation" +"60","disclosure" +"60","imeoptions" +"60","datarelation" +"60","xproc" +"60","jsqlparser" +"60","marker-interfaces" +"60","conftest" +"60","jsr330" +"60","software-update" +"60","mappedbytebuffer" +"60","jscodeshift" +"60","s3distcp" +"60","circuit-diagram" +"60","image-replacement" +"60","piracy" +"60","flaui" +"60","jsforce" +"60","bindableproperty" +"60","ng-app" +"60","imageprocessor" +"60","xpack" +"60","firemonkey-fm2" +"60","datanitro" +"60","database-scan" +"60","gps-time" +"60","read-replication" +"60","servicepointmanager" +"60","jinput" +"60","django-rq" +"60","alfresco-maven" +"60","windows-phone-toolkit" +"60","until-loop" +"60","wcffacility" +"60","facebook-stream-story" +"60","react-to-print" +"60","psalm-php" +"60","alglib" +"60","algorand" +"60","keymaps" +"60","joomla-article" +"60","jooq-codegen" +"60","wasi" +"60","factoring" +"60","angular-loopback" +"60","react-tabs" +"60","oppo" +"60","warc" +"60","angular-nativescript" +"60","avisynth" +"60","cal" +"60","spring-cloud-bus" +"60","ionic-vue" +"60","azkaban" +"60","jrun" +"60","onitemlongclicklistener" +"60","spring-data-commons" +"60","boost-spirit-lex" +"60","scala-generics" +"60","html-components" +"60","axshockwaveflash" +"60","appstats" +"60","sap-cap" +"60","dx-data-grid" +"60","initramfs" +"60","path-separator" +"60","mongodb-nodejs-driver" +"60","interface-segregation-principle" +"60","azure-appfabric" +"60","popviewcontrolleranimated" +"60","nscontrol" +"60","apple-pdfkit" +"60","azure-elastic-scale" +"60","mido" +"60","set-comprehension" +"60","shogun" +"60","rfc5766turnserver" +"60","pyroot" +"60","pylatex" +"60","jasper-plugin" +"60","microsoft-graph-onenote" +"60","signaling" +"60","vista64" +"60","miracast" +"60","network-service" +"60","riak-search" +"60","typeddict" +"60","libressl" +"60","ably-realtime" +"60","gofmt" +"60","google-app-indexing" +"60","t3" +"60","ntpd" +"60","non-modal" +"60","associated-object" +"60","iunknown" +"60","dial-up" +"60","uialertviewdelegate" +"60","isomorphic-fetch-api" +"60","hksamplequery" +"60","genealogy" +"60","gwt-2.5" +"60","sqlps" +"60","version-control-migration" +"60","gboard" +"60","hashcat" +"60","plugin-architecture" +"60","scale-color-manual" +"60","uidynamicanimator" +"60","itemcontainerstyle" +"60","digg" +"60","hook-form-alter" +"60","hook-menu" +"60","xbim" +"60","azure-static-website-hosting" +"60","spdep" +"60","movilizer" +"60","ehcache-bigmemory" +"60","custom-painter" +"60","angular2-di" +"60","test-framework" +"60","android-network-security-config" +"60","acts-as-taggable" +"60","percona-xtradb-cluster" +"60","lawnchair" +"60","evaluator" +"60","change-notification" +"60","zurb-ink" +"60","android-ondestroy" +"60","pedestal" +"60","pentaho-ctools" +"60","spire.doc" +"60","requestscope" +"60","actionbardrawertoggle" +"60","tessnet2" +"60","ninject-interception" +"60","commodore" +"60","character-limit" +"60","nineoldandroids" +"60","motion-planning" +"60","generative-art" +"60","ios-multithreading" +"60","tom-select" +"60","cgpdf" +"60","certenroll" +"60","layerdrawable" +"60","merit-gem" +"60","l-systems" +"60","webobjects" +"60","zohobooks" +"60","head.js" +"60","almalinux" +"60","sum-of-digits" +"60","sttwitter" +"60","sectionedrecyclerviewadapter" +"60","yowsup" +"60","lightroom" +"60","lightspeed" +"60","dart-2" +"60","web-container" +"60","web-ide" +"60","component-diagram" +"60","gml-geographic-markup-lan" +"60","shellcheck" +"60","flutter-html" +"60","fluxible" +"60","link-to-remote" +"60","helicontech" +"60","touchablehighlight" +"60","fnmatch" +"60","composite-id" +"60","partitioner" +"60","dajax" +"60","fme" +"60","webfont-loader" +"60","ifndef" +"59","mvs" +"59","easy-thumbnails" +"59","green-threads" +"59","greenrobot-eventbus-3.0" +"59","edn" +"59","trustpilot" +"59","yii-cmodel" +"59","jest-dom" +"59","editorformodel" +"59","greendao-generator" +"59","triplet" +"59","jetbrains-compose" +"59","dcevm" +"59","yocto-layer" +"59","slam-algorithm" +"59","webrtc-ios" +"59","effort" +"59","react-native-render-html" +"59","interactive-mode" +"59","live-video" +"59","wgl" +"59","procdump" +"59","clientaccesspolicy.xml" +"59","listcontrol" +"59","clio-api" +"59","anonymous-objects" +"59","playfab" +"59","ceedling" +"59","xhtmlrenderer" +"59","childviews" +"59","imx8" +"59","ccmenuitem" +"59","pi4j" +"59","apiclient" +"59","unbounded-wildcard" +"59","cblas" +"59","apollo-android" +"59","flair" +"59","managed-code" +"59","paddleocr" +"59","pixastic" +"59","xml-builder" +"59","vsam" +"59","datarowview" +"59","xpinc" +"59","fusionpbx" +"59","disposable" +"59","console2" +"59","major-mode" +"59","django-bootstrap3" +"59","django-caching" +"59","s7-1200" +"59","rune" +"59","filestreamresult" +"59","smartsheet-c#-sdk-v2" +"59","displaylist" +"59","alamofire-request" +"59","shark-sql" +"59","role-based" +"59","data-hiding" +"59","data-exchange" +"59","crouton" +"59","psycopg" +"59","icarus" +"59","rpt" +"59","verbatim-string" +"59","ruby-2.7" +"59","aws-cost-explorer" +"59","n2" +"59","aws-roles" +"59","rshiny" +"59","angularjs-provider" +"59","aws-marketplace" +"59","nalgebra" +"59","pybullet" +"59","django-mssql" +"59","angular-ui-modal" +"59","windows-firewall-api" +"59","single-logout" +"59","single-precision" +"59","demorgans-law" +"59","posix-api" +"59","jwt-go" +"59","swiftcharts" +"59","grub2" +"59","spring-cloud-dataflow-ui" +"59","www-mechanize-firefox" +"59","bloom" +"59","onnewintent" +"59","borrow" +"59","ereg" +"59","word-template" +"59","deployment-descriptor" +"59","writablebitmap" +"59","turbolinks-5" +"59","boot-clj" +"59","sbt-web" +"59","kairosdb" +"59","jquery-csv" +"59","go-git" +"59","rightnow-crm" +"59","kompose" +"59","luci" +"59","minima" +"59","typer" +"59","system-preferences" +"59","objectquery" +"59","lua-userdata" +"59","buildspec" +"59","cocosbuilder" +"59","astyle" +"59","androidappsonchromeos" +"59","java-mission-control" +"59","signed-url" +"59","rayshader" +"59","facebook4j" +"59","oval" +"59","o365-flow" +"59","analog-digital-converter" +"59","system-verilog-dpi" +"59","buffalo" +"59","knockout-kendo" +"59","magic-quotes" +"59","osgi-fragment" +"59","android-buildconfig" +"59","janino" +"59","nt-native-api" +"59","expression-web" +"59","podman-compose" +"59","dot42" +"59","pointer-to-array" +"59","nonblank" +"59","asp.net-mvc-sitemap" +"59","excelpackage" +"59","mktileoverlay" +"59","pluggable" +"59","no-response" +"59","qwebelement" +"59","exchange-server-2003" +"59","downloading-website-files" +"59","tandem" +"59","gcc8" +"59","poly" +"59","azure-storage-explorer" +"59","vertical-scroll" +"59","tarjans-algorithm" +"59","tarsosdsp" +"59","registerclientscriptblock" +"59","openssl-engine" +"59","qiime" +"59","geopackage" +"59","qiodevice" +"59","offsetdatetime" +"59","collectioneditor" +"59","commonsware" +"59","colordialog" +"59","hypercorn" +"59","acts-as-audited" +"59","http-status-code-307" +"59","human-interface" +"59","custom-notification" +"59","custom-build" +"59","petitparser" +"59","elasticsearch-marvel" +"59","com.sun.net.httpserver" +"59","qpdf" +"59","metalsmith" +"59","mpj-express" +"59","lpcstr" +"59","ipmi" +"59","textstyle" +"59","angular-errorhandler" +"59","specifier" +"59","angular-amd" +"59","splitstackshape" +"59","split-button" +"59","iphone-sdk-3.1" +"59","parent-node" +"59","enclave" +"59","flutter-redux" +"59","subscript-operator" +"59","imagedatagenerator" +"59","tfs-2012" +"59","qtxml" +"59","amazon-machine-learning" +"59","mdbtools" +"59","stddraw" +"59","maven-wagon-plugin" +"59","pandera" +"59","stdhash" +"59","starvation" +"59","google-reseller-api" +"59","usb-camera" +"59","predefined-variables" +"59","linuxbrew" +"59","passive-mode" +"59","google-sheets-custom-function" +"59","webintents" +"58","class-fields" +"58","massmail" +"58","yield-from" +"58","cloaking" +"58","slimbox" +"58","clang-complete" +"58","eco" +"58","base-address" +"58","multiple-constructors" +"58","relational-model" +"58","skipper" +"58","jcop" +"58","trygetvalue" +"58","git-clean" +"58","trumbowyg" +"58","marklogic-corb" +"58","eclipse-mat" +"58","web-vitals" +"58","eer-model" +"58","local-system-account" +"58","flexform" +"58","fenics" +"58","bam" +"58","weibo" +"58","remobjects" +"58","mathtype" +"58","mat-input" +"58","snaplogic" +"58","flax" +"58","jsdata" +"58","pako" +"58","blackberry-qnx" +"58","python-huey" +"58","page-init" +"58","cellpadding" +"58","fuse.js" +"58","binomial-cdf" +"58","jsonstream" +"58","pipelined-function" +"58","makestyles" +"58","data-layer" +"58","datawedge" +"58","conjunctive-normal-form" +"58","finalization" +"58","select-n-plus-1" +"58","consul-kv" +"58","swiftui-state" +"58","categorical" +"58","laplacian" +"58","apereo" +"58","imperative" +"58","awss3transferutility" +"58","cross-origin-embedder-policy" +"58","rsa-sha256" +"58","shared-worker" +"58","kinect.toolbox" +"58","avrcp" +"58","window-chrome" +"58","shapesheet" +"58","rotten-tomatoes" +"58","django-select2" +"58","oracle.manageddataaccess" +"58","ora-00932" +"58","dask-kubernetes" +"58","django-custom-tags" +"58","datagridcolumnheader" +"58","uri-scheme" +"58","pyav" +"58","agile-processes" +"58","data-dump" +"58","p-table" +"58","csplit" +"58","angular-toastr" +"58","databricks-repos" +"58","spring-actuator" +"58","sas-jmp" +"58","aws-sdk-java" +"58","twitter-finagle" +"58","onflow-cadence" +"58","nsq" +"58","nemerle" +"58","nsprintoperation" +"58","opacitymask" +"58","deis" +"58","ionic-appflow" +"58","wpf-grid" +"58","spring-cloud-stream-binder" +"58","grunt-contrib-less" +"58","oocss" +"58","entity-framework-core-3.0" +"58","hsb" +"58","gtkentry" +"58","app-shell" +"58","htmlgenericcontrol" +"58","pdfdocument" +"58","spring-loaded" +"58","neato" +"58","bleu" +"58","google-admin-settings-api" +"58","amplitude-analytics" +"58","orchardcore" +"58","java-money" +"58","ocaml-core" +"58","minecraft-commands" +"58","sgd" +"58","amp-story" +"58","lektor" +"58","netconf" +"58","audience" +"58","netbeans-7.2" +"58","amazon-workmail" +"58","atdd" +"58","51degrees" +"58","formatted-input" +"58","overlapping-matches" +"58","javax.script" +"58",".nettiers" +"58","faas" +"58","shopify-liquid" +"58","newrow" +"58","typehead" +"58","kotlin-android" +"58","b-tree-index" +"58","bssid" +"58","openjdk-17" +"58","dspack" +"58","control-panel" +"58","ntext" +"58","xcode7-beta4" +"58","nsusernotificationcenter" +"58","quora" +"58","taskdialog" +"58","timepickerdialog" +"58","sql-import-wizard" +"58","gap-system" +"58","gdc" +"58","plcrashreporter" +"58","dotnet-isolated" +"58","xajax" +"58","regional" +"58","azure-role-environment" +"58","redeploy" +"58","quick-nimble" +"58","drupal-content-types" +"58","xc16" +"58","aspnet-api-versioning" +"58","npp" +"58","draw2d-js" +"58","policy-based-design" +"58","businesscentral" +"58","pollingduplexhttpbinding" +"58","textfieldparser" +"58","strsep" +"58","meta-analysis" +"58","prompt-toolkit" +"58","google-cloud-translate" +"58","angular-input" +"58","sphinx-napoleon" +"58","cudd" +"58","pyx" +"58","espn" +"58","actionmode" +"58","pywebview" +"58","cen-xfs" +"58","android-jodatime" +"58","iphone-sdk-4.1" +"58","android-overlay" +"58","angular-httpclient-interceptors" +"58","omniauth-google-oauth2" +"58","montage" +"58","moveit" +"58","google-cloud-compute-engine" +"58","iphonecoredatarecipes" +"58","elasticsearch-nested" +"58","hunit" +"58","prototype-pattern" +"58","luac" +"58","concurrent-mark-sweep" +"58","powerbuilder-build-deploy" +"58","tigris" +"58","git-webhooks" +"58","uuencode" +"58","hfp" +"58","array-reduce" +"58","ms-office-script" +"58","bcftools" +"58","haskell-warp" +"58","qt5.8" +"58","asar" +"58","subreports" +"58","d3dx" +"58","stdinitializerlist" +"58","multidimensional-cube" +"58","git-plumbing" +"58","linspace" +"58","array-sum" +"58","mediatypeformatter" +"58","zf3" +"58","haskell-persistent" +"58","hdbc" +"58","theia" +"58","measures" +"58","argouml" +"58","cvat" +"58","qtoolbutton" +"58","gmaven-plugin" +"58","preempt-rt" +"58","partition-problem" +"58","embedly" +"58","ase" +"58","static-binding" +"58","cwd" +"58","flutter-stripe" +"58","cypress-conditional-testing" +"58","google-my-business" +"58","qtruby" +"58","ms-app-analytics" +"57","sizewithfont" +"57","jboss-modules" +"57","multiple-arguments" +"57","aol" +"57","truclient" +"57","math.js" +"57","localized" +"57","deep-residual-networks" +"57","instabug" +"57","wide-format-data" +"57","ghc-mod" +"57","marshmallow-sqlalchemy" +"57","localconnection" +"57","maskededitextender" +"57","interactive-grid" +"57","clearcanvas" +"57","yahoo-messenger" +"57","remote-registry" +"57","eddystone-url" +"57","phaselistener" +"57","remote-backup" +"57","clr4.0" +"57","client-side-attacks" +"57","llamacpp" +"57","ss7" +"57","graphenedb" +"57","edgejs" +"57","trialware" +"57","sitefinity-10" +"57","json2csv" +"57","p4api.net" +"57","fusebox" +"57","kucoin" +"57","imagespan" +"57","birthday-paradox" +"57","dbforge" +"57","firewire" +"57","disjoint-union" +"57","configureawait" +"57","pipx" +"57","fsunit" +"57","pipes-filters" +"57","ngx-mask" +"57","api-hook" +"57","rviz" +"57","ng2-pdfjs-viewer" +"57","cda" +"57","directxmath" +"57","sailpoint" +"57","swiftui-sheet" +"57","nexus-one" +"57","symfony-panther" +"57","dirpagination" +"57","jqmath" +"57","camera-flash" +"57","vungle-ads" +"57","facebook-pop" +"57","indy-9" +"57","facebook-rest-api" +"57","pycall" +"57","docker-pull" +"57","mysql-cli" +"57","rosalind" +"57","windows-hosting" +"57","angularjs-ngmock" +"57","name-hiding" +"57","unnamed-namespace" +"57","database-engine" +"57","pyathena" +"57","kentico-kontent" +"57","ajax-update" +"57","unselect" +"57","documents4j" +"57","psftp" +"57","verisign" +"57","jmapviewer" +"57","r-parsnip" +"57","v-autocomplete" +"57","rq" +"57","methodnotfound" +"57","pcspim" +"57","oomph" +"57","salesforce-flow" +"57","bloburls" +"57","nsindexset" +"57","appodeal" +"57","natural-key" +"57","post-processor" +"57","kdeplot" +"57","azure-availability-set" +"57","twint" +"57","pdf-manipulation" +"57","ionic-tabs" +"57","jquery-globalize" +"57","spring-jersey" +"57","jquery-ui-spinner" +"57","spring-io" +"57","superobject" +"57","negotiate" +"57","word-processor" +"57","cors-anywhere" +"57","interop-domino" +"57","easypost" +"57","erlang-ports" +"57","azure-ad-powershell-v2" +"57","doskey" +"57","rights-management" +"57","setparent" +"57","acaccountstore" +"57","minitab" +"57","system.data.datatable" +"57","ray-picking" +"57","cocos2d-x-3.x" +"57","ri" +"57","showwindow" +"57","bugsense" +"57","libcloud" +"57","oct2py" +"57","libpd" +"57","mindmapping" +"57","ata" +"57","typescript4.0" +"57","itemgroup" +"57","xcode5.0.1" +"57","region-monitoring" +"57","business-process" +"57","drive-letter" +"57","nswagstudio" +"57","noip" +"57","high-level" +"57","cachedrowset" +"57","timeval" +"57","hana-studio" +"57","plone-3.x" +"57","nokiax" +"57","mocha-phantomjs" +"57","nsxpcconnection" +"57","scene-manager" +"57","tcp-keepalive" +"57","timestampdiff" +"57","h2o.ai" +"57","racing" +"57","ml5.js" +"57","red-gate-ants" +"57","xcode12.5" +"57","azure-ml-pipelines" +"57","uiimageorientation" +"57","hgweb" +"57","member-hiding" +"57","nhibernate-validator" +"57","logical-purity" +"57","cusolver" +"57","office-pia" +"57","string-operations" +"57","mercurial-convert" +"57","customcolumn" +"57","angular2-hostbinding" +"57","mosync" +"57","evosuite" +"57","spectre" +"57","activitylog" +"57","mongo-scala-driver" +"57","peer-connection" +"57","ogc" +"57","mousepress" +"57","huawei-map-kit" +"57","motion-blur" +"57","concave-hull" +"57","maven-gae-plugin" +"57","gm-xmlhttprequest" +"57","foaf" +"57","power-virtual-agents" +"57","computational-finance" +"57","avaudiopcmbuffer" +"57","prefix-tree" +"57","cyber-ark" +"57","ardent" +"57","partial-matches" +"57","git-rev-list" +"57","sourcegear-vault" +"57","state-saving" +"57","web.sitemap" +"57","traffic-measurement" +"57","weblogic8.x" +"57","line-drawing" +"57","autopilot" +"57","haskell-diagrams" +"57","max-size" +"57","image-extraction" +"57","substance" +"57","mbcs" +"57","bdc" +"57","static-import" +"57","static-data" +"57","qtest" +"57","zend-guard" +"57","pg-hba.conf" +"56","backlight" +"56","declare-styleable" +"56","livevalidation" +"56","processwire" +"56","webservicetemplate" +"56","ansistring" +"56","mass-emails" +"56","decodeuricomponent" +"56","materialdatepicker" +"56","ecl" +"56","dedicated" +"56","tern" +"56","phlivephoto" +"56","bandpass-filter" +"56","maven-ant-tasks" +"56","dbutils" +"56","treelistview" +"56","phantom-reference" +"56","php-builtin-server" +"56","yelp-fusion-api" +"56","yii-modules" +"56","matplotlib-gridspec" +"56","vue-testing-library" +"56","default-copy-constructor" +"56","dblinq" +"56","installshield-2009" +"56","sse4" +"56","adobe-scriptui" +"56","xmlschema" +"56","rwlock" +"56","blackberry-world" +"56","container-image" +"56","mappingexception" +"56","addressables" +"56","s3-bucket" +"56","software-serial" +"56","pixel-manipulation" +"56","catamorphism" +"56","language-construct" +"56","phrets" +"56","appian" +"56","apache-spark-encoders" +"56","labjs" +"56","churn" +"56","python-magic" +"56","soaphandler" +"56","python-memcached" +"56","ccombobox" +"56","divi-theme" +"56","flash-video" +"56","self-destruction" +"56","snoop" +"56","flasgger" +"56","in-class-initialization" +"56","platform-specific" +"56","json-arrayagg" +"56","undef" +"56","riverpod-generator" +"56","fswatch" +"56","datastax-python-driver" +"56","binary-matrix" +"56","django-treebeard" +"56","windowed" +"56","r-marginaleffects" +"56","wack" +"56","react-ssr" +"56","ora-00936" +"56","wildcard-mapping" +"56","camera-api" +"56","watson-nlu" +"56","fan-page" +"56","watchos-5" +"56","walkthrough" +"56","angularjs-ng-resource" +"56","cross-origin-opener-policy" +"56","oracle-fdw" +"56","kendo-panelbar" +"56","realm-js" +"56","data-cube" +"56","roulette-wheel-selection" +"56","angular-ui-bootstrap-tab" +"56","rsuite" +"56","govendor" +"56","publish-actions" +"56","rootkit" +"56","metatag" +"56","gulp-livereload" +"56","wsdl.exe" +"56","ws-discovery" +"56","modulus.io" +"56","pdf-rendering" +"56","tus" +"56","txtextcontrol" +"56","neko" +"56","ncalc" +"56","boost-polygon" +"56","nsbitmapimagerep" +"56","junos-automation" +"56","boids" +"56","nsmanagedobjectmodel" +"56","mongokit" +"56","bluepill" +"56","html-post" +"56","payment-request-api" +"56","input-filtering" +"56","sap-selection-screens" +"56","ontime" +"56","covering-index" +"56","bluetooth-device-discovery" +"56","io.js" +"56","spring-reactor" +"56","magnify" +"56","external-application" +"56","shopware5" +"56","osm.pbf" +"56","maildir" +"56","pyorient" +"56","osql" +"56","3g-network" +"56","rcppparallel" +"56","extreact" +"56","object-initialization" +"56","amazon-simple-email-service" +"56","facebook-graph-api-v2.4" +"56","forward-compatibility" +"56","ravendb4" +"56","rainbowtable" +"56","fortigate" +"56","sieve-language" +"56","fortify-source" +"56","pyfmi" +"56","hibernate-jpa" +"56","drupal-services" +"56","screen-off" +"56","handlebars.net" +"56","tinymce-3" +"56","itcl" +"56","handleerror" +"56","dialplan" +"56","ispf" +"56","uimenuitem" +"56","uinput" +"56","android-input-filter" +"56","openslide" +"56","gwt-openlayers" +"56","rails-generate" +"56","scala-spark" +"56","sqlreportingservice" +"56","nsvisualeffectview" +"56","device-width" +"56","jackson-dataformat-csv" +"56","vesa" +"56","vfw" +"56","dotnetcorecli" +"56","tdataset" +"56","c++builder-10.3-rio" +"56","refcounting" +"56","bunifu" +"56","historical-db" +"56","c2664" +"56","non-repetitive" +"56","mpmoviewcontroller" +"56","activepython" +"56","pyxb" +"56","geogebra" +"56","es5-shim" +"56","logical-foundations" +"56","spot-instances" +"56","esent" +"56","iron" +"56","stockfish" +"56","ctree" +"56","cer" +"56","login-attempts" +"56","moo" +"56","learndash" +"56","iris-recognition" +"56","mergemap" +"56","nintendo" +"56","zpt" +"56","google-form-quiz" +"56","csvkit" +"56","cstdio" +"56","irs" +"56","acts-as-commentable" +"56","ackermann" +"56","css-parsing" +"56","geom-raster" +"56","angular-auth-oidc-client" +"56","log4r" +"56","zurb-reveal" +"56","elasticsearch-percolate" +"56","mule-flow" +"56","embedded-javascript" +"56","flutter-upgrade" +"56","msbuild-propertygroup" +"56","static-array" +"56","presto-jdbc" +"56","st-link" +"56","zebra-scanners" +"56","zend-controller-router" +"56","concrete5-8.x" +"56","altorouter" +"56","concat-ws" +"56","zend-framework-routing" +"56","mediastreamsource" +"56","stsadm" +"56","scriptcs" +"56","urlretrieve" +"56","authorize.net-arb" +"56","queueing" +"56","structuremap4" +"56","behaviorspace" +"56","qt-linguist" +"56","thingsboard-gateway" +"56","arrayaccess" +"56","parallel-builds" +"56","dart-shelf" +"56","styled-jsx" +"56","cyclic-graph" +"56","global-namespace" +"56","user-identification" +"56","sharpmap" +"56","global-assembly-cache" +"55","vue-dynamic-components" +"55","math-functions" +"55","anytime" +"55","clr-profiling-api" +"55","flutter-engine" +"55","feathers-hook" +"55","bamboo-specs" +"55","gidsignin" +"55","grdb" +"55","multiple-results" +"55","remote-repository" +"55","sql-server-openxml" +"55","template-variables" +"55","inspectdb" +"55","flipboard" +"55","livelink" +"55","gitlab-ee" +"55","apache-camel-3" +"55","ckeditor.net" +"55","git-init" +"55","git-ftp" +"55","clojurescript-javascript-interop" +"55","material-dialog" +"55","ant-design-vue" +"55","clearml" +"55","tspan" +"55","fileopenpicker" +"55","data-segment" +"55","soa-suite" +"55","imgkit" +"55","incredibuild" +"55","nextval" +"55","apache-sentry" +"55","socketasynceventargs" +"55","adonetappender" +"55","fleet" +"55","mappings" +"55","filter-input" +"55","xml-entities" +"55","safearea" +"55","flask-ask" +"55","dispatchgroup" +"55","appery.io" +"55","packet-injection" +"55","fromjson" +"55","discogs-api" +"55","xpathquery" +"55","smartystreets" +"55","unity3d-terrain" +"55","angular-social-login" +"55","method-names" +"55","oracle-apex-20.2" +"55","grandstack" +"55","sim-toolkit" +"55","fasthttp" +"55","upshot" +"55","avcodec" +"55","rosetta-2" +"55","unix-head" +"55","pure-js" +"55","rubymine-7" +"55","database-deployment" +"55","aide" +"55","angularjs-ng-href" +"55","windows-screensaver" +"55","databound-controls" +"55","microsoft-extensions-logging" +"55","gorm-mongodb" +"55","mysql-spatial" +"55","jniwrapper" +"55","unslider" +"55","informatica-data-integration-hub" +"55","jquery-ui-theme" +"55","apple-numbers" +"55","pasteboard" +"55","gulp-babel" +"55","word-sense-disambiguation" +"55","springjunit4classrunner" +"55","tx-gridelements" +"55","postbackurl" +"55","neo4django" +"55","popup-balloons" +"55","grunt-contrib-compass" +"55","sata" +"55","svn-update" +"55","silentpush" +"55","typo3-tca" +"55","system.drawing.color" +"55","luks" +"55","virtual-path" +"55","audiostreamer" +"55","amstock" +"55","ubuntu-13.04" +"55","libtorrent-rasterbar" +"55","m2doc" +"55","google-api-go-client" +"55","ril" +"55","outbox-pattern" +"55","retrofit2.6" +"55","atomicreference" +"55","asynchronous-messaging-protocol" +"55","pykafka" +"55","luajava" +"55","rcu" +"55","context-bound" +"55","tabpy" +"55","digital-filter" +"55","context-sensitive-grammar" +"55","opensc" +"55","gcal" +"55","npm-vulnerabilities" +"55","playlists" +"55","android-cookiemanager" +"55","open-telemetry-java" +"55","dstore" +"55","guvnor" +"55","tawk.to" +"55","non-volatile" +"55","high-traffic" +"55","qvboxlayout" +"55","gecode" +"55","itmstransporter" +"55","nsurlsessiontask" +"55","copy-initialization" +"55","timeunit" +"55","genbank" +"55","hibernate-reactive" +"55","convenience-methods" +"55","leader-election" +"55","iproute" +"55","hubspot-api" +"55","react-motion" +"55","elasticsearch-api" +"55","elastic-cache" +"55","ipyleaflet" +"55","pywin" +"55","nimbus-jose-jwt" +"55","geom-segment" +"55","node-imagemagick" +"55","reactfire" +"55","human-computer-interface" +"55","niftynet" +"55","egui" +"55","command-timeout" +"55","zsh-zle" +"55","everyplay" +"55","pytransitions" +"55","angular2-databinding" +"55","android-make" +"55","genesys" +"55","http-head" +"55","suexec" +"55","flysystem-google-drive" +"55","glympse" +"55","msxml2" +"55","gluon-desktop" +"55","pass-by-const-reference" +"55","medium.com-publishing-api" +"55","particle-filter" +"55","transactional-memory" +"55","mda" +"55","cycle2" +"55","globalcompositeoperation" +"55","styleframe" +"55","qt3" +"55","threadstatic" +"55","cylindrical" +"55","hermit" +"55","powershell-v6.0" +"55","image-enlarge" +"55","powerpoint-2016" +"55","elpa" +"55","threepenny-gui" +"55","bastion-host" +"55","steeltoe" +"55","pants" +"55","structured-logging" +"55","qtdbus" +"54","vsta" +"54","vsql" +"54","vue-options-api" +"54","cloud-object-storage" +"54","staggeredgridlayoutmanager" +"54","dbmail" +"54","clustering-key" +"54","php-shorttags" +"54","yii2-extension" +"54","localytics" +"54","yahoo-boss-api" +"54","deadlines" +"54","llvm-3.0" +"54","list.js" +"54","sqltools" +"54","flexible-search" +"54","web-statistics" +"54","flipkart-api" +"54","cloudcaptain" +"54","clr-hosting" +"54","cisco-axl" +"54","backups" +"54","antisamy" +"54","fieldinfo" +"54","trusted-computing" +"54","treecellrenderer" +"54","edt" +"54","basename" +"54","multiple-browsers" +"54","telegraf-plugins" +"54","ffill" +"54","req" +"54","intel-parallel-studio" +"54","translation-unit" +"54","feincms" +"54","run-app" +"54","snapshot-isolation" +"54","runsettings" +"54","cassette" +"54","marc" +"54","mapstatetoprops" +"54","jsonlint" +"54","xdebug-profiler" +"54","saf" +"54","snakecasing" +"54","packager" +"54","soap4r" +"54","cellspacing" +"54","cilium" +"54","xfdf" +"54","uname" +"54","unitils" +"54","ng-apexcharts" +"54","config-transformation" +"54","python-coverage" +"54","python-jedi" +"54","datecreated" +"54","constantcontact" +"54","freshjs" +"54","python-dotenv" +"54","distributed-filesystem" +"54","simple-openni" +"54","ibm-cloud-plugin" +"54","jqgrid-inlinenav" +"54","jfrog-pipelines" +"54","joomla4" +"54","aws-glue-connection" +"54","jide" +"54","aiff" +"54","ora2pg" +"54","redactor.js" +"54","servicestack-razor" +"54","ibatis.net" +"54","verilator" +"54","rke" +"54","agal" +"54","servicebehavior" +"54","django-sitemaps" +"54","django-widget-tweaks" +"54","angular-route-segment" +"54","avif" +"54","windowless" +"54","keycloak-nodejs-connect" +"54","unoconv" +"54","wikimedia-commons" +"54","croogo" +"54","dnx50" +"54","mysite" +"54","nameko" +"54","aws-rds-data-service" +"54","nacl-cryptography" +"54","mysql-5.0" +"54","validationrule" +"54","vcloud-director-rest-api" +"54","payout" +"54","twistd" +"54","apple-cryptokit" +"54","gulp-rename" +"54","guice-persist" +"54","svnant" +"54","cosmos-sdk" +"54","mongodb-mms" +"54","wse3.0" +"54","open-generics" +"54","android-unit-testing" +"54","bogus" +"54","jtwitter" +"54","android-screen-pinning" +"54","nservicebus-distributor" +"54","portia" +"54","jxcore" +"54","swaggerhub" +"54","aws-service-catalog" +"54","neography" +"54","sca" +"54","swagger-codegen-maven-plugin" +"54","botpress" +"54","neo4j-desktop" +"54","botium-box" +"54","core-services" +"54","oniguruma" +"54","momentics" +"54","boost-tuples" +"54","javax.ws.rs" +"54","pydio" +"54","shopify-hydrogen" +"54","return-by-value" +"54","sifr3" +"54","codio" +"54","raspbian-buster" +"54","virtualmode" +"54",".mov" +"54","form-designer" +"54","word-2016" +"54","golden-layout" +"54","pypandoc" +"54","minimatch" +"54","virtual-column" +"54","kmalloc" +"54","java-memory-leaks" +"54","formsauthenticationticket" +"54","rfc3986" +"54","formatjs" +"54","objective-c-literals" +"54","raiseerror" +"54","facebook-live-api" +"54","code39" +"54","krypton-toolkit" +"54","cocoahttpserver" +"54","f#-scripting" +"54","macdeployqt" +"54","typelist" +"54","macos-darkmode" +"54","vision-transformer" +"54","android-applicationrecord" +"54","vitess" +"54","reform" +"54","poe" +"54","sqlfluff" +"54","c++builder-xe8" +"54","hook-wordpress" +"54","isapi-redirect" +"54","control-p5" +"54","buttonbar" +"54","driverless-ai" +"54","mixture" +"54","plv8" +"54","drupal-5" +"54","gb2312" +"54","azure-public-ip" +"54","dublin-core" +"54","spl-autoloader" +"54","angular-in-memory-web-api" +"54","getpass" +"54","commonmark" +"54","nntp" +"54","google-cloud-ai" +"54","eigenclass" +"54","qpainterpath" +"54","geocomplete" +"54","storybook-addon" +"54","laravel-response" +"54","toolbaritems" +"54","http-status-code-407" +"54","ninject.web" +"54","chargify" +"54","lsb" +"54","ejabberd-hooks" +"54","textflow" +"54","laravel-upgrade" +"54","command-query-separation" +"54","pyuno" +"54","message-pump" +"54","active-window" +"54","sprig-template-functions" +"54","moses" +"54","meta-method" +"54","cucm" +"54","off-by-one" +"54","strongly-connected-graph" +"54","google-data-catalog" +"54","qdrant" +"54","autobahnws" +"54","tig" +"54","msmq-wcf" +"54","uwebsockets" +"54","altivec" +"54","heatmaply" +"54","spark-ada" +"54","maven-repository" +"54","enchant" +"54","arquillian-drone" +"54","alt-tab" +"54","qt-slot" +"54","array-walk" +"54","qstatemachine" +"54","web3modal" +"54","shell32.dll" +"54","flutter-webrtc" +"54","solrconfig" +"54","preferslargetitles" +"54","iglistkit" +"54","suitescript1.0" +"54","igmp" +"54","global-payments-api" +"54","dart-unittest" +"54","linecache" +"54","glblendfunc" +"54","herestring" +"54","topbraid-composer" +"54","completion-block" +"54","source-insight" +"54","web-compiler" +"54","compiler-specific" +"54","flutter-intl" +"54","pareto-chart" +"54","igoogle" +"53","transit" +"53","pg-upgrade" +"53","vue2-google-maps" +"53","dbup" +"53","clipperlib" +"53","phalcon-orm" +"53","sql-server-job" +"53","instant-run" +"53","clicktag" +"53","babelify" +"53","fiddle" +"53","skos" +"53","mask-rcnn" +"53","jenkins-github-plugin" +"53","figaro-ruby" +"53","groupchat" +"53","webpage-rendering" +"53","php-imagine" +"53","gitlens" +"53","clientip" +"53","live-connect-sdk" +"53","matchtemplate" +"53","apache-kafka-security" +"53","gitlab-8" +"53","webtrends" +"53","github-projects" +"53","ants" +"53","fetchcontent" +"53","php-mssql" +"53","probing" +"53","ggcorrplot" +"53","phoneme" +"53","probot" +"53","ngrx-router-store" +"53","underscores-wp" +"53","swiftydropbox" +"53","flexboxgrid" +"53","daypilot" +"53","bit-masks" +"53","rxvt" +"53","firstdata" +"53","adaptive-ui" +"53","file-system-access-api" +"53","select-function" +"53","chrome-for-android" +"53","bizspark" +"53","jsr356" +"53","image-viewer" +"53","firebird1.5" +"53","swift-mt" +"53","imputets" +"53","palm-pre" +"53","fsfs" +"53","distributed-lock" +"53","xmladapter" +"53","biological-neural-network" +"53","palantir-foundry-api" +"53","connman" +"53","find-by-sql" +"53","uml-designer" +"53","apache-nms" +"53","checkin-policy" +"53","indexing-service" +"53","social-tables" +"53","kube-state-metrics" +"53","flash-scope" +"53","kubespray" +"53","findfirst" +"53","imagenamed" +"53","map-force" +"53","xenomai" +"53","sal" +"53","constexpr-function" +"53","varying" +"53","mysql-error-2002" +"53","recorder.js" +"53","opkg" +"53","crowdsourcing" +"53","grails-services" +"53","camera-view" +"53","agora-implementation" +"53","psoc" +"53","doctrine-phpcr" +"53","dataitem" +"53","microkernel" +"53","ruby-enterprise-edition" +"53","createobjecturl" +"53","pycodestyle" +"53","google-wallet" +"53","google-web-component" +"53","goose" +"53","fail-fast" +"53","oracle-dump" +"53","rswag" +"53","caldroid" +"53","valuemember" +"53","microsoft-graph-edu" +"53","meteor-slingshot" +"53","ajdt" +"53","vega-lite-api" +"53","vega-embed" +"53","jhtmlarea" +"53","django-react" +"53","episerver-6" +"53","html-injections" +"53","twitter-anywhere" +"53","createcontext" +"53","modelio" +"53","easyautocomplete" +"53","pathauto" +"53","password-confirmation" +"53","epub.js" +"53","navigation-timing-api" +"53","ontap" +"53","android-studio-3.4" +"53","spring-cloud-loadbalancer" +"53","openaccess" +"53","cqlinq" +"53","paymill" +"53","application-data" +"53","swfaddress" +"53","entity-model" +"53","environ" +"53","kbhit" +"53","juju" +"53","entityset" +"53","postgresql-triggers" +"53","kafka-partition" +"53","android-textattributes" +"53","view-hierarchy" +"53","atata" +"53","browser-action" +"53","pygrib" +"53","windows-xp-embedded" +"53","oracle-wallet" +"53","mikrotik" +"53","lexicographic-ordering" +"53","audioeffect" +"53","netbeans7.0" +"53","lexical-closures" +"53","codeskulptor" +"53","oracle-xml-db" +"53","extensible" +"53","object-identity" +"53","foundry-code-workbooks" +"53","windows-template-studio" +"53","magic-draw" +"53","less-loader" +"53","neutralinojs" +"53","rikulo" +"53","external-data-source" +"53","mahotas" +"53","oauth.io" +"53","facebook-batch-request" +"53","aubio" +"53","system-paths" +"53","tabular-form" +"53","asort" +"53","jaggery-js" +"53","modeline" +"53","xaml-binding" +"53","drizzle-orm" +"53","hig" +"53","hibernate-search-6" +"53","gcc6" +"53","not-operator" +"53","gcc-plugins" +"53","aspose-slides" +"53","drawellipse" +"53","gabor-filter" +"53","excel-pivot" +"53","playwright-sharp" +"53","x-accel-redirect" +"53","tbitmap" +"53","toit" +"53","iserializable" +"53","double-hashing" +"53","xcode7-beta3" +"53","numerics" +"53","xctool" +"53","tabris" +"53","offsetwidth" +"53","httpruntime.cache" +"53","angular2-providers" +"53","http-protocols" +"53","nibble" +"53","excel-4.0" +"53","strophe.js" +"53","nicegui" +"53","command-line-parser" +"53","elephantbird" +"53","login-with-amazon" +"53","loguru" +"53","spectral" +"53","resource-id" +"53","launch-services" +"53","ios-homekit" +"53","cupertinopicker" +"53","mountebank" +"53","protorpc" +"53","oltu" +"53","node-neo4j" +"53","mosca" +"53","morphic" +"53","sphinx-apidoc" +"53","geom-area" +"53","launchdarkly" +"53","reactjs-native" +"53","log4cpp" +"53","merge-statement" +"53","las" +"53","concurrently" +"53","amazon-fsx" +"53","thread-exceptions" +"53","zen" +"53","mean-shift" +"53","goaccess" +"53","line-spacing" +"53","quarkus-oidc" +"53","shibboleth-sp" +"53","emacs-ecb" +"53","suckerfish" +"53","webcal" +"53","scribd" +"53","v4l" +"53","query-notifications" +"53","auth-request" +"53","embedded-tomcat" +"53","sugarbean" +"53","webgl-extensions" +"53","gnome-builder" +"53","yticks" +"53","ms-forms" +"53","qt5.15" +"53","hazard" +"53","zigzag" +"53","powerbi-rest-api" +"53","qt4.6" +"53","zope.interface" +"53","engine.io" +"53","webkit.net" +"53","asdoc" +"53","mediasession" +"53","asf" +"53","ber" +"53","heads-up-notifications" +"52","jenkins-kubernetes" +"52","sql-server-performance" +"52","linux-toolchain" +"52","xrp" +"52","group-membership" +"52","filecompare" +"52","jconnect" +"52","lispworks" +"52","multiway-tree" +"52","primeflex" +"52","cling" +"52","mathematical-lattices" +"52","tensorflow2" +"52","flutter-debug" +"52","multi-table-inheritance" +"52","sitefinity-5" +"52","apache-commons-pool" +"52","eclipse-sirius" +"52","floor-division" +"52","liveconnect" +"52","transport-security" +"52","materialcardview" +"52","fetchrequest" +"52","git-archive" +"52","ssp" +"52","apache-chainsaw" +"52","mat-card" +"52","safeareaview" +"52","chrome-remote-debugging" +"52","addon-domain" +"52","swiftui-layout" +"52","jsonb-api" +"52","unbuffered" +"52","safari-web-extension" +"52","appcelerator-hyperloop" +"52","unchecked-cast" +"52","python-for-android" +"52","mapbox-gl-draw" +"52","smartscreen" +"52","contactpicker" +"52","piracy-prevention" +"52","snapshot-testing" +"52","console.readkey" +"52","python-moderngl" +"52","rxdb" +"52","confluent-control-center" +"52","chewy-gem" +"52","symfony-2.0" +"52","dismo" +"52","xl-deploy" +"52","kurtosis" +"52","smtpd" +"52","chefdk" +"52","runcommand" +"52","jtapplecalendar" +"52","runjags" +"52","sms-retriever-api" +"52","diskarbitration" +"52","socket.io-java-client" +"52","binding.scala" +"52","connectionexception" +"52","mysql-innodb-cluster" +"52","wildfly-26" +"52","datajs" +"52","gradle-shadow-plugin" +"52","gradle-release-plugin" +"52","aws-media-live" +"52","simplekml" +"52","mysqltuner" +"52","wildcard-expansion" +"52","jgitflow-maven-plugin" +"52","waveout" +"52","jive" +"52","django-management-command" +"52","seq-logging" +"52","pyamf" +"52","csip-simple" +"52","windows-administration" +"52","angular-spectator" +"52","angular-state-managmement" +"52","angular-ui-datepicker" +"52","wagon" +"52","django-dev-server" +"52","angularjs-view" +"52","angularjs-track-by" +"52","rsvp-promise" +"52","windows-2003-webserver" +"52","routedevent" +"52","windowsdomainaccount" +"52","windows-driver" +"52","kendo-menu" +"52","dmx512" +"52","grape-entity" +"52","windows-forms-core" +"52","rst2pdf" +"52","datadog-dashboard" +"52","caller-id" +"52","pattern-synonyms" +"52","nested-set-model" +"52","application-icon" +"52","jquery-mobile-ajax" +"52","ini4j" +"52","boehm-gc" +"52","jquery-layout" +"52","boost-locale" +"52","android-traceview" +"52","modx-resources" +"52","inria-spoon" +"52","salt-cloud" +"52","gulp-useref" +"52","nssecurecoding" +"52","dynamic-assemblies" +"52","two.js" +"52","eaccelerator" +"52","dynamic-parallelism" +"52","dynamic-values" +"52","wsastartup" +"52","cpplint" +"52","inplace-editing" +"52","bootcamp" +"52","postgres-10" +"52","inlines" +"52","intrinsic-content-size" +"52","inputverifier" +"52","bonsai-elasticsearch" +"52","mailhog" +"52","typescript-definitions" +"52","branchless" +"52","javahelp" +"52","libmagic" +"52","tabbed-view" +"52","system.type" +"52","pygame2" +"52","ampersand.js" +"52","abortcontroller" +"52","typescript2.2" +"52","rdf-xml" +"52","code-navigation" +"52",".netrc" +"52","build-triggers" +"52","audio-source" +"52","ramaze" +"52","lessphp" +"52","rcaller" +"52","leksah" +"52","gold-linker" +"52","m2e-wtp" +"52","syncsort" +"52","pykalman" +"52","word-field" +"52","dompurify" +"52","netbeans-7.3" +"52","reversi" +"52","knox-gateway" +"52","azure-secrets" +"52","pod-install" +"52","buttonfield" +"52","double-submit-problem" +"52","table-statistics" +"52","continuation" +"52","scikit-optimize" +"52","sqlhelper" +"52","ispell" +"52","expressionvisitor" +"52","table-per-class" +"52","reduce-reduce-conflict" +"52","expression-encoder-sdk" +"52","ganymede" +"52","jade4j" +"52","railway.js" +"52","gaufrette" +"52","red-zone" +"52","gwt-compiler" +"52","gemalto" +"52","tcomport" +"52","copybook" +"52","ref-qualifier" +"52","xcos" +"52","drupal-navigation" +"52","dex2jar" +"52","azure-function-async" +"52","uimenu" +"52","drives" +"52","tapkey" +"52","tinkerpop-blueprint" +"52","sql-server-2017-express" +"52","radrails" +"52","dev-mode" +"52","getproperties" +"52","property-observer" +"52","current-page" +"52","geom-ribbon" +"52","chalk" +"52","oh-my-posh" +"52","movable" +"52","cumulative-layout-shift" +"52","acts-as-tree" +"52","chaiscript" +"52","event-wait-handle" +"52","prtg" +"52","elasticsearch.net" +"52","ejbql" +"52","spotfire-webplayer" +"52","event-capturing" +"52","cfiledialog" +"52","geometry-instancing" +"52","react-datetime" +"52","perlscript" +"52","dumpdata" +"52","iphone-vibrate" +"52","monitors" +"52","qcar-sdk" +"52","reactive-cocoa-3" +"52","csx" +"52","lazyvstack" +"52","monolithic" +"52","msp" +"52","behind" +"52","amazon-deequ" +"52","avassetimagegenerator" +"52","passlib" +"52","asadmin" +"52","hft" +"52","lidr" +"52","multimarkdown" +"52","stxxl" +"52","comvisible" +"52","zendx" +"52","pgfplots" +"52","pangocairo" +"52","healthconnect" +"52","czml" +"52","amazon-kinesis-kpl" +"52","seadragon" +"52","em-websocket" +"52","glassfish-2.x" +"52","qt5.1" +"52","multiarch" +"52","image-cropper" +"52","maximization" +"52","linear-probing" +"52","arduinojson" +"52","multicollinearity" +"52","starcluster" +"51","groovy-eclipse" +"51","flexunit4" +"51","dbproviderfactories" +"51","white-box-testing" +"51","technical-debt" +"51","yajsw" +"51","graphql-playground" +"51","vssdk" +"51","xui" +"51","relativedelta" +"51","reorderable-list" +"51","yii-cactiverecord" +"51","matchmaking" +"51","masspay" +"51","ginput" +"51","phpstorm-2017.1" +"51","apache-apex" +"51","gimbal" +"51","apache-crunch" +"51","mathcad" +"51","base36" +"51","wep" +"51","filab" +"51","yii-chtml" +"51","integer-partition" +"51","dateparser" +"51","fsspec" +"51","configobj" +"51","pipelinedb" +"51","xml-declaration" +"51","pandaboard" +"51","firebase-queue" +"51","filterfunction" +"51","disk-access" +"51","page-setup" +"51","fts5" +"51","ceilometer" +"51","binascii" +"51","snowplow" +"51","catalystbyzoho" +"51","swupdate" +"51","content-for" +"51","fromfile" +"51","rust-async-std" +"51","switchpreference" +"51","constraint-validation-api" +"51","cassandra-jdbc" +"51","chromeless" +"51","kuzzle" +"51","ng-mocks" +"51","rust-obsolete" +"51","ngx-toastr" +"51","distributed-objects" +"51","cassandra-0.7" +"51","pureconfig" +"51","i2s" +"51","up-navigation" +"51","docxtpl" +"51","datajoint" +"51","aho-corasick" +"51","gopls" +"51","verlet-integration" +"51","upsource" +"51","aws-devops" +"51","django-formtools" +"51","upx" +"51","serenity-platform" +"51","got" +"51","angulartics" +"51","angular-testing-library" +"51","windows-server-2000" +"51","ruby-2.5" +"51","facetwp" +"51","mystic" +"51","call-hierarchy" +"51","kframework" +"51","rose-plot" +"51","django-polymorphic" +"51","simpledialog" +"51","metrics-server" +"51","rspec-puppet" +"51","aws-amplify-sdk-android" +"51","namespace-package" +"51","vcproj" +"51","wspbuilder" +"51","cray" +"51","nativescript-cli" +"51","navigationsplitview" +"51","infobip" +"51","android-window" +"51","gtrendsr" +"51","axon-framework" +"51","monger" +"51","wp-nav-menu-item" +"51","azure-emulator" +"51","wowza-transcoder" +"51","corewcf" +"51","txmldocument" +"51","boost-spirit-karma" +"51","popuppanel" +"51","onepage-checkout" +"51","gtkmm4" +"51","gulp-rev" +"51","invision-power-board" +"51","html-help-workshop" +"51","android-simple-facebook" +"51","swift-keypath" +"51","application-security" +"51","postgres-xl" +"51","dynamicparameters" +"51","pasting" +"51","libdispatch" +"51","ocmod" +"51","synedit" +"51","wordpress.com" +"51","pysam" +"51","netbeans-7.4" +"51","synopsys-vcs" +"51","mini-forge" +"51","winforms-to-web" +"51","google-2fa" +"51","rainmeter" +"51","fragment-transitions" +"51","fpgrowth" +"51","sgplot" +"51","tableau-prep" +"51","google-alerts" +"51","visual-leak-detector" +"51","siege" +"51","sidr" +"51","pymodbustcp" +"51","asynccontroller" +"51","vmd" +"51","xcode7-beta6" +"51","android-firmware" +"51","halo" +"51","scalastyle" +"51","hibernation" +"51","taleo" +"51","cacheapi" +"51","hoare-logic" +"51","uidynamicbehavior" +"51","sql-match-all" +"51","android-components" +"51","azure-subscription" +"51","gwt-activities" +"51","table-partitioning" +"51","controller-action" +"51","mobicents-sip-servlets" +"51","gbk" +"51","dotween" +"51","hilla" +"51","spring-social-linkedin" +"51","tdm-mingw" +"51","direct-labels" +"51","android-dateutils" +"51","exif-js" +"51","devkitpro" +"51","tivoli-work-scheduler" +"51","xattribute" +"51","azure-sql" +"51","android-bottom-nav-view" +"51","rackspace-cloudfiles" +"51","tagfile" +"51","gcmlistenerservice" +"51","timemachine" +"51","android-d8" +"51","dib" +"51","dtd-parsing" +"51","polarssl" +"51","scala-metals" +"51","assemblyversions" +"51","isomorphic" +"51","tolist" +"51","tokudb" +"51","gal" +"51","penetration-tools" +"51","moto-360" +"51","respond-with" +"51","cfrunloop" +"51","movefile" +"51","get-eventlog" +"51","getfeatureinfo" +"51","spinning" +"51","eggplant" +"51","ojs" +"51","eggdrop" +"51","custom-receiver" +"51","ironmq" +"51","qgraphicspixmapitem" +"51","node-pg-pool" +"51","google-cloud-debugger" +"51","latent-semantic-indexing" +"51","command-window" +"51","angularjs-interpolate" +"51","node-https" +"51","android-photos" +"51","ipynb" +"51","node-promisify" +"51","mesh-collider" +"51","node.js-nan" +"51","ltrace" +"51","pyvenv" +"51","event-based-programming" +"51","event-arc" +"51","testrigor" +"51","spatial-data-frame" +"51","nmock" +"51","nltk-trainer" +"51","multidplyr" +"51","suitesparse" +"51","qstylesheet" +"51","array-combine" +"51","idispatchmessageinspector" +"51","zend-test" +"51","daab" +"51","prelaunch" +"51","parallel-data-warehouse" +"51","user-defined-data-types" +"51","idle-processing" +"51","thinkscript" +"51","stereotype" +"51","lingo" +"51","parse-dashboard" +"51","gkmatchmaker" +"51","sound-recognition" +"51","subsonic-active-record" +"51","limma" +"51","bigchaindb" +"51","gnu-efi" +"51","comsol" +"51","auto-build" +"51","artwork" +"51","scrolledwindow" +"51","hexagon-dsp" +"51","authz" +"51","alpine-package-keeper" +"51","compojure-api" +"50","cleverhans" +"50","matrix-synapse" +"50","probabilistic-programming" +"50","class-properties" +"50","groupstyle" +"50","flowgear" +"50","multiple-makefiles" +"50","markov-decision-process" +"50","xtradb" +"50","feedly" +"50","websvn" +"50","listmodel" +"50","php-stream-wrappers" +"50","ssis-2019" +"50","vue.draggable" +"50","primeng-treetable" +"50","phalanger" +"50","jericho-html-parser" +"50","intellitest" +"50","default.png" +"50","flutter-deep-link" +"50","packetbeat" +"50","lammps" +"50","content-tag" +"50","container-queries" +"50","unified-service-desk" +"50","biplot" +"50","package-private" +"50","impyla" +"50","fixed-point-iteration" +"50","language-switching" +"50","r-zelig" +"50","pia" +"50","ccd" +"50","apache-sshd" +"50","adm-zip" +"50","seneca" +"50","chrome-declarativenetrequest" +"50","distillery" +"50","jsencrypt" +"50","xml-generation" +"50","ng" +"50","rust-clippy" +"50","jtopen" +"50","flashplayer-10" +"50","runlevel" +"50","dataviewwebpart" +"50","diskcache" +"50","blanket.js" +"50","mariadb-10.6" +"50","grafana-dashboard" +"50","unshelve" +"50","server-migration" +"50","sharepoint-userprofile" +"50","pvrtc" +"50","waitgroup" +"50","windows-mobile-6.1" +"50","crystal-reports-2013" +"50","ora-00979" +"50","upwork-api" +"50","document.evaluate" +"50","keyrelease" +"50","gora" +"50","shared-secret" +"50","docker-command" +"50","wcf-extensions" +"50","service-object" +"50","named-routing" +"50","windows-share" +"50","sequential-number" +"50","read-uncommitted" +"50","read-text" +"50","mysql-error-1055" +"50","ora-00001" +"50","meteor-methods" +"50","optics-algorithm" +"50","routevalues" +"50","angularjs-ng-pattern" +"50","createwritestream" +"50","microsoft365-defender" +"50","avcaptureoutput" +"50","simultaneous-calls" +"50","option-strict" +"50","windows-process" +"50","upsetr" +"50","boost-ublas" +"50","pawn" +"50","openbugs" +"50","ereg-replace" +"50","openbmc" +"50","htcsense" +"50","inno-setup-v6" +"50","dynamic-delivery" +"50","appinstaller" +"50","word-table" +"50","open-flash-chart" +"50","turbo-frames" +"50","guided-access" +"50","simplecaptcha" +"50","mongodb-ruby" +"50","houghlines" +"50","boost-dynamic-bitset" +"50","cqwp" +"50","densenet" +"50","k3d" +"50","nativewindow" +"50","html5mode" +"50","html-escape" +"50","typedarray" +"50","kcat" +"50","salesforce-ios-sdk" +"50","surge.sh" +"50","online-compilation" +"50","typebuilder" +"50","dependency-graph" +"50","desktop-duplication" +"50","twelvemonkeys" +"50","azure-cost-calculation" +"50","nestjs-mongoose" +"50","jaspic" +"50","setdefault" +"50","libtcod" +"50","lwuit-resource-editor" +"50","extjs2" +"50","objectfactory" +"50","fable" +"50","google-api-objc-client" +"50","richdatatable" +"50","cocoa-sheet" +"50","rcpp11" +"50","freedesktop.org" +"50","ubuntu-14.10" +"50","btdf" +"50","sysv-ipc" +"50","a2lix-translation" +"50","pynacl" +"50","formit" +"50","system.numerics" +"50","riff" +"50","facebook-invite-friends" +"50","broadcast-channel" +"50","68hc12" +"50","viewdidlayoutsubviews" +"50","extract-value" +"50","objc-bridging-header" +"50","forward-reference" +"50","javahl" +"50","rake-test" +"50","set-based" +"50","amortization" +"50","nyquist" +"50","plexus" +"50","redhat-brms" +"50","copytree" +"50","c#-interactive" +"50","exposure" +"50","tcombobox" +"50","scipy.ndimage" +"50","tdm-gcc" +"50","nokia-imaging-sdk" +"50","conventional-commits" +"50","contentview" +"50","wxperl" +"50","dot-operator" +"50","schemaexport" +"50","xapi" +"50","itemplate" +"50","caemittercell" +"50","itemspaneltemplate" +"50","itemwriter" +"50","cachemanager" +"50","driveinfo" +"50","radscheduler" +"50","plugin.xml" +"50","diagnostic-tools" +"50","modality" +"50","dinktopdf" +"50","diophantine" +"50","xclip" +"50","continuum" +"50","uipopoverpresentationcontroller" +"50","nvidia-deepstream" +"50","npm-init" +"50","angular-gridster2" +"50","log4javascript" +"50","angular-akita" +"50","layout-inspector" +"50","collection-initializer" +"50","httppostedfile" +"50","spire" +"50","httpruntime" +"50","movies" +"50","string-utils" +"50","peoplesoft-app-engine" +"50","google-elevation-api" +"50","tether" +"50","rest-security" +"50","mpu" +"50","result-of" +"50","getmessage" +"50","memory-size" +"50","etrade-api" +"50","etcd3" +"50","react-native-config" +"50","october-form-controller" +"50","node-pre-gyp" +"50","activecampaign" +"50","react-apexcharts" +"50","project-online" +"50","mop" +"50","centura" +"50","react-final-form-arrays" +"50","getid3" +"50","cfstream" +"50","mui-x-charts" +"50","cypher-3.1" +"50","sdmx" +"50","summarytools" +"50","auto-versioning" +"50","powershell-v5.1" +"50","foreignobject" +"50","paramarray" +"50","timber-android" +"50","tfs-2017" +"50","powercfg" +"50","statusline" +"50","bazel-java" +"50","stlport" +"50","pglogical" +"50","parallel-collections" +"50","haskell-turtle" +"50","ignite-ui-angular" +"50","threaded-comments" +"50","scrolledcomposite" +"50","gmaps4rails2" +"50","tpagecontrol" +"50","subfigure" +"50","basm" +"50","sublime-build" +"50","ar-foundation" +"50","zebra-striping" +"50","compositecollection" +"50","batman.js" +"50","concourse-git-resource" +"50","mediacapture" +"50","star-schema-datawarehouse" +"50","structlayout" +"50","qsslsocket" +"50","scribble" +"50","linux-distro" +"50","pptxgenjs" +"49","react-native-popup-menu" +"49","grep-indesign" +"49","phppresentation" +"49","repmgr" +"49","slf4j-api" +"49","loadable-component" +"49","dday" +"49","multiple-sites" +"49","report-viewer2012" +"49","phpstorm-2017.2" +"49","jetbrains-toolbox" +"49","cloc" +"49","multiserver" +"49","gfs" +"49","pgo" +"49","treecontrol" +"49","feature-store" +"49","ghostdoc" +"49","whisper" +"49","vtt" +"49","termcolor" +"49","clickable-image" +"49","websocket4net" +"49","jdbi3" +"49","jdbc-postgres" +"49","programmers-notepad" +"49","clevertap" +"49","coalescing" +"49","clang-cl" +"49","groovyscriptengine" +"49","telerik-scheduler" +"49","flask-dance" +"49","jstilemap" +"49","address-operator" +"49","bindingnavigator" +"49","socketscan" +"49","make-install" +"49","votive" +"49","functional-java" +"49","run-time-polymorphism" +"49","blat" +"49","self-executing-function" +"49","semantic-zoom" +"49","semigroup" +"49","image-reader" +"49","chronograf" +"49","selenium-remotedriver" +"49","ultrawebgrid" +"49","fsck" +"49","blackberry-editfield" +"49","pick" +"49","disconnection" +"49","discord.io" +"49","imanage" +"49","p4merge" +"49","safari-content-blocker" +"49","selectcommand" +"49","language-extension" +"49","jsp-fragments" +"49","unexpectendoffile" +"49","impactjs" +"49","xmldiff" +"49","unfold" +"49","rxjs-marbles" +"49","dataset-designer" +"49","implicit-flow" +"49","apigee-baas" +"49","recursive-regex" +"49","pushy" +"49","hyperref" +"49","watermelondb" +"49","pthreads-win32" +"49","name-value" +"49","pycocotools" +"49","createtextnode" +"49","data-formats" +"49","meteor-tracker" +"49","angular-tree-component" +"49","django-oauth-toolkit" +"49","airflow-xcom" +"49","fastjson" +"49","dashboard-designer" +"49","kite" +"49","django-mailer" +"49","gpt4all" +"49","wildfly-18" +"49","sharepoint-object-model" +"49","server-farm" +"49","pxssh" +"49","read-sql" +"49","rtx" +"49","gopacket" +"49","icanhaz.js" +"49","gossip" +"49","infinispan-9" +"49","juice-ui" +"49","deployment-project" +"49","pdoc" +"49","bootstrap-icons" +"49","htdp" +"49","pdist" +"49","html-tableextract" +"49","dynamics-365-sales" +"49","samd21" +"49","invariantculture" +"49","invariance" +"49","intrusive-containers" +"49","mongodb-c" +"49","bluetooth-socket" +"49","sbt-idea" +"49","errorprone" +"49","opaque-types" +"49","initwithcoder" +"49","dynamics-crm-uci" +"49","html.listboxfor" +"49","easy-peasy" +"49","dynamic-finders" +"49","sap-smp" +"49","azure-devops-services" +"49","nsmatrix" +"49","jzy3d" +"49","superpixels" +"49","gulp-ruby-sass" +"49","postgres-14" +"49","wuapi" +"49","onrender" +"49","ooyala" +"49","pax-web" +"49","svelte-transition" +"49","svndumpfilter" +"49","jquery-multidatespicker" +"49","nshttpurlresponse" +"49","wso2-stratos" +"49","jquery-ajax" +"49","patternlab.io" +"49","libxml-ruby" +"49","buildkite" +"49","codi" +"49","8thwall-web" +"49","audioinputstream" +"49","system.speech.recognition" +"49","objectname" +"49","miragejs" +"49","cocotb" +"49","pyjamas" +"49","external-tools" +"49","external-url" +"49","rgooglemaps" +"49","libgee" +"49","codecvt" +"49","format-patch" +"49","lemon-graph-library" +"49","oclint" +"49","ubifs" +"49","netzke" +"49","vlc-qt" +"49","amp-analytics" +"49","brokeredmessage" +"49","formfield" +"49","pymoo" +"49","freeform" +"49","uipickerviewdatasource" +"49","quickdialog" +"49","refinery" +"49","nstextcontainer" +"49","nosuchmethod" +"49","mjs" +"49","android-ide" +"49","game-maker-studio-1.4" +"49","drupal-feeds" +"49","gwt-places" +"49","raddatepicker" +"49","gwt-history" +"49","xcode4.6.3" +"49","itanium" +"49","schemagen" +"49","scala-maven-plugin" +"49","uiculture" +"49","tlistbox" +"49","doze" +"49","g77" +"49","timeuuid" +"49","opentripplanner" +"49","opentest" +"49","tdatetime" +"49","todomvc" +"49","uiimageasset" +"49","dhl" +"49","exiv2" +"49","dotnet-restore" +"49","azure-managed-disk" +"49","j1939" +"49","testability" +"49","chararray" +"49","android-rom" +"49","memory-safety" +"49","test-results" +"49","android-jetpack-compose-testing" +"49","chap-links-library" +"49","storing-information" +"49","moodle-theme" +"49","omnibox" +"49","android-percentrelativelayout" +"49","getrusage" +"49","omdbapi" +"49","android-pdf-api" +"49","acumos" +"49","angular-chosen" +"49","lcds" +"49","angular-date-format" +"49","getasync" +"49","activeweb" +"49","elasticsearch-template" +"49","account-linking" +"49","cuckoo" +"49","dulwich" +"49","ldf" +"49","google-dataflow" +"49","mplab-c18" +"49","ipfw" +"49","acts-as-paranoid" +"49","color-theory" +"49","activity-monitor" +"49","qcc" +"49","qchartview" +"49","sphero" +"49","aceoledb" +"49","towerjs" +"49","webcenter-sites" +"49","pandas-ta" +"49","sortables" +"49","google-indexing-api" +"49","stdmutex" +"49","googleio" +"49","mb-convert-encoding" +"49","topography" +"49","darcs" +"49","maxreceivedmessagesize" +"49","bb-messenger" +"49","screwturn" +"49","toolstripitem" +"49","tfs-reports" +"49","flutter-material" +"49","pppd" +"49","powergui" +"49","ms-mpi" +"49","powerpacks" +"49","shazam" +"49","cvs2git" +"49","msi-patch" +"49","stuff" +"49","soundtouch" +"49","zeebe" +"49","stylegan" +"49","md-chip" +"49","linq-method-syntax" +"49","heremaps-ios-sdk" +"49","search-tree" +"49","liferay-7.1" +"49","zorba" +"49","user-generated-content" +"49","partial-index" +"48","jekyll-paginator" +"48","git-apply" +"48","relative-addressing" +"48","srid" +"48","reprojection-error" +"48","llvm-codegen" +"48","multiple-accounts" +"48","insert-id" +"48","pheanstalk" +"48","ggpattern" +"48","fluidsynth" +"48","griddle" +"48","cloudboost" +"48","react-native-modules" +"48","privacy-manifest" +"48","react-native-svg-charts" +"48","mat-pagination" +"48","figma-api" +"48","greendroid" +"48","procmon" +"48","eclipse-rcptt" +"48","react-popper" +"48","dcount" +"48","printqueue" +"48","echo-cancellation" +"48","db-schema" +"48","vue2leaflet" +"48","remote-host" +"48","client-side-rendering" +"48","flexpaper" +"48","jboss-seam" +"48","weex" +"48","freetexttable" +"48","swiftsoup" +"48","contenttemplate" +"48","rust-tonic" +"48","fileprovider-extension" +"48","xlform" +"48","cclabelttf" +"48","filtered-index" +"48","symlink-traversal" +"48","rulers" +"48","softkeys" +"48","xilinx-edk" +"48","sxs" +"48","xpath-3.0" +"48","binary-semaphore" +"48","configsection" +"48","import-libraries" +"48","fubumvc" +"48","jst" +"48","find-package" +"48","labeled-statements" +"48","jsignature" +"48","administrate" +"48","add-type" +"48","adobe-cirrus" +"48","kubernetespodoperator" +"48","oxid" +"48","playframework-json" +"48","apex-trigger" +"48","languageservice" +"48","cidetector" +"48","g++-4.7" +"48","docker-cli" +"48","wallaby.js" +"48","pybuilder" +"48","optimus" +"48","wincc" +"48","jovo-framework" +"48","validation-application-bl" +"48","aikau" +"48","ora-00911" +"48","django-rest-knox" +"48","database-integrity" +"48","kimono" +"48","aws-reserved-instances" +"48","database-theory" +"48","updatecommand" +"48","jointplot" +"48","django-pyodbc-azure" +"48","up-button" +"48","vb5" +"48","windows-hello" +"48","alacritty" +"48","rosbag" +"48","data-lakehouse" +"48","react-thunk" +"48","cakephp-3.3" +"48","name-conflict" +"48","aws-pipeline" +"48","react-table-v6" +"48","fast-math" +"48","sharepointfoundation2010" +"48","micronaut-aws" +"48","rocksdb-java" +"48","onpaste" +"48","boost-logging" +"48","pdfparser" +"48","nsstackview" +"48","cppcms" +"48","appv" +"48","sim800l" +"48","azure-cosmosdb-emulator" +"48","tsyringe" +"48","blynk" +"48","oom" +"48","grunt-browserify" +"48","monday.com" +"48","nsparagraphstyle" +"48","tyk" +"48","mod-rails" +"48","openfst" +"48","approval-tests" +"48","modx-templates" +"48","jquery-ias" +"48","jquery-ui-menu" +"48","application-layer" +"48","nsdatecomponentsformatter" +"48","sas-dis" +"48","jxpath" +"48","hosted-app" +"48","spring-cloud-security" +"48","azure-entra-id" +"48","cosu" +"48","bootstrap-form-helper" +"48","externalizable" +"48","external-display" +"48","libunwind" +"48","oslc" +"48","oslog" +"48","lumen-5.4" +"48","knpmenu" +"48","klarna" +"48","google-api-webmasters" +"48","videodisplay" +"48","rcov" +"48","libnotify" +"48","kotlin-gradle-plugin" +"48","facebook-checkins" +"48","table-calendar" +"48","lxml.objectify" +"48","objective-c-protocol" +"48","rhino-mocks-3.5" +"48","libxml-js" +"48","sysprep" +"48","view-components" +"48","pygresql" +"48","pymodbus3" +"48","system-configuration" +"48","kotlinx" +"48","viewstack" +"48","pyldavis" +"48","osx-yosemite-beta" +"48","newspaper3k" +"48","go-micro" +"48","netplan" +"48","uft-api" +"48","outer-classes" +"48","ocaml-lwt" +"48","systemevent" +"48","pyscard" +"48","f#-giraffe" +"48","qwebenginepage" +"48","gae-quotas" +"48","redux-saga-test-plan" +"48","rack-cors" +"48","node-windows" +"48","open-nfc" +"48","uinavigationbarappearance" +"48","dtplyr" +"48","redux-promise" +"48","hmacsha256" +"48","tivoli-identity-manager" +"48","openprocess" +"48","numeric-input" +"48","mobile-ffmpeg" +"48","rackup" +"48","nook" +"48","dotnetnuke-settings" +"48","non-equi-join" +"48","time-management" +"48","ismouseover" +"48","tbb-flow-graph" +"48","ml.net-model-builder" +"48","tipfy" +"48","qwizard" +"48","expo-image-picker" +"48","npmjs" +"48","tinylog" +"48","rails-sprockets" +"48","haskell-criterion" +"48","drupal-contextual-filters" +"48","drf-nested-routers" +"48","numeral.js" +"48","isparta" +"48","double-submit-prevention" +"48","rails-ujs" +"48","cub" +"48","comboboxmodel" +"48","nlg" +"48","huxtable" +"48","genericdao" +"48","reroute" +"48","lua-5.3" +"48","common-dialog" +"48","locf" +"48","lcg" +"48","splfileobject" +"48","lsh" +"48","mercadopago" +"48","google-container-builder" +"48","node.js-got" +"48","geodesic-sphere" +"48","eventreceiver" +"48","http-parameters" +"48","ios11.2" +"48","cfs" +"48","httpforbiddenhandler" +"48","nodebb" +"48","reactive-cocoa-4" +"48","lattice-diamond" +"48","ios10-today-widget" +"48","react-infinite-scroll-component" +"48","durability" +"48","resize-crop" +"48","io-uring" +"48","logstash-filter" +"48","node-oidc-provider" +"48","react-codemirror" +"48","android-parsequeryadapter" +"48","metaphone" +"48","login-system" +"48","google-cloud-automl-nl" +"48","logic-error" +"48","excel-2021" +"48","erwin" +"48","chained-assignment" +"48","perf4j" +"48","image-load" +"48","spark-checkpoint" +"48","maven-versions-plugin" +"48","webpack-bundle-analyzer" +"48","maxifs" +"48","zerorpc" +"48","msmtp" +"48","google-reviews" +"48","heap-profiling" +"48","autopy" +"48","alternate-data-stream" +"48","ushort" +"48","flutter-module" +"48","beforeupdate" +"48","theorem" +"48","zohocatalyst" +"48","webinvoke" +"48","scrumboard" +"48","qtranslate-x" +"48","cycle-detection" +"48","suiteql" +"48","asciiencoding" +"48","zoomcharts" +"48","flutter-slider" +"48","liferay-hook" +"48","qtwayland" +"48","starmap" +"48","flutter-web-browser" +"47","standard-layout" +"47","travis-ci-cli" +"47","github-pages-deploy-action" +"47","trove4j" +"47","flutter-file" +"47","proc-object" +"47","anonymity" +"47","remote-actors" +"47","graph-explorer" +"47","wechat-miniprogram" +"47","relative-date" +"47","fbsdksharekit" +"47","claudiajs" +"47","slowmotion" +"47","webviewchromium" +"47","tensorflow-data-validation" +"47","graphedit" +"47","tritonserver" +"47","eclipse-formatter" +"47","xyz" +"47","mutablestateof" +"47","basic-msi" +"47","skeletal-mesh" +"47","jboss-4.0.x" +"47","grouping-sets" +"47","mvcgrid" +"47","react-native-dropdown-picker" +"47","vue-render-function" +"47","jcmd" +"47","skvideonode" +"47","clplacemark" +"47","jcabi" +"47","bacula" +"47","xml-editor" +"47","selectbooleancheckbox" +"47","apns-sharp" +"47","physicsjs" +"47","runit" +"47","xna-3.0" +"47","ngx-chips" +"47","rust-bindgen" +"47","rust-ink" +"47","afincrementalstore" +"47","pimcore-v5" +"47","cassandra-python-driver" +"47","apfs" +"47","dismissviewcontroller" +"47","fsyacc" +"47","dismissible" +"47","incron" +"47","ujson" +"47","distriqt" +"47","phrases" +"47","managedobjectcontext" +"47","flask-assets" +"47","semantic-search" +"47","software-collections" +"47","mapsui" +"47","chromium-os" +"47","fuchsia" +"47","safety-critical" +"47","pagertabstrip" +"47","python-bytearray" +"47","method-group" +"47","django-tenants" +"47","angular-localize" +"47","n" +"47","documentclient" +"47","waypoint" +"47","pyasn1" +"47","capicom" +"47","oracle-cdc" +"47","django-parler" +"47","windows-machine-learning" +"47","na.rm" +"47","wavemaker" +"47","django-datatable" +"47","jnotify" +"47","grandchild" +"47","ice-cube" +"47","airbyte" +"47","server-core" +"47","walrus-operator" +"47","docker-push" +"47","public-key-pinning" +"47","dllmain" +"47","cakephp-routing" +"47","aws-app-config" +"47","grails3.2.0" +"47","jobrunr" +"47","cricheditctrl" +"47","wikimedia-dumps" +"47","robotframework-sshlibrary" +"47","aws-private-link" +"47","grails-searchable" +"47","grunt-contrib-jshint" +"47","grunt-contrib-jasmine" +"47","neo4j-python-driver" +"47","twilio-node" +"47","simgrid" +"47","bonferroni" +"47","sametime" +"47","oneplusone" +"47","bootstrap-dialog" +"47","saxon-c" +"47","epg" +"47","enyim" +"47","spring-oxm" +"47","opcodes" +"47","nsscroller" +"47","iommu" +"47","kaitai-struct" +"47","navigatetourl" +"47","natsort" +"47","online-store" +"47","karel" +"47","btrace" +"47","oai" +"47","gocardless" +"47","overlayitem" +"47","new-style-class" +"47","ob-get-contents" +"47","razorsql" +"47","rapidclipse" +"47","object.observe" +"47","abrecord" +"47","set-cover" +"47","pypiserver" +"47","setforegroundwindow" +"47","acc" +"47","google-bigquery-storage-api" +"47","libusbdotnet" +"47","ezaudio" +"47","osm2pgsql" +"47","ride" +"47","javascript-function-declaration" +"47","golangci-lint" +"47","virtual-printer" +"47","libgpiod" +"47","codesynthesis" +"47","amd-rocm" +"47","brk" +"47","reverse-lookup" +"47","learnr" +"47","rawimage" +"47","code-map" +"47","2-legged" +"47","uc-browser" +"47","accent-sensitive" +"47","game-boy-advance" +"47","tobjectlist" +"47","registrar" +"47","associate" +"47","rails-4-2-1" +"47","tatsu" +"47","halt" +"47","expo-web" +"47","iterator-traits" +"47","timefield" +"47","ml-studio" +"47","uic" +"47","opera-mobile" +"47","xcode14.3" +"47","spring-validation" +"47","takesscreenshot" +"47","controlfile" +"47","drop-database" +"47","exceptionmapper" +"47","xcode10.3" +"47","table-rename" +"47","exception-specification" +"47","dsbulk" +"47","continuewith" +"47","haneke" +"47","isolate" +"47","uint8list" +"47","wxnotebook" +"47","openstack-cinder" +"47","contextily" +"47","spritefont" +"47","scoped-model" +"47","tapjoy" +"47","scanline" +"47","mobile-data" +"47","asp.net-core-configuration" +"47","androidimageslider" +"47","isession" +"47","communicationexception" +"47","onappear" +"47","google-cloud-repository" +"47","common-test" +"47","prolog-assert" +"47","requestfiltering" +"47","column-types" +"47","stream-graph" +"47","laravel-package" +"47","tomee-8" +"47","morelinq" +"47","spek" +"47","testcasesource" +"47","testem" +"47","membershipreboot" +"47","humanize" +"47","cfile" +"47","irepository" +"47","logo-lang" +"47","android-mms" +"47","resource-file" +"47","ctakes" +"47","launch-configuration" +"47","text-analytics-api" +"47","leap-second" +"47","stripchart" +"47","elasticsearch-rest-client" +"47","ninjaframework" +"47","protocol-oriented" +"47","evict" +"47","http-equiv" +"47","elasticsearch-model" +"47","permissionerror" +"47","resharper-5.0" +"47","prosody-im" +"47","moxios" +"47","qjsonobject" +"47","emr-serverless" +"47","zend-filter" +"47","dapper-contrib" +"47","pandas-udf" +"47","utm-tracking" +"47","emojione" +"47","panelgrid" +"47","panel-pyviz" +"47","urlrewriter" +"47","gnuplot-iostream" +"47","bigsql" +"47","soomla" +"47","tiddlywiki5" +"47","heist" +"47","tpanel" +"47","quazip" +"47","bijection" +"47","hellosign-api" +"47","sublimetext-snippet" +"47","bilstm" +"47","thirdweb" +"47","prefixes" +"47","scrollviewreader" +"47","seaborn-objects" +"47","torii" +"47","flutter-release" +"47","subparsers" +"47","emacs-prelude" +"47","asa" +"47","useselector" +"47","style-transfer" +"47","yui2" +"47","tfs-2013" +"47","compiler-explorer" +"47","sdl-1.2" +"47","haskell-prelude" +"47","conductor" +"47","static-order-fiasco" +"47","end-of-life" +"46","intellij-scala" +"46","xslkey" +"46","lisp-macros" +"46","listbuffer" +"46","sql-server-mars" +"46","flex-mx" +"46","git-ls-files" +"46","gf" +"46","yii-relations" +"46","weld-se" +"46","react-router-relay" +"46","vue-ssr" +"46","flutter-apk" +"46","teaspoon" +"46","flowdocumentreader" +"46","stackless" +"46","debhelper" +"46","sitemappath" +"46","yahoo-maps" +"46","processing-ide" +"46","jboss-cache" +"46","fluorinefx" +"46","default-browser" +"46","materialized-path-pattern" +"46","barcode4j" +"46","private-repository" +"46","cloudevents" +"46","sslpinning" +"46","translators" +"46","temporal-difference" +"46","fluent-ribbon" +"46","chrome-ios" +"46","adornerlayer" +"46","appdomainsetup" +"46","apache-minifi" +"46","display-manager" +"46","python-applymap" +"46","cassandra-stress" +"46","jslink" +"46","apache-metamodel" +"46","distilbert" +"46","rust-no-std" +"46","mapbox-studio" +"46","ngrx-data" +"46","json-framework" +"46","unattended-processing" +"46","addr2line" +"46","cassandra-2.2" +"46","laravel-broadcast" +"46","cc-mode" +"46","content-delivery-network" +"46","nextjs-rewrites" +"46","undelete" +"46","swxmlhash" +"46","socketcluster" +"46","freetextbox" +"46","console-input" +"46","xpath-3.1" +"46","fiscal" +"46","manifest-merging" +"46","flatiron.js" +"46","unittest++" +"46","pair-programming" +"46","implicitwait" +"46","xirr" +"46","pimple" +"46","capped-collections" +"46","css-cascade" +"46","aws-ec2-instance-connect" +"46","urhosharp" +"46","wasabi" +"46","waitformultipleobjects" +"46","angular-ui-sortable" +"46","aircrack-ng" +"46","cakephp-3.6" +"46","aws-direct-connect" +"46","icu4j" +"46","ruby-test" +"46","sharefile" +"46","veeam" +"46","kiali" +"46","rsocket-java" +"46","vector-multiplication" +"46","unpkg" +"46","aws-lambda-containers" +"46","server-communication" +"46","real-time-multiplayer" +"46","google-voice-actions" +"46","rolap" +"46","server-monitoring" +"46","rocky-os" +"46","keycloak-spi" +"46","aws-control-tower" +"46","sharetribe" +"46","vcftools" +"46","avspeechutterance" +"46","aws-access-policy" +"46","servlet-3.1" +"46","publishing-site" +"46","optapy" +"46","mysql-error-1052" +"46","pulumi-python" +"46","facebook-ui" +"46","icloneable" +"46","joomla3.5" +"46","sine-wave" +"46","nantcontrib" +"46","nested-select" +"46","jviewport" +"46","dynamic-method" +"46","tycho-surefire-plugin" +"46","boost-statechart" +"46","botconnector" +"46","polymorphic-relationship" +"46","keepalived" +"46","twiki" +"46","app-thinning" +"46","mongoose-models" +"46","jwysiwyg" +"46","ioref" +"46","eot" +"46","applocker" +"46","boost-foreach" +"46","monetdblite" +"46","mongoalchemy" +"46","julia-dataframe" +"46","karate-call-single" +"46","popupmenubutton" +"46","invokemember" +"46","ioio" +"46","nspopupbuttoncell" +"46","jubula" +"46","writexl" +"46","delimited-continuations" +"46","jtreetable" +"46","htmleditorextender" +"46","entity-bean" +"46","inno-download-plugin" +"46","pebble" +"46","nrql" +"46","bootstrap-wysiwyg" +"46","nelmio-alice" +"46","app-route" +"46","crdt" +"46","wp-mail" +"46","http.server" +"46","pcre2" +"46","kaios" +"46","spring-data-hadoop" +"46","moinmoin" +"46","ospf" +"46","netty4" +"46","microsoft-query" +"46","missing-symbols" +"46","microsoft-store" +"46","ubuntu-21.04" +"46","typewriter" +"46","lyft-api" +"46","ucos" +"46","fragment-oncreateview" +"46","google-client-login" +"46","netbeans-9" +"46","oci-java-sdk" +"46","orbitcontrols" +"46",".net-security" +"46","fourcc" +"46","audioclip" +"46","netlify-cli" +"46","godot-shader-language" +"46","synclock" +"46","shodan" +"46","about-box" +"46","razor-declarative-helpers" +"46","amp-bind" +"46","extrinsic-parameters" +"46","ancova" +"46","withings" +"46","brushes" +"46","extended-precision" +"46","winghci" +"46","winginx" +"46","javafx-9" +"46","randomized-algorithm" +"46","facebook-app-settings" +"46","virtual-ip-address" +"46","difference-lists" +"46","gcc-extensions" +"46","xaml-islands" +"46","nvapi" +"46","dot.js" +"46","gcc9" +"46","hashicorp-packer" +"46","xamarin-forms-4" +"46","uibarbuttonitemstyle" +"46","galen" +"46","gatein" +"46","quil" +"46","exchange-management-shell" +"46","continuous-testing" +"46","xampp-vm" +"46","drawertoggle" +"46","asqueryable" +"46","nuxtjs2" +"46","rack-test" +"46","sqlbrite" +"46","jam" +"46","uimodaltransitionstyle" +"46","control-language" +"46","redhat-bpm" +"46","scalar-subquery" +"46","hammock" +"46","aspen" +"46","vertex-ai-pipeline" +"46","radix-tree" +"46","dotspatial" +"46","notification-area" +"46","uidocumentinteractioncontroller" +"46","xcode7-beta2" +"46","nose2" +"46","sql.js" +"46","hibernate-filters" +"46","dr-memory" +"46","qxmlstreamreader" +"46","gambling" +"46","rails-upgrade" +"46","redirect-uri" +"46","spectra" +"46","react-flatlist" +"46","spotlight-dbpedia" +"46","react-font-awesome" +"46","actualheight" +"46","google-cloud-identity-aware-proxy" +"46","duplex-channel" +"46","resize-observer" +"46","speculative-execution" +"46","low-level-code" +"46","http-range" +"46","lpeg" +"46","cufflinks" +"46","react-native-bridge" +"46","qodbc" +"46","android-ktx" +"46","qopenglwidget" +"46","android-reboot" +"46","actionform" +"46","large-title" +"46","cuda-driver" +"46","cuda-context" +"46","melpa" +"46","act" +"46","requirejs-text" +"46","memberof" +"46","hwpf" +"46","cssresource" +"46","http-status-code-303" +"46","geospark" +"46","cfpdf" +"46","mdpi" +"46","automationelement" +"46","amazon-cognito-identity-js" +"46","tpot" +"46","passive-view" +"46","zend-rest" +"46","preg-grep" +"46","scsf" +"46","mcisendstring" +"46","autoreconf" +"46","parameter-sniffing" +"46","pre-allocation" +"46","automap" +"46","beam-sql" +"46","sosex" +"46","threadcontext" +"46","tooltwist" +"46","web-feature-service" +"46","fomantic-ui" +"46","iformatprovider" +"46","linear-optimization" +"46","lidgren" +"46","google-roads-api" +"46","ihttpclientfactory" +"46","google-inbox" +"46","toplink-essentials" +"46","gluu" +"46","hbase-shell" +"46","starlark" +"46","stateless-session" +"46","glscene" +"46","maven-reactor" +"46","flyspell" +"45","git-describe" +"45","graphdiff" +"45","jcodemodel" +"45","tree-search" +"45","yii-routing" +"45","ggh4x" +"45","cmdb" +"45","squashfs" +"45","wheelnav.js" +"45","ant-media-server-sdk" +"45","stackage" +"45","click-tracking" +"45","eazfuscator" +"45","feature-scaling" +"45","insert-query" +"45","babel-core" +"45","jet-engine" +"45","sktime" +"45","jets3t" +"45","llc" +"45","relaunch" +"45","progmem" +"45","multimodal" +"45","vte" +"45","page-replacement" +"45","binding-context" +"45","findoneandupdate" +"45","xmobar" +"45","runtime-environment" +"45","cdb" +"45","kyotocabinet" +"45","smart-quotes" +"45","unittest2" +"45","python-binance" +"45","xop" +"45","connectiq" +"45","play-framework-2.7" +"45","fullcalendar-2" +"45","conll" +"45","ultimate-member" +"45","displayname-attribute" +"45","python-cmd" +"45","firefox-android" +"45","constantfolding" +"45","kube-scheduler" +"45","jtapi" +"45","oxm" +"45","flattr" +"45","apache-spark-1.5" +"45","date-histogram" +"45","xml-encoding" +"45","pitch-detection" +"45","xmlelement" +"45","directory-tree" +"45","django-sphinx" +"45","dnsimple" +"45","django-custom-manager" +"45","watson-knowledge-studio" +"45","createremotethread" +"45","docker-logs" +"45","cryptanalysis" +"45","csound" +"45","server-load" +"45","crosswalk-project" +"45","oraclecommand" +"45","w3wp.exe" +"45","vector-auto-regression" +"45","crf++" +"45","sharepoint-addin" +"45","unobtrusive" +"45","kfp" +"45","vctrs" +"45","aws-msk-connect" +"45","datadetectortypes" +"45","go-packages" +"45","fall-through" +"45","pugxmultiuserbundle" +"45","gramex" +"45","pssnapin" +"45","jotform" +"45","pwabuilder" +"45","mi" +"45","wikibase" +"45","datagridviewcellstyle" +"45","anjuta" +"45","agda-mode" +"45","myo" +"45","dataguard" +"45","rsvg" +"45","facebook-sdk-3.14.x" +"45","facebook-python-business-sdk" +"45","react-tooltip" +"45","failed-to-connect" +"45","rebalancing" +"45","input-buffer" +"45","application-blocks" +"45","kamon" +"45","kaboom" +"45","one-click-web-publishing" +"45","kde4" +"45","mongo-go-driver" +"45","grunt-contrib-imagemin" +"45","tweedie" +"45","nested-properties" +"45","bpython" +"45","azure-custom-domain" +"45","dependency-resolution" +"45","mongodb.driver" +"45","springdoc-openui" +"45","enterprise-portal" +"45","easy-digital-downloads" +"45","couchrest" +"45","jquery-1.8" +"45","azure-dsvm" +"45","opendap" +"45","dynamic-class" +"45","mongodb-lookup" +"45","intermec" +"45","intermediate-code" +"45","grunt-wiredep" +"45","dynamic-view" +"45","jquery-attributes" +"45","gs1-ai-syntax" +"45","nslayoutanchor" +"45","jquery-resizable" +"45","ingest" +"45","typemock-isolator" +"45","type-members" +"45","java-print" +"45","google-aiy" +"45","uia" +"45","ratchet-bootstrap" +"45","occlusion-culling" +"45","code-server" +"45","lunrjs" +"45","shinydashboardplus" +"45","systemexit" +"45","winexe" +"45","midi-instrument" +"45","magic-function" +"45","netdata" +"45","system-identification" +"45","freebasic" +"45","dosgi" +"45","extjs6.5" +"45","goclipse" +"45","oasis" +"45","gobblin" +"45","google-blogger-api" +"45","formborderstyle" +"45","missing-template" +"45","lync-server-2010" +"45","asus-xtion" +"45","shorthand-if" +"45","iterated-function" +"45","openhardwaremonitor" +"45","drupal-ctools" +"45","hono" +"45","bungeecord" +"45","devpi" +"45","railsinstaller" +"45","hash-code-uniqueness" +"45","xamarin-live-player" +"45","halogen" +"45","spweb" +"45","expo-auth-session" +"45","dgl" +"45","radosgw" +"45","gedcom" +"45","gwtupload" +"45","mkmapsnapshotter" +"45","gwttestcase" +"45","railtie" +"45","highpass-filter" +"45","android-designer" +"45","sqitch" +"45","built-value" +"45","gembox-document" +"45","xai" +"45","collocation" +"45","progressmonitor" +"45","resource-loading" +"45","iredmail" +"45","android-jetpack-compose-tv" +"45","ipmitool" +"45","angular-cli-v9" +"45","activerecord-import" +"45","colt" +"45","tomography-reconstruction" +"45","resolveurl" +"45","excel-dates" +"45","angular-broadcast" +"45","geolite2" +"45","terraform-provider-vsphere" +"45","moonlight" +"45","lazy-high-charts" +"45","google-cloud-ops-agent" +"45","resilience4j-retry" +"45","geostatistics" +"45","storable" +"45","angular2-moment" +"45","node-archiver" +"45","storekit2" +"45","angular2-injection" +"45","request.servervariables" +"45","stripe-payments-js" +"45","generative" +"45","character-entities" +"45","spoof" +"45","qcoreapplication" +"45","property-files" +"45","laravel-octane" +"45","cfsocket" +"45","spine" +"45","protobuf-csharp-port" +"45","zend-log" +"45","pgi-accelerator" +"45","sparrow-framework" +"45","ember.js-view" +"45","mediatorlivedata" +"45","aliexpress" +"45","ms-access-data-macro" +"45","google-keep" +"45","pre-rendering" +"45","google-maps-autocomplete" +"45","mclust" +"45","light-4j" +"45","sonarqube5.2" +"45","footprint" +"45","archilogic" +"45","soundfont" +"45","spark-operator" +"45","enaml" +"45","mediawiki-installation" +"45","amazon-marketplace" +"45","quaggajs" +"45","compiled-language" +"45","powershell-dsc" +"45","total-commander" +"45","enet" +"45","hfs+" +"45","timagelist" +"45","almond" +"45","webdrivermanager-python" +"45","partial-trust" +"45","sorttable.js" +"45","conceptual-model" +"45","usebean" +"45","array-unset" +"45","question2answer" +"45","pass-by-name" +"45","customtool" +"45","google-product-search" +"45","identitymanager" +"45","spark-excel" +"45","webget" +"44","vue-property-decorator" +"44","editablegrid" +"44","gridviewrow" +"44","tedgebrowser" +"44","graylog3" +"44","greenhopper" +"44","clickstream" +"44","truestudio" +"44","multiplechoicefield" +"44","material-you" +"44","stackalloc" +"44","ddl-trigger" +"44","claims-authentication" +"44","git-bundle" +"44","wdio-v5" +"44","yguard" +"44","clearcase-automation" +"44","react-native-text" +"44","react-native-share" +"44","econnect" +"44","program-slicing" +"44","deadbolt-2" +"44","deadbolt" +"44","react-native-pdf" +"44","cobol85" +"44","flutter-devtools" +"44","yesod-forms" +"44","ecmascript-intl" +"44","programdata" +"44","imap-tools" +"44","catboostregressor" +"44","g++4.9" +"44","symfony-http-client" +"44","switch-user" +"44","labelimg" +"44","soapexception" +"44","contacts-framework" +"44","contact-list" +"44","vrtk" +"44","xmlschemaset" +"44","nginx-upstreams" +"44","adplus" +"44","snowflake-stage" +"44","jstree-dnd" +"44","nhapi" +"44","fromhtml" +"44","aerospike-ce" +"44","cellinfo" +"44","afhttpclient" +"44","umts" +"44","smbj" +"44","filenet-process-engine" +"44","xmpp4r" +"44","vscode-liveshare" +"44","datemodified" +"44","bit-representation" +"44","package-info" +"44","firefox-headless" +"44","distroless" +"44","consensys-truffle" +"44","carousel-slider" +"44","flask-httpauth" +"44","finatra" +"44","python-standalone" +"44","flask-caching" +"44","bing-translator-api" +"44","bindservice" +"44","fairseq" +"44","gpu-warp" +"44","upickle" +"44","root-access" +"44","jpct" +"44","recognizer-intent" +"44","rodeo" +"44","sipml" +"44","ibis" +"44","i18next-http-backend" +"44","optional-binding" +"44","simplex-algorithm" +"44","data-filtering" +"44","fastjsonapi" +"44","calendarkit" +"44","keyeventargs" +"44","microsoft-commerce-server" +"44","robotjs" +"44","serverless-plugins" +"44","crystal-reports-2011" +"44","unity-components" +"44","favorite" +"44","shareplum" +"44","n3" +"44","windowsformsintegration" +"44","akita" +"44","angularjs-ng-checked" +"44","canjs-model" +"44","wcf-4" +"44","icloud-documents" +"44","grads" +"44","aws-sct" +"44","ibm-domino" +"44","rowsorter" +"44","recursive-mutex" +"44","rtmps" +"44","jml" +"44","shared-variable" +"44","aws-networking" +"44","avro4s" +"44","cri-o" +"44","ruby-2.6" +"44","joinfaces" +"44","fastavro" +"44","window-position" +"44","rostering" +"44","session-store" +"44","covariant-return-types" +"44","detailtextlabel" +"44","ws-reliablemessaging" +"44","azure-database-postgresql" +"44","postman-native-app" +"44","apple-app-site-association" +"44","native-file-system-api-js" +"44","spring-integration-mqtt" +"44","nehotspothelper" +"44","neo4j-graphql-js" +"44","approximate-nn-searching" +"44","kazoo" +"44","mojolang" +"44","wrds" +"44","ararat-synapse" +"44","justpy" +"44","simctl" +"44","nested-datalist" +"44","scala-implicits" +"44","html-frames" +"44","inproc" +"44","swifter" +"44","tvos9.1" +"44","wordpress-json-api" +"44","mongodb-cluster" +"44","sap-cpi" +"44","pattern-layout" +"44","simile" +"44","wpforms" +"44","aws-session-manager" +"44","guardian" +"44","boost-proto" +"44","pdfobject" +"44","android-video-record" +"44","boxsizer" +"44","intersystems-iris" +"44","path-2d" +"44","epp" +"44","nested-transactions" +"44","win-phone-silverlight-8.1" +"44","minibuffer" +"44","orbited" +"44","ezplatform" +"44","ktlint" +"44","javascript-security" +"44","klaxon" +"44","system-services" +"44","t4scaffolding" +"44","netty-socketio" +"44","kotlin-java-interop" +"44","netbox" +"44","android-a11y" +"44","ezsql" +"44","millennial-media" +"44","visual-studio-shell" +"44","orientdb3.0" +"44","known-folders" +"44","aswebauthenticationsession" +"44","obfuscar" +"44","ocs" +"44","bscscan" +"44","ocsigen" +"44","java-interop" +"44","m4v" +"44","lustre" +"44","async-iterator" +"44","nvvp" +"44","sysdba" +"44","rete" +"44","dom-to-image" +"44","wordpad" +"44","libstreaming" +"44","libopencm3" +"44","java-binding" +"44","syswow64" +"44","system.windows.media" +"44","lz77" +"44","attachevent" +"44","viber-bot" +"44","knative-eventing" +"44","netdatacontractserializer" +"44","viber-api" +"44","tls1.1" +"44","sqlcompare" +"44","jammit" +"44","tailwind-elements" +"44","sqlcode" +"44","cachestorage" +"44","uidocumentbrowservc" +"44","geemap" +"44","highrise" +"44","isqlquery" +"44","gvm" +"44","harvest" +"44","openxml-powertools" +"44","android-debugging" +"44","hive-configuration" +"44","mkdocs-material" +"44","ithit-ajax-file-browser" +"44","azure-web-pubsub" +"44","qz-tray" +"44","xamarin-linker" +"44","caa" +"44","plottable" +"44","drawingvisual" +"44","asterisk-ari" +"44","xamarin-android-player" +"44","android-custom-keyboard" +"44","hibernate-types" +"44","sql-graph" +"44","drupal-search" +"44","conv1d" +"44","sqlbuilder" +"44","xcode-build-settings" +"44","gdelt" +"44","react-link" +"44","color-conversion" +"44","color-coding" +"44","csv-parser" +"44","laravel-ui" +"44","color-blindness" +"44","node.js-tape" +"44","qresource" +"44","gentelella" +"44","spatial-data" +"44","project-properties" +"44","qfilesystemwatcher" +"44","ip-fragmentation" +"44","exactly-once" +"44","chakra" +"44","e-signature" +"44","actionsheet" +"44","zune" +"44","angular2-guards" +"44","event-stream-processing" +"44","testing-strategies" +"44","specular" +"44","dub" +"44","google-cloud-ai-platform-pipelines" +"44","perl-xs" +"44","nltk-book" +"44","leader" +"44","octoprint" +"44","react-component-unmount" +"44","qmutex" +"44","perplexity" +"44","lsusb" +"44","text-comparison" +"44","stress" +"44","prcomp" +"44","torchserve" +"44","subst" +"44","prebid" +"44","armclang" +"44","thejit" +"44","topendialog" +"44","ember-i18n" +"44","bea" +"44","big5" +"44","google-refine" +"44","state-machine-workflow" +"44","themeprovider" +"44","webgl-globe" +"44","zend-lucene" +"44","gnu-arm" +"44","transform-feedback" +"44","emcc" +"44","parquet-mr" +"44","amazon-alb" +"44","gnumeric" +"44","bats-core" +"44","computed-style" +"44","glrotate" +"44","arcgis-android-api" +"44","tia-portal" +"44","touchjson" +"44","solaris-studio" +"44","power-off" +"44","tightly-coupled-code" +"44","dali" +"44","ikimageview" +"44","multibyte-functions" +"44","multibyte-characters" +"44","pantheios" +"44","sourcelink" +"44","powershell-az-module" +"44","powershell-jobs" +"44","spark-framework" +"43","floyd-cycle-finding" +"43","llama3" +"43","sskeychain" +"43","installshield-2015" +"43","multiple-gpu" +"43","php-phantomjs" +"43","prism-7" +"43","sshkit" +"43","jcasc" +"43","tsoa" +"43","gitahead" +"43","git-filter" +"43","bank-conflict" +"43","tello-drone" +"43","triton" +"43","antimalware" +"43","local-functions" +"43","programming-pearls" +"43","prezto" +"43","intellij-inspections" +"43","cmb2" +"43","clam" +"43","fieldcodes" +"43","antlr4cs" +"43","background-blend-mode" +"43","cmenu" +"43","decal" +"43","location-based-service" +"43","grouped-collection-select" +"43","sql-variant" +"43","symfit" +"43","casing" +"43","phpwkhtmltopdf" +"43","rxalamofire" +"43","check-digit" +"43","dist-zilla" +"43","datastax-php-driver" +"43","rjb" +"43","mariadb-connect-engine" +"43","page-transition" +"43","apartments" +"43","xonsh" +"43","firebase-machine-learning" +"43","python-responses" +"43","ftgl" +"43","flask-sockets" +"43","pact-java" +"43","pythonmagick" +"43","pip-tools" +"43","xpce" +"43","fslex" +"43","next-pwa" +"43","umount" +"43","snmptrapd" +"43","django-countries" +"43","aerogear" +"43","cefglue" +"43","datalength" +"43","chruby" +"43","x-dwm" +"43","semplot" +"43","ccr" +"43","syn" +"43","image-stabilization" +"43","chrome-app-developer-tool" +"43","pkcs#5" +"43","freezable" +"43","python-contextvars" +"43","s2i" +"43","adoconnection" +"43","ngx-echarts" +"43","immutablelist" +"43","chips" +"43","readlink" +"43","keynotfoundexception" +"43","mysql.sock" +"43","rnoaa" +"43","microsoft.build" +"43","optix" +"43","crlf-vulnerability" +"43","angularjs-ng-touch" +"43","django-rest-swagger" +"43","django-generic-relations" +"43","rubyxl" +"43","recess" +"43","ib-insync" +"43","servicestack-auth" +"43","cryptographicexception" +"43","rmstore" +"43","jotai" +"43","createwindowex" +"43","awr" +"43","capstone" +"43","keyboard-maestro" +"43","grapecity" +"43","ptr-vector" +"43","fastmember" +"43","rkt" +"43","akka.net-persistence" +"43","role-manager" +"43","callblocking" +"43","wbem" +"43","psreadline" +"43","mysql-error-2003" +"43","angular-ngfor" +"43","mysql-error-1442" +"43","ora-06512" +"43","bluegiga" +"43","oneupuploaderbundle" +"43","android-wear-complication" +"43","bnfc" +"43","errbot" +"43","password-checker" +"43","hostmonster" +"43","infineon" +"43","nsdiffabledatasourcesnapshot" +"43","jquery-globalization" +"43","jquery-2.0" +"43","inline-scripting" +"43","onepage-scroll" +"43","payload-cms" +"43","azure-data-catalog" +"43","svgwrite" +"43","html5-notifications" +"43","sas-metadata" +"43","sap-business-application-studio" +"43","enumerated-types" +"43","aws-storage-gateway" +"43","springrunner" +"43","spring-data-graph" +"43","kafka-transactions-api" +"43","demographics" +"43","apptainer" +"43","bond" +"43","apple-login" +"43","envi" +"43","asymmetric" +"43","typeorm-datamapper" +"43","rich-notifications" +"43","riak-cs" +"43","revenue" +"43","visual-c++-2017" +"43","vim-powerline" +"43","netldap" +"43","golint" +"43","mailchimp-api-v3" +"43","fosfacebookbundle" +"43","netflix-conductor" +"43","javascript-globalize" +"43","browscap" +"43","setup.exe" +"43","rexcel" +"43","btrieve" +"43","richtextediting" +"43","asynchronous-postback" +"43","abstract-algebra" +"43","rblpapi" +"43","overlapping-instances" +"43","video-memory" +"43","java-nio" +"43","pystray" +"43","typeinitializeexception" +"43","external-dns" +"43","ossec" +"43","formencode" +"43","visual-inheritance" +"43","lfsr" +"43","extreme-programming" +"43","learn-ruby-the-hard-way" +"43","colcon" +"43","signatures" +"43","regexkitlite" +"43","aspnetcore-environment" +"43","gauss" +"43","azure-releases" +"43","aspnetzero" +"43","refinements" +"43","numbered-list" +"43","radium" +"43","galileo" +"43","scala-pickling" +"43","mobile-angular-ui" +"43","x509trustmanager" +"43","table-lock" +"43","npcap" +"43","xamarin.forms.entry" +"43","diaspora" +"43","pn532" +"43","continuous-forms" +"43","devicecheck" +"43","itunesartwork" +"43","xamarin.shell" +"43","handshaking" +"43","rails7" +"43","xamarin.winphone" +"43","isolation-forest" +"43","astral-plane" +"43","android-data-usage" +"43","hashgraph" +"43","wxglade" +"43","dragonboard" +"43","vert.x-webclient" +"43","hierarchical-trees" +"43","content-values" +"43","rag" +"43","sql-server-administration" +"43","assemblyresolve" +"43","openshift-online" +"43","nuclio" +"43","diffmerge" +"43","gw-basic" +"43","c++builder-10.1-berlin" +"43","policyfiles" +"43","quickform" +"43","scmmanager" +"43","nolearn" +"43","nix-flake" +"43","pep8-assembly" +"43","storagefolder" +"43","android-jetpack-compose-ui" +"43","move-lang" +"43","hummus.js" +"43","react-multi-carousel" +"43","generic.xaml" +"43","huawei-account" +"43","android-lazyloading" +"43","angular-injector" +"43","mercury" +"43","charms-bar" +"43","responder-chain" +"43","collaborative" +"43","movieplayer" +"43","pfloginviewcontroller" +"43","geotargetting" +"43","chainlink-keepers" +"43","geshi" +"43","angularbuild" +"43","perl-tidy" +"43","eviews" +"43","qquickwidget" +"43","eventvalidation" +"43","request-queueing" +"43","texttemplate" +"43","mootools1.2" +"43","laravel-mix-vue3" +"43","curry-howard" +"43","react-ace" +"43","qabstractitemview" +"43","active-objects" +"43","spectral-python" +"43","elasticsearch-8" +"43","spray-dsl" +"43","pep517" +"43","git-review" +"43","web-mining" +"43","third-normal-form" +"43","mru" +"43","google-search-platform" +"43","alpaca" +"43","tpc" +"43","cvxr" +"43","panoramio" +"43","libyuv" +"43","structured-concurrency" +"43","qt-vs-addin" +"43","biicode" +"43","partcover" +"43","emm" +"43","mt" +"43","conan-2" +"43","arviz" +"43","git-mv" +"43","multi-configuration" +"43","amazon-product-advertising-api" +"43","transformation-matrix" +"43","gl-matrix" +"43","google-php-sdk" +"43","scrollrect" +"43","tfs-alerts" +"43","secure-element" +"43","premailer" +"43","daq-mx" +"43","google-plus-domains" +"43","precompiler" +"43","parsefacebookutils" +"43","structr" +"43","web-client" +"43","heron" +"43","google-streetview-publish" +"42","slurp" +"42","match-recognize" +"42","banana-pi" +"42","xwork" +"42","cloudconvert" +"42","ecryptfs" +"42","masonry-ios-osx" +"42","intellij-idea-2018" +"42","wdio-v6" +"42","define-syntax" +"42","defaultifempty" +"42","ssis-connection-manager" +"42","troff" +"42","graphql-php" +"42","ec2-userdata" +"42","defaultazurecredential" +"42","process-control" +"42","jboss-portal" +"42","loadcontrol" +"42","gideros" +"42","xtype" +"42","clipboard-interaction" +"42","file-find" +"42","skulpt" +"42","jest-preset-angular" +"42","ghost4j" +"42","multiple-variable-return" +"42","ghcr" +"42","baseline-profile" +"42","debug-diagnostic-tool" +"42","intel-8080" +"42","matlab-spm" +"42","mvccontrib-testhelper" +"42","phonertc" +"42","mvp4g" +"42","skcropnode" +"42","flutter-background" +"42","telerik-test-studio" +"42","app-globalresources" +"42","chrome-profile" +"42","appassembler" +"42","chopper" +"42","adodbapi" +"42","data-profiling" +"42","jtemplates" +"42","addremoveprograms" +"42","jscharts" +"42","filtered" +"42","consuming" +"42","confluent-kafka-go" +"42","platform-agnostic" +"42","cart-analysis" +"42","fink" +"42","aparapi" +"42","flashlite" +"42","volar" +"42","bitmapdrawable" +"42","rxcpp" +"42","bitcount" +"42","freestanding" +"42","makemaker" +"42","swiftystorekit" +"42","xmlcatalog" +"42","sa" +"42","xmllist" +"42","page.js" +"42","xml-literals" +"42","pagefile" +"42","image-slider" +"42","ftpwebresponse" +"42","vscode-jsconfig" +"42","django-auth-models" +"42","xlm" +"42","fvm" +"42","xdoclet" +"42","fxcopcmd" +"42","pairplot" +"42","uniobjects" +"42","manifold" +"42","pandas-merge" +"42","seetest" +"42","cargo-maven2-plugin" +"42","fsharpchart" +"42","rsi" +"42","ruff" +"42","fastlane-deliver" +"42","aws-glue-workflow" +"42","ora-01017" +"42","aws-datasync" +"42","unity-dots" +"42","data-gateway" +"42","waitforexit" +"42","real-number" +"42","sitecore-analytics" +"42","validationgroup" +"42","docker-ucp" +"42","servicestack-autoquery" +"42","windows-98" +"42","iaik-jce" +"42","windows-7-embedded" +"42","native-aot" +"42","keycloak-angular" +"42","kinect-interaction" +"42","gpuimagestillcamera" +"42","datagridviewimagecolumn" +"42","dockerignore" +"42","angular-ui-tabset" +"42","databasedotcom-gem" +"42","shared-access-signatures" +"42","roweditor" +"42","icd" +"42","rollovers" +"42","gst-launch-1.0" +"42","borb" +"42","nsblockoperation" +"42","wrk" +"42","wsit" +"42","boost-random" +"42","delphi-10.4.2" +"42","guard-statement" +"42","guideline-support-library" +"42","nslock" +"42","jquery-get" +"42","neo4j-bolt" +"42","hotwire" +"42","jquery-trigger" +"42","error-list" +"42","twrequest" +"42","nestjs-fastify" +"42","htonl" +"42","turbo-prolog" +"42","aps" +"42","openfin" +"42","mod-proxy-balancer" +"42","cppwinrt" +"42","sap-hr" +"42","appledoc" +"42","sbml" +"42","html-renderer" +"42","powerapps-portal" +"42","postgresql-8.2" +"42","workflow-foundation-4.5" +"42","paypal-pdt" +"42","u8darts" +"42","typescript2.1" +"42","vimeo-ios" +"42","luasql" +"42","rex" +"42","mill" +"42","javafx-tableview" +"42","raw-loader" +"42","code-security" +"42","vivus" +"42","extrafont" +"42","outline-view" +"42","outlining" +"42",".net-runtime" +"42","object-code" +"42","rank-n-types" +"42","audiosegment" +"42","kotlin-symbol-processing" +"42","formstack" +"42","javascript-decorators" +"42","pyfcm" +"42","mio" +"42","o365security-compliance" +"42","coinduction" +"42","new-item" +"42","form-layout" +"42","facebook-debugger" +"42","virtual-drive" +"42","bubblewrap" +"42","kotlin-companion" +"42","devsecops" +"42","mobileiron" +"42","radajaxmanager" +"42","redislabs" +"42","rails-generators" +"42","horde" +"42","novnc" +"42","pljson" +"42","tagless-final" +"42","nuodb" +"42","drupal-ajax" +"42","hasattr" +"42","scoped-ptr" +"42","taction" +"42","hardening" +"42","azure-sphere" +"42","racket-student-languages" +"42","expandable-table" +"42","time-estimation" +"42","bundletransformer" +"42","sql-except" +"42","associated-domains" +"42","cordova-media-plugin" +"42","racsignal" +"42","tobase64string" +"42","hl7-v3" +"42","itunes-search-api" +"42","nszombieenabled" +"42","mobclix" +"42","task-management" +"42","highgui" +"42","opengl-2.0" +"42","openwebbeans" +"42","azure-private-dns" +"42","qwerty" +"42","notary" +"42","notesview" +"42","azure-hub" +"42","android-exifinterface" +"42","cfthread" +"42","activitykit" +"42","hudson-api" +"42","geonetwork" +"42","column-oriented" +"42","iotivity" +"42","european-data-format" +"42","gethostbyaddr" +"42","generic-interface" +"42","spotless" +"42","qjsengine" +"42","hxcpp" +"42","offscreen-canvas" +"42","node-imap" +"42","leaflet-draw" +"42","low-level-api" +"42","okuma" +"42","metadatatype" +"42","streaming-flv-video" +"42","stringcollection" +"42","ehcache-2" +"42","perldoc" +"42","ei" +"42","protocolexception" +"42","teststack" +"42","hygiene" +"42","chartjs-plugin-annotation" +"42","spmd" +"42","messagingcenter" +"42","protostuff" +"42","latex-suite" +"42","terr" +"42","logits" +"42","hyperhtml" +"42","react-native-ble-manager" +"42","cfgrib" +"42","monotorrent" +"42","react-aad-msal" +"42","spgridview" +"42","cometchat" +"42","elasticsearch-geo-shape" +"42","mongovue" +"42","transformable" +"42","google-perftools" +"42","alternation" +"42","helium" +"42","msf4j" +"42","scriptcontrol" +"42","alt-key" +"42","argo-events" +"42","msn-messenger" +"42","limejs" +"42","compilation-time" +"42","arrayindexoutofboundsexception" +"42","hermite" +"42","global.asa" +"42","heritrix" +"42","webiopi" +"42","usermetadata" +"42","soundcloud-stratus" +"42","d3.geo" +"42","thegraph" +"42","top-down" +"42","enforcement" +"42","webbot" +"42","igx-grid" +"42","flutter-row" +"42","starter-kits" +"42","git-rerere" +"42","dart-packages" +"42","has-many-polymorphs" +"42","idempiere" +"42","web-farm-framework" +"42","webactivator" +"42","cxml" +"42","quadratic-curve" +"42","lifecycle-hook" +"42","southeast-asian-languages" +"42","avalara" +"41","mathgl" +"41","mutating-function" +"41","multistage-pipeline" +"41","jedi-code-library" +"41","clientwebsocket" +"41","skeffectnode" +"41","mutablemap" +"41","sql-session-state" +"41","jetbrains-fleet" +"41","jcommander" +"41","telerik-ajax" +"41","fetch-mock" +"41","size-type" +"41","sre" +"41","website-hosting" +"41","skbio" +"41","groovyclassloader" +"41","sketchware" +"41","fedora-commons" +"41","vue-good-table" +"41","tscrollbox" +"41","fluent-design" +"41","dc" +"41","class-eval" +"41","bartintcolor" +"41","cmfctoolbar" +"41","bartender" +"41","treetagger" +"41","white-box" +"41","dddd" +"41","edirectory" +"41","easyxdm" +"41","fluentlenium" +"41","clickablespan" +"41","ansible-ad-hoc" +"41","yii2-rbac" +"41","fluentvalidation-2.0" +"41","barman" +"41","bare-metal-server" +"41","safe-publication" +"41","managed-vm" +"41","ccnode" +"41","binary-log" +"41","cbuttoncolumn" +"41","dirtyread" +"41","bing-speech" +"41","pact-net" +"41","unicast" +"41","ng-html2js" +"41","ng-flow" +"41","bitcore" +"41","apikit" +"41","s" +"41","ada2012" +"41","xfire" +"41","snowflake-pipe" +"41","disable-link" +"41","api-security" +"41","python-language-server" +"41","mainbundle" +"41","firepad" +"41","ngx-monaco-editor" +"41","rvmrc" +"41","ci-merchant" +"41","cartogram" +"41","appendtext" +"41","vscode-api" +"41","json-flattener" +"41","divshot" +"41","adobe-connect" +"41","imapx" +"41","language-binding" +"41","chomsky-hierarchy" +"41","markdown-it" +"41","socks5" +"41","socketstream" +"41","dockerode" +"41","wiki-markup" +"41","public-key-exchange" +"41","sitecore-sxa" +"41","r-neo4j" +"41","operationcontext" +"41","vary" +"41","gradle-daemon" +"41","shared-resource" +"41","oracle-analytics" +"41","vdm++" +"41","dnsjava" +"41","django-viewsets" +"41","unity-test-framework" +"41","service-model" +"41","doh" +"41","nachos" +"41","jform-designer" +"41","session-affinity" +"41","n-ary-tree" +"41","gradle-multi-project-build" +"41","document-class" +"41","winamp" +"41","pyarango" +"41","rsa-key-fingerprint" +"41","wasmtime" +"41","oracle-cloud-infrastructure-classic" +"41","valuetask" +"41","afx" +"41","pure-layout" +"41","windows-phone-emulator" +"41","hyperstack" +"41","hyperscript" +"41","rpres" +"41","readkey" +"41","w3m" +"41","oracle-rac" +"41","sips" +"41","verbatim" +"41","wpf-4.5" +"41","jupyterbook" +"41","design-time-data" +"41","html-tbody" +"41","opendatabase" +"41","androidx-test" +"41","svn-server" +"41","tuxedo" +"41","blitz++" +"41","monadplus" +"41","postcss-import" +"41","braille" +"41","module-map" +"41","wpf-mediakit" +"41","nsrunningapplication" +"41","cp-optimizer" +"41","sbv" +"41","entitycollection" +"41","infinitest" +"41","nsdialogs" +"41","tumblr-html" +"41","jquery-ui-progressbar" +"41","nestjs-graphql" +"41","mongo-jackson-mapper" +"41","nsnetservicebrowser" +"41","posprinter" +"41","pdal" +"41","jquery-nestable" +"41","devcon" +"41","blender-2.61" +"41","corosync" +"41","sap-crm" +"41","jquery-confirm" +"41","spring-resource-server" +"41","boltdb" +"41","aurelia-fetch-client" +"41","pymeshlab" +"41","middy" +"41","rapi" +"41","visual-studio-package" +"41","kmongo" +"41","java-collections-api" +"41","5g" +"41","domaindatasource" +"41","libmysqlclient" +"41","rightfax" +"41","libxl" +"41","google-alloydb" +"41","winmd" +"41","libtool-xcode" +"41","viewanimator" +"41","formkit" +"41","systemjs-builder" +"41","virtual-disk" +"41","androidasync-koush" +"41","rapid-prototyping" +"41","magento-1.13" +"41","window-style" +"41","visual-c++-2010-express" +"41","augmented-assignment" +"41","river-crossing-puzzle" +"41","macrodef" +"41","rdrand" +"41","wind-river-workbench" +"41","systemdynamics" +"41","pytest-qt" +"41","setwd" +"41","viml" +"41","american-fuzzy-lop" +"41","opennmt" +"41","dropbear" +"41","vertx3" +"41","drawingarea" +"41","schemaspy" +"41","highlightjs" +"41","aspmenu-control" +"41","redland" +"41","asp.net-mvc-filters" +"41","hibernateexception" +"41","ntvs" +"41","double-byte" +"41","gdbm" +"41","gwt-2.4" +"41","polymer-elements" +"41","versionupgrade" +"41","policy-gradient-descent" +"41","notification-bar" +"41","h.323" +"41","expo-sqlite" +"41","uigraphicsimagerenderer" +"41","expresso" +"41","quill.io" +"41","uikeycommand" +"41","j2v8" +"41","c++builder-10.4-sydney" +"41","executable-format" +"41","sqldb" +"41","iso-3166" +"41","uiapplicationshortcutitem" +"41","tcomb-form-native" +"41","timelion" +"41","mod-auth" +"41","xamarin.forms.labs" +"41","ivalidatableobject" +"41","tinkergraph" +"41","tasklet" +"41","iranges" +"41","omniauth-linkedin" +"41","messagebird" +"41","cfimage" +"41","character-trimming" +"41","chatbase" +"41","hybrid-cloud" +"41","mouseleftbuttondown" +"41","testfairy" +"41","geo-replication" +"41","google-cloud-resource-manager" +"41","http-digest" +"41","lts" +"41","acsl" +"41","response-entity" +"41","office-online-server" +"41","qextserialport" +"41","curity" +"41","active-pattern" +"41","medusajs" +"41","ios-3.x" +"41","spill-range" +"41","layered-windows" +"41","respondstoselector" +"41","geoext" +"41","pyv8" +"41","spike" +"41","onactionexecuting" +"41","nodename" +"41","zero-pad" +"41","searchqueryset" +"41","google-profiles-api" +"41","gmail-pop" +"41","autodesk-realitycapture" +"41","searchdisplaycontroller" +"41","msp432" +"41","alt-attribute" +"41","webpack-config" +"41","sunone" +"41","zentest" +"41","gmsa" +"41","global-object" +"41","arrange-act-assert" +"41","qtgstreamer" +"41","com-server" +"41","light-sensor" +"41","lightstreamer" +"41","tradeoff" +"41","thredds" +"41","mt19937" +"41","parity-io" +"41","shellshock-bash-bug" +"41","libyaml" +"41","libz" +"41","cwac-camera" +"41","component-space" +"41","max-path" +"41","sonarqube-api" +"41","beam-search" +"41","d2xx" +"41","autoscalemode" +"41","completion-stage" +"41","ms-access-97" +"41","mdanalysis" +"41","sonar-maven-plugin" +"41","z-axis" +"40","phppowerpoint" +"40","ggdendro" +"40","squirrel" +"40","babel-register" +"40","vue-instant-search" +"40","fbs" +"40","phonepe" +"40","matic" +"40","rentrez" +"40","primus" +"40","backgrounding" +"40","loading-image" +"40","ghc-api" +"40","react-native-device-info" +"40","instancetype" +"40","wiki.js" +"40","prism.js" +"40","truedepth-camera" +"40","teamcity-9.1" +"40","fluid-framework" +"40","git-am" +"40","jenkins-git-plugin" +"40","render-blocking" +"40","dearpygui" +"40","feedjira" +"40","live-update" +"40","flutter-assetimage" +"40","bare" +"40","antivirus-integration" +"40","tearing" +"40","skorch" +"40","federated-table" +"40","gilead" +"40","intel-tsx" +"40","slony" +"40","youtrack-api" +"40","listproperty" +"40","annyang" +"40","webtop" +"40","syncfusion-calendar" +"40","distube" +"40","index-buffer" +"40","apache-knox" +"40","plasmoid" +"40","nexusdb" +"40","dividebyzeroexception" +"40","python-aiofiles" +"40","fst" +"40","python-assignment-expression" +"40","placeautocompletefragment" +"40","chirp" +"40","finalcut" +"40","ftp4j" +"40","data-quality-services" +"40","connector-net" +"40","apache-traffic-server" +"40","fuzzy-c-means" +"40","adpcm" +"40","page-flipping" +"40","jsonify" +"40","pixel-ratio" +"40","smartthings" +"40","ovf" +"40","displayfor" +"40","circular-queue" +"40","circularreveal" +"40","packed-decimal" +"40","pipewire" +"40","package-manager-console" +"40","swscale" +"40","ccparticlesystem" +"40","runonce" +"40","catmull-rom-curve" +"40","pickerinput" +"40","freerdp" +"40","cartridge" +"40","sodium" +"40","keycloak-js" +"40","rnaturalearth" +"40","microsoft.mshtml" +"40","vanilla-forums" +"40","value-restriction" +"40","air-android" +"40","windows-composition-api" +"40","factominer" +"40","windows-controls" +"40","meteoric" +"40","cro" +"40","famous-angular" +"40","microsoft-ajax-minifier" +"40","metronome" +"40","pvcs" +"40","reader-macro" +"40","recyclerlistview" +"40","sitecore-xdb" +"40","animatedvectordrawable" +"40","grails-2.1" +"40","css-hyphens" +"40","shared-primary-key" +"40","name-attribute" +"40","vbc" +"40","candidate" +"40","unity3d-shaders" +"40","carbide" +"40","roomle" +"40","aws-route53" +"40","nagle" +"40","rowdetailstemplate" +"40","verifiable-c" +"40","django-swagger" +"40","dxva" +"40","tuya" +"40","nssplitviewcontroller" +"40","spring-boot-testcontainers" +"40","opendialog" +"40","azure-defender" +"40","appwarp" +"40","bootclasspath" +"40","inflector" +"40","ergonomics" +"40","equivalence-classes" +"40","nssound" +"40","azure-billing" +"40","postgis-installation" +"40","infobright" +"40","pcapplusplus" +"40","apple-configurator" +"40","jquery-after" +"40","correspondence" +"40","ndk-gdb" +"40","nestjs-gateways" +"40","jquery-fileupload-rails" +"40","axwebbrowser" +"40","azure-acr" +"40","swd" +"40","patricia-trie" +"40","gsettings" +"40","nsapptransportsecurity" +"40","inverse-transform" +"40","mongodb4.0" +"40","dynamodb-mapper" +"40","derivingvia" +"40","jquery-chaining" +"40","gru" +"40","mongodb-scala" +"40","suppressmessage" +"40","border-spacing" +"40","entity-framework-mapping" +"40","envoyer.io" +"40","openbabel" +"40","interior-mutability" +"40","invokescript" +"40","bootstrap-ui" +"40","retinanet" +"40","google-app-engine-golang" +"40","godot3" +"40","pyscipopt" +"40","rasa-sdk" +"40","pypsa" +"40","wiris" +"40","viewmodel-savedstate" +"40","facebook-authorization" +"40","magma" +"40","3d-printing" +"40","klipfolio" +"40","m2e-pro" +"40","vistadb" +"40","octet-stream" +"40","video4linux" +"40","microsoft-graph-plannertasks" +"40","rhdf5" +"40","return-path" +"40","rhodecode" +"40","bref" +"40","system.data.sqlclient" +"40","u2netdk" +"40","2-digit-year" +"40","shopify-activemerchant" +"40","wkinterfacelabel" +"40","sidekick" +"40","os161" +"40","visual-studio-mac-2022" +"40","word-boundaries" +"40","viewwilltransitiontosize" +"40","mindmap" +"40","forwarderrorcorrection" +"40","facebooker2" +"40","typelite" +"40","mixed-code" +"40","reductio" +"40","redhat-openjdk" +"40","dhis-2" +"40","excel-r1c1-notation" +"40","xacml2" +"40","redhat-sso" +"40","redux-promise-middleware" +"40","azure-mapping-data-flow" +"40","xamarin.forms-styles" +"40","openmap" +"40","nvml" +"40","openlink-virtuoso" +"40","bull-queue" +"40","istio-kiali" +"40","xamarin-zebble" +"40","bump" +"40","istio-operator" +"40","nstableheaderview" +"40","contextclassloader" +"40","wxruby" +"40","nstabviewcontroller" +"40","quickbasic" +"40","android-include" +"40","hard-coding" +"40","vfork" +"40","non-admin" +"40","assembly.load" +"40","pngquant" +"40","sqlncli" +"40","cacls" +"40","plugman" +"40","azure-iot-dps" +"40","sql-pl" +"40","qvideowidget" +"40","android-emulator-plugin" +"40","directory-browsing" +"40","nsxmldocument" +"40","qxmlquery" +"40","number-sequence" +"40","dta" +"40","gwas" +"40","expo-file-system" +"40","scatterpie" +"40","todoist" +"40","scala-repl" +"40","radmenu" +"40","dsquery" +"40","android-cast-api" +"40","asp.net-caching" +"40","ui-codemirror" +"40","azure-spring-cloud" +"40","gwt-jsinterop" +"40","asp.net-core-mvc-2.1" +"40","refinement-type" +"40","hub" +"40","dune" +"40","meep" +"40","android-multiple-users" +"40","css-print" +"40","properties.settings" +"40","node-rest-client" +"40","esri-arc-engine" +"40","combres" +"40","eulerr" +"40","pg-cron" +"40","ctp" +"40","pytorch-forecasting" +"40","spire.xls" +"40","octopack" +"40","http-post-vars" +"40","exceed" +"40","ohai-gem" +"40","qdate" +"40","excel-external-data" +"40","pyxll" +"40","logrus" +"40","node.js-domains" +"40","ctx" +"40","android-lazyadapter" +"40","stm32-hal" +"40","google-diff-match-patch" +"40","latexmk" +"40","angular2-universal" +"40","cfexecute" +"40","logback-groovy" +"40","hero" +"40","idml" +"40","webcodecs" +"40","behavior-tree" +"40","google-source-repositories" +"40","heroku-redis" +"40","flutter-layoutbuilder" +"40","muc" +"40","source-control-bindings" +"40","params-keyword" +"40","google-indoor-maps" +"40","bcdedit" +"40","ms-publisher" +"40","spark-window-function" +"40","asana-connect" +"40","presentation-model" +"40","as3crypto" +"40","sdist" +"40","glimmer.js" +"40","staticlayout" +"40","powerbuilder-pfc" +"40","secrets" +"40","git-refspec" +"40","imagejpeg" +"40","tfilestream" +"40","shfb" +"40","vaadin6" +"40","compound-drawables" +"40","stdformat" +"40","pangram" +"40","touch-up-inside" +"40","ie-mobile" +"40","panes" +"40","tf-agent" +"40","cypher-shell" +"40","thick-client" +"40","beatsmusic" +"40","fluxor" +"40","zend-application" +"40","scriptable" +"40","struts-html" +"40","webconfigurationmanager" +"40","predefined-macro" +"40","gmagick" +"40","static-allocation" +"40","area-chart" +"40","webformsmvp" +"40","zend-form-sub-form" +"40","automatic-storage" +"40","lidar-data" +"40","asianfonts" +"40","user.config" +"40","mscoco" +"40","ms-clarity" +"39","integration-patterns" +"39","slack-bolt" +"39","privilege-elevation" +"39","anonymous-delegates" +"39","flex-grow" +"39","anonymous-struct" +"39","yad" +"39","cmis-workbench" +"39","teradata-covalent" +"39","bamboo-artifacts" +"39","jbcrypt" +"39","debezium-engine" +"39","react-native-deep-linking" +"39","clistview" +"39","ecmascript-3" +"39","flutter-facebook-login" +"39","wds" +"39","multitrigger" +"39","rendering-engine" +"39","gremlinnet" +"39","getstaticpaths" +"39","tensordot" +"39","edmonds-karp" +"39","mat-option" +"39","apache-camel-k" +"39","vuetify-tabs" +"39","webstore" +"39","instanceid" +"39","ssh2-sftp-client" +"39","mvxbind" +"39","cljsbuild" +"39","edid" +"39","apache-camel-aws" +"39","anydac" +"39","ckasset" +"39","deferred-shading" +"39","backstop.js" +"39","mat-expansion-panel" +"39","vue-konva" +"39","babel-plugin-react-css-modules" +"39","webtestclient" +"39","phpflickr" +"39","backing-field" +"39","phpdesigner" +"39","react-router-native" +"39","fbsdksharedialog" +"39","ciscoconfparse" +"39","yarnpkg-v3" +"39","web-serial-api" +"39","dcl" +"39","whatsapp-flows" +"39","insert-statement" +"39","symbolic-execution" +"39","mammoth" +"39","binarystream" +"39","nhibernate-configuration" +"39","pairwise-distance" +"39","unique-lock" +"39","adler32" +"39","jsonplaceholder" +"39","swiftui-texteditor" +"39","apache-spark-2.3" +"39","xjb" +"39","snap7" +"39","mapmyindia-api" +"39","unificationengine" +"39","function-attributes" +"39","ngx-cookie-service" +"39","pik" +"39","jsonix" +"39","jsoniq" +"39","sw-toolbox" +"39","soffice" +"39","python-holidays" +"39","xml-import" +"39","platform-tools" +"39","sem" +"39","xmodem" +"39","apollo-ios" +"39","content-pipeline" +"39","play-authenticate" +"39","adhoc-queries" +"39","laravel-eloquent-resource" +"39","jstree-search" +"39","fsharp.data.typeproviders" +"39","ngx-graph" +"39","runnable-jar" +"39","datavisualization.toolkit" +"39","jstl-functions" +"39","discord-interactions" +"39","blaze-persistence" +"39","chef-zero" +"39","operational-transform" +"39","fastadapter" +"39","cross-application" +"39","serena" +"39","ice40" +"39","microsoft.extensions.logging" +"39","value-provider" +"39","method-dispatch" +"39","awaitility" +"39","simplejdbccall" +"39","winbugs14" +"39","ibtool" +"39","airpush" +"39","djinni" +"39","mysql-error-1292" +"39","docsify" +"39","sip-servlet" +"39","microsoft-copilot" +"39","cs-script" +"39","vcpu" +"39","aws-app-mesh" +"39","jnaerator" +"39","dartz" +"39","gorp" +"39","docker-ce" +"39","fauxton" +"39","google-voice-search" +"39","wcf-authentication" +"39","windows-ribbon-framework" +"39","psse" +"39","react-static" +"39","datagridviewbuttoncolumn" +"39","ibexpert" +"39","r-taskscheduler" +"39","vdso" +"39","scalajs-bundler" +"39","boost-bimap" +"39","scalafmt" +"39","jquery-focusout" +"39","jquery-1.3" +"39","swagger-node-express" +"39","demangler" +"39","errorformat" +"39","errorplacement" +"39","wptoolkit" +"39","interface-orientation" +"39","swift-macro" +"39","desktop.ini" +"39","intersystems-ensemble" +"39","horizontal-pager" +"39","angr" +"39","blocked-threads" +"39","dvd-burning" +"39","open-gauss" +"39","android-viewtreeobserver" +"39","blender-2.67" +"39","ios10.2" +"39","nsbox" +"39","kafka-cluster" +"39","wsgiref" +"39","tvos10" +"39","androidsvg" +"39","writexml" +"39","salesforce-einstein" +"39","svg-path" +"39","sap-smart-forms" +"39","apple-news" +"39","kdc" +"39","dynamic-island" +"39","nsstoryboard" +"39","ion-koush" +"39","jquery-slide-effects" +"39","apsw" +"39","supersonic" +"39","pyexiv2" +"39","tzdata" +"39","raymarching" +"39","java-access-bridge" +"39","68hc11" +"39","pynotify" +"39","output-window" +"39","system2" +"39","360-panorama-viewer" +"39","razzle" +"39","foundationdb" +"39","android-api-31" +"39","udpipe" +"39","java-runtime-compiler" +"39","type-projection" +"39","ko-custom-binding" +"39","gomoku" +"39","goliath" +"39","uglifier" +"39","vite-reactjs" +"39","typemaps" +"39","rawcontacts" +"39","pysimplesoap" +"39","ucd" +"39","lib-jitsi-meet" +"39","google-ajax-api" +"39","ext-direct" +"39","pygame-tick" +"39","shimmer" +"39","jasmine-reporters" +"39","oclif" +"39","orientdb-etl" +"39","visual-studio-setup" +"39","build-helper-maven-plugin" +"39","code-search-engine" +"39","form-with" +"39","pymacs" +"39","facebook-conversions-api" +"39","pyspider" +"39","formsflow.ai" +"39","randoop" +"39","retina.js" +"39","plperl" +"39","sqlline" +"39","jakarta-validation" +"39","regex-alternation" +"39","tapir" +"39","nopcommerce-3.90" +"39","talos" +"39","mobilefirst-analytics" +"39","x86-emulation" +"39","sql-server-2012-localdb" +"39","exploded" +"39","mocha-webpack" +"39","jake" +"39","azure-migrate" +"39","scrap-your-boilerplate" +"39","hippomocks" +"39","c++-loki" +"39","hol" +"39","uipickerviewdelegate" +"39","tagged-templates" +"39","home-screen-widget" +"39","cordova-plugin-camera" +"39","tokumx" +"39","drive-mapping" +"39","pointer-conversion" +"39","regex-look-ahead" +"39","asp.net-validators" +"39","c#-12.0" +"39","c++builder-5" +"39","digicert" +"39","android-crop" +"39","ask-cli" +"39","register-globals" +"39","tkx" +"39","executable-path" +"39","express.io" +"39","rails-cells" +"39","gambit" +"39","mkuserlocation" +"39","handhelddevice" +"39","xcode3to4" +"39","no-framework" +"39","j9" +"39","android-gpuimageview" +"39","ipfs-http-client" +"39","elementname" +"39","iron-ajax" +"39","acceptance" +"39","accessorytype" +"39","pechkin" +"39","google-genomics" +"39","ipcmain" +"39","offsetheight" +"39","textacy" +"39","restframeworkmongoengine" +"39","geor" +"39","angular6-json-schema-form" +"39","laravel-paginate" +"39","responsibility" +"39","perlmagick" +"39","android-multiselectlistpreference" +"39","lossy-compression" +"39","cgcolorspace" +"39","property-wrapper-published" +"39","python-zappa" +"39","android-ndk-r7" +"39","mox" +"39","android-jetpack-compose-preview" +"39","textout" +"39","textrenderer" +"39","dunitx" +"39","getlatest" +"39","hyperbolic-function" +"39","geofence" +"39","com-object" +"39","mergeinfo" +"39","petl" +"39","strict-weak-ordering" +"39","spquery" +"39","sports-league-scheduling-problem" +"39","sprache" +"39","stretched" +"39","mortar" +"39","pandora" +"39","mqueue" +"39","iics-di" +"39","multilingual-app-toolkit" +"39","passcode" +"39","qt5.12" +"39","secret-manager" +"39","stay-logged-in" +"39","bazel-aspect" +"39","concurrentskiplistmap" +"39","totality" +"39","webassets" +"39","script-debugging" +"39","gldrawarrays" +"39","componentart" +"39","heyzap" +"39","git-notes" +"39","alipay" +"39","zebble" +"39","flutter-ui" +"39","ihttpasynchandler" +"39","arena-simulation" +"39","font-embedding" +"39","static-factory" +"39","identifiable" +"39","urlmon" +"39","cxxtest" +"39","compiz" +"39","tfsintegrationplatform" +"39","uses-feature" +"39","webcrypto" +"39","starknet" +"39","mcsession" +"39","here-olp" +"39","seedstack" +"39","flutter-pub" +"39","thread-state" +"38","ecmascript-2018" +"38","material-icons" +"38","fedext" +"38","transitivity" +"38","greenmail" +"38","yetanotherforum" +"38","flutter-card" +"38","remote-process" +"38","flutter-column" +"38","class-structure" +"38","react-native-draggable-flatlist" +"38","printthis" +"38","jetpack-compose-modalbottomsheet" +"38","wice-grid" +"38","jet-ef-provider" +"38","litho" +"38","default-constraint" +"38","file-moving" +"38","ssis-2014" +"38","litjson" +"38","graphserviceclient" +"38","priority-web-sdk" +"38","tso" +"38","cloud-security" +"38","react-share" +"38","instance-eval" +"38","materialpageroute" +"38","private-network-access" +"38","xrmtoolbox" +"38","weak-typing" +"38","jaxbelement" +"38","photoviewer" +"38","phptal" +"38","webpack-production" +"38","close-application" +"38","reportparameter" +"38","cmock" +"38","pgmpy" +"38","tell" +"38","github-api-v4" +"38","renderui" +"38","yaf" +"38","srs" +"38","feasibility" +"38","vsm" +"38","cmdline-args" +"38","bash-function" +"38","gfx" +"38","function-literal" +"38","fisher-yates-shuffle" +"38","apimonitor" +"38","birt-emitter" +"38","caspol" +"38","xml-database" +"38","xmpphp" +"38","functional-api" +"38","symfony-dependency-injection" +"38","swt-awt" +"38","pa11y" +"38","add-action" +"38","voip-android" +"38","aem-touch-ui" +"38","owned-types" +"38","swiftui-zstack" +"38","connection-close" +"38","addattribute" +"38","von-neumann" +"38","fuelcms" +"38","python-keyboard" +"38","appcelerator-arrow" +"38","django-bootstrap4" +"38","safari6" +"38","directquery" +"38","c-header" +"38","imasdk" +"38","snowpark" +"38","frozen-columns" +"38","ngmocke2e" +"38","managementeventwatcher" +"38","umijs" +"38","datatableadapters" +"38","datascroller" +"38","palm-os" +"38","nexus-10" +"38","vsinstaller" +"38","fstat" +"38","snk" +"38","const-pointer" +"38","apache-shindig" +"38","pigpio" +"38","filestack" +"38","langchain-agents" +"38","go-sqlite3" +"38","aws-copilot" +"38","record-count" +"38","rsconnect" +"38","albacore" +"38","py-appscript" +"38","candeactivate" +"38","gquery" +"38","pureftpd" +"38","cross-build" +"38","dml-lang" +"38","unnotificationtrigger" +"38","cross-thread" +"38","r-modis" +"38","docker-ingress" +"38","reality-composer-pro" +"38","siri-remote" +"38","routedata" +"38","angular-material-8" +"38","robohelp" +"38","round-slider" +"38","vuexfire" +"38","rook-storage" +"38","ruboto" +"38","velocity-template-language" +"38","opsgenie" +"38","servicepacks" +"38","django-ninja" +"38","windows-server-2008-x64" +"38","fbdialogs" +"38","docker-layer" +"38","ahah" +"38","ais" +"38","django-multilingual" +"38","optparse-applicative" +"38","grails-spring-security" +"38","icedtea" +"38","erlide" +"38","katharsis" +"38","mongodb-geospatial" +"38","spring-kotlin" +"38","botnet" +"38","spring-rsocket" +"38","nsight-compute" +"38","nsapplescript" +"38","gtid" +"38","android-studio-3.1.3" +"38","hosted-blazor-webassembly" +"38","cpanel-xmlapi" +"38","scadalts" +"38","horovod" +"38","entity-framework-extensions" +"38","appirater" +"38","mod-plsql" +"38","interlacing" +"38","appindicator" +"38","kal" +"38","pdf2htmlex" +"38","tuespechkin" +"38","html5-apps" +"38","bluemix-app-scan" +"38","delegatinghandler" +"38","tuareg" +"38","worklight-console" +"38","salesforce-development" +"38","moengage" +"38","epublib" +"38","initialization-order" +"38","jquery-mobile-flipswitch" +"38","onpremises-gateway" +"38","anemone" +"38","bqplot" +"38","sasm" +"38","kotlin-script" +"38","visualgdb" +"38","virtual-table" +"38","jasmine-maven-plugin" +"38","audioflinger" +"38","outlook-filter" +"38","async-hooks" +"38","set-analysis" +"38","windrose" +"38","visual-programming" +"38","facebook-business-manager" +"38","system.transactions" +"38","raygun" +"38","3d.io" +"38","setx" +"38","pyro4" +"38","setimmediate" +"38","kleisli" +"38","system.io.packaging" +"38","signedness" +"38","brew-framework" +"38","bridging" +"38","atomic-design" +"38","formula-editor" +"38","3270" +"38","express-stormpath" +"38","object-relationships" +"38","uds" +"38","buildaction" +"38","objectbrowser" +"38","liberator" +"38","vim-registers" +"38","letrec" +"38","ubuntu-24.04" +"38",".git-folder" +"38","pykd" +"38","system-codedom-compiler" +"38","obspy" +"38","vimgrep" +"38","shopp" +"38","abperson" +"38","java2wsdl" +"38","r-daisy" +"38","mail-gem" +"38","c2hs" +"38","express-fileupload" +"38","bulk-delete" +"38","titanium-sdk" +"38","hoogle" +"38","pljava" +"38","tag-soup" +"38","business-connector" +"38","scratchpad" +"38","xades" +"38","moby" +"38","gaia" +"38","xcode6gm" +"38","reducing" +"38","timespec" +"38","exception-notification" +"38","playscape" +"38","contract-first" +"38","dotnet-build" +"38","qwraps2" +"38","notify-send" +"38","openrdf" +"38","wymeditor" +"38","direct3d10" +"38","tagged-corpus" +"38","taocp" +"38","tagbuilder" +"38","redistimeseries" +"38","nsxmlelement" +"38","uicontextualaction" +"38","uicollisionbehavior" +"38","sql-server-2019-express" +"38","homotopy-type-theory" +"38","tinkercad" +"38","rabbitmq-c" +"38","download-speed" +"38","gatttool" +"38","android-device-manager" +"38","gem-bundler" +"38","mobile-center" +"38","xcode-scheme" +"38","c++-actor-framework" +"38","opensplice" +"38","tdictionary" +"38","openstack-glance" +"38","redmon" +"38","game-automation" +"38","excel.application" +"38","cusp-library" +"38","escape-analysis" +"38","text-rotation" +"38","tomcat-manager" +"38","perforce-branch-spec" +"38","loggerfactory" +"38","colormatrixfilter" +"38","prophecy" +"38","qbo3" +"38","node-java" +"38","restbed" +"38","laterjs" +"38","mpir" +"38","georss" +"38","android-job" +"38","android-jetpack-compose-scaffold" +"38","office365-rest-client" +"38","nintendo-ds" +"38","node-forge" +"38","acl2" +"38","string.xml" +"38","responsys" +"38","proof-general" +"38","android-maps-extensions" +"38","tone-analyzer" +"38","angular-cache" +"38","google-datatable" +"38","resolution-independence" +"38","ejml" +"38","cgdb" +"38","ejb-jar.xml" +"38","search-guard" +"38","searchkit" +"38","textx" +"38","webkit-animation" +"38","ariadne-graphql" +"38","urxvt" +"38","zend-optimizer" +"38","security-warning" +"38","autocad-scripts" +"38","usb-descriptor" +"38","zeit-pkg" +"38","tibco-designer" +"38","to-timestamp" +"38","zeek" +"38","user-defined-aggregate" +"38","idref" +"38","powervr-sgx" +"38","spark-launcher" +"38","presentationml" +"38","imageflow" +"38","subapplication" +"38","subcommand" +"38","emacs-semantic" +"38","parameter-sets" +"38","linq-to-json" +"38","pass-by-rvalue-reference" +"38","scrutinizer" +"38","sea-orm" +"38","qsizepolicy" +"38","focusin" +"38","google-ranking" +"38","mediabrowserservice" +"38","quarkus-qute" +"38","maven-jib" +"38","custom-url-protocol" +"38","d3dimage" +"38","pardiso" +"38","flutter-run" +"38","alignas" +"38","scrollreveal.js" +"38","maven-nar-plugin" +"37","phpdebugbar" +"37","pg-stat-statements" +"37","multiple-assignment" +"37","ddmathparser" +"37","live-cd" +"37","proactive" +"37","flexibility" +"37","react-navigation-top-tabs" +"37","tsify" +"37","flightphp" +"37","multiple-login" +"37","babel-eslint" +"37","processlist" +"37","multivalue-database" +"37","ts-morph" +"37","flup" +"37","debconf" +"37","ggimage" +"37","srp-protocol" +"37","react-native-sentry" +"37","cloo" +"37","whatsapp-stickers" +"37","skcameranode" +"37","squirrelmail" +"37","cmake-presets" +"37","sqslistener" +"37","intellicode" +"37","baml" +"37","dbms-metadata" +"37","liquid-haskell" +"37","git-fsck" +"37","skadnetwork" +"37","git-daemon" +"37","flutter-ffmpeg" +"37","tensorboardx" +"37","flutter-downloader" +"37","material-design-icons" +"37","remotipart" +"37","wicket-tester" +"37","cockpit" +"37","sizetocontent" +"37","phpgrid" +"37","flex-charting" +"37","clojureclr" +"37","slidy" +"37","transmitfile" +"37","slidesjs" +"37","incremental-load" +"37","ngcloak" +"37","after-create" +"37","kubernetes-hpa" +"37","mail-queue" +"37","fscrawler" +"37","biztalk-pipelines" +"37","smf-forum" +"37","switchyard" +"37","unapply" +"37","inboxsdk" +"37","xgbregressor" +"37","xmlsocket" +"37","fsolve" +"37","pythonbrew" +"37","voldemort" +"37","child-fragment" +"37","swiftpm" +"37","semi-join" +"37","confluence-macros" +"37","snap-in" +"37","jsr296" +"37","laravel-components" +"37","ccspritebatchnode" +"37","fiware-keyrock" +"37","unified-memory" +"37","nhibernate-cascade" +"37","chimp.js" +"37","dbcommand" +"37","python-pdfreader" +"37","binomial-heap" +"37","django-4.1" +"37","finite-difference" +"37","findwindowex" +"37","imgscalr" +"37","sender-id" +"37","paint.net" +"37","frequency-table" +"37","binary-bomb" +"37","xdoc" +"37","csi" +"37","kepserverex" +"37","aws-sdk-go-v2" +"37","iced-coffeescript" +"37","keyhook" +"37","roxy-fileman" +"37","dnode" +"37","rpxnow" +"37","upsetplot" +"37","uploadifive" +"37","canopy-web-testing" +"37","pudb" +"37","kie-wb" +"37","aviarc" +"37","jfxpanel" +"37","data-corruption" +"37","sequence-analysis" +"37","servletconfig" +"37","serialscroll" +"37","icicles" +"37","kiba-etl" +"37","fanotify" +"37","ruby-block" +"37","dmesg" +"37","databricks-rest-api" +"37","optimizer-hints" +"37","ibm-cloud-code-engine" +"37","dash-leaflet" +"37","hyperledger-fabric-sdk-java" +"37","rmongo" +"37","camel-test" +"37","aws-directory-services" +"37","joyent" +"37","fastclick.js" +"37","sitebricks" +"37","camel-jms" +"37","django-smart-selects" +"37","criteriabuilder" +"37","aws-iot-analytics" +"37","session-state-provider" +"37","roundhouse" +"37","inetd" +"37","grand-theft-auto" +"37","django-leaflet" +"37","jfrog-mission-control" +"37","angular-migration" +"37","rspec-expectations" +"37","aws-cloudmap" +"37","angular-material-theming" +"37","angular-xeditable" +"37","bootstrap-wysihtml5" +"37","blessed" +"37","in-memory-tables" +"37","jquery-query-builder" +"37","svgkit" +"37","navigation-compose" +"37","post-update" +"37","gtktextview" +"37","sane" +"37","nsconnection" +"37","support-v4" +"37","wsman" +"37","corflags" +"37","hotplugging" +"37","correlated" +"37","jquery-dropkick" +"37","gud" +"37","dynamic-code" +"37","type-annotation" +"37","inline-variable" +"37","twemproxy" +"37","samplegrabber" +"37","ean-13" +"37","wpf-positioning" +"37","nsfilecoordinator" +"37","pathtoolongexception" +"37","enterframeevent" +"37","gtkd" +"37","aws-transfer-family" +"37","azure-analytics" +"37","correspondence-analysis" +"37","episerver-6-r2" +"37","erlangweb" +"37","bluetooth-printing" +"37","bootstrap-treeview" +"37","cpu-load" +"37","nclob" +"37","bmi" +"37","position-dodge" +"37","swift-data-relationship" +"37","boost-smart-ptr" +"37","coursier" +"37","boost-tokenizer" +"37","portable-areas" +"37","html-formhandler" +"37","dynamicpdf" +"37","grpcio" +"37","simbl" +"37","cra" +"37","html.hiddenfor" +"37","input-language" +"37","internal-link" +"37","infinite-carousel" +"37","jquery.repeater" +"37","oneway" +"37","jansson" +"37","typescript2.4" +"37","vincent" +"37","outerheight" +"37","least-common-ancestor" +"37","viewrendering" +"37","astroquery" +"37","magicalrecord-2.2" +"37","facebook-graph-api-v2.3" +"37","3d-texture" +"37","libfreenect2" +"37","libfuzzer" +"37","exrm" +"37","aurelia-dialog" +"37","visual-testing" +"37","browsable" +"37","magic-string" +"37","goinstant" +"37","libman" +"37","systemmodeler" +"37","shopt" +"37","output-caching" +"37","jaunt-api" +"37","typed-factory-facility" +"37","shotgun" +"37","ancs" +"37","outputdebugstring" +"37","7-bit" +"37","mip-sdk" +"37","letters-and-numbers" +"37","pyfacebook" +"37","uat" +"37","wolkenkit" +"37","nvm-windows" +"37","ory" +"37","pysyft" +"37","jawr" +"37","rdfstore" +"37","asp.net-customcontrol" +"37","azure-managed-database" +"37","sqlalchemy-utils" +"37","plug-and-play" +"37","jacl" +"37","notorm" +"37","gumstix" +"37","gumbo" +"37","nodiscard" +"37","vertex-ai-search" +"37","open-graph-beta" +"37","noreturn" +"37","spsite" +"37","tokio-postgres" +"37","normalizing" +"37","geneos" +"37","scala-streams" +"37","nstrackingarea" +"37","j2ssh" +"37","gaussian-mixture-model" +"37","hmatrix" +"37","c++builder-10-seattle" +"37","tlabel" +"37","isight" +"37","dimension-reduction" +"37","uikit-state-preservation" +"37","bundle-layout" +"37","openstruct" +"37","dotnetnuke-8" +"37","ragged-tensors" +"37","histplot" +"37","pointcuts" +"37","mod-autoindex" +"37","asp.net-4.6" +"37","poeaa" +"37","registering" +"37","directcast" +"37","uiprintpagerenderer" +"37","exception-logging" +"37","azure-private-dns-zone" +"37","mkplacemark" +"37","qquickview" +"37","getderivedstatefromprops" +"37","perfino" +"37","cffunction" +"37","cfdata" +"37","spectrumjs" +"37","mousetrap" +"37","mousekeyhook" +"37","charm-crypto" +"37","perfecto" +"37","text-generation" +"37","memory-visibility" +"37","char16-t" +"37","angular2-google-maps" +"37","react-leaflet-v4" +"37","zumero" +"37","httpful" +"37","lstlisting" +"37","odo" +"37","google-cloud-transcoder" +"37","access-rules" +"37","resuming-training" +"37","ios3.0" +"37","excel4node" +"37","eruby" +"37","cephfs" +"37","text-chunking" +"37","acts-as-tenant" +"37","google-cloud-dataproc-serverless" +"37","persistent-data" +"37","memcachedb" +"37","qpalette" +"37","log4jdbc" +"37","stream-cipher" +"37","messageid" +"37","stochastic-gradient" +"37","custom-operator" +"37","storage-file-share" +"37","google-codelab" +"37","elasticsearch-spark" +"37","texstudio" +"37","com-interface" +"37","maven-toolchains-plugin" +"37","usb-hostcontroller" +"37","iis-express-10" +"37","begincollectionitem" +"37","tracepoint" +"37","avassetwriterinput" +"37","tikzdevice" +"37","lightmode" +"37","shell-namespace-extension" +"37","queueuserworkitem" +"37","bfo" +"37","mu-law" +"37","availability-group" +"37","qstatusbar" +"37","qstringlist" +"37","youtube-player-flutter" +"37","pressable" +"37","webdriver-io-v4" +"37","scriptbundle" +"37","mediafire" +"37","emqx" +"37","query-designer" +"37","help-system" +"37","idris2" +"37","armbian" +"37","automapper-10" +"37","pg-jdbc" +"37","maven-exec-plugin" +"37","end-user" +"37","weatherkit" +"37","text-width" +"37","spack" +"37","solr-search" +"37","hfile" +"37","amazon-ivs" +"37","amazon-forecast" +"37","webbroker" +"37","zerofill" +"37","gitx" +"37","secretsmanager" +"37","usefetch" +"37","powershell-sdk" +"37","webob" +"37","cyk" +"37","arrayiterator" +"37","gmailr" +"37","threecsg" +"37","limiting" +"37","subject-alternative-name" +"37","flutter-linux" +"37","image-effects" +"37","glibmm" +"36","tensor2tensor" +"36","figsize" +"36","base-path" +"36","react-server" +"36","cisco-jtapi" +"36","editview" +"36","templatetag" +"36","tree-nodes" +"36","telosys" +"36","ansi-sql-92" +"36","anychart-8.2" +"36","phped" +"36","react-native-picker-select" +"36","git-history-graph" +"36","jetty-12" +"36","insert-image" +"36","instasharp" +"36","instruction-reordering" +"36","insertion-order" +"36","ss" +"36","insertonsubmit" +"36","ssms-18" +"36","edge-tpu" +"36","mvcroutehandler" +"36","primeng-dialog" +"36","yagmail" +"36","reporting-services-2016" +"36","mat-icon" +"36","match-types" +"36","slapd" +"36","telerik-charting" +"36","ansible-collections" +"36","backbone-stickit" +"36","renderdoc" +"36","rendercontrol" +"36","mathlink" +"36","fluid-images" +"36","cleaned-data" +"36","xslf" +"36","release-notes" +"36","flutter-datatable" +"36","gravitee" +"36","flutter-circularprogressindicator" +"36","groovydoc" +"36","vtk.js" +"36","little-proxy" +"36","eclipse-rse" +"36","phpstorm-2018.1" +"36","imagemagick-identify" +"36","jsr75" +"36","ladder-logic" +"36","jsr305" +"36","imagemagick-montage" +"36","smart-mobile-studio" +"36","imageshack" +"36","fuzzer" +"36","softirq" +"36","swup" +"36","rusqlite" +"36","dbg" +"36","kubernetes-namespace" +"36","future-proof" +"36","datastax-node-driver" +"36","python-docker" +"36","cinterop" +"36","ngdoc" +"36","displayformat" +"36","pin-code" +"36","circom" +"36","semantic-logging" +"36","sendbeacon" +"36","biztalk-bam" +"36","xero" +"36","umfpack" +"36","xmlencoder" +"36","function-templates-overloading" +"36","unify" +"36","confirm-dialog" +"36","first-class" +"36","ng-filter" +"36","apache-spark-2.2" +"36","ftputil" +"36","ngx-daterangepicker-material" +"36","paginateddatatable" +"36","makeappx" +"36","constraint-kinds" +"36","bitbucket-aws-code-deploy" +"36","unfuddle" +"36","pihole" +"36","confuserex" +"36","findinfiles" +"36","pagerfanta" +"36","facebook-php-webdriver" +"36","grako" +"36","ibm-cloud-kubernetes" +"36","dlquery" +"36","grapevine" +"36","psr-1" +"36","simplemde" +"36","mysql-error-1067" +"36","rubberduck" +"36","optimistic" +"36","validate-request" +"36","metricsql" +"36","ibm-app-connect" +"36","fastlane-snapshot" +"36","docker-repository" +"36","cakephp-2.8" +"36","optional-variables" +"36","docker-tag" +"36","myst" +"36","rowlex" +"36","django-rest-framework-gis" +"36","fancyimpute" +"36","aggregate-filter" +"36","roberta" +"36","method-declaration" +"36","data-caching" +"36","mysql-odbc-connector" +"36","update-all" +"36","cryengine" +"36","react-table-v8" +"36","gpu-atomics" +"36","gpu-constant-memory" +"36","single-dispatch" +"36","single-file" +"36","series-40" +"36","pry-rails" +"36","cross-server" +"36","windows-1251" +"36","upload-max-filesize" +"36","react-strictmode" +"36","sinch-verification" +"36","pubchem" +"36","django-rosetta" +"36","keyref" +"36","aws-code-deploy-appspec" +"36","wildfly-12" +"36","rowheader" +"36","realm-database" +"36","animationcontroller" +"36","unload" +"36","nestjs-testing" +"36","twilio-python" +"36","wsdl2code" +"36","spring-cloud-zookeeper" +"36","tuner" +"36","input-filter" +"36","nba-api" +"36","workflow-engine" +"36","android-tiramisu" +"36","dependency-tree" +"36","desktop-wallpaper" +"36","android-spannable" +"36","gulp-replace" +"36","boost-xpressive" +"36","er-diagram" +"36","eraser" +"36","nsarchiving" +"36","spring-cloud-gcp-bigquery" +"36","cornerstonejs" +"36","azure-blockchain-workbench" +"36","pdf2swf" +"36","hotswapagent" +"36","ttml" +"36","application-name" +"36","defunct" +"36","postgres.app" +"36","worker-loader" +"36","internal-compiler-error" +"36","android-side-navigation" +"36","bootstrap-studio" +"36","neo4j-embedded" +"36","post-quantum-cryptography" +"36","app-lab" +"36","errortemplate" +"36","sap-ariba" +"36","botdetect" +"36","android-slider" +"36","coreference-resolution" +"36","coveo" +"36","azure-bastion" +"36","android-shell" +"36","app-service-environment" +"36","oat++" +"36","windsor-3.0" +"36","libserial" +"36","fabric-beta" +"36","android-activitymanager" +"36","pyinvoke" +"36","bucardo" +"36","madexcept" +"36","vitepress" +"36","ordered-map" +"36","system.addin" +"36","lucene-highlighter" +"36","facebook-app-center" +"36","browser-bugs" +"36","code-visualization" +"36","shutter" +"36","net-reactor" +"36","krpano" +"36","audio-video-sync" +"36","rapidshare" +"36","browserid" +"36","setuptools-scm" +"36","kr-c" +"36","siena" +"36","2.5d" +"36","asyncdata" +"36","object-diagram" +"36","atg-droplet" +"36","minimum-size" +"36","go-iris" +"36","amba" +"36","konga" +"36","vmalloc" +"36","vmdk" +"36","microstream" +"36","rfc3161" +"36","typescript-module-resolution" +"36","android-1.5-cupcake" +"36","extract-error-message" +"36","shader-storage-buffer" +"36","viewpropertyanimator" +"36","osx-tiger" +"36","pynamodb" +"36","knopflerfish" +"36","otl" +"36","pymatgen" +"36","braintree-rails" +"36","asynchronous-wcf-call" +"36","amp-img" +"36","pyo" +"36","networkit" +"36","code-collaborator" +"36","kleene-star" +"36","pyjade" +"36","mobileprovision" +"36","npm-version" +"36","nvidia-smi" +"36","android-capture" +"36","scoreloop" +"36","itemeditor" +"36","plr" +"36","android-compose-layout" +"36","iso-8859-2" +"36","table-plus" +"36","nuxt-strapi" +"36","scalardb" +"36","rackattack" +"36","android-drm" +"36","scope-chain" +"36","dot-source" +"36","scoop-installer" +"36","drawingbrush" +"36","gwt-tablayoutpanel" +"36","tabletop.js" +"36","controltemplates" +"36","openoffice-impress" +"36","hacker-news-api" +"36","r2dbc-mysql" +"36","xcarchive" +"36","timing-attack" +"36","nushell" +"36","scalatags" +"36","excel-reader" +"36","buster.js" +"36","gen-class" +"36","itextg" +"36","azure-vm-templates" +"36","mknod" +"36","iview" +"36","azure-spring-boot" +"36","time-precision" +"36","sqlj" +"36","nopcommerce-4.0" +"36","gcc11" +"36","c10k" +"36","iwconfig" +"36","gcloud-java" +"36","gdrive" +"36","geektool" +"36","qfont" +"36","google-container-optimized-os" +"36","chardet" +"36","activity-streams" +"36","spin.js" +"36","httperf" +"36","android-jetpack-compose-animation" +"36","react-image-crop" +"36","httpbrowsercapabilities" +"36","react-async" +"36","httplistenerrequest" +"36","cfengine" +"36","zurb-foundation-apps" +"36","android-mipmap" +"36","moq-3" +"36","terraform-provider-openstack" +"36","cssnext" +"36","spray-routing" +"36","motoko" +"36","react-native-contacts" +"36","android-managed-profile" +"36","tetrahedra" +"36","stripe-tax" +"36","activetcl" +"36","meeting-request" +"36","pyudev" +"36","lua-c++-connection" +"36","qlocalsocket" +"36","laravel-translatable" +"36","ios-library" +"36","liferay-7.2" +"36","parsoid" +"36","cxf-xjc-plugin" +"36","automatic-semicolon-insertion" +"36","qsqlquerymodel" +"36","aria-live" +"36","qt-necessitas" +"36","msvcr90.dll" +"36","iidentity" +"36","stat-density2d" +"36","tgrid" +"36","zebra" +"36","amazon-mobile-hub" +"36","partial-functions" +"36","usercake" +"36","premultiplied-alpha" +"36","ytplayer" +"36","gnu-sed" +"36","amazon-kendra" +"36","parse-framework" +"36","zgc" +"36","git-sparse-checkout" +"36","msmessage" +"36","sec" +"36","space-partitioning" +"36","zk-grid" +"36","illegalmonitorstateexcep" +"36","tortoisemerge" +"36","config.json" +"36","stdlaunder" +"36","z-order-curve" +"36","tightvnc" +"36","mss" +"36","webmachine" +"36","for-else" +"36","sonarqube-5.4" +"36","shields.io" +"36","hermes-jms" +"36","alice-fixtures" +"36","zend-locale" +"36","asciimath" +"36","allegro-cl" +"36","enable-shared-from-this" +"36","parallel.foreachasync" +"36","mruby" +"36","strtr" +"36","idx" +"36","stm32f3" +"36","alphabetized" +"36","hdrimages" +"35","clrmd" +"35","mvcgrid.net" +"35","dcc32" +"35","grit" +"35","babun" +"35","dbn" +"35","phpcas" +"35","badi" +"35","yocto-wic" +"35","ckeditor5-react" +"35","ckeditor5-plugin" +"35","yfiles" +"35","ebook-reader" +"35","clsql" +"35","liquibase-maven-plugin" +"35","render-to-response" +"35","where-object" +"35","trilinos" +"35","xsb" +"35","git-lfs-migrate" +"35","getstate" +"35","phpjs" +"35","gitlab-autodevops" +"35","remove-method" +"35","flutter-drawer" +"35","gitlab-7" +"35","cleartext" +"35","php-pthread" +"35","listlabel" +"35","standardjs" +"35","xtensa" +"35","graph-notebook" +"35","little-o" +"35","phpgraphlib" +"35","process-monitor" +"35","debezium-connect" +"35","reprex" +"35","reinforced-typings" +"35","lmplot" +"35","ggnetwork" +"35","git-fast-import" +"35","react-native-screens" +"35","temboo" +"35","ssis-2005" +"35","ffdshow" +"35","loadjava" +"35","baidu-map" +"35","sslerrorhandler" +"35","antdv" +"35","dat-protocol" +"35","maphilight" +"35","chipset" +"35","vsdoc" +"35","pallet" +"35","pkill" +"35","day-cq" +"35","filesystem-access" +"35","filestreams" +"35","runkit" +"35","next-connect" +"35","nextpeer" +"35","mapdeck" +"35","jstorage" +"35","apache-sedona" +"35","kubernetes-container" +"35","apache-pivot" +"35","snomed-ct" +"35","uivewcontroller" +"35","r-usethis" +"35","mariadb-connector-c" +"35","incremental-search" +"35","carmen" +"35","vscode-problem-matcher" +"35","jsonassert" +"35","lanterna" +"35","displot" +"35","adaptive-icon" +"35","ftplugin" +"35","markermanager" +"35","blackfire" +"35","symbol-not-found" +"35","apollo-gateway" +"35","ozeki" +"35","firepath" +"35","smartsheet-api-1.1" +"35","djangocms-text-ckeditor" +"35","switchery" +"35","ngx-editor" +"35","jsonforms" +"35","alchemy-cms" +"35","dlq" +"35","url-action" +"35","prvalue" +"35","valign" +"35","vendors" +"35","pyad" +"35","reconciliation" +"35","pulumi-azure" +"35","simple-xml-converter" +"35","ora-00923" +"35","rogue-wave" +"35","r-table" +"35","rocket" +"35","journey" +"35","jqchart" +"35","mysql4" +"35","vapid" +"35","microsoft-expression-web" +"35","mymaps" +"35","mysqladministrator" +"35","faker.js" +"35","ag-grid-validation" +"35","rmaps" +"35","pv" +"35","root-node" +"35","validationmessage" +"35","nanopi" +"35","database-dump" +"35","grahams-scan" +"35","camunda-plugin" +"35","oracle-apex21.2" +"35","dnspy" +"35","camping" +"35","n8n" +"35","microsoft.ink" +"35","ibm-information-server" +"35","ajaxsubmit" +"35","cakephp-2.9" +"35","namespace-organisation" +"35","datacontracts" +"35","roaming-profile" +"35","unmanagedexports" +"35","sitecore-speak-ui" +"35","wcf-discovery" +"35","vcbuild" +"35","django-two-factor-auth" +"35","django-hvad" +"35","rector" +"35","optimal" +"35","createoleobject" +"35","crystal-reports-2016" +"35","kentico-13" +"35","android-sdk-1.6" +"35","block-comments" +"35","jquery-mobile-panel" +"35","html-tree" +"35","horizontalpodautoscaler" +"35","aws-signature" +"35","easy-auth" +"35","postgres-12" +"35","jquery.panzoom" +"35","pdp-11" +"35","jquery-ui-widget" +"35","twincat-ads-.net" +"35","epydoc" +"35","jumi" +"35","samsung-galaxy-watch-4" +"35","nsinvocationoperation" +"35","sarsa" +"35","samsung-touchwiz" +"35","ncl" +"35","work-stealing" +"35","gulp-connect" +"35","corresponding-records" +"35","inline-view" +"35","infinidb" +"35","azure-devops-deploymentgroups" +"35","mod-vhost-alias" +"35","sandbox-solution" +"35","spring-expression-language" +"35","negative-integer" +"35","gs1-datamatrix" +"35","jquery-textext" +"35","kadena" +"35","application.cfm" +"35","inets" +"35","path-traversal" +"35","sasl-scram" +"35","epollet" +"35","appsflyer-android-sdk" +"35","patreon" +"35","winobjc" +"35","reuters" +"35","system.web.ui.webcontrols" +"35","system-views" +"35","form-parameter" +"35","libsox" +"35","pyez" +"35","objectcache" +"35","tableau-cloud" +"35","typed-memory-views" +"35","atlaskit" +"35","kivy-recycleview" +"35","viewchildren" +"35","microsoft-skype-bot" +"35","klein-mvc" +"35","abnf" +"35","domain-masking" +"35","object-destruction" +"35","google-business-profile-api" +"35","abbr" +"35","fabric8-maven-plugin" +"35","rfc2898" +"35","rancher-rke" +"35","libsmbclient" +"35","netcoreapp3.1" +"35","word-diff" +"35","abide" +"35","pyshp" +"35","ucfirst" +"35","ocaml-batteries" +"35","pykml" +"35","android-afilechooser" +"35","fr3dldapbundle" +"35","sfnetwork" +"35","vim-macros" +"35","expresso-store" +"35","foundry-contour" +"35","minicom" +"35","mineflayer" +"35","visudo" +"35","viper" +"35","tablefooterview" +"35","viper-mode" +"35","rgee" +"35","taskwarrior" +"35","itemspanel" +"35","uibuttonbaritem" +"35","associated-value" +"35","asp.net-mvc-futures" +"35","noweb" +"35","gatsby-plugin-mdx" +"35","geant4" +"35","exclusion-constraint" +"35","gcdasyncudpsocket" +"35","nv12-nv21" +"35","android-custom-drawable" +"35","azure-managed-app" +"35","azure-sdk-js" +"35","itemcontainergenerator" +"35","wxstyledtextctrl" +"35","hidden-characters" +"35","quotas" +"35","drop-shadow" +"35","drb" +"35","uifontdescriptor" +"35","c51" +"35","gdata-python-client" +"35","dtcoretext" +"35","galaxy-nexus" +"35","mobius" +"35","pl-i" +"35","azure-load-testing" +"35","dia-sdk" +"35","taskstackbuilder" +"35","pngcrush" +"35","sql-authentication" +"35","cordova-chrome-app" +"35","nunittestadapter" +"35","drupal-entities" +"35","downshift" +"35","redquerybuilder" +"35","bulk-import" +"35","android-guava" +"35","taskdef" +"35","scodec" +"35","uinib" +"35","tabu-search" +"35","gwt-highcharts" +"35","diffusers" +"35","gcm-network-manager" +"35","non-breaking-characters" +"35","hamachi" +"35","c++builder-11-alexandria" +"35","mpmedialibrary" +"35","qradar" +"35","stock-data" +"35","angularjs-google-maps" +"35","geom-sf" +"35","terraform-provider-ibm" +"35","google-content-api" +"35","laravel-reverb" +"35","resumablejs" +"35","on-clause" +"35","persistent-object-store" +"35","testimonials" +"35","z-wave" +"35","strictnullchecks" +"35","zstandard" +"35","tonejs" +"35","hydra-core" +"35","peekmessage" +"35","split-screen-multitasking" +"35","everscale" +"35","mpesa" +"35","lookupfield" +"35","st-monad" +"35","mercury-editor" +"35","cumulative-line-chart" +"35","dunn.test" +"35","resharper-plugins" +"35","event-id" +"35","laravel-mongodb" +"35","testcontext" +"35","cgbitmapcontext" +"35","changenotifier" +"35","csv-write-stream" +"35","ete3" +"35","acceptbutton" +"35","excel-2008" +"35","layout-anchor" +"35","ternary-tree" +"35","node.js-client" +"35","accesscontrolservice" +"35","accessibility-insights" +"35","generic-relations" +"35","strong-named-key" +"35","laravel-service-container" +"35","ternary-search-tree" +"35","custom-application" +"35","pester-5" +"35","nmcli" +"35","beans-binding" +"35","shfileoperation" +"35","parking" +"35","panzoom" +"35","compress-archive" +"35","emailrelay" +"35","multi-agent-reinforcement-learning" +"35","web-fragment" +"35","uservoice" +"35","parseui" +"35","flutter-graphql" +"35","basler" +"35","parslet" +"35","solarwinds-orion" +"35","maxrequestlength" +"35","fn" +"35","quagga" +"35","lintr" +"35","subactivity" +"35","amazon-managed-blockchain" +"35","google-groups-settings" +"35","thoughtworks-go" +"35","conditional-split" +"35","cxml-commercexml" +"35","powerschool" +"35","arm9" +"35","suneditor" +"35","webgrease" +"35","zio-test" +"35","armeria" +"35","mediaplayback" +"35","git-server" +"35","msgrcv" +"35","cvblobslib" +"35","qtdeclarative" +"35","mscomm32" +"35","beginreceive" +"35","zenoss" +"35","security-by-obscurity" +"35","scrollableresults" +"35","theano.scan" +"35","struts2-namespace" +"35","ide-customization" +"35","pppoe" +"35","url-fragment" +"34","clipspy" +"34","website-deployment" +"34","base62" +"34","repositorylookupedit" +"34","deduction-guide" +"34","ghc-generics" +"34","triangle-count" +"34","tensorflow-agents" +"34","whenever-capistrano" +"34","default-document" +"34","default-implementation" +"34","transitionend" +"34","backquote" +"34","stable-marriage" +"34","installaware" +"34","default-programs" +"34","trigraphs" +"34","basicnamevaluepair" +"34","dbms-crypto" +"34","marvin-framework" +"34","tss" +"34","flinkml" +"34","ansi-term" +"34","yarn-v3" +"34","clj-http" +"34","flowdocumentscrollviewer" +"34","wcsf" +"34","local-shared-object" +"34","skype4java" +"34","dc.leaflet.js" +"34","flow-scope" +"34","flex-mojos" +"34","eclipse-databinding" +"34","multipart-mixed-replace" +"34","fluent-security" +"34","slickedit" +"34","anr" +"34","clock-synchronization" +"34","fedora-27" +"34","remote-forms" +"34","fedena" +"34","fieldlist" +"34","liquid-xml" +"34","smartassembly" +"34","background-agent" +"34","jenetics" +"34","basil.js" +"34","vraptor" +"34","semantic-ui-css" +"34","const-generics" +"34","kubernetes-nodeport" +"34","adfs2.1" +"34","xmlexception" +"34","adjacency-list-model" +"34","snowpipe" +"34","selectivizr" +"34","select-into-outfile" +"34","vob" +"34","future-warning" +"34","seldon" +"34","firefox3.5" +"34","lamar" +"34","smooth-streaming-player" +"34","fuelphp-orm" +"34","lambda-architecture" +"34","sentimentr" +"34","xmlroot" +"34","fuzzyfinder" +"34","case-expression" +"34","xml-schema-collection" +"34","soapcore" +"34","content-based-retrieval" +"34","fxruby" +"34","syncfusion-blazor" +"34","chatkit" +"34","firemonkey-style" +"34","runtime-type" +"34","sailfish-os" +"34","runumap" +"34","datatable.select" +"34","python-3.1" +"34","manipulate" +"34","rust-piston" +"34","indexed-properties" +"34","discord4j" +"34","independent-set" +"34","imessagefilter" +"34","rxjs7" +"34","binary-deserialization" +"34","swiftui-asyncimage" +"34","indefinite" +"34","apiman" +"34","unaccent" +"34","django-custom-field" +"34","data-linking" +"34","incapsula" +"34","chilkat-email" +"34","vercel-ai" +"34","name-binding" +"34","ruby-prof" +"34","window-load" +"34","microc" +"34","shark" +"34","angularjs-ng-value" +"34","crosstable" +"34","microsoft.data.sqlite" +"34","facebook-send-api" +"34","dataiku" +"34","alexa-presentation-language" +"34","sitecore-rocks" +"34","methodexpression" +"34","read-committed-snapshot" +"34","ora-06502" +"34","r-library" +"34","djl" +"34","opml" +"34","jnr" +"34","aws-elemental" +"34","wincvs" +"34","airbnb-js-styleguide" +"34","read-host" +"34","facenet" +"34","session-0-isolation" +"34","rtm" +"34","django-subquery" +"34","falcor-router" +"34","ora-00918" +"34","fay" +"34","unity3d-ui" +"34","variable-selection" +"34","icustomtypedescriptor" +"34","go-playground" +"34","angular-template-variable" +"34","gradle.properties" +"34","meta-raspberrypi" +"34","psqlodbc" +"34","interlocked-increment" +"34","axe" +"34","springfox-boot-starter" +"34","kaspersky" +"34","spring-projections" +"34","input-split" +"34","ttnavigator" +"34","kemal" +"34","influx-line-protocol" +"34","post-parameter" +"34","entrypointnotfoundexcept" +"34","appsync-apollo-client" +"34","inner-exception" +"34","braced-init-list" +"34","informat" +"34","simple.odata.client" +"34","pax-runner" +"34","grunt-cli" +"34","boost-unit-test-framework" +"34","dynamic-splash-screen" +"34","jugglingdb" +"34","nsdocumentcontroller" +"34","pclose" +"34","android-viewflipper" +"34","postmates" +"34","box2dlights" +"34","aws-sdk-mock" +"34","env-file" +"34","jquery-ui-layout" +"34","spring-data-redis-reactive" +"34","android-studio-plugin" +"34","naudio-framework" +"34","workfusion" +"34","navigation-architecture" +"34","spring-data-neo4j-5" +"34","spring-mobile" +"34","supertab" +"34","nspipe" +"34","ionic-zip" +"34","pbxproj" +"34","svn-reintegrate" +"34","spring-json" +"34","deveco-studio" +"34","http-accept-encoding" +"34","boost-accumulators" +"34","devel-cover" +"34","android-style-tabhost" +"34","coverity-prevent" +"34","pbcopy" +"34","magellan" +"34","acceleratorkey" +"34","sgi" +"34","vim-fzf" +"34","revisionable" +"34","wixlib" +"34","wordpress-3.5" +"34","lenskit" +"34","r-commander" +"34","jaws-wordnet" +"34","vin" +"34","sfdx" +"34","octetstring" +"34","bug-tracker" +"34","coderay" +"34","pypng" +"34","system.drawing.graphics" +"34","rfacebook" +"34","bsddb" +"34","android-2.0-eclair" +"34","typehandler" +"34","richedit-control" +"34","extender" +"34","knife-solo" +"34","javascript-scope" +"34","javax.swing.timer" +"34","type-synonyms" +"34","amp-stories" +"34","libgomp" +"34","2-3-4-tree" +"34","network-driver" +"34","shingles" +"34","ravendb-http" +"34","windows-themes" +"34","forward-engineer" +"34","libigl" +"34","brewmp" +"34","visual-effects" +"34","openvidu" +"34","polymer-2.0" +"34","excelquery" +"34","diawi" +"34","c++pmr" +"34","gdbinit" +"34","non-renewing-subscription" +"34","xcode-extension" +"34","hamming-numbers" +"34","regioninfo" +"34","non-termination" +"34","rails-assets" +"34","tagged-pdf" +"34","npm-ci" +"34","referrer-spam" +"34","high-voltage" +"34","pointycastle" +"34","referenceequals" +"34","null-propagation-operator" +"34","drupal-field-collection" +"34","nupic" +"34","coovachilli" +"34","pluto.jl" +"34","itertools-groupby" +"34","gcp-iam" +"34","explicit-destructor-call" +"34","asp.net-mvc-apiexplorer" +"34","isaserver" +"34","target-audience" +"34","sql-server-2016-localdb" +"34","openid4java" +"34","nuxt-link" +"34","timestep" +"34","executionengineexception" +"34","tagbar" +"34","dryscrape" +"34","gwr" +"34","asset-sync" +"34","version-compatibility" +"34","asp.net-placeholder" +"34","asp.net-spa" +"34","h2o4gpu" +"34","openlayers-7" +"34","copywithzone" +"34","monitoring-query-language" +"34","elasticsearch-6.8" +"34","large-scale" +"34","rest-parameters" +"34","one-class-classification" +"34","geometric-mean" +"34","ipxe" +"34","spelevaluationexception" +"34","chained-select" +"34","monomorphism-restriction" +"34","angular-di" +"34","lockscreenwidget" +"34","etcpasswd" +"34","responsivevoice" +"34","lptstr" +"34","httpresponsecache" +"34","lastaccesstime" +"34","custom-button" +"34","hwndhost" +"34","ning" +"34","custom-pipeline-component" +"34","test-project" +"34","spotify-docker-client" +"34","active-hdl" +"34","color-wheel" +"34","ios-lifecycle" +"34","hybridauthprovider" +"34","httpinvoker" +"34","android-palette" +"34","protobufjs" +"34","mozrepl" +"34","requirements-management" +"34","resume-upload" +"34","certifi" +"34","http-toolkit" +"34","duende" +"34","http-content-range" +"34","activeqt" +"34","requirejs-define" +"34","angular2-upgrade" +"34","huawei-iap" +"34","angular2viewencapsulation" +"34","nix-shell" +"34","qfuture" +"34","parametrize" +"34","urlread" +"34","custom-sections" +"34","sharpcompress" +"34","d2rq" +"34","urlmappings.groovy" +"34","struct.pack" +"34","stargate" +"34","elmish-wpf" +"34","global-filter" +"34","avalanche" +"34","flutter-pubspec" +"34","quay.io" +"34","media-url" +"34","msscriptcontrol" +"34","shelving" +"34","struct-member-alignment" +"34","security-scoped-bookmarks" +"34","stellar" +"34","lightweight-processes" +"34","scrollwheel" +"34","email-threading" +"34","haslayout" +"34","autoflush" +"34","sonarjs" +"34","bass.dll" +"34","uxtheme" +"34","hasura-docker" +"34","zkemkeeper" +"34","zipstream" +"34","mson" +"34","touchablewithoutfeedback" +"34","linkmovementmethod" +"34","yuidoc" +"34","mtkview" +"34","msvcr100.dll" +"34","quadratic-probing" +"34","ember-table" +"34","autonomy" +"34","google-play-protect" +"34","bed" +"34","amazon-in-app-purchase" +"34","queryinterface" +"34","automatic-failover" +"34","webimage" +"34","prepareforreuse" +"34","stateless-state-machine" +"34","ardalis-cleanarchitecture" +"34","user-acceptance-testing" +"34","bigfloat" +"34","user-object" +"33","jcc" +"33","bankers-rounding" +"33","banana" +"33","marten" +"33","cloudflare-r2" +"33","cloudrail" +"33","wct" +"33","jazzy" +"33","cloudflare-apps" +"33","phpmqtt" +"33","php-cpp" +"33","react-number-format" +"33","baqend" +"33","defaultnetworkcredentials" +"33","gina" +"33","treap" +"33","stacking-context" +"33","transit-gateway" +"33","ggspatial" +"33","stamen-maps" +"33","graphlookup" +"33","dedicated-hosting" +"33","webscarab" +"33","fdb" +"33","xquery-3.1" +"33","graphql-go" +"33","wherehas" +"33","edaplayground" +"33","gettickcount" +"33","smartcardio" +"33","clean-css" +"33","xsitype" +"33","why3" +"33","decentralized-identity" +"33","fedora16" +"33","anonymous-access" +"33","eclipse-orion" +"33","relplot" +"33","interface-design" +"33","fluentwait" +"33","multiple-apk" +"33","v-slot" +"33","jffs2" +"33","privatefontcollection" +"33","matlab-hg2" +"33","flotr2" +"33","base-tag" +"33","ecies" +"33","multipoint" +"33","vuejs-transition" +"33","yap" +"33","vuejs3-composition-api" +"33","printf-debugging" +"33","vue-filter" +"33","principalpermission" +"33","jest-mock-axios" +"33","field-description" +"33","pg-query" +"33","cmmi" +"33","phimagemanager" +"33","groovyws" +"33","ebay-design-templates" +"33","backbone-layout-manager" +"33","fiftyone" +"33","snap.js" +"33","xml-publisher" +"33","ng-bootstrap-modal" +"33","apollo-link" +"33","incremental" +"33","nextuntil" +"33","files-app" +"33","config-spec" +"33","apklib" +"33","configuration-profile" +"33","symfony-plugins" +"33","labelfield" +"33","cikernel" +"33","apisauce" +"33","pino" +"33","xmlconvert" +"33","language-packs" +"33","adobe-flash-cs3" +"33","imapi" +"33","packer-builder" +"33","apama" +"33","manatee.trello" +"33","jsf-1.1" +"33","laravel-cache" +"33","apache-stanbol" +"33","direnv" +"33","running-other-programs" +"33","pinata" +"33","admin-bro" +"33","sage50" +"33","cd-burning" +"33","nginx-module" +"33","sencha-touch-theming" +"33","adrotator" +"33","function-interposition" +"33","safari-push-notifications" +"33","jsr168" +"33","distro" +"33","discrete-optimization" +"33","plai" +"33","sendy" +"33","platform-sdk" +"33","ng-multiselect-dropdown" +"33","marble" +"33","free-variable" +"33","disco" +"33","soaphttpclientprotocol" +"33","ngrx-selectors" +"33","fslab" +"33","advising-functions" +"33","adhoc-polymorphism" +"33","cakephp-3.8" +"33","django-webpack-loader" +"33","ajaxmin" +"33","unreal-umg" +"33","rollup-plugin-postcss" +"33","jpopup" +"33","wcf-data-services-client" +"33","rowdetails" +"33","rollover-effect" +"33","angular-new-router" +"33","djgpp" +"33","djvu" +"33","mysql-connector-c" +"33","dnlib" +"33","fastsearch" +"33","root.plist" +"33","rpx" +"33","wcf-behaviour" +"33","sipp" +"33","ruby-jmeter" +"33","mysql-loadfile" +"33","ora-12154" +"33","rr" +"33","akka-grpc" +"33","windows-mobile-gps" +"33","vector-icons" +"33","aws-api-gateway-v2" +"33","unix-text-processing" +"33","aws-rest-api" +"33","red5pro" +"33","ps4" +"33","agentset" +"33","avm2" +"33","aws-chatbot" +"33","ibp-vscode-extension" +"33","docc" +"33","recordreader" +"33","doccano" +"33","datadude" +"33","wash-out" +"33","ibm-sterling" +"33","unparseable" +"33","jhat" +"33","canonical-quickly" +"33","document-view" +"33","angular-material-15" +"33","microsoft.identity.web" +"33","oracle-apex-20.1" +"33","pybliometrics" +"33","ropemacs" +"33","windowsbuilder" +"33","optim" +"33","urdf" +"33","microsoft-appstudio" +"33","jhbuild" +"33","servicepoint" +"33","covariogram" +"33","nsbrowser" +"33","epipe" +"33","pose-detection" +"33","ncr" +"33","epicor" +"33","superscrollorama" +"33","android-scripting" +"33","entryset" +"33","boilerplatejs" +"33","android-vitals" +"33","enterprise-web-library" +"33","svn-propset" +"33","ionic2-select" +"33","kaazing" +"33","aranchor" +"33","sap-query" +"33","nrules" +"33","sanctuary" +"33","gulp-clean-css" +"33","openbd" +"33","ttx-fonttools" +"33","swift5.7" +"33","twincat-hmi" +"33","inner-product" +"33","html-treebuilder" +"33","nsprogress" +"33","wso2-cloud" +"33","devanagari" +"33","boost-pool" +"33","nativescript-firebase" +"33","pchar" +"33","boost-property-map" +"33","gsmcomm" +"33","kdf" +"33","sbt-release" +"33","gs-installable-triggers" +"33","jquery-dirtyforms" +"33","blazored" +"33","mongojack" +"33","sbt-android-plugin" +"33","dynamics-nav-2013" +"33","postico" +"33","aztec-barcode" +"33","bootstrap-file-upload" +"33","dynamic-attributes" +"33","gtm-oauth2" +"33","azure-autoscaling-block" +"33","dynamics-nav-2016" +"33","bootstrap-file-input" +"33","wordpress-theme-astra" +"33","html-title" +"33","spring-security-6" +"33","turnkeylinux.org" +"33","azure-adf" +"33","buckminster" +"33","brat" +"33","osgearth" +"33","raster-graphics" +"33","donut-caching" +"33","org-table" +"33","orange-api" +"33","lwm2m" +"33","ubuntu-touch" +"33","over-clause" +"33","extensible-storage-engine" +"33","google-calendar-recurring-events" +"33","windowsversion" +"33","abstractuser" +"33","learn-ruby-on-rails" +"33","google-buzz" +"33","abrecordref" +"33","os.execl" +"33","tabbed-interface" +"33","wkb" +"33","system-analysis" +"33","androguard" +"33","system-font" +"33","magic-mirror" +"33","fragmentstateadapter" +"33","objective-c-nullability" +"33","cocos2d-python" +"33","machinist" +"33","sidekiq-monitor" +"33","1password" +"33","system.commandline" +"33","system.array" +"33",".net-attributes" +"33","rdbms-agnostic" +"33","atompub" +"33","3scale" +"33","shape-recognition" +"33","visifire" +"33","videoquality" +"33","pyreverse" +"33","obr" +"33","foundry-data-connection" +"33","foundry-python-transform" +"33","foxit-reader" +"33","mixamo" +"33","codeigniter-form-validation" +"33","rb-appscript" +"33","continued-fractions" +"33","tizen-tv" +"33","openvdb" +"33","azure-oms" +"33","polish-notation" +"33","mleap" +"33","hl7-cda" +"33","scrabble" +"33","c++builder-xe4" +"33","cordovawebview" +"33","sqldbtype" +"33","business-layer" +"33","xamarin.windows" +"33","tmb" +"33","bull.js" +"33","cordova-nativestorage" +"33","dramatiq" +"33","control-array" +"33","non-printable" +"33","c#-record-type" +"33","mobfox" +"33","gcc3" +"33","cachegrind" +"33","tbl" +"33","convertto-json" +"33","excel-template" +"33","gumby-framework" +"33","exoplayer-media-item" +"33","nullish-coalescing" +"33","scalaxb" +"33","device-management" +"33","coolstorage" +"33","sql2o" +"33","ragdoll" +"33","asp.net-core-testhost" +"33","cachefactory" +"33","uialertviewcontroller" +"33","c4.5" +"33","hocr" +"33","numactl" +"33","scaldi" +"33","uiswipeactionsconfiguration" +"33","openidm" +"33","vfio" +"33","holder.js" +"33","tinymce-rails" +"33","commitizen" +"33","cstdint" +"33","string-table" +"33","colgroup" +"33","oms" +"33","cstringio" +"33","collaborative-editing" +"33","teststand" +"33","perspectives" +"33","move-uploaded-file" +"33","generic-derivation" +"33","nl-classifier" +"33","ogg-theora" +"33","lr1" +"33","nimble" +"33","elasticsearch-shield" +"33","pest" +"33","hug" +"33","protect-from-forgery" +"33","color-thief" +"33","react-bootstrap4-modal" +"33","qi" +"33","laravel-route" +"33","qnames" +"33","commonj" +"33","mesos-chronos" +"33","angular.json" +"33","offline-storage" +"33","cfoutput" +"33","mootools-more" +"33","reactive-mongo-java" +"33","ios13.3" +"33","angular-config" +"33","loopback-address" +"33","gentics-mesh" +"33","comp-3" +"33","cubical-type-theory" +"33","qcamera" +"33","oft" +"33","chargebee" +"33","common-service-locator" +"33","hugo-theme" +"33","angular-chartist.js" +"33","resolutions" +"33","ipyvuetify" +"33","alias-method" +"33","bfd" +"33","statistical-sampling" +"33","tfs-2018" +"33","mdbg" +"33","tigergraph" +"33","msbuild-15" +"33","tibco-topic" +"33","themedata" +"33","secure-transport" +"33","seam-conversation" +"33","startup-error" +"33","webmatrix-3" +"33","amazon-gateway" +"33","google-gsuite" +"33","stddeque" +"33","zabbix-custom-reports" +"33","automerge" +"33","hatch" +"33","powershellget" +"33","zero-initialization" +"33","gmsplace" +"33","confd" +"33","tf2onnx" +"33","mdac" +"33","gmaven" +"33","scroll-snap-points" +"33","archiverjs" +"33","concreteclass" +"33","amazon-dynamodb-data-modeling" +"33","ppx" +"33","cvsnt" +"33","mrtg" +"33","autoplot" +"33","webcontent" +"33","glom" +"33","asenumerable" +"33","flutter-qrcode" +"33","beast-websockets" +"33","heremap-navigation" +"33","d3heatmap" +"33","touchdb" +"33","concurrentmodificationexception" +"33","componentlistener" +"33","google-merchant-center" +"33","compodoc" +"33","dartdoc" +"33","partial-mocks" +"33","web3dart" +"33","amazon-kinesis-agent" +"33","arelle" +"33","ashot" +"33","multicastdelegate" +"33","autossh" +"33","weblog" +"33","traceability" +"33","flutter-table" +"32","bandit-python" +"32","backtrack-linux" +"32","transitiondrawable" +"32","editplus" +"32","editpad" +"32","mvchtmlstring" +"32","staleobjectstate" +"32","mvapich2" +"32","php-code-coverage" +"32","edeliver" +"32","cloudberry" +"32","getwritabledatabase" +"32","phpize" +"32","multiviews" +"32","principal-components" +"32","xsp4" +"32","remix-ide" +"32","flite" +"32","flutter-add-to-app" +"32","badparcelableexception" +"32","live-sass-compiler" +"32","multipolygons" +"32","ts-node-dev" +"32","tsdx" +"32","yahoo-kafka-manager" +"32","load-factor" +"32","flow-framework" +"32","react-pdf-viewer" +"32","whoops" +"32","file-link" +"32","click-counting" +"32","sitefinity-8" +"32","ckreference" +"32","debug-build" +"32","graphql-flutter" +"32","grgit" +"32","siteorigin" +"32","tempdir" +"32","telecom-manager" +"32","apache-beam-internals" +"32","ansible-filter" +"32","wddx" +"32","dci" +"32","client-templates" +"32","declval" +"32","graphql-python" +"32","dbproj" +"32","manageiq" +"32","firefox-5" +"32","pico-8" +"32","p4java" +"32","firebird-psql" +"32","runpy" +"32","casbin" +"32","rum" +"32","flamerobin" +"32","soap-extension" +"32","padre" +"32","fingerprintjs2" +"32","vorpal.js" +"32","aes-ni" +"32","catransform3drotate" +"32","find-all-references" +"32","ngrx-reducers" +"32","uniroot" +"32","uninstallstring" +"32","separating-axis-theorem" +"32","sentinelsat" +"32","xerces2-j" +"32","ads-api" +"32","xdt" +"32","cdata-drivers" +"32","ngboilerplate" +"32","semantic-kernel" +"32","dbdatareader" +"32","semaphore-ci" +"32","semgrep" +"32","swift-pythonkit" +"32","child-actions" +"32","fuel" +"32","full-text-catalog" +"32","importdata" +"32","pixbuf" +"32","jsr107" +"32","checkvalidity" +"32","constraintset" +"32","laravel-backpack-5" +"32","chronic" +"32","imageresizer-diskcache" +"32","jtemplate" +"32","container-managed" +"32","xpand" +"32","json-web-signature" +"32","symfony-eventdispatcher" +"32","pubxml" +"32","optimistic-ui" +"32","variable-fonts" +"32","caprover" +"32","walmart-electrode" +"32","vds" +"32","recursionerror" +"32","fast-endpoints" +"32","dockeroperator" +"32","ora-01427" +"32","grails-config" +"32","serilog-exceptions" +"32","django-userena" +"32","microsoft.ml" +"32","data-access-object" +"32","wiki-engine" +"32","servicetestcase" +"32","session-state-server" +"32","dkpro-core" +"32","angular-scenario" +"32","dkms" +"32","windeployqt" +"32","pthread-barriers" +"32","vb4android" +"32","routelink" +"32","pushbots" +"32","pushd" +"32","psapi" +"32","upn" +"32","myhdl" +"32","iaccessible" +"32","kendo-gantt" +"32","datagridviewcomboboxcolumn" +"32","microsoft-graph-booking" +"32","windows-server-container" +"32","valums-file-uploader" +"32","docplexcloud" +"32","ora-00600" +"32","serverless-framework-step-functions" +"32","gpytorch" +"32","mysqlupgrade" +"32","sequelize-auto" +"32","pvclust" +"32","inertial-navigation" +"32","pseudo-streaming" +"32","document-store" +"32","carchive" +"32","aws-appstream" +"32","annotatedtimeline" +"32","updown" +"32","updatexml" +"32","csharpscript" +"32","keyguardlock" +"32","documentum-dql" +"32","uriencoding" +"32","pspell" +"32","windows-phone-7.8" +"32","mysql-group-replication" +"32","kentico-api" +"32","inputconnection" +"32","crashloopbackoff" +"32","opencv3.2" +"32","postgrex" +"32","opcode-cache" +"32","wrangler" +"32","errbit" +"32","infobip-api" +"32","tun-tap" +"32","tuple-relational-calculus" +"32","jruby-java-interop" +"32","delete-method" +"32","bluedragon" +"32","apple-vpp" +"32","surveillance" +"32","pdf-reactor" +"32","boost-icl" +"32","module-export" +"32","nsepy" +"32","salesforce-developer" +"32","nsenumerator" +"32","twisted.client" +"32","bloc-test" +"32","navgraph" +"32","cpio" +"32","twisted.conch" +"32","nsapplication-delegate" +"32","android-text-color" +"32","boost-format" +"32","nestjs-microservice" +"32","invantive-control" +"32","onnx-coreml" +"32","word-spacing" +"32","apple-m7" +"32","jquery-transit" +"32","groupwise" +"32","openform" +"32","dwoo" +"32","android-scrollable-tabs" +"32","nsattributedstringkey" +"32","ueye" +"32","out-gridview" +"32","viewwithtag" +"32","orchestra" +"32","rgeo-shapefile" +"32","table-footer" +"32","abcpdf9" +"32","vision-pro" +"32","foscommentbundle" +"32","migratordotnet" +"32","rcc" +"32","extended-choice-parameter" +"32","legacy-app" +"32","koin-scope" +"32","windows-virtual-desktop" +"32","syndicationfeed" +"32","pyqtdeploy" +"32","richtextarea" +"32","extaudiofile" +"32","lumen-5.3" +"32","java-pair-rdd" +"32","range-checking" +"32","android-appshortcut" +"32","browser-state" +"32","typetoken" +"32","pygears" +"32","system.memory" +"32","shinyalert" +"32","1wire" +"32","fabric8-kubernetes-client" +"32","lunarvim" +"32","shinytree" +"32","3dcamera" +"32","networkstatsmanager" +"32","output-clause" +"32","oam" +"32","typolink" +"32","kontakt.io" +"32","newsequentialid" +"32","javafx-webview" +"32","viewmodelproviders" +"32","visual-odometry" +"32","async-profiler" +"32","frameset-iframe" +"32","codemirror-6" +"32","wordpress-database" +"32","google-business" +"32","rewind" +"32","razorpdf" +"32","objectaid" +"32","android-assetmanager" +"32","facebook-actionscript-api" +"32","gae-python27" +"32","c++builder-xe6" +"32","android-connectionservice" +"32","hashalgorithm" +"32","dreamspark" +"32","numpy-stl" +"32","nuke-build" +"32","experience-editor" +"32","scikit-multilearn" +"32","asp.net-minimal-apis" +"32","refactoring-databases" +"32","nullability" +"32","uikitformac" +"32","nosuchfieldexception" +"32","drupal-path-aliases" +"32","azure-iot-suite" +"32","devicepixelratio" +"32","opengl-1.x" +"32","openstack-keystone" +"32","scnmaterial" +"32","wx.textctrl" +"32","exclude-constraint" +"32","vgam" +"32","iso9660" +"32","sql-maven-plugin" +"32","executiontimeout" +"32","version-detection" +"32","gedit-plugin" +"32","scala-native" +"32","uitableviewdiffabledatasource" +"32","gcc-pedantic" +"32","xcode4.1" +"32","android-flavordimension" +"32","notistack" +"32","digit-separator" +"32","qvalidator" +"32","drawtobitmap" +"32","dgml" +"32","digital-assets-links" +"32","uib" +"32","drawinrect" +"32","redhat-datavirt" +"32","screen-grab" +"32","uicollectionviewdelegateflowlayout" +"32","numpy-dtype" +"32","iscrollview" +"32","dialing" +"32","digital-compass" +"32","redpanda" +"32","mockk-verify" +"32","duckduckgo" +"32","activeview" +"32","spreadsheet-excel-writer" +"32","communicator" +"32","community-server" +"32","react-dropdown-tree-select" +"32","google-cloud-http-load-balancer" +"32","proxy-protocol" +"32","monticello" +"32","react-leaflet-draw" +"32","speakerphone" +"32","ioutils" +"32","curve-25519" +"32","activation-context-api" +"32","escript" +"32","e-ink" +"32","combining-marks" +"32","cuml" +"32","google-compute-api" +"32","combinatory-logic" +"32","android-monkey" +"32","peverify" +"32","angular-arrays" +"32","log-viewer" +"32","test-first" +"32","android-jetpack-compose-button" +"32","ltk" +"32","elixir-jason" +"32","resource-adapter" +"32","odometer" +"32","zposition" +"32","commandfield" +"32","hypercube" +"32","oidc-provider" +"32","geopositioning" +"32","geoplot" +"32","angular-controlvalueaccessor" +"32","angular2-inputs" +"32","angular2-custom-pipes" +"32","resource-monitor" +"32","texinfo" +"32","angular14upgrade" +"32","terraform-state" +"32","angulardraganddroplists" +"32","prolog-metainterpreter" +"32","memory-mapped-io" +"32","perl-packager" +"32","log-files" +"32","monocle-scala" +"32","logbook" +"32","android-room-prepackageddatabase" +"32","hwid" +"32","storybook-addon-specifications" +"32","commerce.js" +"32","spider-chart" +"32","android-jsinterface" +"32","odbc-sql-server-driver" +"32","geonear" +"32","moniker" +"32","requires" +"32","qdomdocument" +"32","stringbyevaluatingjavascr" +"32","getcaretpos" +"32","lazy-static" +"32","sunrpc" +"32","bazel-python" +"32","webaddress" +"32","iiif" +"32","git-subrepo" +"32","has-one-through" +"32","hbm2java" +"32","line-api" +"32","berkeley-db-xml" +"32","gldrawpixels" +"32","heap-fragmentation" +"32","quality-gate" +"32","qscrollbar" +"32","sorting-network" +"32","flycapture" +"32","flutter-scrollbar" +"32","flutter-secure-storage" +"32","webforms-routing" +"32","licenses.licx" +"32","gloox" +"32","multihomed" +"32","webkit2" +"32","font-rendering" +"32","glr" +"32","pareto-optimality" +"32","parrot" +"32","compile-time-type-checking" +"32","parse4cn1" +"32","mtl-file" +"32","tquery" +"32","mtlbuffer" +"32","amazon-fire-os" +"32","argon" +"32","transferable" +"32","tps" +"32","tileserver-gl" +"32","subgurim-maps" +"32","max-age" +"32","automapper-9" +"32","measureoverride" +"32","scringo" +"32","zend-loader" +"32","uvloop" +"32","securitycenter" +"32","linux-security-module" +"32","scrutor" +"32","vaadin21" +"32","darksky" +"32","z-notation" +"32","zephir" +"32","zgrep" +"32","searchfiltercollection" +"32","if-none-match" +"32","maven-invoker-plugin" +"32","touchesended" +"32","std-byte" +"32","powerbuilder.net" +"32","seafile-server" +"31","defensive-copy" +"31","eclipse-tptp" +"31","graphcms" +"31","deepequals" +"31","basedon" +"31","cloudsight" +"31","matlabpool" +"31","floatbuffer" +"31","jboss-web" +"31","flutter-clippath" +"31","phpbrew" +"31","instancecontextmode" +"31","griddler" +"31","grapheme" +"31","eccodes" +"31","ts-mockito" +"31","graphene2" +"31","yii-validation" +"31","echo-server" +"31","php-amqp" +"31","multiparameter" +"31","clockpicker" +"31","flickable" +"31","telerik-combobox" +"31","repeating-linear-gradient" +"31","groupme" +"31","flutter-exception" +"31","local-security-policy" +"31","graphql.net" +"31","trustedconnection" +"31","sst" +"31","relaxed-atomics" +"31","gige-sdk" +"31","phonegap-facebook-plugin" +"31","getsockopt" +"31","process-group" +"31","fen" +"31","edgedb" +"31","eclipse-hawkbit" +"31","react-native-keychain" +"31","backbone-boilerplate" +"31","jenv" +"31","fluentautomation" +"31","product-key" +"31","liteide" +"31","filenet-cpe" +"31","phantom-wallet" +"31","cloudera-cdp" +"31","profile-provider" +"31","telescope.nvim" +"31","react-native-notifications" +"31","react-native-nfc-manager" +"31","livekit" +"31","trinidad-gem" +"31","sketching" +"31","terminal-server" +"31","fuser" +"31","unchecked-conversion" +"31","pikepdf" +"31","xdv" +"31","smartgwt-pro" +"31","undeploy" +"31","next-api" +"31","chip-8" +"31","ditto" +"31","in-app-purchase-receipt" +"31","celllist" +"31","ccm" +"31","flatfilereader" +"31","unirx" +"31","sentencepiece" +"31","filtered-lookup" +"31","cbutton" +"31","x-facebook-platform" +"31","contactus" +"31","adobe-javascript" +"31","fxg" +"31","xpress-optimizer" +"31","senti-wordnet" +"31","python-server-pages" +"31","findname" +"31","fstar" +"31","margin-left" +"31","socketmobile" +"31","finereader" +"31","adobe-director" +"31","binomial-theorem" +"31","appcfg" +"31","frontend-maven-plugin" +"31","social-network-friendship" +"31","blackduck" +"31","apache-spark-1.4" +"31","xpathdocument" +"31","jsfunit" +"31","bi-temporal" +"31","firebase-assistant" +"31","bixolon-printer" +"31","jtcalendar" +"31","soaplib" +"31","xirsys" +"31","pivot-without-aggregate" +"31","checklist-model" +"31","vshost.exe" +"31","soap1.2" +"31","jscoverage" +"31","falco" +"31","sitecore-azure" +"31","sharepointadmin" +"31","wcf-proxy" +"31","sisense" +"31","react-widgets" +"31","fastcgi-mono-server" +"31","microsoft-data-sqlclient" +"31","grammar-kit" +"31","gpy" +"31","mysql-error-2013" +"31","microsoft-cpp-unit-test" +"31","gprbuild" +"31","simplerepository" +"31","react-virtuoso" +"31","method-modifier" +"31","ora-04091" +"31","fastapiusers" +"31","fastparse" +"31","kissxml" +"31","share-plus" +"31","meteor-useraccounts" +"31","gradientdrawable" +"31","sharepoint-feature" +"31","failed-to-load-viewstate" +"31","aws-iam-identity-center" +"31","agm-map" +"31","css-houdini" +"31","mydac" +"31","css-import" +"31","serverpod" +"31","facebook-payments" +"31","rlwrap" +"31","push.js" +"31","w3-css" +"31","rubymotion-promotion" +"31","django-runserver" +"31","calendar-control" +"31","dltk" +"31","datakey" +"31","mysql-dependent-subquery" +"31","updateview" +"31","validation-controls" +"31","aio-mysql" +"31","mysql-error-1025" +"31","vuzix" +"31","rkobjectmapping" +"31","iconvertible" +"31","pyaudioanalysis" +"31","ruby-ffi" +"31","camera-matrix" +"31","windows-live-writer" +"31","service-node-port-range" +"31","angular-router-params" +"31","watch-window" +"31","ajax-forms" +"31","awsdeploy" +"31","cakephp3" +"31","canonical-form" +"31","average-precision" +"31","creative-cloud" +"31","aws-permissions" +"31","ibm-jvm" +"31","ajaxpro" +"31","near-real-time" +"31","saripaar" +"31","jqwik" +"31","ttphotoviewcontroller" +"31","aws-security-hub" +"31","jquery-delegate" +"31","jwi" +"31","apple-pencil" +"31","cosm" +"31","svg-android" +"31","jqte" +"31","juniper-network-connect" +"31","sardine" +"31","grunt-connect-proxy" +"31","spring-ide" +"31","nearley" +"31","spring-integration-ip" +"31","junitparams" +"31","tv4" +"31","gruff" +"31","android-sound" +"31","spring-security-cas" +"31","jquery-ui-plugins" +"31","information-gain" +"31","cpd" +"31","jquery-1.3.2" +"31","android-things-console" +"31","application-resource" +"31","onscrollchanged" +"31","inputscope" +"31","boost-ptr-container" +"31","boost-unordered" +"31","cornice" +"31","gulp-notify" +"31","twilio-javascript" +"31","nshttpcookiestorage" +"31","kantu" +"31","application-close" +"31","spring-cloud-skipper" +"31","nerdctl" +"31","twofish" +"31","password-autofill" +"31","inputformatter" +"31","input-history" +"31","writealltext" +"31","jruby-rack" +"31","posh-ssh" +"31","mod-proxy-html" +"31","aqtime" +"31","path-manipulation" +"31","netwire" +"31","oboe.js" +"31","analytics-engine" +"31","pynsist" +"31","brooklyn" +"31","video-ads" +"31","least-privilege" +"31","min3d" +"31","oslo" +"31","vix" +"31","microsoft-oauth" +"31","vifm" +"31","3cx" +"31","microsoft-runtime-library" +"31","osmium" +"31",".ico" +"31","magic-constants" +"31","google-analytics-data-api" +"31","visibilitychange" +"31","aura.js" +"31","wit-ai" +"31","rfc5322" +"31","middleman-4" +"31","viewresult" +"31","short-circuit-evaluation" +"31","system-monitoring" +"31","nzsql" +"31","shopify-javascript-buy-sdk" +"31","rdiscount" +"31","rbokeh" +"31","bufferedstream" +"31","set-include-path" +"31","mirage" +"31","kotlinx.coroutines.flow" +"31","netscape" +"31","libjson" +"31","f#-async" +"31","oracle-xml-publisher" +"31","visual-web-gui" +"31","pyhdf" +"31","sysobjects" +"31","ordered-test" +"31","objectpool" +"31","rhythmbox" +"31",".net-core-publishsinglefile" +"31","rhtml" +"31","windsor-facilities" +"31","express-rate-limit" +"31","javascript-audio-api" +"31","jar-with-dependencies" +"31","azure-oauth" +"31","radhtmlchart" +"31","jak" +"31","holoviz-panel" +"31","aspwizard" +"31","azure-sql-edge" +"31","togaf" +"31","jahia" +"31","sccm-2007" +"31","horizontal-accordion" +"31","r7rs" +"31","sql-calc-found-rows" +"31","qwikjs" +"31","uicontrolstate" +"31","num-lock" +"31","mkmaprect" +"31","quicklaunch" +"31","normalize-css" +"31","xamarin.mobile" +"31","non-maximum-suppression" +"31","digital-analog-converter" +"31","tclientsocket" +"31","device-name" +"31","devise-jwt" +"31","isinrole" +"31","devise-recoverable" +"31","sql-revoke" +"31","hierarchyviewer" +"31","openrouteservice" +"31","titled-border" +"31","uiscene" +"31","tinygo" +"31","openiso8583.net" +"31","scratch-file" +"31","redisinsights" +"31","baasbox" +"31","tail-call" +"31","hibernate-generic-dao" +"31","controller-factory" +"31","open-mobile-api" +"31","android-os-handler" +"31","colortransform" +"31","protocol-buffers-3" +"31","qpolygon" +"31","resgen" +"31","ejabberd-auth" +"31","zsi" +"31","cfdirectory" +"31","lrs" +"31","zsh-alias" +"31","layoutmargins" +"31","cewp" +"31","residemenu" +"31","android-obfuscation" +"31","laspy" +"31","http-status-code-411" +"31","collator" +"31","escrow" +"31","com0com" +"31","streamline" +"31","resharper-6.1" +"31","odftoolkit" +"31","nifty-gui" +"31","textsum" +"31","memory-editing" +"31","qcolor" +"31","es5-compatiblity" +"31","react-monaco-editor" +"31","ios-targets" +"31","mplab-x" +"31","geneva-framework" +"31","elcimagepickercontroller" +"31","reachability-swift" +"31","october-partial" +"31","custom-paging" +"31","android-multi-module" +"31","persona" +"31","pgbackrest" +"31","ipp-protocol" +"31","cgpdfcontext" +"31","memberpress" +"31","android-open-accessory" +"31","pytmx" +"31","mpf" +"31","strictfp" +"31","ios6.0" +"31","ios-universal-framework" +"31","reactivekit" +"31","sp-msforeachdb" +"31","zxing-js" +"31","ios-web-app" +"31","cgit" +"31","google-data" +"31","react-intersection-observer" +"31","peek-pop" +"31","e-token" +"31","columnspan" +"31","commission-junction" +"31","qtwebview" +"31","powerpoint-web-addins" +"31","webforms-view-engine" +"31","sony-lifelog-api" +"31","user-mode-linux" +"31","textutils" +"31","zalgo" +"31","energyplus" +"31","end-to-end-encryption" +"31","hawkular" +"31","query-variables" +"31","cwrsync" +"31","sdo" +"31","sort-object" +"31","healthvault" +"31","powerbuilder-conversion" +"31","usb-hid" +"31","cview" +"31","gksudo" +"31","bigcommerce-stencil-cli" +"31","passenger-nginx" +"31","has-scope" +"31","fontawesome-4.4.0" +"31","header-row" +"31","sttp" +"31","google-suggest" +"31","emptydatatext" +"31","mediarouter" +"31","haskell-language-server" +"31","structopt" +"31","ms-project-server-2016" +"31","composite-literals" +"31","here-routing" +"31","basis" +"31","webclient.uploaddata" +"31","heroku-pipelines" +"31","iepngfix" +"31","google-java-format" +"31","torsocks" +"31","heterogeneous-services" +"31","flutter-scaffold" +"31","vaadin22" +"31","elysiajs" +"31","mayanedms" +"31","linguaplone" +"31","linguijs" +"31","thunderbird-webextensions" +"31","multihead-attention" +"31","linktext" +"30","bart" +"30","floating-point-comparison" +"30","deep-diff" +"30","ebay-lms" +"30","react-simple-maps" +"30","skia4delphi" +"30","teradata-aster" +"30","backbone-local-storage" +"30","antlr2" +"30","x-robots-tag" +"30","phassetcollection" +"30","vue-quill-editor" +"30","loadmodule" +"30","webspeed" +"30","load-order" +"30","multiton" +"30","antora" +"30","jemmy" +"30","yii2-widget" +"30","skaudionode" +"30","tensorflow-quantum" +"30","instance-method" +"30","git-hash" +"30","multiscaleimage" +"30","vuejs-datepicker" +"30","tri-state-logic" +"30","intel-atom" +"30","graphene-sqlalchemy" +"30","fdopen" +"30","phonegap-plugin-push" +"30","graphical-interaction" +"30","antv" +"30","relative-locators" +"30","ferret" +"30","flowpanel" +"30","vsprops" +"30","tsfresh" +"30","flowfile" +"30","eclipse-microprofile-config" +"30","efl" +"30","efi" +"30","grasp" +"30","tsconfig.json" +"30","flotr" +"30","stackify" +"30","slamdata" +"30","privoxy" +"30","reify" +"30","fetched-property" +"30","interactjs" +"30","sql-server-linux" +"30","liquidfun" +"30","file-generation" +"30","dcommit" +"30","tropo" +"30","clistbox" +"30","gigaspaces" +"30","slimv" +"30","weak-events" +"30","php-ml" +"30","ssl-handshake" +"30","xpathnodeiterator" +"30","python-beautifultable" +"30","kube-controller-manager" +"30","piccolo" +"30","senchatouch-2.4" +"30","soft-hyphen" +"30","c-ares" +"30","ccw" +"30","app-engine-patch" +"30","safehandle" +"30","sendgrid-api-v2" +"30","vroom" +"30","snoopy" +"30","python-onvif" +"30","swiftui-toolbar" +"30","vote-up-buttons" +"30","datazen-server" +"30","fsharp.data.sqlclient" +"30","causal-inference" +"30","circular-permutations" +"30","biojava" +"30","jsmooth" +"30","finite-state-automaton" +"30","pagepiling.js" +"30","mapael" +"30","imaskjs" +"30","manifest.cache" +"30","flash-player-11" +"30","unity2.0" +"30","pagy" +"30","land-of-lisp" +"30","manchester-syntax" +"30","filterattribute" +"30","lanczos" +"30","lager" +"30","jsonfield" +"30","inbound-security-rule" +"30","blacklight" +"30","firefox-driver" +"30","data-serialization" +"30","nextion" +"30","configsource" +"30","biztalk-rule-engine" +"30","kubernetes-rook" +"30","fileopener2" +"30","apache-spark-3.0" +"30","blackberry-push" +"30","chrome-dev-editor" +"30","uivibrancyeffect" +"30","kubernetes-cluster" +"30","keystonejs6" +"30","angular-ngmodelchange" +"30","fastapi-middleware" +"30","docbook-xsl" +"30","red-black-tree-insertion" +"30","avmetadataitem" +"30","keywindow" +"30","microblink" +"30","alassetlibrary" +"30","animate-on-scroll" +"30","vendor-branch" +"30","server-tags" +"30","ibm-ifs" +"30","sitecore-exm" +"30","read-committed" +"30","servicecollection" +"30","rndis" +"30","opnet" +"30","nana" +"30","alexa-sdk-nodejs" +"30","cantera" +"30","namedpipeserverstream" +"30","aws-app-runner" +"30","variadic-tuple-types" +"30","windows-credential-provider" +"30","django-push-notifications" +"30","vuex-orm" +"30","vuforia-cloud-recognition" +"30","cameracapturetask" +"30","recordtype" +"30","vultr" +"30","windows-media-encoder" +"30","joomla-content-editor" +"30","react-with-styles" +"30","fast-esp" +"30","row-major-order" +"30","wcf-wshttpbinding" +"30","aiopg" +"30","ora-12560" +"30","californium" +"30","faces-flow" +"30","aim" +"30","mysql-error-1044" +"30","rsyntaxtextarea" +"30","document-provider" +"30","updatable-views" +"30","google-truth" +"30","fastroute" +"30","sipjs" +"30","calendarcontract" +"30","django-suit" +"30","airpods" +"30","hyperledger-iroha" +"30","akka-kafka" +"30","faultcontract" +"30","read-unread" +"30","real-datatype" +"30","fatwire" +"30","karabiner" +"30","gulp-task" +"30","k8s-rolebinding" +"30","twitter-bootstrap-4-beta" +"30","apple-documentation" +"30","pcap-ng" +"30","bluenrg" +"30","spring-security-test" +"30","grunt-ts" +"30","spring-social-google" +"30","countplot" +"30","corewlan" +"30","invalid-pointer" +"30","spring-batch-stream" +"30","kartograph" +"30","twitter-api-v1" +"30","spring-cloud-connectors" +"30","desktop-sharing" +"30","enrich-my-library" +"30","android-sql" +"30","inputmethodmanager" +"30","boxen" +"30","episerver-8" +"30","azure-app-api" +"30","azure-china" +"30","twilio-conference" +"30","android-textview-autosize" +"30","dynamic-sizing" +"30","spring-gem" +"30","sass-maps" +"30","nsanimationcontext" +"30","boinc" +"30","delphi-units" +"30","pomegranate" +"30","mongoid5" +"30","eaglcontext" +"30","applepay-web" +"30","application-client" +"30","neoeloquent" +"30","io-buffering" +"30","appsflyer-ios-sdk" +"30","couchdb-lucene" +"30","swift-composable-architecture" +"30","blender-2.50" +"30","sap-conversational-ai" +"30","android-studio-electric-eel" +"30","juddi" +"30","onexception" +"30","http-1.0" +"30","entityspaces" +"30","postman-mocks" +"30","nsfontmanager" +"30","positive-lookahead" +"30","twitter-bootstrap-wizard" +"30","power-analysis" +"30","workflow-manager-1.x" +"30","neos-server" +"30","nbuilder" +"30","organizational-chart" +"30","objectstatemanager" +"30","systemmenu" +"30","netbeans-10" +"30","browser-api" +"30","system-integration" +"30","libqxt" +"30","javaapns" +"30","bubble-popup" +"30","domino-appdev-pack" +"30","godbolt" +"30","java-bridge-method" +"30","javabuilders" +"30","form-processing" +"30","sigils" +"30","breezingforms" +"30","virtual-file" +"30","coldfusion-2021" +"30","orphaned-objects" +"30","formsflow" +"30","syncml" +"30","coldfire" +"30","pyfirmata" +"30","midi-interface" +"30","pyftpdlib" +"30","256color" +"30","browserstack-app-automate" +"30","minimum-cut" +"30","ui5-webcomponents" +"30","browser-scrollbars" +"30","siesta" +"30","gold-parser" +"30",".net-core-1.1" +"30","minifiedjs" +"30","rhq" +"30","sfml.net" +"30","vivagraphjs" +"30","oshi" +"30","777" +"30","rhino-etl" +"30","ott" +"30","lumia" +"30","kotlin-delegate" +"30","virtualstore" +"30","pypika" +"30","vivaldi" +"30","knppaginatorbundle" +"30","abap-adt" +"30","setf" +"30","sfauthenticationsession" +"30","rich-client-platform" +"30","pytest-aiohttp" +"30","cocos2d-iphone-3" +"30","hiqpdf" +"30","xamarin.forms.carouselview" +"30","asp-net-mvc-1" +"30","scrapy-playwright" +"30","dot-plot" +"30","scrapy-selenium" +"30","registration-free-com" +"30","control-c" +"30","hlint" +"30","gcc10" +"30","astoria" +"30","tnsping" +"30","nox" +"30","mkcircle" +"30","tippecanoe" +"30","cakeemail" +"30","radtextbox" +"30","c5.0" +"30","azure-fluent-api" +"30","gatsby-remark-image" +"30","p-np" +"30","expect.pm" +"30","openid-selector" +"30","android-compose-button" +"30","itemselector" +"30","pluggable-database" +"30","tar.gz" +"30","png-24" +"30","toisostring" +"30","opengl-es-3.1" +"30","android-cards" +"30","norton" +"30","redpitaya" +"30","byteman" +"30","no-match" +"30","burrows-wheeler-transform" +"30","doxygen-addtogroup" +"30","assertraises" +"30","gcutil" +"30","drupal-field-api" +"30","scntext" +"30","xcelsius" +"30","openstacksdk" +"30","android-fragmentscenario" +"30","openscript" +"30","mkstemp" +"30","point-in-time" +"30","node-libcurl" +"30","spout" +"30","layouttransform" +"30","mef2" +"30","iosurface" +"30","ios-vision" +"30","nlm" +"30","metaobject" +"30","moryx" +"30","project-hosting" +"30","nodemanager" +"30","activex-exe" +"30","http-status-code-409" +"30","pecs" +"30","custom-eventlog" +"30","launch-template" +"30","dual-table" +"30","mono-embedding" +"30","provisioned-iops" +"30","elasticsearch-ruby" +"30","responsive-emails" +"30","esri-javascript-api" +"30","angular-jest" +"30","locationmatch" +"30","mpic++" +"30","etags" +"30","logging-application-block" +"30","angular-dragula" +"30","mousearea" +"30","elasticity" +"30","commandbox" +"30","qandroidjniobject" +"30","hyperic" +"30","terraform0.11" +"30","actionbarsherlock-map" +"30","resource-editor" +"30","command-history" +"30","resonance-audio" +"30","strconv" +"30","chardev" +"30","pywt" +"30","genericsetup" +"30","longest-prefix" +"30","node-firebird" +"30","irssi" +"30","getresponsestream" +"30","mozilla-sops" +"30","nhunspell" +"30","httpinterceptor" +"30","angular2-compiler" +"30","omniauth-twitter" +"30","requests-oauthlib" +"30","android-livedata-transformations" +"30","reactfx" +"30","streamwriter.write" +"30","zk-snark" +"30","quarkus-extension" +"30","secure-context" +"30","vaadin-spring-boot" +"30","git-track" +"30","soy-templates" +"30","structured-exception" +"30","art-runtime" +"30","uwp-navigation" +"30","msisdn" +"30","ietf-restconf" +"30","zones" +"30","securitydomain" +"30","glium" +"30","hdcp" +"30","zend-servicemanager" +"30","webargs" +"30","topaz-signatures" +"30","web-animations-api" +"30","practical-common-lisp" +"30","best-buy-api" +"30","qsystemtrayicon" +"30","pragma-pack" +"30","stryker" +"30","ident" +"30","sundials" +"30","starman" +"30","solr7" +"30","concurrency-runtime" +"30","sunpkcs11" +"30","liipfunctionaltestbundle" +"30","pandorabots" +"30","beginthread" +"30","scriban" +"30","passive-event-listeners" +"30","mule-module-jpa" +"30","arcgis-online" +"30","amazon-cloudhsm" +"30","soundchannel" +"30","sui" +"30","ido-mode" +"30","stickyrecycleview" +"30","msde" +"30","liferay-7.3" +"30","zegocloud" +"30","flutter-razorpay" +"30","qt-resource" +"30","zef" +"30","sucker-punch" +"30","ie7.js" +"30","tilt-sensor" +"30","completion-service" +"30","theme-ui" +"30","amazon-javascript-sdk" +"30","msbuild-wpp" +"30","fm-radio" +"30","amazon-msk" +"30","autosummary" +"29","wifstream" +"29","clair" +"29","tsdoc" +"29","debian-bookworm" +"29","fibplus" +"29","flutter-3.0" +"29","edge-function" +"29","skfuzzy" +"29","whatwg-streams-api" +"29","localsystem" +"29","defadvice" +"29","liveview" +"29","teaser" +"29","progid" +"29","felogin" +"29","git-grep" +"29","bankid" +"29","remotes" +"29","maui-shell" +"29","phaser" +"29","flexicious" +"29","livelock" +"29","mutable-reference" +"29","trustwallet" +"29","jbase" +"29","ecpg" +"29","phfetchoptions" +"29","intake" +"29","github-actions-reusable-workflows" +"29","tera" +"29","processmodel" +"29","jchartfx" +"29","xstream-js" +"29","clpb" +"29","gitbucket" +"29","deep-dream" +"29","teachable-machine" +"29","base58" +"29","floating-labels" +"29","client-hints" +"29","x-tag" +"29","deepar" +"29","wicket-8" +"29","mvvm-foundation" +"29","wide-column-store" +"29","xsom" +"29","ffplay" +"29","annox" +"29","claude" +"29","ssms-addin" +"29","loadui" +"29","jboss-messaging" +"29","photo-picker" +"29","babelfish" +"29","jboss-forge" +"29","vssettings" +"29","ssrf" +"29","clipped" +"29","react-responsive-carousel" +"29","smacss" +"29","phpeclipse" +"29","groupon" +"29","giter8" +"29","ssrs-subscription" +"29","apache-ace" +"29","blaze-html" +"29","swish" +"29","pace" +"29","rush" +"29","apache-spark-sql-repartition" +"29","bi-tool" +"29","frequency-domain" +"29","blackberry-maps" +"29","bitmex" +"29","vsdbcmd" +"29","bitly" +"29","bitcoinlib" +"29","discoverability" +"29","voxels" +"29","manifoldcf" +"29","xml.modify" +"29","front-end-optimization" +"29","rxjs-subscriptions" +"29","sockaddr-in" +"29","vobject" +"29","apigee127" +"29","mariadb-10.2" +"29","binary-indexed-tree" +"29","laratrust" +"29","s5" +"29","implementation-defined-behavior" +"29","implication" +"29","sablecc" +"29","xetex" +"29","function-constructor" +"29","python-netifaces" +"29","safenet" +"29","unichar" +"29","xpointer" +"29","functions-framework" +"29","select-insert" +"29","include-once" +"29","python-decouple" +"29","xdp-pdf" +"29","uivideoeditorcontroller" +"29","smartedit" +"29","smartercsv" +"29","category-abstractions" +"29","ngrx-component-store" +"29","jsonpath-ng" +"29","chinese-remainder-theorem" +"29","castcompanionlibrary" +"29","pkpass" +"29","datetimeformatinfo" +"29","circleimage" +"29","fire-sharp" +"29","piwiktracker" +"29","cegui" +"29","fiware-sth-comet" +"29","fixer.io" +"29","flartoolkit" +"29","jstatd" +"29","ng2-datepicker" +"29","flascc" +"29","flatfilesource" +"29","fileupdate" +"29","smtps" +"29","chatfuel" +"29","datechooser" +"29","p-lang" +"29","aioredis" +"29","will-change" +"29","gradle-wrapper" +"29","ora-12170" +"29","windows-live-messenger" +"29","jpedal" +"29","r-mosaic" +"29","mfrc522" +"29","pssh" +"29","robotc" +"29","django-model-utils" +"29","shared-state" +"29","route-parameters" +"29","databricks-dbx" +"29","ruby-3.1" +"29","angular-json" +"29","metatype" +"29","rs256" +"29","crouton-os" +"29","ibm-ilog-opl" +"29","critical-css" +"29","avsc" +"29","jgss" +"29","serenity" +"29","jpegoptim" +"29","sinaweibo" +"29","graph-api-explorer" +"29","jmxtrans" +"29","robotics-studio" +"29","servercontrol" +"29","unsafe-perform-io" +"29","rtaudio" +"29","waitone" +"29","windows-server-2003-r2" +"29","sinopia" +"29","sequel-gem" +"29","microsoft-dynamics-webapi" +"29","pthread-exit" +"29","farpoint-spread" +"29","documentum-dfs" +"29","purify" +"29","jpamodelgen" +"29","vanity" +"29","cal-heatmap" +"29","rebus-azureservicebus" +"29","method-interception" +"29","wagtail-apiv2" +"29","winbgi" +"29","ora-00900" +"29","ruby-paranoia" +"29","angular-tour-of-heroes" +"29","sharepoint-branding" +"29","ora-00905" +"29","upstream" +"29","mygeneration" +"29","dmi" +"29","sharepoint-deployment" +"29","do-catch" +"29","error-recovery" +"29","ttlauncherview" +"29","azure-application-settings" +"29","b-plus-tree" +"29","apptentive" +"29","azure-application-insights-profiler" +"29","android-vertical-seekbar" +"29","pootle" +"29","box-view-api" +"29","boost-uuid" +"29","input-type-range" +"29","gulp-nunjucks-render" +"29","surface-pro" +"29","e1071" +"29","nearprotocol-validator" +"29","openehr" +"29","apple-live-photos" +"29","nest-nested-object" +"29","modelr" +"29","mongodb-hadoop" +"29","dynamic-data-list" +"29","nsdragginginfo" +"29","paystack" +"29","bottomappbar" +"29","mongoid6" +"29","boost-compute" +"29","pcap4j" +"29","applitools" +"29","cosmosdbtrigger" +"29","dynamic-linq-core" +"29","wp-enqueue-scripts" +"29","simple.odata" +"29","aws-sdk-rust" +"29","module-augmentation" +"29","wso2-appm" +"29","jquery-tags-input" +"29","spring-environment" +"29","android-work-profile" +"29","mongodb-charts" +"29","sveltekit-adapter-node" +"29","grpcurl" +"29","onkeylistener" +"29","ttr" +"29","gui-toolkit" +"29","mod-evasive" +"29","nelmiocorsbundle" +"29","kdevelop4" +"29","nscolorpanel" +"29","jrails" +"29","epos" +"29","aramex" +"29","jqzoom" +"29","deployr" +"29","gogo-shell" +"29","syncservices" +"29","ubuntu-20.10" +"29","wnck" +"29","object-expected" +"29","ubuntu-8.04" +"29","lfe" +"29","pygad" +"29","lib.web.mvc" +"29","shadertoy" +"29","javaspaces" +"29","facebook-customer-chat" +"29","2d-3d-conversion" +"29","net-ftp" +"29","pykinect" +"29","visiblox" +"29","macfuse" +"29","othello" +"29","rhel9" +"29",".net-core-configuration" +"29","googleads-mobile-unity" +"29","sfcalendar" +"29","atomicboolean" +"29","javaplot" +"29","ugc" +"29","macromedia" +"29","amember" +"29","exprtk" +"29","t4-toolbox" +"29","macro-recorder" +"29","or-condition" +"29","virtex" +"29","pyicu" +"29","ming" +"29","asyncresttemplate" +"29","rdo" +"29","mitk" +"29","netapi32" +"29","winrun4j" +"29","br-automation-studio" +"29","microsoft-graph-security" +"29","reward-system" +"29","rawrepresentable" +"29","rinsim" +"29","formal-semantics" +"29","libraw" +"29","osmbonuspack" +"29","newsapi" +"29",".net-standard-1.5" +"29","r-inla" +"29","visual-studio-app-center-test" +"29","shopify-app-bridge" +"29","visual-studio-installer" +"29","signer" +"29","ova" +"29","vmmap" +"29","winverifytrust" +"29","python-2.3" +"29","setenvif" +"29","netflix-metaflow" +"29","forever-monitor" +"29","auth0-connection" +"29","bsondocument" +"29","amslidemenu" +"29","shoelace" +"29","woocommerce-checkout-fields" +"29","pypubsub" +"29","setitimer" +"29","knockout-3.2" +"29","issuu" +"29","openmediavault" +"29","development-process" +"29","sqlkorma" +"29","hobo" +"29","xcode11.1" +"29","tadotable" +"29","pnp-core-sdk" +"29","quicktype" +"29","nopcommerce-3.80" +"29","notificationservices" +"29","gaelyk" +"29","scatter-matrix" +"29","tactionmanager" +"29","reflog" +"29","c++builder-xe3" +"29","policy-injection" +"29","gcloud-compute" +"29","tac" +"29","nor" +"29","mobile-broadband-api" +"29","gwt-dev-mode" +"29","aspxcombobox" +"29","sqloledb" +"29","taskaffinity" +"29","dotdotdot" +"29","nonclient-area" +"29","azure-java-tools" +"29","c++builder-2009" +"29","nutch2" +"29","cache-dependency" +"29","moai" +"29","npyscreen" +"29","azure-pack" +"29","jackhenry-jxchange" +"29","npruntime" +"29","npm-cli" +"29","sqlcedatareader" +"29","gcc4.4" +"29","redwoodjs" +"29","regsub" +"29","xcode8-beta2" +"29","direct-composition" +"29","hipi" +"29","galsim" +"29","exchange-transport-agents" +"29","context-param" +"29","openxls" +"29","hip" +"29","rails-administrate" +"29","scopt" +"29","sqlapi++" +"29","excon" +"29","gundb" +"29","nsviewrepresentable" +"29","scope-resolution-operator" +"29","sqlalchemy-access" +"29","openmrs" +"29","openvg" +"29","springsource-dm-server" +"29","pointer-address" +"29","openmmlab" +"29","development-mode" +"29","j8583" +"29","activityresultcontracts" +"29","get-method" +"29","color-key" +"29","column-sum" +"29","ldap-client" +"29","commaide" +"29","laravel-helper" +"29","latent-semantic-analysis" +"29","lcid" +"29","genexus-gam" +"29","genstrings" +"29","event-processor-host" +"29","node-notifier" +"29","event-hooking" +"29","octobercms-widgets" +"29","mem-fun" +"29","eli5" +"29","qmetatype" +"29","stratio" +"29","euclidean-algorithm" +"29","loginstatus" +"29","qlcdnumber" +"29","perl-io" +"29","etetoolkit" +"29","ios11.3" +"29","perl5.8" +"29","ios13.2" +"29","lockdown" +"29","qgraphicswidget" +"29","qfileinfo" +"29","message-channel" +"29","stm32l152" +"29","stm32h743" +"29","spring2.x" +"29","httr2" +"29","resend.com" +"29","message-forwarding" +"29","elasticsearch-php" +"29","qcalendarwidget" +"29","elasticsearch.js" +"29","qaxobject" +"29","restier" +"29","nlog-configuration" +"29","requires-clause" +"29","elastic-appsearch" +"29","sp-msforeachtable" +"29","pywhois" +"29","tetgen" +"29","spf13vim" +"29","propositional-calculus" +"29","activerecord-relation" +"29","protobuf-net.grpc" +"29","angular-foundation" +"29","ip2location" +"29","motorengine" +"29","text-compression" +"29","ctabctrl" +"29","hygieia" +"29","actian" +"29","motodev-studio" +"29","cfeclipse" +"29","duplicity-backup" +"29","spinbox" +"29","toolbars" +"29","angular-component-life-cycle" +"29","spiceworks" +"29","isapi-extension" +"29","cts-search" +"29","angular-auxiliary-routes" +"29","ironpython-studio" +"29","tonic" +"29","trackback" +"29","pg-dumpall" +"29","linkedmdb" +"29","tracking-pixel" +"29","compgen" +"29","batch-request" +"29","parboiled" +"29","betareg" +"29","weatherdata" +"29","beatbox" +"29","parsehub" +"29","zero-extension" +"29","parse-ios-sdk" +"29","userstyles" +"29","gnu-global" +"29","sharpshell" +"29","focus-engine" +"29","batarang" +"29","endeca-workbench" +"29","stitch" +"29","partial-methods" +"29","web-manifest" +"29","git-mirror" +"29","transactiontoolargeexception" +"29","idbconnection" +"29","beeswarm" +"29","stimulus-reflex" +"29","iisreset" +"29","flutter-renderflex-error" +"29","uv4l" +"29","starburst" +"29","start-page" +"29","iis-modules" +"29","fogbugz-api" +"29","emotion-js" +"29","zend-file" +"29","usd" +"29","paper-dialog" +"29","beginthreadex" +"29","embarrassingly-parallel" +"29","bcryptjs" +"29","qt-events" +"29","tiles-game" +"29","multi-catch" +"29","cyclone" +"29","qt-connection" +"29","google-openidconnect" +"29","array-reverse" +"29","dart-test" +"29","google-music" +"29","ilm" +"29","cwp" +"29","cygpath" +"29","mraid" +"29","google-toolbox-for-mac" +"29","cutycapt" +"29","space-leak" +"29","thumbor" +"29","maven-lifecycle" +"29","msxml3" +"29","google-healthcare-api" +"29","spacevim" +"29","quantopian" +"29","three-way-merge" +"29","msdropdown" +"29","powershell-studio" +"28","flexlm" +"28","ansible-lint" +"28","location-based" +"28","multi-targeting" +"28","reliable-message-delivery" +"28","github-codeowners" +"28","primesense" +"28","clappr" +"28","telepresence" +"28","prism-2" +"28","primefaces-gmap" +"28","slack-bot" +"28","skydns" +"28","y2k" +"28","reparsepoint" +"28","multi-model-forms" +"28","jep" +"28","federated-storage-engine" +"28","intel-composer" +"28","sqsh" +"28","wijmo5" +"28","debugpy" +"28","ff4j" +"28","eclipse-gemini" +"28","jbehave-plugin" +"28","defaultmutabletreenode" +"28","ghostscriptsharp" +"28","photobucket" +"28","cleave" +"28","stack-machine" +"28","deepspeed" +"28","ballerina-http" +"28","gimple" +"28","matrixcursor" +"28","sse3" +"28","vue-jest" +"28","transient-failure" +"28","figma-plugin" +"28","websockify" +"28","cmac" +"28","apache-aurora" +"28","yocto-kirkstone" +"28","ghcup" +"28","stack-allocation" +"28","weld2" +"28","php-pdftk" +"28","yii2-module" +"28","git-http-backend" +"28","mat-list" +"28","installshield-2013" +"28","react-native-picker" +"28","decoration" +"28","phpcrawl" +"28","web-sys" +"28","jenkins-jira-trigger" +"28","cncontactpicker" +"28","stack-dump" +"28","python-bybit" +"28","python-bob" +"28","pkcs#10" +"28","catransformlayer" +"28","vmware-sdk" +"28","piexif" +"28","jsonpointer" +"28","xeround" +"28","marathontesting" +"28","dbfunctions" +"28","smt-lib" +"28","pandas-rolling" +"28","label-studio" +"28","lambda-metafactory" +"28","implicit-parameters" +"28","symfony-voter" +"28","softaculous" +"28","nginx-unit" +"28","safe-navigation-operator" +"28","imodelbinder" +"28","language-history" +"28","iml" +"28","cdktf" +"28","pandas-settingwithcopy-warning" +"28","findancestor" +"28","pine-editor" +"28","pagerjs" +"28","pagerequestmanager" +"28","firebird-4.0" +"28","bits-service" +"28","selecteditemchanged" +"28","selenium-docker" +"28","nextjs-api-router" +"28","biomod2" +"28","apollo-boost" +"28","bindata" +"28","adobe-embed-api" +"28","cartocss" +"28","disk.frame" +"28","vscode-git" +"28","pythonqt" +"28","fuzz-testing" +"28","rust-result" +"28","pkgcloud" +"28","picturegallery" +"28","sxssf" +"28","vram" +"28","python-markdown" +"28","function-points" +"28","case-conversion" +"28","jsr354" +"28","frm" +"28","catalyst-optimizer" +"28","rust-decl-macros" +"28","jsr82" +"28","plaidml" +"28","markerspiderfier" +"28","chgrp" +"28","vpath" +"28","docklayoutpanel" +"28","universal-link" +"28","window.closed" +"28","angularjs-ng-switch" +"28","angularjs-ng-template" +"28","grails-3.0.9" +"28","doctrine-dbal" +"28","wallpapermanager" +"28","docker-watchtower" +"28","named-instance" +"28","crfsuite" +"28","credit-card-track-data" +"28","rspec-sidekiq" +"28","angular-seo" +"28","nape" +"28","django-upgrade" +"28","ora-01400" +"28","create-ref" +"28","ora-12514" +"28","createparams" +"28","iap-hosted-content" +"28","jpa-annotations" +"28","ora-00937" +"28","callermembername" +"28","canvaskit" +"28","avcapturephotooutput" +"28","pybossa" +"28","iceweasel" +"28","jigoshop" +"28","recordstore" +"28","carbon-copy" +"28","crow" +"28","crostini" +"28","documentum-dfc" +"28","wildfly-16" +"28","vapi" +"28","datagridrowheader" +"28","rebex" +"28","canjs-view" +"28","myrrix" +"28","pscl" +"28","rtvs" +"28","facebook-recommendations" +"28","unroll" +"28","google-vault-api" +"28","pspice" +"28","room" +"28","jmail" +"28","sesam" +"28","unusernotification" +"28","serial-processing" +"28","document-layout-analysis" +"28","polymorphic-functions" +"28","opencore" +"28","tweener" +"28","sign-in-with-google" +"28","easyrdf" +"28","kafka-node" +"28","bottlenose" +"28","bootstrap-lightbox" +"28","information-visualization" +"28","pbiviz" +"28","boost-beast-websocket" +"28","openafs" +"28","tx-mask" +"28","countable" +"28","ionic-cloud" +"28","molehill" +"28","mongomock" +"28","nrefactory" +"28","boolean-indexing" +"28","grunt-contrib-qunit" +"28","sutime" +"28","writer-monad" +"28","wpengine" +"28","mongodate" +"28","in-memory-data-grid" +"28","svn-client" +"28","spring-ai" +"28","needle.js" +"28","twitter-r" +"28","nsassert" +"28","tying-the-knot" +"28","wtx" +"28","wvd" +"28","twgl.js" +"28","angelscript" +"28","worklight-mtww" +"28","jquery-1.6" +"28","sweeper" +"28","application-variables" +"28","e-notices" +"28","navcontroller" +"28","nearlyfreespeech" +"28","html.textbox" +"28","app-store-connect-api" +"28","boxsdk" +"28","twitter-widget" +"28","libpurple" +"28","visual-c++-2008-express" +"28","konacha" +"28","android-api-30" +"28","shrinkresources" +"28","type-equivalence" +"28","oracle-type" +"28","liblas" +"28","macrobenchmark" +"28","dojox.gfx" +"28","libsigc++" +"28","visualhg" +"28","ezapi" +"28","oauth-ruby" +"28","outputformat" +"28","goertzel-algorithm" +"28","minicart" +"28","system.io.pipelines" +"28","macbookpro" +"28","outgoing-mail" +"28","riverplot" +"28","jarbundler" +"28","rfduino" +"28","amp-mustache" +"28","coderush-xpress" +"28","java-gstreamer" +"28","leftalign" +"28","shady-dom" +"28",".net-1.0" +"28","signalr-client" +"28","jaudiotagger" +"28","amp-form" +"28","attributedstring" +"28","viewflow" +"28","orsserialport" +"28","frameworkelementfactory" +"28","system-setting" +"28","typescript-conditional-types" +"28","raknet" +"28","rcppeigen" +"28","extraction-operator" +"28","klout" +"28","pyramid-arima" +"28","codevisionavr" +"28","jarjar" +"28","express-vhost" +"28","revit-2015" +"28","amiga" +"28","jamvm" +"28","b2g" +"28","iweb" +"28","schema.yml" +"28","drupal-fivestar" +"28","token-exchange" +"28","nsurlcomponents" +"28","tkinter-scrolledtext" +"28","scan-build" +"28","exchange-basicauth" +"28","dscl" +"28","nptl" +"28","ixmldomdocument" +"28","uipath-api" +"28","expired-cookies" +"28","explicit-implementation" +"28","experience-manager" +"28","bzip" +"28","isnan" +"28","nui" +"28","scoped" +"28","expo-build" +"28","cairo-lang" +"28","np.argsort" +"28","referenceproperty" +"28","scoped-lock" +"28","azure-rtos" +"28","itween" +"28","sceditor" +"28","plc4x" +"28","gwt-material-design" +"28","coq-extraction" +"28","taffy" +"28","gendarme" +"28","polymer-1.x" +"28","opera-dragonfly" +"28","gwt-hosted-mode" +"28","controlcollection" +"28","gwt-2.7" +"28","openvx" +"28","tab-size" +"28","point-sprites" +"28","xcglogger" +"28","dotnetinstaller" +"28","podsecuritypolicy" +"28","opengis" +"28","asp.net-core-cli" +"28","mls" +"28","r2rml" +"28","android-credential-manager" +"28","hackintosh" +"28","radupload" +"28","qwizardpage" +"28","raid" +"28","openjpa-maven-plugin" +"28","hamiltonian-path" +"28","drawingcache" +"28","rails-flash" +"28","pm2-logrotate" +"28","diff3" +"28","cfreadstream" +"28","resharper-sdk" +"28","evaluatejavascript" +"28","qpointer" +"28","https-proxy-agent" +"28","pffacebookutils" +"28","morph-x" +"28","omake" +"28","http-status-code-412" +"28","mosel" +"28","laravel-http-client" +"28","spid" +"28","laravel-livewire-wiremodel" +"28","chai-enzyme" +"28","mousemotionevent" +"28","protocol-relative" +"28","metalanguage" +"28","hubspot-cms" +"28","android-notification.mediastyle" +"28","project-setup" +"28","angularjs-fileupload" +"28","angular-cli-ghpages" +"28","action-menu" +"28","dukescript" +"28","duplicate-content" +"28","textspan" +"28","text-services-framework" +"28","ipcs" +"28","nimbus-ios" +"28","tomcat7-maven-plugin" +"28","custom-compare" +"28","eintr" +"28","columnmappings" +"28","io-socket" +"28","test-and-set" +"28","google-cloud-deploy" +"28","terraform-remote-state" +"28","leak-sanitizer" +"28","performance-measuring" +"28","zuora" +"28","google-cloud-tools" +"28","google-fitness-api" +"28","logdna" +"28","react-bootstrap-nav" +"28","ellipsize" +"28","node-horseman" +"28","persistent-memory" +"28","lookml" +"28","lowcode" +"28","query-timeout" +"28","arrangeoverride" +"28","gmcs" +"28","struts2-spring-plugin" +"28","d3fc" +"28","tidyverts" +"28","google-local-search" +"28","sublimecodeintel" +"28","searchable-plugin" +"28","avatars" +"28","bignumber.js" +"28","emboss" +"28","qtwebchannel" +"28","endorsed" +"28","google-surveys" +"28","linq-to-xsd" +"28","eme" +"28","vaadin12" +"28","throbber" +"28","limit-choices-to" +"28","qtremoteobjects" +"28","maven-extension" +"28","seckeyref" +"28","ihaskell" +"28","billingclient" +"28","flutter-responsive-layout" +"28","sonicmq" +"28","benchmark.js" +"28","amazon-mobile-analytics" +"28","zipapp" +"28","webcola" +"28","totalview" +"28","soti" +"28","web-clips" +"28","threebox" +"28","webhttp" +"28","liferay-7.4" +"28","scripting.dictionary" +"28","solandra" +"28","tracemalloc" +"28","url-helper" +"28","zeplin" +"28","heapalloc" +"28","auto-sklearn" +"28","bgfx" +"28","tilestache" +"28","trailing-whitespace" +"28","alt.js" +"28","suitecloud" +"28","imagelibrary" +"28","header-bidding" +"28","webkit-perspective" +"28","quarkus-hibernate-reactive" +"28","tfs-security" +"28","mdtool" +"28","parchment" +"28","sharpbox" +"28","git-send-email" +"28","userappdatapath" +"28","illuminate" +"28","flutter-hotreload" +"28","conditional-variable" +"27","skus" +"27","yardstick" +"27","insight" +"27","jbossmq" +"27","debuggerdisplay" +"27","sitemap-generator-gem" +"27","reactotron" +"27","git-cvs" +"27","dda" +"27","smallcaps" +"27","editline" +"27","gist-index" +"27","vue-slot" +"27","fetchmail" +"27","cliptobounds" +"27","graphql-spqr-spring-boot-starter" +"27","jfif" +"27","yasson" +"27","jbig2" +"27","yandex-tank" +"27","masonite" +"27","slab" +"27","clojure-core.typed" +"27","ggsurvfit" +"27","clist" +"27","php-closures" +"27","loadbalancer" +"27","reparenting" +"27","cloveretl" +"27","groovydsl" +"27","webservicehost" +"27","whirlpool" +"27","edamam-api" +"27","pgraphics" +"27","terminal-color" +"27","dbt-cloud" +"27","list-unsubscribe" +"27","eclipse-fp" +"27","litecoin" +"27","intents-extension" +"27","bankers-algorithm" +"27","remoteexception" +"27","remote-file-inclusion" +"27","greendao3" +"27","git-history-rewrite" +"27","php-resque" +"27","tell-dont-ask" +"27","ebtables" +"27","list-definition" +"27","grouped-list" +"27","phplint" +"27","greenlock" +"27","truevault" +"27","xsl-choose" +"27","mat-slider" +"27","webwork" +"27","xsl-stylesheet" +"27","repeatbutton" +"27","yagni" +"27","printer-properties" +"27","bar3d" +"27","jseparator" +"27","laravel-dusk2" +"27","appengine-maven-plugin" +"27","constant-time" +"27","ui-toolkit" +"27","afjsonrequestoperation" +"27","vs-code-settings" +"27","content-experiments" +"27","connected-services" +"27","packages.config" +"27","umbraco4" +"27","finite-group-theory" +"27","birt-deapi" +"27","plan-9" +"27","sygic" +"27","directory-walk" +"27","pageloadstrategy" +"27","unbounce" +"27","nextjs-storybook" +"27","carekit" +"27","aplpy" +"27","jsunit" +"27","flash-list" +"27","adobe-media-server" +"27","directory-server" +"27","content-query-web-part" +"27","swing-highlighter" +"27","runscope" +"27","pythoncard" +"27","python-bigquery" +"27","json-table" +"27","s3-lifecycle-policy" +"27","smart-device-framework" +"27","cbitmap" +"27","django-constraints" +"27","datalife-engine" +"27","adsutil.vbs" +"27","datatip" +"27","datalistitem" +"27","impressionist" +"27","maintainscrollpositionon" +"27","social-graph" +"27","app42" +"27","pixel-shading" +"27","langgraph" +"27","xml-1.1" +"27","cctray" +"27","social-auth-app-django" +"27","contentdialog" +"27","sage-line-50" +"27","mapstraction" +"27","sage-crm" +"27","ngx-spinner" +"27","data-interchange" +"27","kendo-sortable" +"27","serverless-webpack-plugin" +"27","rt.jar" +"27","document-set" +"27","server-application" +"27","cardio" +"27","pushstreamcontent" +"27","alamofire5" +"27","calligraphy" +"27","mysql-error-1068" +"27","update-by-query" +"27","animatorset" +"27","djnativeswing" +"27","update-attribute" +"27","go-toolchain" +"27","jinja2-cli" +"27","aws-appsync-ios" +"27","windows-phone-voip" +"27","vectorstore" +"27","windows-phone-silverlight" +"27","pubdate" +"27","angular-language-service" +"27","fat-binaries" +"27","rtsp-server" +"27","simpletype" +"27","dojo-dnd" +"27","grails-filters" +"27","rowmapper" +"27","ibm-data-replication" +"27","facial-landmark-alignment" +"27","django-excel" +"27","unminify" +"27","cross-process" +"27","water-jug-problem" +"27","ibm-graph" +"27","data.tree" +"27","rngcryptoserviceprovider" +"27","watir-classic" +"27","universal-hashing" +"27","credssp" +"27","cancelanimationframe" +"27","win32con" +"27","wildfly-15" +"27","ibm-streams" +"27","session-set-save-handler" +"27","django-graphql-jwt" +"27","named-captures" +"27","kind-projector" +"27","database-caching" +"27","http4k" +"27","word-size" +"27","growlnotify" +"27","app-transfer" +"27","postgres-crosstab" +"27","android-wheel" +"27","azure-cosmosdb-cassandra-api" +"27","twitter-hbc" +"27","mongoose-middleware" +"27","iodbc" +"27","delphi-4" +"27","swiftbond" +"27","delphi-2005" +"27","wsat" +"27","tungsten-replicator" +"27","htmldoc" +"27","apriltags" +"27","swift-class" +"27","ion-menu" +"27","postasync" +"27","postgresql-bdr" +"27","svnlook" +"27","nsrect" +"27","appsmith" +"27","bluetooth-sco" +"27","on-location-changed" +"27","nspersistentcontainer" +"27","deftype" +"27","wunderlist" +"27","ionic-plugins" +"27","swift-custom-framework" +"27","intero" +"27","poset" +"27","turbopower" +"27","wtsapi32" +"27","boost-intrusive" +"27","spring-cloud-config-client" +"27","tx-indexed-search" +"27","supplementary" +"27","jupyter-extensions" +"27","spring-js" +"27","navigationwindow" +"27","inext" +"27","designview" +"27","mojo-useragent" +"27","wsgiserver" +"27","httpapi" +"27","modulefile" +"27","earley-parser" +"27","natty" +"27","pattern-guards" +"27","dependent-destroy" +"27","deluge" +"27","samsung-gear" +"27","spring-boot-starter-oauth2-client" +"27","application.xml" +"27","modx-chunks" +"27","boonex-dolphin" +"27","keda-scaledjob" +"27","deploymentitem" +"27","blog-engine" +"27","pound" +"27","kaleido" +"27","jquery-upload-file-plugin" +"27","applicationwindow" +"27","bounds-checker" +"27","saturation-arithmetic" +"27","earthdistance" +"27","nscountedset" +"27","jquery-rails" +"27","jwebunit" +"27","negative-zero" +"27","infoblox" +"27","gtkwave" +"27","ringojs" +"27","sysbench" +"27","virtual-tour" +"27","winit" +"27","javafx-1" +"27","video-reactjs" +"27","random-data" +"27","setalarmclock" +"27","lvgl" +"27","atlassian-connect" +"27","network-load-balancer" +"27","visual-studio-code-server" +"27","asymptote" +"27","codepro" +"27","god-object" +"27","rars-simulator" +"27",".net-sdk" +"27","extension-modules" +"27","oauth2resttemplate" +"27","netflix-archaius" +"27","revoscaler" +"27","wiremock-record" +"27","luvit" +"27","javolution" +"27","async-components" +"27","pyq" +"27","libnodave" +"27","rcrawler" +"27","java-18" +"27","minko" +"27","build-environment" +"27","dolphin-browser" +"27","dolby" +"27","browser-close" +"27","system-restore" +"27","aasa" +"27","libmodbus" +"27","audiojs" +"27","fourier-descriptors" +"27","atlcom" +"27","pylearn" +"27","java-native-library" +"27","extconf.rb" +"27","accept.js" +"27","code-statistics" +"27","outlook-form" +"27","build-pipeline-plugin" +"27","sfdatagrid" +"27","build-process-template" +"27","google-admin-audit-api" +"27","magento-rules" +"27","wkinterfaceimage" +"27","javascript-inheritance" +"27","asp.net-core-logging" +"27","jackson-dataformat-avro" +"27","toeplitz" +"27","redux-router" +"27","radlistbox" +"27","gdm" +"27","tablesort" +"27","redux-offline" +"27","gears" +"27","nth-element" +"27","regexbuddy" +"27","exponentjs" +"27","gcc12" +"27","cache-locality" +"27","sqldmo" +"27","uikeyinput" +"27","dpkg-buildpackage" +"27","assertthat" +"27","tls-psk" +"27","copy-data" +"27","hapi.js-lab" +"27","azure-management-groups" +"27","drupal-permissions" +"27","iusertype" +"27","geiser" +"27","exploratory" +"27","npm-pack" +"27","xcode6-beta5" +"27","xcode6.3.1" +"27","time-select" +"27","c++-experimental" +"27","gamesparks" +"27","nonsequential" +"27","uioutput" +"27","vertex-cover" +"27","android-fragment-manager" +"27","drools-kie-workbench" +"27","opengl-extensions" +"27","mixed-programming" +"27","itemtemplateselector" +"27","mobile-robot-toolkit" +"27","scaleanimation" +"27","tailscale" +"27","cordic" +"27","nunit-2.5.9" +"27","bypass" +"27","dictionary-attack" +"27","dse" +"27","titanium-web-proxy" +"27","scene7" +"27","sql-navigator" +"27","nomachine" +"27","redis-stack-server" +"27","vestal-versions" +"27","askbot" +"27","highline" +"27","modal-popup" +"27","mockup-tool" +"27","scep" +"27","ompr" +"27","angularjs-limitto" +"27","more-itertools" +"27","lsyncd" +"27","eventsetter" +"27","cgimagesource" +"27","iphone-keypad" +"27","angular17-ssr" +"27","olsmultiplelinearregression" +"27","event-flow" +"27","react.rb" +"27","coledatetime" +"27","cupertinotabbar" +"27","qrect" +"27","ip-blocking" +"27","iowait" +"27","react-daterange-picker" +"27","react-flexbox-grid" +"27","nist" +"27","changetype" +"27","property-graph" +"27","pythran" +"27","q-municate" +"27","customproperty" +"27","testdroid" +"27","pywinusb" +"27","office-web-components" +"27","memoise" +"27","project-explorer" +"27","qa-c" +"27","odatacontroller" +"27","test.check" +"27","react-fragment" +"27","long-lines" +"27","logtalk" +"27","google-cloud-pubsublite" +"27","nntool" +"27","google-cloud-talent-solution" +"27","large-file-support" +"27","off-heap" +"27","nocount" +"27","androidpublisher" +"27","react-key-index" +"27","color-channel" +"27","meraki-api" +"27","mercadopagosdk" +"27","android-koin" +"27","performbatchupdates" +"27","pelops" +"27","petgraph" +"27","activity-result-api" +"27","humanizer" +"27","stream-operators" +"27","requests-mock" +"27","elasticlayout" +"27","resolv" +"27","percy" +"27","requires-expression" +"27","responsecache" +"27","resource-timing-api" +"27","spray-test" +"27","electron-react" +"27","stellargraph" +"27","embedded-flashplayer" +"27","bifunctor" +"27","powershell-6.0" +"27","powershell-7" +"27","user-warning" +"27","component-services" +"27","billiards" +"27","parsedown" +"27","stealjs" +"27","queue.js" +"27","quake" +"27","paserver" +"27","zipf" +"27","subobject" +"27","cygwin-64" +"27","parsimonious" +"27","arcamera" +"27","prado" +"27","avassetdownloadtask" +"27","qubit" +"27","seaweedfs" +"27","qsqlrelationaltablemodel" +"27","compilationunit" +"27","sublimemerge" +"27","sectionindexer" +"27","compc" +"27","auto-compile" +"27","sonarqube5.1.2" +"27","ember-bootstrap" +"27","maxby" +"27","urlrewriting.net" +"27","google-logging" +"27","queryselectall" +"27","struts2-tiles-plugin" +"27","tikv" +"27","stl-decomposition" +"27","emitmapper" +"27","alphabetic" +"27","custom-selectors" +"27","linq-to-sharepoint" +"27","sdl-net" +"27","thephpleague-fractal" +"27","tfhpple" +"27","mdp" +"27","beginread" +"27","gmail-promo-tab" +"27","lingpipe" +"27","sourcekit" +"27","bazel-rules-nodejs" +"27","multi-friend-selector" +"27","webhid" +"27","structured-programming" +"27","preforking" +"27","space-filling-curve" +"27","top-level-await" +"27","maven-clean-plugin" +"27","scully" +"27","gnome-keyring-daemon" +"27","spark-redis" +"27","encrypting-file-system" +"27","embind" +"27","qtranslator" +"27","qtime" +"27","scrypto" +"27","autoformat" +"27","identity-map" +"27","endpointbehavior" +"27","toolkitscriptmanager" +"27","custom-ui" +"26","debugbreak" +"26","flowise" +"26","gremlinjs" +"26","remote-management" +"26","interactivepopgesture" +"26","deeppavlov" +"26","dcu" +"26","ansible-handlers" +"26","wideimage" +"26","cloud-automation-manager" +"26","insight.database" +"26","litmus" +"26","react-native-google-mobile-ads" +"26","phpfog" +"26","massivejs" +"26","phpdbg" +"26","mathematical-typesetting" +"26","defaultview" +"26","dcraw" +"26","fluent-docker" +"26","travelport-api" +"26","matchedgeometryeffect" +"26","xwalkview" +"26","class-factory" +"26","ansible-api" +"26","php-mysqlidb" +"26","jbullet" +"26","jd-gui" +"26","princomp" +"26","skopt" +"26","edge-side-includes" +"26","local-security-authority" +"26","ssdt-2019" +"26","gghighlight" +"26","maturin" +"26","prime-ui" +"26","webproject" +"26","fhs" +"26","graphql-federation" +"26","ssconvert" +"26","fgarch" +"26","photosui" +"26","ffmpeg-wasm" +"26","base-sdk" +"26","ecos" +"26","photo-tagging" +"26","flutter-datetime-picker" +"26","react-select-search" +"26","yii2-urlmanager" +"26","xspec" +"26","anti-piracy" +"26","tstream" +"26","rendertron" +"26","intellij-datagrip" +"26","ggmosaic" +"26","cm-synergy" +"26","dbtype" +"26","feathers-service" +"26","grooveshark" +"26","backdrop" +"26","xscale" +"26","gff" +"26","flutter-channel" +"26","vstest.console" +"26","groovy-sql" +"26","flutter-change-notifier-provider" +"26","staledataexception" +"26","barryvdh" +"26","instagram-reels" +"26","vue2-dropzone" +"26","sitetemplate" +"26","python-dragonfly" +"26","laravel-backup" +"26","fillfactor" +"26","freezegun" +"26","datatable-buttons" +"26","swiftui-windowgroup" +"26","container-data-type" +"26","checkov" +"26","fuslogvw" +"26","datetime-generation" +"26","kubernetes-metrics" +"26","xforms-betterform" +"26","chirpy" +"26","dispatchsemaphore" +"26","swiftui-sharelink" +"26","jsonreststore" +"26","laravel-exceptions" +"26","jsdelivr" +"26","in-call" +"26","bindinghandlers" +"26","kxml2" +"26","xname" +"26","displayattribute" +"26","owasp-dependency-check" +"26","blackberry-dynamics" +"26","symfonyux" +"26","bizdays" +"26","content-expiration" +"26","flapdoodle-embed-mongo" +"26","fivetran" +"26","childcontrol" +"26","pythonnet" +"26","pythonplotter" +"26","pitr" +"26","xml-conduit" +"26","appendfile" +"26","unicode-range" +"26","maplist" +"26","adbwireless" +"26","phpundercontrol" +"26","segment-analytics" +"26","ng-required" +"26","uitextposition" +"26","ng2-nvd3" +"26","dbcp" +"26","vodapay-miniprogram" +"26","appcontainer" +"26","safecracker" +"26","s390x" +"26","s2" +"26","afhttpsessionmanager" +"26","cef4delphi" +"26","filesavepicker" +"26","soft-input-panel" +"26","filepattern" +"26","markdownsharp" +"26","ryujit" +"26","sails-skipper" +"26","software-product-lines" +"26","sails-orientdb" +"26","rusoto" +"26","runat" +"26","cascalog" +"26","fbflipper" +"26","css-expressions" +"26","pushover" +"26","gpu.js" +"26","r-server" +"26","ups-api" +"26","vcd" +"26","vax" +"26","push-diffusion" +"26","fast-app-switching" +"26","roauth" +"26","rowstate" +"26","pull-queue" +"26","roomdb" +"26","mysql-error-1066" +"26","aiosmtpd" +"26","simple-realtime-server" +"26","dmx-ssas" +"26","sharepoint-timer-job" +"26","wcat" +"26","goreleaser" +"26","meteor-galaxy" +"26","router-os" +"26","hyperledger-besu" +"26","vbide" +"26","publickeytoken" +"26","fastutil" +"26","sessionend" +"26","route-model-binding" +"26","ptxas" +"26","unwind" +"26","database-installation" +"26","go-structtag" +"26","micronaut-kafka" +"26","django-wkhtmltopdf" +"26","django-voting" +"26","avplayerview" +"26","unmarked-package" +"26","ichat" +"26","famous-engine" +"26","reactxp" +"26","iconic" +"26","mglmapview" +"26","servicem8" +"26","metroframework" +"26","algorithm-animation" +"26","ibm-case-manager" +"26","vvv-wordpress" +"26","service-factory" +"26","icq" +"26","site-column" +"26","crtdbg.h" +"26","windows-sandbox" +"26","databricks-asset-bundle" +"26","unity3d-mecanim" +"26","record-locking" +"26","icu4c" +"26","database-tuning-advisor" +"26","doit" +"26","mysql-udf" +"26","recommenderlab" +"26","data-aware" +"26","servlet-2.5" +"26","wab" +"26","mybatis-sql" +"26","rebus-rabbitmq" +"26","idataobject" +"26","animatedcontainer" +"26","aws-cloudshell" +"26","fantasyland" +"26","rocks" +"26","windows-10-iot-enterprise" +"26","pdfmerger" +"26","svn-administraton" +"26","axd" +"26","cptbarplot" +"26","ioremap" +"26","cqengine" +"26","nestjs-i18n" +"26","pdblp" +"26","cpropertysheet" +"26","simplebutton" +"26","svgo" +"26","ent" +"26","posterous" +"26","springdoc-ui" +"26","invalid-url" +"26","modified-date" +"26","nested-includes" +"26","defold" +"26","mongo-dart" +"26","android-studio-3.1.4" +"26","svg-transforms" +"26","grpc-js" +"26","entity-linking" +"26","cperl-mode" +"26","workflow-definition-language" +"26","oneplusthree" +"26","arangodb-php" +"26","jquery-webcam-plugin" +"26","blend-mode" +"26","jquery-week-calendar" +"26","entity-system" +"26","bleno" +"26","kaizala" +"26","gulp-autoprefixer" +"26","grunt-babel" +"26","ongr" +"26","horizontalfieldmanager" +"26","horizontallistview" +"26","neo4j-aura" +"26","svncommit" +"26","android-trafficstats" +"26","polyvariadic" +"26","spring-insight" +"26","openai-assistants-api" +"26","apple-m2" +"26","nsproxy" +"26","count-unique" +"26","appium-inspector" +"26","error-messages-for" +"26","tvm" +"26","nsolid" +"26","nsimagerep" +"26","superfeedr" +"26","jquery-jscroll" +"26","jtwig" +"26","bootstrap-timepicker" +"26","inheriting-constructors" +"26","posthog" +"26","ponylang" +"26","patch-package" +"26","crawlera" +"26","create-guten-block" +"26","bosh-deployer" +"26","azure-devops-server-2022" +"26","delegating-constructor" +"26","html-tag-summary" +"26","patternsyntaxexception" +"26","rhino-servicebus" +"26","oauth2orize" +"26","viro-react" +"26","libselinux" +"26","rhino-security" +"26","overlayfs" +"26","os-detection" +"26","ordbms" +"26","sfdc-metadata-api" +"26","ucs" +"26","short-filenames" +"26","exrin" +"26","visio2013" +"26","rfb-protocol" +"26","oraoledb" +"26","sysdig" +"26","jasonette" +"26","virtualbox-guest-additions" +"26","new-psdrive" +"26","object-layout" +"26","visual-c++-runtime" +"26","setup-wizard" +"26","sidekiq-cron" +"26","rational-rose" +"26","system.messaging" +"26","ocpp" +"26","rapidsql" +"26","buildmaster" +"26","javax.json" +"26","ravendb5" +"26","typescript-utility" +"26","right-justified" +"26","broadband" +"26","r-formula" +"26","new-object" +"26","sysinfo" +"26","magic-mouse" +"26","magicknet" +"26","google-chrome-flags" +"26","minidumpwritedump" +"26","kosaraju-algorithm" +"26","lwuit-list" +"26","authenticity" +"26","for-xml-explicit" +"26","pymodm" +"26","aadhaar" +"26","amplify-auth-cognito" +"26","fortran-coarrays" +"26","atlassian-python-api" +"26","midori" +"26","amp-ad" +"26","missing-cookies" +"26","macwire" +"26","asus" +"26","cohen-kappa" +"26","3-way-merge" +"26","framemaker" +"26","atlantis" +"26","cocoa-scripting" +"26","coinpayments-api" +"26","magpie" +"26","targetnullvalue" +"26","screenrc" +"26","hangfire-autofac" +"26","xcode9beta6" +"26","convertfrom-json" +"26","scitools" +"26","ui-patterns" +"26","controlparameter" +"26","android-gradle-2.0" +"26","tavern" +"26","timex" +"26","non-virtual-interface" +"26","scncamera" +"26","tabletop-simulator" +"26","tcanvas" +"26","mock-location" +"26","excel-solver" +"26","xcode-previews" +"26","expandometaclass" +"26","tcp-port" +"26","timecop" +"26","asp.net-core-authenticationhandler" +"26","hibernate3-maven-plugin" +"26","polymer-designer-tool" +"26","node-vm2" +"26","taiga" +"26","haskeline" +"26","polkit" +"26","quickdraw" +"26","gem-fury" +"26","uibuilder" +"26","openturns" +"26","redux-orm" +"26","busy-cursor" +"26","cache2k" +"26","gce-persistent-disk" +"26","sqlboiler" +"26","rabbitmqadmin" +"26","r2d3" +"26","hadoop-2.7.2" +"26","ca2000" +"26","iso-8859-15" +"26","redirect-uri-mismatch" +"26","opentaps" +"26","gcmtaskservice" +"26","sql-server-2014-localdb" +"26","assemblyversionattribute" +"26","device-discovery" +"26","corda-flow" +"26","gang-of-four" +"26","copy-local" +"26","expression-blend-3" +"26","itsdangerous" +"26","hammer" +"26","diplib" +"26","rack-mini-profiler" +"26","copy-webpack-plugin" +"26","iteritems" +"26","itil" +"26","drawingml" +"26","python-xmlschema" +"26","s-plus" +"26","terraform-provider-github" +"26","google-cloud-shell-editor" +"26","hugsql" +"26","android-jacoco" +"26","google-dataplex" +"26","react-native-community" +"26","google-gauges" +"26","lockout" +"26","android-jetpack-compose-gesture" +"26","esky" +"26","eslint-plugin-react-hooks" +"26","logmein" +"26","strong-soap" +"26","collective-intelligence" +"26","esplorer" +"26","persistence-manager" +"26","nodejs-express-server" +"26","node-media-server" +"26","resolve-url-loader" +"26","merlin" +"26","georgian" +"26","resharper-10.0" +"26","react-aria" +"26","httpcontext.cache" +"26","streamlink" +"26","melonjs" +"26","httpplatformhandler" +"26","geotrellis" +"26","memory-pressure" +"26","od" +"26","spfield" +"26","angularjs-config" +"26","elasticsearch-mongo-river" +"26","mpi-rma" +"26","geoalchemy" +"26","getmodulefilename" +"26","change-detector-ref" +"26","accordionpane" +"26","getdibits" +"26","splitchunksplugin" +"26","monocross" +"26","columndefinition" +"26","mormot" +"26","mongrel-cluster" +"26","activity-state" +"26","laravel-modules" +"26","mousecapture" +"26","cfbundledisplayname" +"26","custom-datetimepicker" +"26","commercial-application" +"26","tomtom-android-sdk" +"26","durable-subscription" +"26","eglfs" +"26","spc" +"26","activityunittestcase" +"26","mosh" +"26","zend-controller-plugin" +"26","spark-redshift" +"26","hfs" +"26","berksfile" +"26","webidl" +"26","tfs-2005" +"26","toolstripstatuslabel" +"26","hbbtv" +"26","hbase-client" +"26","statmodels" +"26","alice" +"26","subcomponent" +"26","likely-unlikely" +"26","flutter-get" +"26","sonar-plugin" +"26","flutter-patrol" +"26","time4j" +"26","dart-server" +"26","mtrace" +"26","msmqintegrationbinding" +"26","qtbluetooth" +"26","iks" +"26","maven-scm-plugin" +"26","danfojs" +"26","styled-system" +"26","pannellum" +"26","web-ar" +"26","helpndoc" +"26","help-viewer" +"26","amazon-device-messaging" +"26","elvis-operator" +"26","cypress-file-upload" +"26","amazon-certificate-manager" +"26","confidentiality" +"26","scriptish" +"26","webaii" +"26","multi-instance-deployment" +"26","qsys" +"26","email-delivery" +"26","forestadmin" +"26","hdmi-cec" +"26","amazon-guardduty" +"26","mbcalendarkit" +"26","force-touch" +"26","webdriver-w3c-spec" +"26","ifc-open-shell" +"26","beaker-notebook" +"26","dart-ui" +"26","globalize2" +"26","all-delete-orphan" +"26","global-functions" +"26","ihtmldocument" +"26","email-processing" +"26","better-errors-gem" +"26","batch-choice" +"26","secondary-live-tile" +"26","link-time-optimization" +"26","zope3" +"26","v8js" +"26","amazon-gamelift" +"25","skimr" +"25","sliding-doors" +"25","fieldcollapsing" +"25","sliver-grid" +"25","jerkson" +"25","apache-camel-cdi" +"25","primeng-tree" +"25","clickhouse-go" +"25","trusted-sites" +"25","class-reference" +"25","edmgen" +"25","decouple" +"25","phonebook" +"25","preview-feature" +"25","xrc" +"25","remote-administration" +"25","squeezebox" +"25","balsamiq" +"25","primary-constructor" +"25","citrus-pay" +"25","private-class" +"25","jetty-10" +"25","stagexl" +"25","dcpu-16" +"25","editcap" +"25","wfs" +"25","yapf" +"25","client-side-data" +"25","greybox" +"25","temporaries" +"25","llvm-cov" +"25","loading-animation" +"25","vuesax" +"25","tensorflow-gradient" +"25","program-structure" +"25","git-crypt" +"25","flutter-custompaint" +"25","react-native-voice" +"25","web-widget" +"25","graph-sharp" +"25","widescreen" +"25","clojure.test" +"25","jetbrains-gateway" +"25","multi-release-jar" +"25","printform" +"25","ansible-runner" +"25","interchange" +"25","bitnami-kafka" +"25","python-pulsar" +"25","cassandra-lucene-index" +"25","bitstuffing" +"25","bitwise-not" +"25","owin-security" +"25","fit-framework" +"25","jsartoolkit" +"25","blastula" +"25","imageloader" +"25","mappers" +"25","syncano" +"25","jsduck" +"25","semisupervised-learning" +"25","symfony-cache" +"25","mark-and-sweep" +"25","chiseltest" +"25","cdonts" +"25","chromatic" +"25","adobe-sign" +"25","add-references-dialog" +"25","symmetric-difference" +"25","python-cloudant" +"25","voice-control" +"25","saddle" +"25","smartos" +"25","l20n" +"25","jsoneditor" +"25","chrome-ux-report" +"25","smartmatch" +"25","incr-tcl" +"25","chrome-webrequest" +"25","sentinel1" +"25","incremental-compiler" +"25","disp" +"25","rup" +"25","case-folding" +"25","play2-mini" +"25","flashcatalyst" +"25","paddle" +"25","pipedream" +"25","carto-mobile" +"25","adjustable" +"25","pagersnaphelper" +"25","find-sec-bugs" +"25","xendesktop" +"25","selenium-fitnesse-bridge" +"25","adts" +"25","snpe" +"25","mapkit-js" +"25","content-repository" +"25","dbgeng" +"25","configurationelement" +"25","recursiveiterator" +"25","gost3410" +"25","watson-assistant-solutions" +"25","servicenow-client-scripts" +"25","root-finding" +"25","session-cache" +"25","vulcanize" +"25","roottools" +"25","sessioncontext" +"25","docview" +"25","rose-db-object" +"25","database-driven" +"25","document-storage" +"25","ropes" +"25","vue-validator" +"25","jini" +"25","angular-webpack" +"25","serilog-filter" +"25","angulartics2" +"25","jms-queue" +"25","react-swipeable-views" +"25","data-harvest" +"25","service-worker-config" +"25","grails-3.3.x" +"25","roomplan" +"25","oracle-cursor" +"25","csi-driver" +"25","canjs-routing" +"25","cross-page-posting" +"25","val" +"25","hyperloop" +"25","akka-monitoring" +"25","wildfly-17" +"25","facepy" +"25","ibm-db2" +"25","icallbackeventhandler" +"25","pt-online-schema-change" +"25","wikitude-sdk" +"25","publishsubject" +"25","validate.js" +"25","docker-copy" +"25","dn" +"25","windows-application-packaging" +"25","shareware" +"25","pydal" +"25","validateset" +"25","ruby-debug-ide" +"25","kentico-11" +"25","vec" +"25","fastlane-pilot" +"25","window-decoration" +"25","crystal-reports-viewer" +"25","sharepoint-discussion-board" +"25","facebook-tabs" +"25","pryr" +"25","variable-width" +"25","windows-1255" +"25","validation-layers" +"25","fat16" +"25","cakephp-debug-kit" +"25","icingaweb2" +"25","ajax-push" +"25","ajaxify" +"25","single-user" +"25","unnotificationattachment" +"25","pybigquery" +"25","aws-java-sdk-dynamodb" +"25","meteor-cordova" +"25","microsoft-documentation" +"25","windows-media-center" +"25","android-tools-namespace" +"25","pdfsharpcore" +"25","karaf-maven-plugin" +"25","moltin" +"25","paypal-soap" +"25","infosphere-spl" +"25","bluecloth" +"25","appscale" +"25","nested-exceptions" +"25","mongodb-3.6" +"25","mod-proxy-ajp" +"25","azure-agent" +"25","jrepl" +"25","sap-analytics-cloud" +"25","aqua-data-studio" +"25","opencalais" +"25","guid-partition-table" +"25","injection-tokens" +"25","swagger-jsdocs" +"25","julia-studio" +"25","hpx" +"25","one-simulator" +"25","enumerate-devices" +"25","arangodb-foxx" +"25","appjar" +"25","horizontal-alignment" +"25","opencl.net" +"25","depot" +"25","onfocuschangelistener" +"25","gsheets" +"25","axios-retry" +"25","init-parameters" +"25","enterprise-architecture" +"25","invalid-object-name" +"25","design-documents" +"25","postman-collection" +"25","sbt-0.13" +"25","corestore" +"25","openerp-6" +"25","nscfstring" +"25","android-view-invalidate" +"25","demosaicing" +"25","mog" +"25","easyb" +"25","spring-boot-data-geode" +"25","passport.socketio" +"25","tvos13" +"25","kdbg" +"25","cpu-hazard" +"25","epmd" +"25","bluetoothadapter" +"25","jquery-select2-3" +"25","equal-range" +"25","ttabsheet" +"25","postgresql-simple" +"25","azure-blockchain-service" +"25","boxable" +"25","worklight-geolocation" +"25","bounding-volume" +"25","setstring" +"25","google-auth-library-nodejs" +"25","signalr-service" +"25","freegeoip" +"25","video-on-demand" +"25","codesense" +"25","settings-bundle" +"25","objectset" +"25","netlify-form" +"25","2d-context-api" +"25","network-state" +"25","winelib" +"25","astronomer" +"25","video-gallery" +"25","domain-data-modelling" +"25","btahl7" +"25","forest-plots" +"25","amber-smalltalk" +"25","google-anthos-service-mesh" +"25","sieve-of-atkin" +"25","windows-socket-api" +"25","java-20" +"25","sfauthorizationpluginview" +"25","extjs-chart" +"25","brother-print-sdk" +"25","mission-control" +"25",".net-spark" +"25","libexif" +"25","originlab" +"25","revolute-joints" +"25","mime4j" +"25","table-index" +"25","madcap" +"25","ubl" +"25","lumenworks" +"25","knitr-spin" +"25","osmar" +"25","lwt" +"25","outlook-2019" +"25","google-chrome-webview" +"25","view-templates" +"25","google-bi-engine" +"25","android-apt" +"25","nxc" +"25","android-1.6-donut" +"25","ktrain" +"25","abstract-action" +"25","cocoapods-1.0.1" +"25","pydatalog" +"25","otlp-grpc" +"25","gon" +"25","go-back-n" +"25","good-dynamics" +"25","view-model-pattern" +"25","object-notation" +"25","framebusting" +"25","wkinterfacegroup" +"25","libtomcrypt" +"25","wknavigationdelegate" +"25","visual-studio-dbpro" +"25","pyevolve" +"25","pydeck" +"25","build-target" +"25","facebook-as3-api" +"25","neuron-simulator" +"25","visual-build-professional" +"25","hidden-features" +"25","android-compose-card" +"25","scatterplot3d" +"25","redis-search" +"25","model-based-testing" +"25","gwt-2.8" +"25","pokemon-go" +"25","context-sensitive-help" +"25","drmaa" +"25","hibernate-5" +"25","scottplot" +"25","podfile-lock" +"25","sql-server-collation" +"25","cordova-5.0.0" +"25","dfd" +"25","novaclient" +"25","dfdl" +"25","dfinity" +"25","opengts" +"25","tca" +"25","directional-light" +"25","openinventor" +"25","high-resolution-clock" +"25","plovr" +"25","mockstatic" +"25","xamarin.droid" +"25","openjms" +"25","qwindow" +"25","tarantool-cartridge" +"25","nothrow" +"25","time-trial" +"25","gambas" +"25","exi" +"25","hoodie" +"25","isspace" +"25","dtsearch" +"25","toad-data-point" +"25","hamlc" +"25","jamon" +"25","xcode13.2" +"25","refine.js" +"25","nth-root" +"25","refspec" +"25","reference-binding" +"25","node-supervisor" +"25","hit-highlighting" +"25","mkdirection" +"25","aster" +"25","nsurlrequestcachepolicy" +"25","scikit-survival" +"25","handle-leak" +"25","xcode7.1beta" +"25","schema.rb" +"25","dpll" +"25","regexp-grammars" +"25","tizen-web-simulator" +"25","tadodataset" +"25","jakarta-ee-security-api" +"25","vfr-reader" +"25","regex-recursion" +"25","redocly" +"25","devspace" +"25","npm-cache" +"25","contiki-process" +"25","express-cassandra" +"25","httprouter" +"25","cssnano" +"25","launchdagent" +"25","qqmlengine" +"25","tone-generator" +"25","nhprof" +"25","node-rsa" +"25","lua-busted" +"25","layouttransition" +"25","angular2-decorators" +"25","strerror" +"25","elm-architecture" +"25","stringcomparer" +"25","react-color" +"25","laravel-vite" +"25","text-normalization" +"25","cula" +"25","elevatezoom" +"25","stripplot" +"25","text-decoding" +"25","currentitem" +"25","reswift" +"25","strrchr" +"25","z-score" +"25","log4net-filter" +"25","nite" +"25","ekcalendar" +"25","ios-stickers" +"25","ztree" +"25","ios13.4" +"25","node-apn" +"25","ios18" +"25","google-goggles" +"25","node-api" +"25","elasticsearch-scripting" +"25","google-cloud-healthcare" +"25","getcontent" +"25","google-cloud-internal-load-balancer" +"25","nnapi" +"25","nmssh" +"25","ohm" +"25","certificate-transparency" +"25","moonapns" +"25","mptcp" +"25","mozjpeg" +"25","memory-reallocation" +"25","httpwatch" +"25","pytorch3d" +"25","memory-table" +"25","proxy-object" +"25","stp" +"25","odp" +"25","http-upload" +"25","lds" +"25","mongosh" +"25","odoo-mobile" +"25","erubis" +"25","http-status-code-100" +"25","pyzo" +"25","centos-web-panel" +"25","esb-toolkit-2.0" +"25","link-local" +"25","google-qpx-express-api" +"25","autonumeric.js" +"25","hcard" +"25","utf-7" +"25","toolstripcontrolhost" +"25","qualys" +"25","tracking.js" +"25","headertext" +"25","compiler-version" +"25","trains" +"25","encrypted-shared-preference" +"25","user-administration" +"25","lightfm" +"25","auto-registration" +"25","msvc14" +"25","heterogeneous-array" +"25","parenscript" +"25","font-smoothing" +"25","headerdoc" +"25","folium-plugins" +"25","bean-managed-transactions" +"25","msdasql" +"25","hawkbit" +"25","archos" +"25","amazon-linux-2023" +"25","quantitative" +"25","linear-types" +"25","quartz.net-3.0" +"25","arrow-python" +"25","maven-mojo" +"25","zip.js" +"25","google-language-api" +"25","amazon-memory-db" +"25","bigtop" +"25","zend-feed" +"25","artisan-serve" +"25","multi-mapping" +"25","zmodem" +"25","stargate-oss" +"25","webfocus" +"25","arrayref" +"25","maven-docker-plugin" +"25","mcollective" +"25","amazon-fps" +"25","computation-graph" +"25","ti-dsp" +"25","ember-1" +"25","zend-dom-query" +"25","amazon-s3-access-points" +"25","linqtocsv" +"25","maven-source-plugin" +"25","linq-extensions" +"25","embedded-cassandra" +"25","ijkplayer" +"25","shift-reduce" +"25","sharpkml" +"25","arquicklook" +"25","seekbar-thumb" +"25","gmgridview" +"25","flutter-list-tile" +"25","scrooge" +"25","qsignalmapper" +"25","google-nexus" +"25","max-allowed-packet" +"25","webistrano" +"25","gnu-common-lisp" +"25","parameter-splatting" +"24","clickbank" +"24","github-container-registry" +"24","treemaps" +"24","clbeaconregion" +"24","xspf" +"24","fcl" +"24","debezium-server" +"24","tensorflow-c++" +"24","remote-development" +"24","efcore.bulkextensions" +"24","transmogrifier" +"24","telegraf-output-plugins" +"24","gratia" +"24","trax" +"24","telprompt" +"24","webradio" +"24","standard-evaluation" +"24","websocket-rails" +"24","transifex" +"24","edward" +"24","transmission-daemon" +"24","balana" +"24","apache-hop" +"24","babel-plugin-react-intl" +"24","clucene" +"24","jdbi3-core" +"24","marytts" +"24","gretl" +"24","file-inclusion" +"24","mvcrecaptcha" +"24","backout" +"24","clash" +"24","private-functions" +"24","skel" +"24","math.round" +"24","yandex-metrika" +"24","jboss-amq" +"24","fiddler-dev" +"24","mat-error" +"24","phonenumberutils" +"24","marpa" +"24","balancing-groups" +"24","vueify" +"24","jdownloader" +"24","class-cluster" +"24","pg-partman" +"24","fluentcassandra" +"24","float32" +"24","eclipse-collections" +"24","yacas" +"24","slickr" +"24","v-tooltip" +"24","multiple-regression" +"24","reluctant-quantifiers" +"24","multiple-schema" +"24","vue-data-tables" +"24","prezi" +"24","feedback-loop" +"24","clrprofiler" +"24","weakeventmanager" +"24","matchit" +"24","jceks" +"24","dbobject" +"24","yarv" +"24","rembg" +"24","vsts-sync-migrator" +"24","adobe-form" +"24","python4delphi" +"24","indexed-image" +"24","lacontext" +"24","jsonb-array-elements" +"24","ng-sortable" +"24","checkinstall" +"24","swi-prolog-for-sharing" +"24","flash-ide" +"24","jsontemplate" +"24","json-api-response-converter" +"24","json-annotation" +"24","cci" +"24","ccscene" +"24","sejda" +"24","safe-stack" +"24","contenttemplateselector" +"24","python-config" +"24","xml-column" +"24","discounts" +"24","unary-function" +"24","immutant" +"24","datefinder" +"24","xmlbeans-maven-plugin" +"24","immutability-helper" +"24","sencha-command" +"24","imgix" +"24","sn.exe" +"24","runtime-configuration" +"24","carp" +"24","page-fragments" +"24","laravel-auditing" +"24","selenium-hub" +"24","datascript" +"24","firebase-app-hosting" +"24","vsct" +"24","smile" +"24","apollo-link-state" +"24","fsutil" +"24","xp-mode" +"24","ng-annotate" +"24","nhaml" +"24","p4a" +"24","swift-string" +"24","jsr179" +"24","symbol-tables" +"24","mappedby" +"24","oxwall" +"24","conform" +"24","fsc" +"24","contentflow" +"24","maml" +"24","pivot-grid" +"24","jsbundling-rails" +"24","overrun" +"24","apache-plc4x" +"24","jscompress" +"24","rxjs-dom" +"24","jspresso" +"24","dbaas" +"24","jstreer" +"24","fritzbox" +"24","symfony7" +"24","ng-component-outlet" +"24","page-directives" +"24","casadi" +"24","grafana-tempo" +"24","unsafe-eval" +"24","mysql-shell" +"24","angular-timer" +"24","shared-drive" +"24","roxy" +"24","vaultsharp" +"24","shared-file" +"24","ptp" +"24","pyclips" +"24","serial-monitor" +"24","mysql-error-1267" +"24","rs" +"24","icefaces-2" +"24","rsolr" +"24","veracrypt" +"24","verity" +"24","uri-fragment" +"24","sharedservices" +"24","wcf-interoperability" +"24","i18n-node" +"24","wagtail-search" +"24","n900" +"24","icicle-diagram" +"24","gradle-android-test-plugi" +"24","hypersql" +"24","windows-performance-analyzer" +"24","sharepoint-2003" +"24","jline3" +"24","aglio" +"24","read.fwf" +"24","governance-registry" +"24","meta-where" +"24","animejs" +"24","kendo-contextmenu" +"24","crnk" +"24","rebasing" +"24","way2sms" +"24","aws-lambda-go" +"24","simulink-library" +"24","single-spa-react" +"24","fast-refresh" +"24","mybatis-plus" +"24","uptime-monitoring" +"24","routeattribute" +"24","puma-dev" +"24","upvar" +"24","database-diagramming" +"24","rtai" +"24","id3lib" +"24","naming-containers" +"24","windows-principal" +"24","windmill" +"24","awesomeprint" +"24","candy" +"24","ruby-cocoa" +"24","kissmetrics" +"24","fastagi" +"24","microcoding" +"24","r-rook-package" +"24","wildwebdeveloper" +"24","joomfish" +"24","vwo" +"24","awql" +"24","r-rio" +"24","serilog-sinks-elasticsearch" +"24","mysql-error-1136" +"24","simple-spring-memcached" +"24","mfslidemenu" +"24","oracle-agile-plm" +"24","swiftdate" +"24","sap-bsp" +"24","jquery-datatables-rails" +"24","turn-by-turn" +"24","sas-visual-analytics" +"24","one-trust" +"24","grovepi+" +"24","jquery-xml" +"24","iojs" +"24","sas-stored-process" +"24","ioports" +"24","azure-elastic-sharding" +"24","boolean-search" +"24","opencart-events" +"24","nscompoundpredicate" +"24","apple-search-ads" +"24","deskband" +"24","superpower" +"24","grpc-kotlin" +"24","twitter-util" +"24","dynamic-keyword" +"24","applicationpage" +"24","deployjava" +"24","nspathcontrol" +"24","nsfontpanel" +"24","neo4jrestclient" +"24","openal-soft" +"24","pbuilder" +"24","popmotion" +"24","spring-cloud-azure" +"24","epiphany" +"24","katacoda" +"24","bootrun" +"24","html-reports-jenkins" +"24","html-to-text" +"24","julia-gpu" +"24","jwebbrowser" +"24","html.renderpartial" +"24","createentityadapter" +"24","wrds-compusat" +"24","html5builder" +"24","dynamics-nav-2009" +"24","enyim.caching" +"24","infinite-sequence" +"24","eric-ide" +"24","android-swipe" +"24","eris" +"24","gui-design" +"24","inview" +"24","gui-test-framework" +"24","grunt-shell" +"24","html-manipulation" +"24","guix" +"24","infinispan-8" +"24","word-style" +"24","peak-detection" +"24","kango-framework" +"24","brackets-shell" +"24","modelmetadataprovider" +"24","passwordvault" +"24","positional-operator" +"24","pdftables" +"24","pdftex" +"24","worklight-analytics" +"24","invokeandwait" +"24","amdatu" +"24","coin-or" +"24","ubuntu-16.10" +"24","windows-xp-sp2" +"24","rim-4.5" +"24","libasound" +"24","outliner" +"24","ocaml-toplevel" +"24","rhino-commons" +"24","abline" +"24","cocoapods-1.1.1" +"24","gomega" +"24","organizational-unit" +"24","pydictionary" +"24","forge2d" +"24","showtext" +"24","ripemd" +"24","visual-studio-publish" +"24","learnpress" +"24","pysqlcipher" +"24","sidewaffle" +"24","pydantic-settings" +"24","amplify-flutter" +"24","tablayout" +"24","oryx" +"24","macro-rules" +"24","oauth2-server" +"24","razor-3" +"24","fabletools" +"24","vlc.dotnet" +"24","pyfakefs" +"24","pytest-dependency" +"24","oaf" +"24","google-ads-data-hub" +"24","jasidepanels" +"24","mindbody" +"24","lemoon" +"24","leshan" +"24","lwuit-button" +"24","new-webserviceproxy" +"24","setthreadaffinitymask" +"24","code-search" +"24","fabric-digits" +"24","systemmanagement" +"24",".net-gadgeteer" +"24","system-on-chip" +"24","pynetdicom" +"24","miller" +"24","videocore" +"24","extglob" +"24","foswiki" +"24","revoke-token" +"24","pylibmc" +"24","atag" +"24","network-framework" +"24","vinyl" +"24","revmobads" +"24","vim-quickfix" +"24","atom-beautify" +"24","winsql" +"24","build-rules" +"24","vimpulse" +"24","mailbox" +"24","rajawalivr" +"24","occasionallyconnected" +"24","viemu" +"24","systemfit" +"24","google-chrome-theme" +"24","librsync" +"24","winhelp" +"24","oci-python-sdk" +"24","viewcontext" +"24","syslistview32" +"24","winsock-lsp" +"24","raspberry-pi5" +"24",".net-core-logging" +"24","c#-7.1" +"24","task-switching" +"24","di-containers" +"24","time-travel" +"24","openkm" +"24","taskset" +"24","coocox" +"24","cordova-win10" +"24","galleriffic" +"24","cookiebot" +"24","cactus" +"24","aspchart" +"24","excelize" +"24","mklocalsearchrequest" +"24","executeprocesstask" +"24","openimageio" +"24","bulk-mail" +"24","reek" +"24","hibernate-query" +"24","mockoon" +"24","hash-location-strategy" +"24","tcollection" +"24","asterisk-java" +"24","numeric-conversion" +"24","copula" +"24","asp.net-4.8" +"24","geckoboard" +"24","asternet" +"24","dpm" +"24","dr.racket" +"24","gwt-widgets" +"24","guppy" +"24","copyleaks-api" +"24","mkcert" +"24","bwu-datagrid" +"24","plinqo" +"24","continuity" +"24","bwplot" +"24","ui-guidelines" +"24","raco" +"24","isinteger" +"24","xamgrid" +"24","tipkit" +"24","taleo-connect-client" +"24","tokyo-tyrant" +"24","android-controls" +"24","pocketmine" +"24","modbus-tk" +"24","sqlite2" +"24","x-callback-url" +"24","quickgrid" +"24","non-uniform-distribution" +"24","spring-starter" +"24","tkplot" +"24","node-static" +"24","isosurface" +"24","nordic-semi" +"24","dtreeviz" +"24","azure-service-hooks" +"24","android-droidtext" +"24","spyware" +"24","x64dbg" +"24","uilocalizedcollation" +"24","expo-updates" +"24","sproutcore-views" +"24","targettype" +"24","acquisition" +"24","logz.io" +"24","ewmh" +"24","curry" +"24","acts-as-ferret" +"24","custom-contextmenu" +"24","logicblox" +"24","qchar" +"24","gen-fsm" +"24","nipype" +"24","ios11.4" +"24","getpicture" +"24","android-percent-library" +"24","nis" +"24","hubl" +"24","percentile-cont" +"24","es2022" +"24","resulttransformer" +"24","react-native-background-fetch" +"24","cfadmin" +"24","hugo-content-organization" +"24","google-email-migration" +"24","google-email-audit-api" +"24","genomics" +"24","test-more" +"24","testkit" +"24","hyde" +"24","terraform-provider-cloudflare" +"24","android-overscoll" +"24","prost" +"24","stream-compaction" +"24","resharper-4.5" +"24","latin-square" +"24","evernote-app-notebook" +"24","activitydesigner" +"24","lazydatamodel" +"24","iphone-64bit" +"24","speed-dial" +"24","membershipuser" +"24","androidjunitrunner" +"24","special-variables" +"24","css-to-pdf" +"24","odoo.sh" +"24","generative-programming" +"24","httpclienthandler" +"24","qgroundcontrol" +"24","cfsearch" +"24","meego-harmattan" +"24","get-it" +"24","duckling" +"24","iplots" +"24","angular-dart-routing" +"24","angular-data" +"24","zend-app-bootstrap" +"24","mturk" +"24","gnu-sort" +"24","auto-populating" +"24","gmsgroundoverlay" +"24","msxml4" +"24","beat-detection" +"24","automapper-8" +"24","forem" +"24","preon" +"24","cwac-endless" +"24","structure-packing" +"24","arrowdb" +"24","emitter" +"24","enide" +"24","haste" +"24","ms-access-web-app" +"24","embedded-server" +"24","scriptdom" +"24","cut-and-paste" +"24","quadruple-precision" +"24","haskell-spock" +"24","scriptprocessor" +"24","parsel" +"24","script-src" +"24","qtquick3d" +"24","lichess" +"24","google-maps-advanced-marker-element" +"24","iinterceptor" +"24","flutter-timer" +"24","sophoslabs-intelix" +"24","empty-class" +"24","pgm-protocol" +"24","thunderbird-lightning" +"24","line-continuation" +"24","powermockrunner" +"24","stayontop" +"24","image-charts" +"24","dalex" +"24","iis-metabase" +"24","maven-embedder" +"24","theta360" +"24","arcball" +"24","webgl-earth" +"24","imagegrab" +"24","thawte" +"24","vaadin-elements" +"24","bcrypt.net" +"24","dart-native-extension" +"24","toothpick-di" +"24","bgtaskscheduler" +"24","component-based" +"24","toolz" +"24","mediaprojection" +"24","utplsql" +"24","heavy-computation" +"24","std-source-location" +"24","fmpp" +"24","lime-haxe" +"24","user-guide" +"23","ssis-data-types" +"23","anthill" +"23","mwe" +"23","gridx" +"23","bacnet4j" +"23","xsl-variable" +"23","websphere-traditional" +"23","trello-powerup" +"23","feast" +"23","fftpack" +"23","tensorflow-model-analysis" +"23","photoshop-cs5" +"23","groupprincipal" +"23","declaration-files" +"23","git-diff-tree" +"23","term-query" +"23","clarity-lang" +"23","dbus-python" +"23","babeltrace" +"23","bash-on-windows" +"23","primeicons" +"23","yiic" +"23","jeet-grid" +"23","fbwebdialogs" +"23","github-archive" +"23","groupdocs" +"23","phirehose" +"23","phantomcss" +"23","graphics3d" +"23","vue-cli-5" +"23","figcaption" +"23","tensorrt-python" +"23","yii2-active-records" +"23","yii2-api" +"23","tensorly" +"23","fedora-26" +"23","list-separator" +"23","apache-camel-mail" +"23","eclipse-iot" +"23","fluentscheduler" +"23","truss" +"23","defaulted-functions" +"23","react-native-splash-screen" +"23","apache-arrow-flight" +"23","remote-login" +"23","react-native-turbomodule" +"23","relaxng-compact" +"23","phpfastcache" +"23","wdio-v4" +"23","flowpane" +"23","ansi-common-lisp" +"23","cloudkit-environments" +"23","mashery" +"23","staf" +"23","sitefinity-feather" +"23","multiparty" +"23","intellij-idea2017" +"23","defaulttreemodel" +"23","eclipse-templates" +"23","git-cherry" +"23","mxbean" +"23","webpartpage" +"23","apache-dolphinscheduler" +"23","tsserver" +"23","web-to-winforms" +"23","anzograph" +"23","clj-time" +"23","yandex-mapkit" +"23","tsr" +"23","barracuda" +"23","jflap" +"23","aegis" +"23","xmlstreamwriter" +"23","nhibernate-caches" +"23","physical-design" +"23","xmlsec1" +"23","xmlseclibs" +"23","adtf" +"23","python-crfsuite" +"23","vod" +"23","xnamespace" +"23","ngtemplateoutlet" +"23","snmpsharpnet" +"23","kubernetesexecutor" +"23","cbc-mac" +"23","xor-linkedlist" +"23","pkcs" +"23","pythonocc" +"23","python-fractions" +"23","russian-doll-caching" +"23","jsr250" +"23","sneakers" +"23","rxtest" +"23","ad-hoc-network" +"23","django-crontab" +"23","symbolic-references" +"23","distributed-algorithm" +"23","rustfmt" +"23","fillable" +"23","adobe-pdfservices" +"23","flatfiledestination" +"23","flask-principal" +"23","ungetc" +"23","apk-signing" +"23","apigen" +"23","flex4.7" +"23","api-documentation" +"23","bingbot" +"23","adobe-scout" +"23","pagedjs" +"23","padr" +"23","padleft" +"23","x-http-method-override" +"23","ump" +"23","dbd-pg" +"23","apex-data-loader" +"23","umbraco-mvc" +"23","manhattan" +"23","flanneld" +"23","fixed-size-types" +"23","datetime-select" +"23","packagecompiler.jl" +"23","adobe-dtm" +"23","apache-karaf-feature" +"23","sembast" +"23","datetime-local" +"23","jsl" +"23","dbdeploy" +"23","laplacianofgaussian" +"23","immediate-mode" +"23","circleci-orb" +"23","json5" +"23","lablgtk" +"23","c-cda" +"23","jsonapi-serialize" +"23","pig-udf" +"23","makecode" +"23","safe-browsing-api" +"23","mailslot" +"23","mainscreen" +"23","send-port" +"23","mainactor" +"23","pstack" +"23","animatetransform" +"23","rqt" +"23","kenlm" +"23","rpostgres" +"23","vaadin-valo-theme" +"23","watson-text-to-speech" +"23","wbxml" +"23","carbon-fields" +"23","rolling-updates" +"23","aleph" +"23","mysqlcommand" +"23","django-project-architect" +"23","vapix" +"23","unstructured-data" +"23","documentpaginator" +"23","keyedcollection" +"23","i18n-js" +"23","documentsdirectory" +"23","service-application" +"23","django-database-functions" +"23","django-drf-renderer" +"23","ruffle" +"23","windows-media-services" +"23","upc" +"23","data-governance" +"23","hypotenuse" +"23","icomoon" +"23","icns" +"23","vectorwise" +"23","rtts" +"23","akka-camel" +"23","windows-key" +"23","grails-constraints" +"23","rtlcss" +"23","shared-cache" +"23","database-scripts" +"23","simple-mvvm" +"23","dockerfile-maven-plugin" +"23","ical-dotnet" +"23","optaweb-employee-rostering" +"23","unity-ecs" +"23","docker-ee" +"23","django-hosts" +"23","django-geoposition" +"23","row-key" +"23","native-android" +"23","cruisecontrol.rb" +"23","angularjs-timeout" +"23","creole" +"23","rnmapbox-maps" +"23","sipdroid" +"23","canutils" +"23","metering" +"23","jimfs" +"23","ora-24247" +"23","routing-slip" +"23","oracle-streams" +"23","criteo" +"23","data-containers" +"23","keyset-pagination" +"23","metaweblog" +"23","dllplugin" +"23","angular-ng" +"23","j-interop" +"23","vcg" +"23","aws-identitypools" +"23","cronet" +"23","nconf" +"23","azure-file-copy" +"23","internal-representation" +"23","tx" +"23","delphi.net" +"23","save-dialog" +"23","bootstrap-notify" +"23","bootstrap-duallistbox" +"23","spring-cloud-circuitbreaker" +"23","internal-app-sharing" +"23","jquery-mobile-pageshow" +"23","peano-numbers" +"23","bonobo-etl" +"23","delay-load" +"23","nested-stack" +"23","gstreamer-0.10" +"23","wrangle" +"23","apxs2" +"23","samsung-browser" +"23","wsapi" +"23","postgres-plpython" +"23","nsshadow" +"23","initwithcontentsofurl" +"23","kadira" +"23","gtd" +"23","ws4py" +"23","bluetoothlescanner" +"23","kappa" +"23","nested-groups" +"23","nested-types" +"23","kanji" +"23","twitter-flight" +"23","similarity-search" +"23","nbitcoin" +"23","k8s-cluster-role" +"23","bluetooth-mesh" +"23","spring-cloud-stream-binder-kinesis" +"23","twitter-button" +"23","workling" +"23","nscolorwell" +"23","information-architecture" +"23","mongodb-java-3.3.0" +"23","patternfly" +"23","bpp" +"23","enumerators" +"23","cpuset" +"23","wordpress-media" +"23","app-preview" +"23","spring-boot-chaos-monkey" +"23","application-structure" +"23","android-slices" +"23","openbox" +"23","hpack" +"23","open-esb" +"23","entity-framework-extended" +"23","gulp-usemin" +"23","nes" +"23","ionic-keyboard" +"23","infoview" +"23","jquery-ui-contextmenu" +"23","spring-pulsar" +"23","applicationsettingsbase" +"23","deployit" +"23","modern.ie" +"23","boomerang" +"23","swift6" +"23","spring-lemon" +"23","super-columns" +"23","swampy" +"23","ndc" +"23","ndbunit" +"23","nsmanagedobjectid" +"23","inherited-constructors" +"23","easyapache-4" +"23","navigator-ios" +"23","pytest-markers" +"23","802.11p" +"23","kohana-db" +"23","microstation" +"23","visreg" +"23","brisk" +"23","javaquery" +"23","java-heap" +"23","wintersmith" +"23","ubuntu-23.10" +"23","buildsrc" +"23","javaoptions" +"23","u3d" +"23","code-complete" +"23","build-management" +"23","network-efficiency" +"23","neuraxle" +"23","audio-device" +"23","range-tree" +"23","rakudo-star" +"23","aaa-security-protocol" +"23","vmrun" +"23","vizard" +"23","jaseci" +"23","foundry-functions" +"23","typespec" +"23","vk-sdk" +"23","typescript-never" +"23","richfaces-modal" +"23","virtus" +"23","nxhtml" +"23","objectlistview-python" +"23","nwb" +"23","windres" +"23","out-of-band" +"23",".net-standard-1.4" +"23","liberty-maven-plugin" +"23","origami" +"23","knockback.js" +"23","objcmongodb" +"23","domoticz" +"23","side-channel-attacks" +"23","facebook-graph-api-v2.8" +"23","returnn" +"23","shadermaterial" +"23","audio-route" +"23","shippable-ci" +"23","syntax-rules" +"23","minmax-heap" +"23","google-chat-api" +"23","lucidchart" +"23","visual-studio-liveshare" +"23","sidetiq" +"23","pygst" +"23","typeorm-activerecord" +"23","magnification-api" +"23","mailaddress" +"23","vistime" +"23","bsp-tree" +"23","bsdmake" +"23","network.framework" +"23","gomail" +"23","ubersvn" +"23","auth0-delegated-admin" +"23","syslog4j" +"23","visual-studio-power-tools" +"23","tablednd" +"23","contextswitchdeadlock" +"23","asprintf" +"23","mockito-scala" +"23","mobileserviceclient" +"23","taglib-ruby" +"23","c5" +"23","xcode8-beta4" +"23","mmc3" +"23","android-bootstrap" +"23","toloka" +"23","ui-scroll" +"23","continuous-aggregates" +"23","asmjit" +"23","iui" +"23","quickcontactbadge" +"23","explicit-object-parameter" +"23","npmignore" +"23","driving-distance" +"23","openshift-4" +"23","bundletool" +"23","xcplayground" +"23","tachyons-css" +"23","refined" +"23","aspect-fit" +"23","azure-promptflow" +"23","rails.vim" +"23","x-content-type-options" +"23","xcode13.3" +"23","drupal-form-submission" +"23","expo-linking" +"23","radius-protocol" +"23","node-sqlserver" +"23","quilt" +"23","azure-webhooks" +"23","asp.net-mvc-helpers" +"23","gconf" +"23","asp.net-mvc-layout" +"23","scaleform" +"23","dictvectorizer" +"23","exfat" +"23","scratchbox" +"23","xact-abort" +"23","nuxt.config.js" +"23","target-link-libraries" +"23","notification-icons" +"23","scrapy-middleware" +"23","tanuki" +"23","mobilefirst-qa" +"23","wxerlang" +"23","sql-server-data-project" +"23","executefetchrequest" +"23","sql-server-config-manager" +"23","tcheckbox" +"23","android-cts" +"23","tcomb" +"23","azure-relay" +"23","vertxoptions" +"23","pligg" +"23","operadriver" +"23","iso-7816-4" +"23","model-glue" +"23","gatk" +"23","nonfactors-mvc-grid" +"23","expansion-tile" +"23","tailwind-variants" +"23","scala-placeholder-syntax" +"23","rabbitmq-management" +"23","dtn" +"23","propertybag" +"23","layar" +"23","active-users" +"23","angular-gettext" +"23","njs" +"23","ipu" +"23","geom-histogram" +"23","pelles-c" +"23","angular-eslint" +"23","csvtoarray" +"23","activation-codes" +"23","cfbundledocumenttypes" +"23","angular-carousel" +"23","omnipascal" +"23","duffs-device" +"23","geojsonio" +"23","proximityapi" +"23","monkey-testing" +"23","mosaic-decisions" +"23","cuda-arrays" +"23","acid-state" +"23","oma" +"23","eid" +"23","mosml" +"23","spintax" +"23","oledbparameter" +"23","tomcat-dbcp" +"23","egress" +"23","acrcloud" +"23","hygraph" +"23","node-pty" +"23","eventhub" +"23","react-children" +"23","etcdctl" +"23","http-status-code-408" +"23","lowdb" +"23","http-status-code-308" +"23","mesa-abm" +"23","pestphp" +"23","luafilesystem" +"23","react-gtm-module" +"23","stomp.py" +"23","responders" +"23","ewam" +"23","resemblejs" +"23","mendel-os" +"23","qrunnable" +"23","meekro" +"23","excel-2000" +"23","megabyte" +"23","huawei-location-kit" +"23","meltano" +"23","qlibrary" +"23","communityengine" +"23","genius-api" +"23","project-layout" +"23","zugferd" +"23","generic-associated-types" +"23","qpid-proton" +"23","ios-app-signing" +"23","periodic-processing" +"23","pfimageview" +"23","spock-reports" +"23","google-cloud-registry" +"23","genstage" +"23","oftype" +"23","google-cloud-launcher" +"23","promoted-builds" +"23","msodbcsql17" +"23","cxjs" +"23","touchgfx" +"23","auv3" +"23","static-compilation" +"23","msagl" +"23","paraccel" +"23","email-formats" +"23","glmulti" +"23","email-spec" +"23","web-access" +"23","qtwebsockets" +"23","idm" +"23","pp-perl-par-packager" +"23","thruway" +"23","measurement-studio" +"23","bcbsn" +"23","through2" +"23","google-spark-operator" +"23","glui" +"23","powerform" +"23","mdd" +"23","structured-references" +"23","pandas-timeindex" +"23","artificial-life" +"23","pandastable" +"23","mediastreamtrack" +"23","zendesk-sdk" +"23","heroku-connect" +"23","beforeinstallprompt" +"23","bayesian-deep-learning" +"23","autofield" +"23","powerbi-datagateway" +"23","scribe-workbench" +"23","gmsautocomplete" +"23","conditional-expressions" +"23","ashmem" +"23","weboperationcontext" +"23","sunburnt" +"23","space-tree" +"23","msdeployserviceagent" +"23","hex-file" +"23","custom-scope" +"23","multicol" +"23","qtpy" +"23","solar2d" +"23","arcadedb" +"23","imagehash" +"23","fnv" +"23","zero-width-space" +"23","compiler-generated" +"23","stdapply" +"23","utl-http" +"23","parameterized-constructor" +"23","mule-sdk" +"23","qsharedmemory" +"23","embedded-osgi" +"23","parcelfiledescriptor" +"23","parentid" +"23","usenet" +"23","qsplashscreen" +"23","authorize.net-webhooks" +"23","max-execution-timeout" +"23","bigcouch" +"23","qt5.10" +"23","compatibility-level" +"23","font-scaling" +"23","armasm" +"23","parted" +"23","archimate" +"22","stalled" +"22","jcryption" +"22","group-object" +"22","react-particles-js" +"22","inserthtml" +"22","stacks-blockchain" +"22","yoothemes" +"22","matter-iot-standard" +"22","clojars" +"22","react-native-image-crop-picker" +"22","dbisam" +"22","travel-time" +"22","webusercontrols" +"22","mutual-information" +"22","maskformatter" +"22","marp" +"22","stanford-nlp-server" +"22","php-gtk" +"22","material-design-3" +"22","telligent" +"22","filebuf" +"22","jbatch" +"22","cloudkit-sharing" +"22","apache-bahir" +"22","trello.net" +"22","ggtitle" +"22","stack-based" +"22","instana" +"22","template-metal" +"22","cloud66" +"22","install-requires" +"22","websync" +"22","fdmemtable" +"22","program-transformation" +"22","flow-diagram" +"22","gritter" +"22","lli" +"22","xsjs" +"22","multistage" +"22","ecommerce-sales" +"22","replication-factor" +"22","ebxml" +"22","github-search" +"22","teleport" +"22","classtag" +"22","sly" +"22","flutter-camera" +"22","release-apk" +"22","yellow-screen-of-death" +"22","ecslidingviewcontroller-2" +"22","live-unit-tests" +"22","fluent-entity-framework" +"22","linuxthreads" +"22","livecoding" +"22","multiple-join-rows" +"22","multivariate-partition" +"22","jetbrains-hub" +"22","eclipse-dtp" +"22","yapdatabase" +"22","backbone.validation.js" +"22","relx" +"22","trivially-copyable" +"22","eclipse-ecf" +"22","proficy" +"22","print-style" +"22","reposurgeon" +"22","ansible-container" +"22","sktransition" +"22","antd-mobile" +"22","pack-expansion" +"22","impredicativetypes" +"22","bioservices" +"22","aframe-networked" +"22","dispatch-table" +"22","kubernetes-gateway-api" +"22","ngit" +"22","piracy-protection" +"22","appgroups" +"22","umzug" +"22","flashair" +"22","xhtml-1.1" +"22","manticore-search" +"22","chrome-for-testing" +"22","chrome-remote-desktop" +"22","swiftui-transition" +"22","manual-retain-release" +"22","page-inspector" +"22","binding-expressions" +"22","swiftyuserdefaults" +"22","jsondecodeerror" +"22","swig-typemap" +"22","pagertitlestrip" +"22","symfony-guard" +"22","swing-app-framework" +"22","chuck" +"22","check-framework" +"22","unisharp-file-manager" +"22","freemind" +"22","runtime-packages" +"22","flatbutton" +"22","riverpod-annotation" +"22","swiz" +"22","incremental-linking" +"22","file-type-associations" +"22","xmlhttprequest-states" +"22","impact-analysis" +"22","img2pdf" +"22","ng-deep" +"22","symstore" +"22","django-anymail" +"22","python-gearman" +"22","smart-tags" +"22","symfony-cli" +"22","circusd" +"22","image-resolution" +"22","software-protection" +"22","apache-pinot" +"22","jsbarcode" +"22","ngx-image-cropper" +"22","uitextchecker" +"22","social-likes" +"22","xmltocsv" +"22","jsajaxfileuploader" +"22","js2-mode" +"22","fittextjs" +"22","g2o" +"22","connect-timeout" +"22","manage-nuget-packages" +"22","map-matching" +"22","vogels" +"22","ngx-socket-io" +"22","fixed-length-file" +"22","bitmovin-player" +"22","rust-itertools" +"22","selenium-jupiter" +"22","vs-color-theme-editor" +"22","cinch" +"22","data-uri-scheme" +"22","ngx-treeview" +"22","v-navigation-drawer" +"22","js-routes" +"22","socketpair" +"22","cayley" +"22","jpa-1.0" +"22","facepile" +"22","ruby-build" +"22","sessiontracking" +"22","cson" +"22","pvm" +"22","roda" +"22","ora-01858" +"22","joomla-community-builder" +"22","cron4j" +"22","iasyncoperation" +"22","vyper" +"22","cross-env" +"22","keras-cv" +"22","oracle12.1" +"22","optionsettype" +"22","database-create" +"22","vanilla-extract" +"22","rowexpansion" +"22","ajaxuploader" +"22","r-qgraph" +"22","jpa-buddy" +"22","narray" +"22","data-jpa-test" +"22","kendo-ui-vue" +"22","reaper" +"22","ruby-install" +"22","vanishing-point" +"22","django-rest-framework-filters" +"22","keyring" +"22","service-not-available" +"22","pscx" +"22","django-shop" +"22","watchapp" +"22","microsoft-graph-excel" +"22","django-prefetch-related" +"22","psr-12" +"22","jinterface" +"22","rule-of-five" +"22","microsoft-contracts" +"22","windowsondevices" +"22","microsoft-cdn" +"22","sequence-sql" +"22","algol" +"22","icepush" +"22","dlt" +"22","vector-space" +"22","unstated" +"22","cameraoverlayview" +"22","aws-iam-authenticator" +"22","jol" +"22","ahead-of-time-compile" +"22","micronaut-test" +"22","wildfly-13" +"22","gradle-tooling-api" +"22","keyboardfocusmanager" +"22","shapley" +"22","site-definition" +"22","jonas" +"22","micr" +"22","mysql-error-1142" +"22","database-programming" +"22","infernojs" +"22","nqp" +"22","enterprise-miner" +"22","gulp-compass" +"22","htmldecode" +"22","cp1250" +"22","nsanimation" +"22","ttthumbsviewcontroller" +"22","onestepcheckout" +"22","deployment-diagram" +"22","k8ssandra" +"22","sigprocmask" +"22","hotpatching" +"22","tup" +"22","entityobject" +"22","writeonly" +"22","swift-array" +"22","destructure" +"22","hot-rod" +"22","simhash" +"22","svn-trunk" +"22","crawlee" +"22","monadfix" +"22","simplebar" +"22","twaindotnet" +"22","swift-keyboard" +"22","swashbuckle.examples" +"22","boost-system" +"22","saspy" +"22","blazorinputfile" +"22","corecursion" +"22","boost.test" +"22","julia-pkg" +"22","sat4j" +"22","epiceditor" +"22","equational-reasoning" +"22","nsis-mui" +"22","jquery-mobile-select" +"22","epicor10" +"22","jquery-mobile-themeroller" +"22","popper" +"22","delivery-pipeline" +"22","moloquent" +"22","html-to-image" +"22","open-atrium" +"22","grunt-plugins" +"22","pbm" +"22","open-banking" +"22","ionic-devapp" +"22","wsrp" +"22","jquery-1.10" +"22","samsung-gear-s2" +"22","postgres15" +"22","svelte-5" +"22","nested-controls" +"22","in-memory-cache" +"22","wso2-es" +"22","postgis-raster" +"22","spring-batch-integration" +"22","bluetooth-profile" +"22","appliance" +"22","dynamic-invoke" +"22","application-end" +"22","opal" +"22","html-react-parser" +"22","internet-options" +"22","pdk" +"22","apply-visitor" +"22","block-storage" +"22","invoice-ninja" +"22","htmlextensions" +"22","karma-chrome-launcher" +"22","iorderedenumerable" +"22","p-dropdown" +"22","modified-preorder-tree-t" +"22","internet-computer" +"22","ion-slide-box" +"22","opencv3.3" +"22","opendiff" +"22","kahadb" +"22","spring-auto-restdocs" +"22","ion-toggle" +"22","net.pipe" +"22","dynamic-rebinding" +"22","rbindlist" +"22","outlook.application" +"22","ucrop" +"22","async-workflow" +"22","externalizing" +"22","abstractmethoderror" +"22","37-signals" +"22","codefixprovider" +"22","udp-data-transfer" +"22","lwuit-textfield" +"22","microsoft-partner-center" +"22","rise" +"22","minimum-requirements" +"22","pyrus" +"22","output-directory" +"22","observation" +"22","rewire" +"22","facebook-java-sdk" +"22","libsoup" +"22","range-types" +"22","leave-one-out" +"22","view-transitions-api" +"22","pydruid" +"22","library-interposition" +"22","pyspin" +"22","wkhtmltopdf-binary" +"22","goldbach-conjecture" +"22","orbitdb" +"22","ubiquity" +"22","ameritrade" +"22","amdp" +"22","cognex" +"22","system-profiler" +"22","rdebug" +"22","rapidsvn" +"22","amd-gcn" +"22","jasmin-sms" +"22","java-deployment-toolkit" +"22","wookmark" +"22","octicons" +"22","setwindowpos" +"22","setwindowlong" +"22","atomic-swap" +"22","knockout-binding-handlers" +"22","netbeans-13" +"22","bridj" +"22","javascriptexecutor" +"22","tabledit" +"22","bteq" +"22","system.web.routing" +"22","oauth2resourceserver" +"22","type-mapping" +"22","neupy" +"22","browser-width" +"22","audiobufferlist" +"22","systimestamp" +"22","type-resolution" +"22","rapier" +"22","leptos" +"22","leon" +"22","freeboard" +"22","reverse-debugging" +"22","osmand" +"22","mailman-gem" +"22","mimemultipart" +"22","extranet" +"22","asx" +"22","vmargs" +"22","wmctrl" +"22","freak" +"22","quokka.js" +"22","qvector3d" +"22","convexity-defects" +"22","c++26" +"22","rails-authorization" +"22","nuxt-bridge" +"22","byte-code-enhancement" +"22","dtruss" +"22","dreamweaver-templates" +"22","xcode6.1.1" +"22","cactiverecord" +"22","dropify" +"22","device-instance-id" +"22","cordova-4" +"22","dilation" +"22","gamequery" +"22","hama" +"22","rabbitvcs" +"22","toast-ui-editor" +"22","cordova-sqlite-storage" +"22","toast-ui-image-editor" +"22","cordova-plugin-firebasex" +"22","mload" +"22","cordova-plugin-advanced-http" +"22","dsx" +"22","iso-image" +"22","nuance" +"22","jack-compiler" +"22","drupal-contact-form" +"22","sql-data-tools" +"22","drupal-database" +"22","cabal-new" +"22","redux-form-validators" +"22","numeric-ranges" +"22","radiance-flamingo" +"22","iwyu" +"22","mlton" +"22","openvpn-connect" +"22","devexpress-blazor" +"22","scalatest-maven-plugin" +"22","histogram-equalization" +"22","sql-manager" +"22","redux-api-middleware" +"22","android-enterprise-features" +"22","xcuielement" +"22","azure-static-web-app-routing" +"22","aspnet-development-server" +"22","drupal-views-relationship" +"22","scopeguard" +"22","conversational-ai" +"22","registerclass" +"22","contextual-binding" +"22","tdom" +"22","openshift-php-cartidges" +"22","bullet-chart" +"22","tinkerpop-frames" +"22","rails-spring" +"22","tinyalsa" +"22","azure-sql-reporting" +"22","pnrp" +"22","harvard-architecture" +"22","expo-permissions" +"22","plistbuddy" +"22","tabris-js" +"22","xcode-debugger" +"22","table-per-subclass" +"22","timed-events" +"22","dronekit-android" +"22","mockrestserviceserver" +"22","controlleras" +"22","qinputdialog" +"22","http-request2" +"22","angular-http-auth" +"22","http-pipelining" +"22","irfanview" +"22","moonmail" +"22","generate-scripts" +"22","odfpy" +"22","mono-service" +"22","angularjs-1.7" +"22","irp" +"22","angular2-seed" +"22","laravel-schema-builder" +"22","node-native-addon" +"22","genero" +"22","qftp" +"22","compare-contrast" +"22","ondoubleclick" +"22","qfontmetrics" +"22","qdoublespinbox" +"22","oeis" +"22","qdial" +"22","reactify" +"22","qcodo" +"22","electron-rebuild" +"22","ninject-conventions" +"22","reactive-cocoa-5" +"22","qbuttongroup" +"22","genicam" +"22","commitlint" +"22","ol3-google-maps" +"22","testserver" +"22","okular" +"22","elasticsearch-sql" +"22","terraform-enterprise" +"22","geoapi" +"22","og-meta" +"22","ios-statusbar" +"22","android-print-manager" +"22","android-kenburnsview" +"22","pettingzoo" +"22","storyshots" +"22","evenly" +"22","google-cloud-intellij" +"22","storm-orm" +"22","strict-transport-security" +"22","curl-commandline" +"22","persistence-ignorance" +"22","spree-paypal-express" +"22","cequel" +"22","zotonic" +"22","perl5.10" +"22","iphelper" +"22","cert" +"22","memgraph" +"22","spin-rdf" +"22","cucumber-spring" +"22","actuator" +"22","iphone-sdk-3.1.3" +"22","google-filament" +"22","lpwstr" +"22","speech-recognition-api" +"22","lpstr" +"22","chartfx" +"22","iphone-xs-max" +"22","spawn-fcgi" +"22","cgi-application" +"22","chart.jsv3" +"22","provider-model" +"22","iprogress" +"22","prolog-directive-dynamic" +"22","euler-path" +"22","eto" +"22","iraf" +"22","action-hook" +"22","protobuf-3" +"22","activation-record" +"22","font-awesome-6" +"22","concrete-inheritance" +"22","parsey-mcparseface" +"22","prefix-notation" +"22","thinkphp" +"22","utest" +"22","sdiff" +"22","line-through" +"22","maven-dependency-check-plugin" +"22","ember-engines" +"22","cypress-testing-library" +"22","google-routes-api" +"22","usocket" +"22","iloggerfactory" +"22","als" +"22","scribunto" +"22","trackpy" +"22","solidcolorbrush" +"22","conditional-execution" +"22","autogpt" +"22","lightgraphs" +"22","tfs-query" +"22","cypress-configuration" +"22","lifx" +"22","hdl-coder" +"22","spark-ec2" +"22","spark-connect" +"22","tfignore" +"22","arduino-mkr1000" +"22","auto-lock" +"22","ardalis-specification" +"22","custom-scheme-url" +"22","style-dictionary" +"22","encrypted-core-data-sql" +"22","webpack-externals" +"22","cypress-each" +"22","suo" +"22","parse4j" +"22","linktable" +"22","partial-response" +"22","mcimagemanager" +"22","zii-widgets" +"22","sonar-gerrit" +"22","utl-mail" +"22","somee" +"22","igor" +"22","email-signature" +"22","zikula" +"22","prerenderview" +"22","maven-replacer-plugin" +"22","qt-design-studio" +"22","google-patent-search" +"22","flvplayer" +"22","partiallinktext" +"22","image-graphviz" +"22","limited-user" +"22","limit-per-group" +"22","beanstalk-svn" +"22","automic" +"22","arithmetic-overflow" +"22","flutter-swiper" +"22","traccar" +"22","tortoisehg-2.0" +"22","zipwith" +"22","arb" +"22","binance-chain" +"22","gitstack" +"22","mtj" +"22","glumpy" +"22","google-maps-android-api-3" +"22","identicon" +"22","pandastream" +"22","cyrus" +"22","preact-signal" +"22","maven-gpg-plugin" +"22","mediastreamsegmenter" +"21","multiple-indirection" +"21","jbox" +"21","staging-table" +"21","react-slate" +"21","cloud-platform" +"21","client-dependency" +"21","skyve" +"21","maruku" +"21","multiple-occurrence" +"21","clientscriptmanager" +"21","teamcenter" +"21","teamcity-10" +"21","multipath" +"21","teamcity-5.1" +"21","clientcache" +"21","react-native-fbsdk-next" +"21","class-helpers" +"21","client-applications" +"21","xtrf" +"21","flutteramplify" +"21","deepnote" +"21","sli" +"21","slicehost" +"21","vsomeip" +"21","fedcm" +"21","cloudflare-argo" +"21","php-ide" +"21","click-framework" +"21","ddrmenu" +"21","react-native-state" +"21","weceem" +"21","intel-python" +"21","ef-bulkinsert" +"21","product-management" +"21","bandit" +"21","cloth-simulation" +"21","edgeengine" +"21","tensorflow-ssd" +"21","skip-take" +"21","instapaper" +"21","report-studio" +"21","primepush" +"21","fcmp" +"21","groupname" +"21","graph-modelling-language" +"21","graphqlclient" +"21","yii-rest" +"21","fieldeditor" +"21","jdepend" +"21","yii-xupload" +"21","sklightnode" +"21","deck.js" +"21","photoshop-cs4" +"21","square-flow" +"21","react-paginate" +"21","webshot" +"21","photutils" +"21","jenkins-pipeline-unit" +"21","yii2-grid" +"21","installshield-2014" +"21","gringo" +"21","whois-ruby" +"21","principalsearcher" +"21","matlab-java" +"21","github-token" +"21","ycbcr" +"21","localityofreference" +"21","repoze.who" +"21","skeleton-ui" +"21","github-actions-artifacts" +"21","musixmatch" +"21","git-branch-sculpting" +"21","affiliates" +"21","data-studio-custom-visuals" +"21","dirty-checking" +"21","xpdo" +"21","app-hub" +"21","pace.js" +"21","bit-cast" +"21","bit64" +"21","bindonce" +"21","pahocpp" +"21","palm-api" +"21","pandarallel" +"21","unified-diff" +"21","unescapestring" +"21","underscore-java" +"21","selectmanymenu" +"21","umdh" +"21","umbrella" +"21","sencha-cmd5" +"21","sendgrid-ruby" +"21","mapzen" +"21","s3-rewrite-rules" +"21","void-t" +"21","rxjs-lettable-operators" +"21","social-gaming" +"21","vpc-peering" +"21","sobipro" +"21","vsewss" +"21","rust-compiler-plugin" +"21","catalystserverless" +"21","ngx-build-plus" +"21","ng-modal" +"21","ccscrolllayer" +"21","cddvd" +"21","cdi-unit" +"21","nexus-6p" +"21","flask-cli" +"21","flash-v3-components" +"21","find-util" +"21","flash-8" +"21","smjobbless" +"21","jsnetworkx" +"21","jsnlog" +"21","chronicle-bytes" +"21","smart-http" +"21","pkzip" +"21","playcanvas" +"21","chef-template" +"21","chatscript" +"21","python-jose" +"21","swizzle" +"21","diskpart" +"21","distributed-tensorflow" +"21","ovi" +"21","distributed-apps" +"21","python-arango" +"21","index-sequence" +"21","blackberry-widgets" +"21","xlsx-populate" +"21","swiftui-datepicker" +"21","blackfin" +"21","laravel-guard" +"21","kysely" +"21","xml-encryption" +"21","xmemcached" +"21","ims-db" +"21","image-text" +"21","imebra" +"21","imovie" +"21","fsxaml" +"21","python-tenacity" +"21","python-siphon" +"21","python-schedule" +"21","lab-management" +"21","rpl" +"21","service-control-manager" +"21","watson-openscale" +"21","angularjs-ui-utils" +"21","ice-protocol" +"21","ibm-wdt" +"21","ibm-iam" +"21","cryptico" +"21","rockmongo" +"21","record-rules" +"21","windows-arm64" +"21","credible-interval" +"21","serviceinsight" +"21","document-versioning" +"21","windows-media-server" +"21","watchos-simulator" +"21","pushpad" +"21","dashlet" +"21","avs" +"21","service-name" +"21","pycallgraph" +"21","jobeet" +"21","sequential-workflow" +"21","readyroll" +"21","mysql-error-2006" +"21","gpa" +"21","gperf" +"21","keyczar" +"21","keydb" +"21","angular-workspace-configuration" +"21","mysql-logic" +"21","unsafe-inline" +"21","jparsec" +"21","wcf-sessions" +"21","mysql-routines" +"21","unordered-multiset" +"21","unordered-multimap" +"21","dockable" +"21","keyword-extraction" +"21","simplecursortreeadapter" +"21","docker-cmd" +"21","microsoft365r" +"21","rsocket-js" +"21","nacos" +"21","oracleexception" +"21","angular-transfer-state" +"21","jfuzzylogic" +"21","aws-datastore" +"21","nailgun" +"21","universal-storyboard" +"21","react-syntax-highlighter" +"21","microblogging" +"21","operationqueue" +"21","aws-global-accelerator" +"21","name-matching" +"21","jprobe" +"21","fastexport" +"21","optimathsat" +"21","fastfile" +"21","docsplit" +"21","oracle11gr1" +"21","routing-controllers" +"21","nanoid" +"21","jpegtran" +"21","ajaxhelper" +"21","pstree" +"21","dmo" +"21","calloutview" +"21","jpacontainer" +"21","realproxy" +"21","realstudio" +"21","psyco" +"21","pth" +"21","callr" +"21","django-sekizai" +"21","call-user-func-array" +"21","war-filedeployment" +"21","django-scheduler" +"21","kendo-observable" +"21","upcase" +"21","validationexception" +"21","mysqldumpslow" +"21","justboil.me" +"21","pcloud" +"21","neomutt" +"21","supabase-realtime" +"21","saturn-framework" +"21","pcdata" +"21","bootstrap-themes" +"21","android-studio-3.6.1" +"21","salesforce-mobile-sdk" +"21","app-shortcut" +"21","border-container" +"21","applehealth" +"21","ionic-webview" +"21","moltenvk" +"21","oov" +"21","blockcypher" +"21","appservice" +"21","hp-performance-center" +"21","openargs" +"21","sve" +"21","swar" +"21","eoserror" +"21","dynamic-mapping" +"21","crc64" +"21","envsubst" +"21","deno-deploy" +"21","ttcn" +"21","houndify" +"21","password-prompt" +"21","couchdbkit" +"21","svg-animationelements" +"21","gulp-mocha" +"21","ion-grid" +"21","path-provider" +"21","powerapps-component-framework" +"21","workato" +"21","jreddit" +"21","negroni" +"21","entitymanagerfactory" +"21","apply-async" +"21","svelte-native" +"21","supersocket.net" +"21","path-combine" +"21","navigationbaritems" +"21","wwsapi" +"21","boost-json" +"21","nrf-connect" +"21","mongodb-authentication" +"21","online-machine-learning" +"21","wsdl2objc" +"21","dynamic-chart-series" +"21","dynamic-expression" +"21","android-webview-javascript" +"21","interwoven" +"21","onready" +"21","applescript-numbers" +"21","bless" +"21","sap-enterprise-portal" +"21","erlang-driver" +"21","supabase-py" +"21","gstreamer-sharp" +"21","k8s-cronjobber" +"21","inky" +"21","errata" +"21","kallithea" +"21","ws4j" +"21","type-ahead" +"21","module-build" +"21","jqpivot" +"21","formalchemy" +"21","rdio" +"21","nwebsec" +"21","auth0-js" +"21","outlook-graph-api" +"21","system.linq.dynamic" +"21","microsoft-todo" +"21","sic" +"21","lua-scripting-library" +"21","knx" +"21","ludwig" +"21","javascript-interop" +"21","formsy-react" +"21","visual-c++-2019" +"21","lumx" +"21","kotlin-sealed" +"21","java-audio" +"21","typescript-2.5" +"21","fpml" +"21","raml-1.0" +"21","kloxo" +"21","ocrmypdf" +"21","klaviyo" +"21","kotlin-inline-class" +"21","atsam3x" +"21","viewusercontrol" +"21","overheating" +"21","jaxb2-annotate-plugin" +"21","2-3-tree" +"21","code-view" +"21","typeface.js" +"21","3d-mapping" +"21","koloda" +"21","obs-studio" +"21","video-library" +"21","netgraph" +"21","kotlin-coroutine-channel" +"21","type-extension" +"21","system.err" +"21","py-redis" +"21","setsid" +"21","2-satisfiability" +"21","javax.activation" +"21","korge" +"21","systemml" +"21","buf" +"21","browsefragment" +"21","o365rwsclient" +"21","raspbian-stretch" +"21","btreemap" +"21","outlook-2007-addin" +"21","mixed-authentication" +"21","extjs7-classic" +"21","libxlsxwriter" +"21","madlib" +"21","oriento" +"21","magick-r-package" +"21","dolibarr" +"21","amber-framework" +"21","neutrino" +"21","object-address" +"21","net-tcp" +"21","t9" +"21","bryntum-scheduler" +"21","microsoft-graph-groups" +"21","winstone" +"21","orchid" +"21","lenny" +"21","wmdc" +"21","goimports" +"21","braze" +"21","libdl" +"21","objectbox-android" +"21","vllm" +"21","winmail.dat" +"21","wordpress-capabilities" +"21","winrs" +"21","atomic-long" +"21","wnet" +"21","miranda" +"21","macos-app-extension" +"21","buildbox" +"21","magento-go" +"21","scgi" +"21","nolio" +"21","dotnet-core-pack" +"21","gemstone" +"21","expert-advisor" +"21","xamlwriter" +"21","hidden-fields" +"21","rack-rewrite" +"21","novocaine" +"21","expanded" +"21","sql-server-authentication" +"21","hoptoad" +"21","android-hardware-keyboard" +"21","dry-rb" +"21","tinyml" +"21","non-well-formed" +"21","redirecttoroute" +"21","numericstepper" +"21","directory-security" +"21","redirection-wordpress-plugin" +"21","dhclient" +"21","diagrams.net" +"21","wysiwym" +"21","moa" +"21","openonload" +"21","istio-prometheus" +"21","ispconfig-3" +"21","nunit-2.6" +"21","x25519" +"21","mobile-analytics" +"21","plugin.media.crossmedia" +"21","reddit-access-token" +"21","time-to-first-byte" +"21","plumbum" +"21","scratchcard" +"21","screen-positioning" +"21","to-be-continuous" +"21","d-star" +"21","toco" +"21","reflex-dom" +"21","gcore" +"21","hadoop-lzo" +"21","controlling" +"21","nstablerowview" +"21","nszombies" +"21","doxia" +"21","dpdk-pmd" +"21","mkmf" +"21","asp.net-mvc-templates" +"21","scngeometry" +"21","opentofu" +"21","drupal-files" +"21","harmony" +"21","dribbble-api" +"21","opensmpp" +"21","gdal-python-bindings" +"21","export-to-html" +"21","sproutcore-2" +"21","hapi-swagger" +"21","nsuuid" +"21","scntechnique" +"21","expo-dev-client" +"21","gedmo-loggable" +"21","controlbox" +"21","token-name-resolution" +"21","gelly" +"21","vfs-stream" +"21","ivars" +"21","xcode8-beta3" +"21","node-centrality" +"21","moonscript" +"21","android-messaging" +"21","location-updates" +"21","monkeyc" +"21","escalation" +"21","layout-parser" +"21","omeka" +"21","pytumblr" +"21","split-function" +"21","google-cloud-spanner-emulator" +"21","hwclock" +"21","ldapauth" +"21","spec2" +"21","nodereference" +"21","provider-hosted" +"21","huawei-ads" +"21","spring-2.5" +"21","google-cloud-metrics" +"21","okteto" +"21","movefileex" +"21","resharper-5.1" +"21","movidius" +"21","streamingresponsebody" +"21","qlocale" +"21","angular-google-chart" +"21","duosecurity" +"21","comdlg32" +"21","angular-directive-link" +"21","acf-gutenberg" +"21","resumable" +"21","ejb-timer" +"21","perception" +"21","ctp4" +"21","accpac" +"21","ironscheme" +"21","qmovie" +"21","perfetto" +"21","getcustomattributes" +"21","irrklang" +"21","angular2-toaster" +"21","performance.now" +"21","ctr-mode" +"21","restartmanager" +"21","qopenglfunctions" +"21","actuate" +"21","elasticsearch-performance" +"21","iphone-sdk-4.3" +"21","nickel" +"21","memmap" +"21","cuda-graphs" +"21","qglviewer" +"21","string-iteration" +"21","currency-pipe" +"21","text2image" +"21","odoo-accounting" +"21","http-message-converter" +"21","coldspring" +"21","column-major-order" +"21","esptool" +"21","column-defaults" +"21","ios-standalone-mode" +"21","linq.compiledquery" +"21","msgfmt" +"21","zfc-rbac" +"21","google-input-tools" +"21","powergrep" +"21","lifecycleexception" +"21","powerpack" +"21","bayessearchcv" +"21","powerbi-filters" +"21","google-nearby-messages" +"21","encoding-json-go" +"21","bedtools" +"21","zfit" +"21","msmq-transaction" +"21","lightweight-stream-api" +"21","parallel.invoke" +"21","empirical-distribution" +"21","alignof" +"21","particle-photon" +"21","parallelstream" +"21","parse-recdescent" +"21","linux-kernel-headers" +"21","partialviews" +"21","thomson-reuters-eikon" +"21","web-ext" +"21","compiler-services" +"21","user-defined-fields" +"21","hbasestorage" +"21","bfcache" +"21","concrete-syntax-tree" +"21","compiler-development" +"21","embedded-object" +"21","hdfql" +"21","giza++" +"21","gkpeerpickercontroller" +"21","emacs-speedbar" +"21","forecastr" +"21","arm-mpu" +"21","stimulus-rails" +"21","thinky" +"21","webauthenticator" +"21","security-trimming" +"21","struts2-rest-plugin" +"21","concurrent-ruby" +"21","heroicons" +"21","haskell-hedgehog" +"21","flutter-mockito" +"21","secondary-sort" +"21","componentkit" +"21","componentmodel" +"21","maximum-profit-problem" +"21","headerfooter" +"21","spark-shuffle" +"21","usn" +"21","uss" +"21","mcs" +"21","ijvm" +"21","touchswipe" +"21","zencoder" +"21","artemiscloud" +"21","flyte" +"21","fongo" +"21","sonarqube6.3" +"21","sharp-repository" +"21","computed-values" +"21","z3-fixedpoint" +"21","compute-capability" +"21","weblogic14c" +"21","identity-provider" +"21","sonicwall" +"21","sublayout" +"21","behance-api" +"21","fms3" +"21","multcompview" +"21","shiboken2" +"21","identityserver2" +"21","maven-webstart-plugin" +"21","zcml" +"21","gmavenplus" +"20","trusted-vs-untrusted" +"20","terminal.app" +"20","cloud-connect" +"20","xrmservicetoolkit" +"20","decltype-auto" +"20","backdraftjs" +"20","apache-arrow-datafusion" +"20","ckqueryoperation" +"20","dead-reckoning" +"20","close-button" +"20","stanza.io" +"20","ggboxplot" +"20","clean-url" +"20","clang-query" +"20","balena" +"20","bale-messenger" +"20","tensorflowsharp" +"20","ckmodifyrecordsoperation" +"20","anti-bot" +"20","ckfinder3" +"20","ggeffects" +"20","classformaterror" +"20","floris" +"20","wepay" +"20","ckerror" +"20","cluster-mode" +"20","debug-print" +"20","bareword" +"20","floating-ui" +"20","flutter-easy-localization" +"20","ecdhe" +"20","vue-styleguidist" +"20","clozure-cl" +"20","flink-checkpoint" +"20","decentraland" +"20","vue-suspense" +"20","class-decorator" +"20","tembeddedwb" +"20","installshield-2016" +"20","react-native-unimodules" +"20","file-diffs" +"20","materials" +"20","squib" +"20","teltonika" +"20","deferred-result" +"20","my.resources" +"20","pharo-5" +"20","figlet" +"20","reitit" +"20","jbehave-maven-plugin" +"20","website-payment-pro" +"20","phpstorm-2016.1" +"20","jcycle" +"20","liveid" +"20","graphiti" +"20","replit-database" +"20","instaparse" +"20","squad" +"20","repeatable-read" +"20","slick-pg" +"20","react-native-fast-image" +"20","math-mode" +"20","jfeinstein" +"20","few-shot-learning" +"20","jetty-httpclient" +"20","php-safe-mode" +"20","ssbo" +"20","intellij-12" +"20","jboss-wildfly-11" +"20","jett" +"20","filebrowse" +"20","jetspeed2" +"20","smallcheck" +"20","inserter" +"20","intellij-17" +"20","default-namespace" +"20","graphql-yoga" +"20","renesas-rx" +"20","rendr" +"20","jest-mock-extended" +"20","file-globs" +"20","file-connection" +"20","react-native-safe-area-view" +"20","ffmpegkit" +"20","multi-model-database" +"20","react-quilljs" +"20","filehash" +"20","loadvars" +"20","jayrock" +"20","process-elevation" +"20","photran" +"20","react-router-bootstrap" +"20","react-qr-code" +"20","grimport" +"20","cbmc" +"20","function-reference" +"20","ccmenu" +"20","dataparallel" +"20","function-call-operator" +"20","data-presentation" +"20","fullcontact" +"20","datarowcollection" +"20","file-system-storage" +"20","flask-oidc" +"20","symbian3" +"20","firebase-util" +"20","fiware-knowage" +"20","adobe-dps" +"20","jsbn" +"20","js-joda" +"20","swiftui-navigationpath" +"20","swiftui-swipeactions" +"20","fresnel" +"20","chrome-canary" +"20","json-spirit" +"20","choices.js" +"20","content-model" +"20","sx" +"20","chef-windows" +"20","chef-vault" +"20","chatops" +"20","adf-task-flow" +"20","rivescript" +"20","funscript" +"20","cashfree" +"20","runhaskell" +"20","running-object-table" +"20","fusefabric" +"20","python-gnupgp" +"20","rust-criterion" +"20","python-ast" +"20","rust-pin" +"20","voluptuous" +"20","indexed-views" +"20","appboy" +"20","sacct" +"20","safetynet-api" +"20","lance" +"20","sage-one" +"20","self-supervised-learning" +"20","uiviewcontentmode" +"20","unbuffered-queries" +"20","select-for-xml" +"20","seldon-core" +"20","blackhole" +"20","unified-automation-sdk" +"20","unikernel" +"20","unionfs" +"20","pagoda-box" +"20","pagingtoolbar" +"20","binary-string" +"20","api-eveonline" +"20","overtone" +"20","bing-news-search-api" +"20","blackberry-os6" +"20","bitmap-index" +"20","apartment-state" +"20","biwavelet" +"20","apache-vysper" +"20","p7b" +"20","apache-syncope" +"20","p5.play" +"20","smtpjs" +"20","dispy" +"20","xing" +"20","playbin2" +"20","xeus-cling" +"20","smartsheet-java-sdk-v2" +"20","picard" +"20","pingback" +"20","xlw" +"20","smarty-plugins" +"20","dbgeography" +"20","xna-math-library" +"20","divmod" +"20","platform.sh" +"20","rubycas" +"20","csplitterwnd" +"20","simple-machines-forum" +"20","micronaut-security" +"20","django-jenkins" +"20","csqldataprovider" +"20","angular-material-paginator" +"20","universal-ctags" +"20","micrium" +"20","django-translated-fields" +"20","r-labelled" +"20","grails-5" +"20","icap" +"20","mget" +"20","punjab" +"20","kendospreadsheet" +"20","aws-route-table" +"20","camtasia" +"20","dockerrun.aws.json" +"20","fastify-multipart" +"20","avr32" +"20","row-removal" +"20","wayfinder" +"20","naniar" +"20","window.parent" +"20","ora-00054" +"20","crewai" +"20","inet-aton" +"20","rowdefinition" +"20","akismet" +"20","route-constraint" +"20","ag-charts" +"20","vcal" +"20","ora-01422" +"20","napalm" +"20","django-multiwidget" +"20","django-webtest" +"20","sinatra-assetpack" +"20","aws-load-balancer-controller" +"20","rml-rdf" +"20","watson-knowledge-catalog" +"20","gpc" +"20","crystal-reports-formulas" +"20","unspecified" +"20","joda-money" +"20","dataflex" +"20","sharepoint-webservice" +"20","vector-clock" +"20","pybinding" +"20","factual" +"20","icx" +"20","documentgroup" +"20","pybricks-micropython" +"20","data-controls" +"20","wcf-serialization" +"20","crypto-obfuscator" +"20","realm-cocoa" +"20","keypreview" +"20","pweave" +"20","wcf-streaming" +"20","urho3d" +"20","readeventlog" +"20","unqualified-name" +"20","dns-over-https" +"20","facesservlet" +"20","keter" +"20","mytoolkit" +"20","docvariable" +"20","angular-ui-tinymce" +"20","agm-core" +"20","gradle-custom-plugin" +"20","dataformwebpart" +"20","kimball" +"20","angular-transitions" +"20","wails" +"20","aws-mediapackage" +"20","aksequencer" +"20","wikimapia" +"20","pvpython" +"20","kermit" +"20","docx2pdf" +"20","venn" +"20","twitter-bootstrap-form" +"20","write-error" +"20","openbr" +"20","sim7600" +"20","envjs" +"20","passthrough-elements" +"20","derelict3" +"20","bower-register" +"20","tvbox" +"20","nsenter" +"20","hourglass" +"20","gulp-plugin" +"20","azure-android-sdk" +"20","ttkthemes" +"20","http4s-circe" +"20","module-federationnextjs-mfutils" +"20","gtkada" +"20","one-time-binding" +"20","nest-simulator" +"20","neptune" +"20","turn.js" +"20","nscondition" +"20","axelar" +"20","ion-checkbox" +"20","gulp-minify-css" +"20","gulp-minify" +"20","invocationhandler" +"20","twitter-share" +"20","svn-export" +"20","spring-batch-excel" +"20","ttstyledtextlabel" +"20","pdo-odbc" +"20","cps" +"20","nsb-servicecontrol" +"20","enscript" +"20","initwithcontentsoffile" +"20","worker-pool" +"20","silicon" +"20","gulp-if" +"20","swift-compiler" +"20","kafka-join" +"20","ndb" +"20","grunt-assemble" +"20","online-algorithm" +"20","dynamic-web-twain" +"20","internal-class" +"20","wsd" +"20","mongodb-biconnector" +"20","bonsaijs" +"20","android-studio-dolphin" +"20","spring-integration-file" +"20","twinfield" +"20","android-studio-chipmunk" +"20","sass-rails" +"20","poppler-utils" +"20","dynamic-frameworks" +"20","nsobjectcontroller" +"20","interval-arithmetic" +"20","apple-musickit-js" +"20","superblock" +"20","azure-auto-ml" +"20","erdpy" +"20","ion-list" +"20","epoxy-modelview" +"20","apple-authentication" +"20","azure-feature-manager" +"20","jxmaps" +"20","azure-ad-verifiable-credentials" +"20","wreq" +"20","wpf-core" +"20","pomm" +"20","salesforce-cli" +"20","jxmapviewer" +"20","postgres-operator" +"20","twenty-ten-theme" +"20","samsung-health" +"20","borland-c" +"20","wp7test" +"20","jumphost" +"20","kannada" +"20","spring-mono" +"20","ephemeral-storage" +"20","jukito" +"20","desfire" +"20","inline-method" +"20","nchar" +"20","jquery-hotkeys" +"20","codemod" +"20","codelldb" +"20","sysex" +"20","minor-mode" +"20","wordnik" +"20","pyforms" +"20","android-3.1-honeycomb" +"20","object-design" +"20","ubi" +"20","vici" +"20","shinyauthr" +"20",".net-generic-math" +"20","pymongo-2.x" +"20","abap-st" +"20","dom4" +"20",".net-traceprocessing" +"20","richeditabletext" +"20","wordpress-action" +"20","rich-domain-model" +"20","r-distill" +"20","shouldly" +"20","brew-doctor" +"20","reversegeocodelocation" +"20","typeglob" +"20","ubuntu-8.10" +"20","bridge.net" +"20","networkinfo" +"20","magento-1.3" +"20","amazon-sumerian" +"20","os-agnostic" +"20","lupa" +"20","coexistence" +"20","microsoft-graph-sites" +"20","go-flag" +"20","kohana-2" +"20","pygmt" +"20","kognitio-wx2" +"20","levelhelper" +"20","koding" +"20","viewwilldisappear" +"20","pyrserve" +"20","rap" +"20","java-failsafe" +"20","ui4j" +"20","atari-2600" +"20","librarian-puppet" +"20","cocor" +"20","rippled" +"20","gonum" +"20","academic-graph" +"20","aurigma" +"20","codecave" +"20","facebook-graph-api-v2.1" +"20","auraphp" +"20","pydbg" +"20","librato" +"20","magic-leap" +"20","libnice" +"20","tabbed-browsing" +"20","typeset" +"20","pydotplus" +"20","augraph" +"20","goinstall" +"20","accelerate-haskell" +"20","android-activity-alias" +"20","mac-frameworks" +"20","wisper" +"20","android-actionbar-tabs" +"20","pyro.ai" +"20","syphon" +"20","osxfuse" +"20","virtual-channel" +"20","uap" +"20","6510" +"20","extension-builder3" +"20","java-console" +"20","spying" +"20","notification-action" +"20","gadbannerview" +"20","nuxmv" +"20","xcode6-beta7" +"20","mktemp" +"20","sqlacodegen" +"20","caf-receiver-sdk" +"20","noraui" +"20","png-8" +"20","pnp.powershell" +"20","pmwiki" +"20","hkobserverquery" +"20","highs" +"20","cordova-facebook" +"20","wxhtmlwindow" +"20","directmemory" +"20","hoplon" +"20","android-device-owner" +"20","expressiveannotations" +"20","xcode11.2.1" +"20","coproc" +"20","non-scrolling" +"20","sqlbuddy" +"20","azure-resource-lock" +"20","homoiconicity" +"20","c14n" +"20","pointofservice" +"20","context-configuration" +"20","node-test-runner" +"20","nowdoc" +"20","sql-rank" +"20","gvisor" +"20","hmr" +"20","ixmldomelement" +"20","gwt-elemental" +"20","controlled-folder-access" +"20","isml" +"20","polygon.io" +"20","npm-config" +"20","dremel" +"20","ui-spy" +"20","tinytest" +"20","dsymutil" +"20","tinyproxy" +"20","uisplitviewdelegate" +"20","tanstack-router" +"20","mod-auth-kerb" +"20","dfply" +"20","dgrams" +"20","bupar" +"20","bunnycdn" +"20","dotnet-interactive" +"20","toll-free-bridging" +"20","openwrap" +"20","radtreelist" +"20","douglas-peucker" +"20","modeless-dialog" +"20","tobject" +"20","dotnetcharting" +"20","opensymphony" +"20","openxml-table" +"20","associative-table" +"20","uiactivitytypeairdrop" +"20","uiprintformatter" +"20","dpinst" +"20","drupal-routes" +"20","tag-handler" +"20","aspnet-merge" +"20","scalatra-sbt" +"20","redis-stack" +"20","qx" +"20","drupal-render" +"20","scalr" +"20","uidocumentbrowserviewcontroller" +"20","asp.net-cache" +"20","ref-struct" +"20","gd-graph" +"20","lc3-trap" +"20","meta-learning" +"20","mercurial-commit" +"20","genie.jl" +"20","e-sim" +"20","odometry" +"20","proguard-maven-plugin" +"20","qgraphicsrectitem" +"20","eslint-plugin-vue" +"20","mercurial-server" +"20","qkeysequence" +"20","qcubed" +"20","esri-loader" +"20","lazyvim" +"20","prom-client" +"20","odatalib" +"20","ohhttpstubs" +"20","protogen" +"20","chakracore" +"20","proximo" +"20","geograpy" +"20","moquette" +"20","omnicppcomplete" +"20","geokettle" +"20","omnixml" +"20","monobjc" +"20","cflocation" +"20","cfinvoke" +"20","ondrawitem" +"20","hypergraph" +"20","request-pipeline" +"20","huffman-tree" +"20","huawei-ml-kit" +"20","http-status-code-505" +"20","strawberryshake" +"20","petastorm" +"20","http-permissions-policy" +"20","http-mock" +"20","httpi" +"20","resharper-c++" +"20","stretchblt" +"20","persisted-column" +"20","strong-reference-cycle" +"20","perlnetssh" +"20","electronic-direct-mail" +"20","zts" +"20","responsestream" +"20","periodic" +"20","elasticsearch-client" +"20","accountpicker" +"20","elastic-container-registry" +"20","acl9" +"20","acorn" +"20","action-mailbox" +"20","pencilblue" +"20","nls-sort" +"20","lasso-lang" +"20","custom-overlay" +"20","custom-linq-providers" +"20","customizer" +"20","iot-devkit" +"20","react-chat-engine" +"20","terraform-provider-helm" +"20","ipcopen3" +"20","node-kafka" +"20","ls-remote" +"20","large-text" +"20","long-path" +"20","angular2-dart" +"20","nhlambdaextensions" +"20","nhibernate-search" +"20","google-doodle" +"20","cuba" +"20","irule" +"20","evaluation-strategy" +"20","evil-dicom" +"20","google-flexible" +"20","google-floodlight" +"20","ironspeed" +"20","ip-protocol" +"20","launch-condition" +"20","ews-javascript-api" +"20","logical-tree" +"20","colmap" +"20","nodeenv" +"20","qmk-firmware" +"20","qmk" +"20","lazyhgrid" +"20","angularjs-3rd-party" +"20","userchrome.css" +"20","flutter-stacked" +"20","ignoreroute" +"20","webchartcontrol" +"20","three-valued-logic" +"20","concourse-task" +"20","panelbar" +"20","compositionroot" +"20","cypress-origin" +"20","heliconzoo" +"20","zio-http" +"20","mawk" +"20","hdiutil" +"20","user-location" +"20","subliminal" +"20","shell-icons" +"20","alt-ergo" +"20","tibbletime" +"20","compositeitemwriter" +"20","sortedcontainers" +"20","image-annotations" +"20","igbinary" +"20","folktale" +"20","solr9" +"20","zerotier" +"20","statelist" +"20","utf8json" +"20","autodesk-webhooks" +"20","mtgox" +"20","zend-form-fieldset" +"20","mdxstudio" +"20","amazon-ground-truth" +"20","spark-bigquery-connector" +"20","zapproxy" +"20","qtquick-designer" +"20","msscci" +"20","structured-clone" +"20","glossaries" +"20","heroku-nodejs" +"20","qtsvg" +"20","search-keywords" +"20","scullyio" +"20","toplevel-statement" +"20","battlenet-api" +"20","qtooltip" +"20","yt" +"20","spark-2014" +"20","ember-query-params" +"20","ysod" +"20","scroll-snap-type" +"20","array-pointer" +"20","struts2-junit-plugin" +"20","zend-rest-route" +"20","tor-browser-bundle" +"20","licode" +"20","mt940" +"20","scroll-lock" +"20","google-realtime-api" +"20","hasura-cli" +"20","webfiltering" +"20","idbcommand" +"20","lifecycleowner" +"20","dark-theme" +"20","spark2.4.4" +"20","ppc64le" +"20","ilrepack" +"20","precompiling" +"20","stencil-compiler" +"20","meck" +"19","claimcenter" +"19","felix-dependency-manager" +"19","sitescope" +"19","cloudposse" +"19","graphiti-js" +"19","mutual-friendship" +"19","apache-commons-scxml" +"19","vue-dropzone" +"19","trinitycore" +"19","php-attributes" +"19","clover-payment" +"19","yii-migrations" +"19","github-dependabot" +"19","clean-language" +"19","mvcrazortopdf" +"19","backload" +"19","sll" +"19","trunk-rs" +"19","repopulation" +"19","intel-media-sdk" +"19","xsl-grouping" +"19","decimal-precision" +"19","decimal.js" +"19","programmatic-config" +"19","filecopy" +"19","repaintmanager" +"19","fdroid" +"19","anonymous-recursion" +"19","eclipse-project-file" +"19","gitleaks" +"19","flutter-audio-query" +"19","anypoint-rtf" +"19","cj" +"19","eclipse-temurin" +"19","xtemplate" +"19","liquibase-cli" +"19","linux-x32-abi" +"19","tensorflow-addons" +"19","flickrj" +"19","clickup-api" +"19","ffmpeg.js" +"19","stack-level" +"19","tenancyforlaravel" +"19","location-aware" +"19","ant-design-blazor" +"19","flex-datagrid" +"19","private-cloud" +"19","jfeed" +"19","yampa" +"19","dbtable" +"19","slashdb" +"19","php-jwt" +"19","tensorflowjs" +"19","coccinelle" +"19","multipart-upload" +"19","weston" +"19","cobol.net" +"19","instagrapi" +"19","gitbox" +"19","template-mixins" +"19","barbecue" +"19","cloudfront-functions" +"19","groovyfx" +"19","apache-abdera" +"19","slick-codegen" +"19","instancestate" +"19","ssha" +"19","eclipse-api" +"19","yahoo-widgets" +"19","ggdist" +"19","ggalt" +"19","easytracker" +"19","ssdt-2017" +"19","siteedit" +"19","cloudmailin" +"19","easysnmp" +"19","ssas-2016" +"19","react-native-view-shot" +"19","aopalliance" +"19","edge-devtools" +"19","citrix-access-gateway" +"19","laravel-filters" +"19","adornerdecorator" +"19","ngx-modal" +"19","laravel-gate" +"19","switchers" +"19","flask-flatpages" +"19","managed-cuda" +"19","discrete-space" +"19","biztalk-2006" +"19","ozone" +"19","p4.net" +"19","rx-netty" +"19","maquette" +"19","flatpak-builder" +"19","xml3d" +"19","filevisitor" +"19","send-on-behalf-of" +"19","disable-caching" +"19","symengine" +"19","picture-element" +"19","jsmpeg" +"19","file-templates" +"19","sendgrid-rails" +"19","mangopay" +"19","softbody" +"19","chronicle-wire" +"19","adversarial-attack" +"19","makehuman" +"19","bitcoinjs-lib" +"19","aedes" +"19","filestructure" +"19","padding-oracle-attack" +"19","flex-builder-3" +"19","ngrep" +"19","constraintlayout-guideline" +"19","uitextrange" +"19","constraint-handling-rules" +"19","constraintexception" +"19","ng-lightning" +"19","aero-snap" +"19","binding.pry" +"19","nexus6" +"19","bincode" +"19","binary-diff" +"19","self-healing" +"19","nginx-rtmp" +"19","selenium-side-runner" +"19","uniscribe" +"19","uniquery" +"19","apache-whirr" +"19","chop" +"19","select-xml" +"19","nginx-log" +"19","jspeex" +"19","ng2-pdf-viewer" +"19","celerity" +"19","apoc" +"19","uniface" +"19","apiato" +"19","selectmanylistbox" +"19","pandasgui" +"19","unattend-file" +"19","cds.copernicus" +"19","unfoldingmap" +"19","configurationproperty" +"19","ngcomponentrouter" +"19","adapt" +"19","apipie" +"19","python-manylinux" +"19","js-data-angular" +"19","xml-spreadsheet" +"19","run-sequence" +"19","ruport" +"19","django-1.2" +"19","picoblaze" +"19","careplicatorlayer" +"19","smart-tv-alliance" +"19","firefox-nightly" +"19","smd" +"19","python-reflex" +"19","firefox-sidebar" +"19","physfs" +"19","administrative" +"19","xmlpoke" +"19","kubernetes-jenkins-plugin" +"19","xmllite" +"19","vs-android" +"19","kuka-krl" +"19","kurento-media-server" +"19","kwicks" +"19","kxml" +"19","displaymode" +"19","impromptu-interface" +"19","display-cutouts" +"19","datetimerangefield" +"19","v-play" +"19","import-table" +"19","vpd" +"19","rxfire" +"19","adobe-extension" +"19","rxbluetooth" +"19","jsm" +"19","aws-deeplens" +"19","callisto" +"19","cam-pdf" +"19","jpath" +"19","angular-theming" +"19","agda-stdlib" +"19","vegas-viz" +"19","iasyncdisposable" +"19","angular-mdl" +"19","facebook-node-sdk" +"19","datagridviewlinkcolumn" +"19","r-ppp" +"19","value-iteration" +"19","myro" +"19","data-importer" +"19","validator.js" +"19","uploadstring" +"19","pure-react-carousel" +"19","mysql-command-line-client" +"19","ora-01031" +"19","ruby-gnome2" +"19","methodaccessexception" +"19","ruby-daemons" +"19","servemux" +"19","serpapi" +"19","jms2" +"19","rro" +"19","public-members" +"19","vaadin-touchkit" +"19","rs.exe" +"19","gota" +"19","keycloak-admin-client" +"19","keyfilter" +"19","grails-resources-plugin" +"19","mysql-pconnect" +"19","unreliable-connection" +"19","psd2" +"19","namedparameterjdbctemplate" +"19","opnsense" +"19","oracle-service-cloud" +"19","unocss" +"19","fallocate" +"19","kicad" +"19","fastcgi++" +"19","fastcall" +"19","sharejs" +"19","oracle-integration-cloud" +"19","sitecore-social-connected" +"19","kindle-kdk" +"19","microsoft.extensions.configuration" +"19","react-use-gesture" +"19","far" +"19","django-mssql-backend" +"19","avr-studio5" +"19","angularjs-ng-style" +"19","database-comparison" +"19","session-per-request" +"19","avr-studio4" +"19","vb-like-operator" +"19","crossbeam" +"19","vbcodeprovider" +"19","cross-context" +"19","aws-resource-group" +"19","wincache" +"19","dogecoin-api" +"19","canjs-control" +"19","waterlock" +"19","row-value-expression" +"19","aws-scp" +"19","watij" +"19","robocup" +"19","ora-01861" +"19","django-fsm" +"19","nanoscroller" +"19","pycups" +"19","data-capture" +"19","avdepthdata" +"19","dataconnect" +"19","servicemonitor" +"19","variable-product" +"19","service-management" +"19","single-shot-detector" +"19","serviceknowntype" +"19","service-installer" +"19","pyalsaaudio" +"19","rpgmakermv" +"19","icr" +"19","capturestream" +"19","carbon-emacs" +"19","data-formatters" +"19","routedcommand" +"19","nanogallery" +"19","cardinality-estimation" +"19","nspreferencepane" +"19","bottomtabs" +"19","simd-library" +"19","inline-namespaces" +"19","blazor-hosted" +"19","postgresql-8.0" +"19","spring-integration-ftp" +"19","payment-services" +"19","pear-mail" +"19","cpanel-uapi" +"19","nspec" +"19","demoscene" +"19","onutterancecompleted" +"19","bootstrap-image-gallery" +"19","sass-lint" +"19","createdibsection" +"19","blender-2.76" +"19","module-packaging" +"19","neodynamic" +"19","jurassic" +"19","gulp-jscs" +"19","blitz.js" +"19","degrafa" +"19","saleslogix" +"19","enomem" +"19","blinkid" +"19","braintree-data" +"19","nsgradient" +"19","nservicebus6" +"19","blend-2012" +"19","boost-context" +"19","delphi-mocks" +"19","nested-checkboxes" +"19","input-method-kit" +"19","paypal-plus" +"19","inittab" +"19","bodypix" +"19","pattern-finding" +"19","hsc2hs" +"19","spring-boot-starter-security" +"19","openapi.net" +"19","application-scope" +"19","application-role" +"19","spring-modules" +"19","bpftrace" +"19","boxy" +"19","android-shortcutmanager" +"19","twarc2" +"19","jrecord" +"19","surface-controller" +"19","deriveddata" +"19","grunt-contrib-htmlmin" +"19","turbopack" +"19","mongodb-schema" +"19","android-sharesheet" +"19","entity-groups" +"19","intldateformatter" +"19","swf-decompiler" +"19","android-vts" +"19","earth-movers-distance" +"19","svg-font" +"19","dv360" +"19","azure-blueprints" +"19","wpr" +"19","invalidprogramexception" +"19","erlang-escript" +"19","svn-merge-reintegrate" +"19","ioptionsmonitor" +"19","suptitle" +"19","tynamo" +"19","wso2-msf4j" +"19","dust-helpers" +"19","turbojpeg" +"19","swank-clojure" +"19","two-legged" +"19","jqueryi-ui-buttonset" +"19","couch-cms" +"19","grpc-dart" +"19","axure" +"19","wsc" +"19","amazon-silk" +"19","newforms" +"19","type-stability" +"19","sgmlreader" +"19","wingdings" +"19","magiczoomplus" +"19","newrelic-synthetics" +"19","librarian" +"19","windsor-nhfacility" +"19","javascript-oscillator" +"19","google-api-explorer" +"19","window-tester" +"19","framework-design" +"19","google-bigquery-java" +"19","koa-passport" +"19","async-onprogressupdate" +"19","rfc1123" +"19","amethyst" +"19","javaloader" +"19","netlist" +"19","raspberry-pi-os" +"19","foundry-phonograph" +"19","viennacl" +"19","wordpress-ecommerce" +"19","system-f" +"19","rdiff-backup" +"19","form.io" +"19","javafx-17" +"19","vinyl-ftp" +"19","foundry-actions" +"19","formatmessage" +"19","freefem++" +"19","rautomation" +"19","typesafe-actions" +"19","pyiron" +"19","winrt-httpclient" +"19","netiq" +"19","octane" +"19","mirah" +"19","virtio" +"19","fosjsroutingbundle" +"19",".net-services" +"19","extjs6.5.1" +"19","syndication-item" +"19","winpdb" +"19","shakespeare-text" +"19","formsy-material-ui" +"19","oracle-warehouse-builder" +"19","video-effects" +"19","newlisp" +"19","buffer-objects" +"19","java-assist" +"19","orbbec" +"19","typescript2.8" +"19","lua-lanes" +"19","java-custom-serialization" +"19","dom-selection" +"19","vlckit" +"19","o3d" +"19","codefresh" +"19","vlad-deployer" +"19","lwuit-textarea" +"19","microsoft-partnercenter-java" +"19","virtualquery" +"19","visionos-simulator" +"19","system.drawing.common" +"19","abaddressbooksource" +"19","pyrocms-lex" +"19","rightjs" +"19","razorlight" +"19","richpush" +"19","vmt" +"19","code-profiling" +"19","ouya" +"19","analytics-for-apache-hdp" +"19","kommunicate" +"19","domain-aliasing" +"19","nvrtc" +"19","nxopen" +"19","mindsdb" +"19","lesscss-resources" +"19","code-splitting-async" +"19","audiowaveform" +"19","outerwidth" +"19","nexe" +"19","google-analytics-campaign-builder" +"19","rc2-cipher" +"19","kronecker-product" +"19","java-text-blocks" +"19","amz-sagemaker-distributed-training" +"19","4store" +"19","attachmate-extra" +"19","oauth-refresh-token" +"19","netpbm" +"19","f2c" +"19","cocoascript" +"19","nxbre" +"19","domainkeys" +"19","orthanc-server" +"19","gcallowverylargeobjects" +"19","polipo" +"19","android-cling" +"19","h5p" +"19","tagify" +"19","mobx-persist" +"19","explicit-intent" +"19","busy-loop" +"19","tiptip" +"19","tizen-sdk" +"19","ntvdm" +"19","dotras" +"19","openshift-pipelines" +"19","gymnasium" +"19","android-compose-image" +"19","tabmenu" +"19","tlc" +"19","assignment-problem" +"19","nopcommerce-4.1" +"19","scrapysharp" +"19","hallo-js" +"19","taskservice" +"19","nosql-injection" +"19","plt-redex" +"19","plt" +"19","gcp-databricks" +"19","tau-prolog" +"19","reference-collapsing" +"19","android-gnss" +"19","android-go" +"19","uipopoverbackgroundview" +"19","openide" +"19","tcm" +"19","contextify" +"19","vertx4" +"19","exclusionpath" +"19","regl" +"19","mockito-inline" +"19","aspnetcoretemplatepack" +"19","asmselect" +"19","gegl" +"19","hardware-port" +"19","reflexil" +"19","diarization" +"19","drawnow" +"19","c++builder-2007" +"19","sqlmail" +"19","itunesconnect-analytics" +"19","mobilefirst-console" +"19","rack-cache" +"19","direct-initialization" +"19","sqlroleprovider" +"19","sqlite-journal-mode" +"19","uibackgroundmode" +"19","openwebstart" +"19","c++filt" +"19","garb-gem" +"19","scala-script" +"19","gargle" +"19","quire-api" +"19","j2html" +"19","itemprocessor" +"19","c1001" +"19","dexmaker" +"19","numerical-recipes" +"19","sql-azure-federations" +"19","sql-azure-alerts" +"19","diffstat" +"19","isomorphic-style-loader" +"19","hiveserver2" +"19","isoneway" +"19","hive-table" +"19","tnef" +"19","uilaunchimagefile" +"19","ui-leaflet" +"19","mmix" +"19","x10" +"19","spurious-wakeup" +"19","railsinstaller-windows" +"19","devpartner" +"19","buzz" +"19","diego" +"19","xact" +"19","jandex" +"19","dsoframer" +"19","xcodegen" +"19","cfinput" +"19","cfindex" +"19","react-material-ui-form-validator" +"19","ios-9-beta3" +"19","terraform-import" +"19","cfpreferences" +"19","splitpanel" +"19","spml" +"19","terraform-provider-docker" +"19","speedment" +"19","google-cloud-recommendation" +"19","spoonacular" +"19","cfselect" +"19","central" +"19","omf" +"19","terraform-provider-oci" +"19","pgdb" +"19","specter" +"19","storage-access-api" +"19","lars" +"19","resharper-2016" +"19","storyboard-reference" +"19","google-cloud-colab-enterprise" +"19","laravel-herd" +"19","test-double" +"19","testdrivendesign" +"19","http-auth" +"19","custom-collection" +"19","string-building" +"19","gesturelistener" +"19","resourcestring" +"19","perl-prove" +"19","textformat" +"19","cupertino-widgets" +"19","textpattern" +"19","response.transmitfile" +"19","text-to-html" +"19","periscope" +"19","elasticsearch-snapshot" +"19","textual" +"19","resque-retry" +"19","angular2-styleguide" +"19","rest-firebase" +"19","zyte" +"19","leaky-abstraction" +"19","angular-bootstrap-calendar" +"19","command-execution" +"19","acrylic-material" +"19","getfileversion" +"19","learning-locker" +"19","action-caching" +"19","actionhero" +"19","angularjs-events" +"19","angularjs-decorator" +"19","pending-transition" +"19","actionsheetpicker" +"19","pytype" +"19","react-date-range" +"19","lotus-wcm" +"19","project-navigator" +"19","pythreejs" +"19","react-canvas" +"19","collectionbase" +"19","lorenz-system" +"19","office-dialog-api" +"19","lsm-tree" +"19","promiscuous-mode" +"19","event-channel" +"19","character-codes" +"19","lorem-ipsum" +"19","propertychangesupport" +"19","qcursor" +"19","propertypath" +"19","moviecliploader" +"19","loopingselector" +"19","qsa" +"19","qformlayout" +"19","odoo-enterprise" +"19","react-google-places-autocomplete" +"19","merge-file" +"19","chainable" +"19","evaluation-function" +"19","react-graph-vis" +"19","longhorn" +"19","spectator" +"19","cfstoredproc" +"19","memory-sanitizer" +"19","qprogressdialog" +"19","cgrectintersectsrect" +"19","qore" +"19","vaadin-fusion" +"19","imagecreatefromjpg" +"19","webnfc" +"19","conferencing" +"19","zope.component" +"19","mediaprojectionmanager" +"19","flux-machine-learning" +"19","google-ios-vision" +"19","webkit-transition" +"19","emacs-ediff" +"19","heroku-review-app" +"19","linea-pro" +"19","conditional-attribute" +"19","avatar-generation" +"19","subquery-factoring" +"19","sortdirection" +"19","zipfoundation" +"19","ijetty" +"19","startup-folder" +"19","maven-indexer" +"19","image.createimage" +"19","web-folders" +"19","dart-stream" +"19","here-ios" +"19","linemanjs" +"19","flutter-reorderable-listview" +"19","quantumgrid" +"19","starling-server" +"19","strtoull" +"19","md-card" +"19","yui-menu" +"19","cvlib" +"19","bell-curve" +"19","search-engine-api" +"19","automatic-mixed-precision" +"19","gloo" +"19","haskell-ffi" +"19","automatic-variable" +"19","autocreate" +"19","benthos" +"19","glip" +"19","sedna" +"19","seektotime" +"19","hasura-jwt" +"19","argument-matcher" +"19","git-secret" +"19","mqx" +"19","stumbleupon" +"19","compile-static" +"19","mediacenter" +"19","ietf" +"19","trailing-newline" +"19","parquet.net" +"19","bgiframe" +"19","autoquery-servicestack" +"19","maxstringcontentlength" +"19","google-maps-ios-utils" +"19","solid" +"19","traefik-authentication" +"19","sonarqube-plugin" +"19","bicep" +"19","google-loader" +"19","archive-tar" +"19","solrclient" +"19","uwb" +"19","arbre" +"19","quantconnect" +"19","powerpoint-interop" +"19","shdocvw.internetexplorer" +"19","zfdoctrine" +"18","locallib" +"18","markov-random-fields" +"18","class-attribute" +"18","ecb-pattern" +"18","intercom.js" +"18","dce" +"18","matmul" +"18","backfire" +"18","antlrv3ide" +"18","loadmask" +"18","graphql-ws" +"18","grobid" +"18","prisma-binding" +"18","load-link-store-conditional" +"18","yellow-pages" +"18","flex-charts" +"18","groovy++" +"18","ebay-net-sdk" +"18","pgtap" +"18","sly-scroller" +"18","feature-tracking" +"18","clusterpoint" +"18","slt" +"18","react-pagination" +"18","remote-mysql" +"18","process-mining" +"18","jellyfin" +"18","wiegand" +"18","flourishlib" +"18","fluid-mac-app-engine" +"18","teamcity-5.0" +"18","vuejs-transition-group" +"18","jdeveloper-11g" +"18","ansi-nulls" +"18","primary-interop-assembly" +"18","jdoodle" +"18","ddt" +"18","react-native-sensors" +"18","stackunderflow" +"18","weak-entity" +"18","apache-commons-dateutils" +"18","jbake" +"18","tree-rotation" +"18","insightly" +"18","ggstatsplot" +"18","phpstorm-2016.3" +"18","instagramapi-mgp25" +"18","apache-arrow-cpp" +"18","standardanalyzer" +"18","tensorflow-extended" +"18","php-toolkit" +"18","treeline" +"18","wheelcollider" +"18","transplant" +"18","gfsh" +"18","tree-grammar" +"18","telerik-window" +"18","fbrequest-form" +"18","cloudant-sdp" +"18","reportviewerformvc" +"18","citrus-engine" +"18","mxunit" +"18","whitesource" +"18","gino" +"18","travis-ci-api" +"18","triple-equals" +"18","reportico" +"18","reportdocument" +"18","php-opencloud" +"18","github-services" +"18","gifsicle" +"18","sizehint" +"18","backup-sqldatabase" +"18","clbeacon" +"18","size-reduction" +"18","jconfirm" +"18","telerik-editor" +"18","ecmascript-temporal" +"18","repast-hpc" +"18","bangla-font" +"18","clcircularregion" +"18","wid" +"18","pageasynctask" +"18","pagecontext" +"18","bin-folder" +"18","freewalljs" +"18","firefox2" +"18","frontpage-extensions" +"18","manuals" +"18","cast-iron" +"18","syncfusion-blazor-sfgrid" +"18","constinit" +"18","aerospike-loader" +"18","bindingflags" +"18","firefox6" +"18","python-anyio" +"18","langchain4j" +"18","xdcr" +"18","xml-rpc.net" +"18","nexus-js" +"18","pageshow" +"18","uiviewanimation-curve" +"18","uiwindowscene" +"18","app-ads.txt" +"18","chrome-aws-lambda" +"18","python-redmine" +"18","nftw" +"18","ng2-completer" +"18","pixabay" +"18","apache-torque" +"18","ccscrollview" +"18","fxsl" +"18","ultratree" +"18","freshbooks-api" +"18","fxcop-customrules" +"18","fullscreenchange" +"18","python-phonenumber" +"18","nginx-cache" +"18","connect-direct" +"18","celery-canvas" +"18","python-pbr" +"18","jsr311" +"18","iminuit" +"18","unidecoder" +"18","conic-gradients" +"18","mapfish" +"18","makemessages" +"18","smartxls" +"18","impacket" +"18","confluent-rest-proxy" +"18","cdsw" +"18","unfiltered" +"18","first-level-cache" +"18","first-normal-form" +"18","discountasp" +"18","biztalk-schemas" +"18","catalystcloudscale" +"18","bizagi" +"18","disconnected-session" +"18","flatlaf" +"18","jsonfx" +"18","syck" +"18","imx7" +"18","bittorrent-sync" +"18","smips" +"18","bitsets" +"18","symbolicc++" +"18","fselector" +"18","sming" +"18","kusto-java-sdk" +"18","chronological" +"18","app-engine-modules" +"18","flask-graphql" +"18","caucho" +"18","bitmapencoder" +"18","causalml" +"18","pjl" +"18","lamemp3" +"18","chef-attributes" +"18","filesystemexception" +"18","firecracker" +"18","python-sql" +"18","vscode-calva" +"18","dbca" +"18","jsonpath-plus" +"18","php-webdriver" +"18","ximea" +"18","index.html" +"18","symfony-serializer" +"18","docker-selenium" +"18","faulted" +"18","rstudio-connect" +"18","inet-ntop" +"18","cakephp-3.5" +"18","jfreechart-fx" +"18","rspec-api-documentation" +"18","jfreereport" +"18","shared-module" +"18","jgap" +"18","docker-cp" +"18","sharedsizegroup" +"18","falsy" +"18","sharelatex" +"18","verificationexception" +"18","docassemble" +"18","rsample" +"18","jmesa" +"18","venia" +"18","rubygame" +"18","rqda" +"18","dmalloc" +"18","camel-rest" +"18","dmake" +"18","capture-list" +"18","variable-binding" +"18","camera-intrinsics" +"18","join-hints" +"18","camus" +"18","agora-cloud-recording" +"18","wildfly-cluster" +"18","crossdomain-request.js" +"18","cross-device" +"18","wildfly-maven-plugin" +"18","hyperledger-fabric-orderer" +"18","nanobind" +"18","micronaut-openapi" +"18","reconcile" +"18","akka-fsm" +"18","updatebatchsize" +"18","django-jet" +"18","mybinder" +"18","gopherjs" +"18","google-widget" +"18","ora-12899" +"18","unstage" +"18","real-time-java" +"18","session-keys" +"18","dask-jobqueue" +"18","django-openid-auth" +"18","servlet-dispatching" +"18","airsim" +"18","ora-02291" +"18","named-constructor" +"18","readonly-variable" +"18","kephas" +"18","serverless-framework-offline" +"18","real-ip" +"18","rocket-u2" +"18","metismenu" +"18","unowned-references" +"18","key-rotation" +"18","purifycss" +"18","database-inspector" +"18","metawidget" +"18","servicedcomponent" +"18","mysql-error-1364" +"18","unobserved-exception" +"18","ibm-jsf" +"18","ora-01843" +"18","django-socketio" +"18","django-hstore" +"18","database-tools" +"18","microsoft.extensions.hosting" +"18","icmpv6" +"18","upsolver" +"18","akka.net-streams" +"18","wallaby" +"18","django-localflavor" +"18","graalpython" +"18","rotor" +"18","agroal" +"18","crossmint" +"18","op-tee" +"18","mysql-parameter" +"18","angular-scully" +"18","gotw" +"18","keycloak-admin-cli" +"18","angular-masonry" +"18","oracle-apex-23" +"18","narayana" +"18","kiicloud" +"18","wakatime" +"18","angular-package-format" +"18","rmariadb" +"18","upsizing" +"18","routify" +"18","icann" +"18","oracle-application-server" +"18","django-stubs" +"18","craueformflow" +"18","modula-2" +"18","apple-expose" +"18","spring-boot-starter-parent" +"18","hoverfly" +"18","innobackupex" +"18","pbjvision" +"18","app-signing" +"18","suppressfinalize" +"18","html-dataset" +"18","popperjs" +"18","openfx" +"18","peakutils" +"18","nsdocktile" +"18","paysafe" +"18","postgresql-initdb" +"18","easyphp-devserver" +"18","sap-cloud-connector" +"18","dynamics-crm-3" +"18","surveyor-gem" +"18","swagger-tools" +"18","wsdl4j" +"18","nest-asyncio" +"18","dynamic-data-masking" +"18","blazor-bootstrap" +"18","pcx" +"18","survivejs" +"18","apple-business-manager" +"18","juel" +"18","pdftoppm" +"18","jupyterdash" +"18","booking.com-api" +"18","wse2.0" +"18","nestjs-exception-filters" +"18","ncks" +"18","ontouchstart" +"18","polymorphic-variants" +"18","samsung-gear-fit" +"18","android-tap-and-pay" +"18","nsitemprovider" +"18","info-hash" +"18","intersection-types" +"18","sbt-buildinfo" +"18","nslinguistictagger" +"18","guest-executable" +"18","delta-index" +"18","apple-model-io" +"18","mongodb-csfle" +"18","nerdcommenter" +"18","superslim" +"18","modx-getresources" +"18","n-quads" +"18","azerty-keyboard" +"18","worklight-mbs" +"18","inputsimulator" +"18","boot-animation" +"18","potrace" +"18","azapi" +"18","gtkscrolledwindow" +"18","dynamic365" +"18","payfast" +"18","portable-python" +"18","dynamics-365-ce-onpremises" +"18","inexact-arithmetic" +"18","jvx" +"18","dutch-national-flag-problem" +"18","entityresolver" +"18","nsprintinfo" +"18","bleach" +"18","application-singleton" +"18","coypu" +"18","mongobee" +"18","paypal-permissions" +"18","gulp-filter" +"18","mongoose-os" +"18","workflow-rehosting" +"18","grunt-concurrent" +"18","hound" +"18","infura" +"18","model-mommy" +"18","gulp-eslint" +"18","mimosa" +"18","nwpathmonitor" +"18","libhdfs" +"18","microsoft-odata" +"18","virtualdub" +"18","facebook-game-groups" +"18","virtuozzo" +"18","rcloud" +"18","system.net.websockets" +"18","java-resources" +"18","rational-unified-process" +"18","rangeseekbar" +"18","wix5" +"18","codecharge" +"18","netflix-nebula-plugins" +"18","freelancer.com-api" +"18","ueberauth" +"18","otapi" +"18","visx" +"18","krypton" +"18","kotlin-generics" +"18","android-api-34" +"18","aurelia-auth" +"18","r-forge" +"18","overhead-minimization" +"18","ochamcrest" +"18","cockroachcloud" +"18","pyeda" +"18","minimist" +"18","external-secrets-operator" +"18","ounit" +"18","java-ffm" +"18","rightscale" +"18","pysphere" +"18","rateyo" +"18","free-command" +"18","authorization-server" +"18","go-libp2p" +"18","pyml" +"18","razorpay-andoid-sdk" +"18","r-base-graphics" +"18","cocotron" +"18","viewaction" +"18","pysmb" +"18","libvips" +"18","wkurlschemehandler" +"18","kotlinx-html" +"18","outgoing-call" +"18","synthetica" +"18","libusb-win32" +"18","facebook-custom-audience" +"18","pymesh" +"18","winsnmp" +"18","f#-fake-4" +"18","sfhfkeychainutils" +"18","pygmo" +"18","table-driven" +"18","cognitive-complexity" +"18","objectspace" +"18","ortc" +"18","siemens-nx" +"18","java-sealed-type" +"18","lets-plot" +"18","pyqtchart" +"18","coin3d" +"18","objectsize" +"18","microsoft-live-connect" +"18","python-2.2" +"18","java-test-fixtures" +"18","jasmine-ajax" +"18","octest" +"18","wordpress-block-theme" +"18","macrabbit-espresso" +"18","rawrabbit" +"18","orderbook" +"18","object-class" +"18","system.web.http" +"18","rc-slider" +"18","abas" +"18","anchor-cms" +"18","andar" +"18","tablehtml" +"18","shopify-cli" +"18","codelyzer" +"18","pygame-menu" +"18","setediting" +"18","shinymanager" +"18","wordfence" +"18","viber-bot-python" +"18","pyi" +"18","raptor" +"18","for-range" +"18","oaep" +"18","buddyboss" +"18","vldb" +"18","rapidfuzz" +"18","at-sign" +"18","bucket4j" +"18","luaxml" +"18","vexflow" +"18","ispc" +"18","npm-login" +"18","qwebengine" +"18","mjsip" +"18","mixim" +"18","uicontextmenuinteraction" +"18","excel-writer-xlsx" +"18","r3-gui" +"18","sql-server-7" +"18","opengl-es-lighting" +"18","x10-language" +"18","nps" +"18","plotgooglemaps" +"18","controllercontext" +"18","qvt" +"18","is-same" +"18","notifyjs" +"18","android-gradle-7.0" +"18","android-gradle-3.1.0" +"18","executionexception" +"18","hinstance" +"18","dronedeploy" +"18","uigravitybehavior" +"18","sql-max" +"18","sceptre" +"18","itunes-api" +"18","plutus" +"18","droidscript" +"18","android-downloadable-fonts" +"18","android-displaymanager" +"18","sqlite-browser" +"18","raddocking" +"18","dry-run" +"18","mod-cache" +"18","quip" +"18","android-concatadapter" +"18","tal" +"18","model-driven-app" +"18","jackson-module-scala" +"18","nonclient" +"18","uikit-transitions" +"18","expectj" +"18","openseamap" +"18","point-to-point" +"18","jain-slee" +"18","openstack4j" +"18","poll-syscall" +"18","openser" +"18","dot-notation" +"18","sciruby" +"18","hmvc-codeigniter" +"18","tkintermapview" +"18","expo-calendar" +"18","tkinter-photoimage" +"18","mkusertrackingmode" +"18","nsxmlparsererrordomain" +"18","coolite" +"18","gclient" +"18","ntruencrypt" +"18","numeric-textbox" +"18","azuremapscontrol" +"18","gcc4.6" +"18","mobile-emulator" +"18","nuget-update" +"18","azure-management-portal" +"18","ca65" +"18","difference-equations" +"18","mmppf" +"18","asp-net-config-builders" +"18","dput" +"18","didfailwitherror" +"18","mockgoose" +"18","mobile-security" +"18","numbered" +"18","lparam" +"18","customising" +"18","stream-management" +"18","streamparse" +"18","euiccmanager" +"18","httpbuilder-ng" +"18","char-traits" +"18","latte" +"18","es6-generator" +"18","actionmailer.net" +"18","ode-library" +"18","string-externalization" +"18","text-database" +"18","lazy-io" +"18","resource-governor" +"18","mender" +"18","ls2j" +"18","csstidy" +"18","resource-utilization" +"18","metacircular" +"18","nilearn" +"18","duplicate-detection" +"18","eslint-plugin-import" +"18","actionbuilder" +"18","actionable-notification" +"18","qcolordialog" +"18","elasticui" +"18","generatestaticparams" +"18","mercurial-keyring" +"18","android-room-migration" +"18","message-bundle" +"18","messageboard" +"18","qscopedpointer" +"18","getlocation" +"18","irix" +"18","android-priority-jobqueue" +"18","einsum" +"18","elasticsearch-2.4" +"18","iron-list" +"18","zxspectrum" +"18","merge-strategy" +"18","ctfont" +"18","iphone-xr" +"18","esri-oss" +"18","perch" +"18","launcher-icon" +"18","elasticjs" +"18","iplanet" +"18","motionbuilder" +"18","oledragdrop" +"18","communication-diagram" +"18","proxyfactory" +"18","react-native-button" +"18","monomorphism" +"18","mongrel2" +"18","cflogin" +"18","react-native-collapsible" +"18","node.io" +"18","cfftp" +"18","cfdictionary" +"18","splitbrain" +"18","laravel-livewire-wireclick" +"18","okvs" +"18","loop-counter" +"18","monstache" +"18","node-jose" +"18","chamilo-lms" +"18","spotify-desktop" +"18","centrify" +"18","google-cloud-profiler" +"18","ohif" +"18","sp-rename" +"18","google-cloud-network-load-balancer" +"18","locbaml" +"18","moonsharp" +"18","nodebox" +"18","stoplight" +"18","http-trace" +"18","excel-2002" +"18","terser-webpack-plugin" +"18","prometheus-net" +"18","reaction-commerce" +"18","pf-ring" +"18","spectral-clustering" +"18","pf4j" +"18","projekktor" +"18","project-types" +"18","httpretty" +"18","petite-vue" +"18","ios-privacy-settings" +"18","cfwebsocket" +"18","resharper-7.0" +"18","reactive-feign-client" +"18","hex-pm" +"18","google-postmaster" +"18","gnip" +"18","gmongo" +"18","qt-mfc-migration" +"18","mde" +"18","zopim" +"18","amazon-ion" +"18","mssticker" +"18","glue-crawler" +"18","alias-method-chain" +"18","compressed-files" +"18","ember-cli-rails" +"18","maven-plugin-development" +"18","link-checking" +"18","maven-pdf-plugin" +"18","heap-analytics" +"18","google-license-manager" +"18","foldable-devices" +"18","emacs-jedi" +"18","flutter-native" +"18","here-traffic" +"18","maven-package" +"18","maxdb" +"18","hasp" +"18","ember.js-3" +"18","git-sign" +"18","concatenative-language" +"18","mbrola" +"18","concept-insights" +"18","mediabrowser" +"18","bevelled" +"18","media-buttons" +"18","maven-gatling-plugin" +"18","maven-glassfish-plugin" +"18","email-analytics" +"18","mui" +"18","lighthouse-ci" +"18","alternateview" +"18","allen-sdk" +"18","concourse-resource-types" +"18","complex-upset" +"18","multi-camera-api" +"18","concourse-fly" +"18","articulate" +"18","vaadin20" +"18","seam-carving" +"18","tidekit" +"18","sourcegraph" +"18","yui-grids" +"18","webextension-polyfill" +"18","parallel-ssh" +"18","d3pie.js" +"18","solus" +"18","autoproxy" +"18","zio-streams" +"18","autoeventwireup" +"18","search-dialog" +"18","theme-daynight" +"18","cypress-component-testing" +"18","status-register" +"18","startprocessinfo" +"18","shelly" +"18","prefixfree" +"18","dangerous-request" +"18","staticfilehandler" +"18","static-generator" +"18","araxis" +"18","thruk" +"18","tfs-to-tfs-migration-tool" +"18","user-customization" +"18","sdcalertview" +"18","source-server" +"18","particle.io" +"18","shell-trap" +"18","preroll" +"18","endlessadapter" +"18","tidytable" +"18","struts2-s2hibernate" +"18","tilesets" +"18","preconnect" +"18","args4j" +"18","usability-testing" +"18","scrollable-table" +"18","passenger-apache" +"18","medusa" +"18","ms-reports" +"18","securid" +"18","link-to-function" +"18","tpkeyboardavoiding" +"18","stencyl" +"18","autocommand" +"17","annoy" +"17","relative-time-span" +"17","representable" +"17","tensorlayer" +"17","weakly-typed" +"17","ansicon" +"17","jenkins-generic-webhook-trigger" +"17","graphengine" +"17","cjuidialog" +"17","webpart-connection" +"17","jenkins-mstest" +"17","flutter-charts" +"17","stamplay" +"17","clog" +"17","vue3-sfc-loader" +"17","backbone.paginator" +"17","clustal" +"17","primefaces-push" +"17","slather" +"17","telerik-blazor" +"17","xstate-react" +"17","groovlet" +"17","clojure-repl" +"17","ggthemes" +"17","react-native-native-ui-component" +"17","webpack-serve" +"17","skywalking" +"17","primefaces-dataexporter" +"17","default-template-argument" +"17","youku" +"17","defaultstyleddocument" +"17","multiple-cursor" +"17","git-ls-remote" +"17","xtabs" +"17","react-native-pager-view" +"17","treasure-data" +"17","stacktrace.js" +"17","vue-server-renderer" +"17","ckeditor4" +"17","termux-linux" +"17","jaxl" +"17","cl-who" +"17","whmcs-invoice-template" +"17","skrill" +"17","priority-inversion" +"17","squarify" +"17","php-mode" +"17","deepstream" +"17","effector" +"17","list-processing" +"17","photo-management" +"17","jdesktop" +"17","apache-dubbo" +"17","jdk-desugaring" +"17","intel-advisor" +"17","backgroundrb" +"17","wijmo-grid" +"17","interaction-design" +"17","teavm" +"17","grip" +"17","interaction-to-next-paint" +"17","jest-enzyme" +"17","fcbkcomplete" +"17","felgo" +"17","getsystemmetrics" +"17","weak-symbol" +"17","livefyre" +"17","baduk" +"17","anonymous-pipes" +"17","vuetify-loader" +"17","yarn-berry" +"17","wikia" +"17","stackedit" +"17","jemmyfx" +"17","github-advanced-security" +"17","ddlutils" +"17","eddsa" +"17","graphileon" +"17","lisp-2" +"17","flash-10" +"17","function-try-block" +"17","biztalk-services" +"17","function-coverage" +"17","divx" +"17","contentproperty" +"17","imposition" +"17","constraintviolationexception" +"17","api-auth" +"17","pinned-site" +"17","blackberry-torch" +"17","xnet" +"17","fusionreactor" +"17","jsprettier" +"17","imodeljs" +"17","fiware-cep" +"17","overloaded-strings" +"17","contentlayer" +"17","pandapower" +"17","imsl" +"17","incremental-static-regeneration" +"17","celleditingtemplate" +"17","django-activity-stream" +"17","jsonidentityinfo" +"17","financialinstrument" +"17","p8" +"17","unimrcp" +"17","smartview" +"17","snakebite" +"17","imghdr" +"17","pack-uri" +"17","pin-ptr" +"17","kuromoji" +"17","connect-redis" +"17","bindgen" +"17","flannbasedmatcher" +"17","bind2nd" +"17","xip.io" +"17","ftok" +"17","bitmapframe" +"17","pagetabviewstyle" +"17","directus-flows" +"17","bitmapfield" +"17","laravel-environment" +"17","chromebug" +"17","binary-xml" +"17","bitmapeffect" +"17","social-stream" +"17","cdash" +"17","ng-maxlength" +"17","runjettyrun" +"17","rust-language-server" +"17","cheshire" +"17","dawg" +"17","mappath" +"17","ngx-select-dropdown" +"17","datatextfield" +"17","ngreact" +"17","child-objects" +"17","jsweet" +"17","davinci" +"17","jsr299" +"17","chef-client" +"17","adobe-pdf-library" +"17","cbo" +"17","adobe-launch" +"17","ultracombo" +"17","markdowndeep" +"17","ngx-http-rewrite-module" +"17","adium" +"17","socketfactory" +"17","unboundid" +"17","vpi" +"17","carrot" +"17","js-scrollto" +"17","plato" +"17","mapshaper" +"17","chibios" +"17","dateonly" +"17","sentencecase" +"17","ngtools" +"17","adversarial-machines" +"17","vegeta" +"17","angular-load-children" +"17","singer-io" +"17","serverless-stack" +"17","cakephp-helper" +"17","fallbackvalue" +"17","cryptoki" +"17","database-cloning" +"17","camel-spring-dsl" +"17","keyserver" +"17","oracle-cloud-functions" +"17","django-listview" +"17","methodbase" +"17","iclientmessageinspector" +"17","realmrecyclerviewadapter" +"17","oracle-enterprise-linux" +"17","dladdr" +"17","fakexrmeasy" +"17","fakeroot" +"17","windows-95" +"17","microsoft-adal-angular6" +"17","joomla3.8" +"17","data.stackexchange.com" +"17","mysql-error-150" +"17","ibm-pcomm" +"17","windows-build-tools" +"17","metrolog" +"17","real-time-systems" +"17","roots-toolkit" +"17","hypnotoad" +"17","fast-excel" +"17","r-optimization" +"17","uniwebview" +"17","jopendocument" +"17","daru" +"17","creation-pattern" +"17","vdm-sl" +"17","ptrdiff-t" +"17","recent-screens" +"17","windows-embedded-standard" +"17","joy-ui" +"17","ibm-wcm" +"17","rudp" +"17","jpeg-xr" +"17","docker-proxy" +"17","simpletip" +"17","pstcollectionview" +"17","oracle12.2" +"17","unity-remote" +"17","microsoft.office.interop.excel" +"17","kern-invalid-address" +"17","keyboard-python" +"17","crossplane" +"17","jkube" +"17","wait-free" +"17","waitforimages" +"17","keyboard-wedge" +"17","go-xorm" +"17","django-subdomains" +"17","wapiti" +"17","pycorenlp" +"17","gource" +"17","aws-landing-zone" +"17","crossroadsjs" +"17","optaweb-vehicle-routing" +"17","indextank" +"17","wac" +"17","agvtool" +"17","cross-window-scripting" +"17","nastran" +"17","django-supervisor" +"17","warren-abstract-machine" +"17","dojo-1.9" +"17","django-dynamic-scraper" +"17","vash" +"17","go-server" +"17","capedwarf" +"17","akka-dispatcher" +"17","aws-glue3.0" +"17","roassal" +"17","akka-io" +"17","dnsbl" +"17","vuex-module-decorators" +"17","siren" +"17","grafana-agent" +"17","v-btn" +"17","unused-functions" +"17","kendo-draggable" +"17","rsnapshot" +"17","jolie" +"17","joiner" +"17","crunchy-postgresql-operator" +"17","aiokafka" +"17","named-scopes" +"17","fast-ui" +"17","unsafe-unretained" +"17","ruby2d" +"17","ora-01008" +"17","window.crypto" +"17","grails-maven" +"17","mysql-error-1248" +"17","readerquotas" +"17","serviceinstall" +"17","awesome-nested-set" +"17","faults" +"17","docco" +"17","django-floppyforms" +"17","unqlite" +"17","aws-elastictranscoder" +"17","shared-addin" +"17","jquery-selectric" +"17","neo4jrb" +"17","boost-mp11" +"17","swampdragon" +"17","post-format" +"17","postgraphql" +"17","html5-clipboard-api" +"17","bleve" +"17","easyar" +"17","kana" +"17","jwt.io" +"17","design-tokens" +"17","svnx" +"17","k2-blackpearl" +"17","postcss-cli" +"17","apt-key" +"17","nested-fields" +"17","erasure-code" +"17","svnbridge" +"17","internet-explorer-5" +"17","gtk-textbuffer" +"17","jquery-form-wizard" +"17","online-storage" +"17","jquery-mobile-dialog" +"17","tx-dce" +"17","e10s" +"17","sapscript" +"17","twilio-flow" +"17","desktop-background" +"17","bootjack" +"17","oneplustwo" +"17","azure-availability-zones" +"17","mod-speling" +"17","two-step-verification" +"17","swagger-net" +"17","android-virtualdisplay" +"17","azure-batch-account" +"17","onix" +"17","sigv4" +"17","bootsnap" +"17","error-console" +"17","dets" +"17","apple-photos" +"17","bootstrap-confirmation" +"17","silent-post" +"17","turbodbc" +"17","grunt-contrib-coffee" +"17","nrf52840" +"17","applicationwillterminate" +"17","android-scrolling" +"17","ioloop" +"17","opencomputers" +"17","opendolphin" +"17","entity-framework-designer" +"17","jruby-openssl" +"17","dependency-analysis" +"17","inlineuicontainer" +"17","grpc-swift" +"17","workbox-window" +"17","swift-data-modelcontext" +"17","payola" +"17","turi" +"17","passport-github2" +"17","azure-container-app-jobs" +"17","android-sourcesets" +"17","denotational-semantics" +"17","ncqrs" +"17","grunt-ember-templates" +"17","pay-per-click" +"17","aws-site-to-site" +"17","dvi" +"17","dynamiclayout" +"17","tvalue" +"17","nativexml" +"17","kebab-case" +"17","wso2-micro-gateway" +"17","svg-morphing" +"17","easypie" +"17","crc8" +"17","super-linter" +"17","derived-instances" +"17","nsfastenumeration" +"17","boundaries" +"17","bottom-type" +"17","sales-tax" +"17","gulp-uncss" +"17","interruptions" +"17","dynamic-execution" +"17","pclzip" +"17","springloops" +"17","sc.exe" +"17","blue-screen-of-death" +"17","hp-exstream" +"17","moditect" +"17","samsung-internet" +"17","inotify-tools" +"17","ws-i" +"17","scada-ignition" +"17","easy-engine" +"17","blktrace" +"17","application-framework" +"17","polymodel" +"17","virtual-webcam" +"17","amo" +"17","facebook-monetization-manager" +"17","visualstategroup" +"17","javacameraview" +"17","codeigniter-helpers" +"17","frame-grab" +"17","raspistill" +"17",".net-4.0-beta-2" +"17","magic-command" +"17","asynctoken" +"17","reversion" +"17","virtualenv-commands" +"17","codeigniter-pagination" +"17","rational-developer-for-i" +"17","typedjs" +"17","google-chrome-android" +"17","luasec" +"17","windows-wpp" +"17","rethinkdb-ruby" +"17","mifos" +"17","rbenv-gemset" +"17","jasmine-spec-reporter" +"17","macaulay2" +"17",".net-core-authorization" +"17","external-contenttype" +"17","type-switch" +"17","right-mouse-button" +"17","amsmath" +"17","wordbreaker" +"17","mac-roman" +"17","attrs.xml" +"17","accelerated-c++" +"17","coefficient-of-determination" +"17","lynxos" +"17","pypm" +"17","magento-1.12" +"17","buddy.com" +"17","pyrax" +"17","signalfx" +"17","3d-convolution" +"17","shinythemes" +"17","jansi" +"17","android-asynclistdiffer" +"17","woodstock" +"17","cocostudio" +"17","asyncssh" +"17","facebook-litho" +"17","ripcord" +"17","build-chain" +"17",".refresh" +"17","vite-plugin-pwa" +"17","visual-assist-x" +"17","pyre-check" +"17","atoti" +"17","form-generator" +"17","raygun.io" +"17","ocpsoft-rewrite" +"17","shopizer" +"17","dominate" +"17","pygame-mixer" +"17","doophp" +"17","uglifycss" +"17","pygui" +"17","klepto" +"17","kss" +"17","java-synthetic-methods" +"17","known-hosts" +"17","system.json" +"17","viewdeck" +"17","syscache2" +"17","koa.js" +"17","ublock-origin" +"17","minoccurs" +"17","dompi" +"17","do-not-disturb" +"17","donejs" +"17","ocg" +"17","go-github" +"17","uc4" +"17","netadvantage" +"17","lemur" +"17","domain-forwarding" +"17","go-imagick" +"17","librt" +"17","ory-hydra" +"17","nx-angular" +"17","outlook-2011" +"17","nsviewanimation" +"17","xaml-resources" +"17","gcp-config-connector" +"17","dioxus" +"17","cookie-path" +"17","openlayers-8" +"17","openxlsx2" +"17","openmv" +"17","azure-service-fabric-mesh" +"17","screencapturekit" +"17","openstack-python-api" +"17","tiny-core-linux" +"17","nopcommerce-4.2" +"17","numpyro" +"17","dialogbasedapp" +"17","ituneslibrary" +"17","cooliris" +"17","pnunit" +"17","droid-fu" +"17","tangible-t4-editor" +"17","uispec4j" +"17","tiny-slider" +"17","drei" +"17","pocl" +"17","xcode6.3.2" +"17","scout-sass" +"17","pocodynamo" +"17","azure-lab-services" +"17","openwisp" +"17","expect.js" +"17","openstack-api" +"17","mo-cap" +"17","sql-generation" +"17","schemabinding" +"17","mobx-react-form" +"17","hkdf" +"17","nominal-data" +"17","open-search-server" +"17","jacc" +"17","opentools" +"17","tmxtiledmap" +"17","coqui" +"17","uiloader" +"17","sqlbrowser" +"17","spryker" +"17","devextreme-react" +"17","togetherjs" +"17","radpanelbar" +"17","gasp" +"17","ca2202" +"17","gateways" +"17","tabular-editor" +"17","jail-shell" +"17","redstone.dart" +"17","jackson-dataformat-yaml" +"17","hidl" +"17","tabslideout" +"17","higher-order-types" +"17","tktable" +"17","xcode-archive" +"17","expression-encoder-4" +"17","tablib" +"17","number-to-currency" +"17","tlbexp" +"17","copymemory" +"17","nodeselector" +"17","azure-task-groups" +"17","openswoole" +"17","jank" +"17","reg-expressionvalidator" +"17","tcollectionitem" +"17","reference-manual" +"17","haraka" +"17","exception-safe" +"17","dtr" +"17","timeouterror" +"17","vertex-buffer-objects" +"17","itemspresenter" +"17","time-difference" +"17","as-operator" +"17","aspstate" +"17","drupal-alter" +"17","ask-sdk" +"17","pleasewait" +"17","gae-userservice" +"17","tcpportsharing" +"17","verysleepy" +"17","cadquery" +"17","geany-plugin" +"17","gameanalytics" +"17","dialogviewcontroller" +"17","cakefile" +"17","asp.net-core-security" +"17","referential" +"17","q-value" +"17","asp.net-mail" +"17","sqlprofileprovider" +"17","cadence-virtuoso" +"17","itemcollection" +"17","omniverse" +"17","o-d-matrix" +"17","ldc" +"17","cgpathref" +"17","node-glob" +"17","pep3118" +"17","laravel-telescope" +"17","node-deasync" +"17","node-dev" +"17","lazyeval" +"17","leantween" +"17","resty" +"17","eurekalog" +"17","requests-per-second" +"17","ios-contacts" +"17","certificate-signing-request" +"17","espruino" +"17","event-calendar" +"17","iphone7plus" +"17","reservoir-sampling" +"17","response.addheader" +"17","reset-button" +"17","evented-io" +"17","nim-game" +"17","ogdf" +"17","pftableviewcell" +"17","es6-shim" +"17","pfsubclassing" +"17","ninject-3" +"17","ios-messages-extension" +"17","lavaplayer" +"17","chart-director" +"17","curvycorners" +"17","spreedly" +"17","qf-test" +"17","elevatr" +"17","melt-framework" +"17","mosso" +"17","spip" +"17","curvesmoothing" +"17","react-loading-skeleton" +"17","coldfusion-administrator" +"17","stratum" +"17","hyperas" +"17","actorsystem" +"17","moor" +"17","prototype-oriented" +"17","qabstractbutton" +"17","color-tracking" +"17","curtains.js" +"17","terraform-provider-datadog" +"17","acme.sh" +"17","current-principal" +"17","comautomationfactory" +"17","currencymanager" +"17","qdrantclient" +"17","morphline" +"17","mootools-fx" +"17","curlftpfs" +"17","httpfilecollection" +"17","android-restrictions" +"17","android-licenses" +"17","morea-framework" +"17","cua-mode" +"17","dukpt" +"17","google-friend-connect" +"17","elasticsearch-java-api-client" +"17","zxing.net.mobile" +"17","property-testing" +"17","react-button" +"17","qqmllistproperty" +"17","mercurial-revsets" +"17","getclientrect" +"17","common-code" +"17","getconstructor" +"17","logistf" +"17","test-fixture" +"17","lockup" +"17","ternary-search" +"17","log4postsharp" +"17","testinfra" +"17","httptestingcontroller" +"17","metamug" +"17","seandroid" +"17","zeta-components" +"17","parboiled2" +"17","stubby4j" +"17","automapper-11" +"17","cypress-task" +"17","identity-operator" +"17","msloadtest" +"17","std-system-error" +"17","media-keys" +"17","msbuild-buildengine" +"17","lightadmin" +"17","maven-frontend-plugin" +"17","webapplicationstresstool" +"17","gnucash" +"17","google-sheets-vlookup" +"17","git-sync" +"17","sdv" +"17","msbuild-projectreference" +"17","webcontext" +"17","bernoulli-numbers" +"17","automapper-7" +"17","tile-engine" +"17","argo-rollouts" +"17","steam-condenser" +"17","gnulib" +"17","autoexec" +"17","url-protocol" +"17","amazon-clouddrive" +"17","ieditableobject" +"17","hatchstyle" +"17","hd44780" +"17","touchescancelled" +"17","styleable" +"17","havok" +"17","gmisc" +"17","sharppdf" +"17","mdm-zinc" +"17","paseto" +"17","structural-equality" +"17","automatic-speech-recognition" +"17","user-config" +"17","automatic-migration" +"17","solr4j" +"17","stdcopy" +"17","link-prefetch" +"17","bazaar-plugins" +"17","quarkus-kafka" +"17","zoneminder" +"17","confidential" +"17","bazel-gazelle" +"17","toolstripcombobox" +"17","bento" +"17","uu-parsinglib" +"17","linpack" +"17","bazel-query" +"17","sum-type" +"17","array-flip" +"17","bengali" +"17","zola" +"17","sparkfun" +"17","ember.select" +"17","linewidth" +"17","dart-build" +"17","fmj" +"17","compss" +"17","qstk" +"17","font-awesome-3.2" +"17","arc2" +"17","for-await" +"17","bencoding" +"17","zkp" +"17","qstringlistmodel" +"17","globus-toolkit" +"17","user-messaging-platform" +"17","pressflow" +"17","danger" +"17","the-amazing-audio-engine" +"17","webinar" +"17","spark-skinning" +"17","tiers" +"17","autodesk-data-visualization" +"17","damerau-levenshtein" +"17","papaya" +"17","emsdk" +"17","dailybuilds" +"17","theme-development" +"17","query-engine" +"17","starcounter" +"17","ilookup" +"17","sugar.js" +"17","userland" +"17","glowscript" +"17","d3tree" +"17","ember-cp-validations" +"17","d3-graphviz" +"17","tika-python" +"16","anthropic" +"16","groove" +"16","pg-notify" +"16","babel-plugin-module-resolver" +"16","wear-os-tiles" +"16","clojure-testing" +"16","jbchartview" +"16","react-native-tvos" +"16","skfieldnode" +"16","fieldmanager" +"16","groovysh" +"16","phassetslibrary" +"16","cloud-pak-for-data" +"16","mutablecapabilities" +"16","cloudpickle" +"16","file-forks" +"16","vue-cookies" +"16","maven-1" +"16","maturity" +"16","matterport" +"16","matio" +"16","groupie" +"16","react-phone-number-input" +"16","apache-druid" +"16","clpq" +"16","yjs" +"16","photon-fusion" +"16","clpr" +"16","sized-box" +"16","back-projection" +"16","mxchip" +"16","vue-strap" +"16","vue-socket.io" +"16","yolonas" +"16","clusterize" +"16","clsx" +"16","github-classroom" +"16","slider-revolution" +"16","flutter-floor" +"16","integerupdown" +"16","github-check-run" +"16","report-viewer2016" +"16","trifecta" +"16","trifacta" +"16","tridion-core-services" +"16","littler" +"16","srilm" +"16","xshell" +"16","fenv" +"16","feel-language" +"16","remap-istanbul" +"16","gremlin-java" +"16","square-wire" +"16","fdr" +"16","multipart-alternative" +"16","fedora-29" +"16","ggbreak" +"16","flowgorithm" +"16","remodal" +"16","decision-model-notation" +"16","multipartconfig" +"16","wijgrid" +"16","annotorious" +"16","installshield-2008" +"16","relate" +"16","graphql-java-tools" +"16","list-template" +"16","trng" +"16","ecmascript-2021" +"16","wexitstatus" +"16","decap-cms" +"16","wevtutil" +"16","remote-client" +"16","remote-connections" +"16","skylark" +"16","remote-input" +"16","load-generator" +"16","floating-action-menu" +"16","renderman" +"16","tsup" +"16","anormcypher" +"16","default-package" +"16","graphql-spring-boot" +"16","default-initialization" +"16","smalot-datetimepicker" +"16","treecell" +"16","weed-fs" +"16","fhir-net-api" +"16","yattag" +"16","jsmin" +"16","fileparse" +"16","flang" +"16","appcelerator-cli" +"16","piral" +"16","pageloadtimeout" +"16","apache-spark-1.3" +"16","consoleappender" +"16","ladon" +"16","finger-tree" +"16","xqilla" +"16","playhaven" +"16","xnat" +"16","nexus-player" +"16","nhibernate-4" +"16","afbedsheet" +"16","main-bower-files" +"16","immediate-attribute" +"16","flashmedialiveencoder" +"16","image-translation" +"16","flask-apispec" +"16","pinterest-api" +"16","cassini-dev" +"16","pagedcollectionview" +"16","bing-webmaster-tools" +"16","laravel-encryption" +"16","ngondestroy" +"16","mark.js" +"16","cimage" +"16","castle-windsor-3" +"16","voice-detection" +"16","swipe.js" +"16","software-estimation" +"16","overridependingtransition" +"16","casyncsocket" +"16","ngx-international-phone-number" +"16","flesch-kincaid" +"16","pigeon" +"16","contactgroups" +"16","aegir" +"16","socketio4net" +"16","flask-user" +"16","pixman" +"16","sencha-test" +"16","swrlapi" +"16","adsense-anchor-ads" +"16","addmodelerror" +"16","ngx-clipboard" +"16","safariwatir" +"16","smartmeter" +"16","ngsw-config" +"16","firewall-access" +"16","adaptive-dialogs" +"16","picat" +"16","mapguide" +"16","python-fire" +"16","conkeror" +"16","chiliproject" +"16","selectonelistbox" +"16","cdatabase" +"16","ng2-tag-input" +"16","direct-runner" +"16","directorystream" +"16","chinese-postman" +"16","jtest" +"16","python-arrow" +"16","ng-img-crop" +"16","python-iptables" +"16","undici" +"16","cctexturecache" +"16","disposing" +"16","fundamental-matrix" +"16","api-linkpreview" +"16","umbraco-forms" +"16","jsr363" +"16","unirest-java" +"16","ng2-google-chart" +"16","plasmo" +"16","django-cookies" +"16","seleniummanager" +"16","xmlignore" +"16","paintbox" +"16","selectboxit" +"16","xmonad-contrib" +"16","adobe-bridge" +"16","functx" +"16","circular-slider" +"16","jsonx" +"16","xmltransient" +"16","kyma" +"16","unite.vim" +"16","fixup" +"16","ada95" +"16","datetimeparseexception" +"16","swift-regexbuilder" +"16","python-module-unicodedata" +"16","aiven" +"16","microsoft-graph-cloudcommunications" +"16","valdr" +"16","canoo" +"16","window-size" +"16","pycxx" +"16","urchin" +"16","ora-01830" +"16","canvas3d" +"16","kendo-splitter" +"16","dockable-windows" +"16","kendo-timepicker" +"16","ops4j" +"16","prunsrv" +"16","ps2exe-gui" +"16","pusherswift" +"16","alexa-account-linking" +"16","readstata13" +"16","validating-event" +"16","read-fwf" +"16","nakama" +"16","value-of-css-property" +"16","ruby-style-guide" +"16","puppetlabs-mysql" +"16","ora-01000" +"16","updatedate" +"16","ora-00955" +"16","akka-zeromq" +"16","reasoned-schemer" +"16","kitty" +"16","facebook-widgets" +"16","simplyscroll" +"16","ora-00913" +"16","kint" +"16","r-promises" +"16","sipml5" +"16","ora-12541" +"16","pubmed-api" +"16","wall-time" +"16","ahp" +"16","r-mapedit" +"16","keycloak-authorization-services" +"16","keycloak-javascript" +"16","goproxy" +"16","wasp" +"16","docx-to-pdf-conversion" +"16","gradle-properties" +"16","aws-mediaservices" +"16","robotframework-browser" +"16","grafana-mimir" +"16","django-packages" +"16","aggregators" +"16","servlet-4" +"16","mysql-error-1046" +"16","service-virtualization" +"16","sharepoint-listtemplate" +"16","document-types" +"16","meta-title" +"16","servicemodelex" +"16","django-multiselectfield" +"16","fast-xml-parser" +"16","meteor-easy-search" +"16","watson-virtual-agent" +"16","ibm-installation-manager" +"16","database-reconciliation" +"16","jooby" +"16","crictl" +"16","keystore-access" +"16","keyword-expansion" +"16","ibm-rad-7.5" +"16","document-based-database" +"16","ropc" +"16","joox" +"16","keyword-spotting" +"16","camel-blueprint" +"16","camel-jdbc" +"16","jpanelmenu" +"16","windows-mui" +"16","mysqlrouter" +"16","faraday-oauth" +"16","vector-class-library" +"16","mysql-error" +"16","docksal" +"16","mysql-regexp" +"16","jpf" +"16","sequelize-hooks" +"16","docsy" +"16","mysqlpp" +"16","awscognitotoken" +"16","microsoft-expression" +"16","rosters" +"16","htsql" +"16","in-memory-oltp" +"16","bluetooth-keyboard" +"16","payeezy" +"16","nb-iot" +"16","interspire-shopping-cart" +"16","pdf2json" +"16","spring-content-community-project" +"16","ionic2-providers" +"16","springdoc-openapi-maven-plugin" +"16","awtutilities" +"16","nest-winston" +"16","simevents" +"16","mod-lua" +"16","defn" +"16","power-apps-custom-connector" +"16","oneget" +"16","blog-post" +"16","android-tabstrip" +"16","wwan" +"16","initializr" +"16","postgresapp" +"16","onrowclick" +"16","opencyc" +"16","azure-ad-domain-services" +"16","android-wear-3.0" +"16","htmlwriter" +"16","jqpagination" +"16","near-cache" +"16","silverlight-embedded" +"16","bluedata" +"16","internetsetoption" +"16","android-studio-flamingo" +"16","gsubfn" +"16","blockhound" +"16","jquery-datatables-checkboxes" +"16","karma-typescript" +"16","blkid" +"16","initwithframe" +"16","dev-appserver-2" +"16","paytabs" +"16","bluno" +"16","grunt-exec" +"16","svg-react-loader" +"16","jquery-context" +"16","two-phase-commit" +"16","postgresql-8.1" +"16","mod-pywebsocket" +"16","ncommon" +"16","salesforce-rest-api" +"16","htmltable-control" +"16","kairos-api" +"16","application-monitoring" +"16","salesforce-sfdx" +"16","dvajs" +"16","monero" +"16","scalaj-http" +"16","hostvars" +"16","workdir" +"16","sbt-docker" +"16","corrupted-state-exception" +"16","azure-devops-artifacts" +"16","twentytwenty" +"16","satellite-navigation" +"16","infyom" +"16","couchbase-ottoman" +"16","cppdepend" +"16","nsincrementalstore" +"16","mongo-connector" +"16","mongolian-vertical-script" +"16","tuist" +"16","couchbase-nodejs-sdk" +"16","corepack" +"16","hostheader" +"16","gulp-changed" +"16","bounds-check-elimination" +"16","desktop-recording" +"16","native-maven-plugin" +"16","twilio-autopilot" +"16","epd-python" +"16","worksite-sdk" +"16","entity-framework-4.3.1" +"16","boost-sml" +"16","spring-internationalization" +"16","jquery-lint" +"16","entra" +"16","azure-dev-spaces" +"16","nsmutableorderedset" +"16","neo4j-php-ogm" +"16","neo4j-plugin" +"16","easylogging++" +"16","tuprolog" +"16","syscache" +"16","cocoapods-1.2" +"16","mailgun-api" +"16","shoryuken" +"16","codepad" +"16","javapolicy" +"16","pytest-selenium" +"16","shouldautorotate" +"16","significant-terms" +"16","vip" +"16","browserify-rails" +"16","kronos-workforce-central" +"16","object-equality" +"16","macos-mail-app" +"16","reverting" +"16","code-regions" +"16","mageia" +"16","out-of-source" +"16","misuse" +"16","knockout-es5-plugin" +"16","cocos2d-swift" +"16","mini-xml" +"16","mindsphere" +"16","f#+" +"16","typescript3.8" +"16","occurs-check" +"16","ramda-fantasy" +"16","kotlinx.coroutines.channels" +"16","kotlin-when" +"16","object-state" +"16","amos" +"16","mission-planner" +"16","riak-ts" +"16","vis-timeline" +"16","pyfilesystem" +"16","rancheros" +"16","oberon" +"16","javax-validation" +"16","shape-rendering" +"16","overlap2d" +"16","facebook-ios-sdk-4.0" +"16","kotlin-function-type" +"16","typescript2.3" +"16","lxc-docker" +"16","f#-4.0" +"16","raw-file" +"16","abcl" +"16","rethinkdbdash" +"16","reviver-function" +"16","dolby-audio-api" +"16","ordered-set" +"16","authorization-header" +"16","asyncimageview" +"16","leda" +"16","oai-pmh" +"16","sfc" +"16","atlassian-forge" +"16","libfaac" +"16","android-api-33" +"16","viewdraghelper" +"16","netcobol" +"16","google-barchart" +"16","android-appstandby" +"16","wordpress-4.5.2" +"16","ubuntu-19.10" +"16","revokeobjecturl" +"16","vim-ale" +"16","vimclojure" +"16","rgtk2" +"16","amazon-translate" +"16","synopsis-detect" +"16","rich-media" +"16","java-vertx-web" +"16","pygmaps" +"16","objective-git" +"16","google-ajax-libraries" +"16","rhinoceros" +"16","netlib" +"16","pygbag" +"16","rawurl" +"16","dom-if" +"16","neura" +"16","libstrophe" +"16","libspatialindex" +"16","javafx-bindings" +"16","nokia-wrt" +"16","exchange-server-2019" +"16","taglet" +"16","registry-virtualization" +"16","wxstring" +"16","isuserinteractionenabled" +"16","askql" +"16","contextio" +"16","jabberd2" +"16","radphp" +"16","high-level-architecture" +"16","polykinds" +"16","xcore" +"16","histogram-of-oriented-gradients" +"16","rad-server" +"16","azure-workflow-automation" +"16","nuget-package-manager-console" +"16","holoeverywhere" +"16","node-uuid" +"16","scnvector3" +"16","cordite" +"16","redis-rails" +"16","npm-private-modules" +"16","hg-log" +"16","vgo" +"16","dotnet-new" +"16","azure-web-app-firewall" +"16","hashtree" +"16","hashrocket" +"16","control-charts" +"16","expression-body" +"16","quickjs" +"16","nvidia-isaac" +"16","spritely" +"16","convector" +"16","quicksilver" +"16","gatsby-cloud" +"16","spriteview" +"16","asp.net-core-css-isolation" +"16","bulk-create" +"16","refinitiv-eikon-api" +"16","drupal-distributions" +"16","control-library" +"16","dev-tunnels" +"16","ref-parameters" +"16","openstack-juno" +"16","mkmapcamera" +"16","asp.net-mvc-migration" +"16","plsql-psp" +"16","gcp-notebook" +"16","notificationlistenerservice" +"16","iso-639" +"16","xamlx" +"16","hookrouter" +"16","gcp-compute-instance" +"16","plunit" +"16","drupal-zen" +"16","hipe" +"16","itrs" +"16","drwatson" +"16","redex" +"16","gamesalad" +"16","nsxmlparserdelegate" +"16","tolua++" +"16","iso8583-1993" +"16","sched-deadline" +"16","openinfowindowhtml" +"16","azure-service-plan" +"16","ntfs-3g" +"16","rabbitmq-stream" +"16","plotly.net" +"16","digital-handwritting" +"16","droidparts" +"16","scrapy-item" +"16","digital-downloads" +"16","modbus-rtu-over-tcp" +"16","gameclosure" +"16","redux-selector" +"16","dry-validation" +"16","plnkr.co" +"16","nuget-package-explorer" +"16","business-application" +"16","android-compound-view" +"16","xcf" +"16","digestive-functors" +"16","nuget-cli" +"16","isolated-scope" +"16","double-brace-initialize" +"16","scorm-cloud-api" +"16","openrtsp" +"16","tokenize2" +"16","context-info" +"16","wxmathplot" +"16","open-webkit-sharp" +"16","cube-dimension" +"16","montgomery-multiplication" +"16","react-laravel" +"16","responsive-nav" +"16","lazycache" +"16","esp-now" +"16","mercury-mta" +"16","onactionexecuted" +"16","layout-xml" +"16","collaboration-diagram" +"16","spinwait" +"16","ctabitem" +"16","elasticsearch-bulk" +"16","message-authentication-code" +"16","offline.js" +"16","launch-time" +"16","elastic-mq" +"16","metacello" +"16","comint-mode" +"16","cfnetworking" +"16","iriscouch" +"16","restlet-2.3.1" +"16","angular-dynamic-forms" +"16","iron-form" +"16","commerceserver2007" +"16","python-winshell" +"16","elaboration" +"16","react-native-datetimepicker" +"16","spectacle" +"16","angular-abstract-control" +"16","perlapp" +"16","node-repl" +"16","log4shell" +"16","httpsys" +"16","requiressl" +"16","periodformatter" +"16","lock-guard" +"16","zuul-ci" +"16","node-odbc" +"16","eway" +"16","lolcode" +"16","accessibility-inspector" +"16","string-metric" +"16","loopback3" +"16","everlive" +"16","string-catalog" +"16","stretchdibits" +"16","loose-typing" +"16","loupe" +"16","httpconfiguration" +"16","acitree" +"16","ios9-today-widget" +"16","streaminghttpresponse" +"16","google-cloud-language" +"16","ls-colors" +"16","google-cloud-instances" +"16","odfdom" +"16","google-cloud-cpp" +"16","event-b" +"16","ios-searchapi" +"16","elinks" +"16","mellon" +"16","evc4" +"16","evaporate.js" +"16","element-binding" +"16","memory-overcommitment" +"16","monocle" +"16","acts-as-follower" +"16","cups4j" +"16","qdoc" +"16","cumulative-distribution-function" +"16","android-navhostfragment" +"16","android-ndk-r4" +"16","android-pagedlistview" +"16","cuda.net" +"16","certreq" +"16","qcommandlineparser" +"16","einops" +"16","chart.js-datalabels" +"16","proofs" +"16","chartpanel" +"16","character-reference" +"16","spa-template" +"16","duckduckgo-api" +"16","nmock2" +"16","prose" +"16","moxiemanager" +"16","text-mask" +"16","laravel-sitemap" +"16","project-server-2007" +"16","protected-resource" +"16","tomcat-juli" +"16","nixops" +"16","geometrydrawing" +"16","get-filehash" +"16","getpwuid" +"16","spec#" +"16","protector" +"16","cgihttpserver" +"16","iroutehandler" +"16","prolog-defaulty" +"16","moss2007enterprisesearch" +"16","cgpdfscanner" +"16","getschematable" +"16","step-through" +"16","ember-validations" +"16","mcedit" +"16","seamless-immutable" +"16","tpersistent" +"16","searchable-dropdown" +"16","glcanvas" +"16","hedera" +"16","sonarqube7" +"16","amazon-sagemaker-debugger" +"16","static-dispatch" +"16","stingray" +"16","tidyterra" +"16","fluture" +"16","as-if" +"16","benfords-law" +"16","mrv2" +"16","imagedecoder" +"16","presenceinsights" +"16","scrolltoindex" +"16","stig" +"16","ascii85" +"16","maven-wrapper" +"16","ember-paper" +"16","bert-toolkit" +"16","heatwave" +"16","mca" +"16","bemsimplelinegraph" +"16","google-sheets-charts" +"16","sonarqube-4.0" +"16","sdef" +"16","power-state" +"16","lifetimes-python" +"16","torchmetrics" +"16","thoughtbot" +"16","sourceanalyser" +"16","embedded-coder" +"16","lightning-network" +"16","pgmagick" +"16","medial-axis" +"16","subtext" +"16","quantified-constraints" +"16","user-instance" +"16","flutter-path" +"16","d3-cloud" +"16","autotouch" +"16","ziggy" +"16","userjs" +"16","iiviewdeckcontroller" +"16","bcolz" +"16","mediaplayerelement" +"16","msstickerview" +"16","google-jax" +"16","google-instant" +"16","forcing" +"16","dangling-else" +"16","google-health" +"16","dapper-fluentmap" +"16","imagehandler" +"16","alire" +"16","znodes" +"16","weblogic-maven-plugin" +"16","batch-fetching" +"16","multi-database-connections" +"16","user-secret" +"16","uthash" +"16","fontspec" +"16","solid-start" +"16","stdbool" +"16","linkurious" +"16","quarkus-hibernate-orm" +"16","tools-for-apache-cordova" +"16","sharpen-tool" +"16","subsonic-simplerepository" +"16","bfloat16" +"16","beef" +"16","user-extensions.js" +"16","customstringconvertible" +"16","argument-matching" +"16","compiler-compiler" +"16","embla-carousel" +"16","arduino-uno-wifi" +"16","argp" +"16","webby" +"16","transactional-database" +"16","zend-session-namespace" +"16","help-authoring" +"16","sharpffmpeg" +"16","partial-sort" +"16","emf-compare" +"16","sortcomparefunction" +"16","google-persistent-disk" +"16","partitioned-view" +"16","state-dict" +"16","cvsimport" +"16","helpshift" +"15","gitlab-ci-trigger" +"15","graphql-mesh" +"15","graphql-relay" +"15","badboy" +"15","react-oidc" +"15","term-vectors" +"15","vue-slider-component" +"15","xt" +"15","xtea" +"15","render-html" +"15","backup-agent" +"15","reporting-services-map" +"15","mvxlistview" +"15","flutter-beamer" +"15","cluster-manager" +"15","terminate-handler" +"15","mxnet-gluon" +"15","tensorflow-android" +"15","jaxer" +"15","mat-chip" +"15","efpocoadapter" +"15","eframe" +"15","ghc-pkg" +"15","tenacity" +"15","phplot" +"15","ghcjs-dom" +"15","mat-drawer" +"15","weld-junit5" +"15","git2-rs" +"15","inspect.exe" +"15","treestore" +"15","stagewebviewbridge" +"15","git-assume-unchanged" +"15","git-authentication" +"15","inspinia" +"15","react-native-instagram-login" +"15","git-completion" +"15","ggnewscale" +"15","ballerina-composer" +"15","ssis-data-flow" +"15","material-swift" +"15","websphere-ce" +"15","cloud-haskell" +"15","git-dangling" +"15","instantmessenger" +"15","transform-stream" +"15","cloudkit-js" +"15","sitemapnode" +"15","website-metrics" +"15","trezor" +"15","stanford-parser" +"15","file-icons" +"15","srv-record" +"15","gexperts" +"15","integer-hashing" +"15","terminal-ide" +"15","sqwrl" +"15","fcgid" +"15","fciv" +"15","cmultifileupload" +"15","relevanssi" +"15","loaderlock" +"15","dbms-xmlgen" +"15","ansible-pull" +"15","background-clip" +"15","react-simple-keyboard" +"15","c-mode" +"15","tsavedialog" +"15","teamcity-6" +"15","gridding" +"15","yammer-api" +"15","ddpg" +"15","react-pose" +"15","ckshare" +"15","livedocx" +"15","teamstudio-unplugged" +"15","v-stepper" +"15","react-sidebar" +"15","ckrecordzone" +"15","yahoo-search" +"15","phonegap-admob" +"15","preverify" +"15","jersey-3.0" +"15","yii-cformmodel" +"15","eclipse-2020-06" +"15","dbimport" +"15","lita" +"15","cmaltimeter" +"15","eclipse-fragment" +"15","jdic" +"15","fedora-28" +"15","localsocket" +"15","slimselect" +"15","listof" +"15","vssconverter" +"15","baseweb" +"15","llrp" +"15","debian-7.6.0" +"15","cm" +"15","matplotlib.mlab" +"15","llvm-4.0" +"15","mvvmfx" +"15","class-dbi" +"15","ansys-apdl" +"15","mvw" +"15","xtraeditors" +"15","discord-rpc" +"15","funcunit" +"15","ngx-gallery" +"15","firrtl" +"15","picaxe" +"15","filevault" +"15","sygic-mobile-sdk" +"15","runtime-identifier" +"15","safe-bool-idiom" +"15","vndocumentcameraviewcontroller" +"15","fishtown-analytics" +"15","django-2.x" +"15","python-lru-cache" +"15","owl-date-time" +"15","runtimemodification" +"15","flask-smorest" +"15","jsvalidation" +"15","jsonlogic" +"15","python-fabric-2" +"15","python-pex" +"15","picamera2" +"15","cifacefeature" +"15","black-code-formatter" +"15","swipecardview" +"15","python-decimal" +"15","cifar100" +"15","xmlupdate" +"15","cardspace" +"15","adornment" +"15","cardscrollview" +"15","fitvids" +"15","volta" +"15","django-auditlog" +"15","python-bleak" +"15","image-science" +"15","kubernetes-dns" +"15","laravel-airlock" +"15","django-cache-machine" +"15","language-studio" +"15","smartsheet-c#-sdk-v1" +"15","cassandra-stress-tool" +"15","snowboy" +"15","datastax-csharp-driver" +"15","rule-of-zero" +"15","mail-mime" +"15","jsgauge" +"15","flambo" +"15","imports-loader" +"15","xml-error" +"15","rust-rustlings" +"15","mailsystem.net" +"15","picqer-exact-php-client" +"15","firebase-genkit" +"15","fizzler" +"15","flag-secure" +"15","map-basic" +"15","jsr172" +"15","configuration-as-code" +"15","dirtyrectangle" +"15","packetdotnet" +"15","selectcheckboxmenu" +"15","semicolon-inference" +"15","undecidable-instances" +"15","pact-python" +"15","apache-marmotta" +"15","nexus-5x" +"15","page-loading-message" +"15","xinu" +"15","next-translate" +"15","player-stage" +"15","cedar-bdd" +"15","fileresponse" +"15","sendable" +"15","symfony-config-component" +"15","pamie" +"15","page-flow" +"15","apertium" +"15","unifiednativeadview" +"15","synced-folder" +"15","pidcrypt" +"15","django-environ" +"15","unreal-gameplay-ability-system" +"15","windows-sbs" +"15","awesome-typescript-loader" +"15","r-shinylive" +"15","unsemantic-css" +"15","varint" +"15","carbon-components" +"15","car-analogy" +"15","grafana-plugin" +"15","mysema" +"15","keybase" +"15","angular-pagination" +"15","vue-tsc" +"15","canjs-component" +"15","react-to-pdf" +"15","react-templates" +"15","oraclejdk" +"15","py-amqplib" +"15","aiobotocore" +"15","robobinding" +"15","jgiven" +"15","gradle-node-plugin" +"15","sis" +"15","gradle-managed-device" +"15","ruby-kafka" +"15","gradle-kts" +"15","windows-live-mail" +"15","update-post-meta" +"15","jqote" +"15","ruby-characters" +"15","oracle-home" +"15","crowdflower" +"15","wildfly-21" +"15","gradle-2" +"15","jiffy" +"15","optical-drive" +"15","iactivescript" +"15","uprobe" +"15","mysql-error-1075" +"15","mysql-error-1071" +"15","govmomi" +"15","wagtail-pageurl" +"15","gpudirect" +"15","dmcs" +"15","gpu-cooperative-groups" +"15","alfresco-ldap" +"15","pycountry-convert" +"15","jitcode-jitcdde-jitcsde" +"15","sitecore-habitat" +"15","jjs" +"15","canonical-name" +"15","wcf-rest-starter-kit" +"15","mfe" +"15","reassign" +"15","face-landmark" +"15","ibook-author" +"15","rpscreenrecorder" +"15","oracle8" +"15","ruby-upgrade" +"15","simulte" +"15","dashclock" +"15","publisher-policy" +"15","rubyinstaller" +"15","puppet-bolt" +"15","roofline" +"15","wbr" +"15","keras-vggface" +"15","fandjango" +"15","fastinfoset" +"15","metric-fu" +"15","kinetica" +"15","publify" +"15","joml" +"15","mic-1" +"15","rodio" +"15","public-fields" +"15","hyperledger-cello" +"15","nag-fortran" +"15","ruby-1.9.1" +"15","oracle-bpm-suite" +"15","creators-update" +"15","i18next-browser-languagedetector" +"15","ptv-developer" +"15","service-level-agreement" +"15","simpl-schema" +"15","recent-documents" +"15","cspack" +"15","service-operations" +"15","wcf-faults" +"15","rubocop-rspec" +"15","ics-openvpn" +"15","service-pack" +"15","kingsoft" +"15","aws-jwt-authorizer" +"15","push-queue" +"15","jpicker" +"15","farpoint" +"15","datadesign" +"15","ibm-eventstreams" +"15","turtle-mock" +"15","nsdatecomponent" +"15","app-search" +"15","ionic-native-http" +"15","kefir.js" +"15","nested-tibble" +"15","sus" +"15","tymon-jwt" +"15","corporate-policy" +"15","tutum" +"15","azure-eventhub-client" +"15","depth-camera" +"15","svgz" +"15","ionic-serve" +"15","ionic-material" +"15","nativescript-codesharing" +"15","jquery-rotate" +"15","htc-hero" +"15","dynamics-sl" +"15","invalidselectorexception" +"15","mojo-sdk" +"15","dynamic-dll-import" +"15","openacs" +"15","dynamic-expresso" +"15","android-tablet-layout" +"15","tvar" +"15","twemoji" +"15","ephesoft" +"15","design-data" +"15","aws-sftp" +"15","dynamic-schema" +"15","kcov" +"15","samsung-galaxy-watch" +"15","demand-paging" +"15","gulp-shell" +"15","grover" +"15","inheritdoc" +"15","nsight-systems" +"15","appixia" +"15","typedactor" +"15","swift-for-tensorflow" +"15","pdc" +"15","wowslider" +"15","juicy-pixels" +"15","enzyme-to-snapshot" +"15","postgresql-parallel-query" +"15","opalvoip" +"15","infomaker" +"15","opaleye" +"15","nest-dynamic-modules" +"15","scala-2.7" +"15","mongodb-security" +"15","ncml" +"15","easy-modbus" +"15","kata-containers" +"15","bottleneck" +"15","covr" +"15","grunt-build-control" +"15","mod-userdir" +"15","mod-verto" +"15","nested-gridview" +"15","deftjs" +"15","nerves-project" +"15","jxtaskpane" +"15","modulino" +"15","blazor-webapp" +"15","model-inheritance" +"15","swa-cli" +"15","k0s" +"15","path.js" +"15","boost-type-erasure" +"15","opencv-features2d" +"15","sap-solution-manager" +"15","mongoose-auto-increment" +"15","desktop-integration" +"15","navigateuri" +"15","jquery-mobile-fieldset" +"15","entity-framework-6.4" +"15","deploy-keys" +"15","cpm" +"15","grunt-contrib-compress" +"15","module-alias" +"15","mongokitten" +"15","wumpus-world" +"15","host-object" +"15","dynogels" +"15","html-compression" +"15","apple-help" +"15","azure-ddos" +"15","bootstrap-4.1.x" +"15","popupcontrolextender" +"15","positive-lookbehind" +"15","openbadge" +"15","east-text-detector" +"15","kaizala-action" +"15","jquery-reel" +"15","bpmn-js" +"15","block-programming" +"15","blu-ray" +"15","countly-analytics" +"15","jupyter-widget" +"15","inline-table-function" +"15","injective-function" +"15","desktopcapturer" +"15","bootstrap-native" +"15","coreos-ignition" +"15","spring-integration-jdbc" +"15","deoptimization" +"15","ara" +"15","entitykey" +"15","neoclipse" +"15","gulp-load-plugins" +"15","justin.tv" +"15","milter" +"15","f#-charting" +"15","winlibs" +"15","kotlin-experimental" +"15","jasperstarter" +"15","bronto" +"15","typeinitializer" +"15","libdc1394" +"15","ordercloud" +"15","r-devtools" +"15","shopee" +"15","kognitio" +"15","netmodules" +"15","windward" +"15","shakapacker" +"15","rational-test-workbench" +"15","javax.swing.text" +"15","signed-overflow" +"15","buddy-class" +"15","rapier-3d" +"15","amoeba-gem" +"15","setpropertyactionlistener" +"15","amazon-workdocs" +"15","milton" +"15","retained-in-memory" +"15","windows-subsystem-for-android" +"15","lwuit-dialog" +"15","rawbytestring" +"15","java-22" +"15","bufferunderflowexception" +"15","libcst" +"15","signal-protocol" +"15","win-prolog" +"15","ami.js" +"15","audeering-opensmile" +"15","pygraph" +"15","rdf-star" +"15","r-doredis" +"15","netbeans-15" +"15","code-intelligence" +"15","typerex" +"15","typedi" +"15","format-currency" +"15","ocamldoc" +"15","kooboo" +"15","audioworkletprocessor" +"15","code-testing" +"15","migx" +"15","rfc6749" +"15","libudev" +"15","java-process-runtime" +"15","javaexec-gradle-plugin" +"15","fabric-answers" +"15","freefair-aspectj" +"15","analytics-for-hadoop" +"15","r-box" +"15","free-diameter" +"15","aurelia-store" +"15","microsoft-machine-learning-server" +"15","wkhttpcookiestore" +"15","typescript-namespace" +"15","golfscript" +"15","external-assemblies" +"15","nxjs" +"15","pykde" +"15","winui-xaml" +"15","foundry-scenarios" +"15","pysmt" +"15","pysocks" +"15","express-winston" +"15","facebook-conceal" +"15","dolphin-smalltalk" +"15","express-ws" +"15","android-asset-delivery" +"15","objectivezip" +"15","authlogic-oauth" +"15","android-appwidget-list" +"15","nevron" +"15","kuali" +"15","synset" +"15","otroslogviewer" +"15","javahg" +"15","least-astonishment" +"15","uiaccessoryview" +"15","java-micro-editon-sdk3.0" +"15","obscured-view" +"15","mincemeat" +"15","rfc1035" +"15","dollar-quoting" +"15","viewpoint" +"15","mahjong" +"15","objectpath" +"15","cocos2d-iphone-2.x" +"15","klist" +"15",".net-fiddle" +"15","microstack" +"15","windows-shell-extension-menu" +"15","wm-concat" +"15","google-apps-activity" +"15","rio" +"15","udb" +"15","riot-os" +"15","pyexcelerate" +"15","less-rails" +"15","oscache" +"15","do-not-track" +"15","retrytemplate" +"15","lync-server-2013" +"15","buildmanager" +"15","asynctest" +"15","absl-py" +"15","uiaction" +"15","dialog-framework" +"15","dotnet-format" +"15","sqlmigrations" +"15","drupal-cache" +"15","high-volume" +"15","gunit" +"15","number-recognition" +"15","xcode6.0.1" +"15","scenejs" +"15","gwmodel" +"15","dreamservice" +"15","azure-iot-hub-device-update" +"15","scikit-plot" +"15","isolation-frameworks" +"15","digitization" +"15","scalene" +"15","reddot" +"15","hirb" +"15","dexopt" +"15","dibs" +"15","nvdec" +"15","sqf" +"15","express-ntlm" +"15","iview-ui" +"15","scalameter" +"15","gamut" +"15","mobilefirst-mtw" +"15","diffbot" +"15","uifeedbackgenerator" +"15","uidatepickermodetime" +"15","istorage" +"15","is-uploaded-file" +"15","dto-mapping" +"15","uielementcollection" +"15","cordova-2.7.0" +"15","azure-metrics-advisor" +"15","dragtarget" +"15","android-compose-appbar" +"15","android-compose-dropdownmenu" +"15","drakma" +"15","non-public-selectors" +"15","tinysort" +"15","tap-harness" +"15","pnp-framework" +"15","hadoopy" +"15","azure-mobile-engagement" +"15","openoffice-api" +"15","pmw" +"15","gcp-alerts" +"15","assembly-name" +"15","pluto-grid" +"15","mlabwrap" +"15","tasmota" +"15","reference-cycle" +"15","hamming-window" +"15","version-control-keywords" +"15","android-gradle-2.2" +"15","mockserver-netty" +"15","gcp-secret-manager" +"15","hanami-model" +"15","caeagllayer" +"15","reference-library" +"15","execute-as" +"15","contenttypes" +"15","reference-source" +"15","general-protection-fault" +"15","tcptrace-pocketsoap" +"15","tdatasetprovider" +"15","generalized-method-of-moments" +"15","cag" +"15","azure-regions" +"15","azure-performancecounters" +"15","asl" +"15","dropdownlistview" +"15","gc-roots" +"15","regexserde" +"15","playstation-portable" +"15","cake-bake" +"15","hardware-design" +"15","geckosdk" +"15","control-template" +"15","uilayoutguide" +"15","drupal-domain-access" +"15","openssl-net" +"15","expo-splash-screen" +"15","sptbxlib" +"15","spsitedataquery" +"15","tmail" +"15","uimafit" +"15","gwtmockito" +"15","tlsharp" +"15","buybutton.js" +"15","tablesaw" +"15","gwt-visualization" +"15","nodester" +"15","dsofile" +"15","expo-module" +"15","uimodalpresentationformsh" +"15","expo-eas" +"15","device-compatibility" +"15","dropwizard-guice" +"15","mlvision" +"15","red-system" +"15","tizen-sdb" +"15","azure-static-website-routing" +"15","droptarget" +"15","cabal-dev" +"15","android-blur-effect" +"15","policywrap" +"15","titanium-widgets" +"15","quickchart" +"15","quickbuild" +"15","opensearch-security-plugin" +"15","peoplesoft-query" +"15","ctfe" +"15","angular2-build" +"15","acralyzer" +"15","prototype-chosen" +"15","project-open" +"15","react-leaflet-search" +"15","actframework" +"15","resulttype" +"15","angular2-custom-component" +"15","esphome" +"15","char32-t" +"15","hyperapp" +"15","iphone-xs" +"15","penn-treebank" +"15","espocrm" +"15","project-structuring" +"15","message-map" +"15","google-cloud-test-lab" +"15","lazyframe" +"15","project-valhalla" +"15","elision" +"15","office-web-app" +"15","meio-upload" +"15","lazy-propagation" +"15","ios-shortcut" +"15","qclipboard" +"15","text-shadow" +"15","gen-event" +"15","iphone-sdk-4.0.1" +"15","pegkit" +"15","text-embedding-ada-002" +"15","nodejs-polars" +"15","pgbadger" +"15","splitactionbar" +"15","member-enumeration" +"15","lcc-win32" +"15","cuda-events" +"15","iphone-accessory" +"15","pg-ctl" +"15","activerecord-jdbc" +"15","node-ipc" +"15","memcachier" +"15","qdateedit" +"15","prolog-coroutining" +"15","iphone11" +"15","android-multiple-apk" +"15","qemu-device" +"15","geolitecity" +"15","cuelang" +"15","centreon-api" +"15","ipfs-cli" +"15","ipad-playgrounds" +"15","monologue" +"15","react-infinite-scroll" +"15","proxytunnel" +"15","speaker-diarization" +"15","esc-key" +"15","iron-data-table" +"15","node.js-napi" +"15","speechkit" +"15","react-native-charts-wrapper" +"15","get-cli" +"15","zpanel" +"15","ios14.5" +"15","metacpan" +"15","commandinjection" +"15","angularjs-authentication" +"15","logminer" +"15","oledbdestination" +"15","logonserver" +"15","commitanimations" +"15","cgcontextdrawpdfpage" +"15","http-negotiate" +"15","mouseleftbuttonup" +"15","special-form" +"15","chakram" +"15","perlapi" +"15","zynq-ultrascale+" +"15","iruby" +"15","nlog.config" +"15","logan-square" +"15","hummingbird" +"15","access-data-project" +"15","evolus-pencil" +"15","ipvs" +"15","common-expression-language" +"15","spidev" +"15","node-memwatch" +"15","restforce" +"15","cfzip" +"15","moose-technology" +"15","cfwindow" +"15","perwebrequest" +"15","oleview" +"15","nipyapi" +"15","httpfs" +"15","largest-contentful-paint" +"15","csvde" +"15","column-sizing" +"15","cgi.pm" +"15","property-editor" +"15","log-ascii-standard" +"15","lotus-designer" +"15","zset" +"15","google-dataform" +"15","font-feature-settings" +"15","fogbugz-on-demand" +"15","std-expected" +"15","git-rev-parse" +"15","arc-lisp" +"15","trace-listener" +"15","usefaketimers" +"15","security-identifier" +"15","argocd-notification" +"15","stellent" +"15","force-directed-graph" +"15","user-account-control" +"15","mts" +"15","headroom.js" +"15","statsforecast" +"15","fog-aws" +"15","steinberg-asio" +"15","solc" +"15","urlsessionwebsockettask" +"15","tiingo" +"15","sterling-db" +"15","arithabort" +"15","authprovider" +"15","traefik-routers" +"15","haskell-streaming" +"15","user-information-list" +"15","ietf-bcp-47" +"15","urlscan" +"15","glassfish-4.1.1" +"15","autobahnjs" +"15","forerunnerdb" +"15","iesi-collections" +"15","qshortcut" +"15","composite-application" +"15","foreigner" +"15","gns3" +"15","flutter-web3" +"15","web-application-security" +"15","identifying-relationship" +"15","screen-time" +"15","embperl" +"15","cuvid" +"15","google-playground" +"15","zend-form-select" +"15","preact-cli" +"15","pass-by-reference-value" +"15","web-app-manifest" +"15","partytown" +"15","amazon-acl" +"15","beanstream" +"15","emacsw32" +"15","license-maven-plugin" +"15","id-card" +"15","cyberneko" +"15","msinfo32" +"15","cycript" +"15","zenodo" +"15","parseexcel" +"15","webdeploy-3.5" +"15","powershell-provider" +"15","powershell-hosting" +"15","zerolog" +"15","powershell-7.4" +"15","google-managed-prometheus" +"15","parameter-object" +"15","elm-signal" +"15","spark-webui" +"15","mediaquery" +"15","pantone" +"15","tgridpanel" +"15","topcoat" +"15","mspgcc" +"15","eloqua-bulk-api" +"15","dapper-simplecrud" +"15","webkitrequestfullscreen" +"15","mediaview" +"15","linfu" +"15","linkchecker" +"15","linksys" +"15","artemis" +"15","msas" +"15","amazon-linux-extras" +"15","google-street-view-static-api" +"15","mtktextureloader" +"15","artifact-deployer" +"15","z39.50" +"15","amazon-inspector" +"15","gluonts" +"15","tidb-pd" +"15","zaber" +"15","tidal-scheduler" +"15","sublime-syntax" +"15","globalevent" +"15","google-sdm-api" +"15","as86" +"15","sdata" +"15","subnormal-numbers" +"15","prefast" +"15","gmplot" +"15","helidon-webclient" +"15","sony-audio-control-api" +"15","ember-power-select" +"15","amazon-ec2-spot-market" +"15","ember-select" +"15","array-comparison" +"15","custom-search-provider" +"15","custom-stories" +"15","thunar" +"15","stateful-actor-service" +"14","rehosting" +"14","rehypejs" +"14","flot.tooltip" +"14","pgu" +"14","vue3-carousel" +"14","cloudflare-turnstile" +"14","phpsh" +"14","wdqs" +"14","loaderinfo" +"14","skygear" +"14","fiddler-everywhere" +"14","webviewdidfinishload" +"14","sklearn2pmml" +"14","class-designer" +"14","transparent-control" +"14","php-printer" +"14","weak-head-normal-form" +"14","jest-expo" +"14","fhs-twitter-engine" +"14","babashka" +"14","babel-babylon" +"14","ginac" +"14","vstesthost" +"14","skopeo" +"14","wedge" +"14","ghprb" +"14","local-node-modules" +"14","fgetpos" +"14","jbi" +"14","file-loader" +"14","vue3-openlayers" +"14","vue-authenticate" +"14","tslib" +"14","trepan" +"14","phantomjs-node" +"14","reqif" +"14","jboss-rules" +"14","flowground" +"14","ferry" +"14","sleekxmpp" +"14","website-admin-tool" +"14","github-actions-services" +"14","github-actions-workflows" +"14","jemos-podam" +"14","reliable-dictionary" +"14","reliable-multicast" +"14","truthy" +"14","vue-tel-input" +"14","civicrm-extension" +"14","php-8.3" +"14","phonegap-developer-app" +"14","cmfcribbonpanel" +"14","cknotification" +"14","jchart2d" +"14","vuejs-routing" +"14","remote-assistance" +"14","wiener-filter" +"14","vuelayers" +"14","class-relationship" +"14","photospicker" +"14","flutter-button" +"14","smart-commits" +"14","slsvcutil" +"14","removable" +"14","smaato" +"14","feature-clustering" +"14","intercom-ios" +"14","deadline-timer" +"14","process-migration" +"14","privileged-functions" +"14","xsuperobject" +"14","edge-runtime" +"14","procobol" +"14","grid.js" +"14","yolk" +"14","react-slingshot" +"14","dd4t" +"14","apache-falcon" +"14","telerik-radlistbox" +"14","multiscroll.js" +"14","edifabric" +"14","mate-desktop" +"14","annotatorjs" +"14","profunctor" +"14","intellij-platform-psi" +"14","multi-value-dictionary" +"14","react-native-map-clustering" +"14","telerik-datepicker" +"14","preview-pane" +"14","clojureql" +"14","gridlength" +"14","deconstructor" +"14","mvc.jquery.datatables" +"14","dbms-redefinition" +"14","antlrworks2" +"14","matlabcontrol" +"14","installr" +"14","inspections" +"14","greasekit" +"14","telegraph" +"14","deep-fake" +"14","apache-james" +"14","easytrieve" +"14","anvil" +"14","ssdl" +"14","jsog" +"14","cdetailview" +"14","pageheap" +"14","carter" +"14","snapshot-view" +"14","smooth-numbers" +"14","swiftui-navigation" +"14","rx-javafx" +"14","cassandra-node-driver" +"14","directory-upload" +"14","platform-independence" +"14","jssh" +"14","platform-detection" +"14","smoke" +"14","makegood" +"14","frontity" +"14","dispatchworkitem" +"14","xgoogle" +"14","flare3d" +"14","ngx-swiper-wrapper" +"14","swiftui-alert" +"14","sn" +"14","python-envoy" +"14","mapdispatchtoprops" +"14","flamelink-cms" +"14","chatsdk" +"14","jsyn" +"14","imageset" +"14","appcelerator-acs" +"14","js-scrollby" +"14","jsjac" +"14","mapmyfitness" +"14","labelled-generic" +"14","labelfunction" +"14","label-for" +"14","unity3d-cloud-build" +"14","dbext" +"14","self-documenting-code" +"14","playgrounds" +"14","conntrack" +"14","jtooltip" +"14","inappsettings" +"14","fixed-format" +"14","snowballanalyzer" +"14","mailsettings" +"14","paillier" +"14","vrvideoview" +"14","ultidev" +"14","unison-lang" +"14","apache-twill" +"14","apollo-link-rest" +"14","pakyow" +"14","palantir-foundry-security" +"14","datastax-search" +"14","phundament" +"14","rust-embedded" +"14","rust-diesel-mysql" +"14","soap-serialization" +"14","firefox-57+" +"14","fuelphp-routing" +"14","firelens" +"14","kubeflow-kserve" +"14","firefox-addon-bootstrap" +"14","firefox-addon-overlay" +"14","apdex" +"14","rust-2018" +"14","pandadoc" +"14","pike" +"14","chunkypng" +"14","contactsui" +"14","mapbox-static-maps" +"14","p4eclipse" +"14","python-o365" +"14","chatgpt-plugin" +"14","owin.security" +"14","jsonelement" +"14","xlrelease" +"14","blackberry-os5" +"14","pingouin" +"14","addcallback" +"14","symfony-translator" +"14","distutils2" +"14","switchcontrol" +"14","jstockchart" +"14","flex2" +"14","xlet" +"14","add-custom-target" +"14","file-sorting" +"14","xlsx-js" +"14","symja" +"14","flatten-pdf" +"14","ngredux" +"14","smart-listing" +"14","file-saver" +"14","function-query" +"14","sofia-sip" +"14","ccc" +"14","ng-dropdown-multiselect" +"14","jsc3d" +"14","void-safety" +"14","flatui" +"14","bitrock" +"14","smtp-server" +"14","swiftype" +"14","bitpay" +"14","playback-rate" +"14","ngtoast" +"14","vaadin-testbench" +"14","aif360" +"14","windows-embedded-8" +"14","django-ratings" +"14","rtl-language" +"14","nant-task" +"14","ag-charts-react" +"14","mylyn-wikitext" +"14","kinto" +"14","mysql-error-1451" +"14","dlm" +"14","key-storage" +"14","aws-mediastore" +"14","aws-ios" +"14","rtw" +"14","nameservice" +"14","mysql-error-1170" +"14","kigg" +"14","mysql-error-1049" +"14","name-length" +"14","rtmpd" +"14","windows-phone-sl-8.1" +"14","call-flow" +"14","win32serviceutil" +"14","nam" +"14","aion" +"14","django-lfs" +"14","django-rules" +"14","r-text" +"14","unityvs" +"14","vendoring" +"14","avcapturephotosettings" +"14","csproj-user" +"14","red5-recorder" +"14","vb-power-pack" +"14","angularjs-q" +"14","vue-treeselect" +"14","routedevents" +"14","ice4j" +"14","simpleioc" +"14","fakeweb" +"14","csdl" +"14","cscfg" +"14","google-trusted-stores" +"14","ibm-datacap" +"14","cs0246" +"14","angular-rc5" +"14","angular-router-events" +"14","crystal-reports-export" +"14","roundedcorners-dropshadow" +"14","oracle-rdb" +"14","vector2" +"14","vc10" +"14","angular-touch" +"14","session-reuse" +"14","session-replay" +"14","grails-2.0.4" +"14","animsition" +"14","session-less" +"14","fastclick" +"14","serilog-expressions" +"14","vc90" +"14","serverfbml" +"14","document-directory" +"14","hystrix-dashboard" +"14","fastify-swagger" +"14","metricsgraphicsjs" +"14","database-fragmentation" +"14","method-combination" +"14","server-side-sync" +"14","meteor-collection-hooks" +"14","serviceextension" +"14","datadirect" +"14","metapost" +"14","grammy" +"14","napa" +"14","dlt-daemon" +"14","sitecore-commerce-server" +"14","pychef" +"14","pychecker" +"14","gpuarray" +"14","iauthorizationfilter" +"14","pycel" +"14","updatepanel-progressbar" +"14","wampsharp" +"14","validform" +"14","react-universal" +"14","captured-variable" +"14","indy-node" +"14","react-vis-network" +"14","jmathplot" +"14","read-access" +"14","ora-01036" +"14","verizon" +"14","ora-01403" +"14","gouraud" +"14","card-flip" +"14","ora-01461" +"14","single-source" +"14","indexwriter" +"14","gradcam" +"14","facebook-public-feed-api" +"14","css-layer" +"14","gradientstop" +"14","docker-aws" +"14","alamofire-upload" +"14","wasabi-hot-cloud-storage" +"14","single-abstract-method" +"14","realm-studio" +"14","ruby-thread" +"14","crowdin" +"14","rnetlogo" +"14","ruby-watir" +"14","alcatel-ot" +"14","vensim" +"14","gradle-play-publisher" +"14","unity-xr" +"14","gulp-jasmine" +"14","nsdmanager" +"14","npz-file" +"14","nem" +"14","crashpad" +"14","wso2-choreo" +"14","svggraph" +"14","wso2-ml" +"14","neovis" +"14","ndesk.options" +"14","denormal-numbers" +"14","iodocs" +"14","grunt-connect" +"14","path-to-regexp" +"14","android-seek" +"14","scalafix" +"14","bpg" +"14","count-min-sketch" +"14","invantive-query-tool" +"14","createchildcontrols" +"14","worhp" +"14","jquery-uniform" +"14","countdownevent" +"14","hotfolder" +"14","dependabot-script" +"14","braintree-javascript" +"14","intrinsicattributes" +"14","grunt-init" +"14","entity-data-model" +"14","nscala-time" +"14","neoxygen" +"14","sas-gtl" +"14","sas-ds2" +"14","portsip" +"14","andromda" +"14","boost-stacktrace" +"14","erc1155" +"14","neo4j-shell" +"14","android-xml-attribute" +"14","delayed-paperclip" +"14","silvershop" +"14","portable-database" +"14","jquery-filer" +"14","twine-game-engine" +"14","kademi" +"14","nspr" +"14","nspointerarray" +"14","one-time-pad" +"14","azure-arc" +"14","surroundscm" +"14","bootstrap-affix" +"14","silk" +"14","jquery-mobile-table" +"14","onfocusout" +"14","html.checkbox" +"14","arago" +"14","interix" +"14","gss" +"14","neocomplete" +"14","sigqueue" +"14","applescript-studio" +"14","azure-application-proxy" +"14","swagger-play2" +"14","mojoportal" +"14","on-lisp" +"14","htcondor" +"14","devel-nytprof" +"14","bootstrap-toast" +"14","ept" +"14","hslf" +"14","in-place-editor" +"14","nsimagecell" +"14","android-studio-giraffe" +"14","bot-emulator" +"14","infection" +"14","epf" +"14","bluetooth-5" +"14","svg-rect" +"14","svg-salamander" +"14","onset-detection" +"14","bosch-iot-suite" +"14","jquery-triggerhandler" +"14","epilogue" +"14","oodb" +"14","hql-delete" +"14","design-surface" +"14","episerver-find" +"14","typebox" +"14","hping" +"14","postgres-11" +"14","twig.js" +"14","spring-cloud-deployer-kubernetes" +"14","pdfpage" +"14","gulp-webpack" +"14","pcov" +"14","svg-pattern" +"14","brio" +"14","jasmine-matchers" +"14","kotlin-maven-plugin" +"14","ktpass" +"14","vmime" +"14","observable-plot" +"14","kotlin-logging" +"14","brother-bpac" +"14","abmultivalue" +"14","objectbox-java" +"14","coffeekup" +"14","pyelftools" +"14","codebird" +"14","f#-3.1" +"14","kotlin-contracts" +"14","visa-api" +"14","pygmentize" +"14","javonet" +"14","vliw" +"14","accent-color" +"14","pyexcelerator" +"14","overlay-view" +"14","mac-dashboard-widget" +"14","vitis-ai" +"14","facebook-account-kit" +"14","3dr" +"14","aad-pod-identity" +"14","asyncappender" +"14","dokka" +"14","codexl" +"14","misfire-instruction" +"14","setdlldirectory" +"14","r-collapse" +"14","kostache" +"14","rcall" +"14","microsoft-search-server" +"14","ucma2.0" +"14","andengine-gles-2" +"14","brownfield" +"14","microsoft-live-meeting" +"14","bruno" +"14","ksonnet" +"14","attachment-field" +"14","midas-server" +"14","async-graphql" +"14","browser-based" +"14","netmon" +"14","objgraph" +"14","kovan" +"14","luxonis" +"14","kongregate" +"14","maestro" +"14","visualstudio.testtools" +"14","system.web.mail" +"14","nettle" +"14","bricscad" +"14","rich-communications-services" +"14","domain-calculus" +"14","ringout" +"14","facebook-graph-api-v2.5" +"14","authkit" +"14","codemaid" +"14","facebook-graph-api-v2.6" +"14","fpdf2" +"14","pygubu" +"14","pyhf" +"14","rates" +"14","lua-resty-openidc" +"14","pyper" +"14","minibufexplorer" +"14","magma-ca" +"14","random-testing" +"14","pypdf4" +"14","shaped-window" +"14","shoulda-matchers" +"14","r-graphviz" +"14","rfc2396" +"14","showuserlocation" +"14","asyncpostbackerror" +"14","google-base" +"14","buildforge" +"14","winprt" +"14","java.security" +"14","wordperfect" +"14","java-scripting-engine" +"14","miniport" +"14","libfuse" +"14","sgp4" +"14","vimium" +"14","rfc4180" +"14","netcoreapp2.1" +"14","videosdk.live" +"14","raspbian-wheezy" +"14","javascript-date" +"14","shinycssloaders" +"14","wonderpush" +"14","jautodoc" +"14","asyncpraw" +"14","orcid" +"14","mailinator" +"14","network-storage" +"14","goconvey" +"14",".net-core-sdk" +"14","form-editing" +"14","shopifyscripts" +"14","frameless" +"14","lumen-routing" +"14","minio-client" +"14","typescript-5" +"14","withcontext" +"14","foxids" +"14","pyke" +"14","kloudless" +"14","sysdatetime" +"14","viewmodelfactory" +"14","pyprocessing" +"14","systemd-nspawn" +"14","winpty" +"14","magiczoom" +"14","woocommerce-email" +"14","system-generator" +"14","typeshed" +"14","vim-go" +"14","coldfusion-6" +"14","google-business-profile" +"14","object-inspector" +"14","radicale" +"14","asp.net-core-staticfile" +"14","hardware-infrastructure" +"14","mkcoordinatespan" +"14","x2go" +"14","uidocumentmenuvc" +"14","azure-in-role-cache" +"14","spuser" +"14","nonatomic" +"14","dictview" +"14","dicttoxml" +"14","asn1crypto" +"14","tailrecursion-modulo-cons" +"14","mknetworkengine" +"14","noncharacter" +"14","diffsharp" +"14","mobileme" +"14","hirefire" +"14","sp-who2" +"14","gulp-zip" +"14","dex2oat" +"14","hangfire-console" +"14","azure-text-translation" +"14","point-in-time-recovery" +"14","wxlua" +"14","azure-packaging" +"14","nsurldownload" +"14","qxmpp" +"14","wx.html2" +"14","ntt" +"14","azure-tableclient" +"14","mode-analytics" +"14","tcpmon" +"14","r3f" +"14","tcomponent" +"14","plop" +"14","handbrakecli" +"14","redips.drag" +"14","redhat-datagrid" +"14","hopper" +"14","uiprintinfo" +"14","polar-plot" +"14","mobilink" +"14","quotaguard" +"14","hootsuite" +"14","sqlake" +"14","spring-surf" +"14","uiactionsheetdelegate" +"14","direct-buffer" +"14","sqljocky" +"14","diode" +"14","azure-service-runtime" +"14","task-tracking" +"14","assembly.reflectiononly" +"14","timetk" +"14","tkinter.text" +"14","jackson-annotations" +"14","modal-logic" +"14","moarvm" +"14","uipi" +"14","quicken" +"14","polyglot-notebooks" +"14","hiawatha" +"14","android-httptransport" +"14","executestorequery" +"14","scnlight" +"14","drupal-node-hook" +"14","exide" +"14","scosta" +"14","drupal-roles" +"14","highperformance" +"14","gcc5.2" +"14","drupal-behaviors" +"14","xcode9-beta5" +"14","xamarin-component" +"14","scalala" +"14","dropshadoweffect" +"14","drop-cap" +"14","sciter" +"14","gbdk" +"14","exceptionfilterattribute" +"14","xaml-composition" +"14","scrapyd-deploy" +"14","drag-event" +"14","buzz.js" +"14","xcode-tools" +"14","expansion-files" +"14","g729" +"14","android-compose-dialog" +"14","dropdownchecklist" +"14","bwwalkthrough" +"14","ispeech" +"14","bytedeco-javacv" +"14","convox" +"14","dsx-desktop" +"14","android-bubbles" +"14","on-disk" +"14","node-gcm" +"14","react-image-lightbox" +"14","android-jetpack-compose-modifier" +"14","electric-fence" +"14","activex-documents" +"14","node-github" +"14","io-ts-library" +"14","mp3agic" +"14","qrubberband" +"14","nmi" +"14","nmatrix" +"14","etimedout" +"14","activitypub" +"14","elementary-functions" +"14","memurai" +"14","re2c" +"14","httpuv" +"14","geographic-lib" +"14","ipaas" +"14","eglibc" +"14","log-forging" +"14","textexpander" +"14","react-alt" +"14","ios10.3.2" +"14","log4c" +"14","octobercms-user-plugin" +"14","strongly-typed-enum" +"14","prometheus-python-client" +"14","resharper-2017" +"14","laravel-jwt" +"14","performance-estimation" +"14","getpasswd" +"14","strobe-media-playback" +"14","hyperfilesql" +"14","pfsense" +"14","react-effects" +"14","odk-xform" +"14","google-cloud-asset-inventory" +"14","mozilla-prism" +"14","logrocket" +"14","strava-api-v3" +"14","movewindow" +"14","nircmd" +"14","stripe-customer-portal" +"14","requirehttps" +"14","google-cloud-auth" +"14","strcat-s" +"14","evo" +"14","prooph" +"14","googledns" +"14","tesseract-5.x" +"14","acr1252" +"14","textboxlist" +"14","google-cloud-node" +"14","requestify" +"14","google-cloud-proxy" +"14","streamex" +"14","streaming-analytics" +"14","requestly" +"14","google-cloud-vm" +"14","chainercv" +"14","getschema" +"14","combinedchart" +"14","qbuffer" +"14","elasticsearch-river" +"14","spleeter" +"14","omnikey" +"14","react-masonry" +"14","elastic-network-interface" +"14","textrank" +"14","cgns" +"14","ohlcv" +"14","cucumber-cpp" +"14","ipycytoscape" +"14","textswitcher" +"14","android-rendering" +"14","iphone-8" +"14","angular2-modal" +"14","omnicontacts-gem" +"14","chartnew.js" +"14","terraform-loop" +"14","irate" +"14","mercurial-phases" +"14","node-expat" +"14","mercurial-api" +"14","cfimport" +"14","ctransformers" +"14","project-gutenberg" +"14","cfhttpparam" +"14","column-chooser" +"14","cudpp" +"14","spinach" +"14","android-monitor" +"14","layoutpanels" +"14","spatial-regression" +"14","qdesktopservices" +"14","speedglm" +"14","om-next" +"14","spinalhdl" +"14","lateinit" +"14","offsite" +"14","restxq" +"14","elastislide" +"14","colordrawable" +"14","nikola" +"14","texture-packing" +"14","commodity" +"14","android-layout-direction" +"14","android-largeheap" +"14","geocaching" +"14","cgan" +"14","specialized-annotation" +"14","ipp-qbd-sync" +"14","collibra" +"14","layout-engine" +"14","android-jetpack-security" +"14","cfdump" +"14","project-conversion" +"14","tfs-aggregator" +"14","hexchat" +"14","weboptimizer" +"14","multicorn" +"14","fmodf" +"14","qshareddata" +"14","heroku-ssl" +"14","sourcesafe-6.0" +"14","v2ray" +"14","touch-typing" +"14","bigloo" +"14","embedded-control" +"14","sonarqube-5.5" +"14","emacs25" +"14","tf.dataset" +"14","webpack-mix" +"14","conditional-binding" +"14","elm-ui" +"14","sugarcube" +"14","starkit" +"14","bigcommerce-checkout-sdk" +"14","helenus" +"14","here-autocomplete" +"14","sonic" +"14","iis-arr" +"14","threetenabp" +"14","tibco-gi" +"14","bin2hex" +"14","toscawidgets" +"14","startup-probe" +"14","web3php" +"14","static-text" +"14","state.go" +"14","flutter-typeahead" +"14","tilecache" +"14","web3swift" +"14","imagebitmap" +"14","avaudiosessioncategory" +"14","msan" +"14","array-view" +"14","search-multiple-words" +"14","glpi" +"14","searchactivity" +"14","alliedvision" +"14","ember-concurrency" +"14","yui-uploader" +"14","sealedsecret" +"14","bcc-compiler" +"14","quantities" +"14","amazonica" +"14","msbuild-itemgroup" +"14","zipexception" +"14","bcg" +"14","beginanimations" +"14","befunge" +"14","sdl.net" +"14","preference-v7" +"14","powermta" +"14","qubes-os" +"14","qtopcua" +"14","amazon-ecr-public" +"14","parameterinfo" +"14","precompiled-templates" +"14","scribus" +"14","gnu-apl" +"14","amazon-cloudwatch-synthetics" +"14","identity-delegation" +"14","preact-router" +"14","google-play-console-beta" +"14","parameter-list" +"14","zfdatagrid" +"14","measurestring" +"14","particle.js" +"14","beanstalkc" +"14","cy.intercept" +"14","cycle-plugin" +"14","google-native-ads" +"14","ppd" +"14","google-maps-android-api-1" +"14","quadrilaterals" +"14","paravirtualization" +"14","altiris" +"14","zentyal" +"14","google-maps-compose" +"14","autorepeat" +"14","google-maps-timezone" +"14","parquet-dataset" +"14","alternate-access-mappings" +"14","arduino-cli" +"14","ietester" +"14","git-non-bare-repository" +"14","ieframe.dll" +"14","mudselect" +"14","bazel-genrule" +"14","bazel-extra-action" +"14","user-manual" +"14","qt5.11" +"14","transcendental-equation" +"14","linkedblockingqueue" +"14","embeddinator" +"14","zoom-meeting" +"14","ender" +"14","alibaba-cloud-oss" +"14","compileassemblyfromsource" +"14","urlstream" +"14","userpoints" +"14","component-query" +"14","bespin" +"14","stickynote" +"14","prestashop-helper-classes" +"14","urlimageviewhelper" +"14","powerbi-gateway" +"14","haskell-vector" +"14","stipple" +"14","dart-dev-compiler" +"14","tradestation" +"14","haskell-polysemy" +"14","styleswitching" +"14","line-of-business-app" +"14","autocommenting" +"14","seasoned-schemer" +"14","dapper-rainbow" +"14","yt-project" +"14","autodesk-arvr" +"13","vuestic" +"13","slonik" +"13","truedbgrid" +"13","phprunner" +"13","pritunl" +"13","classiejs" +"13","multiple-inclusions" +"13","fedora12" +"13","jexceljs" +"13","privategpt" +"13","privateobject.invoke" +"13","jcaps" +"13","vue-teleport" +"13","ferror" +"13","base85" +"13","flutter-date-range-picker" +"13","react-native-tools" +"13","llvm-py" +"13","vuetify2" +"13","phpt" +"13","react-native-ui-components" +"13","related-posts" +"13","interface-class" +"13","flutter-expanded" +"13","websphere-6" +"13","clpplus" +"13","cockpit-cms" +"13","sitefinity-3x" +"13","backbase" +"13","telerik-radribbonbar" +"13","mathematica-7" +"13","webservice-discovery" +"13","photoshop-sdk" +"13","xxtea" +"13","fencepost" +"13","apache-fineract" +"13","mathcontext" +"13","matchevaluator" +"13","locally-abstract-type" +"13","jest-image-snapshot" +"13","mvcminiprofiler" +"13","backing" +"13","ecdsasignature" +"13","jblas" +"13","multitasking-gestures" +"13","backgroundtaskidentifier" +"13","cmd2" +"13","eclipse-atl" +"13","jdf" +"13","react-native-modalize" +"13","jepp" +"13","pg-repack" +"13","munge" +"13","feathericons" +"13","vt-x" +"13","yii2-authclient" +"13","eclipse-2018-09" +"13","musicg" +"13","yandexcloud" +"13","vue-data" +"13","background-drawable" +"13","echoprint" +"13","phonegap-gmaps-plugin" +"13","gitg" +"13","gitfs" +"13","instascan" +"13","srtm" +"13","srl" +"13","groebner-basis" +"13","clever-cloud" +"13","ssl-security" +"13","clone-element" +"13","ffmpy" +"13","apache-camel-aws-kinesis" +"13","sslv2" +"13","react-redux-i18n" +"13","skinny-war" +"13","ssms-2005" +"13","intel-inspector" +"13","sstoolkit" +"13","renderx" +"13","intellij-2020" +"13","wechat-auth" +"13","gitlab-wiki" +"13","renderbox" +"13","wh-keyboard-ll" +"13","re-natal" +"13","clientcontext" +"13","clay" +"13","clockrates" +"13","listview-filter" +"13","edge-to-edge" +"13","listviewgroup" +"13","procps" +"13","sjs" +"13","rematch" +"13","baresip" +"13","react-os" +"13","fileitem" +"13","reltool" +"13","web-stomp" +"13","grib-api" +"13","remarks" +"13","wdio-jasmine" +"13","edgecast" +"13","claudia.js" +"13","proc-format" +"13","classwizard" +"13","six-python" +"13","interaction-plot" +"13","getwindowlong" +"13","livegraph" +"13","anonymousidentification" +"13","websphere-process-server" +"13","filesysteminfo" +"13","symfony-finder" +"13","filenet-workplace" +"13","bitdefender" +"13","display-suite" +"13","vrone" +"13","apache-storm-flux" +"13","adobe-cc" +"13","underlyingtype" +"13","safefilehandle" +"13","data-tracing" +"13","umlgraph" +"13","ngx-doc-viewer" +"13","date-fns-tz" +"13","nhibernate-collections" +"13","apache-tailer" +"13","cdk8s" +"13","umn-mapserver" +"13","datashape" +"13","adsl" +"13","ngdraggable" +"13","file-traversal" +"13","packages.json" +"13","pibase" +"13","fiware-poi" +"13","safe-tensors" +"13","ultraesb" +"13","python-requests-json" +"13","fiware-perseo" +"13","chatwoot" +"13","xmlinclude" +"13","db2-content-manager" +"13","umbraco9" +"13","snmpwalk" +"13","cirq" +"13","advanced-indexing" +"13","chdatastructures" +"13","kubernetes-java-client" +"13","js-fancyproductdesigner" +"13","checkeditems" +"13","aframe-react" +"13","cellbrowser" +"13","admin-interface" +"13","checkboxtree" +"13","adhearsion" +"13","manager-app" +"13","jsr233" +"13","semantic-comparison" +"13","xhp" +"13","laravel-data" +"13","pixiedust" +"13","constraintlayout-barrier" +"13","makumba" +"13","binmode" +"13","laraadmin" +"13","jsr170" +"13","marimekko-chart" +"13","cassandraunit" +"13","language-recognition" +"13","blackmagic-design" +"13","funkload" +"13","addressable-gem" +"13","platform-of-trust" +"13","pkcanvasview" +"13","uiuserinterfacestyle" +"13","swiftui-menu" +"13","swiftui-map" +"13","constructor-reference" +"13","langsmith" +"13","maniphest" +"13","mambaforge" +"13","apicurio-registry" +"13","pinot" +"13","xqj" +"13","ui-validate" +"13","lamson" +"13","xlslib" +"13","jsondoc" +"13","rvg" +"13","xenu" +"13","lambda-prolog" +"13","nexus-iq" +"13","freemat" +"13","console-redirect" +"13","apiconnect-test-monitor" +"13","jslint4java" +"13","mainmenu" +"13","pict" +"13","bitbar" +"13","xfl" +"13","jscalendar" +"13","datalore" +"13","page-state" +"13","selflanguage" +"13","s3transfermanager" +"13","jscep" +"13","self-intersection" +"13","xfermode" +"13","crossterm" +"13","aws-authorizer" +"13","keyboard-focus" +"13","crudbooster" +"13","varybyparam" +"13","cross-page-postback" +"13","mysql-error-1050" +"13","iab" +"13","awilix" +"13","cryptlib" +"13","aiosqlite" +"13","air2" +"13","avsystemcontroller" +"13","crysis" +"13","django-saml2-auth" +"13","airflow-connections" +"13","hypriot" +"13","create-react-kotlin-app" +"13","icccm" +"13","avoriaz" +"13","icedtea-web" +"13","alexa-interaction-model" +"13","avcapturevideodataoutput" +"13","iconnectionpoint" +"13","mysqldbcompare" +"13","valentina-studio" +"13","vercel-hyper-terminal" +"13","mysql-date" +"13","ruby-mode" +"13","verify-tests" +"13","django-wysiwyg" +"13","al.exe" +"13","ruby-saml" +"13","ruby-native-extensions" +"13","django-wiki" +"13","aws-emr-studio" +"13","django-weasyprint" +"13","rubypython" +"13","django-syndication" +"13","kendo-maskedtextbox" +"13","kendo-ui-window" +"13","aws-graviton" +"13","purgecss" +"13","docker.dotnet" +"13","realm-net" +"13","pup" +"13","ptv-vissim" +"13","pthread-key-create" +"13","unity-test-tools" +"13","recoverymodel" +"13","pstricks" +"13","pstats" +"13","r-paws" +"13","recvmsg" +"13","pseudolocalization" +"13","angularjs-new-router" +"13","simple-oauth2" +"13","simplenlg" +"13","oracle-cloud-shell" +"13","angular-maps" +"13","oracle-export-dump" +"13","simplejdbcinsert" +"13","faktor-ips" +"13","angular-nglist" +"13","routed" +"13","angular-permission" +"13","routeboxer" +"13","oracle-objects" +"13","jplist" +"13","oracle-soda" +"13","angular-structural-directive" +"13","doctrine-collection" +"13","animatewindow" +"13","fast-android-networking" +"13","roslynpad" +"13","joypad" +"13","microclimate" +"13","jotm" +"13","jooq-sbt-plugin" +"13","rootbeer" +"13","server2go" +"13","rom-rb" +"13","data-access-app-block" +"13","servertag" +"13","watson-explorer" +"13","metasyntactic-variable" +"13","joda-convert" +"13","data-execution-prevention" +"13","datagridrow" +"13","watchos-8" +"13","datahub" +"13","jncryptor" +"13","vue-typescript" +"13","dogpile.cache" +"13","gradle-groovy-dsl" +"13","jhipster-blueprint" +"13","goslate" +"13","jikes" +"13","jing" +"13","jinjava" +"13","gpyopt" +"13","gpu-instancing" +"13","wal-e" +"13","jjaql" +"13","windows-client" +"13","kinterbasdb" +"13","windows-core-audio" +"13","window-scroll" +"13","windows-10-sdk" +"13","camera-projection" +"13","django-evolution" +"13","named-function" +"13","caniuse" +"13","windows-logon" +"13","sharelink" +"13","urlcomponents" +"13","kibana-3" +"13","wildfly-27" +"13","wildfly-14" +"13","camel-file" +"13","dmenu" +"13","opserver" +"13","mysql-fabric" +"13","dmoz" +"13","pychart" +"13","sharepoint-alerts" +"13","pybuffer" +"13","pybit" +"13","pybel" +"13","sirius" +"13","callscreeningservice" +"13","react-stripe" +"13","dnp3" +"13","aggdraw" +"13","pyapns" +"13","keyman-developer" +"13","keyman" +"13","ora-00928" +"13","rubyamf" +"13","carbon-components-svelte" +"13","callcontext" +"13","mysql-error-1140" +"13","carbonkit" +"13","ruby-csv" +"13","realm-browser" +"13","mysql-error-1060" +"13","jvm-codecache" +"13","katta" +"13","sass-variables" +"13","sa-mp" +"13","inline-c" +"13","cpn-tools" +"13","createbitmap" +"13","nestedlayout" +"13","scala.rx" +"13","android-studio-3.5.3" +"13","surface-hub" +"13","azure-data-share" +"13","svn-switch" +"13","android-studio-3.5.1" +"13","kawa" +"13","karpenter" +"13","blazor-pwa" +"13","modular-monolith" +"13","monaco-languageserver" +"13","wssf" +"13","satpy" +"13","corenlp-server" +"13","moment-range" +"13","twilio-verify" +"13","juliadb" +"13","android-subscriptionmanager" +"13","injected-class-name" +"13","wpf-listview" +"13","modelstatedictionary" +"13","android-update-sdk" +"13","just" +"13","jupyter-server" +"13","wsdl2php" +"13","twilio-cli" +"13","workqueue" +"13","sbom" +"13","kakoune" +"13","mod-proxy-wstunnel" +"13","sap-analysis-for-office" +"13","kamal" +"13","android-spellcheck" +"13","supportfragmentmanager" +"13","ttimer" +"13","coroutineworker" +"13","apple-watch-glances" +"13","mongify" +"13","android-test-orchestrator" +"13","wordpress-roles" +"13","innerxml" +"13","jquery-mobile-checkbox" +"13","nshost" +"13","jquery-mobile-radio" +"13","input-iterator" +"13","near-sdk-rs" +"13","ncron" +"13","dynamic-picklist-vtiger" +"13","html-target" +"13","bound-variable" +"13","nemlogin" +"13","boxee" +"13","opal-framework" +"13","pcl-crypto" +"13","guacamole-common.js" +"13","boa-constructor" +"13","dynamic-management-views" +"13","developer-payload" +"13","easybind" +"13","gulp-newer" +"13","pcmanfm" +"13","b-prolog" +"13","inno-tools-downloader" +"13","oovoo" +"13","enroute" +"13","aquafold" +"13","interposing" +"13","bluespec" +"13","jquery-color" +"13","ncclient" +"13","descartes" +"13","ion-content" +"13","appsweep" +"13","postgresql.conf" +"13","blur-admin" +"13","pdm" +"13","envstats" +"13","dynamics365-app-mobile" +"13","pdh" +"13","onpreferenceclicklistener" +"13","enumerize" +"13","postgres-9.4" +"13","bluetooth-lowenergy-4.2" +"13","neatupload" +"13","errorcollector" +"13","dynamic-c" +"13","jquery-gmap" +"13","bookblock" +"13","nbehave" +"13","bootstrapvalidator-1000hz" +"13","early-return" +"13","pot" +"13","grunt-ngdocs" +"13","pathelement" +"13","payone" +"13","nslevelindicator" +"13","introsort" +"13","jqplot-highlighter" +"13","jqprint" +"13","grunt-express" +"13","boost-parameter" +"13","jquery-flexbox" +"13","applocalizations" +"13","delegated-properties" +"13","earthpy" +"13","paypal-vault" +"13","delta-rs" +"13","ndebug" +"13","detailslist" +"13","bluefish" +"13","migrate-mongo" +"13","codeigniter-a3m" +"13","miniupnpc" +"13","jave" +"13","nxml" +"13","ranch" +"13","wolfram-cdf" +"13","typo3-form" +"13","rgbcolor" +"13","typed-dataset" +"13","virtual-topic" +"13","braintree-vault" +"13","libneo4j-client" +"13",".net-standard-1.6" +"13","pyresttest" +"13","shiva3d" +"13","system.graphics" +"13","f#-compiler-services" +"13","visio-2010" +"13","nethack" +"13","wkinterfacebutton" +"13","magicline" +"13","builder.io" +"13","ubikloadpack" +"13","shinysky" +"13","coclass" +"13","shape-outside" +"13","google-app-engine-launch" +"13","object-initializer" +"13","mission-critical" +"13","typescript-language-server" +"13","shinyjqui" +"13","buildingblocks" +"13","codea" +"13","rbs" +"13","codata" +"13","dom7" +"13","raw-post" +"13","ramdrive" +"13","kmip" +"13","breakiterator" +"13","java-communication-api" +"13","netbeans6.1" +"13","syndesis" +"13","authlogic-oid" +"13","visualdesigner" +"13","fortumo" +"13","videojs-record" +"13","rinohtype" +"13","pytextrank" +"13","anaglyph-3d" +"13","goaop" +"13","setuserinteractionenabled" +"13","jasmine-headless-webkit" +"13","atlasboard" +"13","ledger-nano-s" +"13","vite-plugin-development" +"13","right-aws" +"13","pystache" +"13","object-sharing" +"13","sigma-grid-control" +"13","viewlets" +"13","libcmtd" +"13","pyrcc" +"13","fppopover" +"13","middle-tier" +"13","r-dbconnect" +"13",".x" +"13","atomic-values" +"13","buddy-build" +"13","settingslogic" +"13","newmips" +"13","signalrcore" +"13","rhino-esb" +"13","revision-graph" +"13","libreoffice-impress" +"13","android-app-ops" +"13","network-tools" +"13","bsmultiselect" +"13","midi.js" +"13","uiaccessibility-notification" +"13","magento-fpc" +"13",".searchable" +"13","word-completion" +"13","libreoffice-draw" +"13","kornia" +"13","codeigniter-flashdata" +"13","winqual" +"13","pyhdfs-client" +"13","magicalrecord-2.1" +"13","retransmit-timeout" +"13","shoretel" +"13","wordpress-6" +"13","android-asset-studio" +"13","uglifyjs-webpack-plugin" +"13","knockout-postbox" +"13","mirrorlink" +"13","setneedsdisplayinrect" +"13","abandoned-memory" +"13","typed-lambda-calculus" +"13","vimba-sdk" +"13","libcurl.net" +"13","libical" +"13","domain-service-class" +"13","2-tier" +"13","a86" +"13","maas" +"13","libresolv" +"13","rewritepath" +"13","richtextctrl" +"13","dokku-alt" +"13","devilbox" +"13","izpanel" +"13","controller-tests" +"13","tmediaplayer" +"13","redo-logs" +"13","mobipocket" +"13","devirtualization" +"13","j2objc-gradle" +"13","redlock.net" +"13","rails-for-zombies" +"13","drf-extensions" +"13","quick-install-package" +"13","astah" +"13","play-templates" +"13","rails-5.1.6" +"13","rails-4-upgrade" +"13","azure-pipeline-python-script-task" +"13","conversions-api" +"13","scichart.js" +"13","npm-debug" +"13","play-ws" +"13","mobx-utils" +"13","assistive" +"13","nsurlcredentialstorage" +"13","radscheduleview" +"13","drupal-form-validation" +"13","asreml" +"13","convertall" +"13","tasty" +"13","taskfile" +"13","openjml" +"13","mockrunner" +"13","polychart" +"13","downloadify" +"13","tchecklistbox" +"13","polyglot-markup" +"13","xctestplan" +"13","tingodb" +"13","poison-queue" +"13","polyglot-persistance" +"13","hidden-variables" +"13","expecto" +"13","opengl-to-opengles" +"13","polylineoptions" +"13","vertexdata" +"13","drupal-schema" +"13","xcode-target" +"13","homomorphic-encryption" +"13","tdatetimepicker" +"13","azureshell" +"13","xcode-plugin" +"13","tdl" +"13","gemma" +"13","nonserializedattribute" +"13","registerhelper" +"13","tinytext" +"13","poc" +"13","as-keyword" +"13","non-web" +"13","nook-tablet" +"13","ex-navigation" +"13","honeysql" +"13","export-to-image" +"13","android-devicetoken" +"13","model-binders" +"13","notarization" +"13","tag-dispatching" +"13","hjson" +"13","gdata-java-client" +"13","tkinter.style" +"13","hopscotch" +"13","hibernate-batch-updates" +"13","scollector" +"13","hail" +"13","r-4.0.0" +"13","cabwiz" +"13","c#-devkit" +"13","racf" +"13","racerjs" +"13","dict-comprehension" +"13","mobile-app-tracker" +"13","haiku" +"13","c#-code-model" +"13","uicolorpickerviewcontroller" +"13","c++-attributes" +"13","uicontextmenuconfiguration" +"13","wx2" +"13","uibubbletableview" +"13","nvblas" +"13","sceneeditor" +"13","bzr-svn" +"13","azure-functions-docker" +"13","sched" +"13","uibaritem" +"13","gwt-syncproxy" +"13","mm7" +"13","cordys-opentext" +"13","hammerdb" +"13","itms-90809" +"13","openwebanalytics" +"13","xamarin.forms.collectionview" +"13","null-string" +"13","xamarin-forms-shell" +"13","c++-tr2" +"13","xaction" +"13","qupath" +"13","cache-digests" +"13","diem" +"13","dhc" +"13","azure-image-builder" +"13","x509certficiate2" +"13","rabbitmq-federation" +"13","issharedsizescope" +"13","sql-server-ce-toolbox" +"13","event-queue" +"13","streamingmarkupbuilder" +"13","layerkit" +"13","ole-object" +"13","texnic-center" +"13","chainlit" +"13","react-d3-graph" +"13","sphider" +"13","propertyconfigurator" +"13","react-mapbox-gl" +"13","getpwnam" +"13","httpfox" +"13","string-math" +"13","combinedresourcehandler" +"13","lookback" +"13","combine-pdf" +"13","resharper-8.1" +"13","ipworks" +"13","pyvimeo" +"13","css-paint-api" +"13","spgwr" +"13","ipython-sql" +"13","restivus" +"13","projectitem" +"13","qq" +"13","mplab-5.45" +"13","ios16.4" +"13","angularjs-infdig" +"13","es-hyperneat" +"13","cfpdfform" +"13","nitrous" +"13","large-address-aware" +"13","angular-gantt" +"13","getcolor" +"13","motor-asyncio" +"13","propfind" +"13","spcontext" +"13","logiql" +"13","escp" +"13","angularfire2-offline" +"13","testim.io" +"13","strstream" +"13","no-database" +"13","ternjs" +"13","lark" +"13","angular-bootstrap-toggle" +"13","android-moxy" +"13","android-motionscene" +"13","android-mqtt-client" +"13","memoryanalyzer" +"13","memoir" +"13","android-navigation-editor" +"13","cue-points" +"13","ondblclick" +"13","reactivemongo-play-json" +"13","euterpea" +"13","splunk-api" +"13","react-google-autocomplete" +"13","android-nsd" +"13","customization-point" +"13","ios-urlsheme" +"13","splobjectstorage" +"13","nike" +"13","android-measure" +"13","tomcat5" +"13","peer-discovery" +"13","memberinfo" +"13","monotone" +"13","terraform-variables" +"13","pgcc" +"13","pgbench" +"13","electron-notarize" +"13","resource-dll" +"13","proxy.pac" +"13","android-preference-v14" +"13","cubrid" +"13","android-project-template" +"13","resource-based-authorization" +"13","mems" +"13","pelias" +"13","textdocumentproxy" +"13","duplicati" +"13","moodle-boost" +"13","egnyte" +"13","pendo" +"13","qaxwidget" +"13","android-resource-qualifiers" +"13","monostate" +"13","android-jetpack-compose-navigation" +"13","elastix-itk" +"13","android-json-rpc" +"13","curand" +"13","react-dragula" +"13","ejabberd-saas" +"13","collapsibletree-r" +"13","ipl" +"13","hydrotsm" +"13","react-library" +"13","prototypal" +"13","odesk" +"13","flutter-radiobutton" +"13","here-tourplanning" +"13","linkshare" +"13","dart-frog" +"13","here-fleet-telematics" +"13","sunmi" +"13","quarkus-grpc" +"13","cypress-session" +"13","suncc" +"13","czmq" +"13","linkedin-gem" +"13","eluna-lua-engine" +"13","lightwindow" +"13","quantify" +"13","d3fo" +"13","parallel-assignment" +"13","elrte" +"13","webgrabber" +"13","dart-pdf" +"13","batch-delete" +"13","line-processing" +"13","darkaonlinel5-swagger" +"13","linux-mint-19" +"13","google-groups-migration" +"13","dapper-plus" +"13","header-injection" +"13","archive-file" +"13","foq" +"13","arcsight" +"13","traefik-middleware" +"13","ardl" +"13","bftask" +"13","hdf5dotnet" +"13","stx" +"13","timbre" +"13","bigdl" +"13","betamax" +"13","authorize.net-aim" +"13","shell-verbs" +"13","berkelium" +"13","gleam" +"13","uttype" +"13","bentoml" +"13","gliffy" +"13","glktextureloader" +"13","array-of-dict" +"13","fmle" +"13","seasonal-adjustment" +"13","qt-faststart" +"13","search-regex" +"13","bigquery-public-datasets" +"13","glpointsize" +"13","flynn" +"13","structured-storage" +"13","sdmmc" +"13","vaadin-push" +"13","autofactory" +"13","beeswax" +"13","fluxlang" +"13","asciimatics" +"13","scriptservice" +"13","qtpositioning" +"13","gnu99" +"13","cve-2021-44228" +"13","webapp-runner" +"13","google-place-picker" +"13","thttpd" +"13","automoc" +"13","parse-live-query" +"13","query-help" +"13","threat-model" +"13","web-control" +"13","substratevm" +"13","cypress-iframe" +"13","autoreload" +"13","max-pool-size" +"13","zenhub" +"13","mui-autocomplete" +"13","ms-access-2002" +"13","compositeusertype" +"13","enigma2" +"13","statusbaritem" +"13","ignore-duplicates" +"13","zinc" +"13","preferencefragmentcompat" +"13","zoomify" +"13","ember-cli-pods" +"13","solidworkspdmapi" +"13","concurrent-vector" +"13","maven-install" +"13","embed-tag" +"13","powercommands" +"13","alpha-shape" +"13","stellaris" +"13","altium-designer" +"13","powerpoint-automation" +"13","measurementformatter" +"13","predicatewithformat" +"13","media-manager" +"13","so-reuseport" +"13","mu4e" +"13","solana-py" +"13","msbuild-14.0" +"13","emacs-projectile" +"13","emailfield" +"13","ijavascript" +"13","igcombo" +"13","compiler-as-a-service" +"13","predestroy" +"13","emoji-tones" +"13","spanish" +"13","prelink" +"13","mcl" +"13","ilias" +"13","identityserver5" +"12","tspl" +"12","smart-app-banner" +"12","renewcommand" +"12","renice" +"12","renode" +"12","yappi" +"12","sqlworkflowpersistencese" +"12","decrease-key" +"12","gforge" +"12","website-monitoring" +"12","antplus" +"12","dbmetal" +"12","babel-6" +"12","flink-state" +"12","graphson" +"12","ecobee-api" +"12","clipbucket" +"12","yarn-v4" +"12","flightpath" +"12","classy-prelude" +"12","jd-eclipse" +"12","slp" +"12","temenos" +"12","squirejs" +"12","weyland" +"12","jcurses" +"12","photosphereviewer" +"12","tensorflow-layers" +"12","ebooklib" +"12","transitional" +"12","livewire-powergrid" +"12","deadobjectexception" +"12","flutter-focus-node" +"12","re-python" +"12","ddx" +"12","trouble-tickets" +"12","websharper.ui.next" +"12","loadoptions" +"12","eclipseme" +"12","edgesdk" +"12","webtask" +"12","procrustes" +"12","template-lite" +"12","ant4eclipse" +"12","trusted-signing" +"12","template-control" +"12","print-job-control" +"12","prodigy" +"12","deferred-deep-linking" +"12","ggradar" +"12","trusted-types" +"12","fc" +"12","intel-pytorch" +"12","eclipse-digital-twin" +"12","wicket-1.4" +"12","localserversocket" +"12","fluentdata" +"12","fcitx" +"12","stagevideo" +"12","dcat" +"12","primeng-menu" +"12","remote-containers" +"12","eclipse-vorto" +"12","tsclust" +"12","intellilock" +"12","remove.bg" +"12","regula" +"12","rehype" +"12","rendermonkey" +"12","graphql-compose" +"12","edwin" +"12","git-ls-tree" +"12","gitlist" +"12","sqlsoup" +"12","jenkins-template-engine" +"12","jenkins-spock" +"12","trixbox" +"12","terminal.gui" +"12","webpack-watch" +"12","yeti" +"12","php-glide" +"12","backbone-paginator" +"12","backbase-portal" +"12","closesocket" +"12","grounddb" +"12","backupexec" +"12","apache-bloodhound" +"12","vue-sweetalert2" +"12","apache-ftpserver" +"12","clouddb" +"12","file-header" +"12","phplib" +"12","clj-kafka" +"12","gridlookupedit" +"12","react-native-deck-swiper" +"12","apache-commons-text" +"12","react-refresh" +"12","sketch.js" +"12","marqo" +"12","skb" +"12","groovyc" +"12","apache-commons-imaging" +"12","react-redux-connect" +"12","easy-rules" +"12","php-ffi" +"12","vue-pwa" +"12","banshee" +"12","barista" +"12","mathdotnet-symbolics" +"12","filedrop.js" +"12","function-template" +"12","selectionchanging" +"12","fundamentals-ts" +"12","snakeviz" +"12","pingaccess" +"12","fitch-proofs" +"12","mapbox-navigation" +"12","python-ipaddress" +"12","funnelweb" +"12","fxgl" +"12","unbuffered-output" +"12","django-angular" +"12","python-dataset" +"12","fxaa" +"12","flawfinder" +"12","package-design" +"12","pabx" +"12","pinnacle-cart" +"12","paapi" +"12","safari9" +"12","safari7" +"12","flatpack" +"12","bit-framework" +"12","saaskit" +"12","biweekly" +"12","s6" +"12","caxlsx" +"12","flask-table" +"12","semmle-ql" +"12","bjqs" +"12","manifoldjs" +"12","packr" +"12","biom" +"12","cbt" +"12","paf" +"12","pinging" +"12","xmake" +"12","laravel-charts" +"12","flashplayer-debug" +"12","pinyin" +"12","socialsharing-plugin" +"12","make-scorer" +"12","img-area-select-jquery" +"12","lapack++" +"12","smoothstep" +"12","selmer" +"12","binding-mode" +"12","many2one" +"12","imperative-languages" +"12","imperva" +"12","snorkel" +"12","lambdatest" +"12","ngx-uploader" +"12","import-hooks" +"12","uiveri5" +"12","laika" +"12","la-clojure" +"12","labelme" +"12","nhibernate-burrow" +"12","ujmp" +"12","unitofworkapplication" +"12","case-tools" +"12","ng2-admin" +"12","fixedpage" +"12","pairing-heap" +"12","kubeless" +"12","vshost32" +"12","python-billiard" +"12","fitted-box" +"12","fyber" +"12","advertised-shortcut" +"12","json-ref" +"12","xps-generation" +"12","smarthost" +"12","consul-health-check" +"12","jsfuck" +"12","symfony-http-kernel" +"12","symfony-bundle" +"12","symfony-assetmapper" +"12","adtf3" +"12","funcall" +"12","appcompatdialogfragment" +"12","aem-core-wcm-components" +"12","chrome-plugins" +"12","swtchart" +"12","apache-pig-grunt" +"12","circuits-framework" +"12","apache-tuscany" +"12","python-slate" +"12","cimbalino" +"12","data-science-studio" +"12","dbclient" +"12","firewall-rules" +"12","connect-modrewrite" +"12","adobe-exprience-manager" +"12","datocms" +"12","apache-xml-graphics" +"12","app2sd" +"12","connection-points" +"12","date-sunrise" +"12","apache-zest" +"12","jtc" +"12","chatjs" +"12","json2xls" +"12","jsctags" +"12","dbextensions" +"12","datastore-admin" +"12","cirrious.fluentlayout" +"12","aphrodite" +"12","jsr380" +"12","apfloat" +"12","pkg" +"12","dbd-mysql" +"12","jmxmp" +"12","fbloginview" +"12","mysql-error-1264" +"12","grails-3.0.10" +"12","jmspaymentpaypalbundle" +"12","grails-plugin-rabbitmq" +"12","mysql-error-1222" +"12","callfire" +"12","gosublime" +"12","grammar-induction" +"12","gotenberg" +"12","data-compaction" +"12","jinitiator" +"12","meteor-jasmine" +"12","fastly-vcl" +"12","ruby-dotenv" +"12","mysql-error-1130" +"12","ibm-oneui" +"12","camunda-spin" +"12","windows-application-driver" +"12","naked-objects" +"12","cakephp-ajaxhelper" +"12","rti-dds" +"12","window.external" +"12","windicss" +"12","vecmath" +"12","angular-sanitizer" +"12","vectorbt" +"12","microsoft-azure-documentdb" +"12","algol68" +"12","nanoboxio" +"12","iccid" +"12","microsoft-entra-external-id" +"12","rstudioapi" +"12","microsoft-graph-contacts" +"12","pycom" +"12","nativedroid" +"12","recursivetask" +"12","icontact" +"12","capture-output" +"12","verp" +"12","facilities" +"12","rsm" +"12","public-suffix-list" +"12","idangero" +"12","receive-location" +"12","punbb" +"12","alation" +"12","real-time-strategy" +"12","alassetsgroup" +"12","realplayer" +"12","facebooksdk.net" +"12","purescript-halogen" +"12","purescript-pux" +"12","rsbarcodes" +"12","pushapps" +"12","service-bus-explorer" +"12","universal-code" +"12","sitecore-lucene" +"12","crystal-reports-10" +"12","update-inner-join" +"12","urlaccess" +"12","rootpy" +"12","docker-registry-mirror" +"12","oracle-access-manager" +"12","aws-ebs-csi-driver" +"12","watson-personality-insights" +"12","simple-phpunit" +"12","simpowersystems" +"12","dkan" +"12","simplepager" +"12","updatecheck" +"12","kismet-wireless" +"12","rosetta-code" +"12","django-inline-models" +"12","django-intermediate-table" +"12","dns-get-record" +"12","oracle-http-server" +"12","untyped-variables" +"12","django-johnny-cache" +"12","hyperledger-fabric2.2" +"12","doctrine-orm-postgres" +"12","ora-06553" +"12","routedeventargs" +"12","do178-b" +"12","unleash" +"12","sharepoint2010-bcs" +"12","watchr" +"12","walrus" +"12","aws-mediatailor" +"12","ora-03113" +"12","keywordquery" +"12","django-rss" +"12","unnamed-class" +"12","ias" +"12","aws-copilot-cli" +"12","rl78" +"12","watchos-10" +"12","wago" +"12","keyboard-avoidance" +"12","roslyn-project-system" +"12","django-pandas" +"12","warp-scheduler" +"12","doctrine-mapping" +"12","django-recaptcha" +"12","worklight-cli" +"12","horn" +"12","nspoint" +"12","turbolinks-ios" +"12","justinmind" +"12","nested-statement" +"12","kameleo" +"12","kakao" +"12","bootp" +"12","sap-business-bydesign" +"12","wso2-asgardeo" +"12","jrecorder" +"12","gulpfile" +"12","gs1-databar" +"12","mojo-dom" +"12","nsaffinetransform" +"12","swfmill" +"12","apple-ii" +"12","azul-zing" +"12","countdownjs.js" +"12","ionic.io" +"12","turing-lang" +"12","online-forms" +"12","wtforms-json" +"12","apple-speech" +"12","hostinger" +"12","ncurses-cdk" +"12","apple-clang" +"12","ion-infinite-scroll" +"12","border-collapse" +"12","blazor-jsruntime" +"12","ttlauncheritem" +"12","initwithstyle" +"12","silk-central" +"12","neo4j-cql" +"12","spring-expression" +"12","saslidemenu" +"12","degenerate-dimension" +"12","grunt-svgstore" +"12","boost-fiber" +"12","grunt-ssh" +"12","silverlight-2-rc0" +"12","silverlightcontrols" +"12","arangodb-java" +"12","swiftgen" +"12","invantive-data-hub" +"12","grunt-eslint" +"12","intersystems-cache-studio" +"12","html5-qrcode" +"12","dynamics-nav-2015" +"12","createitem" +"12","springockito" +"12","blazy" +"12","html5-img" +"12","botframeworkemulator" +"12","sc" +"12","bosh" +"12","blazor-routing" +"12","modelmultiplechoicefield" +"12","write-through" +"12","nbug" +"12","axvline" +"12","httpapplicationstate" +"12","paw" +"12","grunt-angular-gettext" +"12","jquery-infinite-scroll" +"12","dynamically-loaded-xap" +"12","twitter-recess" +"12","dylan" +"12","open-array-parameters" +"12","openfb" +"12","application-size" +"12","appsee" +"12","modelvisual3d" +"12","openflashchart2" +"12","inline-if" +"12","wsacleanup" +"12","postman-flows" +"12","html-to-docx" +"12","navparams" +"12","pbrt" +"12","gtmsessionfetcher" +"12","k-combinator" +"12","easendmail" +"12","interfax" +"12","corewars" +"12","pcapy" +"12","wpf-interop" +"12","eastl" +"12","inlineeditbox" +"12","nestacms" +"12","swallowed-exceptions" +"12","dxcore" +"12","needleman-wunsch" +"12","mongo-driver" +"12","design-consideration" +"12","application-integration" +"12","mongodb-tools" +"12","enumdropdownlistfor" +"12","easyquery" +"12","kanso" +"12","inlay-hints" +"12","dynamic-data-exchange" +"12","axhost" +"12","applicationid" +"12","pd4ml" +"12","depottools" +"12","guidance-automation-tool" +"12","inpainting" +"12","deps-edn" +"12","onserviceconnected" +"12","samsung-galaxy-camera" +"12","karafka" +"12","jquery-ui-slider-pips" +"12","cots" +"12","lzf" +"12","neurolab" +"12","newsgroup" +"12","vlad-vector" +"12","mixed-case" +"12","osvr" +"12","videojs-transcript" +"12","oauth-2.1" +"12","minimumosversion" +"12","rbtools" +"12","wix2" +"12","javaexe" +"12","gomobile-android" +"12","osx-extensions" +"12","viewroot" +"12","mac-classic" +"12","abstract-machine" +"12","java-flow" +"12","javaimports" +"12","pyscreeze" +"12","typoscript2" +"12","machine.fakes" +"12","otcl" +"12","coco2d-x" +"12","facebook-browser" +"12","librabbitmq" +"12","abaqus-odb" +"12","oas3" +"12","raycast" +"12","android-app-quick-setting" +"12","vim-syntastic" +"12","javafx-datepicker" +"12","ext.list" +"12","frapi" +"12","view-debugging" +"12","audio-panning" +"12","nxt-python" +"12","javafx-gradle-plugin" +"12","android-banner" +"12","wizard-control" +"12","rbar" +"12","raspivid" +"12","atan" +"12","goldmine" +"12","audio-comparison" +"12","winwrap" +"12","pygsl" +"12","browserslist" +"12","ora-hash" +"12","amd-app" +"12","gocb" +"12","orafce" +"12","pyrender" +"12","netbeans-14" +"12","codepage-437" +"12","knockout-subscribe" +"12","ezpdf" +"12","ravenhq" +"12","pypi-regex" +"12","codesite" +"12","miniz" +"12","windows-virtual-pc" +"12","knowm-xchart" +"12","kolite" +"12","microsoft-graph-webhooks" +"12","pyportmidi" +"12","lexical-editor" +"12","koken" +"12","codeworld" +"12","network-conduit" +"12","shadow-removal" +"12","dominotogo" +"12","codeguard" +"12","system-databases" +"12","shady" +"12","range-partitions" +"12","objectgears" +"12","atlassprites" +"12","libmongoc" +"12","kotlin-context-receivers" +"12","code-elimination" +"12","libnds" +"12","reverseprojection" +"12","wkrefreshbackgroundtask" +"12","kobotoolbox" +"12","freeling" +"12","kover" +"12","system-rules" +"12","facebook-infer" +"12","klvdata" +"12","typescript-3.6" +"12","mirador" +"12","wmd-markdown" +"12","syncthing" +"12","pyimagej" +"12","sfu" +"12","jasync-sql" +"12","cofoundry" +"12","riak-js" +"12","kohana-3.0" +"12","windows-shortcut" +"12",".net-mac" +"12","ratecard-api" +"12","lxr" +"12","amplify-ios" +"12","luaplus" +"12","raml-java-parser" +"12","typeliteral" +"12","shutterstock" +"12","javasymbolsolver" +"12","goblin" +"12","shutdown-script" +"12","spu" +"12","pluggableprotocol" +"12","refreshable" +"12","azure-ml-component" +"12","jalopy" +"12","plugin-pattern" +"12","gdr" +"12","asp.net-mvc-awesome" +"12","tagfield" +"12","asp.net-mvc-custom-filter" +"12","itemrenderers" +"12","asmock" +"12","ds9" +"12","notification-content-extension" +"12","difference-between-rows" +"12","highspeed" +"12","png-transparency" +"12","coproduct" +"12","hlsl2glsl" +"12","expo-publish" +"12","asp.net-mvc-uihint" +"12","refinitiv-eikon" +"12","notifyitemchanged" +"12","mockingoose" +"12","copssh" +"12","r2dbc-mssql" +"12","vetiver" +"12","vestacp" +"12","tamagui" +"12","r2d2" +"12","double-double-arithmetic" +"12","tds-fdw" +"12","tangram" +"12","h2-console" +"12","dragenter" +"12","homomorphism" +"12","podman-networking" +"12","mobify" +"12","open-packaging-convention" +"12","dinamico" +"12","nodevm" +"12","gwt-test-utils" +"12","android-compose-exposeddropdown" +"12","tcpchannel" +"12","coq-plugin" +"12","node-xbee" +"12","tinn-r" +"12","polyline-decorator" +"12","nodist" +"12","pointplot" +"12","istool" +"12","gwt-dispatch" +"12","targetprocess" +"12","mms-gateway" +"12","openid-dex" +"12","openindiana" +"12","gwt-2.2" +"12","gvariant" +"12","nokia-n8" +"12","double-splat" +"12","openjscad" +"12","bwidget" +"12","buzztouch" +"12","rails-event-store" +"12","devise-async" +"12","bwip-js" +"12","ganon" +"12","red-gate-sql-prompt" +"12","scintillanet" +"12","sqlfire" +"12","rails-bullet" +"12","rails-roar" +"12","uiactivitycontroller" +"12","caching-application-block" +"12","reddison" +"12","redux-async-actions" +"12","npn" +"12","opera-presto" +"12","opensoundcontrol" +"12","redux-immutable" +"12","redis-om-spring" +"12","playscalajs" +"12","redis-om" +"12","control-adapter" +"12","npm-outdated" +"12","rackunit" +"12","gcc-4.2" +"12","tlbinf32" +"12","mkoverlaypathrenderer" +"12","scct" +"12","xcode12.3" +"12","expression-sketchflow" +"12","re-encoding" +"12","garnet-os" +"12","bzlmod" +"12","sqlite-cipher" +"12","dotmailer" +"12","assembly-trap" +"12","mobile-controls" +"12","nvidia-titan" +"12","handset" +"12","androidinjector" +"12","mixed-type" +"12","sqlalchemy-continuum" +"12","xcode13.3.1" +"12","convertigo" +"12","xcode12beta6" +"12","uisheetpresentationcontroller" +"12","handlerinterceptor" +"12","menuitem-selection" +"12","prometheus-adapter" +"12","omml" +"12","omemo" +"12","huawei-cloud" +"12","ofed" +"12","perlguts" +"12","spectre.console" +"12","esb-toolkit-2.1" +"12","on-behalf-of" +"12","onbeforeload" +"12","spoken-language" +"12","proxygen" +"12","huggingface-evaluate" +"12","centos7.6" +"12","charm++" +"12","qqmlcontext" +"12","offline-web-app" +"12","spgroup" +"12","pyupdater" +"12","qgadget" +"12","sphere.io" +"12","charmap" +"12","mergecursor" +"12","luadoc" +"12","qnx-ifs" +"12","lua-4.0" +"12","qif" +"12","meshroom" +"12","eslintignore" +"12","esp-idf-sys" +"12","pessimistic" +"12","lpad" +"12","mpkg" +"12","pywhatkit" +"12","pfbc" +"12","spiffe" +"12","projectlocker" +"12","spinnaker-cam" +"12","nhibernate-hql" +"12","irvine16" +"12","resharper-9.1" +"12","elaborated-type-specifier" +"12","restrserve" +"12","iron-elements" +"12","elastalert2" +"12","restore-points" +"12","google-compute-disk" +"12","elastic-enterprise-search" +"12","cometserver" +"12","perceptual-sdk" +"12","restkit-0.24.x" +"12","elasticnet" +"12","ips" +"12","lava" +"12","ace-tao" +"12","ipropertystorage" +"12","elasticsearch-1.6.0" +"12","restclientbuilder" +"12","react-location" +"12","google-cloud-save" +"12","google-cloud-run-jobs" +"12","nodechildren" +"12","color-gradient" +"12","iosched" +"12","colemak" +"12","android-reflection" +"12","google-cloud-interconnect" +"12","elasticsearch-phonetic" +"12","resolvejs" +"12","cube-script" +"12","elisp-macro" +"12","android-pullparser" +"12","node-ftp" +"12","actionscript-1" +"12","node-kafka-streams" +"12","active-attr" +"12","ipados13" +"12","acts-as-state-machine" +"12","ios-sqlite" +"12","respondcms" +"12","ip2long" +"12","customize-cra" +"12","perl-core" +"12","periodictimer" +"12","geom-map" +"12","getforegroundwindow" +"12","niagara-4" +"12","angular2-docheck" +"12","testswarm" +"12","httptransportse" +"12","laravel-unit-test" +"12","node-pg-migrate" +"12","generative-testing" +"12","getseq" +"12","testdoublejs" +"12","react-codemirror2" +"12","genericprincipal" +"12","genymotion-gps" +"12","test-and-target" +"12","testtrack" +"12","gervill" +"12","to-yaml" +"12","folksonomy" +"12","embedded-container" +"12","tiger" +"12","uudecode" +"12","compose-multiplatform-ios" +"12","shgo" +"12","qsignalspy" +"12","fog-google" +"12","autoblogged" +"12","uwf" +"12","ms-office-addin" +"12","static-if" +"12","cylon.js" +"12","zend-xmlrpc" +"12","allow-modals" +"12","global-query-filter" +"12","secure-trading" +"12","compound-operator" +"12","struts2-config-browser" +"12","tibero" +"12","em-websocket-client" +"12","belief-propagation" +"12","totara" +"12","ytt" +"12","all-in-one-event-calendar" +"12","hec-ras" +"12","google-notebook" +"12","yui-editor" +"12","google-site-verification-api" +"12","tortoisegitmerge" +"12","webchannelfactory" +"12","maven-multi-module" +"12","linux-mint-21" +"12","helix-editor" +"12","amazon-imagebuilder" +"12","preinit" +"12","glutcreatewindow" +"12","git-switch" +"12","best-first-search" +"12","haxepunk" +"12","msmqbinding" +"12","trait-bounds" +"12","compilationmode" +"12","steemit" +"12","hazelcast-cloud" +"12","embedio" +"12","gitsharp" +"12","mbsync" +"12","power-series" +"12","ie-plugins" +"12","iextenderprovider" +"12","compcert" +"12","embedded-script" +"12","std-invoke" +"12","usedapp" +"12","gkscore" +"12","user-testing" +"12","stylet" +"12","cypress-psoc" +"12","usda-fooddata-central-api" +"12","embedded-postgres" +"12","use-swr" +"12","architect" +"12","bfile" +"12","d3-geo" +"12","hdf5storage" +"12","parlai" +"12","std-call-once" +"12","sua" +"12","solr8.4.1" +"12","usage-tracking" +"12","d3-org-chart" +"12","argument-validation" +"12","bhm" +"12","bcompiler" +"12","statusnet" +"12","glfrustum" +"12","urlspan" +"12","daap" +"12","cypress-code-coverage" +"12","mcdm" +"12","stryker-net" +"12","font-replacement" +"12","sharpvectors" +"12","url-modification" +"12","dacapo" +"12","arm-linux" +"12","sheetrock" +"12","subdomain-fu" +"12","url-link" +"12","conda-pack" +"12","bayesglm" +"12","starcraftgym" +"12","webextension-storage" +"12","zammad" +"12","linq-to-ldap" +"12","tfs-2008" +"12","webloadui" +"12","zappdev" +"12","source-filter" +"12","passive-sts" +"12","linqbridge" +"12","allatori" +"12","weblistener" +"12","hetzner-cloud" +"12","arworldmap" +"12","starrocks" +"12","webodf" +"12","qtserial" +"12","preg-quote" +"12","mdspan" +"12","gnosis-safe" +"12","seaglass" +"12","allauth" +"12","spark2" +"12","mdw" +"12","help-files" +"12","multibox" +"12","zcash" +"12","google-sheets-filter-view" +"12","gnu-indent" +"12","mtasc" +"12","queued-connection" +"12","precompute" +"12","gmock" +"12","glyph-substitution" +"12","mediawiki-visualeditor" +"12","conceptnet" +"12","pptk" +"12","beautytips" +"12","quarkus-testing" +"12","mdls" +"12","webgrind" +"12","sourcery" +"12","libyang" +"11","primeng-checkbox" +"11","multitouch-keyboard" +"11","bash-it" +"11","cmfcmenubutton" +"11","sitespeedio" +"11","vticker" +"11","graphql-compose-mongoose" +"11","relstorage" +"11","pgsync" +"11","marmalade-edk" +"11","filecoin" +"11","mark-of-the-web" +"11","react-native-macos" +"11","yii-behaviour" +"11","clientside-caching" +"11","procstat" +"11","slickquiz" +"11","jenkins-php" +"11","balanced-groups" +"11","stalestateexception" +"11","intel-xdk-contacts" +"11","previewcallback" +"11","marklogic-11" +"11","clientresource" +"11","webtransport" +"11","productsign" +"11","wickedpicker" +"11","remoteserviceexception" +"11","php-generators" +"11","trtc.io" +"11","jaxb2-simplify-plugin" +"11","clustermap" +"11","mass-package" +"11","multiple-interface-implem" +"11","tronlink" +"11","apache-doris" +"11","lmtp" +"11","masstransit-courier" +"11","lobo-cobra" +"11","master-db" +"11","jaxb-episode" +"11","teamcity-rest-api" +"11","trusted-application" +"11","react-native-table-component" +"11","xsp2" +"11","masquerade" +"11","citymaps" +"11","masterslider" +"11","ansible-automation-platform" +"11","ecmascript-4" +"11","eclipse-europa" +"11","filemap" +"11","anypoint-mq" +"11","fbsnapshottestcase" +"11","jet.com-apis" +"11","ecobertura" +"11","localizedstringkey" +"11","fluent-mongo" +"11","badgerdb" +"11","cmake-js" +"11","react-native-upgrade" +"11","web-safe-fonts" +"11","release-cycle" +"11","trimble-maps" +"11","jazzylistview" +"11","clim" +"11","liveservertestcase" +"11","fluentbootstrap" +"11","process-injection" +"11","reliablesession" +"11","yii-form" +"11","badsqlgrammarexception" +"11","clickhouse-kafka" +"11","github-third-party-apps" +"11","matplotlib-table" +"11","skim" +"11","deducer" +"11","vue-functional-component" +"11","tensor-indexing" +"11","weechat" +"11","decorator-chaining" +"11","telecom" +"11","ef-postgresql" +"11","jcstress" +"11","clouddevelopmentkit" +"11","default-database" +"11","weixinjsbridge" +"11","vue-flickity" +"11","github-flow" +"11","phpfarm" +"11","tensorflow-decision-forests" +"11","teamwork-projects" +"11","flint" +"11","gridle" +"11","mvcextensions" +"11","dbmigrator" +"11","php-fig" +"11","wexpect" +"11","skreferencenode" +"11","anycast" +"11","repost" +"11","giteye" +"11","srvany" +"11","ant-junit" +"11","fedora-coreos" +"11","flippy" +"11","skyfloatinglabeltextfield" +"11","anti-xml" +"11","ternary-representation" +"11","dbsetup" +"11","bac0" +"11","anyhow" +"11","sscli" +"11","decisiontreeclassifier" +"11","vue-query" +"11","gridview.builder" +"11","yardoc" +"11","list.selectedvalue" +"11","slim-2" +"11","fedora-33" +"11","clflush" +"11","cdi-2.0" +"11","api-platform" +"11","pact-node" +"11","pimcore-datahub" +"11","cdo-emf" +"11","const-string" +"11","sel4" +"11","fileslurp" +"11","xhtml-mp" +"11","kuma" +"11","constructorargument" +"11","connect.js" +"11","jsonrpc4j" +"11","bioconda" +"11","kubernetes-vitess" +"11","pagekit" +"11","pagekite" +"11","apache-nifi-toolkit" +"11","xmlindex" +"11","uniform-cost-search" +"11","ftpes" +"11","independentsoft" +"11","consolas" +"11","ng2-semantic-ui" +"11","chocolatechip-ui" +"11","apache-unomi" +"11","swiftui-fileimporter" +"11","flarum" +"11","implicit-class" +"11","pircbot" +"11","fira-code" +"11","xml-crypto" +"11","langohr" +"11","fingerprintjs" +"11","smoothie.js" +"11","immutablearray" +"11","immer" +"11","json2csharp" +"11","imgix-js" +"11","flambe" +"11","pion-net" +"11","swiftui-table" +"11","flashmessenger" +"11","imposm" +"11","flashsocket" +"11","xml-document-transform" +"11","laravel-config" +"11","image-management" +"11","cimport" +"11","final-class" +"11","owasp-dependency-track" +"11","ox" +"11","filterfactory" +"11","content-platform-engine" +"11","imsdroid" +"11","pinned-shortcut" +"11","sybase-rs" +"11","p4vs" +"11","filewalker" +"11","xpc-target" +"11","l10n.js" +"11","sylius-resource" +"11","chropath" +"11","sym" +"11","disclosuregroup" +"11","bit-src" +"11","bits-per-pixel" +"11","kylix" +"11","flee" +"11","bitbucket-webhook" +"11","fleetboard" +"11","contactitem" +"11","contact-center" +"11","chrome-sync" +"11","pactflow" +"11","python-generateds" +"11","catch-exception" +"11","function-address" +"11","daypilot-scheduler" +"11","python-egg-cache" +"11","funambol" +"11","db2-express-c" +"11","s3-object-tagging" +"11","mariadb-connector" +"11","safariservices" +"11","advanced-threat-protection" +"11","python-control" +"11","python-constraint" +"11","sag" +"11","fullstory" +"11","semweb" +"11","appconkit" +"11","sails-redis" +"11","adobe-native-extensions" +"11","datumbox" +"11","python-inspect" +"11","platformview" +"11","vql" +"11","checkjs" +"11","snap-to-grid" +"11","xmlworkerhelper" +"11","pix" +"11","vscode-restclient" +"11","vscode-server" +"11","first-class-modules" +"11","jsr-275" +"11","five9" +"11","xmlstore" +"11","nginx-status" +"11","cartalyst" +"11","uiweb" +"11","xdp-ebpf" +"11","soap-rpc-encoded" +"11","cascade-filtering" +"11","soapformatter" +"11","carrierwave-direct" +"11","selenium-ruby" +"11","umbraco12" +"11","cargo-features" +"11","running-balance" +"11","mapisendmail" +"11","adjustviewbounds" +"11","selenium-builder" +"11","childactivity" +"11","databricks-notebook" +"11","document-preview" +"11","uplevel" +"11","aleph-ilp" +"11","push-promise" +"11","updateexception" +"11","reagent-forms" +"11","rsrc" +"11","gradle-cache" +"11","w3.js" +"11","warp10" +"11","push-relabel" +"11","servermiddleware" +"11","hyperkit" +"11","cssbundling-rails" +"11","hyperldger-fabric-peer" +"11","pyansys" +"11","vera++" +"11","iconutil" +"11","ora-00947" +"11","ora-00984" +"11","ora-01034" +"11","dojo2" +"11","graffiticms" +"11","call-directory-extension" +"11","ahk2" +"11","sharepoint-upgrade" +"11","grails-3.2" +"11","mysql-error-126" +"11","calendar-store" +"11","call-queue" +"11","django-rest-framework-permissions" +"11","sharepoint-documents" +"11","django-role-permissions" +"11","fb2" +"11","robotium-recorder" +"11","calculated-property" +"11","camel-jpa" +"11","watchmaker" +"11","django-localeurl" +"11","rtrt" +"11","mysqlcheck" +"11","grammarly" +"11","na.approx" +"11","django-sitetree" +"11","validates-associated" +"11","ajax.request" +"11","aws-sdk-android" +"11","campfire" +"11","jgitver" +"11","my-model-jami" +"11","dll-dependency" +"11","windb" +"11","validity.js" +"11","ruby-parser" +"11","operator-lifecycle-manager" +"11","vunit" +"11","vuze" +"11","nanodbc" +"11","urlbinding" +"11","roadkill-wiki" +"11","verold" +"11","gradlefx" +"11","pycoral" +"11","oracleinternals" +"11","gpu-managed-memory" +"11","ibm-maximo-worker-insights" +"11","gpu-local-memory" +"11","fairlearn" +"11","mhash" +"11","angularjs-slider" +"11","microbundle" +"11","jira-mobile-connect" +"11","angular-material-9" +"11","angular-material-tab" +"11","failable" +"11","fakevim" +"11","i2b2" +"11","r-lib-cpp11" +"11","redbird" +"11","recursive-templates" +"11","oracle-apex-22" +"11","ibm-swift-sandbox" +"11","fact++" +"11","ibm-was-oc" +"11","jqbargraph" +"11","crystal-reports-2005" +"11","oracle-map-viewer" +"11","ptokax" +"11","fastapi-crudrouter" +"11","gpu-overdraw" +"11","simplicity-studio" +"11","ptpython" +"11","pt-query-digest" +"11","aws-acm-certificate" +"11","hyper-virtualization" +"11","algorithmia" +"11","micromamba" +"11","wce" +"11","aws-databrew" +"11","angular-router-loader" +"11","animated-webp" +"11","dask-gateway" +"11","aws-automation" +"11","rebass" +"11","rmic" +"11","aws-amplify-vue" +"11","fancyupload" +"11","ora-12519" +"11","seqlock" +"11","avmutablevideocomposition" +"11","hypertrack" +"11","fare" +"11","realm-cloud" +"11","csf" +"11","facebooktoolkit" +"11","cross-domain-proxy" +"11","aws-cdk-context" +"11","rollingfilesink" +"11","unless" +"11","sinemacula" +"11","joomla3.9" +"11","fastify-jwt" +"11","farbtastic" +"11","svn-api" +"11","twiny" +"11","mongoose-deleteone" +"11","dynamodb-gsi" +"11","guitexture" +"11","jul-to-slf4j" +"11","jumblr" +"11","core-banking" +"11","wrapt" +"11","sbt-crossproject" +"11","couchdb-2.x" +"11","sbt-concat" +"11","twisted.words" +"11","sbt-aspectj" +"11","interval-intersection" +"11","core.match" +"11","earthly" +"11","applaud" +"11","neo4j-dotnet-driver" +"11","dynamicgridview" +"11","ergm" +"11","jquery-boilerplate" +"11","nsmergepolicy" +"11","nsmutablecopying" +"11","native-executable" +"11","gs1-qr-code" +"11","dynamics-crm-sdk" +"11","e57" +"11","twitter-client" +"11","azure-ase" +"11","population-count" +"11","jqxtreegrid" +"11","couchnode" +"11","hostnetwork" +"11","nsbatchupdaterequest" +"11","gulp-jest" +"11","hot-code-replace" +"11","tttattritubedlabel" +"11","infor-eam" +"11","episerver-forms" +"11","epoch.js" +"11","nsdecimal" +"11","ncftp" +"11","cramp" +"11","ws-ex-layered" +"11","negation-as-failure" +"11","dxgrid" +"11","svn-copy" +"11","crash-recovery" +"11","bowtie2" +"11","wpflocalizationextension" +"11","dependent-method-type" +"11","boost-container" +"11","cosmwasm" +"11","ert" +"11","twilio-sdk" +"11","corert" +"11","equalsverifier" +"11","bounded-quantification" +"11","neo4j.py" +"11","wpm" +"11","wpn-xm" +"11","android-time-square" +"11","gulp-connect-php" +"11","demeteorizer" +"11","jquery-mobile-loader" +"11","swift5.9" +"11","devdefined-oauth" +"11","ws-notification" +"11","sbt-sonatype" +"11","nehalem" +"11","spring-modulith" +"11","sbt-proguard" +"11","boomla" +"11","inline-editor" +"11","blendability" +"11","silverfrost-fortran" +"11","android-sdk-build-tools" +"11","bodybuilder.js" +"11","inputevent" +"11","silverlight-plugin" +"11","apple-profile-manager" +"11","android-sparsearray" +"11","oneplus6t" +"11","ndi" +"11","nest2" +"11","open4" +"11","inverse-match" +"11","applicationmanager" +"11","mod-filter" +"11","arangoimport" +"11","blcr" +"11","ndde" +"11","ndk-stack" +"11","input-button-image" +"11","simian" +"11","ionic-popover" +"11","peachpie" +"11","android-stlport" +"11","simmechanics" +"11","simple-authentication" +"11","grunt-contrib-jade" +"11","bolero" +"11","paypal-android-sdk" +"11","jxmapkit" +"11","html-xml-utils" +"11","axi4" +"11","portletbridge" +"11","post-type" +"11","ionic2-tabs" +"11","ndoc" +"11","kaleidoscope" +"11","axelor" +"11","kargers-algorithm" +"11","bluetooth-hci" +"11","application-warmup" +"11","jwasm" +"11","ontorefine" +"11","password-retrieval" +"11","path-iterator" +"11","ons-api" +"11","password-strength" +"11","delay-sign" +"11","pdfminersix" +"11","paver" +"11","ion-item" +"11","initialization-block" +"11","jvi" +"11","apple-watch-standalone" +"11","intunemam" +"11","netbanx-api" +"11","wordpress-3.9" +"11","rhea" +"11","libcoap" +"11","vlc-unity" +"11","wordpress-4.0" +"11","abstraction-layer" +"11","ordinal-classification" +"11","aba" +"11","mixcloud" +"11","mahara" +"11","extjs-form" +"11","osstatus" +"11","attestations" +"11","abstract-interpretation" +"11","objc-protocol" +"11","exscript" +"11","objc-message-send" +"11","orjson" +"11","oracle-xml-db-repository" +"11","mac-in-cloud" +"11","oanda" +"11","ormar" +"11","extension-objects" +"11","lempel-ziv-76" +"11","mitreid-connect" +"11","system-stored-procedures" +"11","system.web.extensions" +"11","browsercaps" +"11","networkcomms.net" +"11","rational-performance-test" +"11","orphan-removal" +"11","goangular" +"11","mindtouch" +"11","anchor-modeling" +"11","built.io" +"11","object-test-bench" +"11","letsencrypt-nginx-proxy-companion" +"11","anamorphism" +"11","go-generate" +"11","objectiveflickr" +"11","win-shell" +"11","breach-attack" +"11","oauth2-toolkit" +"11","mini-language" +"11","rawpy" +"11","wm-command" +"11","python.el" +"11","abbrevia" +"11","objective-c-framework" +"11","brep" +"11","libtins" +"11","authenticationchallenge" +"11","rim-4.2" +"11","tabbarios" +"11","siema" +"11","ufs" +"11","rim-4.6" +"11","rim-4.7" +"11","pykka" +"11","sfcartesianchart" +"11","facebook-field-expansion" +"11","microsoft-tag" +"11","kratos" +"11","23andme-api" +"11","authentication-flows" +"11","sifting-appender" +"11","freebase-acre" +"11","sigmaplot" +"11","visual-foxpro-9" +"11","java-war" +"11","java-persistence-api" +"11","obsidian-dataview" +"11","visual-c++-2022" +"11","komodo-ide" +"11","vim-tabular" +"11","min.js" +"11","codan" +"11","udisks" +"11","visual-age" +"11","atom-liveserver" +"11","microsoft-webdriver" +"11","retrying" +"11","ripping" +"11","shinyscreenshot" +"11","coderef" +"11","uccapi" +"11","midasr" +"11","pyisapie" +"11",".net-core-rc1" +"11","videogular2" +"11","neural-mt" +"11","setorientation" +"11","goofys" +"11","pyface" +"11","rallyapi" +"11","codeigniter-session" +"11",".net-internals" +"11",".net-interactive" +"11","japid" +"11","jaotc" +"11","korpus" +"11","9-bit-serial" +"11","occam-pi" +"11","google-api-key-restrictions" +"11","neuroph" +"11","lumen-5.5" +"11","10gen-csharp-driver" +"11","a2hs" +"11","goji" +"11","typewatch" +"11","lubm" +"11","1c" +"11","net-library" +"11","rainbows" +"11","forio-contour" +"11","razor-component-library" +"11","7digital" +"11","shopifysharp" +"11","type-only-import-export" +"11","sha1sum" +"11","google-api-cpp-client" +"11","oursql" +"11","lumisoft" +"11","visual-studio-exp-2013" +"11","sidekit" +"11","aac+" +"11","shopify-app-extension" +"11","audio-playback-agent" +"11","synchronizedcollection" +"11","revealing-prototype" +"11","convex.dev" +"11","gvfs" +"11","handlerexceptionresolver" +"11","policy-violation" +"11","cactoos" +"11","vertical-partitioning" +"11","screenshotexception" +"11","gvnix-es" +"11","policy-based-security" +"11","hard-real-time" +"11","gatsby-plugin-intl" +"11","handlersocket" +"11","polardb" +"11","dragonfly-bsd" +"11","redhat-decision-manager" +"11","redirectwithcookies" +"11","android-companion-device" +"11","drupal-commons" +"11","draftail" +"11","mksh" +"11","drawablegamecomponent" +"11","expectit" +"11","redismqserver" +"11","druid-rs" +"11","convoy-pattern" +"11","directml" +"11","cookie-policy" +"11","diagflow" +"11","control-state" +"11","tcustomcontrol" +"11","mobify-js" +"11","registrator" +"11","harvest-scm" +"11","hash-reference" +"11","mobirise" +"11","redux-logger" +"11","gadinterstitial" +"11","exotel-api" +"11","nuxtserverinit" +"11","exmpp" +"11","cache-oblivious" +"11","cache-money" +"11","veusz" +"11","hadoop-native-library" +"11","nvim.cmp" +"11","regionadapter" +"11","normalize-space" +"11","gemcutter" +"11","drupal-gmap" +"11","diem-cms" +"11","pluto" +"11","plexe" +"11","assembly-reference-path" +"11","assemblyfileversion" +"11","bulkhead" +"11","android-expandable-list-view" +"11","hook-widgets" +"11","dpd" +"11","hadoop2.7.3" +"11","cop" +"11","reference-parameters" +"11","bunch" +"11","asp.net-web-api-filters" +"11","mockall" +"11","bump2version" +"11","hopac" +"11","hllapi" +"11","scikit-build" +"11","xc32" +"11","sqlglot" +"11","sqliteexception" +"11","opentelemetry-js" +"11","tmsh" +"11","sproutcore-controllers" +"11","sprof" +"11","izimodal" +"11","xar" +"11","xcode-build-phase" +"11","tinyxpath" +"11","dotnet-dev-certs" +"11","token-pasting-operator" +"11","jambi" +"11","azure-xplat-cli" +"11","azure-synapse-link" +"11","uiactivityitemprovider" +"11","taiko" +"11","xamlbuild" +"11","spring-webtestclient" +"11","highcharts-boost" +"11","uialertsheet" +"11","iterator-range" +"11","sql-search" +"11","iterated-logarithm" +"11","spring-tld" +"11","scrapyjs" +"11","dspace-ecu" +"11","mod-authz-host" +"11","tapandhold" +"11","modal-sheet" +"11","rabbitmq-cluster" +"11","scrapy-request" +"11","hit-count" +"11","xcode11.5" +"11","quickcontact" +"11","tact" +"11","android-ble-library" +"11","hivecli" +"11","uifocusguide" +"11","azure-virtual-network-gateway" +"11","polymaps" +"11","xcode16" +"11","uidocumentpicker" +"11","uimotioneffect" +"11","sqlanydb" +"11","tabnine" +"11","tkpdfviewer" +"11","timing-diagram" +"11","r10k" +"11","xamarin.communitytoolkit" +"11","isomorphic-git" +"11","scnsphere" +"11","hivedb" +"11","tkintertable" +"11","azure-vm-extension" +"11","openshift-nextgen" +"11","wysihat" +"11","qx11embedcontainer" +"11","openmx" +"11","tactionlist" +"11","opennn" +"11","openshift-web-console" +"11","iphone-wax" +"11","esri-leaflet-geocoder" +"11","cfb-mode" +"11","merge-tracking" +"11","promoting" +"11","responsive-navigation" +"11","nltokenizer" +"11","cextension" +"11","text-capture" +"11","spline-data-lineage-tracker" +"11","eta-expansion" +"11","android-orm" +"11","cuda-wmma" +"11","iphone-3g" +"11","texlipse" +"11","ethercard" +"11","android-lottie" +"11","android-locale" +"11","certbot-dns-plugin" +"11","menubarextra" +"11","android-jetpack-compose-row" +"11","response.filter" +"11","android-jetpack-compose-pager" +"11","duckyscript" +"11","menpo" +"11","acts-as-nested-set" +"11","centrifugo" +"11","testflight-public-link" +"11","activity-oncreateview" +"11","centos-6.9" +"11","resourceproviderfactory" +"11","react-hot-toast" +"11","company-mode" +"11","nocilla" +"11","spdx" +"11","project-folder" +"11","terraform-cli" +"11","angular2-localstorage" +"11","ogl" +"11","large-query" +"11","spatie-activitylog" +"11","python-visual" +"11","angular-cdk-overlay" +"11","commondomain" +"11","restricted-profiles" +"11","niceforms" +"11","angular-jit" +"11","esdoc" +"11","comlink" +"11","mootools-sortable" +"11","generic-relationship" +"11","comet-ml" +"11","nifi-api" +"11","genesys-platform-sdk" +"11","react-native-0.46" +"11","react-multiselect-checkboxes" +"11","sparsehash" +"11","node-blade" +"11","sparse-columns" +"11","charm" +"11","eslint-plugin-react" +"11","charisma" +"11","laravel-pint" +"11","columnattribute" +"11","textlocal" +"11","prolog-tabling" +"11","messageformat.js" +"11","terraform-provider-vault" +"11","ipreviewhandler" +"11","colormath" +"11","prometheus-postgres-exporter" +"11","geometry-class-library" +"11","moops" +"11","ctfontref" +"11","ch" +"11","terraform-workspace" +"11","action-open-document-tree" +"11","access-database-engine" +"11","pen-tablet" +"11","required-reason-api" +"11","event-gateway" +"11","lso" +"11","action-scheduler" +"11","ios-mqtt-client-framework" +"11","hypercard" +"11","huobi" +"11","logstash-input-jdbc" +"11","react-charts" +"11","stplanr" +"11","qgrid" +"11","ios-icons" +"11","qgraphicspathitem" +"11","httpserverutility" +"11","oculus-runtime" +"11","lookup-field" +"11","google-cloud-php-client" +"11","react-concurrent" +"11","zwoptex" +"11","perfplot" +"11","stringdictionary" +"11","resig" +"11","qlocalserver" +"11","zumo" +"11","lovefield" +"11","requests-futures" +"11","custom-panel" +"11","active-passive" +"11","logical-reads" +"11","perl-html-template" +"11","qmultimap" +"11","reactablefmtr" +"11","react-developer-tools" +"11","streaming-video" +"11","odata-connected-service" +"11","linfu-dynamicproxy" +"11","glkbaseeffect" +"11","statsvn" +"11","urlsplit" +"11","quaqua" +"11","elm-test" +"11","webkit-appearance" +"11","gles20" +"11","elm-port" +"11","ar-mailer" +"11","go-agent" +"11","componentwillreceiveprops" +"11","pgjdbc-ng" +"11","amazon-sagemaker-clarify" +"11","haskell-src-exts" +"11","tfstate" +"11","qualified" +"11","beaker-testing" +"11","ascensor" +"11","source-separation" +"11","scrubyt" +"11","headereditemscontrol" +"11","component-design" +"11","sourcekitservice" +"11","embree" +"11","conf.d" +"11","qt6.4.1" +"11","compiled-bindings" +"11","webpack-handlebars-loader" +"11","mdxclient" +"11","user-environment" +"11","zend-config-xml" +"11","condition-system" +"11","dartpad" +"11","emokit" +"11","haven" +"11","precompiled-views" +"11","hbasetestingutility" +"11","git-revision" +"11","scriptom" +"11","stdstack" +"11","given" +"11","zerossl" +"11","if-case" +"11","gjslint" +"11","hcl-connections" +"11","archway-network" +"11","scrollbox" +"11","conditional-move" +"11","hcluster" +"11","zoomooz" +"11","uses-clause" +"11","msnodesqlv8" +"11","asgardcms" +"11","webmethods-caf" +"11","precompiled-binaries" +"11","maybeuninit" +"11","usesound" +"11","usb-modeswitch" +"11","ascmd" +"11","amasty" +"11","autogluon" +"11","scribe-server" +"11","lighty" +"11","arcface" +"11","amazon-macie" +"11","secevents" +"11","weavy" +"11","cycle-sort" +"11","preprocessor-meta-program" +"11","linearprogressindicator" +"11","mediarss" +"11","batchnorm" +"11","struts2-bootstrap-plugin" +"11","array-population" +"11","google-settings" +"11","totem" +"11","zipmap" +"11","em-synchrony" +"11","vaadin-designer" +"11","web-api-contrib" +"11","maven-jarsigner-plugin" +"11","array-initialize" +"11","avaudioconverter" +"11","flutter-tex" +"11","imageareaselect" +"11","ticoredatasync" +"11","dancer2" +"11","stario-sdk" +"11","thiserror" +"11","focus-stealing" +"11","global-key" +"11","sortedcollection" +"11","identityserver6" +"11","autocode" +"11","arview" +"11","multidrop-bus" +"11","multi-az" +"11","zio-json" +"11","allusersprofile" +"11","que" +"11","shenandoah" +"11","linqpad7" +"11","autodesk-tandem" +"11","startforegroundservice" +"11","sdhc" +"11","zen-of-python" +"11","endly" +"11","fontastic" +"11","google-oauth-.net-client" +"11","helm-tls" +"11","stitches" +"11","autodesk-vault" +"11","flutter-reactive-forms" +"11","sparktable" +"11","email-body" +"11","starship" +"11","amazon-parallelcluster" +"11","staticmatic" +"11","linux-rt" +"11","bigstatsr" +"11","topsy" +"11","lindo" +"11","folder-access" +"11","yui-datasource" +"11","automotive-grade-linux" +"11","static-language" +"10","square-checkout" +"10","process-accounting" +"10","skpsmtpmessage" +"10","react-native-skia" +"10","replaysubject" +"10","cloudcannon" +"10","fiducial-markers" +"10","triplot" +"10","dead-key" +"10","apache-edgent" +"10","procedural-music" +"10","maskededitvalidator" +"10","westwind" +"10","transfuse" +"10","instant-view" +"10","xssfworkbook" +"10","grapheme-cluster" +"10","github-fine-grained-tokens" +"10","bartmachine" +"10","problem-steps-recorder" +"10","reportprogress" +"10","websitespark" +"10","xsocket" +"10","lm-sensors" +"10","filenet-ce-sql" +"10","clib" +"10","regular-type" +"10","closeablehttpresponse" +"10","intacct" +"10","westwind-globalization" +"10","temporary-asp.net-files" +"10","profvis" +"10","reactql" +"10","ggtimeseries" +"10","deferrable-constraint" +"10","edify" +"10","skylink" +"10","clcircleregion" +"10","react-phone-input-2" +"10","decentralized-identifiers" +"10","ci-server" +"10","skein" +"10","staking" +"10","decimation" +"10","ghost-inspector" +"10","cloudflarestream" +"10","whitespace-language" +"10","intellij-idea-2020" +"10","sql-server-mobile" +"10","sql-server-on-linux" +"10","teneo" +"10","stampit.js" +"10","stackato" +"10","cloud-integration" +"10","react-rainbow-components" +"10","listview-selector" +"10","barebox" +"10","skype-uri.js" +"10","ggez" +"10","trestle-admin" +"10","ballerina-vscode-plugin" +"10","cloudscribe" +"10","cloudera-navigator" +"10","terasort" +"10","sql-trace" +"10","cloudera-director" +"10","intellij-16" +"10","react-notifications" +"10","stablebaseline3" +"10","tricore" +"10","renviron" +"10","websphere-mq-ams" +"10","trap" +"10","tridion-storage-extension" +"10","react-reducer" +"10","processmaker-api" +"10","transport-layer-protocol" +"10","cleartk" +"10","livestamp.js" +"10","team-city-10.0" +"10","flutter-font" +"10","cl-ppcre" +"10","flipside" +"10","easyrepro" +"10","fluent-bit-rewrite-tag" +"10","tsung-recorder" +"10","jdk1.8-73" +"10","multi-table-delete" +"10","ts-check" +"10","greenrobot-objectbox" +"10","materialapp" +"10","matrix-profile" +"10","yarp" +"10","jest-junit" +"10","mux-video" +"10","jedox" +"10","floating-ip" +"10","small-business-server" +"10","trustkit" +"10","fence-plots" +"10","vue-infinite-loading" +"10","graph-query" +"10","cmfcpropertypage" +"10","mathematical-notation" +"10","yfrog" +"10","clx" +"10","tsql-parser" +"10","photostream" +"10","photoview" +"10","cmockery" +"10","yecc" +"10","xvim" +"10","yii2-user-roles" +"10","dbt-bigquery" +"10","materialfx" +"10","tsparticles" +"10","feature-activation" +"10","truncate-log" +"10","slk" +"10","multiple-mice" +"10","eclipse-m2t-jet" +"10","eclipse-mdt" +"10","eclipse-2018-12" +"10","phalcon-devtools" +"10","ddex" +"10","fedora11" +"10","truevfs" +"10","slik" +"10","ckfetchrecordchangesopera" +"10","apache-http-server" +"10","feedbackpanel" +"10","flowbite-svelte" +"10","react-native-localize" +"10","php-ci" +"10","clang-plugin" +"10","tediousjs" +"10","yamlbeans" +"10","fbsdkappinvitecontent" +"10","vue-pdf" +"10","jenkins-mailer-plugin" +"10","eclipse-metadata" +"10","vsperfmon" +"10","jetpack-compose-swipe-to-dismiss" +"10","management-pack" +"10","s60-3rd-edition" +"10","adsapi-php.ini" +"10","implicit-grant" +"10","discordgo" +"10","xnanimation" +"10","managedthreadfactory" +"10","chatgpt-function-call" +"10","implicit-constructor" +"10","s3proxy" +"10","managedinstallerclass" +"10","rusage" +"10","voice-interaction" +"10","smspdu" +"10","filterexpression" +"10","socket.io-stream" +"10","castle-validators" +"10","json-everything" +"10","swixml" +"10","managed-ews" +"10","data-parallel-haskell" \ No newline at end of file diff --git a/docs/index.html b/docs/index.html new file mode 100644 index 0000000000..c3f9809962 --- /dev/null +++ b/docs/index.html @@ -0,0 +1,297 @@ + + + + + + + + + + + + + + Mal Web REPL + + +
+

Mal

+ +

Mal Web REPL

+ + + +
+
+
+
+ +

 

+
+
+
+ View source on Github

+
+
+ +
+ +
+

Mal at a glance

+
+ +
+
+

Datatypes

+ + + + + + + + + + + + + + + + + +
Maps{"key1" "val1", "key2" 123}
Lists(1 2 3 "four")
Vectors[1 2 3 4 "a" "b" "c" 1 2]
Scalarsa-symbol, "a string", :a_keyword, 123, nil, true, false
+
+
+

Functions

+ + + + + + + + + + + + + +
Calling(<function> + <args*>)
Defining named functions(def! <name> + (fn* + [<args*>] + <action>))
Anonymous function(fn* + [<args*>] + <action>)
+
+
+

Useful Macros and Special Forms

+ + + + + + + + + + + + + + + + + + + + + + +
Conditionalsif cond or
Multiple Actions (side-effects)(do + <action*>...)
Defining thingsdef! defmacro! let*
Quoting' ` ~ ~@
Examining macrosmacroexpand
+
+
+ +
+
+

Useful Functions

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Math+ - * /
Comparison/Boolean= < > <= >= not
Predicatesnil? true? false? symbol? keyword? string? list? vector? map? sequential?
Data processingmap apply
Data createlist vector hash-map
Data inspectionfirst rest get keys vals count get nth contains? empty?
Data manipulationconj cons concat assoc dissoc
Lists and Vectorsfirst rest nth seq
Hash Mapsget keys vals contains?
Stringsstr pr-str seq
Atomsatom atom? deref[@] reset! swap!
Metameta with-meta[^]
Outputprintln prn
+
+
+

JavaScript Interop

+ + + + + + + + + +
Evaluate JavaScript(js-eval "JS string to eval")
Method call/access(. js-fn arg...)
+
+
+ +
+ + + +
+ + + + + + + diff --git a/docs/notes.md b/docs/notes.md new file mode 100644 index 0000000000..15c3ebdfcf --- /dev/null +++ b/docs/notes.md @@ -0,0 +1,15 @@ +## Counting languages, implementations, and runtimes/MODES + +``` +# languages +$ egrep -v "\-mal\>|IMPL: mal,.*nim" IMPLS.yml | grep -o "\|IMPL: mal,.*nim" IMPLS.yml | grep -o "\|IMPL: mal,.*nim" IMPLS.yml | grep -o "\ max_history_length) { + lines = lines.slice(lines.length-max_history_length); + } + jq.SetHistory(lines); + } +} + +function jq_save_history(jq) { + var lines = jq.GetHistory(); + localStorage['mal_history'] = JSON.stringify(lines); +} + + +var readline = { + 'readline': function(prompt_str) { + return prompt(prompt_str); + }}; + +// Node vs browser behavior +var types = {}; +if (typeof module === 'undefined') { + var exports = types; +} + +// General functions + +function _obj_type(obj) { + if (_symbol_Q(obj)) { return 'symbol'; } + else if (_list_Q(obj)) { return 'list'; } + else if (_vector_Q(obj)) { return 'vector'; } + else if (_hash_map_Q(obj)) { return 'hash-map'; } + else if (_nil_Q(obj)) { return 'nil'; } + else if (_true_Q(obj)) { return 'true'; } + else if (_false_Q(obj)) { return 'false'; } + else if (_atom_Q(obj)) { return 'atom'; } + else { + switch (typeof(obj)) { + case 'number': return 'number'; + case 'function': return 'function'; + case 'string': return obj[0] == '\u029e' ? 'keyword' : 'string'; + default: throw new Error("Unknown type '" + typeof(obj) + "'"); + } + } +} + +function _sequential_Q(lst) { return _list_Q(lst) || _vector_Q(lst); } + + +function _equal_Q (a, b) { + var ota = _obj_type(a), otb = _obj_type(b); + if (!(ota === otb || (_sequential_Q(a) && _sequential_Q(b)))) { + return false; + } + switch (ota) { + case 'symbol': return a.value === b.value; + case 'list': + case 'vector': + if (a.length !== b.length) { return false; } + for (var i=0; i 0 ? obj : null; + } else if (types._vector_Q(obj)) { + return obj.length > 0 ? Array.prototype.slice.call(obj, 0): null; + } else if (types._string_Q(obj)) { + return obj.length > 0 ? obj.split('') : null; + } else if (obj === null) { + return null; + } else { + throw new Error("seq: called on non-sequence"); + } +} + + +function apply(f) { + var args = Array.prototype.slice.call(arguments, 1); + return f.apply(f, args.slice(0, args.length-1).concat(args[args.length-1])); +} + +function map(f, lst) { + return lst.map(function(el){ return f(el); }); +} + + +// Metadata functions +function with_meta(obj, m) { + var new_obj = types._clone(obj); + new_obj.__meta__ = m; + return new_obj; +} + +function meta(obj) { + // TODO: support symbols and atoms + if ((!types._sequential_Q(obj)) && + (!(types._hash_map_Q(obj))) && + (!(types._function_Q(obj)))) { + throw new Error("attempt to get metadata from: " + types._obj_type(obj)); + } + return obj.__meta__; +} + + +// Atom functions +function deref(atm) { return atm.val; } +function reset_BANG(atm, val) { return atm.val = val; } +function swap_BANG(atm, f) { + var args = [atm.val].concat(Array.prototype.slice.call(arguments, 2)); + atm.val = f.apply(f, args); + return atm.val; +} + +function js_eval(str) { + return interop.js_to_mal(eval(str.toString())); +} + +function js_method_call(object_method_str) { + var args = Array.prototype.slice.call(arguments, 1), + r = interop.resolve_js(object_method_str), + obj = r[0], f = r[1]; + var res = f.apply(obj, args); + return interop.js_to_mal(res); +} + +// types.ns is namespace of type functions +var ns = {'type': types._obj_type, + '=': types._equal_Q, + 'throw': mal_throw, + 'nil?': types._nil_Q, + 'true?': types._true_Q, + 'false?': types._false_Q, + 'number?': types._number_Q, + 'string?': types._string_Q, + 'symbol': types._symbol, + 'symbol?': types._symbol_Q, + 'keyword': types._keyword, + 'keyword?': types._keyword_Q, + 'fn?': types._fn_Q, + 'macro?': types._macro_Q, + + 'pr-str': pr_str, + 'str': str, + 'prn': prn, + 'println': println, + 'readline': readline.readline, + 'read-string': reader.read_str, + 'slurp': slurp, + '<' : function(a,b){return a' : function(a,b){return a>b;}, + '>=' : function(a,b){return a>=b;}, + '+' : function(a,b){return a+b;}, + '-' : function(a,b){return a-b;}, + '*' : function(a,b){return a*b;}, + '/' : function(a,b){return a/b;}, + "time-ms": time_ms, + + 'list': types._list, + 'list?': types._list_Q, + 'vector': types._vector, + 'vector?': types._vector_Q, + 'hash-map': types._hash_map, + 'map?': types._hash_map_Q, + 'assoc': assoc, + 'dissoc': dissoc, + 'get': get, + 'contains?': contains_Q, + 'keys': keys, + 'vals': vals, + + 'sequential?': types._sequential_Q, + 'cons': cons, + 'concat': concat, + 'nth': nth, + 'first': first, + 'rest': rest, + 'empty?': empty_Q, + 'count': count, + 'apply': apply, + 'map': map, + + 'conj': conj, + 'seq': seq, + + 'with-meta': with_meta, + 'meta': meta, + 'atom': types._atom, + 'atom?': types._atom_Q, + "deref": deref, + "reset!": reset_BANG, + "swap!": swap_BANG, + + 'js-eval': js_eval, + '.': js_method_call +}; + +exports.ns = core.ns = ns; +if (typeof module !== 'undefined') { +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function is_pair(x) { + return types._sequential_Q(x) && x.length > 0; +} + +function quasiquote(ast) { + if (!is_pair(ast)) { + return [types._symbol("quote"), ast]; + } else if (types._symbol_Q(ast[0]) && ast[0].value === 'unquote') { + return ast[1]; + } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { + return [types._symbol("concat"), + ast[0][1], + quasiquote(ast.slice(1))]; + } else { + return [types._symbol("cons"), + quasiquote(ast[0]), + quasiquote(ast.slice(1))]; + } +} + +function is_macro_call(ast, env) { + return types._list_Q(ast) && + types._symbol_Q(ast[0]) && + env.find(ast[0]) && + env.get(ast[0])._ismacro_; +} + +function macroexpand(ast, env) { + while (is_macro_call(ast, env)) { + var mac = env.get(ast[0]); + ast = mac.apply(mac, ast.slice(1)); + } + return ast; +} + +function eval_ast(ast, env) { + if (types._symbol_Q(ast)) { + return env.get(ast); + } else if (types._list_Q(ast)) { + return ast.map(function(a) { return EVAL(a, env); }); + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[EVAL(k, env)] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } +} + +function _EVAL(ast, env) { + while (true) { + + //printer.println("EVAL:", printer._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + ast = macroexpand(ast, env); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + if (ast.length === 0) { + return ast; + } + + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i], EVAL(a1[i+1], let_env)); + } + ast = a2; + env = let_env; + break; + case "quote": + return a1; + case "quasiquote": + ast = quasiquote(a1); + break; + case 'defmacro!': + var func = EVAL(a2, env); + func._ismacro_ = true; + return env.set(a1, func); + case 'macroexpand': + return macroexpand(a1, env); + case "try*": + try { + return EVAL(a1, env); + } catch (exc) { + if (a2 && a2[0].value === "catch*") { + if (exc instanceof Error) { exc = exc.message; } + return EVAL(a2[2], new Env(env, [a2[1]], [exc])); + } else { + throw exc; + } + } + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; + } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0]; + if (f.__ast__) { + ast = f.__ast__; + env = f.__gen_env__(el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + + } +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var repl_env = new Env(); +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +// core.js: defined using javascript +for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } +repl_env.set(types._symbol('eval'), function(ast) { + return EVAL(ast, repl_env); }); +repl_env.set(types._symbol('*ARGV*'), []); + +// core.mal: defined using the language itself +rep("(def! *host-language* \"javascript\")") +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +rep("(def! inc (fn* [x] (+ x 1)))"); +rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"); +rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"); + +if (typeof process !== 'undefined' && process.argv.length > 2) { + repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + rep("(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/js/web/skeleton.css b/docs/web/skeleton.css similarity index 100% rename from js/web/skeleton.css rename to docs/web/skeleton.css diff --git a/mal/clojurewest2014.mal b/examples/clojurewest2014.mal similarity index 93% rename from mal/clojurewest2014.mal rename to examples/clojurewest2014.mal index 2b5be9c665..c88afe2d69 100755 --- a/mal/clojurewest2014.mal +++ b/examples/clojurewest2014.mal @@ -25,10 +25,10 @@ (list (list (title2 " __ __ _ _") - (title2 "| \/ | / \ | |") - (title2 "| |\/| | / _ \ | | ") - (title2 "| | | |/ ___ \| |___ ") - (title2 "|_| |_/_/ \_\_____|")) + (title2 "| \\/ | / \\ | |") + (title2 "| |\\/| | / _ \\ | | ") + (title2 "| | | |/ ___ \\| |___ ") + (title2 "|_| |_/_/ \\_\\_____|")) (list (title "gherkin") "- a lisp1 written in bash4") @@ -84,7 +84,7 @@ "- performance" "- namespaces" "- keywords" - "- GC (in bash, make, C implmentations)" + "- GC (in bash, make, C implementations)" "- lots of other things") (list (title "why?") @@ -124,4 +124,3 @@ (present (rest slides)))))) (present conj-slides) - diff --git a/examples/exercises.mal b/examples/exercises.mal new file mode 100644 index 0000000000..babdfc7e67 --- /dev/null +++ b/examples/exercises.mal @@ -0,0 +1,163 @@ +;; These are the answers to the questions in ../docs/exercise.md. + +;; In order to avoid unexpected circular dependencies among solutions, +;; this answer file attempts to be self-contained. +(def! reduce (fn* (f init xs) + (if (empty? xs) init (reduce f (f init (first xs)) (rest xs))))) +(def! foldr (fn* [f init xs] + (if (empty? xs) init (f (first xs) (foldr f init (rest xs)))))) + +;; Reimplementations. + +(def! nil? (fn* [x] (= x nil ))) +(def! true? (fn* [x] (= x true ))) +(def! false? (fn* [x] (= x false))) +(def! empty? (fn* [x] (= x [] ))) + +(def! sequential? + (fn* [x] + (if (list? x) true (vector? x)))) + +(def! > (fn* [a b] (< b a) )) +(def! <= (fn* [a b] (not (< b a)))) +(def! >= (fn* [a b] (not (< a b)))) + +(def! list (fn* [& xs] xs)) +(def! vec (fn* [xs] (apply vector xs))) +(def! prn (fn* [& xs] (println (apply pr-str xs)))) +(def! hash-map (fn* [& xs] (apply assoc {} xs))) +(def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs)))) + +(def! count + (fn* [xs] + (if (nil? xs) + 0 + (reduce (fn* [acc _] (+ 1 acc)) 0 xs)))) +(def! nth + (fn* [xs index] + (if (if (<= 0 index) (not (empty? xs))) ; logical and + (if (= 0 index) + (first xs) + (nth (rest xs) (- index 1))) + (throw "nth: index out of range")))) +(def! map + (fn* [f xs] + (foldr (fn* [x acc] (cons (f x) acc)) () xs))) +(def! concat + (fn* [& xs] + (foldr (fn* [x acc] (foldr cons acc x)) () xs))) +(def! conj + (fn* [xs & ys] + (if (vector? xs) + (vec (concat xs ys)) + (reduce (fn* [acc x] (cons x acc)) xs ys)))) + +(def! do2 (fn* [& xs] (nth xs (- (count xs) 1)))) +(def! do3 (fn* [& xs] (reduce (fn* [_ x] x) nil xs))) +;; do2 will probably be more efficient when lists are implemented as +;; arrays with direct indexing, but when they are implemented as +;; linked lists, do3 may win because it only does one traversal. + +(defmacro! quote2 (fn* [ast] + (list (fn* [] ast)))) +(def! _quasiquote_iter (fn* [x acc] + (if (if (list? x) (= (first x) 'splice-unquote)) ; logical and + (list 'concat (first (rest x)) acc) + (list 'cons (list 'quasiquote2 x) acc)))) +(defmacro! quasiquote2 (fn* [ast] + (if (list? ast) + (if (= (first ast) 'unquote) + (first (rest ast)) + (foldr _quasiquote_iter () ast)) + (if (vector? ast) + (list 'vec (foldr _quasiquote_iter () ast)) + (list 'quote ast))))) + +;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns +;; (f k1 v1 (f k2 v2 (f ... (f kn vn)))). +(def! _foldr_pairs (fn* [f init kvs] + (if (empty? kvs) + init + (let* [key (first kvs) + rst (rest kvs) + val (first rst) + acc (_foldr_pairs f init (rest rst))] + (f key val acc))))) +(defmacro! let*A (fn* [binds form] + (let* [formal (_foldr_pairs (fn* [key val acc] (cons key acc)) () binds) + actual (_foldr_pairs (fn* [key val acc] (cons val acc)) () binds)] + `((fn* ~formal ~form) ~@actual)))) +;; Fails for (let* [a 1 b (+ 1 a)] b) +(defmacro! let*B (fn* [binds form] + (let* [f (fn* [key val acc] + `((fn* [~key] ~acc) ~val))] + (_foldr_pairs f form binds)))) +;; Fails for (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1)) +(def! _c_combinator (fn* [x] (x x))) +(def! _d_combinator (fn* [f] (fn* [x] (f (fn* [v] ((x x) v)))))) +(def! _Y_combinator (fn* [x] (_c_combinator (_d_combinator x)))) +(defmacro! let*C (fn* [binds form] + (let* [f (fn* [key val acc] + `((fn* [~key] ~acc) (_Y_combinator (fn* [~key] ~val))))] + (_foldr_pairs f form binds)))) +;; Fails for mutual recursion. +;; See http://okmij.org/ftp/Computation/fixed-point-combinators.html +;; if you are motivated to implement solution D. + +(def! apply + ;; Replace (f a b [c d]) with ('f 'a 'b 'c 'd) then evaluate the + ;; resulting function call (the surrounding environment does not + ;; matter when evaluating a function call). + ;; Use nil as marker to detect deepest recursive call. + (let* [q (fn* [x] (list 'quote x)) + iter (fn* [x acc] + (if (nil? acc) ; x is the last element (a sequence) + (map q x) + (cons (q x) acc)))] + (fn* [& xs] (eval (foldr iter nil xs))))) + +;; Folds + +(def! sum (fn* [xs] (reduce + 0 xs))) +(def! product (fn* [xs] (reduce * 1 xs))) + +(def! conjunction + (let* [and2 (fn* [acc x] (if acc x false))] + (fn* [xs] + (reduce and2 true xs)))) +(def! disjunction + (let* [or2 (fn* [acc x] (if acc true x))] + (fn* [xs] + (reduce or2 false xs)))) +;; It would be faster to stop the iteration on first failure +;; (conjunction) or success (disjunction). Even better, `or` in the +;; stepA and `and` in `core.mal` stop evaluating their arguments. + +;; Yes, -2-3-4 means (((0-2)-3)-4). + +;; `(reduce str "" xs)` is equivalent to `apply str xs` +;; and `(reduce concat () xs)` is equivalent to `apply concat xs`. +;; The built-in iterations are probably faster. + +;; `(reduce (fn* [acc _] acc) nil xs)` is equivalent to `nil`. + +;; For (reduce (fn* [acc x] x) nil xs))), see do3 above. + +;; `(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)` computes the +;; maximum of a list of non-negative integers. It is hard to find an +;; initial value fitting all purposes. + +(def! sum_len + (let* [add_len (fn* [acc x] (+ acc (count x)))] + (fn* [xs] + (reduce add_len 0 xs)))) +(def! max_len + (let* [update_max (fn* [acc x] (let* [l (count x)] (if (< acc l) l acc)))] + (fn* [xs] + (reduce update_max 0 xs)))) + +;; (fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs)) +;; computes the composition of an arbitrary number of functions. +;; The first anonymous function is the mathematical composition. +;; For practical purposes, `->` and `->>` in `core.mal` are more +;; efficient and general. diff --git a/examples/hello.mal b/examples/hello.mal new file mode 100644 index 0000000000..165efc4f65 --- /dev/null +++ b/examples/hello.mal @@ -0,0 +1,2 @@ +(println "hello world\n\nanother line") +(println "and another line") diff --git a/examples/presentation.mal b/examples/presentation.mal new file mode 100755 index 0000000000..4e0c3383bc --- /dev/null +++ b/examples/presentation.mal @@ -0,0 +1,122 @@ +;; Mal Presentation + +(def! clear + (fn* () + (str ""))) + +(def! bold + (fn* (s) + (str "" s ""))) + +(def! blue + (fn* (s) + (str "" s ""))) + +(def! title + (fn* (s) + (bold (blue (str s "\n"))))) + +(def! title2 + (fn* (s) + (bold (blue s)))) + + +(def! slides + (list + (list + (title2 " __ __ _ _") + (title2 "| \/ | / \ | |") + (title2 "| |\/| | / _ \ | | ") + (title2 "| | | |/ ___ \| |___ ") + (title2 "|_| |_/_/ \_\_____|")) + (list + (title "gherkin") + "- a lisp1 written in bash4") + (list + (title "mal - an interpreter for a subset of Clojure")) + (list + (title "mal - an interpreter for a subset of Clojure") + "- written in GNU make") + (list + (title "mal - an interpreter for a subset of Clojure") + "- written in GNU make" + "- and Bash 4") + (list + (title "mal - an interpreter for a subset of Clojure") + "- written in GNU make" + "- and Bash 4" + "- and Javascript") + (list + (title "mal - an interpreter for a subset of Clojure") + "- written in GNU make" + "- and Bash 4" + "- and Javascript" + "- and Python") + (list + (title "mal - an interpreter for a subset of Clojure") + "- written in GNU make" + "- and Bash 4" + "- and Javascript" + "- and Python" + "- and Clojure") + (list + (title "mal - an interpreter for a subset of Clojure") + "- written in GNU make" + "- and Bash 4" + "- and Javascript" + "- and Python" + "- and Clojure" + "- and 17 other languages") + (list + (title "things it has") + "- scalars: integers, strings, symbols, keywords, nil, true, false" + "- immutable collections: lists, vectors, hash-maps" + "- metadata, atoms" + "- def!, fn*, let*" + " - varargs: (fn* (x y & more) ...)" + "- tail call optimization" + " - except GNU make implementation (no iteration)" + "- macros (quote, unquote, quasiquote, splice-quote)" + "- over 500 unit tests" + "- REPL with line editing (GNU readline/libedit/linenoise)") + (list + (title "things it does not have") + "- performance" + "- namespaces" + "- GC (in bash, make, C implementations)" + "- protocols :-(" + "- lots of other things") + (list + (title "why?") + "- because!") + (list + (title "why?") + "- because!" + "- gherkin was an inspiration to higher levels of crazy" + "- evolved into learning tool" + "- way to learn about Lisp and also the target language" + "- each implementation broken into small 11 steps") + (list + (title "thanks to:") + "- Peter Norvig: inspiration: lispy" + " - http://norvig.com/lispy.html" + "- Alan Dipert: gherkin, original gherkin slides" + " - https://github.com/alandipert/gherkin") + (list + (title "mal - Make a Lisp") + "https://github.com/kanaka/mal") + (list + (title "demo")))) + +(def! present + (fn* (slides) + (if (> (count slides) 0) + (do + (println (clear)) + + (apply println (map (fn* (line) (str "\n " line)) (first slides))) + (println "\n\n\n") + (readline "") + (present (rest slides)))))) + +(present slides) diff --git a/forth/Makefile b/forth/Makefile deleted file mode 100644 index 29bf79922d..0000000000 --- a/forth/Makefile +++ /dev/null @@ -1,10 +0,0 @@ -SOURCES_BASE = types.fs str.fs reader.fs printer.fs -SOURCES_LISP = env.fs core.fs stepA_mal.fs -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/forth/core.fs b/forth/core.fs deleted file mode 100644 index 1a1cc4ddf1..0000000000 --- a/forth/core.fs +++ /dev/null @@ -1,224 +0,0 @@ -require env.fs - -0 MalEnv. constant core - -: args-as-native { argv argc -- entry*argc... } - argc 0 ?do - argv i cells + @ as-native - loop ; - -: defcore* ( sym xt ) - MalNativeFn. core env/set ; - -: defcore - parse-allot-name MalSymbol. ( xt ) - ['] defcore* :noname ; - -defcore + args-as-native + MalInt. ;; -defcore - args-as-native - MalInt. ;; -defcore * args-as-native * MalInt. ;; -defcore / args-as-native / MalInt. ;; -defcore < args-as-native < mal-bool ;; -defcore > args-as-native > mal-bool ;; -defcore <= args-as-native <= mal-bool ;; -defcore >= args-as-native >= mal-bool ;; - -defcore list { argv argc } - argc cells allocate throw { start } - argv start argc cells cmove - start argc MalList. ;; - -defcore vector { argv argc } - argc cells allocate throw { start } - argv start argc cells cmove - start argc MalList. - MalVector new swap over MalVector/list ! ;; - -defcore empty? drop @ empty? ;; -defcore count drop @ mal-count ;; - -defcore = drop dup @ swap cell+ @ swap m= mal-bool ;; -defcore not - drop @ - dup mal-nil = if - drop mal-true - else - mal-false = if - mal-true - else - mal-false - endif - endif ;; - -: pr-str-multi ( readably? argv argc ) - ?dup 0= if drop 0 0 - else - { argv argc } - new-str - argv @ pr-buf - argc 1 ?do - a-space - argv i cells + @ pr-buf - loop - endif ; - -defcore prn true -rot pr-str-multi type cr drop mal-nil ;; -defcore pr-str true -rot pr-str-multi MalString. nip ;; -defcore println false -rot pr-str-multi type cr drop mal-nil ;; -defcore str ( argv argc ) - dup 0= if - MalString. - else - { argv argc } - false new-str - argc 0 ?do - argv i cells + @ pr-buf - loop - MalString. nip - endif ;; - -defcore read-string drop @ unpack-str read-str ;; -defcore slurp drop @ unpack-str slurp-file MalString. ;; - -defcore cons ( argv[item,coll] argc ) - drop dup @ swap cell+ @ ( item coll ) - to-list conj ;; - -defcore concat { lists argc } - MalList new - lists over MalList/start ! - argc over MalList/count ! - MalList/concat ;; - -defcore conj { argv argc } - argv @ ( coll ) - argc 1 ?do - argv i cells + @ swap conj - loop ;; - -defcore assoc { argv argc } - argv @ ( coll ) - argv argc cells + argv cell+ +do - i @ \ key - i cell+ @ \ val - rot assoc - 2 cells +loop ;; - -defcore keys ( argv argc ) - drop @ MalMap/list @ - dup MalList/start @ swap MalList/count @ { start count } - here - start count cells + start +do - i @ , - 2 cells +loop - here>MalList ;; - -defcore vals ( argv argc ) - drop @ MalMap/list @ - dup MalList/start @ swap MalList/count @ { start count } - here - start count cells + start cell+ +do - i @ , - 2 cells +loop - here>MalList ;; - -defcore dissoc { argv argc } - argv @ \ coll - argv argc cells + argv cell+ +do - i @ swap dissoc - cell +loop ;; - -defcore hash-map { argv argc } - MalMap/Empty - argc cells argv + argv +do - i @ i cell+ @ rot assoc - 2 cells +loop ;; - -defcore get { argv argc } - argc 3 < if mal-nil else argv cell+ cell+ @ endif - argv cell+ @ \ key - argv @ \ coll - get ;; - -defcore contains? { argv argc } - 0 - argv cell+ @ \ key - argv @ \ coll - get 0 <> mal-bool ;; - -defcore nth ( argv[coll,i] argc ) - drop dup @ to-list ( argv list ) - swap cell+ @ MalInt/int @ ( list i ) - over MalList/count @ ( list i count ) - 2dup >= if { i count } - 0 0 - new-str i int>str str-append s\" \040>= " count int>str - s" nth out of bounds: " ...throw-str - endif drop ( list i ) - cells swap ( c-offset list ) - MalList/start @ + @ ;; - -defcore first ( argv[coll] argc ) - drop @ to-list - dup MalList/count @ 0= if - drop mal-nil - else - MalList/start @ @ - endif ;; - -defcore rest ( argv[coll] argc ) - drop @ to-list MalList/rest ;; - -defcore meta ( argv[obj] argc ) - drop @ mal-meta @ - ?dup 0= if mal-nil endif ;; - -defcore with-meta ( argv[obj,meta] argc ) - drop ( argv ) - dup cell+ @ swap @ ( meta obj ) - dup mal-type @ MalTypeType-struct @ ( meta obj obj-size ) - dup allocate throw { new-obj } ( meta obj obj-size ) - new-obj swap cmove ( meta ) - new-obj mal-meta ! ( ) - new-obj ;; - -defcore atom ( argv[val] argc ) - drop @ Atom. ;; - -defcore deref ( argv[atom] argc ) - drop @ Atom/val @ ;; - -defcore reset! ( argv[atom,val] argc ) - drop dup cell+ @ ( argv val ) - dup -rot swap @ Atom/val ! ;; - -defcore apply { argv argc -- val } - \ argv is (fn args... more-args) - argv argc 1- cells + @ to-list { more-args } - argc 2 - { list0len } - more-args MalList/count @ list0len + { final-argc } - final-argc cells allocate throw { final-argv } - argv cell+ final-argv list0len cells cmove - more-args MalList/start @ final-argv list0len cells + final-argc list0len - cells cmove - final-argv final-argc argv @ invoke ;; - -defcore throw ( argv argc -- ) - drop @ to exception-object - 1 throw ;; - -defcore map? drop @ mal-type @ MalMap = mal-bool ;; -defcore list? drop @ mal-type @ MalList = mal-bool ;; -defcore vector? drop @ mal-type @ MalVector = mal-bool ;; -defcore keyword? drop @ mal-type @ MalKeyword = mal-bool ;; -defcore symbol? drop @ mal-type @ MalSymbol = mal-bool ;; -defcore atom? drop @ mal-type @ Atom = mal-bool ;; -defcore true? drop @ mal-true = mal-bool ;; -defcore false? drop @ mal-false = mal-bool ;; -defcore nil? drop @ mal-nil = mal-bool ;; - -defcore sequential? drop @ sequential? ;; - -defcore keyword drop @ unpack-str MalKeyword. ;; -defcore symbol drop @ unpack-str MalSymbol. ;; - -defcore time-ms 2drop utime d>s 1000 / MalInt. ;; diff --git a/forth/printer.fs b/forth/printer.fs deleted file mode 100644 index 85f88a0fb6..0000000000 --- a/forth/printer.fs +++ /dev/null @@ -1,114 +0,0 @@ -require str.fs -require types.fs - -\ === printer protocol and implementations === / - -def-protocol-method pr-buf ( readably? str-addr str-len this -- str-addr str-len ) -def-protocol-method pr-seq-buf ( readably? str-addr str-len this -- str-addr str-len ) - -: pr-str { obj } - true new-str obj pr-buf rot drop ; - -\ Examples of extending existing protocol methods to existing type -MalDefault - extend pr-buf - { this } - s" #<" str-append - this mal-type @ type-name str-append - a-space - this int>str str-append - s" >" str-append ;; -drop - -MalNil extend pr-buf drop s" nil" str-append ;; drop -MalTrue extend pr-buf drop s" true" str-append ;; drop -MalFalse extend pr-buf drop s" false" str-append ;; drop - -MalList - extend pr-buf - -rot s" (" str-append ( list str-addr str-len ) - rot pr-seq-buf - s" )" str-append ;; - extend pr-seq-buf { list } - list MalList/count @ 0 > if - list MalList/start @ { start } - start @ pr-buf - list MalList/count @ 1 ?do - a-space - start i cells + @ pr-buf - loop - endif ;; -drop - -MalVector - extend pr-buf - MalVector/list @ - -rot s" [" str-append ( list str-addr str-len ) - rot pr-seq-buf - s" ]" str-append ;; -drop - -MalMap - extend pr-buf - MalMap/list @ - -rot s" {" str-append ( list str-addr str-len ) - rot { list } - list MalList/count @ { count } - count 0 > if - list MalList/start @ { start } - start @ pr-buf a-space start cell+ @ pr-buf - count 2 / 1 ?do - s" , " str-append - start i 2 * cells + @ pr-buf a-space - start i 2 * 1+ cells + @ pr-buf - loop - endif - s" }" str-append ;; -drop - -MalInt - extend pr-buf - MalInt/int @ int>str str-append ;; -drop - -MalSymbol - extend pr-buf - unpack-sym str-append ;; -drop - -MalKeyword - extend pr-buf { kw } - s" :" str-append - kw unpack-keyword str-append ;; -drop - -: escape-str { addr len } - s\" \"" str-append - addr len + addr ?do - i c@ case - [char] " of s\" \\\"" str-append endof - [char] \ of s\" \\\\" str-append endof - 10 of s\" \\n" str-append endof - 13 of s\" \\r" str-append endof - -rot i 1 str-append rot - endcase - loop - s\" \"" str-append ; - -MalString - extend pr-buf - dup MalString/str-addr @ - swap MalString/str-len @ - 4 pick if - escape-str - else - str-append - endif ;; -drop - -Atom - extend pr-buf { this } - s" (atom " str-append - this Atom/val @ pr-buf - s" )" str-append ;; -drop \ No newline at end of file diff --git a/forth/reader.fs b/forth/reader.fs deleted file mode 100644 index 134749b3ec..0000000000 --- a/forth/reader.fs +++ /dev/null @@ -1,147 +0,0 @@ -require types.fs -require printer.fs - -\ Drop a char off the front of string by advancing the addr and -\ decrementing the length, and fetch next char -: adv-str ( str-addr str-len -- str-addr str-len char ) - swap 1+ swap 1- - dup 0= if 0 ( eof ) - else over c@ endif ; - -: mal-digit? ( char -- flag ) - dup [char] 9 <= if - [char] 0 >= - else - drop 0 - endif ; - -: char-in-str? ( char str-addr str-len ) - rot { needle } - false -rot - over + swap ?do - i c@ needle = if drop true leave endif - loop ; - -: sym-char? ( char -- flag ) - s\" \n\r\t\000[]{}()'\"`,; " char-in-str? 0= ; - -: skip-spaces ( str-addr str-len char -- str-addr str-len non-space-char ) - begin - begin - dup s\" \n\r\t, " char-in-str? - while ( str-addr str-len space-char ) - drop adv-str - repeat - dup [char] ; = if - drop - begin - adv-str s\" \n\r\000" char-in-str? - until - adv-str false - else - true - endif - until ; - -defer read-form ( str-addr str-len -- str-addr str-len mal-obj ) - -: read-int ( str-addr str-len digit-char -- str-addr str-len non-digit-char mal-int ) - 0 { int } - begin ( str-addr str-len digit-char ) - [char] 0 - int 10 * + to int ( str-addr str-len ) - adv-str dup mal-digit? 0= ( str-addr str-len digit-char ) - until - int MalInt. ; - -: read-symbol-str ( str-addr str-len sym-char -- str-addr str-len char sym-addr sym-len ) - new-str { sym-addr sym-len } - begin ( str-addr str-len sym-char ) - sym-addr sym-len rot str-append-char to sym-len to sym-addr - adv-str dup sym-char? 0= - until - sym-addr sym-len ; - -: read-string-literal ( in-addr in-len quote-char -- in-addr in-len mal-string ) - new-str { out-addr out-len } - drop \ drop leading quote - begin ( in-addr in-len ) - adv-str over 0= if - 2drop 0 0 s\" expected '\"', got EOF" ...throw-str - endif - dup [char] " <> - while - dup [char] \ = if - drop adv-str - dup [char] n = if drop 10 endif - dup [char] r = if drop 13 endif - endif - out-addr out-len rot str-append-char to out-len to out-addr - repeat - drop adv-str \ skip trailing quote - out-addr out-len MalString. ; - -: read-list ( str-addr str-len open-paren-char close-paren-char - -- str-addr str-len non-paren-char mal-list ) - here { close-char old-here } - drop adv-str - begin ( str-addr str-len char ) - skip-spaces ( str-addr str-len non-space-char ) - over 0= if - drop 2drop 0 0 s" ', got EOF" - close-char pad ! pad 1 - s" expected '" ...throw-str - endif - dup close-char <> - while ( str-addr str-len non-space-non-paren-char ) - read-form , - repeat - drop adv-str - old-here here>MalList ; - -s" deref" MalSymbol. constant deref-sym -s" quote" MalSymbol. constant quote-sym -s" quasiquote" MalSymbol. constant quasiquote-sym -s" splice-unquote" MalSymbol. constant splice-unquote-sym -s" unquote" MalSymbol. constant unquote-sym - -: read-wrapped ( buf-addr buf-len quote-char sym-addr sym-len -- buf-addr buf-len char mal-list ) - here { old-here } - , ( buf-addr buf-len char ) - read-form , ( buf-addr buf-len char ) - old-here here>MalList ; - -: read-form2 ( str-addr str-len char -- str-addr str-len char mal-obj ) - skip-spaces - dup mal-digit? if read-int else - dup [char] ( = if [char] ) read-list else - dup [char] [ = if [char] ] read-list MalVector new tuck MalVector/list ! else - dup [char] { = if [char] } read-list MalMap new tuck MalMap/list ! else - dup [char] " = if read-string-literal else - dup [char] : = if drop adv-str read-symbol-str MalKeyword. else - dup [char] @ = if drop adv-str deref-sym read-wrapped else - dup [char] ' = if drop adv-str quote-sym read-wrapped else - dup [char] ` = if drop adv-str quasiquote-sym read-wrapped else - dup [char] ~ = if - drop adv-str - dup [char] @ = if drop adv-str splice-unquote-sym read-wrapped - else unquote-sym read-wrapped - endif - else - dup [char] ^ = if - drop adv-str - read-form { meta } read-form { obj } - meta mal-nil conj - obj swap conj - s" with-meta" MalSymbol. swap conj - else - read-symbol-str - 2dup s" true" str= if 2drop mal-true - else 2dup s" false" str= if 2drop mal-false - else 2dup s" nil" str= if 2drop mal-nil - else - MalSymbol. - endif endif endif endif endif endif endif endif endif endif endif endif endif endif ; -' read-form2 is read-form - -: read-str ( str-addr str-len - mal-obj ) - over c@ read-form { obj } drop 2drop obj ; diff --git a/forth/step0_repl.fs b/forth/step0_repl.fs deleted file mode 100644 index 2483c12c84..0000000000 --- a/forth/step0_repl.fs +++ /dev/null @@ -1,23 +0,0 @@ -require types.fs - -: read ; -: eval ; -: print ; - -: rep - read - eval - print ; - -create buff 128 allot - -: read-lines - begin - ." user> " - buff 128 stdin read-line throw - while - buff swap - rep type cr - repeat ; - -read-lines \ No newline at end of file diff --git a/forth/step1_read_print.fs b/forth/step1_read_print.fs deleted file mode 100644 index 9e42995bbb..0000000000 --- a/forth/step1_read_print.fs +++ /dev/null @@ -1,34 +0,0 @@ -require reader.fs -require printer.fs - -: read read-str ; -: eval ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -: rep ( str-addr str-len -- str-addr str-len ) - read - eval - print ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -: read-lines - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute safe-type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -read-lines -cr -bye diff --git a/forth/step2_eval.fs b/forth/step2_eval.fs deleted file mode 100644 index 724de4473f..0000000000 --- a/forth/step2_eval.fs +++ /dev/null @@ -1,120 +0,0 @@ -require reader.fs -require printer.fs - -: args-as-native { argv argc -- entry*argc... } - argc 0 ?do - argv i cells + @ as-native - loop ; - -: env-assoc ( map sym-str-addr sym-str-len xt ) - -rot MalSymbol. swap MalNativeFn. rot assoc ; - -MalMap/Empty - s" +" :noname args-as-native + MalInt. ; env-assoc - s" -" :noname args-as-native - MalInt. ; env-assoc - s" *" :noname args-as-native * MalInt. ; env-assoc - s" /" :noname args-as-native / MalInt. ; env-assoc -constant repl-env - -: read read-str ; -: eval ( env obj ) mal-eval ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ eval - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke ( env list this -- list ) - MalNativeFn/xt @ { xt } - eval-rest ( argv argc ) - xt execute ( return-val ) ;; -drop - -MalSymbol - extend mal-eval { env sym -- val } - 0 sym env get - dup 0= if - drop - ." Symbol '" - sym pr-str safe-type - ." ' not found." cr - 1 throw - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -: read-lines - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute safe-type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -read-lines -cr -bye diff --git a/forth/step3_env.fs b/forth/step3_env.fs deleted file mode 100644 index a8a625e68f..0000000000 --- a/forth/step3_env.fs +++ /dev/null @@ -1,154 +0,0 @@ -require reader.fs -require printer.fs -require env.fs - -: args-as-native { argv argc -- entry*argc... } - argc 0 ?do - argv i cells + @ as-native - loop ; - -0 MalEnv. constant repl-env -s" +" MalSymbol. :noname args-as-native + MalInt. ; MalNativeFn. repl-env env/set -s" -" MalSymbol. :noname args-as-native - MalInt. ; MalNativeFn. repl-env env/set -s" *" MalSymbol. :noname args-as-native * MalInt. ; MalNativeFn. repl-env env/set -s" /" MalSymbol. :noname args-as-native / MalInt. ; MalNativeFn. repl-env env/set - -: read read-str ; -: eval ( env obj ) mal-eval ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ eval - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke ( env list this -- list ) - MalNativeFn/xt @ { xt } - eval-rest ( argv argc ) - xt execute ( return-val ) ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ eval - \ TODO: dec refcount of env - ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - ." Symbol '" sym pr-str safe-type ." ' not found." cr - 1 throw - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -: read-lines - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute safe-type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -read-lines -cr -bye diff --git a/forth/step4_if_fn_do.fs b/forth/step4_if_fn_do.fs deleted file mode 100644 index a3d64acaba..0000000000 --- a/forth/step4_if_fn_do.fs +++ /dev/null @@ -1,214 +0,0 @@ -require reader.fs -require printer.fs -require core.fs - -core MalEnv. constant repl-env - -: read read-str ; -: eval ( env obj ) mal-eval ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ eval - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke ( env list this -- list ) - MalNativeFn/xt @ { xt } - eval-rest ( argv argc ) - xt execute ( return-val ) ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ eval - \ TODO: dec refcount of env - ;; - -defspecial do { env list -- val } - list MalList/start @ - 0 - list MalList/count @ 1 ?do - drop - dup i cells + @ env swap eval - loop - nip ;; - -defspecial if { env list -- val } - list MalList/start @ cell+ { arg0 } - env arg0 @ eval ( test-val ) - dup mal-false = if - drop -1 - else - mal-nil = - endif - if - \ branch to false - list MalList/count @ 3 > if - env arg0 cell+ cell+ @ eval - else - mal-nil - endif - else - \ branch to true - env arg0 cell+ @ eval - endif ;; - -s" &" MalSymbol. constant &-sym - -MalUserFn - extend eval-invoke { call-env list mal-fn -- list } - call-env list eval-rest { argv argc } - - mal-fn MalUserFn/formal-args @ { f-args-list } - mal-fn MalUserFn/env @ MalEnv. { env } - - f-args-list MalList/start @ { f-args } - f-args-list MalList/count @ ?dup 0= if else - \ pass nil for last arg, unless overridden below - 1- cells f-args + @ mal-nil env env/set - endif - argc 0 ?do - f-args i cells + @ - dup &-sym m= if - drop - f-args i 1+ cells + @ ( more-args-symbol ) - MalList new ( sym more-args ) - argc i - dup { c } over MalList/count ! - c cells allocate throw dup { start } over MalList/start ! - argv i cells + start c cells cmove - env env/set - leave - endif - argv i cells + @ - env env/set - loop - - env mal-fn MalUserFn/body @ eval ;; -drop - -defspecial fn* { env list -- val } - list MalList/start @ cell+ { arg0 } - MalUserFn new - env over MalUserFn/env ! - arg0 @ to-list over MalUserFn/formal-args ! - arg0 cell+ @ over MalUserFn/body ! ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - ." Symbol '" sym pr-str safe-type ." ' not found." cr - 1 throw - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -: read-lines - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute safe-type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -read-lines -cr -bye diff --git a/forth/step5_tco.fs b/forth/step5_tco.fs deleted file mode 100644 index 421a2fc397..0000000000 --- a/forth/step5_tco.fs +++ /dev/null @@ -1,225 +0,0 @@ -require reader.fs -require printer.fs -require core.fs - -core MalEnv. constant repl-env - -99999999 constant TCO-eval - -: read read-str ; -: eval ( env obj ) - begin - \ ." eval-> " dup pr-str safe-type cr - mal-eval - dup TCO-eval = - while - drop - repeat ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ TCO-eval - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke ( env list this -- list ) - MalNativeFn/xt @ { xt } - eval-rest ( argv argc ) - xt execute ( return-val ) ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ TCO-eval - \ TODO: dec refcount of env - ;; - -defspecial do { env list -- val } - list MalList/start @ { start } - list MalList/count @ dup 1- { last } 1 ?do - env start i cells + @ - i last = if - TCO-eval - else - eval drop - endif - loop ;; - -defspecial if { env list -- val } - list MalList/start @ cell+ { arg0 } - env arg0 @ eval ( test-val ) - dup mal-false = if - drop -1 - else - mal-nil = - endif - if - \ branch to false - list MalList/count @ 3 > if - env arg0 cell+ cell+ @ TCO-eval - else - mal-nil - endif - else - \ branch to true - env arg0 cell+ @ TCO-eval - endif ;; - -s" &" MalSymbol. constant &-sym - -MalUserFn - extend eval-invoke { call-env list mal-fn -- list } - call-env list eval-rest { argv argc } - - mal-fn MalUserFn/formal-args @ { f-args-list } - mal-fn MalUserFn/env @ MalEnv. { env } - - f-args-list MalList/start @ { f-args } - f-args-list MalList/count @ ?dup 0= if else - \ pass nil for last arg, unless overridden below - 1- cells f-args + @ mal-nil env env/set - endif - argc 0 ?do - f-args i cells + @ - dup &-sym m= if - drop - f-args i 1+ cells + @ ( more-args-symbol ) - MalList new ( sym more-args ) - argc i - dup { c } over MalList/count ! - c cells allocate throw dup { start } over MalList/start ! - argv i cells + start c cells cmove - env env/set - leave - endif - argv i cells + @ - env env/set - loop - - env mal-fn MalUserFn/body @ TCO-eval ;; -drop - -defspecial fn* { env list -- val } - list MalList/start @ cell+ { arg0 } - MalUserFn new - env over MalUserFn/env ! - arg0 @ to-list over MalUserFn/formal-args ! - arg0 cell+ @ over MalUserFn/body ! ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - ." Symbol '" sym pr-str safe-type ." ' not found." cr - 1 throw - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -: read-lines - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute safe-type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -read-lines -cr -bye diff --git a/forth/step6_file.fs b/forth/step6_file.fs deleted file mode 100644 index 60b381717a..0000000000 --- a/forth/step6_file.fs +++ /dev/null @@ -1,252 +0,0 @@ -require reader.fs -require printer.fs -require core.fs - -core MalEnv. constant repl-env - -99999999 constant TCO-eval - -: read read-str ; -: eval ( env obj ) - begin - \ ." eval-> " dup pr-str safe-type cr - mal-eval - dup TCO-eval = - while - drop - repeat ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ TCO-eval - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke ( env list this -- list ) - MalNativeFn/xt @ { xt } - eval-rest ( argv argc ) - xt execute ( return-val ) ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ TCO-eval - \ TODO: dec refcount of env - ;; - -defspecial do { env list -- val } - list MalList/start @ { start } - list MalList/count @ dup 1- { last } 1 ?do - env start i cells + @ - i last = if - TCO-eval - else - eval drop - endif - loop ;; - -defspecial if { env list -- val } - list MalList/start @ cell+ { arg0 } - env arg0 @ eval ( test-val ) - dup mal-false = if - drop -1 - else - mal-nil = - endif - if - \ branch to false - list MalList/count @ 3 > if - env arg0 cell+ cell+ @ TCO-eval - else - mal-nil - endif - else - \ branch to true - env arg0 cell+ @ TCO-eval - endif ;; - -s" &" MalSymbol. constant &-sym - -MalUserFn - extend eval-invoke { call-env list mal-fn -- list } - call-env list eval-rest { argv argc } - - mal-fn MalUserFn/formal-args @ { f-args-list } - mal-fn MalUserFn/env @ MalEnv. { env } - - f-args-list MalList/start @ { f-args } - f-args-list MalList/count @ ?dup 0= if else - \ pass nil for last arg, unless overridden below - 1- cells f-args + @ mal-nil env env/set - endif - argc 0 ?do - f-args i cells + @ - dup &-sym m= if - drop - f-args i 1+ cells + @ ( more-args-symbol ) - MalList new ( sym more-args ) - argc i - dup { c } over MalList/count ! - c cells allocate throw dup { start } over MalList/start ! - argv i cells + start c cells cmove - env env/set - leave - endif - argv i cells + @ - env env/set - loop - - env mal-fn MalUserFn/body @ TCO-eval ;; -drop - -defspecial fn* { env list -- val } - list MalList/start @ cell+ { arg0 } - MalUserFn new - env over MalUserFn/env ! - arg0 @ to-list over MalUserFn/formal-args ! - arg0 cell+ @ over MalUserFn/body ! ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - ." Symbol '" sym pr-str safe-type ." ' not found." cr - 1 throw - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -defcore eval ( argv argc ) - drop @ repl-env swap eval ;; - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -: mk-args-list ( -- ) - here - begin - next-arg 2dup 0 0 d<> while - MalString. , - repeat - 2drop here>MalList ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop - -: repl ( -- ) - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -: main ( -- ) - mk-args-list { args-list } - args-list MalList/count @ 0= if - s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set - repl - else - args-list MalList/start @ @ { filename } - s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set - - repl-env - here s" load-file" MalSymbol. , filename , here>MalList - eval print - endif ; - -main -cr -bye diff --git a/forth/step7_quote.fs b/forth/step7_quote.fs deleted file mode 100644 index 1e4043d02c..0000000000 --- a/forth/step7_quote.fs +++ /dev/null @@ -1,294 +0,0 @@ -require reader.fs -require printer.fs -require core.fs - -core MalEnv. constant repl-env - -99999999 constant TCO-eval - -: read read-str ; -: eval ( env obj ) - begin - \ ." eval-> " dup pr-str safe-type cr - mal-eval - dup TCO-eval = - while - drop - repeat ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ TCO-eval - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke ( env list this -- list ) - MalNativeFn/xt @ { xt } - eval-rest ( argv argc ) - xt execute ( return-val ) ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -: is-pair? ( obj -- bool ) - empty? mal-false = ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -s" concat" MalSymbol. constant concat-sym -s" cons" MalSymbol. constant cons-sym - -defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif - endif - endif ; -' quasiquote0 is quasiquote - -defspecial quasiquote ( env list ) - MalList/start @ cell+ @ ( ast ) - quasiquote TCO-eval ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ TCO-eval - \ TODO: dec refcount of env - ;; - -defspecial do { env list -- val } - list MalList/start @ { start } - list MalList/count @ dup 1- { last } 1 ?do - env start i cells + @ - i last = if - TCO-eval - else - eval drop - endif - loop ;; - -defspecial if { env list -- val } - list MalList/start @ cell+ { arg0 } - env arg0 @ eval ( test-val ) - dup mal-false = if - drop -1 - else - mal-nil = - endif - if - \ branch to false - list MalList/count @ 3 > if - env arg0 cell+ cell+ @ TCO-eval - else - mal-nil - endif - else - \ branch to true - env arg0 cell+ @ TCO-eval - endif ;; - -s" &" MalSymbol. constant &-sym - -MalUserFn - extend eval-invoke { call-env list mal-fn -- list } - call-env list eval-rest { argv argc } - - mal-fn MalUserFn/formal-args @ { f-args-list } - mal-fn MalUserFn/env @ MalEnv. { env } - - f-args-list MalList/start @ { f-args } - f-args-list MalList/count @ ?dup 0= if else - \ pass nil for last arg, unless overridden below - 1- cells f-args + @ mal-nil env env/set - endif - argc 0 ?do - f-args i cells + @ - dup &-sym m= if - drop - f-args i 1+ cells + @ ( more-args-symbol ) - MalList new ( sym more-args ) - argc i - dup { c } over MalList/count ! - c cells allocate throw dup { start } over MalList/start ! - argv i cells + start c cells cmove - env env/set - leave - endif - argv i cells + @ - env env/set - loop - - env mal-fn MalUserFn/body @ TCO-eval ;; -drop - -defspecial fn* { env list -- val } - list MalList/start @ cell+ { arg0 } - MalUserFn new - env over MalUserFn/env ! - arg0 @ to-list over MalUserFn/formal-args ! - arg0 cell+ @ over MalUserFn/body ! ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - ." Symbol '" sym pr-str safe-type ." ' not found." cr - 1 throw - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -defcore eval ( argv argc ) - drop @ repl-env swap eval ;; - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -: mk-args-list ( -- ) - here - begin - next-arg 2dup 0 0 d<> while - MalString. , - repeat - 2drop here>MalList ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop - -: repl ( -- ) - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -: main ( -- ) - mk-args-list { args-list } - args-list MalList/count @ 0= if - s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set - repl - else - args-list MalList/start @ @ { filename } - s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set - - repl-env - here s" load-file" MalSymbol. , filename , here>MalList - eval print - endif ; - -main -cr -bye diff --git a/forth/step8_macros.fs b/forth/step8_macros.fs deleted file mode 100644 index 7260567deb..0000000000 --- a/forth/step8_macros.fs +++ /dev/null @@ -1,324 +0,0 @@ -require reader.fs -require printer.fs -require core.fs - -core MalEnv. constant repl-env - -99999999 constant TCO-eval - -: read read-str ; -: eval ( env obj ) - begin - \ ." eval-> " dup pr-str safe-type cr - mal-eval - dup TCO-eval = - while - drop - repeat ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ TCO-eval - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke ( env list this -- list ) - MalNativeFn/xt @ { xt } - eval-rest ( argv argc ) - xt execute ( return-val ) ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -: is-pair? ( obj -- bool ) - empty? mal-false = ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -s" concat" MalSymbol. constant concat-sym -s" cons" MalSymbol. constant cons-sym - -defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif - endif - endif ; -' quasiquote0 is quasiquote - -defspecial quasiquote ( env list ) - MalList/start @ cell+ @ ( ast ) - quasiquote TCO-eval ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial defmacro! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval { val } - true val MalUserFn/is-macro? ! - val env env/set - val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ TCO-eval - \ TODO: dec refcount of env - ;; - -defspecial do { env list -- val } - list MalList/start @ { start } - list MalList/count @ dup 1- { last } 1 ?do - env start i cells + @ - i last = if - TCO-eval - else - eval drop - endif - loop ;; - -defspecial if { env list -- val } - list MalList/start @ cell+ { arg0 } - env arg0 @ eval ( test-val ) - dup mal-false = if - drop -1 - else - mal-nil = - endif - if - \ branch to false - list MalList/count @ 3 > if - env arg0 cell+ cell+ @ TCO-eval - else - mal-nil - endif - else - \ branch to true - env arg0 cell+ @ TCO-eval - endif ;; - -s" &" MalSymbol. constant &-sym - -: new-user-fn-env { argv argc mal-fn -- env } - mal-fn MalUserFn/formal-args @ { f-args-list } - mal-fn MalUserFn/env @ MalEnv. { env } - - f-args-list MalList/start @ { f-args } - f-args-list MalList/count @ ?dup 0= if else - \ pass nil for last arg, unless overridden below - 1- cells f-args + @ mal-nil env env/set - endif - argc 0 ?do - f-args i cells + @ - dup &-sym m= if - drop - f-args i 1+ cells + @ ( more-args-symbol ) - MalList new ( sym more-args ) - argc i - dup { c } over MalList/count ! - c cells allocate throw dup { start } over MalList/start ! - argv i cells + start c cells cmove - env env/set - leave - endif - argv i cells + @ - env env/set - loop - env ; - -MalUserFn - extend eval-invoke { call-env list mal-fn -- list } - mal-fn MalUserFn/is-macro? @ if - list MalList/start @ cell+ list MalList/count @ 1- - else - call-env list eval-rest - endif - mal-fn new-user-fn-env { env } - - mal-fn MalUserFn/is-macro? @ if - env mal-fn MalUserFn/body @ eval - env swap TCO-eval - else - env mal-fn MalUserFn/body @ TCO-eval - endif ;; -drop - -defspecial fn* { env list -- val } - list MalList/start @ cell+ { arg0 } - MalUserFn new - env over MalUserFn/env ! - arg0 @ to-list over MalUserFn/formal-args ! - arg0 cell+ @ over MalUserFn/body ! ;; - -defspecial macroexpand ( env list[_,form] -- form ) - MalList/start @ cell+ @ swap over ( form env form ) - MalList/start @ @ ( form env macro-name-expr ) - eval { macro-fn } ( form ) - dup MalList/start @ cell+ swap MalList/count @ 1- macro-fn ( argv argc fn ) - new-user-fn-env ( env ) - macro-fn MalUserFn/body @ TCO-eval ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - ." Symbol '" sym pr-str safe-type ." ' not found." cr - 1 throw - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -defcore eval ( argv argc ) - drop @ repl-env swap eval ;; - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -: mk-args-list ( -- ) - here - begin - next-arg 2dup 0 0 d<> while - MalString. , - repeat - 2drop here>MalList ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop -s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop -s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" rep 2drop - -: repl ( -- ) - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute type - catch ?dup 0= if safe-type else ." Caught error " . endif - cr - stack-leak-detect <> if ." --stack leak--" cr endif - repeat ; - -: main ( -- ) - mk-args-list { args-list } - args-list MalList/count @ 0= if - s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set - repl - else - args-list MalList/start @ @ { filename } - s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set - - repl-env - here s" load-file" MalSymbol. , filename , here>MalList - eval print - endif ; - -main -cr -bye diff --git a/forth/step9_try.fs b/forth/step9_try.fs deleted file mode 100644 index 681e608b91..0000000000 --- a/forth/step9_try.fs +++ /dev/null @@ -1,381 +0,0 @@ -require reader.fs -require printer.fs -require core.fs - -core MalEnv. constant repl-env - -99999999 constant TCO-eval - -: read read-str ; -: eval ( env obj ) - begin - \ ." eval-> " dup pr-str safe-type cr - mal-eval - dup TCO-eval = - while - drop - repeat ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ TCO-eval - else - mal-nil - endif - endif ;; - extend invoke { argv argc kw -- val } - 0 kw argv @ get - ?dup 0= if - argc 1 > if - argv cell+ @ - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke { env list this -- list } - env list eval-rest ( argv argc ) - this invoke ;; - extend invoke ( argv argc this -- val ) - MalNativeFn/xt @ execute ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -: is-pair? ( obj -- bool ) - empty? mal-false = ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -s" concat" MalSymbol. constant concat-sym -s" cons" MalSymbol. constant cons-sym - -defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif - endif - endif ; -' quasiquote0 is quasiquote - -defspecial quasiquote ( env list ) - MalList/start @ cell+ @ ( ast ) - quasiquote TCO-eval ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial defmacro! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval { val } - true val MalUserFn/is-macro? ! - val env env/set - val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ TCO-eval - \ TODO: dec refcount of env - ;; - -defspecial do { env list -- val } - list MalList/start @ { start } - list MalList/count @ dup 1- { last } 1 ?do - env start i cells + @ - i last = if - TCO-eval - else - eval drop - endif - loop ;; - -defspecial if { env list -- val } - list MalList/start @ cell+ { arg0 } - env arg0 @ eval ( test-val ) - dup mal-false = if - drop -1 - else - mal-nil = - endif - if - \ branch to false - list MalList/count @ 3 > if - env arg0 cell+ cell+ @ TCO-eval - else - mal-nil - endif - else - \ branch to true - env arg0 cell+ @ TCO-eval - endif ;; - -s" &" MalSymbol. constant &-sym - -: new-user-fn-env { argv argc mal-fn -- env } - mal-fn MalUserFn/formal-args @ { f-args-list } - mal-fn MalUserFn/env @ MalEnv. { env } - - f-args-list MalList/start @ { f-args } - f-args-list MalList/count @ ?dup 0= if else - \ pass nil for last arg, unless overridden below - 1- cells f-args + @ mal-nil env env/set - endif - argc 0 ?do - f-args i cells + @ - dup &-sym m= if - drop - argc i - { c } - c cells allocate throw { start } - argv i cells + start c cells cmove - f-args i 1+ cells + @ ( more-args-symbol ) - start c MalList. env env/set - leave - endif - argv i cells + @ - env env/set - loop - env ; - -MalUserFn - extend eval-invoke { call-env list mal-fn -- list } - mal-fn MalUserFn/is-macro? @ if - list MalList/start @ cell+ \ argv - list MalList/count @ 1- \ argc - mal-fn new-user-fn-env { env } - env mal-fn MalUserFn/body @ eval - call-env swap TCO-eval - else - call-env list eval-rest - mal-fn invoke - endif ;; - - extend invoke ( argv argc mal-fn ) - dup { mal-fn } new-user-fn-env { env } - env mal-fn MalUserFn/body @ TCO-eval ;; -drop - -defspecial fn* { env list -- val } - list MalList/start @ cell+ { arg0 } - MalUserFn new - false over MalUserFn/is-macro? ! - env over MalUserFn/env ! - arg0 @ to-list over MalUserFn/formal-args ! - arg0 cell+ @ over MalUserFn/body ! ;; - -defspecial macroexpand ( env list[_,form] -- form ) - MalList/start @ cell+ @ swap over ( form env form ) - MalList/start @ @ ( form env macro-name-expr ) - eval { macro-fn } ( form ) - dup MalList/start @ cell+ swap MalList/count @ 1- macro-fn ( argv argc fn ) - new-user-fn-env ( env ) - macro-fn MalUserFn/body @ TCO-eval ;; - -5555555555 constant pre-try - -defspecial try* { env list -- val } - list MalList/start @ cell+ { arg0 } - pre-try - env arg0 @ ['] eval catch ?dup 0= if - nip - else { errno } - begin pre-try = until - errno 1 <> if - s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc - to exception-object - endif - arg0 cell+ @ ( list[catch*,sym,form] ) - MalList/start @ cell+ { catch0 } - env MalEnv. { catch-env } - catch0 @ exception-object catch-env env/set - catch-env catch0 cell+ @ TCO-eval - endif ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - 0 0 s" ' not found" sym pr-str s" '" ...throw-str - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -defcore eval ( argv argc ) - drop @ repl-env swap eval ;; - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -: mk-args-list ( -- ) - here - begin - next-arg 2dup 0 0 d<> while - MalString. , - repeat - 2drop here>MalList ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -: nop ; - -defcore map ( argv argc -- list ) - drop dup @ swap cell+ @ to-list { fn list } - here - list MalList/start @ list MalList/count @ cells over + swap +do - i 1 fn invoke - dup TCO-eval = if drop eval endif - , - cell +loop - here>MalList ;; - -defcore readline ( argv argc -- mal-string ) - drop @ unpack-str type stdout flush-file drop - buff 128 stdin read-line throw - if buff swap MalString. else drop mal-nil endif ;; - -s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop -s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop -s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" rep 2drop -s\" (def! swap! (fn* [a f & args] (reset! a (apply f @a args))))" rep 2drop - -: repl ( -- ) - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute ['] nop \ uncomment to see stack traces - catch ?dup 0= if - safe-type cr - stack-leak-detect <> if ." --stack leak--" cr endif - else { errno } - begin stack-leak-detect = until - errno 1 <> if - s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc - to exception-object - endif - ." Uncaught exception: " - exception-object pr-str safe-type cr - endif - repeat ; - -: main ( -- ) - mk-args-list { args-list } - args-list MalList/count @ 0= if - s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set - repl - else - args-list MalList/start @ @ { filename } - s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set - - repl-env - here s" load-file" MalSymbol. , filename , here>MalList - eval print - endif ; - -main -cr -bye diff --git a/forth/stepA_mal.fs b/forth/stepA_mal.fs deleted file mode 100644 index af5f5d83f7..0000000000 --- a/forth/stepA_mal.fs +++ /dev/null @@ -1,390 +0,0 @@ -require reader.fs -require printer.fs -require core.fs - -core MalEnv. constant repl-env - -99999999 constant TCO-eval - -: read read-str ; -: eval ( env obj ) - begin - \ ." eval-> " dup pr-str safe-type cr - mal-eval - dup TCO-eval = - while - drop - repeat ; -: print - \ ." Type: " dup mal-type @ type-name safe-type cr - pr-str ; - -MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself - -MalKeyword - extend eval-invoke { env list kw -- val } - 0 kw env list MalList/start @ cell+ @ eval get - ?dup 0= if - \ compute not-found value - list MalList/count @ 1 > if - env list MalList/start @ 2 cells + @ TCO-eval - else - mal-nil - endif - endif ;; - extend invoke { argv argc kw -- val } - 0 kw argv @ get - ?dup 0= if - argc 1 > if - argv cell+ @ - else - mal-nil - endif - endif ;; -drop - -\ eval all but the first item of list -: eval-rest { env list -- argv argc } - list MalList/start @ cell+ { expr-start } - list MalList/count @ 1- { argc } - argc cells allocate throw { target } - argc 0 ?do - env expr-start i cells + @ eval - target i cells + ! - loop - target argc ; - -MalNativeFn - extend eval-invoke { env list this -- list } - env list eval-rest ( argv argc ) - this invoke ;; - extend invoke ( argv argc this -- val ) - MalNativeFn/xt @ execute ;; -drop - -SpecialOp - extend eval-invoke ( env list this -- list ) - SpecialOp/xt @ execute ;; -drop - -: install-special ( symbol xt ) - SpecialOp. repl-env env/set ; - -: defspecial - parse-allot-name MalSymbol. - ['] install-special - :noname - ; - -: is-pair? ( obj -- bool ) - empty? mal-false = ; - -defspecial quote ( env list -- form ) - nip MalList/start @ cell+ @ ;; - -s" concat" MalSymbol. constant concat-sym -s" cons" MalSymbol. constant cons-sym - -defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif - endif - endif ; -' quasiquote0 is quasiquote - -defspecial quasiquote ( env list ) - MalList/start @ cell+ @ ( ast ) - quasiquote TCO-eval ;; - -defspecial def! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval dup { val } ( key val ) - env env/set val ;; - -defspecial defmacro! { env list -- val } - list MalList/start @ cell+ { arg0 } - arg0 @ ( key ) - env arg0 cell+ @ eval { val } - true val MalUserFn/is-macro? ! - val env env/set - val ;; - -defspecial let* { old-env list -- val } - old-env MalEnv. { env } - list MalList/start @ cell+ dup { arg0 } - @ to-list - dup MalList/start @ { bindings-start } ( list ) - MalList/count @ 0 +do - bindings-start i cells + dup @ swap cell+ @ ( sym expr ) - env swap eval - env env/set - 2 +loop - env arg0 cell+ @ TCO-eval - \ TODO: dec refcount of env - ;; - -defspecial do { env list -- val } - list MalList/start @ { start } - list MalList/count @ dup 1- { last } 1 ?do - env start i cells + @ - i last = if - TCO-eval - else - eval drop - endif - loop ;; - -defspecial if { env list -- val } - list MalList/start @ cell+ { arg0 } - env arg0 @ eval ( test-val ) - dup mal-false = if - drop -1 - else - mal-nil = - endif - if - \ branch to false - list MalList/count @ 3 > if - env arg0 cell+ cell+ @ TCO-eval - else - mal-nil - endif - else - \ branch to true - env arg0 cell+ @ TCO-eval - endif ;; - -s" &" MalSymbol. constant &-sym - -: new-user-fn-env { argv argc mal-fn -- env } - mal-fn MalUserFn/formal-args @ { f-args-list } - mal-fn MalUserFn/env @ MalEnv. { env } - - f-args-list MalList/start @ { f-args } - f-args-list MalList/count @ ?dup 0= if else - \ pass nil for last arg, unless overridden below - 1- cells f-args + @ mal-nil env env/set - endif - argc 0 ?do - f-args i cells + @ - dup &-sym m= if - drop - argc i - { c } - c cells allocate throw { start } - argv i cells + start c cells cmove - f-args i 1+ cells + @ ( more-args-symbol ) - start c MalList. env env/set - leave - endif - argv i cells + @ - env env/set - loop - env ; - -MalUserFn - extend eval-invoke { call-env list mal-fn -- list } - mal-fn MalUserFn/is-macro? @ if - list MalList/start @ cell+ \ argv - list MalList/count @ 1- \ argc - mal-fn new-user-fn-env { env } - env mal-fn MalUserFn/body @ eval - call-env swap TCO-eval - else - call-env list eval-rest - mal-fn invoke - endif ;; - - extend invoke ( argv argc mal-fn ) - dup { mal-fn } new-user-fn-env { env } - env mal-fn MalUserFn/body @ TCO-eval ;; -drop - -defspecial fn* { env list -- val } - list MalList/start @ cell+ { arg0 } - MalUserFn new - false over MalUserFn/is-macro? ! - env over MalUserFn/env ! - arg0 @ to-list over MalUserFn/formal-args ! - arg0 cell+ @ over MalUserFn/body ! ;; - -defspecial macroexpand ( env list[_,form] -- form ) - MalList/start @ cell+ @ swap over ( form env form ) - MalList/start @ @ ( form env macro-name-expr ) - eval { macro-fn } ( form ) - dup MalList/start @ cell+ swap MalList/count @ 1- macro-fn ( argv argc fn ) - new-user-fn-env ( env ) - macro-fn MalUserFn/body @ TCO-eval ;; - -5555555555 constant pre-try - -defspecial try* { env list -- val } - list MalList/start @ cell+ { arg0 } - pre-try - env arg0 @ ['] eval catch ?dup 0= if - nip - else { errno } - begin pre-try = until - errno 1 <> if - s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc - to exception-object - endif - arg0 cell+ @ ( list[catch*,sym,form] ) - MalList/start @ cell+ { catch0 } - env MalEnv. { catch-env } - catch0 @ exception-object catch-env env/set - catch-env catch0 cell+ @ TCO-eval - endif ;; - -defspecial . { env coll -- rtn-list } - depth { old-depth } - coll to-list dup MalList/count @ swap MalList/start @ { count start } - count cells start + start cell+ +do - env i @ eval as-native - cell +loop ;; - -MalSymbol - extend mal-eval { env sym -- val } - sym env env/get-addr - dup 0= if - drop - 0 0 s" ' not found" sym pr-str s" '" ...throw-str - else - @ - endif ;; -drop - -: eval-ast { env list -- list } - here - list MalList/start @ { expr-start } - list MalList/count @ 0 ?do - env expr-start i cells + @ eval , - loop - here>MalList ; - -MalList - extend mal-eval { env list -- val } - env list MalList/start @ @ eval - env list rot eval-invoke ;; -drop - -MalVector - extend mal-eval ( env vector -- vector ) - MalVector/list @ eval-ast - MalVector new swap over MalVector/list ! ;; -drop - -MalMap - extend mal-eval ( env map -- map ) - MalMap/list @ eval-ast - MalMap new swap over MalMap/list ! ;; -drop - -defcore eval ( argv argc ) - drop @ repl-env swap eval ;; - -: rep ( str-addr str-len -- str-addr str-len ) - read - repl-env swap eval - print ; - -: mk-args-list ( -- ) - here - begin - next-arg 2dup 0 0 d<> while - MalString. , - repeat - 2drop here>MalList ; - -create buff 128 allot -77777777777 constant stack-leak-detect - -: nop ; - -defcore map ( argv argc -- list ) - drop dup @ swap cell+ @ to-list { fn list } - here - list MalList/start @ list MalList/count @ cells over + swap +do - i 1 fn invoke - dup TCO-eval = if drop eval endif - , - cell +loop - here>MalList ;; - -defcore readline ( argv argc -- mal-string ) - drop @ unpack-str type stdout flush-file drop - buff 128 stdin read-line throw - if buff swap MalString. else drop mal-nil endif ;; - -s\" (def! *host-language* \"forth\")" rep 2drop -s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop -s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop -s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" rep 2drop -s\" (def! swap! (fn* [a f & args] (reset! a (apply f @a args))))" rep 2drop - -: repl ( -- ) - s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop - begin - ." user> " - stack-leak-detect - buff 128 stdin read-line throw - while ( num-bytes-read ) - buff swap ( str-addr str-len ) - ['] rep - \ execute ['] nop \ uncomment to see stack traces - catch ?dup 0= if - safe-type cr - stack-leak-detect <> if ." --stack leak--" cr endif - else { errno } - begin stack-leak-detect = until - errno 1 <> if - s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc - to exception-object - endif - ." Uncaught exception: " - exception-object pr-str safe-type cr - endif - repeat ; - -: main ( -- ) - mk-args-list { args-list } - args-list MalList/count @ 0= if - s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set - repl - else - args-list MalList/start @ @ { filename } - s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set - - repl-env - here s" load-file" MalSymbol. , filename , here>MalList - eval print - endif ; - -main -cr -bye diff --git a/forth/tests/stepA_mal.mal b/forth/tests/stepA_mal.mal deleted file mode 100644 index c4a0e75613..0000000000 --- a/forth/tests/stepA_mal.mal +++ /dev/null @@ -1,41 +0,0 @@ -;; Basic interop -(. 5 'MalInt.) -;=>5 -(. 11 31 '+ 'MalInt.) -;=>42 -(. "greetings" 'MalString.) -;=>"greetings" -(. "hello" 'type 'cr 'mal-nil) -; hello -;=>nil - -;; Interop on non-literals -(. (+ 15 27) 'MalInt.) -;=>42 -(let* [a 17] (. a 25 '+ 'MalInt.)) -;=>42 -(let* [a "hello"] (. a 1 '- 'MalString.)) -;=>"hell" - -;; Use of annoyingly-named forth words -(. 1 'MalInt. (symbol ",") 'here (symbol "@")) -;=>1 -(let* (i 'MalInt.) (. 5 i)) -;=>5 -(let* (comma (symbol ",") fetch (symbol "@")) (. 'here 42 'MalInt. comma fetch)) -;=>42 - -;; Multiple .-forms interacting via heap memory and mal locals -(def! string-parts (fn* (s) (. s 'MalInt. 'swap 'MalInt. 'here '-rot (symbol ",") (symbol ",") 'here>MalList))) -(first (rest (string-parts "sketchy"))) -;=>7 -(def! prn-chars (fn* (start count) (if (> count 0) (do (prn (. start 1 'MalString.)) (prn-chars (+ start 1) (- count 1)))))) -(let* (msg (string-parts "sketchy")) (prn-chars (first msg) (first (rest msg)))) -; "s" -; "k" -; "e" -; "t" -; "c" -; "h" -; "y" -;=>nil diff --git a/forth/types.fs b/forth/types.fs deleted file mode 100644 index 2fceccfaf3..0000000000 --- a/forth/types.fs +++ /dev/null @@ -1,624 +0,0 @@ -require str.fs - -\ === sorted-array === / -\ Here are a few utility functions useful for creating and maintaining -\ the deftype* method tables. The keys array is kept in sorted order, -\ and the methods array is maintained in parallel so that an index into -\ one corresponds to an index in the other. - -\ Search a sorted array for key, returning the index of where it was -\ found. If key is not in the array, return the index where it would -\ be if added. -: array-find { a-length a-addr key -- index found? } - 0 a-length ( start end ) - begin - \ cr 2dup . . - 2dup + 2 / dup ( start end middle middle ) - cells a-addr + @ ( start end middle mid-val ) - dup key < if - drop rot ( end middle start ) - 2dup = if - 2drop dup ( end end ) - else - drop swap ( middle end ) - endif - else - key > if ( start end middle ) - nip ( start middle ) - else - -rot 2drop dup ( middle middle ) - endif - endif - 2dup = until - dup a-length = if - drop false - else - cells a-addr + @ key = - endif ; - -\ Create a new array, one cell in length, initialized the provided value -: new-array { value -- array } - cell allocate throw value over ! ; - -\ Resize a heap-allocated array to be one cell longer, inserting value -\ at idx, and shifting the tail of the array as necessary. Returns the -\ (possibly new) array address -: array-insert { old-array-length old-array idx value -- array } - old-array old-array-length 1+ cells resize throw - { a } - a idx cells + dup cell+ old-array-length idx - cells cmove> - value a idx cells + ! - a - ; - - -\ === deftype* -- protocol-enabled structs === / -\ Each type has MalTypeType% struct allocated on the stack, with -\ mutable fields pointing to all class-shared resources, specifically -\ the data needed to allocate new instances, and the table of protocol -\ methods that have been extended to the type. -\ Use 'deftype*' to define a new type, and 'new' to create new -\ instances of that type. - -struct - cell% field mal-type - cell% field mal-meta - \ cell% field ref-count \ Ha, right. -end-struct MalType% - -struct - cell% 2 * field MalTypeType-struct - cell% field MalTypeType-methods - cell% field MalTypeType-method-keys - cell% field MalTypeType-method-vals - cell% field MalTypeType-name-addr - cell% field MalTypeType-name-len -end-struct MalTypeType% - -: new ( MalTypeType -- obj ) - dup MalTypeType-struct 2@ %allocate throw ( MalTypeType obj ) \ create struct - dup -rot mal-type ! ( obj ) \ set struct's type pointer to this type - nil over mal-meta ! - ; - -: deftype* ( struct-align struct-len -- MalTypeType ) - MalTypeType% %allot ( s-a s-l MalTypeType ) - dup 2swap rot ( MalTypeType s-a s-l MalTypeType ) - MalTypeType-struct 2! ( MalTypeType ) \ store struct info - dup MalTypeType-methods 0 swap ! ( MalTypeType ) - dup MalTypeType-method-keys nil swap ! ( MalTypeType ) - dup MalTypeType-method-vals nil swap ! ( MalTypeType ) - dup MalTypeType-name-len 0 swap ! ( MalTypeType ) - ; - -\ parse-name uses temporary space, so copy into dictionary stack: -: parse-allot-name { -- new-str-addr str-len } - parse-name { str-addr str-len } - here { new-str-addr } str-len allot - str-addr new-str-addr str-len cmove - new-str-addr str-len ; - -: deftype ( struct-align struct-len R:type-name -- ) - parse-allot-name { name-addr name-len } - - \ allot and initialize type structure - deftype* { mt } - name-addr mt MalTypeType-name-addr ! - name-len mt MalTypeType-name-len ! - \ ." Defining " mt MalTypeType-name-addr @ mt MalTypeType-name-len @ type cr - mt name-addr name-len nextname 1 0 const-does> ; - -: type-name ( mal-type ) - dup MalTypeType-name-addr @ ( mal-type name-addr ) - swap MalTypeType-name-len @ ( name-addr name-len ) - ; - -MalType% deftype MalDefault - -\ nil type and instance to support extending protocols to it -MalType% deftype MalNil MalNil new constant mal-nil -MalType% deftype MalTrue MalTrue new constant mal-true -MalType% deftype MalFalse MalFalse new constant mal-false - -: mal-bool - 0= if mal-false else mal-true endif ; - -: not-object? ( obj -- bool ) - dup 7 and 0 <> if - drop true - else - 1000000 < - endif ; - -\ === protocol methods === / - -struct - cell% field call-site/type - cell% field call-site/xt -end-struct call-site% - -\ Used by protocol methods to find the appropriate implementation of -\ themselves for the given object, and then execute that implementation. -: execute-method { obj pxt call-site -- } - obj not-object? if - 0 0 obj int>str s" ' on non-object: " pxt >name name>string - s" Refusing to invoke protocol fn '" ...throw-str - endif - \ ." Calling '" pxt >name name>string type ." ' on " obj mal-type @ type-name type ." , cs " call-site . - - obj mal-type @ ( type ) - dup call-site call-site/type @ = if - \ ." hit!" cr - drop - call-site call-site/xt @ - else - \ ." miss!" cr - dup MalTypeType-methods 2@ swap ( type methods method-keys ) - dup 0= if \ No protocols extended to this type; check for a default - 2drop drop MalDefault MalTypeType-methods 2@ swap - endif - - pxt array-find ( type idx found? ) - dup 0= if \ No implementation found for this method; check for a default - 2drop drop MalDefault dup MalTypeType-methods 2@ swap - pxt array-find ( type idx found? ) - endif - 0= if ( type idx ) - 2drop - 0 0 s" '" obj mal-type @ type-name s" ' extended to type '" - pxt >name name>string s" No protocol fn '" ...throw-str - endif - - cells over MalTypeType-method-vals @ + @ ( type xt ) - swap call-site call-site/type ! ( xt ) - dup call-site call-site/xt ! ( xt ) - endif - obj swap execute ; - -\ Extend a type with a protocol method. This mutates the MalTypeType -\ object that represents the MalType being extended. -: extend-method* { type pxt ixt -- type } - \ ." Extend '" pxt dup . >name name>string safe-type ." ' to " type type-name safe-type ." , " - \ type MalTypeType-methods 2@ ( method-keys methods ) - \ 0 ?do - \ dup i cells + @ >name name>string safe-type ." , " - \ \ dup i cells + @ . - \ loop - \ drop cr - - type MalTypeType-methods 2@ swap ( methods method-keys ) - dup 0= if \ no protocols extended to this type - 2drop - 1 type MalTypeType-methods ! - pxt new-array type MalTypeType-method-keys ! - ixt new-array type MalTypeType-method-vals ! - else - pxt array-find { idx found? } - found? if \ overwrite - ." Warning: overwriting protocol method implementation '" - pxt >name name>string safe-type ." ' on " type type-name safe-type ." , " idx . found? . cr - - type MalTypeType-method-vals @ idx cells + ixt ! - else \ resize - type MalTypeType-methods dup @ 1+ dup rot ! ( new-count ) - 1- dup type MalTypeType-method-keys @ idx pxt array-insert ( old-count new-array ) - type MalTypeType-method-keys ! ( old-count ) - type MalTypeType-method-vals @ idx ixt array-insert ( new-array ) - type MalTypeType-method-vals ! - endif - endif - type - ; - - -\ Define a new protocol function. For example: -\ def-protocol-method pr-str -\ When called as above, defines a new word 'pr-str' and stores there its -\ own xt (known as pxt). When a usage of pr-str is compiled, it -\ allocates a call-site object on the heap and injects a reference to -\ both that and the pxt into the compilation, along with a call to -\ execute-method. Thus when pr-str runs, execute-method can check the -\ call-site object to see if the type of the target object is the same -\ as the last call for this site. If so, it executes the implementation -\ immediately. Otherwise, it searches the target type's method list and -\ if necessary MalDefault's method list. If an implementation of pxt is -\ found, it is cached in the call-site, and then executed. -: make-call-site { pxt -- } - pxt postpone literal \ transfer pxt into call site - call-site% %allocate throw dup postpone literal \ allocate call-site, push reference - \ dup ." Make cs '" pxt >name name>string type ." ' " . cr - 0 swap call-site/type ! - postpone execute-method ; - -: def-protocol-method ( parse: name -- ) - : latestxt postpone literal postpone make-call-site postpone ; immediate - ; - -: extend ( type -- type pxt install-xt ) - parse-name find-name name>int ( type pxt ) - ['] extend-method* - :noname - ; - -: ;; ( type pxt -- type ) - [compile] ; ( type pxt install-xt ixt ) - swap execute - ; immediate - -( -\ These whole-protocol names are only needed for 'satisfies?': -protocol IPrintable - def-protocol-method pr-str -end-protocol - -MalList IPrintable extend - ' pr-str :noname drop s" " ; extend-method* - - extend-method pr-str - drop s" " ;; -end-extend -) - -\ === Mal types and protocols === / - -def-protocol-method conj ( obj this -- this ) -def-protocol-method assoc ( k v this -- this ) -def-protocol-method dissoc ( k this -- this ) -def-protocol-method get ( not-found k this -- value ) -def-protocol-method mal= ( a b -- bool ) -def-protocol-method as-native ( obj -- ) - -def-protocol-method to-list ( obj -- mal-list ) -def-protocol-method empty? ( obj -- mal-bool ) -def-protocol-method mal-count ( obj -- mal-int ) -def-protocol-method sequential? ( obj -- mal-bool ) -def-protocol-method get-map-hint ( obj -- hint ) -def-protocol-method set-map-hint! ( hint obj -- ) - - -\ Fully evalutate any Mal object: -def-protocol-method mal-eval ( env ast -- val ) - -\ Invoke an object, given whole env and unevaluated argument forms: -def-protocol-method eval-invoke ( env list obj -- ... ) - -\ Invoke a function, given parameter values -def-protocol-method invoke ( argv argc mal-fn -- ... ) - - -: m= ( a b -- bool ) - 2dup = if - 2drop true - else - mal= - endif ; - - -MalType% - cell% field MalInt/int -deftype MalInt - -: MalInt. { int -- mal-int } - MalInt new dup MalInt/int int swap ! ; - -MalInt - extend mal= ( other this -- bool ) - over mal-type @ MalInt = if - MalInt/int @ swap MalInt/int @ = - else - 2drop 0 - endif ;; - - extend as-native ( mal-int -- int ) - MalInt/int @ ;; -drop - - -MalType% - cell% field MalList/count - cell% field MalList/start -deftype MalList - -: MalList. ( start count -- mal-list ) - MalList new - swap over MalList/count ! ( start list ) - swap over MalList/start ! ( list ) ; - -: here>MalList ( old-here -- mal-list ) - here over - { bytes } ( old-here ) - MalList new bytes ( old-here mal-list bytes ) - allocate throw dup { target } over MalList/start ! ( old-here mal-list ) - bytes cell / over MalList/count ! ( old-here mal-list ) - swap target bytes cmove ( mal-list ) - 0 bytes - allot \ pop list contents from dictionary stack - ; - -: MalList/concat ( list-of-lists ) - dup MalList/start @ swap MalList/count @ { lists argc } - 0 lists argc cells + lists +do ( count ) - i @ to-list MalList/count @ + - cell +loop { count } - count cells allocate throw { start } - start lists argc cells + lists +do ( target ) - i @ to-list MalList/count @ cells 2dup i @ to-list MalList/start @ -rot ( target bytes src target bytes ) - cmove ( target bytes ) - + ( new-target ) - cell +loop - drop start count MalList. ; - -MalList - extend to-list ;; - extend sequential? drop mal-true ;; - extend conj { elem old-list -- list } - old-list MalList/count @ 1+ { new-count } - new-count cells allocate throw { new-start } - elem new-start ! - new-count 1 > if - old-list MalList/start @ new-start cell+ new-count 1- cells cmove - endif - new-start new-count MalList. ;; - extend empty? MalList/count @ 0= mal-bool ;; - extend mal-count MalList/count @ MalInt. ;; - extend mal= - over mal-nil = if - 2drop false - else - swap to-list dup 0= if - nip - else - 2dup MalList/count @ swap MalList/count @ over = if ( list-a list-b count ) - -rot MalList/start @ swap MalList/start @ { start-b start-a } - true swap ( return-val count ) - 0 ?do - start-a i cells + @ - start-b i cells + @ - m= if else - drop false leave - endif - loop - else - drop 2drop false - endif - endif - endif ;; -drop - -MalList new 0 over MalList/count ! constant MalList/Empty - -: MalList/rest { list -- list } - list MalList/start @ cell+ - list MalList/count @ 1- - MalList. ; - - -MalType% - cell% field MalVector/list -deftype MalVector - -MalVector - extend sequential? drop mal-true ;; - extend to-list - MalVector/list @ ;; - extend empty? - MalVector/list @ - MalList/count @ 0= mal-bool ;; - extend mal-count - MalVector/list @ - MalList/count @ MalInt. ;; - extend mal= - MalVector/list @ swap m= ;; - extend conj - MalVector/list @ { elem old-list } - old-list MalList/count @ { old-count } - old-count 1+ cells allocate throw { new-start } - elem new-start old-count cells + ! - old-list MalList/start @ new-start old-count cells cmove - new-start old-count 1+ MalList. - MalVector new swap - over MalVector/list ! ;; -drop - -MalType% - cell% field MalMap/list -deftype MalMap - -MalMap new MalList/Empty over MalMap/list ! constant MalMap/Empty - -: MalMap/get-addr ( k map -- addr-or-nil ) - MalMap/list @ - dup MalList/start @ - swap MalList/count @ { k start count } - true \ need to search? - k get-map-hint { hint-idx } - hint-idx -1 <> if - hint-idx count < if - hint-idx cells start + { key-addr } - key-addr @ k m= if - key-addr cell+ - nip false - endif - endif - endif - if \ search - nil ( addr ) - count cells start + start +do - i @ k m= if - drop i - dup start - cell / k set-map-hint! - cell+ leave - endif - [ 2 cells ] literal +loop - endif ; - -MalMap - extend conj ( kv map -- map ) - MalMap/list @ \ get list - over MalList/start @ cell+ @ swap conj \ add value - swap MalList/start @ @ swap conj \ add key - MalMap new dup -rot MalMap/list ! \ put back in map - ;; - extend assoc ( k v map -- map ) - MalMap/list @ \ get list - conj conj - MalMap new tuck MalMap/list ! \ put back in map - ;; - extend dissoc { k map -- map } - map MalMap/list @ - dup MalList/start @ swap MalList/count @ { start count } - map \ return original if key not found - count 0 +do - start i cells + @ k mal= if - drop here - start i MalList. , - start i 2 + cells + count i - 2 - MalList. , - here>MalList MalList/concat - MalMap new dup -rot MalMap/list ! \ put back in map - endif - 2 +loop ;; - extend get ( not-found k map -- value ) - MalMap/get-addr ( not-found addr-or-nil ) - dup 0= if drop else nip @ endif ;; - extend empty? - MalMap/list @ - MalList/count @ 0= mal-bool ;; - extend mal-count - MalMap/list @ - MalList/count @ 2 / MalInt. ;; -drop - -\ Examples of extending existing protocol methods to existing type -MalDefault - extend conj ( obj this -- this ) - nip ;; - extend to-list drop 0 ;; - extend empty? drop mal-true ;; - extend sequential? drop mal-false ;; - extend mal= = ;; - extend get-map-hint drop -1 ;; - extend set-map-hint! 2drop ;; -drop - -MalNil - extend conj ( item nil -- mal-list ) - drop MalList/Empty conj ;; - extend as-native drop nil ;; - extend get 2drop ;; - extend to-list drop MalList/Empty ;; - extend empty? drop mal-true ;; - extend mal-count drop 0 MalInt. ;; - extend mal= drop mal-nil = ;; -drop - -MalType% - cell% field MalSymbol/sym-addr - cell% field MalSymbol/sym-len - cell% field MalSymbol/map-hint -deftype MalSymbol - -: MalSymbol. { str-addr str-len -- mal-sym } - MalSymbol new { sym } - str-addr sym MalSymbol/sym-addr ! - str-len sym MalSymbol/sym-len ! - -1 sym MalSymbol/map-hint ! - sym ; - -: unpack-sym ( mal-string -- addr len ) - dup MalSymbol/sym-addr @ - swap MalSymbol/sym-len @ ; - -MalSymbol - extend mal= ( other this -- bool ) - over mal-type @ MalSymbol = if - unpack-sym rot unpack-sym str= - else - 2drop 0 - endif ;; - extend get-map-hint MalSymbol/map-hint @ ;; - extend set-map-hint! MalSymbol/map-hint ! ;; - extend as-native ( this ) - unpack-sym evaluate ;; -drop - -MalType% - cell% field MalKeyword/str-addr - cell% field MalKeyword/str-len -deftype MalKeyword - -: unpack-keyword ( mal-keyword -- addr len ) - dup MalKeyword/str-addr @ - swap MalKeyword/str-len @ ; - -MalKeyword - extend mal= ( other this -- bool ) - over mal-type @ MalKeyword = if - unpack-keyword rot unpack-keyword str= - else - 2drop 0 - endif ;; - ' as-native ' unpack-keyword extend-method* -drop - -: MalKeyword. { str-addr str-len -- mal-keyword } - MalKeyword new { kw } - str-addr kw MalKeyword/str-addr ! - str-len kw MalKeyword/str-len ! - kw ; - -MalType% - cell% field MalString/str-addr - cell% field MalString/str-len -deftype MalString - -: MalString.0 { str-addr str-len -- mal-str } - MalString new { str } - str-addr str MalString/str-addr ! - str-len str MalString/str-len ! - str ; -' MalString.0 is MalString. - -: unpack-str ( mal-string -- addr len ) - dup MalString/str-addr @ - swap MalString/str-len @ ; - -MalString - extend mal= ( other this -- bool ) - over mal-type @ MalString = if - unpack-str rot unpack-str str= - else - 2drop 0 - endif ;; - ' as-native ' unpack-str extend-method* -drop - - -MalType% - cell% field MalNativeFn/xt -deftype MalNativeFn - -: MalNativeFn. { xt -- mal-fn } - MalNativeFn new { mal-fn } - xt mal-fn MalNativeFn/xt ! - mal-fn ; - - -MalType% - cell% field MalUserFn/is-macro? - cell% field MalUserFn/env - cell% field MalUserFn/formal-args - cell% field MalUserFn/var-arg - cell% field MalUserFn/body -deftype MalUserFn - - -MalType% - cell% field SpecialOp/xt -deftype SpecialOp - -: SpecialOp. - SpecialOp new swap over SpecialOp/xt ! ; - -MalType% - cell% field Atom/val -deftype Atom - -: Atom. Atom new swap over Atom/val ! ; diff --git a/get-ci-matrix.py b/get-ci-matrix.py new file mode 100755 index 0000000000..451728d1e1 --- /dev/null +++ b/get-ci-matrix.py @@ -0,0 +1,74 @@ +#!/usr/bin/env python3 + +import json +import os +import re +import sys +import yaml + +IMPLS_FILE = "IMPLS.yml" +RE_IGNORE = re.compile(r'(^LICENSE$|^README.md$|^docs/|^process/|^IMPLS.yml$|^Makefile.impls$)') +RE_IMPL = re.compile(r'^impls/(?!lib|tests)([^/]*)/') + +OVERRIDE_IMPLS = os.environ.get('OVERRIDE_IMPLS', '').split() + +def eprint(*args, **kwargs): + print(*args, file=sys.stderr, **kwargs) + +def impl_text(impl): + s = "IMPL=%s" % impl['IMPL'] + for k, v in impl.items(): + if k == 'IMPL': continue + s += " %s=%s" % (k, v) + return s + +all_changes = sys.argv[1:] +# code changes that are not just to docs or implementation lists +code_changes = set([c for c in all_changes if not RE_IGNORE.search(c)]) +# actual changes to implementations +impl_changes = set([c for c in all_changes if RE_IMPL.search(c)]) +# names of changed implementations +run_impls = set([RE_IMPL.search(c).groups()[0] for c in impl_changes]) + +do_full = (len(code_changes) != len(impl_changes)) + +# If we have non-implementation code changes then we will add all +# implementations to the test matrix +if OVERRIDE_IMPLS: + run_impls = OVERRIDE_IMPLS + if 'all' in OVERRIDE_IMPLS: + do_full = True + + +eprint("OVERRIDE_IMPLS: %s" % OVERRIDE_IMPLS) +eprint("code_changes: %s (%d)" % (code_changes, len(code_changes))) +eprint("impl_changes: %s (%d)" % (impl_changes, len(impl_changes))) +eprint("run_impls: %s (%d)" % (run_impls, len(run_impls))) +eprint("do_full: %s" % do_full) + +# Load the full implementation description file +all_impls = yaml.safe_load(open(IMPLS_FILE)) + +# Accumulate and output linux, macos & windows implementations separately +linux_impls = [] +macos_impls = [] +windows_impls = [] +for impl in all_impls['IMPL']: + targ = linux_impls + if 'OS' in impl and impl['OS'] == 'macos': + targ = macos_impls + if 'OS' in impl and impl['OS'] == 'windows': + targ = windows_impls + # Run implementations with actual changes first before running + # other impls triggered by non-impl code changes + if impl['IMPL'] in run_impls: + targ.insert(0, impl_text(impl)) + elif do_full: + targ.append(impl_text(impl)) + +print("do_linux=%s" % json.dumps(len(linux_impls)>0)) +print("do_macos=%s" % json.dumps(len(macos_impls)>0)) +print("do_windows=%s" % json.dumps(len(windows_impls)>0)) +print("linux={\"IMPL\":%s}" % json.dumps(linux_impls)) +print("macos={\"IMPL\":%s}" % json.dumps(macos_impls)) +print("windows={\"IMPL\":%s}" % json.dumps(windows_impls)) diff --git a/go/Makefile b/go/Makefile deleted file mode 100644 index 67e967b90a..0000000000 --- a/go/Makefile +++ /dev/null @@ -1,41 +0,0 @@ -export GOPATH := $(dir $(abspath $(lastword $(MAKEFILE_LIST)))) - -##################### - -SOURCES_BASE = src/types/types.go src/readline/readline.go \ - src/reader/reader.go src/printer/printer.go \ - src/env/env.go src/core/core.go -SOURCES_LISP = src/env/env.go src/core/core.go \ - src/stepA_mal/stepA_mal.go -SOURCES = $(SOURCES_BASE) $(word $(words $(SOURCES_LISP)),${SOURCES_LISP}) - -##################### - -SRCS = step0_repl.go step1_read_print.go step2_eval.go step3_env.go \ - step4_if_fn_do.go step5_tco.go step6_file.go step7_quote.go \ - step8_macros.go step9_try.go stepA_mal.go -BINS = $(SRCS:%.go=%) - -##################### - -all: $(BINS) mal - -mal: $(word $(words $(BINS)),$(BINS)) - cp $< $@ - -define dep_template -$(1): $(SOURCES_BASE) src/$(1)/$(1).go - go build $$@ -endef - -$(foreach b,$(BINS),$(eval $(call dep_template,$(b)))) - -clean: - rm -f $(BINS) mal - -.PHONY: stats stats-lisp - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/go/src/core/core.go b/go/src/core/core.go deleted file mode 100644 index 159acc7695..0000000000 --- a/go/src/core/core.go +++ /dev/null @@ -1,516 +0,0 @@ -package core - -import ( - "errors" - "fmt" - "io/ioutil" - "time" -) - -import ( - "printer" - "reader" - "readline" - . "types" -) - -// Errors/Exceptions -func throw(a []MalType) (MalType, error) { - return nil, MalError{a[0]} -} - -// String functions - -func pr_str(a []MalType) (MalType, error) { - return printer.Pr_list(a, true, "", "", " "), nil -} - -func str(a []MalType) (MalType, error) { - return printer.Pr_list(a, false, "", "", ""), nil -} - -func prn(a []MalType) (MalType, error) { - fmt.Println(printer.Pr_list(a, true, "", "", " ")) - return nil, nil -} - -func println(a []MalType) (MalType, error) { - fmt.Println(printer.Pr_list(a, false, "", "", " ")) - return nil, nil -} - -func slurp(a []MalType) (MalType, error) { - b, e := ioutil.ReadFile(a[0].(string)) - if e != nil { - return nil, e - } - return string(b), nil -} - -// Number functions -func time_ms(a []MalType) (MalType, error) { - return int(time.Now().UnixNano() / int64(time.Millisecond)), nil -} - -// Hash Map functions -func copy_hash_map(hm HashMap) HashMap { - new_hm := HashMap{map[string]MalType{}, nil} - for k, v := range hm.Val { - new_hm.Val[k] = v - } - return new_hm -} - -func assoc(a []MalType) (MalType, error) { - if len(a) < 3 { - return nil, errors.New("assoc requires at least 3 arguments") - } - if len(a)%2 != 1 { - return nil, errors.New("assoc requires odd number of arguments") - } - if !HashMap_Q(a[0]) { - return nil, errors.New("assoc called on non-hash map") - } - new_hm := copy_hash_map(a[0].(HashMap)) - for i := 1; i < len(a); i += 2 { - key := a[i] - if !String_Q(key) { - return nil, errors.New("assoc called with non-string key") - } - new_hm.Val[key.(string)] = a[i+1] - } - return new_hm, nil -} - -func dissoc(a []MalType) (MalType, error) { - if len(a) < 2 { - return nil, errors.New("dissoc requires at least 3 arguments") - } - if !HashMap_Q(a[0]) { - return nil, errors.New("dissoc called on non-hash map") - } - new_hm := copy_hash_map(a[0].(HashMap)) - for i := 1; i < len(a); i += 1 { - key := a[i] - if !String_Q(key) { - return nil, errors.New("dissoc called with non-string key") - } - delete(new_hm.Val, key.(string)) - } - return new_hm, nil -} - -func get(a []MalType) (MalType, error) { - if len(a) != 2 { - return nil, errors.New("get requires 2 arguments") - } - if Nil_Q(a[0]) { - return nil, nil - } - if !HashMap_Q(a[0]) { - return nil, errors.New("get called on non-hash map") - } - if !String_Q(a[1]) { - return nil, errors.New("get called with non-string key") - } - return a[0].(HashMap).Val[a[1].(string)], nil -} - -func contains_Q(hm MalType, key MalType) (MalType, error) { - if Nil_Q(hm) { - return false, nil - } - if !HashMap_Q(hm) { - return nil, errors.New("get called on non-hash map") - } - if !String_Q(key) { - return nil, errors.New("get called with non-string key") - } - _, ok := hm.(HashMap).Val[key.(string)] - return ok, nil -} - -func keys(a []MalType) (MalType, error) { - if !HashMap_Q(a[0]) { - return nil, errors.New("keys called on non-hash map") - } - slc := []MalType{} - for k, _ := range a[0].(HashMap).Val { - slc = append(slc, k) - } - return List{slc, nil}, nil -} -func vals(a []MalType) (MalType, error) { - if !HashMap_Q(a[0]) { - return nil, errors.New("keys called on non-hash map") - } - slc := []MalType{} - for _, v := range a[0].(HashMap).Val { - slc = append(slc, v) - } - return List{slc, nil}, nil -} - -// Sequence functions - -func cons(a []MalType) (MalType, error) { - val := a[0] - lst, e := GetSlice(a[1]) - if e != nil { - return nil, e - } - - return List{append([]MalType{val}, lst...), nil}, nil -} - -func concat(a []MalType) (MalType, error) { - if len(a) == 0 { - return List{}, nil - } - slc1, e := GetSlice(a[0]) - if e != nil { - return nil, e - } - for i := 1; i < len(a); i += 1 { - slc2, e := GetSlice(a[i]) - if e != nil { - return nil, e - } - slc1 = append(slc1, slc2...) - } - return List{slc1, nil}, nil -} - -func nth(a []MalType) (MalType, error) { - slc, e := GetSlice(a[0]) - if e != nil { - return nil, e - } - idx := a[1].(int) - if idx < len(slc) { - return slc[idx], nil - } else { - return nil, errors.New("nth: index out of range") - } -} - -func first(a []MalType) (MalType, error) { - if len(a) == 0 { - return nil, nil - } - slc, e := GetSlice(a[0]) - if e != nil { - return nil, e - } - if len(slc) == 0 { - return nil, nil - } - return slc[0], nil -} - -func rest(a []MalType) (MalType, error) { - slc, e := GetSlice(a[0]) - if e != nil { - return nil, e - } - if len(slc) == 0 { - return List{}, nil - } - return List{slc[1:], nil}, nil -} - -func empty_Q(a []MalType) (MalType, error) { - switch obj := a[0].(type) { - case List: - return len(obj.Val) == 0, nil - case Vector: - return len(obj.Val) == 0, nil - case nil: - return true, nil - default: - return nil, errors.New("Count called on non-sequence") - } -} - -func count(a []MalType) (MalType, error) { - switch obj := a[0].(type) { - case List: - return len(obj.Val), nil - case Vector: - return len(obj.Val), nil - case map[string]MalType: - return len(obj), nil - case nil: - return 0, nil - default: - return nil, errors.New("Count called on non-sequence") - } -} - -func apply(a []MalType) (MalType, error) { - if len(a) < 2 { - return nil, errors.New("apply requires at least 2 args") - } - f := a[0] - args := []MalType{} - for _, b := range a[1 : len(a)-1] { - args = append(args, b) - } - last, e := GetSlice(a[len(a)-1]) - if e != nil { - return nil, e - } - args = append(args, last...) - return Apply(f, args) -} - -func do_map(a []MalType) (MalType, error) { - if len(a) != 2 { - return nil, errors.New("map requires 2 args") - } - f := a[0] - results := []MalType{} - args, e := GetSlice(a[1]) - if e != nil { - return nil, e - } - for _, arg := range args { - res, e := Apply(f, []MalType{arg}) - results = append(results, res) - if e != nil { - return nil, e - } - } - return List{results, nil}, nil -} - -func conj(a []MalType) (MalType, error) { - if len(a) < 2 { - return nil, errors.New("conj requires at least 2 arguments") - } - switch seq := a[0].(type) { - case List: - new_slc := []MalType{} - for i := len(a) - 1; i > 0; i -= 1 { - new_slc = append(new_slc, a[i]) - } - return List{append(new_slc, seq.Val...), nil}, nil - case Vector: - new_slc := seq.Val - for _, x := range a[1:] { - new_slc = append(new_slc, x) - } - return Vector{new_slc, nil}, nil - } - - if !HashMap_Q(a[0]) { - return nil, errors.New("dissoc called on non-hash map") - } - new_hm := copy_hash_map(a[0].(HashMap)) - for i := 1; i < len(a); i += 1 { - key := a[i] - if !String_Q(key) { - return nil, errors.New("dissoc called with non-string key") - } - delete(new_hm.Val, key.(string)) - } - return new_hm, nil -} - -// Metadata functions -func with_meta(a []MalType) (MalType, error) { - if len(a) != 2 { - return nil, errors.New("with-meta requires 2 args") - } - obj := a[0] - m := a[1] - switch tobj := obj.(type) { - case List: - return List{tobj.Val, m}, nil - case Vector: - return Vector{tobj.Val, m}, nil - case HashMap: - return HashMap{tobj.Val, m}, nil - case Func: - return Func{tobj.Fn, m}, nil - case MalFunc: - fn := tobj - fn.Meta = m - return fn, nil - default: - return nil, errors.New("with-meta not supported on type") - } -} - -func meta(a []MalType) (MalType, error) { - obj := a[0] - switch tobj := obj.(type) { - case List: - return tobj.Meta, nil - case Vector: - return tobj.Meta, nil - case HashMap: - return tobj.Meta, nil - case Func: - return tobj.Meta, nil - case MalFunc: - return tobj.Meta, nil - default: - return nil, errors.New("meta not supported on type") - } -} - -// Atom functions -func deref(a []MalType) (MalType, error) { - if !Atom_Q(a[0]) { - return nil, errors.New("deref called with non-atom") - } - return a[0].(*Atom).Val, nil -} - -func reset_BANG(a []MalType) (MalType, error) { - if !Atom_Q(a[0]) { - return nil, errors.New("reset! called with non-atom") - } - a[0].(*Atom).Set(a[1]) - return a[1], nil -} - -func swap_BANG(a []MalType) (MalType, error) { - if !Atom_Q(a[0]) { - return nil, errors.New("swap! called with non-atom") - } - if len(a) < 2 { - return nil, errors.New("swap! requires at least 2 args") - } - atm := a[0].(*Atom) - args := []MalType{atm.Val} - f := a[1] - args = append(args, a[2:]...) - res, e := Apply(f, args) - if e != nil { - return nil, e - } - atm.Set(res) - return res, nil -} - -// core namespace -var NS = map[string]MalType{ - "=": func(a []MalType) (MalType, error) { - return Equal_Q(a[0], a[1]), nil - }, - "throw": throw, - "nil?": func(a []MalType) (MalType, error) { - return Nil_Q(a[0]), nil - }, - "true?": func(a []MalType) (MalType, error) { - return True_Q(a[0]), nil - }, - "false?": func(a []MalType) (MalType, error) { - return False_Q(a[0]), nil - }, - "symbol": func(a []MalType) (MalType, error) { - return Symbol{a[0].(string)}, nil - }, - "symbol?": func(a []MalType) (MalType, error) { - return Symbol_Q(a[0]), nil - }, - "keyword": func(a []MalType) (MalType, error) { - return NewKeyword(a[0].(string)) - }, - "keyword?": func(a []MalType) (MalType, error) { - return Keyword_Q(a[0]), nil - }, - - "pr-str": func(a []MalType) (MalType, error) { return pr_str(a) }, - "str": func(a []MalType) (MalType, error) { return str(a) }, - "prn": func(a []MalType) (MalType, error) { return prn(a) }, - "println": func(a []MalType) (MalType, error) { return println(a) }, - "read-string": func(a []MalType) (MalType, error) { - return reader.Read_str(a[0].(string)) - }, - "slurp": slurp, - "readline": func(a []MalType) (MalType, error) { - return readline.Readline(a[0].(string)) - }, - - "<": func(a []MalType) (MalType, error) { - return a[0].(int) < a[1].(int), nil - }, - "<=": func(a []MalType) (MalType, error) { - return a[0].(int) <= a[1].(int), nil - }, - ">": func(a []MalType) (MalType, error) { - return a[0].(int) > a[1].(int), nil - }, - ">=": func(a []MalType) (MalType, error) { - return a[0].(int) >= a[1].(int), nil - }, - "+": func(a []MalType) (MalType, error) { - return a[0].(int) + a[1].(int), nil - }, - "-": func(a []MalType) (MalType, error) { - return a[0].(int) - a[1].(int), nil - }, - "*": func(a []MalType) (MalType, error) { - return a[0].(int) * a[1].(int), nil - }, - "/": func(a []MalType) (MalType, error) { - return a[0].(int) / a[1].(int), nil - }, - "time-ms": time_ms, - - "list": func(a []MalType) (MalType, error) { - return List{a, nil}, nil - }, - "list?": func(a []MalType) (MalType, error) { - return List_Q(a[0]), nil - }, - "vector": func(a []MalType) (MalType, error) { - return Vector{a, nil}, nil - }, - "vector?": func(a []MalType) (MalType, error) { - return Vector_Q(a[0]), nil - }, - "hash-map": func(a []MalType) (MalType, error) { - return NewHashMap(List{a, nil}) - }, - "map?": func(a []MalType) (MalType, error) { - return HashMap_Q(a[0]), nil - }, - "assoc": assoc, - "dissoc": dissoc, - "get": get, - "contains?": func(a []MalType) (MalType, error) { - return contains_Q(a[0], a[1]) - }, - "keys": keys, - "vals": vals, - - "sequential?": func(a []MalType) (MalType, error) { - return Sequential_Q(a[0]), nil - }, - "cons": cons, - "concat": concat, - "nth": nth, - "first": first, - "rest": rest, - "empty?": empty_Q, - "count": count, - "apply": apply, - "map": do_map, - "conj": conj, - - "with-meta": with_meta, - "meta": meta, - "atom": func(a []MalType) (MalType, error) { - return &Atom{a[0], nil}, nil - }, - "atom?": func(a []MalType) (MalType, error) { - return Atom_Q(a[0]), nil - }, - "deref": deref, - "reset!": reset_BANG, - "swap!": swap_BANG, -} diff --git a/go/src/stepA_mal/stepA_mal.go b/go/src/stepA_mal/stepA_mal.go deleted file mode 100644 index 548d72b723..0000000000 --- a/go/src/stepA_mal/stepA_mal.go +++ /dev/null @@ -1,372 +0,0 @@ -package main - -import ( - "errors" - "fmt" - "os" - "strings" -) - -import ( - "core" - . "env" - "printer" - "reader" - "readline" - . "types" -) - -// read -func READ(str string) (MalType, error) { - return reader.Read_str(str) -} - -// eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false - } - return len(slc) > 0 -} - -func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} - } - } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} - } -} - -func is_macro_call(ast MalType, env EnvType) bool { - if List_Q(ast) { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && env.Find(a0.(Symbol)) != nil { - mac, e := env.Get(a0.(Symbol)) - if e != nil { - return false - } - if MalFunc_Q(mac) { - return mac.(MalFunc).GetMacro() - } - } - } - return false -} - -func macroexpand(ast MalType, env EnvType) (MalType, error) { - var mac MalType - var e error - for is_macro_call(ast, env) { - slc, _ := GetSlice(ast) - a0 := slc[0] - mac, e = env.Get(a0.(Symbol)) - if e != nil { - return nil, e - } - fn := mac.(MalFunc) - ast, e = Apply(fn, slc[1:]) - if e != nil { - return nil, e - } - } - return ast, nil -} - -func eval_ast(ast MalType, env EnvType) (MalType, error) { - //fmt.Printf("eval_ast: %#v\n", ast) - if Symbol_Q(ast) { - return env.Get(ast.(Symbol)) - } else if List_Q(ast) { - lst := []MalType{} - for _, a := range ast.(List).Val { - exp, e := EVAL(a, env) - if e != nil { - return nil, e - } - lst = append(lst, exp) - } - return List{lst, nil}, nil - } else if Vector_Q(ast) { - lst := []MalType{} - for _, a := range ast.(Vector).Val { - exp, e := EVAL(a, env) - if e != nil { - return nil, e - } - lst = append(lst, exp) - } - return Vector{lst, nil}, nil - } else if HashMap_Q(ast) { - m := ast.(HashMap) - new_hm := HashMap{map[string]MalType{}, nil} - for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } - kv, e2 := EVAL(v, env) - if e2 != nil { - return nil, e2 - } - new_hm.Val[ke.(string)] = kv - } - return new_hm, nil - } else { - return ast, nil - } -} - -func EVAL(ast MalType, env EnvType) (MalType, error) { - var e error - for { - - //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) - switch ast.(type) { - case List: // continue - default: - return eval_ast(ast, env) - } - - // apply list - ast, e = macroexpand(ast, env) - if e != nil { - return nil, e - } - if !List_Q(ast) { - return ast, nil - } - - a0 := ast.(List).Val[0] - var a1 MalType = nil - var a2 MalType = nil - switch len(ast.(List).Val) { - case 1: - a1 = nil - a2 = nil - case 2: - a1 = ast.(List).Val[1] - a2 = nil - default: - a1 = ast.(List).Val[1] - a2 = ast.(List).Val[2] - } - a0sym := "__<*fn*>__" - if Symbol_Q(a0) { - a0sym = a0.(Symbol).Val - } - switch a0sym { - case "def!": - res, e := EVAL(a2, env) - if e != nil { - return nil, e - } - return env.Set(a1.(Symbol), res), nil - case "let*": - let_env, e := NewEnv(env, nil, nil) - if e != nil { - return nil, e - } - arr1, e := GetSlice(a1) - if e != nil { - return nil, e - } - for i := 0; i < len(arr1); i += 2 { - if !Symbol_Q(arr1[i]) { - return nil, errors.New("non-symbol bind value") - } - exp, e := EVAL(arr1[i+1], let_env) - if e != nil { - return nil, e - } - let_env.Set(arr1[i].(Symbol), exp) - } - ast = a2 - env = let_env - case "quote": - return a1, nil - case "quasiquote": - ast = quasiquote(a1) - case "defmacro!": - fn, e := EVAL(a2, env) - fn = fn.(MalFunc).SetMacro() - if e != nil { - return nil, e - } - return env.Set(a1.(Symbol), fn), nil - case "macroexpand": - return macroexpand(a1, env) - case "try*": - var exc MalType - exp, e := EVAL(a1, env) - if e == nil { - return exp, nil - } else { - if a2 != nil && List_Q(a2) { - a2s, _ := GetSlice(a2) - if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") { - switch e.(type) { - case MalError: - exc = e.(MalError).Obj - default: - exc = e.Error() - } - binds := NewList(a2s[1]) - new_env, e := NewEnv(env, binds, NewList(exc)) - if e != nil { - return nil, e - } - exp, e = EVAL(a2s[2], new_env) - if e == nil { - return exp, nil - } - } - } - return nil, e - } - case "do": - lst := ast.(List).Val - _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) - if e != nil { - return nil, e - } - if len(lst) == 1 { - return nil, nil - } - ast = lst[len(lst)-1] - case "if": - cond, e := EVAL(a1, env) - if e != nil { - return nil, e - } - if cond == nil || cond == false { - if len(ast.(List).Val) >= 4 { - ast = ast.(List).Val[3] - } else { - return nil, nil - } - } else { - ast = a2 - } - case "fn*": - fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} - return fn, nil - default: - el, e := eval_ast(ast, env) - if e != nil { - return nil, e - } - f := el.(List).Val[0] - if MalFunc_Q(f) { - fn := f.(MalFunc) - ast = fn.Exp - env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) - if e != nil { - return nil, e - } - } else { - fn, ok := f.(Func) - if !ok { - return nil, errors.New("attempt to call non-function") - } - return fn.Fn(el.(List).Val[1:]) - } - } - - } // TCO loop -} - -// print -func PRINT(exp MalType) (string, error) { - return printer.Pr_str(exp, true), nil -} - -var repl_env, _ = NewEnv(nil, nil, nil) - -// repl -func rep(str string) (MalType, error) { - var exp MalType - var res string - var e error - if exp, e = READ(str); e != nil { - return nil, e - } - if exp, e = EVAL(exp, repl_env); e != nil { - return nil, e - } - if res, e = PRINT(exp); e != nil { - return nil, e - } - return res, nil -} - -func main() { - // core.go: defined using go - for k, v := range core.NS { - repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) - } - repl_env.Set(Symbol{"eval"}, Func{func(a []MalType) (MalType, error) { - return EVAL(a[0], repl_env) - }, nil}) - repl_env.Set(Symbol{"*ARGV*"}, List{}) - - // core.mal: defined using the language itself - rep("(def! *host-language* \"go\")") - rep("(def! not (fn* (a) (if a false true)))") - rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") - rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - // called with mal script to load and eval - if len(os.Args) > 1 { - args := make([]MalType, 0, len(os.Args)-2) - for _, a := range os.Args[2:] { - args = append(args, a) - } - repl_env.Set(Symbol{"*ARGV*"}, List{args, nil}) - if _, e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { - fmt.Printf("Error: %v\n", e) - os.Exit(1) - } - os.Exit(0) - } - - // repl loop - rep("(println (str \"Mal [\" *host-language* \"]\"))") - for { - text, err := readline.Readline("user> ") - text = strings.TrimRight(text, "\n") - if err != nil { - return - } - var out MalType - var e error - if out, e = rep(text); e != nil { - if e.Error() == "" { - continue - } - fmt.Printf("Error: %v\n", e) - continue - } - fmt.Printf("%v\n", out) - } -} diff --git a/haskell/Core.hs b/haskell/Core.hs deleted file mode 100644 index d1034c1dcc..0000000000 --- a/haskell/Core.hs +++ /dev/null @@ -1,297 +0,0 @@ -module Core -( ns ) -where - -import System.IO (hFlush, stdout) -import Control.Exception (catch) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import Data.Time.Clock.POSIX (getPOSIXTime) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) - -import Readline (readline) -import Reader (read_str) -import Types -import Printer (_pr_str, _pr_list) - --- General functions - -equal_Q [a, b] = return $ if a == b then MalTrue else MalFalse -equal_Q _ = throwStr "illegal arguments to =" - -run_1 :: (MalVal -> MalVal) -> [MalVal] -> IOThrows MalVal -run_1 f (x:[]) = return $ f x -run_1 _ _ = throwStr "function takes a single argument" - -run_2 :: (MalVal -> MalVal -> MalVal) -> [MalVal] -> IOThrows MalVal -run_2 f (x:y:[]) = return $ f x y -run_2 _ _ = throwStr "function takes a two arguments" - --- Error/Exception functions - -throw (mv:[]) = throwMalVal mv -throw _ = throwStr "illegal arguments to throw" - --- Scalar functions - -symbol (MalString str:[]) = return $ MalSymbol str -symbol _ = throwStr "symbol called with non-string" - -keyword (MalString str:[]) = return $ MalString $ "\x029e" ++ str -keyword _ = throwStr "keyword called with non-string" - - --- String functions - -pr_str args = do - return $ MalString $ _pr_list True " " args - -str args = do - return $ MalString $ _pr_list False "" args - -prn args = do - liftIO $ putStrLn $ _pr_list True " " args - liftIO $ hFlush stdout - return Nil - -println args = do - liftIO $ putStrLn $ _pr_list False " " args - liftIO $ hFlush stdout - return Nil - -slurp ([MalString path]) = do - str <- liftIO $ readFile path - return $ MalString str -slurp _ = throwStr "invalid arguments to slurp" - -do_readline ([MalString prompt]) = do - str <- liftIO $ readline prompt - case str of - Nothing -> throwStr "readline failed" - Just str -> return $ MalString str -do_readline _ = throwStr "invalid arguments to readline" - --- Numeric functions - -num_op op [MalNumber a, MalNumber b] = do - return $ MalNumber $ op a b -num_op _ _ = throwStr "illegal arguments to number operation" - -cmp_op op [MalNumber a, MalNumber b] = do - return $ if op a b then MalTrue else MalFalse -cmp_op _ _ = throwStr "illegal arguments to comparison operation" - -time_ms _ = do - t <- liftIO $ getPOSIXTime - return $ MalNumber $ round (t * 1000) - - --- List functions - -list args = return $ MalList args Nil - --- Vector functions - -vector args = return $ MalVector args Nil - --- Hash Map functions - -_pairup [x] = throwStr "Odd number of elements to _pairup" -_pairup [] = return [] -_pairup (MalString x:y:xs) = do - rest <- _pairup xs - return $ (x,y):rest - -hash_map args = do - pairs <- _pairup args - return $ MalHashMap (Map.fromList pairs) Nil - -assoc (MalHashMap hm _:kvs) = do - pairs <- _pairup kvs - return $ MalHashMap (Map.union (Map.fromList pairs) hm) Nil -assoc _ = throwStr "invalid call to assoc" - -dissoc (MalHashMap hm _:ks) = do - let remover = (\hm (MalString k) -> Map.delete k hm) in - return $ MalHashMap (foldl remover hm ks) Nil -dissoc _ = throwStr "invalid call to dissoc" - -get (MalHashMap hm _:MalString k:[]) = do - case Map.lookup k hm of - Just mv -> return mv - Nothing -> return Nil -get (Nil:MalString k:[]) = return Nil -get _ = throwStr "invalid call to get" - -contains_Q (MalHashMap hm _:MalString k:[]) = do - if Map.member k hm then return MalTrue - else return MalFalse -contains_Q (Nil:MalString k:[]) = return MalFalse -contains_Q _ = throwStr "invalid call to contains?" - -keys (MalHashMap hm _:[]) = do - return $ MalList (map MalString (Map.keys hm)) Nil -keys _ = throwStr "invalid call to keys" - -vals (MalHashMap hm _:[]) = do - return $ MalList (Map.elems hm) Nil -vals _ = throwStr "invalid call to vals" - - --- Sequence functions - -_sequential_Q (MalList _ _) = MalTrue -_sequential_Q (MalVector _ _) = MalTrue -_sequential_Q _ = MalFalse - -cons x Nil = MalList [x] Nil -cons x (MalList lst _) = MalList (x:lst) Nil -cons x (MalVector lst _) = MalList (x:lst) Nil - -concat1 a (MalList lst _) = a ++ lst -concat1 a (MalVector lst _) = a ++ lst -do_concat args = return $ MalList (foldl concat1 [] args) Nil - -nth ((MalList lst _):(MalNumber idx):[]) = do - if idx < length lst then return $ lst !! idx - else throwStr "nth: index out of range" -nth ((MalVector lst _):(MalNumber idx):[]) = do - if idx < length lst then return $ lst !! idx - else throwStr "nth: index out of range" -nth _ = throwStr "invalid call to nth" - -first (MalList lst _) = if length lst > 0 then lst !! 0 else Nil -first (MalVector lst _) = if length lst > 0 then lst !! 0 else Nil - -rest (MalList lst _) = MalList (drop 1 lst) Nil -rest (MalVector lst _) = MalList (drop 1 lst) Nil - -empty_Q Nil = MalTrue -empty_Q (MalList [] _) = MalTrue -empty_Q (MalVector [] _) = MalTrue -empty_Q _ = MalFalse - -count (Nil:[]) = return $ MalNumber 0 -count (MalList lst _:[]) = return $ MalNumber $ length lst -count (MalVector lst _:[]) = return $ MalNumber $ length lst -count _ = throwStr $ "non-sequence passed to count" - -conj ((MalList lst _):args) = return $ MalList ((reverse args) ++ lst) Nil -conj ((MalVector lst _):args) = return $ MalVector (lst ++ args) Nil -conj _ = throwStr $ "illegal arguments to conj" - -apply args = do - f <- _get_call args - lst <- _to_list (last args) - f $ (init (drop 1 args)) ++ lst - -do_map args = do - f <- _get_call args - lst <- _to_list (args !! 1) - do new_lst <- mapM (\x -> f [x]) lst - return $ MalList new_lst Nil - --- Metadata functions - -with_meta ((MalList lst _):m:[]) = return $ MalList lst m -with_meta ((MalVector lst _):m:[]) = return $ MalVector lst m -with_meta ((MalHashMap hm _):m:[]) = return $ MalHashMap hm m -with_meta ((MalAtom atm _):m:[]) = return $ MalAtom atm m -with_meta ((Func f _):m:[]) = return $ Func f m -with_meta ((MalFunc {fn=f, ast=a, env=e, params=p, macro=mc}):m:[]) = do - return $ MalFunc {fn=f, ast=a, env=e, params=p, macro=mc, meta=m} -with_meta _ = throwStr $ "invalid with-meta call" - -do_meta ((MalList _ m):[]) = return m -do_meta ((MalVector _ m):[]) = return m -do_meta ((MalHashMap _ m):[]) = return m -do_meta ((MalAtom _ m):[]) = return m -do_meta ((Func _ m):[]) = return m -do_meta ((MalFunc {meta=m}):[]) = return m -do_meta _ = throwStr $ "invalid meta call" - --- Atom functions - -atom (val:[]) = do - ref <- liftIO $ newIORef val - return $ MalAtom ref Nil -atom _ = throwStr "invalid atom call" - -deref (MalAtom ref _:[]) = do - val <- liftIO $ readIORef ref - return val -deref _ = throwStr "invalid deref call" - -reset_BANG (MalAtom ref _:val:[]) = do - liftIO $ writeIORef ref $ val - return val -reset_BANG _ = throwStr "invalid deref call" - -swap_BANG (MalAtom ref _:args) = do - val <- liftIO $ readIORef ref - f <- _get_call args - new_val <- f $ [val] ++ (tail args) - _ <- liftIO $ writeIORef ref $ new_val - return new_val - -ns = [ - ("=", _func equal_Q), - ("throw", _func throw), - ("nil?", _func $ run_1 $ _nil_Q), - ("true?", _func $ run_1 $ _true_Q), - ("false?", _func $ run_1 $ _false_Q), - ("symbol", _func $ symbol), - ("symbol?", _func $ run_1 $ _symbol_Q), - ("keyword", _func $ keyword), - ("keyword?", _func $ run_1 $ _keyword_Q), - - ("pr-str", _func pr_str), - ("str", _func str), - ("prn", _func prn), - ("println", _func println), - ("readline", _func do_readline), - ("read-string", _func (\[(MalString s)] -> read_str s)), - ("slurp", _func slurp), - - ("<", _func $ cmp_op (<)), - ("<=", _func $ cmp_op (<=)), - (">", _func $ cmp_op (>)), - (">=", _func $ cmp_op (>=)), - ("+", _func $ num_op (+)), - ("-", _func $ num_op (-)), - ("*", _func $ num_op (*)), - ("/", _func $ num_op (div)), - ("time-ms", _func $ time_ms), - - ("list", _func $ list), - ("list?", _func $ run_1 _list_Q), - ("vector", _func $ vector), - ("vector?", _func $ run_1 _vector_Q), - ("hash-map", _func $ hash_map), - ("map?", _func $ run_1 _hash_map_Q), - ("assoc", _func $ assoc), - ("dissoc", _func $ dissoc), - ("get", _func $ get), - ("contains?",_func $ contains_Q), - ("keys", _func $ keys), - ("vals", _func $ vals), - - ("sequential?", _func $ run_1 _sequential_Q), - ("cons", _func $ run_2 $ cons), - ("concat", _func $ do_concat), - ("nth", _func nth), - ("first", _func $ run_1 $ first), - ("rest", _func $ run_1 $ rest), - ("empty?", _func $ run_1 $ empty_Q), - ("count", _func $ count), - ("conj", _func $ conj), - ("apply", _func $ apply), - ("map", _func $ do_map), - - ("with-meta", _func $ with_meta), - ("meta", _func $ do_meta), - ("atom", _func $ atom), - ("atom?", _func $ run_1 _atom_Q), - ("deref", _func $ deref), - ("reset!", _func $ reset_BANG), - ("swap!", _func $ swap_BANG)] diff --git a/haskell/Env.hs b/haskell/Env.hs deleted file mode 100644 index 3dfd2c83eb..0000000000 --- a/haskell/Env.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Env -( Env, env_new, null_env, env_bind, env_find, env_get, env_set ) -where - -import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Control.Monad.Trans (liftIO) -import Data.List (elemIndex) -import qualified Data.Map as Map - -import Types -import Printer - --- These Env types are defined in Types module to avoid dep cycle ---data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal)) ---type Env = IORef EnvData - -env_new :: Maybe Env -> IO Env -env_new outer = newIORef $ EnvPair (outer, (Map.fromList [])) - -null_env = env_new Nothing - -env_bind :: Env -> [MalVal] -> [MalVal] -> IO Env -env_bind envRef binds exprs = do - case (elemIndex (MalSymbol "&") binds) of - Nothing -> do - -- bind binds to exprs - _ <- mapM (\(b,e) -> env_set envRef b e) $ zip binds exprs - return envRef - Just idx -> do - -- Varargs binding - _ <- mapM (\(b,e) -> env_set envRef b e) $ - zip (take idx binds) (take idx exprs) - _ <- env_set envRef (binds !! (idx + 1)) - (MalList (drop idx exprs) Nil) - return envRef - -env_find :: Env -> MalVal -> IO (Maybe Env) -env_find envRef sym@(MalSymbol key) = do - e <- readIORef envRef - case e of - EnvPair (o, m) -> case Map.lookup key m of - Nothing -> case o of - Nothing -> return Nothing - Just o -> env_find o sym - Just val -> return $ Just envRef - -env_get :: Env -> MalVal -> IOThrows MalVal -env_get envRef sym@(MalSymbol key) = do - e1 <- liftIO $ env_find envRef sym - case e1 of - Nothing -> throwStr $ "'" ++ key ++ "' not found" - Just eRef -> do - e2 <- liftIO $ readIORef eRef - case e2 of - EnvPair (o,m) -> case Map.lookup key m of - Nothing -> throwStr $ "env_get error" - Just val -> return val - - -env_set :: Env -> MalVal -> MalVal -> IO MalVal -env_set envRef (MalSymbol key) val = do - e <- readIORef envRef - case e of - EnvPair (o,m) -> writeIORef envRef $ EnvPair (o, (Map.insert key val m)) - return val diff --git a/haskell/Makefile b/haskell/Makefile deleted file mode 100644 index 0ac1a75cc4..0000000000 --- a/haskell/Makefile +++ /dev/null @@ -1,31 +0,0 @@ -SOURCES_BASE = Readline.hs Types.hs Reader.hs Printer.hs -SOURCES_LISP = Env.hs Core.hs step9_try.hs -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -##################### - -SRCS = step0_repl.hs step1_read_print.hs step2_eval.hs step3_env.hs \ - step4_if_fn_do.hs step5_tco.hs step6_file.hs step7_quote.hs \ - step8_macros.hs step9_try.hs stepA_mal.hs -OTHER_SRCS = Readline.hs Types.hs Reader.hs Printer.hs Env.hs Core.hs -BINS = $(SRCS:%.hs=%) - -##################### - -all: $(BINS) mal - -mal: $(word $(words $(BINS)),$(BINS)) - cp $< $@ - -$(BINS): %: %.hs $(OTHER_SRCS) - ghc --make $< -o $@ - -clean: - rm -f $(BINS) mal *.hi *.o - -.PHONY: stats stats-lisp tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/haskell/Printer.hs b/haskell/Printer.hs deleted file mode 100644 index e24695fdb2..0000000000 --- a/haskell/Printer.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Printer -( _pr_str, _pr_list ) -where - -import qualified Data.Map as Map -import Data.IORef (readIORef) -import System.IO.Unsafe (unsafePerformIO) - -import Types - ---concat (map (++ delim) list) ---join [] delim = [] ---join (x:xs) delim = x ++ delim ++ join xs delim - - -_pr_list :: Bool -> String -> [MalVal] -> String -_pr_list pr sep [] = [] -_pr_list pr sep (x:[]) = (_pr_str pr x) -_pr_list pr sep (x:xs) = (_pr_str pr x) ++ sep ++ (_pr_list pr sep xs) - -_flatTuples ((a,b):xs) = MalString a : b : _flatTuples xs -_flatTuples _ = [] - -unescape chr = case chr of - '\n' -> "\\n" - '\\' -> "\\\\" - '"' -> "\\\"" - c -> [c] - -_pr_str :: Bool -> MalVal -> String -_pr_str _ (MalString ('\x029e':str)) = ":" ++ str -_pr_str True (MalString str) = "\"" ++ concatMap unescape str ++ "\"" -_pr_str False (MalString str) = str -_pr_str _ (MalSymbol name) = name -_pr_str _ (MalNumber num) = show num -_pr_str _ (MalTrue) = "true" -_pr_str _ (MalFalse) = "false" -_pr_str _ (Nil) = "nil" -_pr_str pr (MalList items _) = "(" ++ (_pr_list pr " " items) ++ ")" -_pr_str pr (MalVector items _) = "[" ++ (_pr_list pr " " items) ++ "]" -_pr_str pr (MalHashMap m _) = "{" ++ (_pr_list pr " " (_flatTuples $ Map.assocs m)) ++ "}" -_pr_str pr (MalAtom r _) = "(atom " ++ (_pr_str pr (unsafePerformIO (readIORef r))) ++ ")" -_pr_str _ (Func f _) = "#" -_pr_str _ (MalFunc {ast=ast, env=fn_env, params=params}) = "(fn* " ++ (show params) ++ " " ++ (show ast) ++ ")" - -instance Show MalVal where show = _pr_str True - diff --git a/haskell/Reader.hs b/haskell/Reader.hs deleted file mode 100644 index 91ce63dcb3..0000000000 --- a/haskell/Reader.hs +++ /dev/null @@ -1,155 +0,0 @@ -module Reader -( read_str ) -where - -import Text.ParserCombinators.Parsec ( - Parser, parse, space, char, digit, letter, try, - (<|>), oneOf, noneOf, many, many1, skipMany, skipMany1, sepEndBy) -import qualified Data.Map as Map -import Control.Monad (liftM) - -import Types - -spaces :: Parser () -spaces = skipMany1 (oneOf ", \n") - -comment :: Parser () -comment = do - char ';' - skipMany (noneOf "\r\n") - -ignored :: Parser () -ignored = skipMany (spaces <|> comment) - -symbol :: Parser Char -symbol = oneOf "!#$%&|*+-/:<=>?@^_~" - -escaped :: Parser Char -escaped = do - char '\\' - x <- oneOf "\\\"n" - case x of - 'n' -> return '\n' - _ -> return x - -read_number :: Parser MalVal -read_number = liftM (MalNumber . read) $ many1 digit - -read_string :: Parser MalVal -read_string = do - char '"' - x <- many (escaped <|> noneOf "\\\"") - char '"' - return $ MalString x - -read_symbol :: Parser MalVal -read_symbol = do - first <- letter <|> symbol - rest <- many (letter <|> digit <|> symbol) - let str = first:rest - return $ case str of - "true" -> MalTrue - "false" -> MalFalse - "nil" -> Nil - _ -> MalSymbol str - -read_keyword :: Parser MalVal -read_keyword = do - char ':' - x <- many (letter <|> digit <|> symbol) - return $ MalString $ "\x029e" ++ x - -read_atom :: Parser MalVal -read_atom = read_number - <|> read_string - <|> read_keyword - <|> read_symbol - -read_list :: Parser MalVal -read_list = do - char '(' - x <- sepEndBy read_form ignored - char ')' - return $ MalList x Nil - -read_vector :: Parser MalVal -read_vector = do - char '[' - x <- sepEndBy read_form ignored - char ']' - return $ MalVector x Nil - --- TODO: propagate error properly -_pairs [x] = error "Odd number of elements to _pairs" -_pairs [] = [] -_pairs (MalString x:y:xs) = (x,y):_pairs xs - -read_hash_map :: Parser MalVal -read_hash_map = do - char '{' - x <- sepEndBy read_form ignored - char '}' - return $ MalHashMap (Map.fromList $ _pairs x) Nil - --- reader macros -read_quote :: Parser MalVal -read_quote = do - char '\'' - x <- read_form - return $ MalList [MalSymbol "quote", x] Nil - -read_quasiquote :: Parser MalVal -read_quasiquote = do - char '`' - x <- read_form - return $ MalList [MalSymbol "quasiquote", x] Nil - -read_splice_unquote :: Parser MalVal -read_splice_unquote = do - char '~' - char '@' - x <- read_form - return $ MalList [MalSymbol "splice-unquote", x] Nil - -read_unquote :: Parser MalVal -read_unquote = do - char '~' - x <- read_form - return $ MalList [MalSymbol "unquote", x] Nil - -read_deref :: Parser MalVal -read_deref = do - char '@' - x <- read_form - return $ MalList [MalSymbol "deref", x] Nil - -read_with_meta :: Parser MalVal -read_with_meta = do - char '^' - m <- read_form - x <- read_form - return $ MalList [MalSymbol "with-meta", x, m] Nil - -read_macro :: Parser MalVal -read_macro = read_quote - <|> read_quasiquote - <|> try read_splice_unquote <|> read_unquote - <|> read_deref - <|> read_with_meta - --- - -read_form :: Parser MalVal -read_form = do - ignored - x <- read_macro - <|> read_list - <|> read_vector - <|> read_hash_map - <|> read_atom - return $ x - -read_str :: String -> IOThrows MalVal -read_str str = case parse read_form "Mal" str of - Left err -> throwStr $ show err - Right val -> return val diff --git a/haskell/Readline.hs b/haskell/Readline.hs deleted file mode 100644 index bbde009af6..0000000000 --- a/haskell/Readline.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Readline -( readline, load_history ) -where - --- Pick one of these: --- GPL license -import qualified System.Console.Readline as RL --- BSD license ---import qualified System.Console.Editline.Readline as RL - -import System.Directory (getHomeDirectory) - -import System.IO (hGetLine, hFlush, hIsEOF, stdin, stdout) - -history_file = do - home <- getHomeDirectory - return $ home ++ "/.mal-history" - -load_history = do - hfile <- history_file - content <- readFile hfile - mapM RL.addHistory (lines content) - -readline prompt = do - hfile <- history_file - maybeLine <- RL.readline prompt - case maybeLine of - Just line -> do - appendFile hfile (line ++ "\n") - RL.addHistory line - return maybeLine - _ -> return maybeLine diff --git a/haskell/Types.hs b/haskell/Types.hs deleted file mode 100644 index 5a7fff77b6..0000000000 --- a/haskell/Types.hs +++ /dev/null @@ -1,136 +0,0 @@ -module Types -(MalVal (..), MalError (..), IOThrows (..), Fn (..), EnvData (..), Env, - throwStr, throwMalVal, _get_call, _to_list, - _func, _malfunc, - _nil_Q, _true_Q, _false_Q, _symbol_Q, _keyword_Q, - _list_Q, _vector_Q, _hash_map_Q, _atom_Q) -where - -import Data.IORef (IORef) -import qualified Data.Map as Map -import Control.Exception as CE -import Control.Monad.Error (ErrorT, Error, noMsg, strMsg, throwError) - - --- Base Mal types -- -newtype Fn = Fn ([MalVal] -> IOThrows MalVal) -data MalVal = Nil - | MalFalse - | MalTrue - | MalNumber Int - | MalString String - | MalSymbol String - | MalList [MalVal] MalVal - | MalVector [MalVal] MalVal - | MalHashMap (Map.Map String MalVal) MalVal - | MalAtom (IORef MalVal) MalVal - | Func Fn MalVal - | MalFunc {fn :: Fn, - ast :: MalVal, - env :: Env, - params :: MalVal, - macro :: Bool, - meta :: MalVal} - -_equal_Q Nil Nil = True -_equal_Q MalFalse MalFalse = True -_equal_Q MalTrue MalTrue = True -_equal_Q (MalNumber a) (MalNumber b) = a == b -_equal_Q (MalString a) (MalString b) = a == b -_equal_Q (MalSymbol a) (MalSymbol b) = a == b -_equal_Q (MalList a _) (MalList b _) = a == b -_equal_Q (MalList a _) (MalVector b _) = a == b -_equal_Q (MalVector a _) (MalList b _) = a == b -_equal_Q (MalHashMap a _) (MalHashMap b _) = a == b -_equal_Q (MalAtom a _) (MalAtom b _) = a == b -_equal_Q _ _ = False - -instance Eq MalVal where - x == y = _equal_Q x y - - ---- Errors/Exceptions --- - -data MalError = StringError String - | MalValError MalVal - -type IOThrows = ErrorT MalError IO - -instance Error MalError where - noMsg = StringError "An error has occurred" - strMsg = StringError - -throwStr str = throwError $ StringError str -throwMalVal mv = throwError $ MalValError mv - --- Env types -- --- Note: Env functions are in Env module -data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal)) -type Env = IORef EnvData - - - ----------------------------------------------------------- - --- General functions -- - -_get_call ((Func (Fn f) _) : _) = return f -_get_call (MalFunc {fn=(Fn f)} : _) = return f -_get_call _ = throwStr "_get_call first parameter is not a function " - -_to_list (MalList lst _) = return lst -_to_list (MalVector lst _) = return lst -_to_list _ = throwStr "_to_list expected a MalList or MalVector" - --- Errors - ---catchAny :: IO a -> (CE.SomeException -> IO a) -> IO a ---catchAny = CE.catch - --- Functions - -_func fn = Func (Fn fn) Nil -_func_meta fn meta = Func (Fn fn) meta - -_malfunc ast env params fn = MalFunc {fn=(Fn fn), ast=ast, - env=env, params=params, - macro=False, meta=Nil} -_malfunc_meta ast env params fn meta = MalFunc {fn=(Fn fn), ast=ast, - env=env, params=params, - macro=False, meta=meta} - --- Scalars -_nil_Q Nil = MalTrue -_nil_Q _ = MalFalse - -_true_Q MalTrue = MalTrue -_true_Q _ = MalFalse - -_false_Q MalFalse = MalTrue -_false_Q _ = MalFalse - -_symbol_Q (MalSymbol _) = MalTrue -_symbol_Q _ = MalFalse - -_keyword_Q (MalString ('\x029e':_)) = MalTrue -_keyword_Q _ = MalFalse - --- Lists - -_list_Q (MalList _ _) = MalTrue -_list_Q _ = MalFalse - --- Vectors - -_vector_Q (MalVector _ _) = MalTrue -_vector_Q _ = MalFalse - --- Hash Maps - -_hash_map_Q (MalHashMap _ _) = MalTrue -_hash_map_Q _ = MalFalse - --- Atoms - -_atom_Q (MalAtom _ _) = MalTrue -_atom_Q _ = MalFalse diff --git a/haskell/step0_repl.hs b/haskell/step0_repl.hs deleted file mode 100644 index 639640057b..0000000000 --- a/haskell/step0_repl.hs +++ /dev/null @@ -1,28 +0,0 @@ -import System.IO (hFlush, stdout) - -import Readline (readline, load_history) - --- read -mal_read str = str - --- eval -eval ast env = ast - --- print -mal_print exp = exp - --- repl -rep line = mal_print $ eval (mal_read line) "" - -repl_loop = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop - Just str -> do - putStrLn $ rep str - repl_loop - -main = do - load_history - repl_loop diff --git a/haskell/step1_read_print.hs b/haskell/step1_read_print.hs deleted file mode 100644 index c7a4eef5ce..0000000000 --- a/haskell/step1_read_print.hs +++ /dev/null @@ -1,45 +0,0 @@ -import System.IO (hFlush, stdout) -import Control.Monad.Error (runErrorT) - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -eval :: MalVal -> String -> MalVal -eval ast env = ast - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl -rep :: String -> IOThrows String -rep line = do - ast <- mal_read line - return $ mal_print (eval ast "") - -repl_loop :: IO () -repl_loop = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop - Just str -> do - res <- runErrorT $ rep str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop - -main = do - load_history - repl_loop diff --git a/haskell/step2_eval.hs b/haskell/step2_eval.hs deleted file mode 100644 index 9105737065..0000000000 --- a/haskell/step2_eval.hs +++ /dev/null @@ -1,93 +0,0 @@ -import System.IO (hFlush, stdout) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -eval_ast :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal -eval_ast (MalSymbol sym) env = do - case Map.lookup sym env of - Nothing -> throwStr $ "'" ++ sym ++ "' not found" - Just v -> return v -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -apply_ast :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal -apply_ast ast@(MalList _ _) env = do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - el -> - throwStr $ "invalid apply: " ++ (show el) - -eval :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl -add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b -add _ = throwStr $ "illegal arguments to +" -sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b -sub _ = throwStr $ "illegal arguments to -" -mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b -mult _ = throwStr $ "illegal arguments to *" -divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b -divd _ = throwStr $ "illegal arguments to /" - -repl_env :: Map.Map String MalVal -repl_env = Map.fromList [("+", _func add), - ("-", _func sub), - ("*", _func mult), - ("/", _func divd)] - -rep :: String -> IOThrows String -rep line = do - ast <- mal_read line - exp <- eval ast repl_env - return $ mal_print exp - -repl_loop :: IO () -repl_loop = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop - Just str -> do - res <- runErrorT $ rep str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop - -main = do - load_history - repl_loop diff --git a/haskell/step3_env.hs b/haskell/step3_env.hs deleted file mode 100644 index 3bd3b1935d..0000000000 --- a/haskell/step3_env.hs +++ /dev/null @@ -1,113 +0,0 @@ -import System.IO (hFlush, stdout) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_get, env_set) - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList _ _) env = do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - el -> - throwStr $ "invalid apply: " ++ (show el) - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl -add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b -add _ = throwStr $ "illegal arguments to +" -sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b -sub _ = throwStr $ "illegal arguments to -" -mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b -mult _ = throwStr $ "illegal arguments to *" -divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b -divd _ = throwStr $ "illegal arguments to /" - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - load_history - - repl_env <- env_new Nothing - env_set repl_env (MalSymbol "+") $ _func add - env_set repl_env (MalSymbol "-") $ _func sub - env_set repl_env (MalSymbol "*") $ _func mult - env_set repl_env (MalSymbol "/") $ _func divd - repl_loop repl_env diff --git a/haskell/step4_if_fn_do.hs b/haskell/step4_if_fn_do.hs deleted file mode 100644 index 497ece2cf8..0000000000 --- a/haskell/step4_if_fn_do.hs +++ /dev/null @@ -1,140 +0,0 @@ -import System.IO (hFlush, stdout) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_bind, env_get, env_set) -import Core as Core - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList (MalSymbol "do" : args) _) env = do - case args of - ([]) -> return Nil - _ -> do - el <- eval_ast (MalList args Nil) env - case el of - (MalList lst _) -> return $ last lst - -apply_ast ast@(MalList (MalSymbol "if" : args) _) env = do - case args of - (a1 : a2 : a3 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then eval a3 env - else eval a2 env - (a1 : a2 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then return Nil - else eval a2 env - _ -> throwStr "invalid if" -apply_ast ast@(MalList (MalSymbol "fn*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - return $ (_func - (\args -> do - fn_env1 <- liftIO $ env_new $ Just env - fn_env2 <- liftIO $ env_bind fn_env1 params args - eval a2 fn_env2)) - _ -> throwStr "invalid fn*" -apply_ast ast@(MalList _ _) env = do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - el -> - throwStr $ "invalid apply: " ++ (show el) - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - load_history - - repl_env <- env_new Nothing - - -- core.hs: defined using Haskell - (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns) - - -- core.mal: defined using the language itself - runErrorT $ rep repl_env "(def! not (fn* (a) (if a false true)))" - - repl_loop repl_env diff --git a/haskell/step5_tco.hs b/haskell/step5_tco.hs deleted file mode 100644 index f32875af3d..0000000000 --- a/haskell/step5_tco.hs +++ /dev/null @@ -1,144 +0,0 @@ -import System.IO (hFlush, stdout) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_bind, env_get, env_set) -import Core as Core - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList (MalSymbol "do" : args) _) env = do - case args of - ([]) -> return Nil - _ -> do - el <- eval_ast (MalList args Nil) env - case el of - (MalList lst _) -> return $ last lst - -apply_ast ast@(MalList (MalSymbol "if" : args) _) env = do - case args of - (a1 : a2 : a3 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then eval a3 env - else eval a2 env - (a1 : a2 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then return Nil - else eval a2 env - _ -> throwStr "invalid if" -apply_ast ast@(MalList (MalSymbol "fn*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - return $ (_malfunc a2 env (MalList params Nil) - (\args -> do - fn_env1 <- liftIO $ env_new $ Just env - fn_env2 <- liftIO $ env_bind fn_env1 params args - eval a2 fn_env2)) - _ -> throwStr "invalid fn*" -apply_ast ast@(MalList _ _) env = do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - (MalList ((MalFunc {ast=ast, env=fn_env, params=(MalList params Nil)}) : rest) _) -> do - fn_env1 <- liftIO $ env_new $ Just fn_env - fn_env2 <- liftIO $ env_bind fn_env1 params rest - eval ast fn_env2 - el -> - throwStr $ "invalid apply: " ++ (show el) - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - load_history - - repl_env <- env_new Nothing - - -- core.hs: defined using Haskell - (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns) - - -- core.mal: defined using the language itself - runErrorT $ rep repl_env "(def! not (fn* (a) (if a false true)))" - - repl_loop repl_env diff --git a/haskell/step6_file.hs b/haskell/step6_file.hs deleted file mode 100644 index ba58f2ff4b..0000000000 --- a/haskell/step6_file.hs +++ /dev/null @@ -1,154 +0,0 @@ -import System.IO (hFlush, stdout) -import System.Environment (getArgs) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_bind, env_get, env_set) -import Core as Core - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList (MalSymbol "do" : args) _) env = do - case args of - ([]) -> return Nil - _ -> do - el <- eval_ast (MalList args Nil) env - case el of - (MalList lst _) -> return $ last lst - -apply_ast ast@(MalList (MalSymbol "if" : args) _) env = do - case args of - (a1 : a2 : a3 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then eval a3 env - else eval a2 env - (a1 : a2 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then return Nil - else eval a2 env - _ -> throwStr "invalid if" -apply_ast ast@(MalList (MalSymbol "fn*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - return $ (_malfunc a2 env (MalList params Nil) - (\args -> do - fn_env1 <- liftIO $ env_new $ Just env - fn_env2 <- liftIO $ env_bind fn_env1 params args - eval a2 fn_env2)) - _ -> throwStr "invalid fn*" -apply_ast ast@(MalList _ _) env = do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - (MalList ((MalFunc {ast=ast, env=fn_env, params=(MalList params Nil)}) : rest) _) -> do - fn_env1 <- liftIO $ env_new $ Just fn_env - fn_env2 <- liftIO $ env_bind fn_env1 params rest - eval ast fn_env2 - el -> - throwStr $ "invalid apply: " ++ (show el) - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - args <- getArgs - load_history - - repl_env <- env_new Nothing - - -- core.hs: defined using Haskell - (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns) - env_set repl_env (MalSymbol "eval") (_func (\[ast] -> eval ast repl_env)) - env_set repl_env (MalSymbol "*ARGV*") (MalList [] Nil) - - -- core.mal: defined using the language itself - runErrorT $ rep repl_env "(def! not (fn* (a) (if a false true)))" - runErrorT $ rep repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - - if length args > 0 then do - env_set repl_env (MalSymbol "*ARGV*") (MalList (map MalString (drop 1 args)) Nil) - runErrorT $ rep repl_env $ "(load-file \"" ++ (args !! 0) ++ "\")" - return () - else - repl_loop repl_env diff --git a/haskell/step7_quote.hs b/haskell/step7_quote.hs deleted file mode 100644 index c6bb0e0f67..0000000000 --- a/haskell/step7_quote.hs +++ /dev/null @@ -1,183 +0,0 @@ -import System.IO (hFlush, stdout) -import System.Environment (getArgs) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_bind, env_get, env_set) -import Core as Core - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -is_pair (MalList x _:xs) = True -is_pair (MalVector x _:xs) = True -is_pair _ = False - -quasiquote :: MalVal -> MalVal -quasiquote ast = - case ast of - (MalList (MalSymbol "unquote" : a1 : []) _) -> a1 - (MalList (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalList rest Nil)] Nil - (MalVector (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalVector rest Nil)] Nil - (MalList (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalList rest Nil)] Nil - (MalVector (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalVector rest Nil)] Nil - _ -> MalList [(MalSymbol "quote"), ast] Nil - - -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList (MalSymbol "quote" : args) _) env = do - case args of - a1 : [] -> return a1 - _ -> throwStr "invalid quote" -apply_ast ast@(MalList (MalSymbol "quasiquote" : args) _) env = do - case args of - a1 : [] -> eval (quasiquote a1) env - _ -> throwStr "invalid quasiquote" -apply_ast ast@(MalList (MalSymbol "do" : args) _) env = do - case args of - ([]) -> return Nil - _ -> do - el <- eval_ast (MalList args Nil) env - case el of - (MalList lst _) -> return $ last lst - -apply_ast ast@(MalList (MalSymbol "if" : args) _) env = do - case args of - (a1 : a2 : a3 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then eval a3 env - else eval a2 env - (a1 : a2 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then return Nil - else eval a2 env - _ -> throwStr "invalid if" -apply_ast ast@(MalList (MalSymbol "fn*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - return $ (_malfunc a2 env (MalList params Nil) - (\args -> do - fn_env1 <- liftIO $ env_new $ Just env - fn_env2 <- liftIO $ env_bind fn_env1 params args - eval a2 fn_env2)) - _ -> throwStr "invalid fn*" -apply_ast ast@(MalList _ _) env = do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - (MalList ((MalFunc {ast=ast, env=fn_env, params=(MalList params Nil)}) : rest) _) -> do - fn_env1 <- liftIO $ env_new $ Just fn_env - fn_env2 <- liftIO $ env_bind fn_env1 params rest - eval ast fn_env2 - el -> - throwStr $ "invalid apply: " ++ (show el) - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - args <- getArgs - load_history - - repl_env <- env_new Nothing - - -- core.hs: defined using Haskell - (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns) - env_set repl_env (MalSymbol "eval") (_func (\[ast] -> eval ast repl_env)) - env_set repl_env (MalSymbol "*ARGV*") (MalList [] Nil) - - -- core.mal: defined using the language itself - runErrorT $ rep repl_env "(def! not (fn* (a) (if a false true)))" - runErrorT $ rep repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - - if length args > 0 then do - env_set repl_env (MalSymbol "*ARGV*") (MalList (map MalString (drop 1 args)) Nil) - runErrorT $ rep repl_env $ "(load-file \"" ++ (args !! 0) ++ "\")" - return () - else - repl_loop repl_env diff --git a/haskell/step8_macros.hs b/haskell/step8_macros.hs deleted file mode 100644 index 9b272e8cd1..0000000000 --- a/haskell/step8_macros.hs +++ /dev/null @@ -1,238 +0,0 @@ -import System.IO (hFlush, stdout) -import System.Environment (getArgs) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_bind, env_find, env_get, env_set) -import Core as Core - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -is_pair (MalList x _:xs) = True -is_pair (MalVector x _:xs) = True -is_pair _ = False - -quasiquote :: MalVal -> MalVal -quasiquote ast = - case ast of - (MalList (MalSymbol "unquote" : a1 : []) _) -> a1 - (MalList (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalList rest Nil)] Nil - (MalVector (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalVector rest Nil)] Nil - (MalList (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalList rest Nil)] Nil - (MalVector (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalVector rest Nil)] Nil - _ -> MalList [(MalSymbol "quote"), ast] Nil - -is_macro_call :: MalVal -> Env -> IOThrows Bool -is_macro_call (MalList (a0@(MalSymbol _) : rest) _) env = do - e <- liftIO $ env_find env a0 - case e of - Just e -> do - f <- env_get e a0 - case f of - MalFunc {macro=True} -> return True - _ -> return False - Nothing -> return False -is_macro_call _ _ = return False - -macroexpand :: MalVal -> Env -> IOThrows MalVal -macroexpand ast@(MalList (a0 : args) _) env = do - mc <- is_macro_call ast env - if mc then do - mac <- env_get env a0 - case mac of - MalFunc {fn=(Fn f)} -> do - new_ast <- f args - macroexpand new_ast env - _ -> - return ast - else - return ast -macroexpand ast _ = return ast - -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList (MalSymbol "quote" : args) _) env = do - case args of - a1 : [] -> return a1 - _ -> throwStr "invalid quote" -apply_ast ast@(MalList (MalSymbol "quasiquote" : args) _) env = do - case args of - a1 : [] -> eval (quasiquote a1) env - _ -> throwStr "invalid quasiquote" - -apply_ast ast@(MalList (MalSymbol "defmacro!" : args) _) env = do - case args of - (a1 : a2 : []) -> do - func <- eval a2 env - case func of - MalFunc {fn=f, ast=a, env=e, params=p} -> do - let new_func = MalFunc {fn=f, ast=a, env=e, - params=p, macro=True, - meta=Nil} in - liftIO $ env_set env a1 new_func - _ -> throwStr "defmacro! on non-function" - _ -> throwStr "invalid defmacro!" -apply_ast ast@(MalList (MalSymbol "macroexpand" : args) _) env = do - case args of - (a1 : []) -> macroexpand a1 env - _ -> throwStr "invalid macroexpand" -apply_ast ast@(MalList (MalSymbol "do" : args) _) env = do - case args of - ([]) -> return Nil - _ -> do - el <- eval_ast (MalList args Nil) env - case el of - (MalList lst _) -> return $ last lst - -apply_ast ast@(MalList (MalSymbol "if" : args) _) env = do - case args of - (a1 : a2 : a3 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then eval a3 env - else eval a2 env - (a1 : a2 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then return Nil - else eval a2 env - _ -> throwStr "invalid if" -apply_ast ast@(MalList (MalSymbol "fn*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - return $ (_malfunc a2 env (MalList params Nil) - (\args -> do - fn_env1 <- liftIO $ env_new $ Just env - fn_env2 <- liftIO $ env_bind fn_env1 params args - eval a2 fn_env2)) - _ -> throwStr "invalid fn*" -apply_ast ast@(MalList _ _) env = do - mc <- is_macro_call ast env - if mc then do - new_ast <- macroexpand ast env - eval new_ast env - else - case ast of - MalList _ _ -> do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - (MalList ((MalFunc {ast=ast, - env=fn_env, - params=(MalList params Nil)} : rest)) _) -> do - fn_env1 <- liftIO $ env_new $ Just fn_env - fn_env2 <- liftIO $ env_bind fn_env1 params rest - eval ast fn_env2 - el -> - throwStr $ "invalid apply: " ++ (show el) - _ -> return ast - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - args <- getArgs - load_history - - repl_env <- env_new Nothing - - -- core.hs: defined using Haskell - (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns) - env_set repl_env (MalSymbol "eval") (_func (\[ast] -> eval ast repl_env)) - env_set repl_env (MalSymbol "*ARGV*") (MalList [] Nil) - - -- core.mal: defined using the language itself - runErrorT $ rep repl_env "(def! not (fn* (a) (if a false true)))" - runErrorT $ rep repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - runErrorT $ rep repl_env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" - runErrorT $ rep repl_env "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - - if length args > 0 then do - env_set repl_env (MalSymbol "*ARGV*") (MalList (map MalString (drop 1 args)) Nil) - runErrorT $ rep repl_env $ "(load-file \"" ++ (args !! 0) ++ "\")" - return () - else - repl_loop repl_env diff --git a/haskell/step9_try.hs b/haskell/step9_try.hs deleted file mode 100644 index f944d178df..0000000000 --- a/haskell/step9_try.hs +++ /dev/null @@ -1,253 +0,0 @@ -import System.IO (hFlush, stdout) -import System.Environment (getArgs) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_bind, env_find, env_get, env_set) -import Core as Core - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -is_pair (MalList x _:xs) = True -is_pair (MalVector x _:xs) = True -is_pair _ = False - -quasiquote :: MalVal -> MalVal -quasiquote ast = - case ast of - (MalList (MalSymbol "unquote" : a1 : []) _) -> a1 - (MalList (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalList rest Nil)] Nil - (MalVector (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalVector rest Nil)] Nil - (MalList (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalList rest Nil)] Nil - (MalVector (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalVector rest Nil)] Nil - _ -> MalList [(MalSymbol "quote"), ast] Nil - -is_macro_call :: MalVal -> Env -> IOThrows Bool -is_macro_call (MalList (a0@(MalSymbol _) : rest) _) env = do - e <- liftIO $ env_find env a0 - case e of - Just e -> do - f <- env_get e a0 - case f of - MalFunc {macro=True} -> return True - _ -> return False - Nothing -> return False -is_macro_call _ _ = return False - -macroexpand :: MalVal -> Env -> IOThrows MalVal -macroexpand ast@(MalList (a0 : args) _) env = do - mc <- is_macro_call ast env - if mc then do - mac <- env_get env a0 - case mac of - MalFunc {fn=(Fn f)} -> do - new_ast <- f args - macroexpand new_ast env - _ -> - return ast - else - return ast -macroexpand ast _ = return ast - -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList (MalSymbol "quote" : args) _) env = do - case args of - a1 : [] -> return a1 - _ -> throwStr "invalid quote" -apply_ast ast@(MalList (MalSymbol "quasiquote" : args) _) env = do - case args of - a1 : [] -> eval (quasiquote a1) env - _ -> throwStr "invalid quasiquote" - -apply_ast ast@(MalList (MalSymbol "defmacro!" : args) _) env = do - case args of - (a1 : a2 : []) -> do - func <- eval a2 env - case func of - MalFunc {fn=f, ast=a, env=e, params=p} -> do - let new_func = MalFunc {fn=f, ast=a, env=e, - params=p, macro=True, - meta=Nil} in - liftIO $ env_set env a1 new_func - _ -> throwStr "defmacro! on non-function" - _ -> throwStr "invalid defmacro!" -apply_ast ast@(MalList (MalSymbol "macroexpand" : args) _) env = do - case args of - (a1 : []) -> macroexpand a1 env - _ -> throwStr "invalid macroexpand" -apply_ast ast@(MalList (MalSymbol "try*" : args) _) env = do - case args of - (a1 : []) -> eval a1 env - (a1 : (MalList ((MalSymbol "catch*") : a21 : a22 : []) _) : []) -> do - res <- liftIO $ runErrorT $ eval a1 env - case res of - Right val -> return val - Left err -> do - exc <- case err of - (StringError str) -> return $ MalString str - (MalValError mv) -> return $ mv - try_env <- liftIO $ env_new $ Just env - liftIO $ env_set try_env a21 exc - eval a22 try_env - _ -> throwStr "invalid try*" -apply_ast ast@(MalList (MalSymbol "do" : args) _) env = do - case args of - ([]) -> return Nil - _ -> do - el <- eval_ast (MalList args Nil) env - case el of - (MalList lst _) -> return $ last lst - -apply_ast ast@(MalList (MalSymbol "if" : args) _) env = do - case args of - (a1 : a2 : a3 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then eval a3 env - else eval a2 env - (a1 : a2 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then return Nil - else eval a2 env - _ -> throwStr "invalid if" -apply_ast ast@(MalList (MalSymbol "fn*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - return $ (_malfunc a2 env (MalList params Nil) - (\args -> do - fn_env1 <- liftIO $ env_new $ Just env - fn_env2 <- liftIO $ env_bind fn_env1 params args - eval a2 fn_env2)) - _ -> throwStr "invalid fn*" -apply_ast ast@(MalList _ _) env = do - mc <- is_macro_call ast env - if mc then do - new_ast <- macroexpand ast env - eval new_ast env - else - case ast of - MalList _ _ -> do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - (MalList ((MalFunc {ast=ast, - env=fn_env, - params=(MalList params Nil)} : rest)) _) -> do - fn_env1 <- liftIO $ env_new $ Just fn_env - fn_env2 <- liftIO $ env_bind fn_env1 params rest - eval ast fn_env2 - el -> - throwStr $ "invalid apply: " ++ (show el) - _ -> return ast - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - args <- getArgs - load_history - - repl_env <- env_new Nothing - - -- core.hs: defined using Haskell - (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns) - env_set repl_env (MalSymbol "eval") (_func (\[ast] -> eval ast repl_env)) - env_set repl_env (MalSymbol "*ARGV*") (MalList [] Nil) - - -- core.mal: defined using the language itself - runErrorT $ rep repl_env "(def! not (fn* (a) (if a false true)))" - runErrorT $ rep repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - runErrorT $ rep repl_env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" - runErrorT $ rep repl_env "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - - if length args > 0 then do - env_set repl_env (MalSymbol "*ARGV*") (MalList (map MalString (drop 1 args)) Nil) - runErrorT $ rep repl_env $ "(load-file \"" ++ (args !! 0) ++ "\")" - return () - else - repl_loop repl_env diff --git a/haskell/stepA_mal.hs b/haskell/stepA_mal.hs deleted file mode 100644 index f1d4b38348..0000000000 --- a/haskell/stepA_mal.hs +++ /dev/null @@ -1,255 +0,0 @@ -import System.IO (hFlush, stdout) -import System.Environment (getArgs) -import Control.Monad (mapM) -import Control.Monad.Error (runErrorT) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as Map -import qualified Data.Traversable as DT - -import Readline (readline, load_history) -import Types -import Reader (read_str) -import Printer (_pr_str) -import Env (Env, env_new, env_bind, env_find, env_get, env_set) -import Core as Core - --- read -mal_read :: String -> IOThrows MalVal -mal_read str = read_str str - --- eval -is_pair (MalList x _:xs) = True -is_pair (MalVector x _:xs) = True -is_pair _ = False - -quasiquote :: MalVal -> MalVal -quasiquote ast = - case ast of - (MalList (MalSymbol "unquote" : a1 : []) _) -> a1 - (MalList (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalList rest Nil)] Nil - (MalVector (MalList (MalSymbol "splice-unquote" : a01 : []) _ : rest) _) -> - MalList [(MalSymbol "concat"), a01, quasiquote (MalVector rest Nil)] Nil - (MalList (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalList rest Nil)] Nil - (MalVector (a0 : rest) _) -> MalList [(MalSymbol "cons"), - quasiquote a0, - quasiquote (MalVector rest Nil)] Nil - _ -> MalList [(MalSymbol "quote"), ast] Nil - -is_macro_call :: MalVal -> Env -> IOThrows Bool -is_macro_call (MalList (a0@(MalSymbol _) : rest) _) env = do - e <- liftIO $ env_find env a0 - case e of - Just e -> do - f <- env_get e a0 - case f of - MalFunc {macro=True} -> return True - _ -> return False - Nothing -> return False -is_macro_call _ _ = return False - -macroexpand :: MalVal -> Env -> IOThrows MalVal -macroexpand ast@(MalList (a0 : args) _) env = do - mc <- is_macro_call ast env - if mc then do - mac <- env_get env a0 - case mac of - MalFunc {fn=(Fn f)} -> do - new_ast <- f args - macroexpand new_ast env - _ -> - return ast - else - return ast -macroexpand ast _ = return ast - -eval_ast :: MalVal -> Env -> IOThrows MalVal -eval_ast sym@(MalSymbol _) env = env_get env sym -eval_ast ast@(MalList lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalList new_lst m -eval_ast ast@(MalVector lst m) env = do - new_lst <- mapM (\x -> (eval x env)) lst - return $ MalVector new_lst m -eval_ast ast@(MalHashMap lst m) env = do - new_hm <- DT.mapM (\x -> (eval x env)) lst - return $ MalHashMap new_hm m -eval_ast ast env = return ast - -let_bind :: Env -> [MalVal] -> IOThrows Env -let_bind env [] = return env -let_bind env (b:e:xs) = do - evaled <- eval e env - x <- liftIO $ env_set env b evaled - let_bind env xs - -apply_ast :: MalVal -> Env -> IOThrows MalVal -apply_ast ast@(MalList (MalSymbol "def!" : args) _) env = do - case args of - (a1@(MalSymbol _): a2 : []) -> do - evaled <- eval a2 env - liftIO $ env_set env a1 evaled - _ -> throwStr "invalid def!" -apply_ast ast@(MalList (MalSymbol "let*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - let_env <- liftIO $ env_new $ Just env - let_bind let_env params - eval a2 let_env - _ -> throwStr "invalid let*" -apply_ast ast@(MalList (MalSymbol "quote" : args) _) env = do - case args of - a1 : [] -> return a1 - _ -> throwStr "invalid quote" -apply_ast ast@(MalList (MalSymbol "quasiquote" : args) _) env = do - case args of - a1 : [] -> eval (quasiquote a1) env - _ -> throwStr "invalid quasiquote" - -apply_ast ast@(MalList (MalSymbol "defmacro!" : args) _) env = do - case args of - (a1 : a2 : []) -> do - func <- eval a2 env - case func of - MalFunc {fn=f, ast=a, env=e, params=p} -> do - let new_func = MalFunc {fn=f, ast=a, env=e, - params=p, macro=True, - meta=Nil} in - liftIO $ env_set env a1 new_func - _ -> throwStr "defmacro! on non-function" - _ -> throwStr "invalid defmacro!" -apply_ast ast@(MalList (MalSymbol "macroexpand" : args) _) env = do - case args of - (a1 : []) -> macroexpand a1 env - _ -> throwStr "invalid macroexpand" -apply_ast ast@(MalList (MalSymbol "try*" : args) _) env = do - case args of - (a1 : []) -> eval a1 env - (a1 : (MalList ((MalSymbol "catch*") : a21 : a22 : []) _) : []) -> do - res <- liftIO $ runErrorT $ eval a1 env - case res of - Right val -> return val - Left err -> do - exc <- case err of - (StringError str) -> return $ MalString str - (MalValError mv) -> return $ mv - try_env <- liftIO $ env_new $ Just env - liftIO $ env_set try_env a21 exc - eval a22 try_env - _ -> throwStr "invalid try*" -apply_ast ast@(MalList (MalSymbol "do" : args) _) env = do - case args of - ([]) -> return Nil - _ -> do - el <- eval_ast (MalList args Nil) env - case el of - (MalList lst _) -> return $ last lst - -apply_ast ast@(MalList (MalSymbol "if" : args) _) env = do - case args of - (a1 : a2 : a3 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then eval a3 env - else eval a2 env - (a1 : a2 : []) -> do - cond <- eval a1 env - if cond == MalFalse || cond == Nil - then return Nil - else eval a2 env - _ -> throwStr "invalid if" -apply_ast ast@(MalList (MalSymbol "fn*" : args) _) env = do - case args of - (a1 : a2 : []) -> do - params <- (_to_list a1) - return $ (_malfunc a2 env (MalList params Nil) - (\args -> do - fn_env1 <- liftIO $ env_new $ Just env - fn_env2 <- liftIO $ env_bind fn_env1 params args - eval a2 fn_env2)) - _ -> throwStr "invalid fn*" -apply_ast ast@(MalList _ _) env = do - mc <- is_macro_call ast env - if mc then do - new_ast <- macroexpand ast env - eval new_ast env - else - case ast of - MalList _ _ -> do - el <- eval_ast ast env - case el of - (MalList ((Func (Fn f) _) : rest) _) -> - f $ rest - (MalList ((MalFunc {ast=ast, - env=fn_env, - params=(MalList params Nil)} : rest)) _) -> do - fn_env1 <- liftIO $ env_new $ Just fn_env - fn_env2 <- liftIO $ env_bind fn_env1 params rest - eval ast fn_env2 - el -> - throwStr $ "invalid apply: " ++ (show el) - _ -> return ast - -eval :: MalVal -> Env -> IOThrows MalVal -eval ast env = do - case ast of - (MalList _ _) -> apply_ast ast env - _ -> eval_ast ast env - - --- print -mal_print :: MalVal -> String -mal_print exp = show exp - --- repl - -rep :: Env -> String -> IOThrows String -rep env line = do - ast <- mal_read line - exp <- eval ast env - return $ mal_print exp - -repl_loop :: Env -> IO () -repl_loop env = do - line <- readline "user> " - case line of - Nothing -> return () - Just "" -> repl_loop env - Just str -> do - res <- runErrorT $ rep env str - out <- case res of - Left (StringError str) -> return $ "Error: " ++ str - Left (MalValError mv) -> return $ "Error: " ++ (show mv) - Right val -> return val - putStrLn out - hFlush stdout - repl_loop env - -main = do - args <- getArgs - load_history - - repl_env <- env_new Nothing - - -- core.hs: defined using Haskell - (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns) - env_set repl_env (MalSymbol "eval") (_func (\[ast] -> eval ast repl_env)) - env_set repl_env (MalSymbol "*ARGV*") (MalList [] Nil) - - -- core.mal: defined using the language itself - runErrorT $ rep repl_env "(def! *host-language* \"haskell\")" - runErrorT $ rep repl_env "(def! not (fn* (a) (if a false true)))" - runErrorT $ rep repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - runErrorT $ rep repl_env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" - runErrorT $ rep repl_env "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - - if length args > 0 then do - env_set repl_env (MalSymbol "*ARGV*") (MalList (map MalString (drop 1 args)) Nil) - runErrorT $ rep repl_env $ "(load-file \"" ++ (args !! 0) ++ "\")" - return () - else do - runErrorT $ rep repl_env "(println (str \"Mal [\" *host-language* \"]\"))" - repl_loop repl_env diff --git a/impls/.gitignore b/impls/.gitignore new file mode 100644 index 0000000000..292498c104 --- /dev/null +++ b/impls/.gitignore @@ -0,0 +1,149 @@ +.DS_Store +.bash_history +.cache +.cargo +.config +.mal-history +.crystal +.lein +.m2 +.ivy2 +.sbt +.npm +.node-gyp +.elm +*/experiments +*/node_modules +*.o +*.pyc +*/step0_repl +*/step1_read_print +*/step2_eval +*/step3_env +*/step4_if_fn_do +*/step5_tco +*/step6_file +*/step7_quote +*/step8_macros +*/step9_try +*/stepA_mal +*/mal +*/notes + +logs +old + +ada/obj/ +awk/mal.awk +bash/mal.sh +clojure/mal.jar +clojure/target +clojure/.lein-repl-history +coffee/mal.coffee +cs/*.exe +cs/*.dll +cs/*.mdb +d/*.o +elixir/_build +elixir/deps +elixir/erl_crash.dump +elixir/*.ez +erlang/ebin +erlang/.rebar +erlang/src/*.beam +es6/mal.js +es6/.esm-cache +factor/mal.factor +fantom/lib +forth/mal.fs +fsharp/*.exe +fsharp/*.dll +fsharp/*.mdb +go/step* +groovy/*.class +groovy/mal.jar +haskell/*.hi +haskell/*.o +haxe/*.n +haxe/*.py +haxe/cpp/ +haxe/*.js +java/mal.jar +java/target/ +java/dependency-reduced-pom.xml +.npm/ +.node-gyp/ +js/mal.js +js/web/mal.js +kotlin/*.jar +kotlin/.idea +kotlin/*.iml +lua/lib +lua/linenoise.so +lua/rex_pcre.so +lua/mal.lua +make/mal.mk +mal/mal.mal +matlab/octave-workspace +miniMAL/mal.json +nim/nimcache* +objc/*.d +ocaml/*.cmi +ocaml/*.cmo +ocaml/*.swp +ocaml/*.cmx +ocaml/*.o +ocaml/mal_lib.* +objpascal/*.o +objpascal/*.ppu +objpascal/pas-readline +objpascal/regexpr/Source/RegExpr.ppu +perl/mal.pl +perl6/.precomp/ +php/mal.php +php/mal-web.php +ps/mal.ps +python/mal.pyz +r/mal.r +ruby/mal.rb +.cargo/ +rust/target/ +rust/Cargo.lock +rust/.cargo +r/lib +scala/mal.jar +scala/target +scala/project +skew/*.js +tcl/mal.tcl +vb/*.exe +vb/*.dll +vimscript/mal.vim +clisp/*.fas +clisp/*.lib +basic/step0_repl.bas +basic/step1_read_print.bas +basic/step2_eval.bas +basic/step3_env.bas +basic/step4_if_fn_do.bas +basic/step5_tco.bas +basic/step6_file.bas +basic/step7_quote.bas +basic/step8_macros.bas +basic/step9_try.bas +basic/stepA_mal.bas +basic/*.prg +common-lisp/*.fasl +common-lisp/*.lib +common-lisp/images/* +common-lisp/hist/* +livescript/*.js +!livescript/node_readline.js +livescript/node_modules +elm/node_modules +elm/elm-stuff +elm/*.js +!elm/node_readline.js +!elm/bootstrap.js +wasm/*.wat +wasm/*.wasm diff --git a/impls/ada.2/Dockerfile b/impls/ada.2/Dockerfile new file mode 100644 index 0000000000..54cfbefb8a --- /dev/null +++ b/impls/ada.2/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# GNU Ada compiler +RUN apt-get -y install gnat libreadline-dev diff --git a/impls/ada.2/Makefile b/impls/ada.2/Makefile new file mode 100644 index 0000000000..2b17dda639 --- /dev/null +++ b/impls/ada.2/Makefile @@ -0,0 +1,74 @@ +ifdef DEBUG + ADAFLAGS := -Wall -Wextra -gnatw.eH.Y -gnatySdouxy -gnatVa -g -gnataEfoqQ \ + -fstack-check -pg + LDFLAGS := -pg +else + # -O3 is not recommended as the default by the GCC documentation, + # and -O2 seems to produce slightly better performances. + ADAFLAGS := -O2 -gnatnp +endif + +# Compiler arguments. +CARGS = $(ADAFLAGS) +# Linker arguments. +LARGS = $(LDFLAGS) -lreadline + +step0 := step0_repl +step13 := step1_read_print \ + step2_eval \ + step3_env +step49 := step4_if_fn_do \ + step5_tco \ + step6_file \ + step7_quote \ + step8_macros \ + step9_try +stepa := stepA_mal +steps := $(step0) $(step13) $(step49) $(stepa) + +.PHONY: all clean +all: $(steps) +clean: + $(RM) *~ *.adt *.ali *.o b~*.ad[bs] gmon.out $(steps) + +# Tell Make how to detect out-of-date executables, and let gnatmake do +# the rest when it must be executed. +sources = $(foreach unit,$1,$(unit).adb $(unit).ads) +TYPES := $(call sources,\ + envs \ + err \ + garbage_collected \ + printer \ + reader \ + readline \ + types \ + types-atoms \ + types-builtins \ + types-fns \ + types-maps \ + types-sequences \ + types-strings \ +) +CORE := $(call sources,\ + core \ +) + +$(step0) : %: %.adb +$(step13): %: %.adb $(TYPES) +$(step49): %: %.adb $(TYPES) $(CORE) +$(stepa) : stepA%: stepa%.adb $(TYPES) $(CORE) +$(steps) : + gnatmake $< -o $@ -cargs $(CARGS) -largs $(LARGS) + +.PHONY: steps.diff +steps.diff: + diff -u step0_*.adb step1_*.adb || true + diff -u step1_*.adb step2_*.adb || true + diff -u step2_*.adb step3_*.adb || true + diff -u step3_*.adb step4_*.adb || true + diff -u step4_*.adb step5_*.adb || true + diff -u step5_*.adb step6_*.adb || true + diff -u step6_*.adb step7_*.adb || true + diff -u step7_*.adb step8_*.adb || true + diff -u step8_*.adb step9_*.adb || true + diff -u step9_*.adb stepa_*.adb || true diff --git a/impls/ada.2/README b/impls/ada.2/README new file mode 100644 index 0000000000..4bb287d496 --- /dev/null +++ b/impls/ada.2/README @@ -0,0 +1,46 @@ +Comparison with the first Ada implementation. +-- + +The first implementation was deliberately compatible with all Ada +compilers, while this one illustrates various Ada 2012 features: +assertions, preconditions, invariants, initial assignment for limited +types, limited imports... + +The variant MAL type is implemented with a discriminant instead of +object-style dispatching. This allows more static and dynamic checks, +but also two crucial performance improvements: +* Nil, boolean, integers and pointers to built-in functions are passed + by value without dynamic allocation. +* Lists are implemented as C-style arrays, and can often be + allocated on the stack. + +Another difference is that a minimal form of garbage collecting is +implemented, removing objects not referenced from the main +environment. Reference counting does not seem efficient even for symbols, +and never deallocates cyclic structures. The implementation collects +garbage after each Read-Eval-Print cycle. It would be much more +difficult to collect garbage inside scripts. If this is ever done, it +would be better to reimplement load-file in Ada and run a cycle after +each root evaluation. +It is possible to execute the recursion marking references in parallel +with the recursion printing the result, which does not modify anything +and ignores the reference marking. This works but is less performant +than sequential execution even with Linux threads and a single task +initialized at startup. +Each pointer type goes on using its own memory pool, enabling better +performance when the designated subtype has a fixed size. + +The eventual performances compete with C-style languages, allthough +all user input is checked (implicit language-defined checks like array +bounds and discriminant consistency are only enabled during tests). + +Debugging +-- + +Uncaught exceptions are reported with an execution trace (excluding +TCO cycles). This has become possible in step9, but has been +backported to former steps as this is really handy for debugging. + +Some environment variables increase verbosity. +# dbgread= ./stepAmal trace reader recursion +# dbgeval= ./stepAmal trace eval recursion (including TCO) diff --git a/impls/ada.2/core.adb b/impls/ada.2/core.adb new file mode 100644 index 0000000000..1cea19e816 --- /dev/null +++ b/impls/ada.2/core.adb @@ -0,0 +1,459 @@ +with Ada.Calendar; +with Ada.Characters.Latin_1; +with Ada.Strings.Unbounded; +with Ada.Text_IO.Unbounded_IO; + +with Err; +with Printer; +with Reader; +with Types.Atoms; +with Types.Builtins; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +package body Core is + + package ASU renames Ada.Strings.Unbounded; + use all type Types.Kind_Type; + + -- Used by time_ms. + Start_Time : constant Ada.Calendar.Time := Ada.Calendar.Clock; + + generic + Kind : in Types.Kind_Type; + function Generic_Kind_Test (Args : in Types.T_Array) return Types.T; + function Generic_Kind_Test (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return (Kind_Boolean, Args (Args'First).Kind = Kind); + end Generic_Kind_Test; + + generic + with function Ada_Operator (Left, Right : in Integer) return Integer; + function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T; + function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 2 + and then Args (Args'First).Kind = Kind_Number + and then Args (Args'Last).Kind = Kind_Number, + "expected two numbers"); + return (Kind_Number, Ada_Operator (Args (Args'First).Number, + Args (Args'Last).Number)); + end Generic_Mal_Operator; + + generic + with function Ada_Operator (Left, Right : in Integer) return Boolean; + function Generic_Comparison (Args : in Types.T_Array) return Types.T; + function Generic_Comparison (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 2 + and then Args (Args'First).Kind = Kind_Number + and then Args (Args'Last).Kind = Kind_Number, + "expected two numbers"); + return (Kind_Boolean, Ada_Operator (Args (Args'First).Number, + Args (Args'Last).Number)); + end Generic_Comparison; + + function Addition is new Generic_Mal_Operator ("+"); + function Apply (Args : in Types.T_Array) return Types.T; + function Division is new Generic_Mal_Operator ("/"); + function Equals (Args : in Types.T_Array) return Types.T; + function Greater_Equal is new Generic_Comparison (">="); + function Greater_Than is new Generic_Comparison (">"); + function Is_Atom is new Generic_Kind_Test (Kind_Atom); + function Is_False (Args : in Types.T_Array) return Types.T; + function Is_Function (Args : in Types.T_Array) return Types.T; + function Is_Keyword is new Generic_Kind_Test (Kind_Keyword); + function Is_List is new Generic_Kind_Test (Kind_List); + function Is_Macro is new Generic_Kind_Test (Kind_Macro); + function Is_Map is new Generic_Kind_Test (Kind_Map); + function Is_Nil is new Generic_Kind_Test (Kind_Nil); + function Is_Number is new Generic_Kind_Test (Kind_Number); + function Is_Sequential (Args : in Types.T_Array) return Types.T; + function Is_String is new Generic_Kind_Test (Kind_String); + function Is_Symbol is new Generic_Kind_Test (Kind_Symbol); + function Is_True (Args : in Types.T_Array) return Types.T; + function Is_Vector is new Generic_Kind_Test (Kind_Vector); + function Keyword (Args : in Types.T_Array) return Types.T; + function Less_Equal is new Generic_Comparison ("<="); + function Less_Than is new Generic_Comparison ("<"); + function Meta (Args : in Types.T_Array) return Types.T; + function Pr_Str (Args : in Types.T_Array) return Types.T; + function Println (Args : in Types.T_Array) return Types.T; + function Prn (Args : in Types.T_Array) return Types.T; + function Product is new Generic_Mal_Operator ("*"); + function Read_String (Args : in Types.T_Array) return Types.T; + function Readline (Args : in Types.T_Array) return Types.T; + function Seq (Args : in Types.T_Array) return Types.T; + function Slurp (Args : in Types.T_Array) return Types.T; + function Str (Args : in Types.T_Array) return Types.T; + function Subtraction is new Generic_Mal_Operator ("-"); + function Symbol (Args : in Types.T_Array) return Types.T; + function Time_Ms (Args : in Types.T_Array) return Types.T; + function With_Meta (Args : in Types.T_Array) return Types.T; + + ---------------------------------------------------------------------- + + function Apply (Args : in Types.T_Array) return Types.T is + begin + Err.Check (2 <= Args'Length + and then Args (Args'Last).Kind in Types.Kind_Sequence, + "expected a function, optional arguments then a sequence"); + declare + use type Types.T_Array; + F : Types.T renames Args (Args'First); + A : constant Types.T_Array + := Args (Args'First + 1 .. Args'Last - 1) + & Args (Args'Last).Sequence.all.Data; + begin + case F.Kind is + when Kind_Builtin => + return F.Builtin.all (A); + when Kind_Builtin_With_Meta => + return F.Builtin_With_Meta.all.Builtin.all (A); + when Kind_Fn | Kind_Macro => + return F.Fn.all.Apply (A); + when others => + Err.Raise_With ("parameter 1 must be a function or macro"); + end case; + end; + end Apply; + + function Equals (Args : in Types.T_Array) return Types.T is + use type Types.T; + begin + Err.Check (Args'Length = 2, "expected 2 parameters"); + return (Kind_Boolean, Args (Args'First) = Args (Args'Last)); + end Equals; + + function Is_False (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return (Kind_Boolean, Args (Args'First).Kind = Kind_Boolean + and then not Args (Args'First).Ada_Boolean); + end Is_False; + + function Is_Function (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return (Kind_Boolean, Args (Args'First).Kind in Types.Kind_Function); + end Is_Function; + + function Is_Sequential (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return (Kind_Boolean, Args (Args'First).Kind in Types.Kind_Sequence); + end Is_Sequential; + + function Is_True (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return (Kind_Boolean, Args (Args'First).Kind = Kind_Boolean + and then Args (Args'First).Ada_Boolean); + end Is_True; + + function Keyword (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1 + and then Args (Args'First).Kind in Types.Kind_Key, + "expected a keyword or a string"); + return (Kind_Keyword, Args (Args'First).Str); + end Keyword; + + function Meta (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + declare + A1 : Types.T renames Args (Args'First); + begin + case A1.Kind is + when Types.Kind_Sequence => + return A1.Sequence.all.Meta; + when Kind_Map => + return A1.Map.all.Meta; + when Kind_Fn => + return A1.Fn.all.Meta; + when Kind_Builtin_With_Meta => + return A1.Builtin_With_Meta.all.Meta; + when Kind_Builtin => + return Types.Nil; + when others => + Err.Raise_With ("expected a function, map or sequence"); + end case; + end; + end Meta; + + procedure NS_Add_To_Repl (Repl : in Envs.Ptr) is + procedure P (S : in String; + B : in Types.Builtin_Ptr) with Inline; + procedure P (S : in String; + B : in Types.Builtin_Ptr) + is + begin + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc (S)), + (Kind_Builtin, B)); + end P; + begin + P ("+", Addition'Access); + P ("apply", Apply'Access); + P ("assoc", Types.Maps.Assoc'Access); + P ("atom", Types.Atoms.Atom'Access); + P ("concat", Types.Sequences.Concat'Access); + P ("conj", Types.Sequences.Conj'Access); + P ("cons", Types.Sequences.Cons'Access); + P ("contains?", Types.Maps.Contains'Access); + P ("count", Types.Sequences.Count'Access); + P ("deref", Types.Atoms.Deref'Access); + P ("dissoc", Types.Maps.Dissoc'Access); + P ("/", Division'Access); + P ("=", Equals'Access); + P ("first", Types.Sequences.First'Access); + P ("get", Types.Maps.Get'Access); + P (">=", Greater_Equal'Access); + P (">", Greater_Than'Access); + P ("hash-map", Types.Maps.Hash_Map'Access); + P ("atom?", Is_Atom'Access); + P ("empty?", Types.Sequences.Is_Empty'Access); + P ("false?", Is_False'Access); + P ("fn?", Is_Function'Access); + P ("keyword?", Is_Keyword'Access); + P ("list?", Is_List'Access); + P ("macro?", Is_Macro'Access); + P ("map?", Is_Map'Access); + P ("nil?", Is_Nil'Access); + P ("number?", Is_Number'Access); + P ("sequential?", Is_Sequential'Access); + P ("string?", Is_String'Access); + P ("symbol?", Is_Symbol'Access); + P ("true?", Is_True'Access); + P ("vector?", Is_Vector'Access); + P ("keys", Types.Maps.Keys'Access); + P ("keyword", Keyword'Access); + P ("<=", Less_Equal'Access); + P ("<", Less_Than'Access); + P ("list", Types.Sequences.List'Access); + P ("map", Types.Sequences.Map'Access); + P ("meta", Meta'Access); + P ("nth", Types.Sequences.Nth'Access); + P ("pr-str", Pr_Str'Access); + P ("println", Println'Access); + P ("prn", Prn'Access); + P ("*", Product'Access); + P ("read-string", Read_String'Access); + P ("readline", Readline'Access); + P ("reset!", Types.Atoms.Reset'Access); + P ("rest", Types.Sequences.Rest'Access); + P ("seq", Seq'Access); + P ("slurp", Slurp'Access); + P ("str", Str'Access); + P ("-", Subtraction'Access); + P ("swap!", Types.Atoms.Swap'Access); + P ("symbol", Symbol'Access); + P ("throw", Err.Throw'Access); + P ("time-ms", Time_Ms'Access); + P ("vals", Types.Maps.Vals'Access); + P ("vec", Types.Sequences.Vec'Access); + P ("vector", Types.Sequences.Vector'Access); + P ("with-meta", With_Meta'Access); + end NS_Add_To_Repl; + + function Pr_Str (Args : in Types.T_Array) return Types.T is + R : ASU.Unbounded_String; + Started : Boolean := False; + begin + for A of Args loop + if Started then + ASU.Append (R, ' '); + else + Started := True; + end if; + Printer.Pr_Str (R, A); + end loop; + return (Kind_String, Types.Strings.Alloc (ASU.To_String (R))); + end Pr_Str; + + function Println (Args : in Types.T_Array) return Types.T is + Started : Boolean := False; + Buffer : ASU.Unbounded_String; + begin + for A of Args loop + if Started then + ASU.Append (Buffer, ' '); + else + Started := True; + end if; + Printer.Pr_Str (Buffer, A, Readably => False); + end loop; + Ada.Text_IO.Unbounded_IO.Put_Line (Buffer); + return Types.Nil; + end Println; + + function Prn (Args : in Types.T_Array) return Types.T is + -- Calling Pr_Str would create an intermediate copy. + Buffer : ASU.Unbounded_String; + Started : Boolean := False; + begin + for A of Args loop + if Started then + ASU.Append (Buffer, ' '); + else + Started := True; + end if; + Printer.Pr_Str (Buffer, A); + end loop; + Ada.Text_IO.Unbounded_IO.Put_Line (Buffer); + return Types.Nil; + end Prn; + + function Readline (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, + "expected a string"); + Ada.Text_IO.Put (Args (Args'First).Str.all.To_String); + if Ada.Text_IO.End_Of_File then + return Types.Nil; + else + return (Kind_String, Types.Strings.Alloc (Ada.Text_IO.Get_Line)); + end if; + end Readline; + + function Read_String (Args : in Types.T_Array) return Types.T is + Result : Types.T; + procedure Process (Element : in String); + procedure Process (Element : in String) is + R : constant Types.T_Array := Reader.Read_Str (Element); + begin + Err.Check (R'Length = 1, "parameter must contain 1 expression"); + Result := R (R'First); + end Process; + begin + Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, + "expected a string"); + Args (Args'First).Str.all.Query_Element (Process'Access); + return Result; + end Read_String; + + function Seq (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + case Args (Args'First).Kind is + when Kind_Nil => + return Types.Nil; + when Kind_String => + declare + Result : Types.T; + procedure Process (S : in String); + procedure Process (S : in String) is + begin + if S'Length = 0 then + Result := Types.Nil; + else + Result := (Kind_List, + Types.Sequences.Constructor (S'Length)); + for I in S'Range loop + Result.Sequence.all.Data (S'First - 1 + I) + := (Kind_String, Types.Strings.Alloc (S (I .. I))); + end loop; + end if; + end Process; + begin + Args (Args'First).Str.all.Query_Element (Process'Access); + return Result; + end; + when Types.Kind_Sequence => + if Args (Args'First).Sequence.all.Length = 0 then + return Types.Nil; + else + return (Kind_List, Args (Args'First).Sequence); + end if; + when others => + Err.Raise_With ("expected nil, a sequence or a string"); + end case; + end Seq; + + function Slurp (Args : in Types.T_Array) return Types.T is + use Ada.Text_IO; + File : File_Type; + Buffer : ASU.Unbounded_String; + begin + Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, + "expected a string"); + Open (File, In_File, Args (Args'First).Str.all.To_String); + while not End_Of_File (File) loop + ASU.Append (Buffer, Get_Line (File)); + ASU.Append (Buffer, Ada.Characters.Latin_1.LF); + end loop; + Close (File); + return (Kind_String, Types.Strings.Alloc (ASU.To_String (Buffer))); + exception + -- Catch I/O errors, but not Err.Error... + when E : Status_Error | Name_Error | Use_Error | Mode_Error => + if Is_Open (File) then + Close (File); + end if; + Err.Raise_In_Mal (E); + end Slurp; + + function Str (Args : in Types.T_Array) return Types.T is + R : ASU.Unbounded_String; + begin + for Arg of Args loop + Printer.Pr_Str (R, Arg, Readably => False); + end loop; + return (Kind_String, Types.Strings.Alloc (ASU.To_String (R))); + end Str; + + function Symbol (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, + "expected a string"); + return (Kind_Symbol, Args (Args'First).Str); + end Symbol; + + function Time_Ms (Args : in Types.T_Array) return Types.T is + use type Ada.Calendar.Time; + begin + Err.Check (Args'Length = 0, "expected no parameter"); + return (Kind_Number, + Integer (1000.0 * (Ada.Calendar.Clock - Start_Time))); + end Time_Ms; + + function With_Meta (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 2, "expected 2 parameters"); + declare + A1 : Types.T renames Args (Args'First); + A2 : Types.T renames Args (Args'Last); + begin + case A1.Kind is + when Kind_Builtin_With_Meta => + return A1.Builtin_With_Meta.all.With_Meta (A2); + when Kind_Builtin => + return Types.Builtins.With_Meta (A1.Builtin, A2); + when Kind_List => + return R : constant Types.T + := Types.Sequences.List (A1.Sequence.all.Data) + do + R.Sequence.all.Meta := A2; + end return; + when Kind_Vector => + return R : constant Types.T + := Types.Sequences.Vector (A1.Sequence.all.Data) + do + R.Sequence.all.Meta := A2; + end return; + when Kind_Map => + return A1.Map.all.With_Meta (A2); + when Kind_Fn => + return (Kind_Fn, Types.Fns.New_Function + (A1.Fn.all.Params, A1.Fn.all.Ast, A1.Fn.all.Env, A2)); + when others => + Err.Raise_With + ("parameter 1 must be a function, map or sequence"); + end case; + end; + end With_Meta; + +end Core; diff --git a/impls/ada.2/core.ads b/impls/ada.2/core.ads new file mode 100644 index 0000000000..bc2858d659 --- /dev/null +++ b/impls/ada.2/core.ads @@ -0,0 +1,8 @@ +with Envs; + +package Core is + + procedure NS_Add_To_Repl (Repl : in Envs.Ptr); + -- Add built-in functions. + +end Core; diff --git a/impls/ada.2/envs.adb b/impls/ada.2/envs.adb new file mode 100644 index 0000000000..3383b9c0ab --- /dev/null +++ b/impls/ada.2/envs.adb @@ -0,0 +1,128 @@ +with Ada.Text_IO.Unbounded_IO; + +with Err; +with Printer; +with Types.Sequences; + +package body Envs is + + use all type Types.Kind_Type; + use type Types.Strings.Instance; + + ---------------------------------------------------------------------- + + procedure Dump_Stack (Env : in Instance) is + use Ada.Text_IO; + begin + Put ("environment:"); + for P in Env.Data.Iterate loop + -- Do not print builtins for repl. + if HM.Element (P).Kind /= Kind_Builtin or Env.Outer /= null then + Put (" "); + HM.Key (P).all.Query_Element (Put'Access); + Put (':'); + Unbounded_IO.Put (Printer.Pr_Str (HM.Element (P))); + New_Line; + end if; + end loop; + if Env.Outer /= null then + Put ("outer is "); + Env.Outer.all.Dump_Stack; + end if; + end Dump_Stack; + + function Get (Env : in Instance; + Key : in Types.String_Ptr) return Types.T + is + Position : HM.Cursor := Env.Data.Find (Key); + Ref : Link; + begin + if not HM.Has_Element (Position) then + Ref := Env.Outer; + loop + if Ref = null then + -- Not using Err.Check, which would compute the + -- argument even if the assertion holds... + Err.Raise_With ("'" & Key.To_String & "' not found"); + end if; + Position := Ref.all.Data.Find (Key); + exit when HM.Has_Element (Position); + Ref := Ref.all.Outer; + end loop; + end if; + return HM.Element (Position); + end Get; + + function Get_Or_Nil (Env : Instance; + Key : Types.String_Ptr) return Types.T is + Position : HM.Cursor := Env.Data.Find (Key); + Ref : Link; + begin + if not HM.Has_Element (Position) then + Ref := Env.Outer; + loop + if Ref = null then + return Types.Nil; + end if; + Position := Ref.all.Data.Find (Key); + exit when HM.Has_Element (Position); + Ref := Ref.all.Outer; + end loop; + end if; + return HM.Element (Position); + end Get_Or_Nil; + + procedure Keep_References (Object : in out Instance) is + begin + for Position in Object.Data.Iterate loop + HM.Key (Position).all.Keep; + Types.Keep (HM.Element (Position)); + end loop; + if Object.Outer /= null then + Object.Outer.all.Keep; + end if; + end Keep_References; + + function New_Env (Outer : in Link := null) return Ptr is + Ref : constant Ptr := new Instance; + begin + Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); + Ref.all.Outer := Outer; + return Ref; + end New_Env; + + procedure Set_Binds (Env : in out Instance; + Binds : in Types.T_Array; + Exprs : in Types.T_Array) + is + begin + if 2 <= Binds'Length and then Binds (Binds'Last - 1).Str.all = "&" then + Err.Check (Binds'Length - 2 <= Exprs'Length, + "not enough actual parameters for vararg function"); + for I in 0 .. Binds'Length - 3 loop + Env.Data.Include (Key => Binds (Binds'First + I).Str, + New_Item => Exprs (Exprs'First + I)); + end loop; + Env.Data.Include (Key => Binds (Binds'Last).Str, + New_Item => Types.Sequences.List + (Exprs (Exprs'First + Binds'Length - 2 .. Exprs'Last))); + else + Err.Check (Binds'Length = Exprs'Length, + "wrong parameter count for (not vararg) function"); + for I in 0 .. Binds'Length - 1 loop + Env.Data.Include (Key => Binds (Binds'First + I).Str, + New_Item => Exprs (Exprs'First + I)); + end loop; + end if; + end Set_Binds; + + procedure Set (Env : in out Instance; + Key : in Types.T; + New_Item : in Types.T) + is + begin + Err.Check (Key.Kind = Kind_Symbol, "environment keys must be symbols"); + Env.Data.Include (Key.Str, New_Item); + end Set; + +end Envs; diff --git a/impls/ada.2/envs.ads b/impls/ada.2/envs.ads new file mode 100644 index 0000000000..aeeaa149eb --- /dev/null +++ b/impls/ada.2/envs.ads @@ -0,0 +1,58 @@ +private with Ada.Containers.Hashed_Maps; + +with Garbage_Collected; +with Types.Strings; + +package Envs is + + -- This package should be named Env, but Ada does not allow formal + -- parameters to be named like a package dependency, and it seems + -- that readability inside Eval is more important. + + type Instance (<>) is abstract new Garbage_Collected.Instance with private; + type Link is access Instance; + subtype Ptr is not null Link; + + function New_Env (Outer : in Link := null) return Ptr with Inline; + + procedure Set_Binds (Env : in out Instance; + Binds : in Types.T_Array; + Exprs : in Types.T_Array); + -- Equivalent to successive calls to Set, except that if Binds + -- ends with "&" followed by a symbol, the trailing symbol + -- receives all remaining values as a list. + + function Get (Env : in Instance; + Key : in Types.String_Ptr) return Types.T; + + function Get_Or_Nil (Env : Instance; + Key : Types.String_Ptr) return Types.T; + + procedure Set (Env : in out Instance; + Key : in Types.T; + New_Item : in Types.T) with Inline; + -- Raises an exception if Key is not a symbol. + + -- Debug. + procedure Dump_Stack (Env : in Instance); + +private + + package HM is new Ada.Containers.Hashed_Maps + (Key_Type => Types.String_Ptr, + Element_Type => Types.T, + Hash => Types.Strings.Hash, + Equivalent_Keys => Types.Strings.Same_Contents, + "=" => Types."="); + + -- It may be tempting to subclass Types.Map, but this would not + -- simplify the code much. And adding metadata to a structure that + -- is allocated very often has a cost. + + type Instance is new Garbage_Collected.Instance with record + Outer : Link; + Data : HM.Map; + end record; + overriding procedure Keep_References (Object : in out Instance) with Inline; + +end Envs; diff --git a/impls/ada.2/err.adb b/impls/ada.2/err.adb new file mode 100644 index 0000000000..e2411f16ae --- /dev/null +++ b/impls/ada.2/err.adb @@ -0,0 +1,67 @@ +with Ada.Characters.Latin_1; + +with Printer; +with Types.Strings; + +package body Err is + + use Ada.Strings.Unbounded; + + ---------------------------------------------------------------------- + + procedure Add_Trace_Line (Action : in String; + Ast : in Types.T) + is + begin + Append (Trace, " in "); + Append (Trace, Action); + Append (Trace, ": "); + Printer.Pr_Str (Trace, Ast); + Append (Trace, Ada.Characters.Latin_1.LF); + end Add_Trace_Line; + + procedure Check (Condition : in Boolean; + Message : in String) + is + begin + if not Condition then + Raise_With (Message); + end if; + end Check; + + procedure Raise_In_Mal (E : in Ada.Exceptions.Exception_Occurrence) is + Message : String renames Ada.Exceptions.Exception_Information (E); + procedure Process (S : in String); + procedure Process (S : in String) is + begin + Append (Trace, S); + end Process; + begin + Data := (Types.Kind_String, Types.Strings.Alloc (Message)); + Set_Unbounded_String (Trace, "Uncaught exception: "); + Data.Str.all.Query_Element (Process'Access); + raise Error; + end Raise_In_Mal; + + procedure Raise_With (Message : in String) is + begin + Data := (Types.Kind_String, Types.Strings.Alloc (Message)); + Set_Unbounded_String (Trace, "Uncaught exception: "); + Append (Trace, Message); + Append (Trace, Ada.Characters.Latin_1.LF); + raise Error; + end Raise_With; + + function Throw (Args : in Types.T_Array) return Types.T is + begin + Check (Args'Length = 1, "expected 1 parameter"); + Data := Args (Args'First); + Set_Unbounded_String (Trace, "Uncaught exception: "); + Printer.Pr_Str (Trace, Data); + Append (Trace, Ada.Characters.Latin_1.LF); + -- A raise value is equivalent to a raise statement, but + -- silents a compiler warning. + return raise Error; + end Throw; + +end Err; diff --git a/impls/ada.2/err.ads b/impls/ada.2/err.ads new file mode 100644 index 0000000000..a83078a7e0 --- /dev/null +++ b/impls/ada.2/err.ads @@ -0,0 +1,50 @@ +with Ada.Exceptions; +with Ada.Strings.Unbounded; + +with Types; +-- We declare a variable of type Types.T. +pragma Elaborate (Types); + +package Err is + + -- Error handling. + + -- Built-in function. + function Throw (Args : in Types.T_Array) return Types.T; + + -- Ada exceptions can only carry an immutable String in each + -- occurence, so we require a global variable to store the last + -- exception as a Mal object anyway, and may as well use it for + -- simple string messages. + + Error : exception; + Data : Types.T; + Trace : Ada.Strings.Unbounded.Unbounded_String; + + -- Convenient shortcuts. + + procedure Raise_With (Message : in String) with No_Return; + -- Similar to a "raise with Message" Ada statement. + -- Store the message into Data, + -- store the message and "Uncaught exception: " into Trace, + -- then raise Error. + + procedure Raise_In_Mal (E : in Ada.Exceptions.Exception_Occurrence) + with No_Return; + -- Raise_With (Ada.Exceptions.Exception_Information (E)) + + procedure Add_Trace_Line (Action : in String; + Ast : in Types.T); + -- Appends a line like "Action: Ast" to Trace. + + procedure Check (Condition : in Boolean; + Message : in String) with Inline; + -- Raise_With if Condition fails. + + -- It is probably more efficient to construct a boolean and call + -- this procedure once, as "inline" is only a recommendation. + + -- Beware of the classical performance issue that the Message is + -- formatted even if the Condition does not hold. + +end Err; diff --git a/impls/ada.2/garbage_collected.adb b/impls/ada.2/garbage_collected.adb new file mode 100644 index 0000000000..373f26d977 --- /dev/null +++ b/impls/ada.2/garbage_collected.adb @@ -0,0 +1,54 @@ +with Ada.Unchecked_Deallocation; + +package body Garbage_Collected is + + procedure Free is new Ada.Unchecked_Deallocation (Class, Link); + + Top : Link := null; + + ---------------------------------------------------------------------- + + procedure Clean is + Current : Link := Top; + Previous : Link; + begin + while Current /= null and then not Current.all.Kept loop + Previous := Current; + Current := Current.all.Next; + Free (Previous); + end loop; + Top := Current; + while Current /= null loop + if Current.all.Kept then + Current.all.Kept := False; + Previous := Current; + else + Previous.all.Next := Current.all.Next; + Free (Current); + end if; + Current := Previous.all.Next; + end loop; + end Clean; + + procedure Keep (Object : in out Class) is + begin + if not Object.Kept then + Object.Kept := True; + Object.Keep_References; -- dispatching + end if; + end Keep; + + procedure Check_Allocations is + begin + pragma Assert (Top = null); + end Check_Allocations; + + procedure Register (Ref : in Pointer) is + begin + pragma Assert (Ref.all.Kept = False); + pragma Assert (Ref.all.Next = null); + Ref.all.Next := Top; + Top := Ref; + end Register; + +end Garbage_Collected; diff --git a/impls/ada.2/garbage_collected.ads b/impls/ada.2/garbage_collected.ads new file mode 100644 index 0000000000..1f23f2b980 --- /dev/null +++ b/impls/ada.2/garbage_collected.ads @@ -0,0 +1,46 @@ +package Garbage_Collected is + + -- A generic would not be convenient for lists. We want the + -- extended type to be able to have a discriminant. + + -- However, we keep the dispatching in a single enumeration for + -- efficiency and clarity of the source. + + type Instance is abstract tagged limited private; + subtype Class is Instance'Class; + type Link is access all Class; + subtype Pointer is not null Link; + + procedure Keep_References (Object : in out Instance) is null with Inline; + -- A dispatching call in Keep allows subclasses to override this + -- in order to Keep each of the internal reference they maintain. + + -- The following methods have no reason to be overridden. + + procedure Keep (Object : in out Class) with Inline; + -- Mark this object so that it is not deleted by next clean, + -- then make a dispatching call to Keep_References. + -- Does nothing if it has already been called for this object + -- since startup or last Clean. + + procedure Register (Ref : in Pointer) with Inline; + -- Each subclass defines its own allocation pool, but every call + -- to new must be followed by a call to Register. + + procedure Clean; + -- For each object for which Keep has not been called since + -- startup or last clean, make a dispatching call to Finalize, + -- then deallocate the memory for the object. + + -- Debug. + procedure Check_Allocations; + -- Does nothing if assertions are disabled. + +private + + type Instance is abstract tagged limited record + Kept : Boolean := False; + Next : Link := null; + end record; + +end Garbage_Collected; diff --git a/impls/ada.2/printer.adb b/impls/ada.2/printer.adb new file mode 100644 index 0000000000..0891cd741f --- /dev/null +++ b/impls/ada.2/printer.adb @@ -0,0 +1,164 @@ +with Ada.Characters.Latin_1; + +with Types.Atoms; +with Types.Fns; +with Types.Maps; +pragma Warnings (Off, "unit ""Types.Sequences"" is not referenced"); +with Types.Sequences; +pragma Warnings (On, "unit ""Types.Sequences"" is not referenced"); + +package body Printer is + + use Ada.Strings.Unbounded; + use all type Types.Kind_Type; + + procedure Pr_Str (Buffer : in out Unbounded_String; + Ast : in Types.T; + Readably : in Boolean := True) + is + + procedure Print_Form (Form_Ast : in Types.T); + -- The recursive function traversing Ast for Pr_Str. + -- Form_Ast is the current node. + + -- Helpers for Print_Form. + procedure Print_Number (Number : in Integer); + procedure Print_List (List : in Types.T_Array); + procedure Print_Map (Map : in Types.Maps.Instance); + procedure Print_Readably (S : in String); + procedure Print_String (S : in String); + + ---------------------------------------------------------------------- + + procedure Print_Form (Form_Ast : in Types.T) is + begin + case Form_Ast.Kind is + when Kind_Nil => + Append (Buffer, "nil"); + when Kind_Boolean => + if Form_Ast.Ada_Boolean then + Append (Buffer, "true"); + else + Append (Buffer, "false"); + end if; + when Kind_Symbol => + Form_Ast.Str.all.Query_Element (Print_String'Access); + when Kind_Number => + Print_Number (Form_Ast.Number); + when Kind_Keyword => + Append (Buffer, ':'); + Form_Ast.Str.all.Query_Element (Print_String'Access); + when Kind_String => + if Readably then + Append (Buffer, '"'); + Form_Ast.Str.all.Query_Element (Print_Readably'Access); + Append (Buffer, '"'); + else + Form_Ast.Str.all.Query_Element (Print_String'Access); + end if; + when Kind_List => + Append (Buffer, '('); + Print_List (Form_Ast.Sequence.all.Data); + Append (Buffer, ')'); + when Kind_Vector => + Append (Buffer, '['); + Print_List (Form_Ast.Sequence.all.Data); + Append (Buffer, ']'); + when Kind_Map => + Append (Buffer, '{'); + Print_Map (Form_Ast.Map.all); + Append (Buffer, '}'); + when Kind_Builtin | Kind_Builtin_With_Meta => + Append (Buffer, "#"); + when Kind_Fn => + Append (Buffer, "# "); + Print_Form (Form_Ast.Fn.all.Ast); + Append (Buffer, '>'); + when Kind_Macro => + Append (Buffer, "# "); + Print_Form (Form_Ast.Fn.all.Ast); + Append (Buffer, '>'); + when Kind_Atom => + Append (Buffer, "(atom "); + Print_Form (Form_Ast.Atom.all.Deref); + Append (Buffer, ')'); + end case; + end Print_Form; + + procedure Print_List (List : in Types.T_Array) is + begin + if 0 < List'Length then + Print_Form (List (List'First)); + for I in List'First + 1 .. List'Last loop + Append (Buffer, ' '); + Print_Form (List (I)); + end loop; + end if; + end Print_List; + + procedure Print_Map (Map : in Types.Maps.Instance) is + use all type Types.Maps.Cursor; + Position : Types.Maps.Cursor := Map.First; + begin + if Has_Element (Position) then + loop + Print_Form (Key (Position)); + Append (Buffer, ' '); + Print_Form (Element (Position)); + Next (Position); + exit when not Has_Element (Position); + Append (Buffer, ' '); + end loop; + end if; + end Print_Map; + + procedure Print_Number (Number : in Integer) is + Image : constant String := Integer'Image (Number); + First : Positive := Image'First; + begin + if Image (First) = ' ' then + First := First + 1; + end if; + Append (Buffer, Image (First .. Image'Last)); + end Print_Number; + + procedure Print_Readably (S : in String) is + begin + for C of S loop + case C is + when '"' | '\' => + Append (Buffer, '\'); + Append (Buffer, C); + when Ada.Characters.Latin_1.LF => + Append (Buffer, "\n"); + when others => + Append (Buffer, C); + end case; + end loop; + end Print_Readably; + + procedure Print_String (S : in String) is + begin + Append (Buffer, S); + end Print_String; + + ---------------------------------------------------------------------- + + begin -- Pr_Str + Print_Form (Ast); + end Pr_Str; + + function Pr_Str (Ast : in Types.T; + Readably : in Boolean := True) return Unbounded_String + is + begin + return Buffer : Unbounded_String do + Pr_Str (Buffer, Ast, Readably); + end return; + end Pr_Str; + +end Printer; diff --git a/impls/ada.2/printer.ads b/impls/ada.2/printer.ads new file mode 100644 index 0000000000..22646dc659 --- /dev/null +++ b/impls/ada.2/printer.ads @@ -0,0 +1,19 @@ +with Ada.Strings.Unbounded; + +with Types; + +package Printer is + + procedure Pr_Str + (Buffer : in out Ada.Strings.Unbounded.Unbounded_String; + Ast : in Types.T; + Readably : in Boolean := True); + -- Append the text to Buffer. + + function Pr_Str (Ast : in Types.T; + Readably : in Boolean := True) + return Ada.Strings.Unbounded.Unbounded_String; + -- Return a freshly created unbounded string. + -- Convenient, but inefficient. + +end Printer; diff --git a/impls/ada.2/reader.adb b/impls/ada.2/reader.adb new file mode 100644 index 0000000000..65037e84cf --- /dev/null +++ b/impls/ada.2/reader.adb @@ -0,0 +1,267 @@ +with Ada.Characters.Handling; +with Ada.Characters.Latin_1; +with Ada.Environment_Variables; +with Ada.Strings.Maps.Constants; +with Ada.Strings.Unbounded; +with Ada.Text_IO.Unbounded_IO; + +with Err; +with Printer; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +package body Reader is + + Debug : constant Boolean := Ada.Environment_Variables.Exists ("dbgread"); + + use all type Types.Kind_Type; + use all type Ada.Strings.Maps.Character_Set; + + Ignored_Set : constant Ada.Strings.Maps.Character_Set + := Ada.Strings.Maps.Constants.Control_Set + or To_Set (" ,;"); + + Symbol_Set : constant Ada.Strings.Maps.Character_Set + := not (Ignored_Set or To_Set ("""'()@[]^`{}~")); + + function Read_Str (Source : in String) return Types.T_Array is + + I : Positive := Source'First; + -- Index in Source of the currently read character. + + -- Big arrays on the stack are faster than repeated dynamic + -- reallocations. This single buffer is used by all Read_List + -- recursive invocations, and by Read_Str. + Buffer : Types.T_Array (1 .. Source'Length); + B_Last : Natural := Buffer'First - 1; + -- Index in Buffer of the currently written MAL expression. + + function Read_Form return Types.T; + -- The recursive part of Read_Str. + + -- Helpers for Read_Form: + + procedure Skip_Ignored; + -- Check if the current character is ignorable or a comment. + -- Increment I until it exceeds Source'Last or designates + -- an interesting character. + + procedure Skip_Digits with Inline; + -- Increment I at least once, until I exceeds Source'Last or + -- designates something else than a decimal digit. + + procedure Skip_Symbol with Inline; + -- Check if the current character is allowed in a symbol name. + -- Increment I until it exceeds Source'Last or stops + -- designating an allowed character. + + -- Read_Atom has been merged into the same case/switch + -- statement, for clarity and efficiency. + + function Read_List (Ending : in Character) return Natural; + -- Returns the index of the last elements in Buffer. + -- The elements have been stored in Buffer (B_Last .. result). + + function Read_Quote (Symbol : in String) return Types.T; + + function Read_String return Types.T; + + function Read_With_Meta return Types.T; + + ---------------------------------------------------------------------- + + function Read_List (Ending : in Character) return Natural is + Opening : constant Character := Source (I); + Old : constant Natural := B_Last; + Result : Positive; + begin + I := I + 1; -- Skip (, [ or {. + loop + Skip_Ignored; + Err.Check (I <= Source'Last, "unbalanced '" & Opening & "'"); + exit when Source (I) = Ending; + B_Last := B_Last + 1; + Buffer (B_Last) := Read_Form; + end loop; + I := I + 1; -- Skip ), ] or }. + Result := B_Last; + B_Last := Old; + return Result; + end Read_List; + + function Read_Quote (Symbol : in String) return Types.T is + R : constant Types.Sequence_Ptr := Types.Sequences.Constructor (2); + begin + I := I + 1; -- Skip the initial ' or similar. + R.all.Data (1) := (Kind_Symbol, Types.Strings.Alloc (Symbol)); + Skip_Ignored; + Err.Check (I <= Source'Last, "Incomplete '" & Symbol & "'"); + R.all.Data (2) := Read_Form; + return (Kind_List, R); + end Read_Quote; + + function Read_Form return Types.T is + -- After I has been increased, current token is be + -- Source (F .. I - 1). + F : Positive; + R : Types.T; -- The result of this function. + begin + case Source (I) is + when ')' | ']' | '}' => + Err.Raise_With ("unbalanced '" & Source (I) & "'"); + when '"' => + R := Read_String; + when ':' => + I := I + 1; + F := I; + Skip_Symbol; + R := (Kind_Keyword, Types.Strings.Alloc (Source (F .. I - 1))); + when '-' => + F := I; + Skip_Digits; + if F + 1 < I then + R := (Kind_Number, Integer'Value (Source (F .. I - 1))); + else + Skip_Symbol; + R := (Kind_Symbol, + Types.Strings.Alloc (Source (F .. I - 1))); + end if; + when '~' => + if I < Source'Last and then Source (I + 1) = '@' then + I := I + 1; + R := Read_Quote ("splice-unquote"); + else + R := Read_Quote ("unquote"); + end if; + when '0' .. '9' => + F := I; + Skip_Digits; + R := (Kind_Number, Integer'Value (Source (F .. I - 1))); + when ''' => + R := Read_Quote ("quote"); + when '`' => + R := Read_Quote ("quasiquote"); + when '@' => + R := Read_Quote ("deref"); + when '^' => + R := Read_With_Meta; + when '(' => + R := Types.Sequences.List + (Buffer (B_Last + 1 .. Read_List (')'))); + when '[' => + R := Types.Sequences.Vector + (Buffer (B_Last + 1 .. Read_List (']'))); + when '{' => + R := Types.Maps.Hash_Map + (Buffer (B_Last + 1 .. Read_List ('}'))); + when others => + F := I; + Skip_Symbol; + if Source (F .. I - 1) = "false" then + R := (Kind_Boolean, False); + elsif Source (F .. I - 1) = "nil" then + R := Types.Nil; + elsif Source (F .. I - 1) = "true" then + R := (Kind_Boolean, True); + else + R := (Kind_Symbol, + Types.Strings.Alloc (Source (F .. I - 1))); + end if; + end case; + if Debug then + Ada.Text_IO.Put ("reader: "); + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (R)); + end if; + return R; + end Read_Form; + + function Read_String return Types.T is + use Ada.Strings.Unbounded; + Result : Unbounded_String; + begin + loop + I := I + 1; + Err.Check (I <= Source'Last, "unbalanced '""'"); + case Source (I) is + when '"' => + exit; + when '\' => + I := I + 1; + Err.Check (I <= Source'Last, "unbalanced '""'"); + case Source (I) is + when '\' | '"' => + Append (Result, Source (I)); + when 'n' => + Append (Result, Ada.Characters.Latin_1.LF); + when others => + Append (Result, Source (I - 1 .. I)); + end case; + when others => + Append (Result, Source (I)); + end case; + end loop; + I := I + 1; -- Skip closing double quote. + return (Kind_String, Types.Strings.Alloc (To_String (Result))); + end Read_String; + + function Read_With_Meta return Types.T is + List : constant Types.Sequence_Ptr := Types.Sequences.Constructor (3); + begin + I := I + 1; -- Skip the initial ^. + List.all.Data (1) := (Kind_Symbol, Types.Strings.Alloc ("with-meta")); + for I in reverse 2 .. 3 loop + Skip_Ignored; + Err.Check (I <= Source'Last, "Incomplete 'with-meta'"); + List.all.Data (I) := Read_Form; + end loop; + return (Kind_List, List); + end Read_With_Meta; + + procedure Skip_Digits is + use Ada.Characters.Handling; + begin + loop + I := I + 1; + exit when Source'Last < I; + exit when not Is_Digit (Source (I)); + end loop; + end Skip_Digits; + + procedure Skip_Ignored is + use Ada.Characters.Handling; + begin + Ignored : while I <= Source'Last + and then Is_In (Source (I), Ignored_Set) + loop + if Source (I) = ';' then + Comment : loop + I := I + 1; + exit Ignored when Source'Last < I; + exit Comment when Is_Line_Terminator (Source (I)); + end loop Comment; + end if; + I := I + 1; + end loop Ignored; + end Skip_Ignored; + + procedure Skip_Symbol is + begin + while I <= Source'Last and then Is_In (Source (I), Symbol_Set) loop + I := I + 1; + end loop; + end Skip_Symbol; + + ---------------------------------------------------------------------- + + begin -- Read_Str + loop + Skip_Ignored; + exit when Source'Last < I; + B_Last := B_Last + 1; + Buffer (B_Last) := Read_Form; + end loop; + return Buffer (Buffer'First .. B_Last); + end Read_Str; + +end Reader; diff --git a/impls/ada.2/reader.ads b/impls/ada.2/reader.ads new file mode 100644 index 0000000000..033fc33e16 --- /dev/null +++ b/impls/ada.2/reader.ads @@ -0,0 +1,10 @@ +with Types; + +package Reader is + + function Read_Str (Source : in String) return Types.T_Array; + -- The language does not explicitly define what happens when the + -- input string contains more than one expression. + -- This implementation returns all of them. + +end Reader; diff --git a/impls/ada.2/readline.adb b/impls/ada.2/readline.adb new file mode 100644 index 0000000000..882b347387 --- /dev/null +++ b/impls/ada.2/readline.adb @@ -0,0 +1,32 @@ +with Interfaces.C.Strings; + +package body Readline is + + function Input (Prompt : in String) return String is + + use Interfaces.C; + use Interfaces.C.Strings; + + function C_Readline (Prompt : in char_array) return chars_ptr + with Import, Convention => C, External_Name => "readline"; + + procedure Add_History (Line : in chars_ptr) + with Import, Convention => C, External_Name => "add_history"; + + procedure Free (Line : in chars_ptr) + with Import, Convention => C, External_Name => "free"; + + C_Line : constant chars_ptr := C_Readline (To_C (Prompt)); + begin + if C_Line = Null_Ptr then + raise End_Of_File; + end if; + return Ada_Line : constant String := Value (C_Line) do + if Ada_Line /= "" then + Add_History (C_Line); + end if; + Free (C_Line); + end return; + end Input; + +end Readline; diff --git a/impls/ada.2/readline.ads b/impls/ada.2/readline.ads new file mode 100644 index 0000000000..81bdb839db --- /dev/null +++ b/impls/ada.2/readline.ads @@ -0,0 +1,7 @@ +package Readline is + + function Input (Prompt : in String) return String; + + End_Of_File : exception; + +end Readline; diff --git a/impls/ada.2/run b/impls/ada.2/run new file mode 100755 index 0000000000..6efdc3de32 --- /dev/null +++ b/impls/ada.2/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/ada.2/step0_repl.adb b/impls/ada.2/step0_repl.adb new file mode 100644 index 0000000000..5a09040d98 --- /dev/null +++ b/impls/ada.2/step0_repl.adb @@ -0,0 +1,45 @@ +with Ada.Text_IO; + +with Readline; + +procedure Step0_Repl is + + function Read return String with Inline; + + function Eval (Ast : in String) return String; + + procedure Print (Ast : in String) with Inline; + + procedure Rep with Inline; + + ---------------------------------------------------------------------- + + function Eval (Ast : in String) return String + is (Ast); + + procedure Print (Ast : in String) is + begin + Ada.Text_IO.Put_Line (Ast); + end Print; + + function Read return String is (Readline.Input ("user> ")); + + procedure Rep is + begin + Print (Eval (Read)); + end Rep; + + ---------------------------------------------------------------------- + +begin + loop + begin + Rep; + exception + when Readline.End_Of_File => + exit; + end; + -- Other exceptions are really unexpected. + end loop; + Ada.Text_IO.New_Line; +end Step0_Repl; diff --git a/impls/ada.2/step1_read_print.adb b/impls/ada.2/step1_read_print.adb new file mode 100644 index 0000000000..4079879e94 --- /dev/null +++ b/impls/ada.2/step1_read_print.adb @@ -0,0 +1,65 @@ +with Ada.Text_IO.Unbounded_IO; + +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types; + +procedure Step1_Read_Print is + + function Read return Types.T_Array with Inline; + + function Eval (Ast : in Types.T) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep with Inline; + + ---------------------------------------------------------------------- + + function Eval (Ast : in Types.T) return Types.T is (Ast); + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep is + begin + for Expression of Read loop + Print (Eval (Expression)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + +begin + loop + begin + Rep; + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + -- No data survives at this stage, Repl only contains static + -- pointers to built-in functions. + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step1_Read_Print; diff --git a/impls/ada.2/step2_eval.adb b/impls/ada.2/step2_eval.adb new file mode 100644 index 0000000000..7d5ab79dd4 --- /dev/null +++ b/impls/ada.2/step2_eval.adb @@ -0,0 +1,188 @@ +with Ada.Containers.Indefinite_Hashed_Maps; +with Ada.Strings.Hash; +with Ada.Text_IO.Unbounded_IO; + +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step2_Eval is + + use type Types.T; + use all type Types.Kind_Type; + + package Envs is new Ada.Containers.Indefinite_Hashed_Maps + (Key_Type => String, + Element_Type => Types.Builtin_Ptr, + Hash => Ada.Strings.Hash, + Equivalent_Keys => "=", + "=" => Types."="); + + function Read return Types.T_Array with Inline; + + function Eval (Ast : in Types.T; + Env : in Envs.Map) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Map) with Inline; + + generic + with function Ada_Operator (Left, Right : in Integer) return Integer; + function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Map) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Map) return Types.T; + -- Helpers for the Eval function. + + ---------------------------------------------------------------------- + + function Eval (Ast : in Types.T; + Env : in Envs.Map) return Types.T + is + First : Types.T; + begin + -- Ada.Text_IO.Put ("EVAL: "); + -- Print (Ast); + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + declare + S : constant String := Ast.Str.all.To_String; + C : constant Envs.Cursor := Env.Find (S); + begin + -- The predefined error message does not pass tests. + Err.Check (Envs.Has_Element (C), "'" & S & "' not found"); + return (Kind_Builtin, Envs.Element (C)); + end; + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Ast is a non-empty list, First is its first element. + First := Eval (First, Env); + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its evaluated first element. + Err.Check (First.Kind = Kind_Builtin, + "first element must be a function"); + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + return First.Builtin.all (Args); + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Map) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Map) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T + is (Kind_Number, Ada_Operator (Args (Args'First).Number, + Args (Args'Last).Number)); + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Map) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + function Addition is new Generic_Mal_Operator ("+"); + function Subtraction is new Generic_Mal_Operator ("-"); + function Product is new Generic_Mal_Operator ("*"); + function Division is new Generic_Mal_Operator ("/"); + + Repl : Envs.Map; +begin + Repl.Insert ("+", Addition 'Unrestricted_Access); + Repl.Insert ("-", Subtraction'Unrestricted_Access); + Repl.Insert ("*", Product 'Unrestricted_Access); + Repl.Insert ("/", Division 'Unrestricted_Access); + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + -- No data survives at this stage, Repl only contains static + -- pointers to built-in functions. + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step2_Eval; diff --git a/impls/ada.2/step3_env.adb b/impls/ada.2/step3_env.adb new file mode 100644 index 0000000000..b428ab2300 --- /dev/null +++ b/impls/ada.2/step3_env.adb @@ -0,0 +1,220 @@ +with Ada.Text_IO.Unbounded_IO; + +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step3_Env is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + + function Read return Types.T_Array with Inline; + + function Eval (Ast : in Types.T; + Env : in Envs.Ptr) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + generic + with function Ada_Operator (Left, Right : in Integer) return Integer; + function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + ---------------------------------------------------------------------- + + function Eval (Ast : in Types.T; + Env : in Envs.Ptr) return Types.T + is + First : Types.T; + begin + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + New_Env : constant Envs.Ptr := Envs.New_Env (Outer => Env); + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + for I in 0 .. Bindings'Length / 2 - 1 loop + New_Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), New_Env)); + -- This call checks key kind. + end loop; + return Eval (Ast.Sequence.all.Data (3), New_Env); + end; + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + else + First := Eval (First, Env); + end if; + when others => + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + Err.Check (First.Kind = Kind_Builtin, + "first element must be a function"); + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + return First.Builtin.all (Args); + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T + is (Kind_Number, Ada_Operator (Args (Args'First).Number, + Args (Args'Last).Number)); + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + function Addition is new Generic_Mal_Operator ("+"); + function Subtraction is new Generic_Mal_Operator ("-"); + function Product is new Generic_Mal_Operator ("*"); + function Division is new Generic_Mal_Operator ("/"); + + Repl : constant Envs.Ptr := Envs.New_Env; +begin + -- Add Core functions into the top environment. + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("+")), + (Kind_Builtin, Addition 'Unrestricted_Access)); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("-")), + (Kind_Builtin, Subtraction'Unrestricted_Access)); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*")), + (Kind_Builtin, Product 'Unrestricted_Access)); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("/")), + (Kind_Builtin, Division 'Unrestricted_Access)); + -- Execute user commands. + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step3_Env; diff --git a/impls/ada.2/step4_if_fn_do.adb b/impls/ada.2/step4_if_fn_do.adb new file mode 100644 index 0000000000..3de6c7cc27 --- /dev/null +++ b/impls/ada.2/step4_if_fn_do.adb @@ -0,0 +1,258 @@ +with Ada.Text_IO.Unbounded_IO; + +with Core; +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step4_If_Fn_Do is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + + function Read return Types.T_Array with Inline; + + function Eval (Ast : in Types.T; + Env : in Envs.Ptr) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + procedure Exec (Script : in String; + Env : in Envs.Ptr) with Inline; + -- Read the script, eval its elements, but ignore the result. + + ---------------------------------------------------------------------- + + function Eval (Ast : in Types.T; + Env : in Envs.Ptr) return Types.T + is + First : Types.T; + begin + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "if" then + Err.Check (Ast.Sequence.all.Length in 3 .. 4, + "expected 2 or 3 parameters"); + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + return Eval (Ast.Sequence.all.Data (3), Env); + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + return Eval (Ast.Sequence.all.Data (4), Env); + end if; + elsif First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + New_Env : constant Envs.Ptr := Envs.New_Env (Outer => Env); + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + for I in 0 .. Bindings'Length / 2 - 1 loop + New_Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), New_Env)); + -- This call checks key kind. + end loop; + return Eval (Ast.Sequence.all.Data (3), New_Env); + end; + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "do" then + Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); + declare + Result : Types.T; + begin + for I in 2 .. Ast.Sequence.all.Length loop + Result := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + return Result; + end; + elsif First.Str.all = "fn*" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Params : Types.T renames Ast.Sequence.all.Data (2); + begin + Err.Check (Params.Kind in Types.Kind_Sequence, + "first argument of fn* must be a sequence"); + return (Kind_Fn, Types.Fns.New_Function + (Params => Params.Sequence, + Ast => Ast.Sequence.all.Data (3), + Env => Env)); + end; + else + First := Eval (First, Env); + end if; + when others => + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + Err.Check (First.Kind in Types.Kind_Function, + "first element must be a function"); + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + if First.Kind = Kind_Builtin then + return First.Builtin.all (Args); + end if; + return First.Fn.all.Apply (Args); + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + procedure Exec (Script : in String; + Env : in Envs.Ptr) + is + Result : Types.T; + begin + for Expression of Reader.Read_Str (Script) loop + Result := Eval (Expression, Env); + end loop; + pragma Unreferenced (Result); + end Exec; + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + Startup : constant String + := "(def! not (fn* (a) (if a false true)))"; + Repl : constant Envs.Ptr := Envs.New_Env; +begin + -- Show the Eval function to other packages. + Types.Fns.Eval_Cb := Eval'Unrestricted_Access; + -- Add Core functions into the top environment. + Core.NS_Add_To_Repl (Repl); + -- Native startup procedure. + Exec (Startup, Repl); + -- Execute user commands. + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step4_If_Fn_Do; diff --git a/impls/ada.2/step5_tco.adb b/impls/ada.2/step5_tco.adb new file mode 100644 index 0000000000..52fc19f679 --- /dev/null +++ b/impls/ada.2/step5_tco.adb @@ -0,0 +1,282 @@ +with Ada.Text_IO.Unbounded_IO; + +with Core; +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step5_Tco is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + + function Read return Types.T_Array with Inline; + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + procedure Exec (Script : in String; + Env : in Envs.Ptr) with Inline; + -- Read the script, eval its elements, but ignore the result. + + ---------------------------------------------------------------------- + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T + is + -- Use local variables, that can be rewritten when tail call + -- optimization goes to <>. + Ast : Types.T := Ast0; + Env : Envs.Ptr := Env0; + First : Types.T; + begin + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "if" then + Err.Check (Ast.Sequence.all.Length in 3 .. 4, + "expected 2 or 3 parameters"); + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; + elsif First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + Env := Envs.New_Env (Outer => Env); + for I in 0 .. Bindings'Length / 2 - 1 loop + Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), Env)); + -- This call checks key kind. + end loop; + Ast := Ast.Sequence.all.Data (3); + goto Restart; + end; + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "do" then + Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); + declare + Result : Types.T; + begin + for I in 2 .. Ast.Sequence.all.Length - 1 loop + Result := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + pragma Unreferenced (Result); + end; + Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); + goto Restart; + elsif First.Str.all = "fn*" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Params : Types.T renames Ast.Sequence.all.Data (2); + begin + Err.Check (Params.Kind in Types.Kind_Sequence, + "first argument of fn* must be a sequence"); + return (Kind_Fn, Types.Fns.New_Function + (Params => Params.Sequence, + Ast => Ast.Sequence.all.Data (3), + Env => Env)); + end; + else + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + First := Env.all.Get (First.Str); + end if; + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + null; + when Types.Kind_Sequence | Kind_Map => + -- Lists are definitely worth a recursion, and the two other + -- cases should be rare (they will report an error later). + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + Err.Check (First.Kind in Types.Kind_Function, + "first element must be a function"); + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + if First.Kind = Kind_Builtin then + return First.Builtin.all (Args); + end if; + -- Like Types.Fns.Apply, except that we use TCO. + Env := Envs.New_Env (Outer => First.Fn.all.Env); + Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, + Exprs => Args); + Ast := First.Fn.all.Ast; + goto Restart; + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + procedure Exec (Script : in String; + Env : in Envs.Ptr) + is + Result : Types.T; + begin + for Expression of Reader.Read_Str (Script) loop + Result := Eval (Expression, Env); + end loop; + pragma Unreferenced (Result); + end Exec; + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + Startup : constant String + := "(def! not (fn* (a) (if a false true)))"; + Repl : constant Envs.Ptr := Envs.New_Env; +begin + -- Show the Eval function to other packages. + Types.Fns.Eval_Cb := Eval'Unrestricted_Access; + -- Add Core functions into the top environment. + Core.NS_Add_To_Repl (Repl); + -- Native startup procedure. + Exec (Startup, Repl); + -- Execute user commands. + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step5_Tco; diff --git a/impls/ada.2/step6_file.adb b/impls/ada.2/step6_file.adb new file mode 100644 index 0000000000..6fb5ef355e --- /dev/null +++ b/impls/ada.2/step6_file.adb @@ -0,0 +1,309 @@ +with Ada.Command_Line; +with Ada.Text_IO.Unbounded_IO; + +with Core; +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step6_File is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + package ACL renames Ada.Command_Line; + + function Read return Types.T_Array with Inline; + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T; + function Eval_Builtin (Args : in Types.T_Array) return Types.T; + -- The built-in variant needs to see the Repl variable. + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + procedure Exec (Script : in String; + Env : in Envs.Ptr) with Inline; + -- Read the script, eval its elements, but ignore the result. + + ---------------------------------------------------------------------- + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T + is + -- Use local variables, that can be rewritten when tail call + -- optimization goes to <>. + Ast : Types.T := Ast0; + Env : Envs.Ptr := Env0; + First : Types.T; + begin + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "if" then + Err.Check (Ast.Sequence.all.Length in 3 .. 4, + "expected 2 or 3 parameters"); + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; + elsif First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + Env := Envs.New_Env (Outer => Env); + for I in 0 .. Bindings'Length / 2 - 1 loop + Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), Env)); + -- This call checks key kind. + end loop; + Ast := Ast.Sequence.all.Data (3); + goto Restart; + end; + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "do" then + Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); + declare + Result : Types.T; + begin + for I in 2 .. Ast.Sequence.all.Length - 1 loop + Result := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + pragma Unreferenced (Result); + end; + Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); + goto Restart; + elsif First.Str.all = "fn*" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Params : Types.T renames Ast.Sequence.all.Data (2); + begin + Err.Check (Params.Kind in Types.Kind_Sequence, + "first argument of fn* must be a sequence"); + return (Kind_Fn, Types.Fns.New_Function + (Params => Params.Sequence, + Ast => Ast.Sequence.all.Data (3), + Env => Env)); + end; + else + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + First := Env.all.Get (First.Str); + end if; + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + null; + when Types.Kind_Sequence | Kind_Map => + -- Lists are definitely worth a recursion, and the two other + -- cases should be rare (they will report an error later). + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + Err.Check (First.Kind in Types.Kind_Function, + "first element must be a function"); + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + if First.Kind = Kind_Builtin then + return First.Builtin.all (Args); + end if; + -- Like Types.Fns.Apply, except that we use TCO. + Env := Envs.New_Env (Outer => First.Fn.all.Env); + Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, + Exprs => Args); + Ast := First.Fn.all.Ast; + goto Restart; + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + procedure Exec (Script : in String; + Env : in Envs.Ptr) + is + Result : Types.T; + begin + for Expression of Reader.Read_Str (Script) loop + Result := Eval (Expression, Env); + end loop; + pragma Unreferenced (Result); + end Exec; + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + Startup : constant String + := "(def! not (fn* (a) (if a false true)))" + & "(def! load-file (fn* (f)" + & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"; + Repl : constant Envs.Ptr := Envs.New_Env; + function Eval_Builtin (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return Eval (Args (Args'First), Repl); + end Eval_Builtin; + Script : constant Boolean := 0 < ACL.Argument_Count; + Argv : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); +begin + -- Show the Eval function to other packages. + Types.Fns.Eval_Cb := Eval'Unrestricted_Access; + -- Add Core functions into the top environment. + Core.NS_Add_To_Repl (Repl); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), + (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); + -- Native startup procedure. + Exec (Startup, Repl); + -- Define ARGV from command line arguments. + for I in 2 .. ACL.Argument_Count loop + Argv.all.Data (I - 1) := (Kind_String, + Types.Strings.Alloc (ACL.Argument (I))); + end loop; + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), + (Kind_List, Argv)); + -- Execute user commands. + if Script then + Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); + else + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + end if; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step6_File; diff --git a/impls/ada.2/step7_quote.adb b/impls/ada.2/step7_quote.adb new file mode 100644 index 0000000000..10941a059a --- /dev/null +++ b/impls/ada.2/step7_quote.adb @@ -0,0 +1,375 @@ +with Ada.Command_Line; +with Ada.Text_IO.Unbounded_IO; + +with Core; +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step7_Quote is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + package ACL renames Ada.Command_Line; + + function Read return Types.T_Array with Inline; + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T; + function Eval_Builtin (Args : in Types.T_Array) return Types.T; + -- The built-in variant needs to see the Repl variable. + + function Quasiquote (Ast : in Types.T) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + procedure Exec (Script : in String; + Env : in Envs.Ptr) with Inline; + -- Read the script, eval its elements, but ignore the result. + + ---------------------------------------------------------------------- + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T + is + -- Use local variables, that can be rewritten when tail call + -- optimization goes to <>. + Ast : Types.T := Ast0; + Env : Envs.Ptr := Env0; + First : Types.T; + begin + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "if" then + Err.Check (Ast.Sequence.all.Length in 3 .. 4, + "expected 2 or 3 parameters"); + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; + elsif First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + Env := Envs.New_Env (Outer => Env); + for I in 0 .. Bindings'Length / 2 - 1 loop + Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), Env)); + -- This call checks key kind. + end loop; + Ast := Ast.Sequence.all.Data (3); + goto Restart; + end; + elsif First.Str.all = "quote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "do" then + Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); + declare + Result : Types.T; + begin + for I in 2 .. Ast.Sequence.all.Length - 1 loop + Result := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + pragma Unreferenced (Result); + end; + Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); + goto Restart; + elsif First.Str.all = "fn*" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Params : Types.T renames Ast.Sequence.all.Data (2); + begin + Err.Check (Params.Kind in Types.Kind_Sequence, + "first argument of fn* must be a sequence"); + return (Kind_Fn, Types.Fns.New_Function + (Params => Params.Sequence, + Ast => Ast.Sequence.all.Data (3), + Env => Env)); + end; + elsif First.Str.all = "quasiquote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; + else + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + First := Env.all.Get (First.Str); + end if; + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + null; + when Types.Kind_Sequence | Kind_Map => + -- Lists are definitely worth a recursion, and the two other + -- cases should be rare (they will report an error later). + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + Err.Check (First.Kind in Types.Kind_Function, + "first element must be a function"); + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + if First.Kind = Kind_Builtin then + return First.Builtin.all (Args); + end if; + -- Like Types.Fns.Apply, except that we use TCO. + Env := Envs.New_Env (Outer => First.Fn.all.Env); + Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, + Exprs => Args); + Ast := First.Fn.all.Ast; + goto Restart; + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + procedure Exec (Script : in String; + Env : in Envs.Ptr) + is + Result : Types.T; + begin + for Expression of Reader.Read_Str (Script) loop + Result := Eval (Expression, Env); + end loop; + pragma Unreferenced (Result); + end Exec; + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Quasiquote (Ast : in Types.T) return Types.T is + + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; + + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); + begin + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") + then + Err.Check (Elt.Sequence.all.Length = 2, + "splice-unquote expects 1 parameter"); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); + else + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); + end if; + end loop; + return Result; + end Qq_Seq; + + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin + case Ast.Kind is + when Kind_List => + if Starts_With (Ast.Sequence.all.Data, "unquote") then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + else + return Qq_Seq; + end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); + when others => + return Ast; + end case; + exception + when Err.Error => + Err.Add_Trace_Line ("quasiquote", Ast); + raise; + end Quasiquote; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + Startup : constant String + := "(def! not (fn* (a) (if a false true)))" + & "(def! load-file (fn* (f)" + & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"; + Repl : constant Envs.Ptr := Envs.New_Env; + function Eval_Builtin (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return Eval (Args (Args'First), Repl); + end Eval_Builtin; + Script : constant Boolean := 0 < ACL.Argument_Count; + Argv : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); +begin + -- Show the Eval function to other packages. + Types.Fns.Eval_Cb := Eval'Unrestricted_Access; + -- Add Core functions into the top environment. + Core.NS_Add_To_Repl (Repl); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), + (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); + -- Native startup procedure. + Exec (Startup, Repl); + -- Define ARGV from command line arguments. + for I in 2 .. ACL.Argument_Count loop + Argv.all.Data (I - 1) := (Kind_String, + Types.Strings.Alloc (ACL.Argument (I))); + end loop; + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), + (Kind_List, Argv)); + -- Execute user commands. + if Script then + Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); + else + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + end if; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step7_Quote; diff --git a/impls/ada.2/step8_macros.adb b/impls/ada.2/step8_macros.adb new file mode 100644 index 0000000000..4b0633c4bb --- /dev/null +++ b/impls/ada.2/step8_macros.adb @@ -0,0 +1,406 @@ +with Ada.Command_Line; +with Ada.Text_IO.Unbounded_IO; + +with Core; +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step8_Macros is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + package ACL renames Ada.Command_Line; + + function Read return Types.T_Array with Inline; + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T; + function Eval_Builtin (Args : in Types.T_Array) return Types.T; + -- The built-in variant needs to see the Repl variable. + + function Quasiquote (Ast : in Types.T) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + procedure Exec (Script : in String; + Env : in Envs.Ptr) with Inline; + -- Read the script, eval its elements, but ignore the result. + + ---------------------------------------------------------------------- + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T + is + -- Use local variables, that can be rewritten when tail call + -- optimization goes to <>. + Ast : Types.T := Ast0; + Env : Envs.Ptr := Env0; + First : Types.T; + begin + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "if" then + Err.Check (Ast.Sequence.all.Length in 3 .. 4, + "expected 2 or 3 parameters"); + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; + elsif First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + Env := Envs.New_Env (Outer => Env); + for I in 0 .. Bindings'Length / 2 - 1 loop + Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), Env)); + -- This call checks key kind. + end loop; + Ast := Ast.Sequence.all.Data (3); + goto Restart; + end; + elsif First.Str.all = "quote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "defmacro!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Fun : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + Val : Types.T; + begin + Err.Check (Fun.Kind = Kind_Fn, "expected a function"); + Val := (Kind_Macro, Types.Fns.New_Function + (Params => Fun.Fn.all.Params, + Ast => Fun.Fn.all.Ast, + Env => Fun.Fn.all.Env)); + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "do" then + Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); + declare + Result : Types.T; + begin + for I in 2 .. Ast.Sequence.all.Length - 1 loop + Result := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + pragma Unreferenced (Result); + end; + Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); + goto Restart; + elsif First.Str.all = "fn*" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Params : Types.T renames Ast.Sequence.all.Data (2); + begin + Err.Check (Params.Kind in Types.Kind_Sequence, + "first argument of fn* must be a sequence"); + return (Kind_Fn, Types.Fns.New_Function + (Params => Params.Sequence, + Ast => Ast.Sequence.all.Data (3), + Env => Env)); + end; + elsif First.Str.all = "quasiquote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; + else + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + First := Env.all.Get (First.Str); + end if; + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + null; + when Types.Kind_Sequence | Kind_Map => + -- Lists are definitely worth a recursion, and the two other + -- cases should be rare (they will report an error later). + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + case First.Kind is + when Kind_Macro => + -- Use the unevaluated arguments. + Ast := First.Fn.all.Apply + (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); + -- Then evaluate the result with TCO. + goto Restart; + when Types.Kind_Function => + null; + when others => + Err.Raise_With ("first element must be a function or macro"); + end case; + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + if First.Kind = Kind_Builtin then + return First.Builtin.all (Args); + end if; + -- Like Types.Fns.Apply, except that we use TCO. + Env := Envs.New_Env (Outer => First.Fn.all.Env); + Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, + Exprs => Args); + Ast := First.Fn.all.Ast; + goto Restart; + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + procedure Exec (Script : in String; + Env : in Envs.Ptr) + is + Result : Types.T; + begin + for Expression of Reader.Read_Str (Script) loop + Result := Eval (Expression, Env); + end loop; + pragma Unreferenced (Result); + end Exec; + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Quasiquote (Ast : in Types.T) return Types.T is + + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; + + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); + begin + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") + then + Err.Check (Elt.Sequence.all.Length = 2, + "splice-unquote expects 1 parameter"); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); + else + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); + end if; + end loop; + return Result; + end Qq_Seq; + + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin + case Ast.Kind is + when Kind_List => + if Starts_With (Ast.Sequence.all.Data, "unquote") then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + else + return Qq_Seq; + end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); + when others => + return Ast; + end case; + exception + when Err.Error => + Err.Add_Trace_Line ("quasiquote", Ast); + raise; + end Quasiquote; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + Startup : constant String + := "(def! not (fn* (a) (if a false true)))" + & "(def! load-file (fn* (f)" + & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" + & "(defmacro! cond (fn* (& xs)" + & " (if (> (count xs) 0)" + & " (list 'if (first xs)" + & " (if (> (count xs) 1) (nth xs 1)" + & " (throw ""odd number of forms to cond""))" + & " (cons 'cond (rest (rest xs)))))))"; + Repl : constant Envs.Ptr := Envs.New_Env; + function Eval_Builtin (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return Eval (Args (Args'First), Repl); + end Eval_Builtin; + Script : constant Boolean := 0 < ACL.Argument_Count; + Argv : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); +begin + -- Show the Eval function to other packages. + Types.Fns.Eval_Cb := Eval'Unrestricted_Access; + -- Add Core functions into the top environment. + Core.NS_Add_To_Repl (Repl); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), + (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); + -- Native startup procedure. + Exec (Startup, Repl); + -- Define ARGV from command line arguments. + for I in 2 .. ACL.Argument_Count loop + Argv.all.Data (I - 1) := (Kind_String, + Types.Strings.Alloc (ACL.Argument (I))); + end loop; + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), + (Kind_List, Argv)); + -- Execute user commands. + if Script then + Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); + else + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + end if; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step8_Macros; diff --git a/impls/ada.2/step9_try.adb b/impls/ada.2/step9_try.adb new file mode 100644 index 0000000000..b6b2928287 --- /dev/null +++ b/impls/ada.2/step9_try.adb @@ -0,0 +1,433 @@ +with Ada.Command_Line; +with Ada.Text_IO.Unbounded_IO; + +with Core; +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure Step9_Try is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + package ACL renames Ada.Command_Line; + + function Read return Types.T_Array with Inline; + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T; + function Eval_Builtin (Args : in Types.T_Array) return Types.T; + -- The built-in variant needs to see the Repl variable. + + function Quasiquote (Ast : in Types.T) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + procedure Exec (Script : in String; + Env : in Envs.Ptr) with Inline; + -- Read the script, eval its elements, but ignore the result. + + ---------------------------------------------------------------------- + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T + is + -- Use local variables, that can be rewritten when tail call + -- optimization goes to <>. + Ast : Types.T := Ast0; + Env : Envs.Ptr := Env0; + First : Types.T; + begin + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "if" then + Err.Check (Ast.Sequence.all.Length in 3 .. 4, + "expected 2 or 3 parameters"); + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; + elsif First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + Env := Envs.New_Env (Outer => Env); + for I in 0 .. Bindings'Length / 2 - 1 loop + Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), Env)); + -- This call checks key kind. + end loop; + Ast := Ast.Sequence.all.Data (3); + goto Restart; + end; + elsif First.Str.all = "quote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "defmacro!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Fun : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + Val : Types.T; + begin + Err.Check (Fun.Kind = Kind_Fn, "expected a function"); + Val := (Kind_Macro, Types.Fns.New_Function + (Params => Fun.Fn.all.Params, + Ast => Fun.Fn.all.Ast, + Env => Fun.Fn.all.Env)); + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "do" then + Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); + declare + Result : Types.T; + begin + for I in 2 .. Ast.Sequence.all.Length - 1 loop + Result := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + pragma Unreferenced (Result); + end; + Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); + goto Restart; + elsif First.Str.all = "fn*" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Params : Types.T renames Ast.Sequence.all.Data (2); + begin + Err.Check (Params.Kind in Types.Kind_Sequence, + "first argument of fn* must be a sequence"); + return (Kind_Fn, Types.Fns.New_Function + (Params => Params.Sequence, + Ast => Ast.Sequence.all.Data (3), + Env => Env)); + end; + elsif First.Str.all = "quasiquote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; + elsif First.Str.all = "try*" then + if Ast.Sequence.all.Length = 2 then + Ast := Ast.Sequence.all.Data (2); + goto Restart; + end if; + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (3).Kind = Kind_List, + "expected 1 parameter, maybe followed by a list"); + declare + A3 : Types.T_Array + renames Ast.Sequence.all.Data (3).Sequence.all.Data; + begin + Err.Check (A3'Length = 3 + and then A3 (A3'First).Kind = Kind_Symbol + and then A3 (A3'First).Str.all = "catch*", + "3rd parameter if present must be a catch* list"); + begin + return Eval (Ast.Sequence.all.Data (2), Env); + exception + when Err.Error => + null; + end; + Env := Envs.New_Env (Outer => Env); + Env.all.Set (A3 (A3'First + 1), Err.Data); -- check key kind + Ast := A3 (A3'Last); + goto Restart; + end; + else + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + First := Env.all.Get (First.Str); + end if; + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + null; + when Types.Kind_Sequence | Kind_Map => + -- Lists are definitely worth a recursion, and the two other + -- cases should be rare (they will report an error later). + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + case First.Kind is + when Kind_Macro => + -- Use the unevaluated arguments. + Ast := First.Fn.all.Apply + (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); + -- Then evaluate the result with TCO. + goto Restart; + when Types.Kind_Function => + null; + when others => + Err.Raise_With ("first element must be a function or macro"); + end case; + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + if First.Kind = Kind_Builtin then + return First.Builtin.all (Args); + end if; + -- Like Types.Fns.Apply, except that we use TCO. + Env := Envs.New_Env (Outer => First.Fn.all.Env); + Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, + Exprs => Args); + Ast := First.Fn.all.Ast; + goto Restart; + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + procedure Exec (Script : in String; + Env : in Envs.Ptr) + is + Result : Types.T; + begin + for Expression of Reader.Read_Str (Script) loop + Result := Eval (Expression, Env); + end loop; + pragma Unreferenced (Result); + end Exec; + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Quasiquote (Ast : in Types.T) return Types.T is + + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; + + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); + begin + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") + then + Err.Check (Elt.Sequence.all.Length = 2, + "splice-unquote expects 1 parameter"); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); + else + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); + end if; + end loop; + return Result; + end Qq_Seq; + + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin + case Ast.Kind is + when Kind_List => + if Starts_With (Ast.Sequence.all.Data, "unquote") then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + else + return Qq_Seq; + end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); + when others => + return Ast; + end case; + exception + when Err.Error => + Err.Add_Trace_Line ("quasiquote", Ast); + raise; + end Quasiquote; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + Startup : constant String + := "(def! not (fn* (a) (if a false true)))" + & "(def! load-file (fn* (f)" + & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" + & "(defmacro! cond (fn* (& xs)" + & " (if (> (count xs) 0)" + & " (list 'if (first xs)" + & " (if (> (count xs) 1) (nth xs 1)" + & " (throw ""odd number of forms to cond""))" + & " (cons 'cond (rest (rest xs)))))))"; + Repl : constant Envs.Ptr := Envs.New_Env; + function Eval_Builtin (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return Eval (Args (Args'First), Repl); + end Eval_Builtin; + Script : constant Boolean := 0 < ACL.Argument_Count; + Argv : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); +begin + -- Show the Eval function to other packages. + Types.Fns.Eval_Cb := Eval'Unrestricted_Access; + -- Add Core functions into the top environment. + Core.NS_Add_To_Repl (Repl); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), + (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); + -- Native startup procedure. + Exec (Startup, Repl); + -- Define ARGV from command line arguments. + for I in 2 .. ACL.Argument_Count loop + Argv.all.Data (I - 1) := (Kind_String, + Types.Strings.Alloc (ACL.Argument (I))); + end loop; + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), + (Kind_List, Argv)); + -- Execute user commands. + if Script then + Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); + else + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + end if; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end Step9_Try; diff --git a/impls/ada.2/stepa_mal.adb b/impls/ada.2/stepa_mal.adb new file mode 100644 index 0000000000..620e0fa341 --- /dev/null +++ b/impls/ada.2/stepa_mal.adb @@ -0,0 +1,441 @@ +with Ada.Command_Line; +with Ada.Text_IO.Unbounded_IO; + +with Core; +with Envs; +with Err; +with Garbage_Collected; +with Printer; +with Reader; +with Readline; +with Types.Builtins; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +with Types.Strings; + +procedure StepA_Mal is + + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); + + use type Types.T; + use all type Types.Kind_Type; + use type Types.Strings.Instance; + package ACL renames Ada.Command_Line; + + function Read return Types.T_Array with Inline; + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T; + function Eval_Builtin (Args : in Types.T_Array) return Types.T; + -- The built-in variant needs to see the Repl variable. + + function Quasiquote (Ast : in Types.T) return Types.T; + + procedure Print (Ast : in Types.T) with Inline; + + procedure Rep (Env : in Envs.Ptr) with Inline; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T; + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T; + -- Helpers for the Eval function. + + procedure Exec (Script : in String; + Env : in Envs.Ptr) with Inline; + -- Read the script, eval its elements, but ignore the result. + + ---------------------------------------------------------------------- + + function Eval (Ast0 : in Types.T; + Env0 : in Envs.Ptr) return Types.T + is + -- Use local variables, that can be rewritten when tail call + -- optimization goes to <>. + Ast : Types.T := Ast0; + Env : Envs.Ptr := Env0; + First : Types.T; + begin + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then + Ada.Text_IO.Put ("EVAL: "); + Print (Ast); + Envs.Dump_Stack (Env.all); + end if; + + case Ast.Kind is + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + return Ast; + when Kind_Symbol => + return Env.all.Get (Ast.Str); + when Kind_Map => + return Eval_Map (Ast.Map.all, Env); + when Kind_Vector => + return Eval_Vector (Ast.Sequence.all, Env); + when Kind_List => + null; + end case; + + -- Ast is a list. + if Ast.Sequence.all.Length = 0 then + return Ast; + end if; + First := Ast.Sequence.all.Data (1); + + -- Special forms + -- Ast is a non-empty list, First is its first element. + case First.Kind is + when Kind_Symbol => + if First.Str.all = "if" then + Err.Check (Ast.Sequence.all.Length in 3 .. 4, + "expected 2 or 3 parameters"); + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; + elsif First.Str.all = "let*" then + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, + "expected a sequence then a value"); + declare + Bindings : Types.T_Array + renames Ast.Sequence.all.Data (2).Sequence.all.Data; + begin + Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); + Env := Envs.New_Env (Outer => Env); + for I in 0 .. Bindings'Length / 2 - 1 loop + Env.all.Set (Bindings (Bindings'First + 2 * I), + Eval (Bindings (Bindings'First + 2 * I + 1), Env)); + -- This call checks key kind. + end loop; + Ast := Ast.Sequence.all.Data (3); + goto Restart; + end; + elsif First.Str.all = "quote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + elsif First.Str.all = "def!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + begin + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "defmacro!" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Key : Types.T renames Ast.Sequence.all.Data (2); + Fun : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); + Val : Types.T; + begin + Err.Check (Fun.Kind = Kind_Fn, "expected a function"); + Val := (Kind_Macro, Types.Fns.New_Function + (Params => Fun.Fn.all.Params, + Ast => Fun.Fn.all.Ast, + Env => Fun.Fn.all.Env)); + Env.all.Set (Key, Val); -- Check key kind. + return Val; + end; + elsif First.Str.all = "do" then + Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); + declare + Result : Types.T; + begin + for I in 2 .. Ast.Sequence.all.Length - 1 loop + Result := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + pragma Unreferenced (Result); + end; + Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); + goto Restart; + elsif First.Str.all = "fn*" then + Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); + declare + Params : Types.T renames Ast.Sequence.all.Data (2); + begin + Err.Check (Params.Kind in Types.Kind_Sequence, + "first argument of fn* must be a sequence"); + return (Kind_Fn, Types.Fns.New_Function + (Params => Params.Sequence, + Ast => Ast.Sequence.all.Data (3), + Env => Env)); + end; + elsif First.Str.all = "quasiquote" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; + elsif First.Str.all = "try*" then + if Ast.Sequence.all.Length = 2 then + Ast := Ast.Sequence.all.Data (2); + goto Restart; + end if; + Err.Check (Ast.Sequence.all.Length = 3 + and then Ast.Sequence.all.Data (3).Kind = Kind_List, + "expected 1 parameter, maybe followed by a list"); + declare + A3 : Types.T_Array + renames Ast.Sequence.all.Data (3).Sequence.all.Data; + begin + Err.Check (A3'Length = 3 + and then A3 (A3'First).Kind = Kind_Symbol + and then A3 (A3'First).Str.all = "catch*", + "3rd parameter if present must be a catch* list"); + begin + return Eval (Ast.Sequence.all.Data (2), Env); + exception + when Err.Error => + null; + end; + Env := Envs.New_Env (Outer => Env); + Env.all.Set (A3 (A3'First + 1), Err.Data); -- check key kind + Ast := A3 (A3'Last); + goto Restart; + end; + else + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + First := Env.all.Get (First.Str); + end if; + when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key + | Kind_Macro | Types.Kind_Function => + -- Equivalent to First := Eval (First, Env) + -- except that we already know enough to spare a recursive call. + null; + when Types.Kind_Sequence | Kind_Map => + -- Lists are definitely worth a recursion, and the two other + -- cases should be rare (they will report an error later). + First := Eval (First, Env); + end case; + + -- Apply phase. + -- Ast is a non-empty list, + -- First is its non-special evaluated first element. + case First.Kind is + when Kind_Macro => + -- Use the unevaluated arguments. + Ast := First.Fn.all.Apply + (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); + -- Then evaluate the result with TCO. + goto Restart; + when Types.Kind_Function => + null; + when others => + Err.Raise_With ("first element must be a function or macro"); + end case; + -- We are applying a function. Evaluate its arguments. + declare + Args : Types.T_Array (2 .. Ast.Sequence.all.Length); + begin + for I in Args'Range loop + Args (I) := Eval (Ast.Sequence.all.Data (I), Env); + end loop; + case First.Kind is + when Kind_Builtin => + return First.Builtin.all (Args); + when Kind_Builtin_With_Meta => + return First.Builtin_With_Meta.all.Builtin.all (Args); + when others => + null; + end case; + -- Like Types.Fns.Apply, except that we use TCO. + Env := Envs.New_Env (Outer => First.Fn.all.Env); + Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, + Exprs => Args); + Ast := First.Fn.all.Ast; + goto Restart; + end; + exception + when Err.Error => + Err.Add_Trace_Line ("eval", Ast); + raise; + end Eval; + + function Eval_Map (Source : in Types.Maps.Instance; + Env : in Envs.Ptr) return Types.T + is + use all type Types.Maps.Cursor; + -- Copy the whole map so that keys are not hashed again. + Result : constant Types.T := Types.Maps.New_Map (Source); + Position : Types.Maps.Cursor := Result.Map.all.First; + begin + while Has_Element (Position) loop + Result.Map.all.Replace_Element (Position, + Eval (Element (Position), Env)); + Next (Position); + end loop; + return Result; + end Eval_Map; + + function Eval_Vector (Source : in Types.Sequences.Instance; + Env : in Envs.Ptr) return Types.T + is + Ref : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Source.Length); + begin + for I in Source.Data'Range loop + Ref.all.Data (I) := Eval (Source.Data (I), Env); + end loop; + return (Kind_Vector, Ref); + end Eval_Vector; + + procedure Exec (Script : in String; + Env : in Envs.Ptr) + is + Result : Types.T; + begin + for Expression of Reader.Read_Str (Script) loop + Result := Eval (Expression, Env); + end loop; + pragma Unreferenced (Result); + end Exec; + + procedure Print (Ast : in Types.T) is + begin + Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); + end Print; + + function Quasiquote (Ast : in Types.T) return Types.T is + + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; + + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); + begin + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") + then + Err.Check (Elt.Sequence.all.Length = 2, + "splice-unquote expects 1 parameter"); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); + else + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); + end if; + end loop; + return Result; + end Qq_Seq; + + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin + case Ast.Kind is + when Kind_List => + if Starts_With (Ast.Sequence.all.Data, "unquote") then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Ast.Sequence.all.Data (2); + else + return Qq_Seq; + end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); + when others => + return Ast; + end case; + exception + when Err.Error => + Err.Add_Trace_Line ("quasiquote", Ast); + raise; + end Quasiquote; + + function Read return Types.T_Array + is (Reader.Read_Str (Readline.Input ("user> "))); + + procedure Rep (Env : in Envs.Ptr) is + begin + for Expression of Read loop + Print (Eval (Expression, Env)); + end loop; + end Rep; + + ---------------------------------------------------------------------- + + Startup : constant String + := "(def! not (fn* (a) (if a false true)))" + & "(def! load-file (fn* (f)" + & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" + & "(defmacro! cond (fn* (& xs)" + & " (if (> (count xs) 0)" + & " (list 'if (first xs)" + & " (if (> (count xs) 1) (nth xs 1)" + & " (throw ""odd number of forms to cond""))" + & " (cons 'cond (rest (rest xs)))))))" + & "(def! *host-language* ""ada.2"")"; + Repl : constant Envs.Ptr := Envs.New_Env; + function Eval_Builtin (Args : in Types.T_Array) return Types.T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + return Eval (Args (Args'First), Repl); + end Eval_Builtin; + Script : constant Boolean := 0 < ACL.Argument_Count; + Argv : constant Types.Sequence_Ptr + := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); +begin + -- Show the Eval function to other packages. + Types.Fns.Eval_Cb := Eval'Unrestricted_Access; + -- Add Core functions into the top environment. + Core.NS_Add_To_Repl (Repl); + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), + (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); + -- Native startup procedure. + Exec (Startup, Repl); + -- Define ARGV from command line arguments. + for I in 2 .. ACL.Argument_Count loop + Argv.all.Data (I - 1) := (Kind_String, + Types.Strings.Alloc (ACL.Argument (I))); + end loop; + Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), + (Kind_List, Argv)); + -- Execute user commands. + if Script then + Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); + else + Exec ("(println (str ""Mal ["" *host-language* ""]""))", Repl); + loop + begin + Rep (Repl); + exception + when Readline.End_Of_File => + exit; + when Err.Error => + Ada.Text_IO.Unbounded_IO.Put (Err.Trace); + end; + -- Other exceptions are really unexpected. + + -- Collect garbage. + Err.Data := Types.Nil; + Repl.all.Keep; + Dbgeval.Keep; + Garbage_Collected.Clean; + end loop; + Ada.Text_IO.New_Line; + end if; + + -- If assertions are enabled, check deallocations. + -- Normal runs do not need to deallocate before termination. + -- Beware that all pointers are now dangling. + pragma Debug (Garbage_Collected.Clean); + Garbage_Collected.Check_Allocations; +end StepA_Mal; diff --git a/impls/ada.2/types-atoms.adb b/impls/ada.2/types-atoms.adb new file mode 100644 index 0000000000..848cf54592 --- /dev/null +++ b/impls/ada.2/types-atoms.adb @@ -0,0 +1,65 @@ +with Err; +with Types.Builtins; +with Types.Fns; + +package body Types.Atoms is + + function Atom (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + declare + Ref : constant Atom_Ptr := new Instance; + begin + Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); + Ref.all.Data := Args (Args'First); + return (Kind_Atom, Ref); + end; + end Atom; + + function Deref (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Atom, + "expected an atom"); + return Args (Args'First).Atom.all.Data; + end Deref; + + function Deref (Item : in Instance) return T + is (Item.Data); + + procedure Keep_References (Object : in out Instance) is + begin + Keep (Object.Data); + end Keep_References; + + function Reset (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Atom, + "expected an atom then a value"); + Args (Args'First).Atom.all.Data := Args (Args'Last); + return Args (Args'Last); + end Reset; + + function Swap (Args : in T_Array) return T is + begin + Err.Check (2 <= Args'Length and then Args (Args'First).Kind = Kind_Atom, + "expected an atom, a function, then optional arguments"); + declare + X : T renames Args (Args'First).Atom.all.Data; + F : T renames Args (Args'First + 1); + A : constant T_Array := X & Args (Args'First + 2 .. Args'Last); + begin + case F.Kind is + when Kind_Builtin => + X := F.Builtin.all (A); + when Kind_Builtin_With_Meta => + X := F.Builtin_With_Meta.all.Builtin.all (A); + when Kind_Fn => + X := F.Fn.all.Apply (A); + when others => + Err.Raise_With ("parameter 2 must be a function"); + end case; + return X; + end; + end Swap; + +end Types.Atoms; diff --git a/impls/ada.2/types-atoms.ads b/impls/ada.2/types-atoms.ads new file mode 100644 index 0000000000..8764ad4442 --- /dev/null +++ b/impls/ada.2/types-atoms.ads @@ -0,0 +1,24 @@ +with Garbage_Collected; + +package Types.Atoms is + + type Instance (<>) is abstract new Garbage_Collected.Instance with private; + + -- Built-in functions. + function Atom (Args : in T_Array) return T; + function Deref (Args : in T_Array) return T; + function Reset (Args : in T_Array) return T; + function Swap (Args : in T_Array) return T; + + -- Helper for print. + function Deref (Item : in Instance) return T with Inline; + +private + + type Instance is new Garbage_Collected.Instance with record + Data : T; + end record; + + overriding procedure Keep_References (Object : in out Instance) with Inline; + +end Types.Atoms; diff --git a/impls/ada.2/types-builtins.adb b/impls/ada.2/types-builtins.adb new file mode 100644 index 0000000000..cd85b526a5 --- /dev/null +++ b/impls/ada.2/types-builtins.adb @@ -0,0 +1,31 @@ +package body Types.Builtins is + + function Builtin (Item : in Instance) return Builtin_Ptr + is (Item.F_Builtin); + + procedure Keep_References (Object : in out Instance) is + begin + Keep (Object.F_Meta); + end Keep_References; + + function Meta (Item : in Instance) return T + is (Item.F_Meta); + + function With_Meta (Builtin : in Builtin_Ptr; + Metadata : in T) return T + is + -- Builtin is not null and requires an immediate initialization. + Ref : constant Builtin_With_Meta_Ptr + := new Instance'(Garbage_Collected.Instance with + F_Builtin => Builtin, + F_Meta => Metadata); + begin + Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); + return (Kind_Builtin_With_Meta, Ref); + end With_Meta; + + function With_Meta (Builtin : in Instance; + Metadata : in T) return T + is (With_Meta (Builtin.F_Builtin, Metadata)); + +end Types.Builtins; diff --git a/impls/ada.2/types-builtins.ads b/impls/ada.2/types-builtins.ads new file mode 100644 index 0000000000..3da6a1c8f8 --- /dev/null +++ b/impls/ada.2/types-builtins.ads @@ -0,0 +1,28 @@ +with Garbage_Collected; + +package Types.Builtins is + + -- Types.Mal.Builtin_Ptr is efficient and sufficient for most + -- purposes, as native function need no deallocation. The type + -- below is only useful to add metadata to a built-in. + + type Instance (<>) is abstract new Garbage_Collected.Instance with private; + + function With_Meta (Builtin : in Builtin_Ptr; + Metadata : in T) return T with Inline; + function With_Meta (Builtin : in Instance; + Metadata : in T) return T with Inline; + + function Meta (Item : in Instance) return T with Inline; + function Builtin (Item : in Instance) return Builtin_Ptr with Inline; + +private + + type Instance is new Garbage_Collected.Instance with record + F_Builtin : Builtin_Ptr; + F_Meta : T; + end record; + + overriding procedure Keep_References (Object : in out Instance) with Inline; + +end Types.Builtins; diff --git a/impls/ada.2/types-fns.adb b/impls/ada.2/types-fns.adb new file mode 100644 index 0000000000..6deb6e063d --- /dev/null +++ b/impls/ada.2/types-fns.adb @@ -0,0 +1,59 @@ +with Err; +pragma Warnings (Off, "unit ""Types.Sequences"" is not referenced"); +with Types.Sequences; +pragma Warnings (On, "unit ""Types.Sequences"" is not referenced"); + +package body Types.Fns is + + function Apply (Item : in Instance; + Args : in T_Array) return T + is + Env : constant Envs.Ptr := Envs.New_Env (Outer => Item.F_Env); + begin + Env.all.Set_Binds (Binds => Item.F_Params.all.Data, + Exprs => Args); + return Eval_Cb.all (Ast => Item.F_Ast, + Env => Env); + end Apply; + + function Ast (Item : in Instance) return T + is (Item.F_Ast); + + function Env (Item : in Instance) return Envs.Ptr + is (Item.F_Env); + + procedure Keep_References (Object : in out Instance) is + begin + Keep (Object.F_Ast); + Object.F_Params.all.Keep; + Object.F_Env.all.Keep; + Keep (Object.F_Meta); + end Keep_References; + + function Meta (Item : in Instance) return T + is (Item.F_Meta); + + function New_Function (Params : in Sequence_Ptr; + Ast : in T; + Env : in Envs.Ptr; + Metadata : in T := Nil) return Fn_Ptr + is + -- Env and Params are not null and require an immediate + -- initialization. + Ref : constant Fn_Ptr + := new Instance'(Garbage_Collected.Instance with + F_Ast => Ast, + F_Env => Env, + F_Meta => Metadata, + F_Params => Params); + begin + Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); + Err.Check ((for all P of Params.all.Data => P.Kind = Kind_Symbol), + "formal parameters must be symbols"); + return Ref; + end New_Function; + + function Params (Item : in Instance) return Sequence_Ptr + is (Item.F_Params); + +end Types.Fns; diff --git a/impls/ada.2/types-fns.ads b/impls/ada.2/types-fns.ads new file mode 100644 index 0000000000..7a0b8f56ca --- /dev/null +++ b/impls/ada.2/types-fns.ads @@ -0,0 +1,45 @@ +with Envs; +with Garbage_Collected; + +package Types.Fns is + + Eval_Cb : access function (Ast : in T; + Env : in Envs.Ptr) return T; + -- The main program must register this global callback to the main + -- eval function before Apply is called. + + type Instance (<>) is abstract new Garbage_Collected.Instance with private; + + function New_Function (Params : in Sequence_Ptr; + Ast : in T; + Env : in Envs.Ptr; + Metadata : in T := Nil) return Fn_Ptr + with Inline; + -- Raise an exception if Params contains something else than symbols. + + function Params (Item : in Instance) return Sequence_Ptr + with Inline; + function Ast (Item : in Instance) return T with Inline; + -- Useful to print. + + function Apply (Item : in Instance; + Args : in T_Array) return T with Inline; + -- Duplicated in the step files because of TCO. + + function Env (Item : in Instance) return Envs.Ptr with Inline; + -- Required for TCO, instead of Apply. + + function Meta (Item : in Instance) return T with Inline; + +private + + type Instance is new Garbage_Collected.Instance + with record + F_Ast : T; + F_Env : Envs.Ptr; + F_Meta : T; + F_Params : Sequence_Ptr; + end record; + overriding procedure Keep_References (Object : in out Instance) with Inline; + +end Types.Fns; diff --git a/impls/ada.2/types-maps.adb b/impls/ada.2/types-maps.adb new file mode 100644 index 0000000000..1b9f939877 --- /dev/null +++ b/impls/ada.2/types-maps.adb @@ -0,0 +1,200 @@ +with Err; +with Types.Sequences; +with Types.Strings; + +package body Types.Maps is + + use type HM.Map; + + function Assoc (Initial : in HM.Map; + Bind : in T_Array) return T; + + function Constructor return Map_Ptr with Inline; + + ---------------------------------------------------------------------- + + function "=" (Left, Right : in Instance) return Boolean + is (Left.Data = Right.Data); + + function Assoc (Initial : in HM.Map; + Bind : in T_Array) return T + is + begin + Err.Check (Bind'Length mod 2 = 0, "expected an even bind count"); + declare + Len : constant Natural := Bind'Length / 2; + Ref : constant Map_Ptr := Constructor; + begin + Ref.all.Data := Initial; + for I in 0 .. Len - 1 loop + Ref.all.Data.Include (Bind (Bind'First + 2 * I), + Bind (Bind'First + 2 * I + 1)); + end loop; + return (Kind_Map, Ref); + end; + end Assoc; + + function Assoc (Args : in T_Array) return T is + begin + Err.Check (0 < Args'Length and then Args (Args'First).Kind = Kind_Map, + "first parameter must be a map"); + return Assoc (Args (Args'First).Map.all.Data, + Args (Args'First + 1 .. Args'Last)); + end Assoc; + + function Constructor return Map_Ptr is + Ref : constant Map_Ptr := new Instance; + begin + Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); + return Ref; + end Constructor; + + function Contains (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Map, + "expected a map then a key"); + return (Kind_Boolean, + Args (Args'First).Map.all.Data.Contains (Args (Args'Last))); + end Contains; + + function Dissoc (Args : in T_Array) return T is + begin + Err.Check (0 < Args'Length and then Args (Args'First).Kind = Kind_Map, + "expected a map then keys"); + declare + Ref : constant Map_Ptr := Constructor; + begin + Ref.all.Data := Args (Args'First).Map.all.Data; + for I in Args'First + 1 .. Args'Last loop + Ref.all.Data.Exclude (Args (I)); + -- This call checks the kind of the key. + end loop; + return (Kind_Map, Ref); + end; + end Dissoc; + + function Element (Position : in Cursor) return T + is (HM.Element (HM.Cursor (Position))); + + function First (Container : in Instance) return Cursor + is (Cursor (Container.Data.First)); + + function Get (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 2, "expected 2 parameters"); + case Args (Args'First).Kind is + when Kind_Nil => + Err.Check (Args (Args'Last).Kind in Kind_Key, + "key must be a keyword or string"); + return Nil; + when Kind_Map => + declare + Position : constant HM.Cursor + := Args (Args'First).Map.all.Data.Find (Args (Args'Last)); + begin + if HM.Has_Element (Position) then + return HM.Element (Position); + else + return Nil; + end if; + end; + when others => + Err.Raise_With ("parameter 1 must be nil or a map"); + end case; + end Get; + + function Has_Element (Position : in Cursor) return Boolean + is (HM.Has_Element (HM.Cursor (Position))); + + function Hash (Item : in T) return Ada.Containers.Hash_Type is + begin + Err.Check (Item.Kind in Kind_Key, "keys must be keywords or strings"); + return Strings.Hash (Item.Str); + end Hash; + + function Hash_Map (Args : in T_Array) return T + is (Assoc (HM.Empty_Map, Args)); + + procedure Keep_References (Object : in out Instance) is + begin + for Position in Object.Data.Iterate loop + Keep (HM.Key (Position)); + Keep (HM.Element (Position)); + end loop; + Keep (Object.F_Meta); + end Keep_References; + + function Key (Position : in Cursor) return T + is (HM.Key (HM.Cursor (Position))); + + function Keys (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Map, + "expected a map"); + declare + A1 : HM.Map renames Args (Args'First).Map.all.Data; + Ref : constant Sequence_Ptr + := Sequences.Constructor (Natural (A1.Length)); + I : Positive := 1; + begin + for Position in A1.Iterate loop + Ref.all.Data (I) := HM.Key (Position); + I := I + 1; + end loop; + return (Kind_List, Ref); + end; + end Keys; + + function Meta (Container : in Instance) return T + is (Container.F_Meta); + + procedure Next (Position : in out Cursor) is + begin + HM.Next (HM.Cursor (Position)); + end Next; + + function New_Map (Source : in Instance) return T + is + Ref : constant Map_Ptr := Constructor; + begin + Ref.all.Data := Source.Data; + return (Kind_Map, Ref); + end New_Map; + + procedure Replace_Element (Container : in out Instance; + Position : in Cursor; + New_Item : in T) + is + begin + Container.Data.Replace_Element (HM.Cursor (Position), New_Item); + end Replace_Element; + + function Vals (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Map, + "expected a map"); + declare + A1 : HM.Map renames Args (Args'First).Map.all.Data; + R : constant Sequence_Ptr + := Sequences.Constructor (Natural (A1.Length)); + I : Positive := 1; + begin + for Element of A1 loop + R.all.Data (I) := Element; + I := I + 1; + end loop; + return (Kind_List, R); + end; + end Vals; + + function With_Meta (Container : in Instance; + Metadata : in T) return T + is + Ref : constant Map_Ptr := Constructor; + begin + Ref.all.Data := Container.Data; + Ref.all.F_Meta := Metadata; + return (Kind_Map, Ref); + end With_Meta; + +end Types.Maps; diff --git a/impls/ada.2/types-maps.ads b/impls/ada.2/types-maps.ads new file mode 100644 index 0000000000..09f481c293 --- /dev/null +++ b/impls/ada.2/types-maps.ads @@ -0,0 +1,62 @@ +private with Ada.Containers.Hashed_Maps; + +with Garbage_Collected; + +package Types.Maps is + + -- All function receiving a key check that its kind is keyword or + -- string. + + type Instance (<>) is abstract new Garbage_Collected.Instance with private; + + -- Built-in functions. + function Assoc (Args : in T_Array) return T; + function Contains (Args : in T_Array) return T; + function Dissoc (Args : in T_Array) return T; + function Get (Args : in T_Array) return T; + function Hash_Map (Args : in T_Array) return T; + function Keys (Args : in T_Array) return T; + function Vals (Args : in T_Array) return T; + + function "=" (Left, Right : in Instance) return Boolean with Inline; + + -- Used to print each element of a map. + type Cursor (<>) is limited private; + function Has_Element (Position : in Cursor) return Boolean with Inline; + function Key (Position : in Cursor) return T with Inline; + function Element (Position : in Cursor) return T with Inline; + function First (Container : in Instance) return Cursor with Inline; + procedure Next (Position : in out Cursor) with Inline; + + -- Used to evaluate each element of a map. + function New_Map (Source : in Instance) return T with Inline; + procedure Replace_Element (Container : in out Instance; + Position : in Cursor; + New_Item : in T) with Inline; + + function Meta (Container : in Instance) return T with Inline; + function With_Meta (Container : in Instance; + Metadata : in T) return T with Inline; + +private + + function Hash (Item : in T) return Ada.Containers.Hash_Type with Inline; + -- This function also checks the kind of the key, and raise an + -- error in case of problem. + + package HM is new Ada.Containers.Hashed_Maps (Key_Type => T, + Element_Type => T, + Hash => Hash, + Equivalent_Keys => "=", + "=" => "="); + + type Instance is new Garbage_Collected.Instance with record + Data : HM.Map; + F_Meta : T; + end record; + + overriding procedure Keep_References (Object : in out Instance) with Inline; + + type Cursor is new HM.Cursor; + +end Types.Maps; diff --git a/impls/ada.2/types-sequences.adb b/impls/ada.2/types-sequences.adb new file mode 100644 index 0000000000..c2604658a7 --- /dev/null +++ b/impls/ada.2/types-sequences.adb @@ -0,0 +1,227 @@ +with Err; +with Types.Fns; +with Types.Builtins; + +package body Types.Sequences is + + function "=" (Left, Right : in Instance) return Boolean is + -- Should become Left.all.Data = Right.all.Data when + -- https://gcc.gnu.org/bugzilla/show_bug.cgi?id=89178 is fixed. + begin + return Left.Length = Right.Length + and then + (for all I in 1 .. Left.Data'Length => Left.Data (I) = Right.Data (I)); + end "="; + + function Concat (Args : in T_Array) return T is + Sum : Natural := 0; + First : Positive := 1; + Last : Natural; + begin + Err.Check ((for all A of Args => A.Kind in Kind_Sequence), + "expected sequences"); + for Arg of Args loop + Sum := Sum + Arg.Sequence.all.Data'Length; + end loop; + declare + Ref : constant Sequence_Ptr := Constructor (Sum); + begin + for Arg of Args loop + Last := First - 1 + Arg.Sequence.all.Data'Last; + Ref.all.Data (First .. Last) := Arg.Sequence.all.Data; + First := Last + 1; + end loop; + return (Kind_List, Ref); + end; + end Concat; + + function Conj (Args : in T_Array) return T is + begin + Err.Check (0 < Args'Length, "expected at least 1 parameter"); + case Args (Args'First).Kind is + when Kind_Sequence => + declare + Data : T_Array renames Args (Args'First).Sequence.all.Data; + Last : constant Natural := Args'Length - 1 + Data'Length; + -- Avoid exceptions until Ref is controlled. + Ref : constant Sequence_Ptr := Constructor (Last); + begin + if Args (Args'First).Kind = Kind_List then + for I in 1 .. Args'Length - 1 loop + Ref.all.Data (I) := Args (Args'Last - I + 1); + end loop; + Ref.all.Data (Args'Length .. Last) := Data; + return (Kind_List, Ref); + else + Ref.all.Data := Data & Args (Args'First + 1 .. Args'Last); + return (Kind_Vector, Ref); + end if; + end; + when others => + Err.Raise_With ("parameter 1 must be a sequence"); + end case; + end Conj; + + function Cons (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 2 + and then Args (Args'Last).Kind in Kind_Sequence, + "expected a value then a sequence"); + declare + Head : T renames Args (Args'First); + Tail : T_Array renames Args (Args'Last).Sequence.all.Data; + Ref : constant Sequence_Ptr := Constructor (1 + Tail'Length); + begin + Ref.all.Data := Head & Tail; + return (Kind_List, Ref); + end; + end Cons; + + function Constructor (Length : in Natural) return Sequence_Ptr is + Ref : constant Sequence_Ptr := new Instance (Length); + begin + Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); + return Ref; + end Constructor; + + function Count (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + case Args (Args'First).Kind is + when Kind_Nil => + return (Kind_Number, 0); + when Kind_Sequence => + return (Kind_Number, Args (Args'First).Sequence.all.Data'Length); + when others => + Err.Raise_With ("parameter must be nil or a sequence"); + end case; + end Count; + + function First (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + case Args (Args'First).Kind is + when Kind_Nil => + return Nil; + when Kind_Sequence => + declare + Data : T_Array renames Args (Args'First).Sequence.all.Data; + begin + if Data'Length = 0 then + return Nil; + else + return Data (Data'First); + end if; + end; + when others => + Err.Raise_With ("parameter must be nil or a sequence"); + end case; + end First; + + function Is_Empty (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1 + and then Args (Args'First).Kind in Kind_Sequence, + "expected a sequence"); + return (Kind_Boolean, Args (Args'First).Sequence.all.Data'Length = 0); + end Is_Empty; + + procedure Keep_References (Object : in out Instance) is + begin + Keep (Object.Meta); + for M of Object.Data loop + Keep (M); + end loop; + end Keep_References; + + function List (Args : in T_Array) return T + is + Ref : constant Sequence_Ptr := Constructor (Args'Length); + begin + Ref.all.Data := Args; + return (Kind_List, Ref); + end List; + + function Map (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 2 + and then Args (Args'Last).Kind in Kind_Sequence, + "expected a function then a sequence"); + declare + F : T renames Args (Args'First); + Src : T_Array renames Args (Args'Last).Sequence.all.Data; + Ref : constant Sequence_Ptr := Constructor (Src'Length); + begin + case F.Kind is + when Kind_Builtin => + for I in Src'Range loop + Ref.all.Data (I) := F.Builtin.all (Src (I .. I)); + end loop; + when Kind_Builtin_With_Meta => + for I in Src'Range loop + Ref.all.Data (I) + := F.Builtin_With_Meta.all.Builtin.all (Src (I .. I)); + end loop; + when Kind_Fn => + for I in Src'Range loop + Ref.all.Data (I) := F.Fn.all.Apply (Src (I .. I)); + end loop; + when others => + Err.Raise_With ("parameter 1 must be a function"); + end case; + return (Kind_List, Ref); + end; + end Map; + + function Nth (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 2 + and then Args (Args'First).Kind in Kind_Sequence + and then Args (Args'Last).Kind = Kind_Number, + "expected a sequence then a number"); + declare + L : T_Array renames Args (Args'First).Sequence.all.Data; + I : constant Integer := Args (Args'Last).Number + 1; + begin + Err.Check (I in L'Range, "index out of bounds"); + return L (I); + end; + end Nth; + + function Rest (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1, "expected 1 parameter"); + case Args (Args'First).Kind is + when Kind_Nil => + return (Kind_List, Constructor (0)); + when Kind_Sequence => + declare + A1 : T_Array renames Args (Args'First).Sequence.all.Data; + Ref : constant Sequence_Ptr + := Constructor (Integer'Max (0, A1'Length - 1)); + begin + Ref.all.Data := A1 (A1'First + 1 .. A1'Last); + return (Kind_List, Ref); + end; + when others => + Err.Raise_With ("parameter must be nil or a sequence"); + end case; + end Rest; + + function Vec (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1 + and then Args (Args'First).Kind in Kind_Sequence, + "expects a sequence"); + return (Kind_Vector, Args (Args'First).Sequence); + end Vec; + + function Vector (Args : in T_Array) return T + is + Ref : constant Sequence_Ptr := Constructor (Args'Length); + begin + Ref.all.Data := Args; + return (Kind_Vector, Ref); + end Vector; + +end Types.Sequences; diff --git a/impls/ada.2/types-sequences.ads b/impls/ada.2/types-sequences.ads new file mode 100644 index 0000000000..f45bdbdec6 --- /dev/null +++ b/impls/ada.2/types-sequences.ads @@ -0,0 +1,40 @@ +with Garbage_Collected; + +package Types.Sequences is + + -- Hiding the implementation would either cause a significative + -- performance hit (the compiler performs better optimization with + -- explicit arrays) or a convoluted interface (demonstrated for + -- strings and maps, where the balance is different). + + type Instance (Length : Natural) is new Garbage_Collected.Instance with + record + Meta : T; + Data : T_Array (1 .. Length); + end record; + + -- Built-in functions. + function Concat (Args : in T_Array) return T; + function Conj (Args : in T_Array) return T; + function Cons (Args : in T_Array) return T; + function Count (Args : in T_Array) return T; + function First (Args : in T_Array) return T; + function Is_Empty (Args : in T_Array) return T; + function List (Args : in T_Array) return T; + function Map (Args : in T_Array) return T; + function Nth (Args : in T_Array) return T; + function Rest (Args : in T_Array) return T; + function Vec (Args : in T_Array) return T; + function Vector (Args : in T_Array) return T; + + -- New instances must be created via this constructor. + function Constructor (Length : in Natural) return Sequence_Ptr with Inline; + + -- Helper for Types."=". + function "=" (Left, Right : in Instance) return Boolean; + +private + + overriding procedure Keep_References (Object : in out Instance) with Inline; + +end Types.Sequences; diff --git a/impls/ada.2/types-strings.adb b/impls/ada.2/types-strings.adb new file mode 100644 index 0000000000..a51f01fdbe --- /dev/null +++ b/impls/ada.2/types-strings.adb @@ -0,0 +1,34 @@ +with Ada.Strings.Hash; + +package body Types.Strings is + + function "=" (Left : in Instance; + Right : in String) return Boolean + is (Left.Data = Right); + + function Alloc (Data : in String) return String_Ptr is + Ref : constant String_Ptr := new Instance (Data'Length); + begin + Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); + Ref.all.Data := Data; + return Ref; + end Alloc; + + function Hash (Item : in String_Ptr) return Ada.Containers.Hash_Type + is (Ada.Strings.Hash (Item.all.Data)); + + procedure Query_Element + (Container : in Instance; + Process : not null access procedure (Element : in String)) + is + begin + Process.all (Container.Data); + end Query_Element; + + function Same_Contents (Left, Right : in String_Ptr) return Boolean + is (Left = Right or else Left.all.Data = Right.all.Data); + + function To_String (Container : in Instance) return String + is (Container.Data); + +end Types.Strings; diff --git a/impls/ada.2/types-strings.ads b/impls/ada.2/types-strings.ads new file mode 100644 index 0000000000..58bd0c6377 --- /dev/null +++ b/impls/ada.2/types-strings.ads @@ -0,0 +1,49 @@ +with Ada.Containers; + +with Garbage_Collected; + +package Types.Strings is + + ------------------------------------ + -- Keywords, Strings and Symbols -- + ------------------------------------ + + -- Tests seem to show that manual garbage collection is faster + -- than reference counting in Ada.Strings.Unbounded, probably + -- because we know that the values will never change. + + -- Also, maintaining a global structure in order to avoid similar + -- symbol allocations does not seem to improve performances. + + type Instance (<>) is abstract new Garbage_Collected.Instance with private; + + function Alloc (Data : in String) return String_Ptr + with Inline; + + function "=" (Left : in Instance; + Right : in String) return Boolean + with Inline; + + -- This kind of accessor is more efficient than a function + -- returning an array. + procedure Query_Element + (Container : in Instance; + Process : not null access procedure (Element : in String)); + + -- These methods could be implemented with Query_Element, + -- but we want to optimize Envs.Get. + function Hash (Item : in String_Ptr) return Ada.Containers.Hash_Type + with Inline; + function Same_Contents (Left, Right : in String_Ptr) return Boolean + with Inline; + + -- When readability is more important than copying a string. + function To_String (Container : in Instance) return String with Inline; + +private + + type Instance (Last : Natural) is new Garbage_Collected.Instance with record + Data : String (1 .. Last); + end record; + +end Types.Strings; diff --git a/impls/ada.2/types.adb b/impls/ada.2/types.adb new file mode 100644 index 0000000000..1f6ddb9df9 --- /dev/null +++ b/impls/ada.2/types.adb @@ -0,0 +1,64 @@ +pragma Warnings (Off, "no entities of ""Types.*"" are referenced"); +with Types.Atoms; +with Types.Builtins; +with Types.Fns; +with Types.Maps; +with Types.Sequences; +pragma Warnings (On, "no entities of ""Types.*"" are referenced"); +with Types.Strings; + +package body Types is + + function "=" (Left, Right : in T) return Boolean + is (case Left.Kind is + when Kind_Nil => + Right.Kind = Kind_Nil, + when Kind_Boolean => + Right.Kind = Kind_Boolean + and then Left.Ada_Boolean = Right.Ada_Boolean, + when Kind_Number => + Right.Kind = Kind_Number and then Left.Number = Right.Number, + -- Here comes the part that differs from the predefined equality. + when Kind_Key | Kind_Symbol => + Right.Kind = Left.Kind + and then Strings.Same_Contents (Left.Str, Right.Str), + when Kind_Sequence => + Right.Kind in Kind_Sequence + and then (Left.Sequence = Right.Sequence + or else Sequences."=" (Left.Sequence.all, Right.Sequence.all)), + when Kind_Map => + Right.Kind = Kind_Map + and then (Left.Map = Right.Map + or else Maps."=" (Left.Map.all, Right.Map.all)), + -- Also, comparing functions is an interesting problem. + when others => + False); + + procedure Keep (Object : in T) is + -- No dynamic dispatching happens here. + begin + case Object.Kind is + when Kind_Nil | Kind_Boolean | Kind_Number | Kind_Builtin => + null; + when Kind_Key | Kind_Symbol => + Object.Str.all.Keep; + when Kind_Atom => + Object.Atom.all.Keep; + when Kind_Sequence => + Object.Sequence.all.Keep; + when Kind_Map => + Object.Map.all.Keep; + when Kind_Builtin_With_Meta => + Object.Builtin_With_Meta.all.Keep; + when Kind_Fn | Kind_Macro => + Object.Fn.all.Keep; + end case; + end Keep; + + function To_Boolean (Form : T) return Boolean is + (case Form.Kind is + when Kind_Nil => False, + when Kind_Boolean => Form.Ada_Boolean, + when others => True); + +end Types; diff --git a/impls/ada.2/types.ads b/impls/ada.2/types.ads new file mode 100644 index 0000000000..4a26248d00 --- /dev/null +++ b/impls/ada.2/types.ads @@ -0,0 +1,92 @@ +limited with Types.Atoms; +limited with Types.Builtins; +limited with Types.Fns; +limited with Types.Maps; +limited with Types.Sequences; +limited with Types.Strings; + +package Types is + + -- A type with a default value for the discriminant is the Ada + -- equivalent of a C union. It uses a fixed size, and allows + -- efficient arrays. A class hierarchy would make this impossible, + -- for little gain. + -- Native types may seem to consume too much memory, but + -- 1/ they require no allocation/deallocation. + -- 2/ the overhead would actually be higher with an intermediate + -- reference (the size of the pointer plus the size of the native + -- type, while an union uses the minimum of both and a single + -- memory area ). + + -- The idea is inspired from the Haskell and OCaml interpreters, + -- which use a bit to distinguish pointers from integers. Ada + -- allows to specify the bit position of each component, but + -- generating such architecture-dependent definitions seems a lot + -- of work for MAL. + + -- The Ada tradition is to give explicit names to types, but this + -- one will be used very often. + + type Kind_Type is + (Kind_Nil, + Kind_Atom, + Kind_Boolean, + Kind_Number, + Kind_Symbol, + Kind_Keyword, Kind_String, + Kind_List, Kind_Vector, + Kind_Map, + Kind_Macro, Kind_Fn, Kind_Builtin_With_Meta, Kind_Builtin); + + subtype Kind_Key is Kind_Type range Kind_Keyword .. Kind_String; + subtype Kind_Sequence is Kind_Type range Kind_List .. Kind_Vector; + subtype Kind_Function is Kind_Type range Kind_Fn .. Kind_Builtin; + + type T; + type T_Array; + type Atom_Ptr is not null access Atoms.Instance; + type Builtin_Ptr is not null access function (Args : in T_Array) return T; + type Builtin_With_Meta_Ptr is not null access Builtins.Instance; + type Fn_Ptr is not null access Fns.Instance; + type Map_Ptr is not null access Maps.Instance; + type Sequence_Ptr is not null access Sequences.Instance; + type String_Ptr is not null access Strings.Instance; + + type T (Kind : Kind_Type := Kind_Nil) is record + case Kind is + when Kind_Nil => + null; + when Kind_Boolean => + Ada_Boolean : Boolean; + when Kind_Number => + Number : Integer; + when Kind_Atom => + Atom : Atom_Ptr; + when Kind_Key | Kind_Symbol => + Str : String_Ptr; + when Kind_Sequence => + Sequence : Sequence_Ptr; + when Kind_Map => + Map : Map_Ptr; + when Kind_Builtin => + Builtin : Builtin_Ptr; + when Kind_Builtin_With_Meta => + Builtin_With_Meta : Builtin_With_Meta_Ptr; + when Kind_Fn | Kind_Macro => + Fn : Fn_Ptr; + end case; + end record; + + -- Useful for recursive automatic definition of equality for + -- composite types like the array type below. + function "=" (Left, Right : in T) return Boolean with Inline; + + Nil : constant T := (Kind => Kind_Nil); + + function To_Boolean (Form : T) return Boolean with Inline; + + procedure Keep (Object : in T) with Inline; + + type T_Array is array (Positive range <>) of T; + +end Types; diff --git a/impls/ada/Dockerfile b/impls/ada/Dockerfile new file mode 100755 index 0000000000..ffc69e2fc6 --- /dev/null +++ b/impls/ada/Dockerfile @@ -0,0 +1,25 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin +LABEL org.opencontainers.image.source=https://github.com/kanaka/mal +LABEL org.opencontainers.image.description="mal test container: ada" + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# GNU Ada compiler +RUN apt-get -y install gnat diff --git a/impls/ada/Makefile b/impls/ada/Makefile new file mode 100644 index 0000000000..99f58b8b46 --- /dev/null +++ b/impls/ada/Makefile @@ -0,0 +1,23 @@ +PROGS=step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ + step5_tco step6_file step7_quote step8_macros step9_try + +all: ${PROGS} stepA_mal + +obj: + mkdir -p $@ + +# stepA_mal is awkward because GNAT requires the filename to be lowercase +${PROGS} stepa_mal: force obj + gnatmake -O3 -gnata $@.adb -D obj + +# so we make stepa_mal and just move it. +stepA_mal: stepa_mal + mv $< $@ + +clean: + rm -f ${PROGS} + rm -rf obj + +.PHONY: force + +force: diff --git a/impls/ada/core.adb b/impls/ada/core.adb new file mode 100644 index 0000000000..0a365834c5 --- /dev/null +++ b/impls/ada/core.adb @@ -0,0 +1,1287 @@ +with Ada.Calendar; +with Ada.Characters.Latin_1; +with Ada.Strings.Unbounded; +with Ada.Text_IO; +with Eval_Callback; +with Reader; +with Smart_Pointers; +with Types; +with Types.Hash_Map; +with Types.Vector; + +package body Core is + + use Types; + + -- primitive functions on Smart_Pointer, + function "+" is new Arith_Op ("+", "+"); + function "-" is new Arith_Op ("-", "-"); + function "*" is new Arith_Op ("*", "*"); + function "/" is new Arith_Op ("/", "/"); + + function "<" is new Rel_Op ("<", "<"); + function "<=" is new Rel_Op ("<=", "<="); + function ">" is new Rel_Op (">", ">"); + function ">=" is new Rel_Op (">=", ">="); + + + function Eval_As_Boolean (MH : Types.Mal_Handle) return Boolean is + use Types; + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + Res := False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Throw (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + Types.Mal_Exception_Value := First_Param; + raise Mal_Exception; + return First_Param; -- Keep the compiler happy. + end Throw; + + + function Is_True (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type + (Deref (First_Param).Sym_Type = Bool and then + Deref_Bool (First_Param).Get_Bool); + end Is_True; + + + function Is_False (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type + (Deref (First_Param).Sym_Type = Bool and then + not Deref_Bool (First_Param).Get_Bool); + end Is_False; + + + function Is_Nil (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type + (Deref (First_Param).Sym_Type = Nil); + end Is_Nil; + + + function Meta (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Deref (First_Param).Get_Meta; + end Meta; + + + function With_Meta (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Meta_Param, Res : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + Rest_List := Deref_List (Cdr (Rest_List)).all; + Meta_Param := Car (Rest_List); + Res := Copy (First_Param); + Deref (Res).Set_Meta (Meta_Param); + return Res; + end With_Meta; + + + function New_Atom (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Atom_Mal_Type (First_Param); + end New_Atom; + + function Is_Atom (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Atom); + end Is_Atom; + + + function Deref_Atm (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Deref_Atom (First_Param).Get_Atom; + end Deref_Atm; + + + function Reset (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Atom_Param, New_Val : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + Atom_Param := Car (Rest_List); + Rest_List := Deref_List (Cdr (Rest_List)).all; + New_Val := Car (Rest_List); + Deref_Atom (Atom_Param).Set_Atom (New_Val); + return New_Val; + end Reset; + + + function Swap (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Atom_Param, Atom_Val, New_Val : Mal_Handle; + Rest_List : Types.List_Mal_Type; + Rest_List_Class : Types.List_Class_Ptr; + Func_Param, Param_List : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + Atom_Param := Car (Rest_List); + Rest_List := Deref_List (Cdr (Rest_List)).all; + Func_Param := Car (Rest_List); + Param_List := Cdr (Rest_List); + + Rest_List_Class := Deref_List_Class (Param_List); + Param_List := Rest_List_Class.Duplicate; + Atom_Val := Deref_Atom (Atom_Param).Get_Atom; + Param_List := Prepend (Atom_Val, Deref_List (Param_List).all); + case Deref (Func_Param).Sym_Type is + when Lambda => + New_Val := Deref_Lambda (Func_Param).Apply (Param_List); + when Func => + New_Val := Deref_Func (Func_Param).Call_Func (Param_List); + when others => raise Runtime_Exception with "Swap with bad func"; + end case; + Deref_Atom (Atom_Param).Set_Atom (New_Val); + return New_Val; + end Swap; + + + function Is_List (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type + (Deref (First_Param).Sym_Type = List and then + Deref_List (First_Param).Get_List_Type = List_List); + end Is_List; + + + function Is_Vector (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type + (Deref (First_Param).Sym_Type = List and then + Deref_List (First_Param).Get_List_Type = Vector_List); + end Is_Vector; + + + function Is_Map (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type + (Deref (First_Param).Sym_Type = List and then + Deref_List (First_Param).Get_List_Type = Hashed_List); + end Is_Map; + + + function Is_Sequential (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return New_Bool_Mal_Type + (Deref (First_Param).Sym_Type = List and then + Deref_List (First_Param).Get_List_Type /= Hashed_List); + end Is_Sequential; + + + function Is_Empty (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + List : List_Class_Ptr; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + List := Deref_List_Class (First_Param); + return New_Bool_Mal_Type (Is_Null (List.all)); + end Is_Empty; + + + function Eval_As_List (MH : Types.Mal_Handle) return List_Mal_Type is + begin + case Deref (MH).Sym_Type is + when List => return Deref_List (MH).all; + when Nil => return Null_List (List_List); + when others => null; + end case; + raise Runtime_Exception with "Expecting a List"; + return Null_List (List_List); + end Eval_As_List; + + + function Count (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Evaled_List : Mal_Handle; + L : List_Mal_Type; + Rest_List : Types.List_Mal_Type; + N : Natural; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + if Deref (First_Param).Sym_Type = List and then + Deref_List (First_Param).Get_List_Type = Vector_List then + N := Deref_List_Class (First_Param).Length; + else + L := Eval_As_List (First_Param); + N := L.Length; + end if; + return New_Int_Mal_Type (N); + end Count; + + + function Cons (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + First_Param, List_Handle : Mal_Handle; + List : List_Mal_Type; + List_Class : List_Class_Ptr; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + List_Handle := Cdr (Rest_List); + List := Deref_List (List_Handle).all; + List_Handle := Car (List); + List_Class := Deref_List_Class (List_Handle); + return Prepend (First_Param, List_Class.all); + end Cons; + + + function Concat (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + return Types.Concat (Rest_List); + end Concat; + + + function First (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + First_List : Types.List_Class_Ptr; + First_Param : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + if Deref (First_Param).Sym_Type = Nil then + return New_Nil_Mal_Type; + end if; + First_List := Deref_List_Class (First_Param); + if Is_Null (First_List.all) then + return New_Nil_Mal_Type; + else + return Types.Car (First_List.all); + end if; + end First; + + + function Rest (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + First_Param, Container : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + if Deref (First_Param).Sym_Type = Nil then + return New_List_Mal_Type (List_List); + end if; + Container := Deref_List_Class (First_Param).Cdr; + return Deref_List_Class (Container).Duplicate; + end Rest; + + + function Nth (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + -- Rest_List, First_List : Types.List_Mal_Type; + Rest_List : Types.List_Mal_Type; + First_List : Types.List_Class_Ptr; + First_Param, List_Handle, Num_Handle : Mal_Handle; + List : List_Mal_Type; + Index : Types.Int_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + First_List := Deref_List_Class (First_Param); + List_Handle := Cdr (Rest_List); + List := Deref_List (List_Handle).all; + Num_Handle := Car (List); + Index := Deref_Int (Num_Handle).all; + return Types.Nth (First_List.all, Natural (Index.Get_Int_Val)); + end Nth; + + + function Apply (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + + Results_Handle, First_Param : Mal_Handle; + Rest_List : List_Mal_Type; + Results_List : List_Ptr; + + begin + + -- The rest of the line. + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + Rest_List := Deref_List (Cdr (Rest_List)).all; + + Results_Handle := New_List_Mal_Type (List_List); + Results_List := Deref_List (Results_Handle); + + -- The last item is a list or a vector which gets flattened so that + -- (apply f (A B) C (D E)) becomes (f (A B) C D E) + while not Is_Null (Rest_List) loop + declare + Part_Handle : Mal_Handle; + begin + Part_Handle := Car (Rest_List); + Rest_List := Deref_List (Cdr (Rest_List)).all; + + -- Is Part_Handle the last item in the list? + if Is_Null (Rest_List) then + declare + The_List : List_Class_Ptr; + List_Item : Mal_Handle; + Next_List : Mal_Handle; + begin + The_List := Deref_List_Class (Part_Handle); + while not Is_Null (The_List.all) loop + List_Item := Car (The_List.all); + Append (Results_List.all, List_Item); + Next_List := Cdr (The_List.all); + The_List := Deref_List_Class (Next_List); + end loop; + end; + else + Append (Results_List.all, Part_Handle); + end if; + end; + end loop; + + -- The apply part... + if Deref (First_Param).Sym_Type = Func then + return Call_Func (Deref_Func (First_Param).all, Results_Handle); + elsif Deref (First_Param).Sym_Type = Lambda then + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Results_List.all) then + + return Eval_Callback.Eval.all (L.Get_Expr, E); + + else + + raise Runtime_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func + raise Runtime_Exception with "Deref called on non-Func/Lambda"; + end if; + + end Apply; + + + function Map (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + + Rest_List, Results_List : List_Mal_Type; + Func_Handle, List_Handle, Results_Handle : Mal_Handle; + + begin + + -- The rest of the line. + Rest_List := Deref_List (Rest_Handle).all; + + Func_Handle := Car (Rest_List); + List_Handle := Nth (Rest_List, 1); + + Results_Handle := New_List_Mal_Type (List_List); + Results_List := Deref_List (Results_Handle).all; + + while not Is_Null (Deref_List_Class (List_Handle).all) loop + + declare + Parts_Handle : Mal_Handle; + begin + Parts_Handle := + Make_New_List + ((1 => Func_Handle, + 2 => Make_New_List + ((1 => Car (Deref_List_Class (List_Handle).all))))); + + List_Handle := Cdr (Deref_List_Class (List_Handle).all); + + Append + (Results_List, + Apply (Parts_Handle)); + + end; + + end loop; + + return New_List_Mal_Type (Results_List); + + end Map; + + + function Symbol (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + + Sym_Handle : Mal_Handle; + Rest_List : List_Mal_Type; + + begin + + -- The rest of the line. + Rest_List := Deref_List (Rest_Handle).all; + + Sym_Handle := Car (Rest_List); + + return New_Symbol_Mal_Type (Deref_String (Sym_Handle).Get_String); + + end Symbol; + + + function Is_Symbol (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + + Sym_Handle : Mal_Handle; + Rest_List : List_Mal_Type; + Res : Boolean; + + begin + Rest_List := Deref_List (Rest_Handle).all; + Sym_Handle := Car (Rest_List); + if Deref (Sym_Handle).Sym_Type = Sym then + Res := Deref_Sym (Sym_Handle).Get_Sym (1) /= ':'; + else + Res := False; + end if; + return New_Bool_Mal_Type (Res); + end Is_Symbol; + + + function Is_String (Rest_Handle : Mal_Handle) return Types.Mal_Handle is + First_Param : Mal_Handle; + begin + First_Param := Car (Deref_List (Rest_Handle).all); + return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Str); + end Is_String; + + + function Keyword (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + + Sym_Handle : Mal_Handle; + Rest_List : List_Mal_Type; + + begin + + -- The rest of the line. + Rest_List := Deref_List (Rest_Handle).all; + + Sym_Handle := Car (Rest_List); + + case Deref (Sym_Handle).Sym_Type is + when Str => + return New_Symbol_Mal_Type (':' & Deref_String (Sym_Handle).Get_String); + when Sym => + if Deref_Sym (Sym_Handle).Get_Sym (1) = ':' then + return Sym_Handle; + end if; + when others => + null; + end case; + + raise Runtime_Exception with "keyword: expects a keyword or string"; + + end Keyword; + + + function Is_Keyword (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + + Sym_Handle : Mal_Handle; + Rest_List : List_Mal_Type; + Res : Boolean; + + begin + Rest_List := Deref_List (Rest_Handle).all; + Sym_Handle := Car (Rest_List); + if Deref (Sym_Handle).Sym_Type = Sym then + Res := Deref_Sym (Sym_Handle).Get_Sym (1) = ':'; + else + Res := False; + end if; + return New_Bool_Mal_Type (Res); + end Is_Keyword; + + + function Is_Number (Rest_Handle : Mal_Handle) return Types.Mal_Handle is + First_Param : Mal_Handle; + begin + First_Param := Car (Deref_List (Rest_Handle).all); + return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Int); + end Is_Number; + + + function Is_Fn (Rest_Handle : Mal_Handle) return Types.Mal_Handle is + First_Param : Mal_Handle; + Res : Boolean; + begin + First_Param := Car (Deref_List (Rest_Handle).all); + case Deref (First_Param).Sym_Type is + when Func => + Res := True; + when Lambda => + Res := not Deref_Lambda (First_Param).Get_Is_Macro; + when others => + Res := False; + end case; + return New_Bool_Mal_Type (Res); + end Is_Fn; + + + function Is_Macro (Rest_Handle : Mal_Handle) return Types.Mal_Handle is + First_Param : Mal_Handle; + begin + First_Param := Car (Deref_List (Rest_Handle).all); + return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Lambda and then Deref_Lambda (First_Param).Get_Is_Macro); + end Is_Macro; + + + function New_List (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + return New_List_Mal_Type (The_List => Rest_List); + end New_List; + + + function New_Vector (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : List_Mal_Type; + Res : Mal_Handle; + use Types.Vector; + begin + Res := New_Vector_Mal_Type; + Rest_List := Deref_List (Rest_Handle).all; + while not Is_Null (Rest_List) loop + Deref_Vector (Res).Append (Car (Rest_List)); + Rest_List := Deref_List (Cdr (Rest_List)).all; + end loop; + return Res; + end New_Vector; + + + function Vec (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + begin + First_Param := Car (Deref_List (Rest_Handle).all); + if Deref (First_Param).Sym_Type /= List then + raise Runtime_Exception with "Expecting a sequence"; + end if; + case Deref_List_Class (First_Param).Get_List_Type is + when Hashed_List => + raise Runtime_Exception with "Expecting a sequence"; + when Vector_List => + return First_Param; + when List_List => + return New_Vector (First_Param); + end case; + end Vec; + + + function New_Map (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : List_Mal_Type; + Res : Mal_Handle; + begin + Res := Hash_Map.New_Hash_Map_Mal_Type; + Rest_List := Deref_List (Rest_Handle).all; + while not Is_Null (Rest_List) loop + Hash_Map.Deref_Hash (Res).Append (Car (Rest_List)); + Rest_List := Deref_List (Cdr (Rest_List)).all; + end loop; + return Res; + end New_Map; + + + function Assoc (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Mal_Handle; + Map : Hash_Map.Hash_Map_Mal_Type; + begin + Rest_List := Rest_Handle; + Map := Hash_Map.Deref_Hash (Car (Deref_List (Rest_List).all)).all; + Rest_List := Cdr (Deref_List (Rest_List).all); + return Hash_Map.Assoc (Map, Rest_List); + end Assoc; + + + function Dis_Assoc (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Mal_Handle; + Map : Hash_Map.Hash_Map_Mal_Type; + begin + Rest_List := Rest_Handle; + Map := Hash_Map.Deref_Hash (Car (Deref_List (Rest_List).all)).all; + Rest_List := Cdr (Deref_List (Rest_List).all); + return Hash_Map.Dis_Assoc (Map, Rest_List); + end Dis_Assoc; + + + function Get_Key (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : List_Mal_Type; + Map : Hash_Map.Hash_Map_Mal_Type; + Map_Param, Key : Mal_Handle; + The_Sym : Sym_Types; + begin + + Rest_List := Deref_List (Rest_Handle).all; + Map_Param := Car (Rest_List); + The_Sym := Deref (Map_Param).Sym_Type; + if The_Sym = Sym or The_Sym = Nil then + -- Either its nil or its some other atom + -- which makes no sense! + return New_Nil_Mal_Type; + end if; + + -- Assume a map from here on in. + Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; + Rest_List := Deref_List (Cdr (Rest_List)).all; + Key := Car (Rest_List); + + return Map.Get (Key); + + end Get_Key; + + + function Contains_Key (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : List_Mal_Type; + Map : Hash_Map.Hash_Map_Mal_Type; + Key : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; + Rest_List := Deref_List (Cdr (Rest_List)).all; + Key := Car (Rest_List); + return New_Bool_Mal_Type (Hash_Map.Contains (Map, Key)); + end Contains_Key; + + + function All_Keys (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : List_Mal_Type; + Map : Hash_Map.Hash_Map_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; + return Hash_Map.All_Keys (Map); + end All_Keys; + + + function All_Values (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : List_Mal_Type; + Map : Hash_Map.Hash_Map_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; + return Hash_Map.All_Values (Map); + end All_Values; + + + -- Take a list with two parameters and produce a single result + -- using the Op access-to-function parameter. + function Reduce2 + (Op : Binary_Func_Access; LH : Mal_Handle) + return Mal_Handle is + Left, Right : Mal_Handle; + L, Rest_List : List_Mal_Type; + begin + L := Deref_List (LH).all; + Left := Car (L); + Rest_List := Deref_List (Cdr (L)).all; + Right := Car (Rest_List); + return Op (Left, Right); + end Reduce2; + + + function Plus (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 ("+"'Access, Rest_Handle); + end Plus; + + + function Minus (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 ("-"'Access, Rest_Handle); + end Minus; + + + function Mult (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 ("*"'Access, Rest_Handle); + end Mult; + + + function Divide (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 ("/"'Access, Rest_Handle); + end Divide; + + + function LT (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 ("<"'Access, Rest_Handle); + end LT; + + + function LTE (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 ("<="'Access, Rest_Handle); + end LTE; + + + function GT (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (">"'Access, Rest_Handle); + end GT; + + + function GTE (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (">="'Access, Rest_Handle); + end GTE; + + + function EQ (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Types."="'Access, Rest_Handle); + end EQ; + + + function Pr_Str (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return New_String_Mal_Type (Deref_List (Rest_Handle).Pr_Str); + end Pr_Str; + + + function Prn (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + Ada.Text_IO.Put_Line (Deref_List (Rest_Handle).Pr_Str); + return New_Nil_Mal_Type; + end Prn; + + + function Println (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + Ada.Text_IO.Put_Line (Deref_List (Rest_Handle).Pr_Str (False)); + return New_Nil_Mal_Type; + end Println; + + + function Str (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return New_String_Mal_Type (Deref_List (Rest_Handle).Cat_Str (False)); + end Str; + + + function Read_String (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + First_Param : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Reader.Read_Str (Deref_String (First_Param).Get_String); + end Read_String; + + + function Read_Line (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + First_Param : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + -- Output the prompt. + Ada.Text_IO.Put (Deref_String (First_Param).Get_String); + -- Get the text. + return New_String_Mal_Type (Ada.Text_IO.Get_Line); + end Read_Line; + + + function Slurp (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + First_Param : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + declare + Unquoted_Str : String := Deref_String (First_Param).Get_String; + use Ada.Text_IO; + Fn : Ada.Text_IO.File_Type; + File_Str : Ada.Strings.Unbounded.Unbounded_String := + Ada.Strings.Unbounded.Null_Unbounded_String; + I : Natural := 0; + begin + Ada.Text_IO.Open (Fn, In_File, Unquoted_Str); + while not End_Of_File (Fn) loop + declare + Line_Str : constant String := Get_Line (Fn); + begin + if Line_Str'Length > 0 then + Ada.Strings.Unbounded.Append (File_Str, Line_Str); + Ada.Strings.Unbounded.Append (File_Str, Ada.Characters.Latin_1.LF); + end if; + end; + end loop; + Ada.Text_IO.Close (Fn); + return New_String_Mal_Type (Ada.Strings.Unbounded.To_String (File_Str)); + end; + end Slurp; + + + function Conj (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + Rest_List : List_Mal_Type; + First_Param, Res : Mal_Handle; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + Rest_List := Deref_List (Cdr (Rest_List)).all; + + -- Is this a List or a Vector? + case Deref_List (First_Param).Get_List_Type is + when List_List => + Res := Copy (First_Param); + while not Is_Null (Rest_List) loop + Res := Prepend (To_List => Deref_List (Res).all, Op => Car (Rest_List)); + Rest_List := Deref_List (Cdr (Rest_List)).all; + end loop; + return Res; + when Vector_List => + Res := Copy (First_Param); + while not Is_Null (Rest_List) loop + Vector.Append (Vector.Deref_Vector (Res).all, Car (Rest_List)); + Rest_List := Deref_List (Cdr (Rest_List)).all; + end loop; + return Res; + when Hashed_List => raise Runtime_Exception with "Conj on Hashed_Map"; + end case; + end Conj; + + + function Seq (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param, Res : Mal_Handle; + begin + First_Param := Car (Deref_List (Rest_Handle).all); + case Deref (First_Param).Sym_Type is + when Nil => return First_Param; + when List => + case Deref_List (First_Param).Get_List_Type is + when List_List => + if Is_Null (Deref_List (First_Param).all) then + return New_Nil_Mal_Type; + else + return First_Param; + end if; + when Vector_List => + if Vector.Is_Null (Vector.Deref_Vector (First_Param).all) then + return New_Nil_Mal_Type; + else + return Vector.Duplicate (Vector.Deref_Vector (First_Param).all); + end if; + when others => raise Runtime_Exception; + end case; + when Str => + declare + Param_Str : String := Deref_String (First_Param).Get_String; + String1 : String (1 .. 1); + L_Ptr : List_Ptr; + begin + if Param_Str'Length = 0 then + return New_Nil_Mal_Type; -- "" + else + Res := New_List_Mal_Type (List_List); + L_Ptr := Deref_List (Res); + for I in Param_Str'First .. Param_Str'Last loop + String1 (1) := Param_Str (I); + Append (L_Ptr.all, New_String_Mal_Type (String1)); + end loop; + return Res; + end if; + end; + when others => raise Runtime_Exception; + end case; + end Seq; + + + Start_Time : Ada.Calendar.Time := Ada.Calendar.Clock; + + function Time_Ms (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + D : Duration; + use Ada.Calendar; + begin + D := Clock - Start_Time; -- seconds + D := D * 1000.0; -- milli-seconds + return New_Int_Mal_Type (Integer (D)); -- ms rounded to the nearest one + end Time_Ms; + + + procedure Init (Repl_Env : Envs.Env_Handle) is + begin + + Envs.Set (Repl_Env, "*host-language*", Types.New_String_Mal_Type ("Ada")); + + Envs.Set (Repl_Env, + "true?", + New_Func_Mal_Type ("true?", Is_True'access)); + + Envs.Set (Repl_Env, + "false?", + New_Func_Mal_Type ("false?", Is_False'access)); + + Envs.Set (Repl_Env, + "meta", + New_Func_Mal_Type ("meta", Meta'access)); + + Envs.Set (Repl_Env, + "with-meta", + New_Func_Mal_Type ("with-meta", With_Meta'access)); + + Envs.Set (Repl_Env, + "nil?", + New_Func_Mal_Type ("nil?", Is_Nil'access)); + + Envs.Set (Repl_Env, + "throw", + New_Func_Mal_Type ("throw", Throw'access)); + + Envs.Set (Repl_Env, + "atom", + New_Func_Mal_Type ("atom", New_Atom'access)); + + Envs.Set (Repl_Env, + "atom?", + New_Func_Mal_Type ("atom?", Is_Atom'access)); + + Envs.Set (Repl_Env, + "deref", + New_Func_Mal_Type ("deref", Deref_Atm'access)); + + Envs.Set (Repl_Env, + "reset!", + New_Func_Mal_Type ("reset!", Reset'access)); + + Envs.Set (Repl_Env, + "swap!", + New_Func_Mal_Type ("swap!", Swap'access)); + + Envs.Set (Repl_Env, + "list", + New_Func_Mal_Type ("list", New_List'access)); + + Envs.Set (Repl_Env, + "list?", + New_Func_Mal_Type ("list?", Is_List'access)); + + Envs.Set (Repl_Env, + "vec", + New_Func_Mal_Type ("vec", Vec'access)); + + Envs.Set (Repl_Env, + "vector", + New_Func_Mal_Type ("vector", New_Vector'access)); + + Envs.Set (Repl_Env, + "vector?", + New_Func_Mal_Type ("vector?", Is_Vector'access)); + + Envs.Set (Repl_Env, + "hash-map", + New_Func_Mal_Type ("hash-map", New_Map'access)); + + Envs.Set (Repl_Env, + "assoc", + New_Func_Mal_Type ("assoc", Assoc'access)); + + Envs.Set (Repl_Env, + "dissoc", + New_Func_Mal_Type ("dissoc", Dis_Assoc'access)); + + Envs.Set (Repl_Env, + "get", + New_Func_Mal_Type ("get", Get_Key'access)); + + Envs.Set (Repl_Env, + "keys", + New_Func_Mal_Type ("keys", All_Keys'access)); + + Envs.Set (Repl_Env, + "vals", + New_Func_Mal_Type ("vals", All_Values'access)); + + Envs.Set (Repl_Env, + "map?", + New_Func_Mal_Type ("map?", Is_Map'access)); + + Envs.Set (Repl_Env, + "contains?", + New_Func_Mal_Type ("contains?", Contains_Key'access)); + + Envs.Set (Repl_Env, + "sequential?", + New_Func_Mal_Type ("sequential?", Is_Sequential'access)); + + Envs.Set (Repl_Env, + "empty?", + New_Func_Mal_Type ("empty?", Is_Empty'access)); + + Envs.Set (Repl_Env, + "count", + New_Func_Mal_Type ("count", Count'access)); + + Envs.Set (Repl_Env, + "cons", + New_Func_Mal_Type ("cons", Cons'access)); + + Envs.Set (Repl_Env, + "concat", + New_Func_Mal_Type ("concat", Concat'access)); + + Envs.Set (Repl_Env, + "first", + New_Func_Mal_Type ("first", First'access)); + + Envs.Set (Repl_Env, + "rest", + New_Func_Mal_Type ("rest", Rest'access)); + + Envs.Set (Repl_Env, + "nth", + New_Func_Mal_Type ("nth", Nth'access)); + + Envs.Set (Repl_Env, + "map", + New_Func_Mal_Type ("map", Map'access)); + + Envs.Set (Repl_Env, + "apply", + New_Func_Mal_Type ("apply", Apply'access)); + + Envs.Set (Repl_Env, + "symbol", + New_Func_Mal_Type ("symbol", Symbol'access)); + + Envs.Set (Repl_Env, + "symbol?", + New_Func_Mal_Type ("symbol?", Is_Symbol'access)); + + Envs.Set (Repl_Env, + "string?", + New_Func_Mal_Type ("string?", Is_String'access)); + + Envs.Set (Repl_Env, + "keyword", + New_Func_Mal_Type ("keyword", Keyword'access)); + + Envs.Set (Repl_Env, + "keyword?", + New_Func_Mal_Type ("keyword?", Is_Keyword'access)); + + Envs.Set (Repl_Env, + "number?", + New_Func_Mal_Type ("number?", Is_Number'access)); + + Envs.Set (Repl_Env, + "fn?", + New_Func_Mal_Type ("fn?", Is_Fn'access)); + + Envs.Set (Repl_Env, + "macro?", + New_Func_Mal_Type ("macro?", Is_Macro'access)); + + Envs.Set (Repl_Env, + "pr-str", + New_Func_Mal_Type ("pr-str", Pr_Str'access)); + + Envs.Set (Repl_Env, + "str", + New_Func_Mal_Type ("str", Str'access)); + + Envs.Set (Repl_Env, + "prn", + New_Func_Mal_Type ("prn", Prn'access)); + + Envs.Set (Repl_Env, + "println", + New_Func_Mal_Type ("println", Println'access)); + + Envs.Set (Repl_Env, + "read-string", + New_Func_Mal_Type ("read-string", Read_String'access)); + + Envs.Set (Repl_Env, + "readline", + New_Func_Mal_Type ("readline", Read_Line'access)); + + Envs.Set (Repl_Env, + "slurp", + New_Func_Mal_Type ("slurp", Slurp'access)); + + Envs.Set (Repl_Env, + "conj", + New_Func_Mal_Type ("conj", Conj'access)); + + Envs.Set (Repl_Env, + "seq", + New_Func_Mal_Type ("seq", Seq'access)); + + Envs.Set (Repl_Env, + "time-ms", + New_Func_Mal_Type ("time-ms", Time_Ms'access)); + + Envs.Set (Repl_Env, + "+", + New_Func_Mal_Type ("+", Plus'access)); + + Envs.Set (Repl_Env, + "-", + New_Func_Mal_Type ("-", Minus'access)); + + Envs.Set (Repl_Env, + "*", + New_Func_Mal_Type ("*", Mult'access)); + + Envs.Set (Repl_Env, + "/", + New_Func_Mal_Type ("/", Divide'access)); + + Envs.Set (Repl_Env, + "<", + New_Func_Mal_Type ("<", LT'access)); + + Envs.Set (Repl_Env, + "<=", + New_Func_Mal_Type ("<=", LTE'access)); + + Envs.Set (Repl_Env, + ">", + New_Func_Mal_Type (">", GT'access)); + + Envs.Set (Repl_Env, + ">=", + New_Func_Mal_Type (">=", GTE'access)); + + Envs.Set (Repl_Env, + "=", + New_Func_Mal_Type ("=", EQ'access)); + + end Init; + + +end Core; diff --git a/impls/ada/core.ads b/impls/ada/core.ads new file mode 100644 index 0000000000..d4e253e505 --- /dev/null +++ b/impls/ada/core.ads @@ -0,0 +1,10 @@ +with Envs; + +package Core is + + -- Init puts core functions into a new Env. + procedure Init (Repl_Env : Envs.Env_Handle); + + Evaluation_Error : exception; + +end Core; diff --git a/impls/ada/envs.adb b/impls/ada/envs.adb new file mode 100644 index 0000000000..0739ad0cfd --- /dev/null +++ b/impls/ada/envs.adb @@ -0,0 +1,146 @@ +with Ada.Text_IO; +with Types; +with Unchecked_Deallocation; + +package body Envs is + + + function Is_Null (E : Env_Handle) return Boolean is + use Smart_Pointers; + begin + return E = Null_Env_Handle; + end Is_Null; + + + function New_Env (Outer : Env_Handle := Null_Env_Handle) return Env_Handle is + use Smart_Pointers; + Level : Natural; + begin + if Is_Null (Outer) then + Level := 0; + else + Level := Deref (Outer).Level + 1; + end if; + if Debug then + Ada.Text_IO.Put_Line + ("Envs: Creating at level " & Natural'Image (Level)); + end if; + return Env_Handle (Smart_Pointers.New_Ptr (new Env' + (Base_Class with The_Map => String_Mal_Hash.Empty_Map, + Outer_Env => Outer, + Level => Level))); + end New_Env; + + + procedure Set + (E : Env_Handle; + Key : String; + Elem : Smart_Pointers.Smart_Pointer) is + begin + if Debug then + Ada.Text_IO.Put_Line + ("Envs: Setting " & Key & + " to " & Types.Deref (Elem).To_String & + " at level " & Natural'Image (Deref (E).Level)); + end if; + String_Mal_Hash.Include + (Container => Deref (E).The_Map, + Key => Ada.Strings.Unbounded.To_Unbounded_String (Key), + New_Item => Elem); + end Set; + + + function Get (E : Env_Handle; Key: String) + return Smart_Pointers.Smart_Pointer is + + use String_Mal_Hash; + C : Cursor; + + begin + + if Debug then + Ada.Text_IO.Put_Line + ("Envs: Finding " & Key & + " at level " & Natural'Image (Deref (E).Level)); + end if; + + C := Find (Deref (E).The_Map, + Ada.Strings.Unbounded.To_Unbounded_String (Key)); + + if C = No_Element then + + if Is_Null (Deref (E).Outer_Env) then + raise Not_Found; + else + return Get (Deref (E).Outer_Env, Key); + end if; + + else + return Element (C); + end if; + + end Get; + + + procedure Set_Outer + (E : Env_Handle; Outer_Env : Env_Handle) is + begin + -- Attempt to avoid making loops. + if Deref (E).Level /= 0 then + Deref (E).Outer_Env := Outer_Env; + end if; + end Set_Outer; + + + function To_String (E : Env_Handle) return String is + use String_Mal_Hash, Ada.Strings.Unbounded; + C : Cursor; + Res : Unbounded_String; + begin + C := First (Deref (E).The_Map); + while C /= No_Element loop + Append (Res, Key (C) & " => " & Types.To_String (Types.Deref (Element (C)).all) & ", "); + C := Next (C); + end loop; + return To_String (Res); + end To_String; + + + -- Sym and Exprs are lists. Bind Sets Keys in Syms to the corresponding + -- expression in Exprs. Returns true if all the parameters were bound. + function Bind (Env : Env_Handle; Syms, Exprs : Types.List_Mal_Type) + return Boolean is + use Types; + S, Expr : List_Mal_Type; + First_Sym : Sym_Ptr; + begin + S := Syms; + Expr := Exprs; + while not Is_Null (S) loop + + First_Sym := Deref_Sym (Car (S)); + + if First_Sym.Get_Sym = "&" then + S := Deref_List (Cdr (S)).all; + First_Sym := Deref_Sym (Car (S)); + Set (Env, First_Sym.Get_Sym, New_List_Mal_Type (Expr)); + return True; + end if; + + Set (Env, First_Sym.Get_Sym, Car (Expr)); + S := Deref_List (Cdr (S)).all; + exit when Is_Null (Expr); + Expr := Deref_List (Cdr (Expr)).all; + + end loop; + return Is_Null (S); + end Bind; + + + function Deref (SP : Env_Handle) return Env_Ptr is + begin + return Env_Ptr (Smart_Pointers.Deref (Smart_Pointers.Smart_Pointer (SP))); + end Deref; + + +end Envs; diff --git a/impls/ada/envs.ads b/impls/ada/envs.ads new file mode 100644 index 0000000000..ce0f1f21fa --- /dev/null +++ b/impls/ada/envs.ads @@ -0,0 +1,64 @@ +with Ada.Containers.Hashed_Maps; +with Ada.Strings.Unbounded.Hash; +with Smart_Pointers; +limited with Types; + +package Envs is + + type Env_Handle is private; + + Null_Env_Handle : constant Env_Handle; + + function New_Env (Outer : Env_Handle := Null_Env_Handle) return Env_Handle; + + -- Set adds an element to the environment E. + procedure Set + (E : Env_Handle; + Key : String; + Elem : Smart_Pointers.Smart_Pointer); + + -- Get finds a key in the E env. If it can't be found it looks + -- in an outer env. If it runs out of envs, Not Found is raised. + function Get (E : Env_Handle; Key : String) return Smart_Pointers.Smart_Pointer; + + Not_Found : exception; + + procedure Set_Outer + (E : Env_Handle; Outer_Env : Env_Handle); + + -- Sym and Exprs are lists. Bind Sets Keys in Syms to the corresponding + -- expression in Exprs. Returns true if all the parameters were bound. + function Bind (Env : Env_Handle; Syms, Exprs : Types.List_Mal_Type) + return Boolean; + + function To_String (E : Env_Handle) return String; + + Debug : Boolean := False; + +private + + type Env_Handle is new Smart_Pointers.Smart_Pointer; + + Null_Env_Handle : constant Env_Handle := + Env_Handle (Smart_Pointers.Null_Smart_Pointer); + + function Is_Null (E : Env_Handle) return Boolean; + + package String_Mal_Hash is new Ada.Containers.Hashed_Maps + (Key_Type => Ada.Strings.Unbounded.Unbounded_String, + Element_Type => Smart_Pointers.Smart_Pointer, + Hash => Ada.Strings.Unbounded.Hash, + Equivalent_Keys => Ada.Strings.Unbounded."=", + "=" => Smart_Pointers."="); + + type Env is new Smart_Pointers.Base_Class with record + The_Map : String_Mal_Hash.Map; + Outer_Env : Env_Handle; + Level: Natural; + end record; + + type Env_Ptr is access all Env; + + function Deref (SP : Env_Handle) return Env_Ptr; + +end Envs; diff --git a/impls/ada/eval_callback.ads b/impls/ada/eval_callback.ads new file mode 100644 index 0000000000..ea422996b3 --- /dev/null +++ b/impls/ada/eval_callback.ads @@ -0,0 +1,11 @@ +with Envs; +with Types; + +package Eval_Callback is + + type Eval_Func is access + function (MH : Types.Mal_Handle; Env : Envs.Env_Handle) return Types.Mal_Handle; + + Eval : Eval_Func; + +end Eval_Callback; diff --git a/impls/ada/printer.adb b/impls/ada/printer.adb new file mode 100644 index 0000000000..67d139bb9e --- /dev/null +++ b/impls/ada/printer.adb @@ -0,0 +1,12 @@ +package body Printer is + + function Pr_Str (M : Types.Mal_Handle) return String is + begin + if Types.Is_Null (M) then + return ""; + else + return Types.To_String (Types.Deref (M).all); + end if; + end Pr_Str; + +end Printer; diff --git a/impls/ada/printer.ads b/impls/ada/printer.ads new file mode 100644 index 0000000000..8e9fc671a0 --- /dev/null +++ b/impls/ada/printer.ads @@ -0,0 +1,7 @@ +with Types; + +package Printer is + + function Pr_Str (M : Types.Mal_Handle) return String; + +end Printer; diff --git a/impls/ada/reader.adb b/impls/ada/reader.adb new file mode 100644 index 0000000000..94ecc4ac70 --- /dev/null +++ b/impls/ada/reader.adb @@ -0,0 +1,390 @@ +with Ada.IO_Exceptions; +with Ada.Characters.Latin_1; +with Ada.Exceptions; +with Ada.Strings.Maps.Constants; +with Ada.Strings.Unbounded; +with Ada.Text_IO; +with Smart_Pointers; +with Types.Vector; +with Types.Hash_Map; + +package body Reader is + + use Types; + + package ACL renames Ada.Characters.Latin_1; + + type Lexemes is (Ignored_Tok, + Start_List_Tok, Start_Vector_Tok, Start_Hash_Tok, + Meta_Tok, Deref_Tok, + Quote_Tok, Quasi_Quote_Tok, Splice_Unq_Tok, Unquote_Tok, + Int_Tok, Float_Tok, + Str_Tok, Sym_Tok); + + type Token (ID : Lexemes := Ignored_Tok) is record + case ID is + when Int_Tok => + Int_Val : Mal_Integer; + when Float_Tok => + Float_Val : Mal_Float; + when Str_Tok | Sym_Tok => + Start_Char, Stop_Char : Natural; + when others => null; + end case; + end record; + + Lisp_Whitespace : constant Ada.Strings.Maps.Character_Set := + Ada.Strings.Maps.To_Set + (ACL.HT & ACL.LF & ACL.CR & ACL.Space & ACL.Comma); + + -- [^\s\[\]{}('"`,;)] + Terminator_Syms : Ada.Strings.Maps.Character_Set := + Ada.Strings.Maps."or" + (Lisp_Whitespace, + Ada.Strings.Maps.To_Set ("[]{}('""`,;)")); + + -- The unterminated string error + String_Error : exception; + + + function Convert_String (S : String) return String is + use Ada.Strings.Unbounded; + Res : Unbounded_String; + I : Positive; + Str_Last : Natural; + begin + Str_Last := S'Last; + I := S'First; + while I <= Str_Last loop + if S (I) = '\' then + if I+1 > Str_Last then + Append (Res, S (I)); + I := I + 1; + elsif S (I+1) = 'n' then + Append (Res, Ada.Characters.Latin_1.LF); + I := I + 2; + elsif S (I+1) = '"' then + Append (Res, S (I+1)); + I := I + 2; + elsif S (I+1) = '\' then + Append (Res, S (I+1)); + I := I + 2; + else + Append (Res, S (I)); + I := I + 1; + end if; + else + Append (Res, S (I)); + I := I + 1; + end if; + end loop; + return To_String (Res); + end Convert_String; + + Str_Len : Natural := 0; + Saved_Line : Ada.Strings.Unbounded.Unbounded_String; + Char_To_Read : Natural := 1; + + function Get_Token return Token is + Res : Token; + I, J : Natural; + use Ada.Strings.Unbounded; + begin + + <> + + -- Skip over whitespace... + I := Char_To_Read; + while I <= Str_Len and then + Ada.Strings.Maps.Is_In (Element (Saved_Line, I), Lisp_Whitespace) loop + I := I + 1; + end loop; + + -- Filter out lines consisting of only whitespace + if I > Str_Len then + return (ID => Ignored_Tok); + end if; + + J := I; + + case Element (Saved_Line, J) is + + when ''' => Res := (ID => Quote_Tok); Char_To_Read := J+1; + + when '`' => Res := (ID => Quasi_Quote_Tok); Char_To_Read := J+1; + + when '~' => -- Tilde + + if J+1 <= Str_Len and then Element (Saved_Line, J+1) = '@' then + Res := (ID => Splice_Unq_Tok); + Char_To_Read := J+2; + else + -- Just a Tilde + Res := (ID => Unquote_Tok); + Char_To_Read := J+1; + end if; + + when '(' => Res := (ID => Start_List_Tok); Char_To_Read := J+1; + when '[' => Res := (ID => Start_Vector_Tok); Char_To_Read := J+1; + when '{' => Res := (ID => Start_Hash_Tok); Char_To_Read := J+1; + + when '^' => Res := (ID => Meta_Tok); Char_To_Read := J+1; + when '@' => Res := (ID => Deref_Tok); Char_To_Read := J+1; + + when ']' | '}' | ')' => + + Res := (ID => Sym_Tok, Start_Char => J, Stop_Char => J); + Char_To_Read := J+1; + + when '"' => -- a string + + loop + if Str_Len <= J then + raise String_Error; + end if; + J := J + 1; + exit when Element (Saved_Line, J) = '"'; + if Element (Saved_Line, J) = '\' then + J := J + 1; + end if; + end loop; + + Res := (ID => Str_Tok, Start_Char => I, Stop_Char => J); + Char_To_Read := J + 1; + + when ';' => -- a comment + + -- Read to the end of the line or until + -- the saved_line string is exhausted. + -- NB if we reach the end we don't care + -- what the last char was. + while J < Str_Len and Element (Saved_Line, J) /= ACL.LF loop + J := J + 1; + end loop; + if J = Str_Len then + Res := (ID => Ignored_Tok); + else + Char_To_Read := J + 1; + -- was: Res := Get_Token; + goto Tail_Call_Opt; + end if; + + when others => -- an atom + + while J <= Str_Len and then + not Ada.Strings.Maps.Is_In (Element (Saved_Line, J), Terminator_Syms) loop + J := J + 1; + end loop; + + -- Either we ran out of string or + -- the one at J was the start of a new token + Char_To_Read := J; + J := J - 1; + + declare + Dots : Natural; + All_Digits : Boolean; + begin + -- check if all digits or . + Dots := 0; + All_Digits := True; + for K in I .. J loop + if (K = I and K /= J) and then Element (Saved_Line, K) = '-' then + null; + elsif Element (Saved_Line, K) = '.' then + Dots := Dots + 1; + elsif not (Element (Saved_Line, K) in '0' .. '9') then + All_Digits := False; + exit; + end if; + end loop; + + if All_Digits then + if Dots = 0 then + Res := + (ID => Int_Tok, + Int_Val => Mal_Integer'Value (Slice (Saved_Line, I, J))); + elsif Dots = 1 then + Res := + (ID => Float_Tok, + Float_Val => Mal_Float'Value (Slice (Saved_Line, I, J))); + else + Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J); + end if; + else + Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J); + end if; + + end; + + end case; + + return Res; + + end Get_Token; + + + function Read_List (LT : Types.List_Types) + return Types.Mal_Handle is + + MTA : Mal_Handle; + + begin + + MTA := Read_Form; + + declare + List_SP : Mal_Handle; + List_P : List_Class_Ptr; + Close : String (1..1) := (1 => Types.Closing (LT)); + begin + + case LT is + when List_List => List_SP := New_List_Mal_Type (List_Type => LT); + when Vector_List => List_SP := Vector.New_Vector_Mal_Type; + when Hashed_List => List_SP := Hash_Map.New_Hash_Map_Mal_Type; + end case; + + -- Need to append to a variable so... + List_P := Deref_List_Class (List_SP); + + loop + + if Is_Null (MTA) then + return New_Error_Mal_Type (Str => "expected '" & Close & "', got EOF"); + end if; + + exit when Deref (MTA).Sym_Type = Sym and then + Symbol_Mal_Type (Deref (MTA).all).Get_Sym = Close; + + Append (List_P.all, MTA); + + MTA := Read_Form; + + end loop; + + return List_SP; + + end; + + end Read_List; + + + function Read_Form return Types.Mal_Handle is + Tok : Token; + MTS : Mal_Handle; + use Ada.Strings.Unbounded; + begin + + Tok := Get_Token; + + case Tok.ID is + + when Ignored_Tok => return Smart_Pointers.Null_Smart_Pointer; + + when Int_Tok => return New_Int_Mal_Type (Tok.Int_Val); + + when Float_Tok => return New_Float_Mal_Type (Tok.Float_Val); + + when Start_List_Tok => return Read_List (List_List); + + when Start_Vector_Tok => return Read_List (Vector_List); + + when Start_Hash_Tok => return Read_List (Hashed_List); + + when Meta_Tok => + + declare + Meta, Obj : Mal_Handle; + begin + Meta := Read_Form; + Obj := Read_Form; + return Make_New_List + ((1 => New_Symbol_Mal_Type ("with-meta"), + 2 => Obj, + 3 => Meta)); + end; + + when Deref_Tok => + + return Make_New_List + ((1 => New_Symbol_Mal_Type ("deref"), + 2 => Read_Form)); + + when Quote_Tok => + + return Make_New_List + ((1 => New_Symbol_Mal_Type ("quote"), + 2 => Read_Form)); + + when Quasi_Quote_Tok => + + return Make_New_List + ((1 => New_Symbol_Mal_Type ("quasiquote"), + 2 => Read_Form)); + + when Splice_Unq_Tok => + + return Make_New_List + ((1 => New_Symbol_Mal_Type ("splice-unquote"), + 2 => Read_Form)); + + when Unquote_Tok => + + return Make_New_List + ((1 => New_Symbol_Mal_Type ("unquote"), + 2 => Read_Form)); + + when Str_Tok => + + -- +/-1 strips out the double quotes. + -- Convert_String converts backquoted charaters to raw format. + return New_String_Mal_Type + (Convert_String + (Slice (Saved_Line, Tok.Start_Char + 1, Tok.Stop_Char - 1))); + + when Sym_Tok => + + -- Mal interpreter is required to know about true, false and nil. + declare + S : String := Slice (Saved_Line, Tok.Start_Char, Tok.Stop_Char); + begin + if S = "true" then + return New_Bool_Mal_Type (True); + elsif S = "false" then + return New_Bool_Mal_Type (False); + elsif S = "nil" then + return New_Nil_Mal_Type; + else + return New_Symbol_Mal_Type (S); + end if; + end; + + end case; + + end Read_Form; + + + procedure Lex_Init (S : String) is + begin + Str_Len := S'Length; + Saved_Line := Ada.Strings.Unbounded.To_Unbounded_String (S); + Char_To_Read := 1; + end Lex_Init; + + + function Read_Str (S : String) return Types.Mal_Handle is + I, Str_Len : Natural := S'Length; + begin + + Lex_Init (S); + + return Read_Form; + + exception + when String_Error => + return New_Error_Mal_Type (Str => "expected '""', got EOF"); + end Read_Str; + + +end Reader; diff --git a/impls/ada/reader.ads b/impls/ada/reader.ads new file mode 100644 index 0000000000..402b3aabbe --- /dev/null +++ b/impls/ada/reader.ads @@ -0,0 +1,14 @@ +with Types; + +package Reader is + + -- This is the Parser (returns an AST) + function Read_Str (S : String) return Types.Mal_Handle; + +private + + procedure Lex_Init (S : String); + + function Read_Form return Types.Mal_Handle; + +end Reader; diff --git a/impls/ada/run b/impls/ada/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/ada/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/ada/smart_pointers.adb b/impls/ada/smart_pointers.adb new file mode 100644 index 0000000000..37c7b67723 --- /dev/null +++ b/impls/ada/smart_pointers.adb @@ -0,0 +1,49 @@ +with Ada.Unchecked_Deallocation; + +package body Smart_Pointers is + + + function New_Ptr (Base_Class : Base_Class_Accessor) return Smart_Pointer is + begin + return Smart_Pointer' + (Ada.Finalization.Controlled with Pointer => Base_Class); + end New_Ptr; + + + function Deref (Ptr : Smart_Pointer) return Base_Class_Accessor is + begin + return Ptr.Pointer; + end Deref; + + + overriding procedure Adjust (Object : in out Smart_Pointer) is + begin + if Object.Pointer /= null then + Object.Pointer.Ref_Count := Object.Pointer.Ref_Count + 1; + end if; + end Adjust; + + + procedure Free is + new Ada.Unchecked_Deallocation (Base_Class'Class, Base_Class_Accessor); + + overriding procedure Finalize (Object : in out Smart_Pointer) is + begin + if Object.Pointer /= null then + if Object.Pointer.Ref_Count > 0 then + Object.Pointer.Ref_Count := Object.Pointer.Ref_Count - 1; + if Object.Pointer.Ref_Count = 0 then + Free (Object.Pointer); + end if; + end if; + end if; + end Finalize; + + + function Is_Null (Ptr : Smart_Pointer) return Boolean is + begin + return Ptr = Null_Smart_Pointer; + end Is_Null; + + +end Smart_Pointers; diff --git a/impls/ada/smart_pointers.ads b/impls/ada/smart_pointers.ads new file mode 100644 index 0000000000..837461bf92 --- /dev/null +++ b/impls/ada/smart_pointers.ads @@ -0,0 +1,39 @@ +with Ada.Finalization; + +package Smart_Pointers is + + -- Classes we want to track derrive from Base Class. + type Base_Class is abstract tagged private; + + type Base_Class_Accessor is access Base_Class'Class; + + + type Smart_Pointer is private; + + function New_Ptr (Base_Class : Base_Class_Accessor) return Smart_Pointer; + + function Deref (Ptr : Smart_Pointer) return Base_Class_Accessor; + + Null_Smart_Pointer : constant Smart_Pointer; + + function Is_Null (Ptr : Smart_Pointer) return Boolean; + +private + + type Base_Class is abstract tagged record + Ref_Count : Natural := 1; + end record; + + + type Smart_Pointer is new Ada.Finalization.Controlled with record + Pointer : Base_Class_Accessor; + end record; + + overriding procedure Adjust (Object : in out Smart_Pointer); + + overriding procedure Finalize (Object : in out Smart_Pointer); + + Null_Smart_Pointer : constant Smart_Pointer := + (Ada.Finalization.Controlled with Pointer => null); + +end Smart_Pointers; diff --git a/impls/ada/step0_repl.adb b/impls/ada/step0_repl.adb new file mode 100644 index 0000000000..456b8a302e --- /dev/null +++ b/impls/ada/step0_repl.adb @@ -0,0 +1,34 @@ +with Ada.Text_IO; + +procedure Step0_Repl is + + function Read (Param : String) return String is + begin + return Param; + end Read; + + function Eval (Param : String) return String is + begin + return Param; + end Eval; + + function Print (Param : String) return String is + begin + return Param; + end Print; + + function Rep (Param : String) return String is + Read_Str : String := Read (Param); + Eval_Str : String := Eval (Read_Str); + Print_Str : String := Print (Eval_Str); + begin + return Print_Str; + end Rep; + +begin + loop + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line)); + end loop; +end Step0_Repl; diff --git a/impls/ada/step1_read_print.adb b/impls/ada/step1_read_print.adb new file mode 100644 index 0000000000..4969ad34c3 --- /dev/null +++ b/impls/ada/step1_read_print.adb @@ -0,0 +1,44 @@ +with Ada.Text_IO; +with Printer; +with Reader; +with Types; + +procedure Step1_Read_Print is + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + function Eval (Param : Types.Mal_Handle) return Types.Mal_Handle is + begin + return Param; + end Eval; + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST); + return Print (Evaluated_AST); + end if; + + end Rep; + +begin + loop + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line)); + end loop; +end Step1_Read_Print; diff --git a/impls/ada/step2_eval.adb b/impls/ada/step2_eval.adb new file mode 100644 index 0000000000..5ef3304e4d --- /dev/null +++ b/impls/ada/step2_eval.adb @@ -0,0 +1,230 @@ +with Ada.Containers.Hashed_Maps; +with Ada.Strings.Unbounded.Hash; +with Ada.Text_IO; +with Ada.Exceptions; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step2_Eval is + + use Types; + + -- primitive functions on Smart_Pointer, + function "+" is new Arith_Op ("+", "+"); + function "-" is new Arith_Op ("-", "-"); + function "*" is new Arith_Op ("*", "*"); + function "/" is new Arith_Op ("/", "/"); + + -- Take a list with two parameters and produce a single result + -- using the Op access-to-function parameter. + function Reduce2 + (Op : Binary_Func_Access; LH : Mal_Handle) + return Mal_Handle is + Left, Right : Mal_Handle; + L, Rest_List : List_Mal_Type; + begin + L := Deref_List (LH).all; + Left := Car (L); + Rest_List := Deref_List (Cdr (L)).all; + Right := Car (Rest_List); + return Op (Left, Right); + end Reduce2; + + + function Plus (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step2_Eval."+"'Unrestricted_Access, Rest_Handle); + end Plus; + + + function Minus (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step2_Eval."-"'Unrestricted_Access, Rest_Handle); + end Minus; + + + function Mult (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step2_Eval."*"'Unrestricted_Access, Rest_Handle); + end Mult; + + + function Divide (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step2_Eval."/"'Unrestricted_Access, Rest_Handle); + end Divide; + + + package String_Mal_Hash is new Ada.Containers.Hashed_Maps + (Key_Type => Ada.Strings.Unbounded.Unbounded_String, + Element_Type => Smart_Pointers.Smart_Pointer, + Hash => Ada.Strings.Unbounded.Hash, + Equivalent_Keys => Ada.Strings.Unbounded."=", + "=" => Smart_Pointers."="); + + Not_Found : exception; + + function Get (M : String_Mal_Hash.Map; K : String) return Mal_Handle is + use String_Mal_Hash; + C : Cursor; + begin + C := Find (M, Ada.Strings.Unbounded.To_Unbounded_String (K)); + if C = No_Element then + raise Not_Found; + else + return Element (C); + end if; + end Get; + + + Repl_Env : String_Mal_Hash.Map; + + + function Eval (Param : Types.Mal_Handle; Env : String_Mal_Hash.Map) + return Types.Mal_Handle; + + + Debug : Boolean := False; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Eval_Ast + (Ast : Mal_Handle; Env : String_Mal_Hash.Map) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + + function Eval (Param : Mal_Handle; Env : String_Mal_Hash.Map) + return Mal_Handle is + First_Elem : Mal_Handle; + Ast : Mal_Handle renames Param; -- Historic + begin + if Debug then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + + case Deref (Ast).Sym_Type is + + when Sym => + + declare + Sym : Mal_String := Deref_Sym (Ast).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Ast; + else + return Get (Env, Sym); + end if; + exception + when Not_Found => + raise Not_Found with ("'" & Sym & "' not found"); + end; + + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + declare + Evaled_H, First_Param : Mal_Handle; + Evaled_List : List_Mal_Type; + Param_List : List_Mal_Type; + begin + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + Evaled_H := Eval_Ast (Param, Env); + Evaled_List := Deref_List (Evaled_H).all; + First_Param := Car (Evaled_List); + return Call_Func (Deref_Func (First_Param).all, Cdr (Evaled_List)); + end; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + + function Rep (Param : String; Env : String_Mal_Hash.Map) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + +begin + + String_Mal_Hash.Include + (Container => Repl_Env, + Key => Ada.Strings.Unbounded.To_Unbounded_String ("+"), + New_Item => New_Func_Mal_Type ("+", Plus'Unrestricted_access)); + + String_Mal_Hash.Include + (Container => Repl_Env, + Key => Ada.Strings.Unbounded.To_Unbounded_String ("-"), + New_Item => New_Func_Mal_Type ("-", Minus'Unrestricted_access)); + + String_Mal_Hash.Include + (Container => Repl_Env, + Key => Ada.Strings.Unbounded.To_Unbounded_String ("*"), + New_Item => New_Func_Mal_Type ("*", Mult'Unrestricted_access)); + + String_Mal_Hash.Include + (Container => Repl_Env, + Key => Ada.Strings.Unbounded.To_Unbounded_String ("/"), + New_Item => New_Func_Mal_Type ("/", Divide'Unrestricted_access)); + + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Ada.Exceptions.Exception_Information (E)); + end; + end loop; +end Step2_Eval; diff --git a/impls/ada/step3_env.adb b/impls/ada/step3_env.adb new file mode 100644 index 0000000000..d5469c046a --- /dev/null +++ b/impls/ada/step3_env.adb @@ -0,0 +1,267 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step3_Env is + + use Types; + + -- primitive functions on Smart_Pointer, + function "+" is new Arith_Op ("+", "+"); + function "-" is new Arith_Op ("-", "-"); + function "*" is new Arith_Op ("*", "*"); + function "/" is new Arith_Op ("/", "/"); + + -- Take a list with two parameters and produce a single result + -- using the Op access-to-function parameter. + function Reduce2 + (Op : Binary_Func_Access; LH : Mal_Handle) + return Mal_Handle is + Left, Right : Mal_Handle; + L, Rest_List : List_Mal_Type; + begin + L := Deref_List (LH).all; + Left := Car (L); + Rest_List := Deref_List (Cdr (L)).all; + Right := Car (Rest_List); + return Op (Left, Right); + end Reduce2; + + + function Plus (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step3_Env."+"'Unrestricted_Access, Rest_Handle); + end Plus; + + + function Minus (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step3_Env."-"'Unrestricted_Access, Rest_Handle); + end Minus; + + + function Mult (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step3_Env."*"'Unrestricted_Access, Rest_Handle); + end Mult; + + + function Divide (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + begin + return Reduce2 (Step3_Env."/"'Unrestricted_Access, Rest_Handle); + end Divide; + + + function Eval (Param : Types.Mal_Handle; Env : Envs.Env_Handle) + return Types.Mal_Handle; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected symbol as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Let_Processing (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Args); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Args)).all); + Res := Eval (Expr, E); + return Res; + end Let_Processing; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + + function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + Ast : Mal_Handle renames Param; -- Historic + begin + declare + M : Mal_Handle; + B : Boolean; + begin + M := Envs.Get (Env, "DEBUG-EVAL"); + case Deref (M).Sym_Type is + when Bool => B := Deref_Bool (M).Get_Bool; + when Nil => B := False; + when others => B := True; + end case; + if B then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Ast).Sym_Type is + + when Sym => + + declare + Sym : Mal_String := Deref_Sym (Ast).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Ast; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + declare + Evaled_H, First_Param, Rest_List : Mal_Handle; + Param_List : List_Mal_Type; + begin + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_List := Cdr (Param_List); + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + return Def_Fn (Deref_List (Rest_List).all, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + return Let_Processing (Deref_List (Rest_List).all, Env); + else + -- The APPLY section. + Evaled_H := Eval_Ast (Param, Env); + Param_List := Deref_List (Evaled_H).all; + First_Param := Car (Param_List); + return Call_Func (Deref_Func (First_Param).all, Cdr (Param_List)); + end if; + + end; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + procedure Init (Env : Envs.Env_Handle) is + begin + + Envs.Set (Env, + "+", + New_Func_Mal_Type ("+", Plus'Unrestricted_Access)); + + Envs.Set (Env, + "-", + New_Func_Mal_Type ("-", Minus'Unrestricted_Access)); + + Envs.Set (Env, + "*", + New_Func_Mal_Type ("*", Mult'Unrestricted_Access)); + + Envs.Set (Env, + "/", + New_Func_Mal_Type ("/", Divide'Unrestricted_Access)); + + end Init; + + + Repl_Env : Envs.Env_Handle; +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Repl_Env := Envs.New_Env; + + Init (Repl_Env); + + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Ada.Exceptions.Exception_Information (E)); + end; + end loop; +end Step3_Env; diff --git a/impls/ada/step4_if_fn_do.adb b/impls/ada/step4_if_fn_do.adb new file mode 100644 index 0000000000..a86c6e7d8c --- /dev/null +++ b/impls/ada/step4_if_fn_do.adb @@ -0,0 +1,321 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Core; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step4_If_Fn_Do is + + use Types; + + function Eval (Param : Types.Mal_Handle; Env : Envs.Env_Handle) + return Types.Mal_Handle; + + Debug : Boolean := False; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected symbol as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Let_Processing (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Args); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Args)).all); + Res := Eval (Expr, E); + return Res; + end Let_Processing; + + + function Do_Processing (Do_List : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + D : List_Mal_Type; + Res : Mal_Handle := Smart_Pointers.Null_Smart_Pointer; + begin + if Debug then + Ada.Text_IO.Put_Line ("Do-ing " & To_String (Do_List)); + end if; + D := Do_List; + while not Is_Null (D) loop + Res := Eval (Car (D), Env); + D := Deref_List (Cdr(D)).all; + end loop; + return Res; + end Do_Processing; + + + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + + function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; + Ast : Mal_Handle renames Param; -- Historic + begin + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Ast).Sym_Type is + + when Sym => + + declare + Sym : Mal_String := Deref_Sym (Ast).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Ast; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + + return Def_Fn (Rest_List, Env); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + + return Let_Processing (Rest_List, Env); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "do" then + + return Do_Processing (Rest_List, Env); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "if" then + + declare + Cond, True_Part, False_Part : Mal_Handle; + Cond_Bool : Boolean; + pragma Assert (Length (Rest_List) = 2 or Length (Rest_List) = 3, + "If_Processing: not 2 or 3 parameters"); + L : List_Mal_Type; + begin + + Cond := Eval (Car (Rest_List), Env); + + Cond_Bool := Eval_As_Boolean (Cond); + + if Cond_Bool then + L := Deref_List (Cdr (Rest_List)).all; + return Eval (Car (L), Env); + else + if Length (Rest_List) = 3 then + L := Deref_List (Cdr (Rest_List)).all; + L := Deref_List (Cdr (L)).all; + return Eval (Car (L), Env); + else + return New_Nil_Mal_Type; + end if; + end if; + + end; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "fn*" then + + return New_Lambda_Mal_Type + (Params => Car (Rest_List), + Expr => Nth (Rest_List, 1), + Env => Env); + + else + + -- The APPLY section. + declare + Evaled_H : Mal_Handle; + begin + Evaled_H := Eval_Ast (Param, Env); + + Param_List := Deref_List (Evaled_H).all; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Func then + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + elsif Deref (First_Param).Sym_Type = Lambda then + return Apply (Deref_Lambda (First_Param).all, Rest_Params); + else + raise Mal_Exception; + end if; + + end; + + end if; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + Repl_Env : Envs.Env_Handle; + + + -- This op uses Repl_Env directly. + + + procedure RE (Str : Mal_String) is + Discarded : Mal_Handle; + begin + Discarded := Eval (Read (Str), Repl_Env); + end RE; + + + Cmd_Args : Natural; + +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Cmd_Args := 0; + while Ada.Command_Line.Argument_Count > Cmd_Args loop + Cmd_Args := Cmd_Args + 1; + if Ada.Command_Line.Argument (Cmd_Args) = "-d" then + Debug := True; + elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then + Envs.Debug := True; + end if; + end loop; + + Repl_Env := Envs.New_Env; + + Core.Init (Repl_Env); + + RE ("(def! not (fn* (a) (if a false true)))"); + + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + "Error: " & Ada.Exceptions.Exception_Information (E)); + if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Printer.Pr_Str (Types.Mal_Exception_Value)); + Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; + end if; + end; + end loop; +end Step4_If_Fn_Do; diff --git a/impls/ada/step5_tco.adb b/impls/ada/step5_tco.adb new file mode 100644 index 0000000000..e0b2eb0299 --- /dev/null +++ b/impls/ada/step5_tco.adb @@ -0,0 +1,375 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Core; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step5_TCO is + + use Types; + + -- Forward declaration of Eval. + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle; + + Debug : Boolean := False; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected atom as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) + return Mal_Handle is + Param : Mal_Handle; + Env : Envs.Env_Handle; + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; + Ast : Mal_Handle renames Param; -- Historic + begin + + Param := AParam; + Env := AnEnv; + + <> + + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Ast).Sym_Type is + + when Sym => + + declare + Sym : Mal_String := Deref_Sym (Ast).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Ast; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + return Def_Fn (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + declare + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Rest_List); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Rest_List)).all); + Param := Expr; + Env := E; + goto Tail_Call_Opt; + -- was: + -- Res := Eval (Expr, E); + -- return Res; + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "do" then + declare + D : List_Mal_Type; + E : Mal_Handle; + begin + + if Debug then + Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); + end if; + + if Is_Null (Rest_List) then + return Rest_Params; + end if; + + -- Loop processes Evals all but last entry + D := Rest_List; + loop + E := Car (D); + D := Deref_List (Cdr (D)).all; + exit when Is_Null (D); + E := Eval (E, Env); + end loop; + + Param := E; + goto Tail_Call_Opt; + + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "if" then + declare + Args : List_Mal_Type := Rest_List; + + Cond, True_Part, False_Part : Mal_Handle; + Cond_Bool : Boolean; + pragma Assert (Length (Args) = 2 or Length (Args) = 3, + "If_Processing: not 2 or 3 parameters"); + L : List_Mal_Type; + begin + + Cond := Eval (Car (Args), Env); + + Cond_Bool := Eval_As_Boolean (Cond); + + if Cond_Bool then + L := Deref_List (Cdr (Args)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + if Length (Args) = 3 then + L := Deref_List (Cdr (Args)).all; + L := Deref_List (Cdr (L)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + return New_Nil_Mal_Type; + end if; + end if; + end; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "fn*" then + + return New_Lambda_Mal_Type + (Params => Car (Rest_List), + Expr => Nth (Rest_List, 1), + Env => Env); + + else + + -- The APPLY section. + declare + Evaled_H : Mal_Handle; + begin + Evaled_H := Eval_Ast (Param, Env); + + Param_List := Deref_List (Evaled_H).all; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Func then + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + elsif Deref (First_Param).Sym_Type = Lambda then + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then + + Param := L.Get_Expr; + Env := E; + goto Tail_Call_Opt; + -- was: return Eval (L.Get_Expr, E); + + else + + raise Mal_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func + raise Mal_Exception; + end if; + + end; + + end if; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + Repl_Env : Envs.Env_Handle; + + + -- These two ops use Repl_Env directly. + + + procedure RE (Str : Mal_String) is + Discarded : Mal_Handle; + begin + Discarded := Eval (Read (Str), Repl_Env); + end RE; + + + function Do_Eval (Rest_Handle : Mal_Handle; Env : Envs.Env_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Eval_Callback.Eval.all (First_Param, Repl_Env); + end Do_Eval; + + Cmd_Args : Natural; + +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Cmd_Args := 0; + while Ada.Command_Line.Argument_Count > Cmd_Args loop + Cmd_Args := Cmd_Args + 1; + if Ada.Command_Line.Argument (Cmd_Args) = "-d" then + Debug := True; + elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then + Envs.Debug := True; + end if; + end loop; + + Repl_Env := Envs.New_Env; + + Core.Init (Repl_Env); + + RE ("(def! not (fn* (a) (if a false true)))"); + + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + "Error: " & Ada.Exceptions.Exception_Information (E)); + if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Printer.Pr_Str (Types.Mal_Exception_Value)); + Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; + end if; + end; + end loop; +end Step5_TCO; diff --git a/impls/ada/step6_file.adb b/impls/ada/step6_file.adb new file mode 100644 index 0000000000..3d800856c1 --- /dev/null +++ b/impls/ada/step6_file.adb @@ -0,0 +1,410 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Core; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step6_File is + + use Types; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + -- Forward declaration of Eval. + function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) + return Types.Mal_Handle; + + + Debug : Boolean := False; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected atom as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) + return Mal_Handle is + Param : Mal_Handle; + Env : Envs.Env_Handle; + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; + Ast : Mal_Handle renames Param; -- Historic + begin + + Param := AParam; + Env := AnEnv; + + <> + + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + + case Deref (Ast).Sym_Type is + + when Sym => + + declare + Sym : Mal_String := Deref_Sym (Ast).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Ast; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + return Def_Fn (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + declare + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Rest_List); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Rest_List)).all); + Param := Expr; + Env := E; + goto Tail_Call_Opt; + -- was: + -- Res := Eval (Expr, E); + -- return Res; + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "do" then + declare + D : List_Mal_Type; + E : Mal_Handle; + begin + + if Debug then + Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); + end if; + + if Is_Null (Rest_List) then + return Rest_Params; + end if; + + -- Loop processes Evals all but last entry + D := Rest_List; + loop + E := Car (D); + D := Deref_List (Cdr (D)).all; + exit when Is_Null (D); + E := Eval (E, Env); + end loop; + + Param := E; + goto Tail_Call_Opt; + + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "if" then + declare + Args : List_Mal_Type := Rest_List; + + Cond, True_Part, False_Part : Mal_Handle; + Cond_Bool : Boolean; + pragma Assert (Length (Args) = 2 or Length (Args) = 3, + "If_Processing: not 2 or 3 parameters"); + L : List_Mal_Type; + begin + + Cond := Eval (Car (Args), Env); + + Cond_Bool := Eval_As_Boolean (Cond); + + if Cond_Bool then + L := Deref_List (Cdr (Args)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + if Length (Args) = 3 then + L := Deref_List (Cdr (Args)).all; + L := Deref_List (Cdr (L)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + return New_Nil_Mal_Type; + end if; + end if; + end; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "fn*" then + + return New_Lambda_Mal_Type + (Params => Car (Rest_List), + Expr => Nth (Rest_List, 1), + Env => Env); + + else + + -- The APPLY section. + declare + Evaled_H : Mal_Handle; + begin + Evaled_H := Eval_Ast (Param, Env); + + Param_List := Deref_List (Evaled_H).all; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Func then + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + elsif Deref (First_Param).Sym_Type = Lambda then + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then + + Param := L.Get_Expr; + Env := E; + goto Tail_Call_Opt; + -- was: return Eval (L.Get_Expr, E); + + else + + raise Runtime_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func + raise Runtime_Exception with "Deref called on non-Func/Lambda"; + end if; + + end; + + end if; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + Repl_Env : Envs.Env_Handle; + + + -- These two ops use Repl_Env directly. + + + procedure RE (Str : Mal_String) is + Discarded : Mal_Handle; + begin + Discarded := Eval (Read (Str), Repl_Env); + end RE; + + + function Do_Eval (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Eval_Callback.Eval.all (First_Param, Repl_Env); + end Do_Eval; + + + Cmd_Args, File_Param : Natural; + Command_Args : Types.Mal_Handle; + Command_List : Types.List_Ptr; + File_Processed : Boolean := False; + +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Repl_Env := Envs.New_Env; + + -- Core init also creates the first environment. + -- This is needed for the def!'s below. + Core.Init (Repl_Env); + + -- Register the eval command. This needs to be done here rather than Core.Init + -- as it requires direct access to Repl_Env. + Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); + + RE ("(def! not (fn* (a) (if a false true)))"); + RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); + + -- Command line processing. + + Cmd_Args := 0; + Command_Args := Types.New_List_Mal_Type (Types.List_List); + Command_List := Types.Deref_List (Command_Args); + + while Ada.Command_Line.Argument_Count > Cmd_Args loop + + Cmd_Args := Cmd_Args + 1; + if Ada.Command_Line.Argument (Cmd_Args) = "-d" then + Debug := True; + elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then + Envs.Debug := True; + elsif not File_Processed then + File_Param := Cmd_Args; + File_Processed := True; + else + Command_List.Append + (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); + end if; + + end loop; + + Envs.Set (Repl_Env, "*ARGV*", Command_Args); + + if File_Processed then + RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); + else + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + "Error: " & Ada.Exceptions.Exception_Information (E)); + if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Printer.Pr_Str (Types.Mal_Exception_Value)); + Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; + end if; + end; + end loop; + end if; +end Step6_File; diff --git a/impls/ada/step7_quote.adb b/impls/ada/step7_quote.adb new file mode 100644 index 0000000000..6250c5966f --- /dev/null +++ b/impls/ada/step7_quote.adb @@ -0,0 +1,489 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Core; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step7_Quote is + + use Types; + + function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) + return Types.Mal_Handle; + + Debug : Boolean := False; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected atom as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; + + function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is + Res, Elt, New_Res : Mal_Handle; + L : List_Ptr; + begin + + if Debug then + Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); + end if; + + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; + + if Deref (Param).Sym_Type /= List or else + Deref_List_Class (Param).Get_List_Type = Hashed_List then + + -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); + L.Append (New_Symbol_Mal_Type ("quote")); + L.Append (Param); + return Res; + + end if; + + -- if the first element of ast is a symbol named "unquote": + if Starts_With (Param, "unquote") then + -- return the second element of ast.` + return Deref_List_Class (Param).Nth (1); + + end if; + + Res := New_List_Mal_Type (List_List); + + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then + L.Append (New_Symbol_Mal_Type ("concat")); + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); + end if; + L.Append (Res); + Res := New_Res; + end loop; + + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; + end if; + + return Res; + + end Quasi_Quote_Processing; + + + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) + return Mal_Handle is + Param : Mal_Handle; + Env : Envs.Env_Handle; + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; + begin + + Param := AParam; + Env := AnEnv; + + <> + + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Param).Sym_Type is + when Sym => + declare + Sym : Mal_String := Deref_Sym (Param).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Param; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + return Def_Fn (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + declare + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Rest_List); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Rest_List)).all); + Param := Expr; + Env := E; + goto Tail_Call_Opt; + -- was: + -- Res := Eval (Expr, E); + -- return Res; + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "do" then + declare + D : List_Mal_Type; + E : Mal_Handle; + begin + + if Debug then + Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); + end if; + + if Is_Null (Rest_List) then + return Rest_Params; + end if; + + -- Loop processes Evals all but last entry + D := Rest_List; + loop + E := Car (D); + D := Deref_List (Cdr (D)).all; + exit when Is_Null (D); + E := Eval (E, Env); + end loop; + + Param := E; + goto Tail_Call_Opt; + + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "if" then + declare + Args : List_Mal_Type := Rest_List; + + Cond, True_Part, False_Part : Mal_Handle; + Cond_Bool : Boolean; + pragma Assert (Length (Args) = 2 or Length (Args) = 3, + "If_Processing: not 2 or 3 parameters"); + L : List_Mal_Type; + begin + + Cond := Eval (Car (Args), Env); + + Cond_Bool := Eval_As_Boolean (Cond); + + if Cond_Bool then + L := Deref_List (Cdr (Args)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + if Length (Args) = 3 then + L := Deref_List (Cdr (Args)).all; + L := Deref_List (Cdr (L)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + return New_Nil_Mal_Type; + end if; + end if; + end; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "fn*" then + + return New_Lambda_Mal_Type + (Params => Car (Rest_List), + Expr => Nth (Rest_List, 1), + Env => Env); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quote" then + + return Car (Rest_List); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquote" then + + Param := Quasi_Quote_Processing (Car (Rest_List)); + goto Tail_Call_Opt; + + else + + -- The APPLY section. + declare + Evaled_H : Mal_Handle; + begin + Evaled_H := Eval_Ast (Param, Env); + + Param_List := Deref_List (Evaled_H).all; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Func then + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + elsif Deref (First_Param).Sym_Type = Lambda then + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then + + Param := L.Get_Expr; + Env := E; + goto Tail_Call_Opt; + -- was: return Eval (L.Get_Expr, E); + + else + + raise Runtime_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func + raise Runtime_Exception with "Deref called on non-Func/Lambda"; + end if; + + end; + + end if; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + Repl_Env : Envs.Env_Handle; + + + -- These two ops use Repl_Env directly. + + + procedure RE (Str : Mal_String) is + Discarded : Mal_Handle; + begin + Discarded := Eval (Read (Str), Repl_Env); + end RE; + + + function Do_Eval (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Eval_Callback.Eval.all (First_Param, Repl_Env); + end Do_Eval; + + + Cmd_Args, File_Param : Natural; + Command_Args : Types.Mal_Handle; + Command_List : Types.List_Ptr; + File_Processed : Boolean := False; + +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Repl_Env := Envs.New_Env; + + -- Core init also creates the first environment. + -- This is needed for the def!'s below. + Core.Init (Repl_Env); + + -- Register the eval command. This needs to be done here rather than Core.Init + -- as it requires direct access to Repl_Env. + Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); + + RE ("(def! not (fn* (a) (if a false true)))"); + RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); + + -- Command line processing. + + Cmd_Args := 0; + Command_Args := Types.New_List_Mal_Type (Types.List_List); + Command_List := Types.Deref_List (Command_Args); + + while Ada.Command_Line.Argument_Count > Cmd_Args loop + + Cmd_Args := Cmd_Args + 1; + if Ada.Command_Line.Argument (Cmd_Args) = "-d" then + Debug := True; + elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then + Envs.Debug := True; + elsif not File_Processed then + File_Param := Cmd_Args; + File_Processed := True; + else + Command_List.Append + (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); + end if; + + end loop; + + Envs.Set (Repl_Env, "*ARGV*", Command_Args); + + if File_Processed then + RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); + else + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + "Error: " & Ada.Exceptions.Exception_Information (E)); + if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Printer.Pr_Str (Types.Mal_Exception_Value)); + Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; + end if; + end; + end loop; + end if; +end Step7_Quote; diff --git a/impls/ada/step8_macros.adb b/impls/ada/step8_macros.adb new file mode 100644 index 0000000000..c25d4f62f2 --- /dev/null +++ b/impls/ada/step8_macros.adb @@ -0,0 +1,513 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Core; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step8_Macros is + + use Types; + + function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) + return Types.Mal_Handle; + + Debug : Boolean := False; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected atom as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Def_Macro (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + Lambda_P : Lambda_Ptr; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Macro: expected atom as name"); + Fn_Body := Car (Deref_List (Cdr (Args)).all); + Res := Eval (Fn_Body, Env); + Lambda_P := Deref_Lambda (Res); + Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params, + Expr => Lambda_P.all.Get_Expr, + Env => Lambda_P.all.Get_Env); + Deref_Lambda (Res).Set_Is_Macro (True); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Macro; + + + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; + + function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is + Res, Elt, New_Res : Mal_Handle; + L : List_Ptr; + begin + + if Debug then + Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); + end if; + + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; + + if Deref (Param).Sym_Type /= List or else + Deref_List_Class (Param).Get_List_Type = Hashed_List then + + -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); + L.Append (New_Symbol_Mal_Type ("quote")); + L.Append (Param); + return Res; + + end if; + + -- if the first element of ast is a symbol named "unquote": + if Starts_With (Param, "unquote") then + -- return the second element of ast.` + return Deref_List_Class (Param).Nth (1); + + end if; + + Res := New_List_Mal_Type (List_List); + + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then + L.Append (New_Symbol_Mal_Type ("concat")); + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); + end if; + L.Append (Res); + Res := New_Res; + end loop; + + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; + end if; + + return Res; + + end Quasi_Quote_Processing; + + + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) + return Mal_Handle is + Param : Mal_Handle; + Env : Envs.Env_Handle; + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; + begin + + Param := AParam; + Env := AnEnv; + + <> + + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Param).Sym_Type is + when Sym => + declare + Sym : Mal_String := Deref_Sym (Param).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Param; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + return Def_Fn (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "defmacro!" then + return Def_Macro (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + declare + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Rest_List); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Rest_List)).all); + Param := Expr; + Env := E; + goto Tail_Call_Opt; + -- was: + -- Res := Eval (Expr, E); + -- return Res; + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "do" then + declare + D : List_Mal_Type; + E : Mal_Handle; + begin + + if Debug then + Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); + end if; + + if Is_Null (Rest_List) then + return Rest_Params; + end if; + + -- Loop processes Evals all but last entry + D := Rest_List; + loop + E := Car (D); + D := Deref_List (Cdr (D)).all; + exit when Is_Null (D); + E := Eval (E, Env); + end loop; + + Param := E; + goto Tail_Call_Opt; + + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "if" then + declare + Args : List_Mal_Type := Rest_List; + + Cond, True_Part, False_Part : Mal_Handle; + Cond_Bool : Boolean; + pragma Assert (Length (Args) = 2 or Length (Args) = 3, + "If_Processing: not 2 or 3 parameters"); + L : List_Mal_Type; + begin + + Cond := Eval (Car (Args), Env); + + Cond_Bool := Eval_As_Boolean (Cond); + + if Cond_Bool then + L := Deref_List (Cdr (Args)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + if Length (Args) = 3 then + L := Deref_List (Cdr (Args)).all; + L := Deref_List (Cdr (L)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + return New_Nil_Mal_Type; + end if; + end if; + end; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "fn*" then + + return New_Lambda_Mal_Type + (Params => Car (Rest_List), + Expr => Nth (Rest_List, 1), + Env => Env); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quote" then + + return Car (Rest_List); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquote" then + + Param := Quasi_Quote_Processing (Car (Rest_List)); + goto Tail_Call_Opt; + + else + + -- The APPLY section. + First_Param := Eval (First_Param, Env); + + if Deref (First_Param).Sym_Type = Func then + Rest_Params := Eval_Ast (Rest_Params, Env); + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + elsif Deref (First_Param).Sym_Type = Lambda then + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + + if L.Get_Is_Macro then + -- Apply to *unevaluated* arguments + Param := L.Apply (Rest_Params); + -- then EVAL the result. + goto Tail_Call_Opt; + end if; + + Rest_Params := Eval_Ast (Rest_Params, Env); + + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then + + Param := L.Get_Expr; + Env := E; + goto Tail_Call_Opt; + -- was: return Eval (L.Get_Expr, E); + + else + + raise Runtime_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func + raise Runtime_Exception with "Deref called on non-Func/Lambda"; + end if; + + end if; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + Repl_Env : Envs.Env_Handle; + + + -- These two ops use Repl_Env directly. + + + procedure RE (Str : Mal_String) is + Discarded : Mal_Handle; + begin + Discarded := Eval (Read (Str), Repl_Env); + end RE; + + + function Do_Eval (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Eval_Callback.Eval.all (First_Param, Repl_Env); + end Do_Eval; + + + Cmd_Args, File_Param : Natural; + Command_Args : Types.Mal_Handle; + Command_List : Types.List_Ptr; + File_Processed : Boolean := False; + +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Repl_Env := Envs.New_Env; + + -- Core init also creates the first environment. + -- This is needed for the def!'s below. + Core.Init (Repl_Env); + + -- Register the eval command. This needs to be done here rather than Core.Init + -- as it requires direct access to Repl_Env. + Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); + + RE ("(def! not (fn* (a) (if a false true)))"); + RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); + RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))"); + + -- Command line processing. + + Cmd_Args := 0; + Command_Args := Types.New_List_Mal_Type (Types.List_List); + Command_List := Types.Deref_List (Command_Args); + + while Ada.Command_Line.Argument_Count > Cmd_Args loop + + Cmd_Args := Cmd_Args + 1; + if Ada.Command_Line.Argument (Cmd_Args) = "-d" then + Debug := True; + elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then + Envs.Debug := True; + elsif not File_Processed then + File_Param := Cmd_Args; + File_Processed := True; + else + Command_List.Append + (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); + end if; + + end loop; + + Envs.Set (Repl_Env, "*ARGV*", Command_Args); + + if File_Processed then + RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); + else + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + "Error: " & Ada.Exceptions.Exception_Information (E)); + if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Printer.Pr_Str (Types.Mal_Exception_Value)); + Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; + end if; + end; + end loop; + end if; +end Step8_Macros; diff --git a/impls/ada/step9_try.adb b/impls/ada/step9_try.adb new file mode 100644 index 0000000000..f249276726 --- /dev/null +++ b/impls/ada/step9_try.adb @@ -0,0 +1,566 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Core; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure Step9_Try is + + use Types; + + function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) + return Types.Mal_Handle; + + Debug : Boolean := False; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected atom as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Def_Macro (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + Lambda_P : Lambda_Ptr; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Macro: expected atom as name"); + Fn_Body := Car (Deref_List (Cdr (Args)).all); + Res := Eval (Fn_Body, Env); + Lambda_P := Deref_Lambda (Res); + Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params, + Expr => Lambda_P.all.Get_Expr, + Env => Lambda_P.all.Get_Env); + Deref_Lambda (Res).Set_Is_Macro (True); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Macro; + + + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; + + function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is + Res, Elt, New_Res : Mal_Handle; + L : List_Ptr; + begin + + if Debug then + Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); + end if; + + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; + + if Deref (Param).Sym_Type /= List or else + Deref_List_Class (Param).Get_List_Type = Hashed_List then + + -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); + L.Append (New_Symbol_Mal_Type ("quote")); + L.Append (Param); + return Res; + + end if; + + -- if the first element of ast is a symbol named "unquote": + if Starts_With (Param, "unquote") then + -- return the second element of ast.` + return Deref_List_Class (Param).Nth (1); + + end if; + + Res := New_List_Mal_Type (List_List); + + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then + L.Append (New_Symbol_Mal_Type ("concat")); + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); + end if; + L.Append (Res); + Res := New_Res; + end loop; + + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; + end if; + + return Res; + + end Quasi_Quote_Processing; + + + function Catch_Processing + (Try_Line : Mal_Handle; + ExStr : Mal_Handle; + Env : Envs.Env_Handle) + return Mal_Handle is + + L, CL, CL2, CL3 : List_Mal_Type; + C : Mal_Handle; + New_Env : Envs.Env_Handle; + + begin + + L := Deref_List (Try_Line).all; + C := Car (L); + -- CL is the list with the catch in. + CL := Deref_List (C).all; + + CL2 := Deref_List (Cdr (CL)).all; + New_Env := Envs.New_Env (Env); + Envs.Set (New_Env, Deref_Sym (Car (CL2)).Get_Sym, ExStr); + + CL3 := Deref_List (Cdr (CL2)).all; + return Eval (Car (CL3), New_Env); + end Catch_Processing; + + + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) + return Mal_Handle is + Param : Mal_Handle; + Env : Envs.Env_Handle; + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; + begin + + Param := AParam; + Env := AnEnv; + + <> + + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Param).Sym_Type is + when Sym => + declare + Sym : Mal_String := Deref_Sym (Param).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Param; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + return Def_Fn (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "defmacro!" then + return Def_Macro (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + declare + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Rest_List); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Rest_List)).all); + Param := Expr; + Env := E; + goto Tail_Call_Opt; + -- was: + -- Res := Eval (Expr, E); + -- return Res; + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "do" then + declare + D : List_Mal_Type; + E : Mal_Handle; + begin + + if Debug then + Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); + end if; + + if Is_Null (Rest_List) then + return Rest_Params; + end if; + + -- Loop processes Evals all but last entry + D := Rest_List; + loop + E := Car (D); + D := Deref_List (Cdr (D)).all; + exit when Is_Null (D); + E := Eval (E, Env); + end loop; + + Param := E; + goto Tail_Call_Opt; + + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "if" then + declare + Args : List_Mal_Type := Rest_List; + + Cond, True_Part, False_Part : Mal_Handle; + Cond_Bool : Boolean; + pragma Assert (Length (Args) = 2 or Length (Args) = 3, + "If_Processing: not 2 or 3 parameters"); + L : List_Mal_Type; + begin + + Cond := Eval (Car (Args), Env); + + Cond_Bool := Eval_As_Boolean (Cond); + + if Cond_Bool then + L := Deref_List (Cdr (Args)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + if Length (Args) = 3 then + L := Deref_List (Cdr (Args)).all; + L := Deref_List (Cdr (L)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + return New_Nil_Mal_Type; + end if; + end if; + end; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "fn*" then + + return New_Lambda_Mal_Type + (Params => Car (Rest_List), + Expr => Nth (Rest_List, 1), + Env => Env); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quote" then + + return Car (Rest_List); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquote" then + + Param := Quasi_Quote_Processing (Car (Rest_List)); + goto Tail_Call_Opt; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "try*" then + + if Length (Rest_List) = 1 then + return Eval (Car (Rest_List), Env); + end if; + declare + Res : Mal_Handle; + begin + return Eval (Car (Rest_List), Env); + exception + when Mal_Exception => + Res := Catch_Processing + (Cdr (Rest_List), + Types.Mal_Exception_Value, + Env); + Types.Mal_Exception_Value := + Smart_Pointers.Null_Smart_Pointer; + return Res; + when E : others => + return Catch_Processing + (Cdr (Rest_List), + New_String_Mal_Type + (Ada.Exceptions.Exception_Message (E)), + Env); + end; + + else + + -- The APPLY section. + First_Param := Eval (First_Param, Env); + + if Deref (First_Param).Sym_Type = Func then + Rest_Params := Eval_Ast (Rest_Params, Env); + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + elsif Deref (First_Param).Sym_Type = Lambda then + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + + if L.Get_Is_Macro then + -- Apply to *unevaluated* arguments + Param := L.Apply (Rest_Params); + -- then EVAL the result. + goto Tail_Call_Opt; + end if; + + Rest_Params := Eval_Ast (Rest_Params, Env); + + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then + + Param := L.Get_Expr; + Env := E; + goto Tail_Call_Opt; + -- was: return Eval (L.Get_Expr, E); + + else + + raise Runtime_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func + raise Runtime_Exception with "Deref called on non-Func/Lambda"; + end if; + + end if; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + Repl_Env : Envs.Env_Handle; + + + -- These two ops use Repl_Env directly. + + + procedure RE (Str : Mal_String) is + Discarded : Mal_Handle; + begin + Discarded := Eval (Read (Str), Repl_Env); + end RE; + + + function Do_Eval (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Eval_Callback.Eval.all (First_Param, Repl_Env); + end Do_Eval; + + + Cmd_Args, File_Param : Natural; + Command_Args : Types.Mal_Handle; + Command_List : Types.List_Ptr; + File_Processed : Boolean := False; + +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Repl_Env := Envs.New_Env; + + -- Core init also creates the first environment. + -- This is needed for the def!'s below. + Core.Init (Repl_Env); + + -- Register the eval command. This needs to be done here rather than Core.Init + -- as it requires direct access to Repl_Env. + Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); + + RE ("(def! not (fn* (a) (if a false true)))"); + RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); + RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))"); + + -- Command line processing. + + Cmd_Args := 0; + Command_Args := Types.New_List_Mal_Type (Types.List_List); + Command_List := Types.Deref_List (Command_Args); + + while Ada.Command_Line.Argument_Count > Cmd_Args loop + + Cmd_Args := Cmd_Args + 1; + if Ada.Command_Line.Argument (Cmd_Args) = "-d" then + Debug := True; + elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then + Envs.Debug := True; + elsif not File_Processed then + File_Param := Cmd_Args; + File_Processed := True; + else + Command_List.Append + (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); + end if; + + end loop; + + Envs.Set (Repl_Env, "*ARGV*", Command_Args); + + if File_Processed then + RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); + else + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + "Error: " & Ada.Exceptions.Exception_Information (E)); + if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Printer.Pr_Str (Types.Mal_Exception_Value)); + Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; + end if; + end; + end loop; + end if; +end Step9_Try; diff --git a/impls/ada/stepa_mal.adb b/impls/ada/stepa_mal.adb new file mode 100644 index 0000000000..ff5807bf2f --- /dev/null +++ b/impls/ada/stepa_mal.adb @@ -0,0 +1,567 @@ +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; +with Core; +with Envs; +with Eval_Callback; +with Printer; +with Reader; +with Smart_Pointers; +with Types; + +procedure StepA_Mal is + + use Types; + + function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) + return Types.Mal_Handle; + + Debug : Boolean := False; + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; + + + function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Fn: expected atom as name"); + Fn_Body := Nth (Args, 1); + Res := Eval (Fn_Body, Env); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Fn; + + + function Def_Macro (Args : List_Mal_Type; Env : Envs.Env_Handle) + return Mal_Handle is + Name, Fn_Body, Res : Mal_Handle; + Lambda_P : Lambda_Ptr; + begin + Name := Car (Args); + pragma Assert (Deref (Name).Sym_Type = Sym, + "Def_Macro: expected atom as name"); + Fn_Body := Car (Deref_List (Cdr (Args)).all); + Res := Eval (Fn_Body, Env); + Lambda_P := Deref_Lambda (Res); + Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params, + Expr => Lambda_P.all.Get_Expr, + Env => Lambda_P.all.Get_Env); + Deref_Lambda (Res).Set_Is_Macro (True); + Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); + return Res; + end Def_Macro; + + + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval_Ast + (Ast : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + + begin + pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + end Eval_Ast; + + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; + + function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is + Res, Elt, New_Res : Mal_Handle; + L : List_Ptr; + begin + + if Debug then + Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); + end if; + + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; + + if Deref (Param).Sym_Type /= List or else + Deref_List_Class (Param).Get_List_Type = Hashed_List then + + -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); + L.Append (New_Symbol_Mal_Type ("quote")); + L.Append (Param); + return Res; + + end if; + + -- if the first element of ast is a symbol named "unquote": + if Starts_With (Param, "unquote") then + -- return the second element of ast.` + return Deref_List_Class (Param).Nth (1); + + end if; + + Res := New_List_Mal_Type (List_List); + + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then + L.Append (New_Symbol_Mal_Type ("concat")); + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); + end if; + L.Append (Res); + Res := New_Res; + end loop; + + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; + end if; + + return Res; + + end Quasi_Quote_Processing; + + + function Catch_Processing + (Try_Line : Mal_Handle; + ExStr : Mal_Handle; + Env : Envs.Env_Handle) + return Mal_Handle is + + L, CL, CL2, CL3 : List_Mal_Type; + C : Mal_Handle; + New_Env : Envs.Env_Handle; + + begin + + L := Deref_List (Try_Line).all; + C := Car (L); + -- CL is the list with the catch in. + CL := Deref_List (C).all; + + CL2 := Deref_List (Cdr (CL)).all; + New_Env := Envs.New_Env (Env); + Envs.Set (New_Env, Deref_Sym (Car (CL2)).Get_Sym, ExStr); + + CL3 := Deref_List (Cdr (CL2)).all; + return Eval (Car (CL3), New_Env); + end Catch_Processing; + + + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) + return Mal_Handle is + Param : Mal_Handle; + Env : Envs.Env_Handle; + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; + begin + + Param := AParam; + Env := AnEnv; + + <> + + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Param).Sym_Type is + when Sym => + declare + Sym : Mal_String := Deref_Sym (Param).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Param; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + return Eval_Ast (Param, Env); + when List_List => + + Param_List := Deref_List (Param).all; + + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; + + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then + return Def_Fn (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "defmacro!" then + return Def_Macro (Rest_List, Env); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then + declare + Defs, Expr, Res : Mal_Handle; + E : Envs.Env_Handle; + begin + E := Envs.New_Env (Env); + Defs := Car (Rest_List); + Deref_List_Class (Defs).Add_Defs (E); + Expr := Car (Deref_List (Cdr (Rest_List)).all); + Param := Expr; + Env := E; + goto Tail_Call_Opt; + -- was: + -- Res := Eval (Expr, E); + -- return Res; + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "do" then + declare + D : List_Mal_Type; + E : Mal_Handle; + begin + + if Debug then + Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); + end if; + + if Is_Null (Rest_List) then + return Rest_Params; + end if; + + -- Loop processes Evals all but last entry + D := Rest_List; + loop + E := Car (D); + D := Deref_List (Cdr (D)).all; + exit when Is_Null (D); + E := Eval (E, Env); + end loop; + + Param := E; + goto Tail_Call_Opt; + + end; + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "if" then + declare + Args : List_Mal_Type := Rest_List; + + Cond, True_Part, False_Part : Mal_Handle; + Cond_Bool : Boolean; + pragma Assert (Length (Args) = 2 or Length (Args) = 3, + "If_Processing: not 2 or 3 parameters"); + L : List_Mal_Type; + begin + + Cond := Eval (Car (Args), Env); + + Cond_Bool := Eval_As_Boolean (Cond); + + if Cond_Bool then + L := Deref_List (Cdr (Args)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + if Length (Args) = 3 then + L := Deref_List (Cdr (Args)).all; + L := Deref_List (Cdr (L)).all; + + Param := Car (L); + goto Tail_Call_Opt; + -- was: return Eval (Car (L), Env); + else + return New_Nil_Mal_Type; + end if; + end if; + end; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "fn*" then + + return New_Lambda_Mal_Type + (Params => Car (Rest_List), + Expr => Nth (Rest_List, 1), + Env => Env); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quote" then + + return Car (Rest_List); + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquote" then + + Param := Quasi_Quote_Processing (Car (Rest_List)); + goto Tail_Call_Opt; + + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "try*" then + + if Length (Rest_List) = 1 then + return Eval (Car (Rest_List), Env); + end if; + declare + Res : Mal_Handle; + begin + return Eval (Car (Rest_List), Env); + exception + when Mal_Exception => + Res := Catch_Processing + (Cdr (Rest_List), + Types.Mal_Exception_Value, + Env); + Types.Mal_Exception_Value := + Smart_Pointers.Null_Smart_Pointer; + return Res; + when E : others => + return Catch_Processing + (Cdr (Rest_List), + New_String_Mal_Type + (Ada.Exceptions.Exception_Message (E)), + Env); + end; + + else + + -- The APPLY section. + First_Param := Eval (First_Param, Env); + + if Deref (First_Param).Sym_Type = Func then + Rest_Params := Eval_Ast (Rest_Params, Env); + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + elsif Deref (First_Param).Sym_Type = Lambda then + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + + if L.Get_Is_Macro then + -- Apply to *unevaluated* arguments + Param := L.Apply (Rest_Params); + -- then EVAL the result. + goto Tail_Call_Opt; + end if; + + Rest_Params := Eval_Ast (Rest_Params, Env); + + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then + + Param := L.Get_Expr; + Env := E; + goto Tail_Call_Opt; + -- was: return Eval (L.Get_Expr, E); + + else + + raise Runtime_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func + raise Runtime_Exception with "Deref called on non-Func/Lambda"; + end if; + + end if; + + end case; + when others => -- not a list, map, symbol or vector + return Param; + end case; + end Eval; + + + function Print (Param : Types.Mal_Handle) return String is + begin + return Printer.Pr_Str (Param); + end Print; + + function Rep (Param : String; Env : Envs.Env_Handle) return String is + AST, Evaluated_AST : Types.Mal_Handle; + begin + + AST := Read (Param); + + if Types.Is_Null (AST) then + return ""; + else + Evaluated_AST := Eval (AST, Env); + return Print (Evaluated_AST); + end if; + + end Rep; + + + Repl_Env : Envs.Env_Handle; + + + -- These two ops use Repl_Env directly. + + + procedure RE (Str : Mal_String) is + Discarded : Mal_Handle; + begin + Discarded := Eval (Read (Str), Repl_Env); + end RE; + + + function Do_Eval (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + Rest_List : Types.List_Mal_Type; + begin + Rest_List := Deref_List (Rest_Handle).all; + First_Param := Car (Rest_List); + return Eval_Callback.Eval.all (First_Param, Repl_Env); + end Do_Eval; + + + Cmd_Args, File_Param : Natural; + Command_Args : Types.Mal_Handle; + Command_List : Types.List_Ptr; + File_Processed : Boolean := False; + +begin + + -- Save a function pointer back to the Eval function. + -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK + -- as we know Eval will be in scope for the lifetime of the program. + Eval_Callback.Eval := Eval'Unrestricted_Access; + + Repl_Env := Envs.New_Env; + + -- Core init also creates the first environment. + -- This is needed for the def!'s below. + Core.Init (Repl_Env); + + -- Register the eval command. This needs to be done here rather than Core.Init + -- as it requires direct access to Repl_Env. + Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); + + RE ("(def! not (fn* (a) (if a false true)))"); + RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); + RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))"); + + -- Command line processing. + + Cmd_Args := 0; + Command_Args := Types.New_List_Mal_Type (Types.List_List); + Command_List := Types.Deref_List (Command_Args); + + while Ada.Command_Line.Argument_Count > Cmd_Args loop + + Cmd_Args := Cmd_Args + 1; + if Ada.Command_Line.Argument (Cmd_Args) = "-d" then + Debug := True; + elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then + Envs.Debug := True; + elsif not File_Processed then + File_Param := Cmd_Args; + File_Processed := True; + else + Command_List.Append + (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); + end if; + + end loop; + + Envs.Set (Repl_Env, "*ARGV*", Command_Args); + + if File_Processed then + RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); + else + RE("(println (str ""Mal ["" *host-language* ""]""))"); + loop + begin + Ada.Text_IO.Put ("user> "); + exit when Ada.Text_IO.End_Of_File; + Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); + exception + when E : others => + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + "Error: " & Ada.Exceptions.Exception_Information (E)); + if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then + Ada.Text_IO.Put_Line + (Ada.Text_IO.Standard_Error, + Printer.Pr_Str (Types.Mal_Exception_Value)); + Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; + end if; + end; + end loop; + end if; +end StepA_Mal; diff --git a/impls/ada/types-hash_map.adb b/impls/ada/types-hash_map.adb new file mode 100644 index 0000000000..f672a7d21d --- /dev/null +++ b/impls/ada/types-hash_map.adb @@ -0,0 +1,285 @@ +with Ada.Strings.Unbounded.Hash; +with Smart_Pointers; + +package body Types.Hash_Map is + + function "=" (A, B : Hash_Map_Mal_Type) return Boolean is + A_Key, A_Elem, B_Elem : Mal_Handle; + use Mal_Mal_Hash; + C : Cursor; + begin + if A.Length /= B.Length then + return False; + end if; + C := A.Hash.First; + while Has_Element (C) loop + A_Key := Key (C); + A_Elem := Element (C); + B_Elem := Mal_Mal_Hash.Element (B.Hash, A_Key); + if A_Elem /= B_Elem then + return False; + end if; + Next (C); + end loop; + return True; + end "="; + + function New_Hash_Map_Mal_Type + return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Hash_Map_Mal_Type' + (Mal_Type with + List_Type => Hashed_List, + The_List => Smart_Pointers.Null_Smart_Pointer, + Last_Elem => Smart_Pointers.Null_Smart_Pointer, + Is_Key_Expected => True, + Next_Key => Smart_Pointers.Null_Smart_Pointer, + Hash => Mal_Mal_Hash.Empty_Map)); + end New_Hash_Map_Mal_Type; + + overriding function Prepend (Op : Mal_Handle; To_Vector : Hash_Map_Mal_Type) + return Mal_Handle is + begin + raise Not_Appropriate; + return Smart_Pointers.Null_Smart_Pointer; + end Prepend; + + overriding procedure Append (V : in out Hash_Map_Mal_Type; E : Mal_Handle) is + begin + if V.Is_Key_Expected then + V.Next_Key := E; + else + Mal_Mal_Hash.Include + (Container => V.Hash, + Key => V.Next_Key, + New_Item => E); + end if; + V.Is_Key_Expected := not V.Is_Key_Expected; + end Append; + + overriding function Length (L : Hash_Map_Mal_Type) return Natural is + begin + return Natural (L.Hash.Length); + end Length; + + overriding function Is_Null (L : Hash_Map_Mal_Type) return Boolean is + begin + return L.Hash.Is_Empty; + end Is_Null; + + overriding function Null_List (L : List_Types) return Hash_Map_Mal_Type is + begin + return + Hash_Map_Mal_Type' + (Mal_Type with + List_Type => Hashed_List, + The_List => Smart_Pointers.Null_Smart_Pointer, + Last_Elem => Smart_Pointers.Null_Smart_Pointer, + Is_Key_Expected => False, + Next_Key => Smart_Pointers.Null_Smart_Pointer, + Hash => Mal_Mal_Hash.Empty_Map); + end Null_List; + + -- Duplicate copies the list (logically). This is to allow concatenation, + -- The result is always a List_List. + overriding function Duplicate (The_List : Hash_Map_Mal_Type) return Mal_Handle is + begin + raise Not_Appropriate; + return Smart_Pointers.Null_Smart_Pointer; + end Duplicate; + + overriding function Nth (L :Hash_Map_Mal_Type; N : Natural) return Mal_Handle is + begin + raise Not_Appropriate; + return Smart_Pointers.Null_Smart_Pointer; + end Nth; + + overriding procedure Add_Defs (Defs : Hash_Map_Mal_Type; Env : Envs.Env_Handle) is + begin + raise Not_Appropriate; + end Add_Defs; + + -- Get the first item in the list: + overriding function Car (L : Hash_Map_Mal_Type) return Mal_Handle is + begin + raise Not_Appropriate; + return Smart_Pointers.Null_Smart_Pointer; + end Car; + + -- Get the rest of the list (second item onwards) + overriding function Cdr (L : Hash_Map_Mal_Type) return Mal_Handle is + begin + raise Not_Appropriate; + return Smart_Pointers.Null_Smart_Pointer; + end Cdr; + + + overriding function Map + (Func_Ptr : Func_Access; + L : Hash_Map_Mal_Type) + return Mal_Handle is + Res : Mal_Handle; + use Mal_Mal_Hash; + C : Cursor; + begin + Res := New_Hash_Map_Mal_Type; + C := L.Hash.First; + while Has_Element (C) loop + -- Assuming we're not applying the func to the keys too. + Deref_Hash (Res).Hash.Include + (Key => Key (C), + New_Item => Func_Ptr (Element (C))); + Next (C); + end loop; + return Res; + end Map; + + function Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle is + Res : Mal_Handle; + Rest_List : List_Mal_Type; + use Mal_Mal_Hash; + C : Cursor; + begin + Res := New_Hash_Map_Mal_Type; + Rest_List := Deref_List (List).all; + + -- Copy arg into result. + Deref_Hash (Res).Hash := H.Hash; + + while not Is_Null (Rest_List) loop + Deref_Hash (Res).Append (Car (Rest_List)); + Rest_List := Deref_List (Cdr (Rest_List)).all; + end loop; + return Res; + end Assoc; + + + function Dis_Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle is + Res : Mal_Handle; + Rest_List : List_Mal_Type; + use Mal_Mal_Hash; + C : Cursor; + begin + Res := New_Hash_Map_Mal_Type; + Rest_List := Deref_List (List).all; + + -- Copy arg into result. + Deref_Hash (Res).Hash := H.Hash; + + while not Is_Null (Rest_List) loop + Mal_Mal_Hash.Exclude (Deref_Hash (Res).Hash, Car (Rest_List)); + Rest_List := Deref_List (Cdr (Rest_List)).all; + end loop; + return Res; + end Dis_Assoc; + + + function Get (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Mal_Handle is + use Mal_Mal_Hash; + C : Cursor; + begin + C := Mal_Mal_Hash.Find (H.Hash, Key); + if Has_Element (C) then + return Element (C); + else + return New_Nil_Mal_Type; + end if; + end Get; + + + function All_Keys (H : Hash_Map_Mal_Type) return Mal_Handle is + Res, Map_Key : Mal_Handle; + use Mal_Mal_Hash; + C : Cursor; + begin + Res := New_List_Mal_Type (List_List); + C := H.Hash.First; + while Has_Element (C) loop + Map_Key := Key (C); + Deref_List (Res).Append (Map_Key); + Next (C); + end loop; + return Res; + end All_Keys; + + + function All_Values (H : Hash_Map_Mal_Type) return Mal_Handle is + Res, Map_Val : Mal_Handle; + use Mal_Mal_Hash; + C : Cursor; + begin + Res := New_List_Mal_Type (List_List); + C := H.Hash.First; + while Has_Element (C) loop + Map_Val := Element (C); + Deref_List (Res).Append (Map_Val); + Next (C); + end loop; + return Res; + end All_Values; + + + function Contains (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Boolean is + begin + return Mal_Mal_Hash.Contains (H.Hash, Key); + end Contains; + + function Deref_Hash (SP : Mal_Handle) return Hash_Ptr is + begin + return Hash_Ptr (Deref (SP)); + end Deref_Hash; + + function Hash (M : Mal_Handle) return Ada.Containers.Hash_Type is + begin + return Ada.Strings.Unbounded.Hash + (Ada.Strings.Unbounded.To_Unbounded_String + (Deref (M).To_String)); + end Hash; + + overriding function To_Str + (T : Hash_Map_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + use Ada.Containers; + begin + if (T.Hash.Length = 0) then + return Opening (T.List_Type) & + Closing (T.List_Type); + else + declare + Res : Ada.Strings.Unbounded.Unbounded_String; + use Mal_Mal_Hash; + C : Cursor; + begin + C := First (T.Hash); + + Res := Ada.Strings.Unbounded."&" + (Opening (T.List_Type), + Ada.Strings.Unbounded.To_Unbounded_String + (To_String (Deref (Key (C)).all, Print_Readably))); + Res := Ada.Strings.Unbounded."&" (Res, " "); + Res := Ada.Strings.Unbounded."&" + (Res, + Ada.Strings.Unbounded.To_Unbounded_String + (To_String (Deref (Element (C)).all, Print_Readably))); + Next (C); + while Has_Element (C) loop + Res := Ada.Strings.Unbounded."&" (Res, " "); + Res := Ada.Strings.Unbounded."&" + (Res, + Ada.Strings.Unbounded.To_Unbounded_String + (To_String (Deref (Key (C)).all, Print_Readably))); + Res := Ada.Strings.Unbounded."&" (Res, " "); + Res := Ada.Strings.Unbounded."&" + (Res, + Ada.Strings.Unbounded.To_Unbounded_String + (To_String (Deref (Element (C)).all, Print_Readably))); + Next (C); + end loop; + Res := Ada.Strings.Unbounded."&" (Res, Closing (T.List_Type)); + return Ada.Strings.Unbounded.To_String (Res); + end; + end if; + end To_Str; + +end Types.Hash_Map; diff --git a/impls/ada/types-hash_map.ads b/impls/ada/types-hash_map.ads new file mode 100644 index 0000000000..10d9e4274e --- /dev/null +++ b/impls/ada/types-hash_map.ads @@ -0,0 +1,83 @@ +with Ada.Containers.Hashed_Maps; +with Smart_Pointers; +with Envs; + +package Types.Hash_Map is + + type Hash_Map_Mal_Type is new List_Mal_Type with private; + + function New_Hash_Map_Mal_Type + return Mal_Handle; + + function "=" (A, B : Hash_Map_Mal_Type) return Boolean; + + overriding function Prepend (Op : Mal_Handle; To_Vector : Hash_Map_Mal_Type) + return Mal_Handle; + + overriding procedure Append (V : in out Hash_Map_Mal_Type; E : Mal_Handle); + + overriding function Length (L : Hash_Map_Mal_Type) return Natural; + + overriding function Is_Null (L : Hash_Map_Mal_Type) return Boolean; + + overriding function Null_List (L : List_Types) return Hash_Map_Mal_Type; + + -- Duplicate copies the list (logically). This is to allow concatenation, + -- The result is always a List_List. + overriding function Duplicate (The_List : Hash_Map_Mal_Type) return Mal_Handle; + + overriding function Nth (L :Hash_Map_Mal_Type; N : Natural) return Mal_Handle; + + overriding procedure Add_Defs (Defs : Hash_Map_Mal_Type; Env : Envs.Env_Handle); + + -- Get the first item in the list: + overriding function Car (L : Hash_Map_Mal_Type) return Mal_Handle; + + -- Get the rest of the list (second item onwards) + overriding function Cdr (L : Hash_Map_Mal_Type) return Mal_Handle; + + overriding function Map + (Func_Ptr : Func_Access; + L : Hash_Map_Mal_Type) + return Mal_Handle; + + function Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle; + + function Dis_Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle; + + function Get (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Mal_Handle; + + function All_Keys (H : Hash_Map_Mal_Type) return Mal_Handle; + + function All_Values (H : Hash_Map_Mal_Type) return Mal_Handle; + + function Contains (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Boolean; + + type Hash_Ptr is access all Hash_Map_Mal_Type; + + function Deref_Hash (SP : Mal_Handle) return Hash_Ptr; + + Not_Appropriate : exception; + +private + + function Hash (M : Mal_Handle) return Ada.Containers.Hash_Type; + + package Mal_Mal_Hash is new Ada.Containers.Hashed_Maps + (Key_Type => Mal_Handle, + Element_Type => Mal_Handle, + Hash => Hash, + Equivalent_Keys => "=", + "=" => "="); + + type Hash_Map_Mal_Type is new List_Mal_Type with record + Is_Key_Expected : Boolean := True; + Next_Key : Mal_Handle; + Hash : Mal_Mal_Hash.Map; + end record; + + overriding function To_Str + (T : Hash_Map_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + +end Types.Hash_Map; diff --git a/impls/ada/types-vector.adb b/impls/ada/types-vector.adb new file mode 100644 index 0000000000..b4dc70f56e --- /dev/null +++ b/impls/ada/types-vector.adb @@ -0,0 +1,196 @@ +with Ada.Strings.Unbounded; +with Ada.Text_IO; +with Eval_Callback; + +package body Types.Vector is + + + function New_Vector_Mal_Type + return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Vector_Mal_Type' + (Mal_Type with + List_Type => Vector_List, + The_List => Smart_Pointers.Null_Smart_Pointer, + Last_Elem => Smart_Pointers.Null_Smart_Pointer, + Vec => Mal_Vectors.Empty_Vector)); + end New_Vector_Mal_Type; + + + overriding function Prepend (Op : Mal_Handle; To_Vector : Vector_Mal_Type) + return Mal_Handle is + begin + return Types.Prepend (Op, Deref_List (To_Vector.Duplicate).all); + end Prepend; + + + overriding procedure Append (V : in out Vector_Mal_Type; E : Mal_Handle) is + begin + Mal_Vectors.Append (V.Vec, E); + end Append; + + + overriding function Is_Null (L : Vector_Mal_Type) return Boolean is + use Ada.Containers; + begin + return L.Vec.Is_Empty; + end Is_Null; + + + overriding function Null_List (L : List_Types) return Vector_Mal_Type is + begin + return Vector_Mal_Type' + (Mal_Type with + List_Type => Vector_List, + The_List => Smart_Pointers.Null_Smart_Pointer, + Last_Elem => Smart_Pointers.Null_Smart_Pointer, + Vec => Mal_Vectors.Empty_Vector); + end Null_List; + + + -- Duplicate copies the list (logically). This is to allow concatenation, + -- The result is always a List_List. + overriding function Duplicate (The_List : Vector_Mal_Type) return Mal_Handle is + Res : Mal_Handle; + use Mal_Vectors; + C : Cursor; + begin + Res := New_List_Mal_Type (List_List); + C := First (The_List.Vec); + while Has_Element (C) loop + Deref_List (Res).Append (Element (C)); + Next (C); + end loop; + return Res; + end Duplicate; + + + function Length (L : Vector_Mal_Type) return Natural is + begin + return Natural (L.Vec.Length); + end Length; + + + procedure Add_Defs (Defs : Vector_Mal_Type; Env : Envs.Env_Handle) is + C, D : Cursor; + begin + C := Defs.Vec.First; + while Has_Element (C) loop + D := Next (C); + exit when not Has_Element (D); + Envs.Set + (Env, + Deref_Sym (Element (C)).Get_Sym, + Eval_Callback.Eval.all (Element (D), Env)); + C := Next (D); + end loop; + end Add_Defs; + + + overriding function Nth (L : Vector_Mal_Type; N : Natural) return Mal_Handle is + begin + if N >= L.Length then + raise Runtime_Exception with "Nth (vector): Index out of range"; + else + return Mal_Vectors.Element (L.Vec, Vec_Index (N)); + end if; + end Nth; + + + -- Get the first item in the list: + overriding function Car (L : Vector_Mal_Type) return Mal_Handle is + begin + return L.Vec.Element (0); + end Car; + + -- Get the rest of the list (second item onwards) + + overriding function Cdr (L : Vector_Mal_Type) return Mal_Handle is + Res : Mal_Handle; + Vec_P : Vector_Ptr; + C : Mal_Vectors.Cursor; + I : Vec_Index; + use Ada.Containers; + begin + Res := New_Vector_Mal_Type; + if L.Vec.Length < 2 then + return Res; + end if; + Vec_P := Deref_Vector (Res); + Vec_P.Vec := To_Vector (L.Vec.Length - 1); + + -- Set C to second entry. + C := L.Vec.First; + Mal_Vectors.Next (C); + + I := 0; + while Mal_Vectors.Has_Element (C) loop + Mal_Vectors.Replace_Element (Vec_P.Vec, I, Mal_Vectors.Element (C)); + Mal_Vectors.Next (C); + I := I + 1; + end loop; + return Res; + end Cdr; + + overriding function Map + (Func_Ptr : Func_Access; + L : Vector_Mal_Type) + return Mal_Handle is + Res : Mal_Handle; + use Mal_Vectors; + C : Cursor; + begin + Res := New_Vector_Mal_Type; + C := First (L.Vec); + while Has_Element (C) loop + Deref_Vector (Res).Append (Func_Ptr.all (Element (C))); + Next (C); + end loop; + return Res; + end Map; + + + function Deref_Vector (SP : Mal_Handle) return Vector_Ptr is + begin + return Vector_Ptr (Deref (SP)); + end Deref_Vector; + + + overriding function To_Str + (T : Vector_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + use Ada.Containers; + begin + if (T.Vec.Length = 0) then + return Opening (T.List_Type) & + Closing (T.List_Type); + else + declare + Res : Ada.Strings.Unbounded.Unbounded_String; + use Mal_Vectors; + C : Cursor; + begin + C := First (T.Vec); + + Res := Ada.Strings.Unbounded."&" + (Opening (T.List_Type), + Ada.Strings.Unbounded.To_Unbounded_String + (To_String (Deref (Element (C)).all, Print_Readably))); + Next (C); + while Has_Element (C) loop + Res := Ada.Strings.Unbounded."&" (Res, " "); + Res := Ada.Strings.Unbounded."&" + (Res, + Ada.Strings.Unbounded.To_Unbounded_String + (To_String (Deref (Element (C)).all, Print_Readably))); + Next (C); + end loop; + Res := Ada.Strings.Unbounded."&" (Res, Closing (T.List_Type)); + return Ada.Strings.Unbounded.To_String (Res); + end; + end if; + end To_Str; + + +end Types.Vector; diff --git a/impls/ada/types-vector.ads b/impls/ada/types-vector.ads new file mode 100644 index 0000000000..27d6c57771 --- /dev/null +++ b/impls/ada/types-vector.ads @@ -0,0 +1,66 @@ +with Ada.Containers.Vectors; +with Ada.Strings.Unbounded; +with Smart_Pointers; +with Envs; + +package Types.Vector is + + type Vector_Mal_Type is new List_Mal_Type with private; + + function New_Vector_Mal_Type + return Mal_Handle; + + overriding function Prepend (Op : Mal_Handle; To_Vector : Vector_Mal_Type) + return Mal_Handle; + + overriding procedure Append (V : in out Vector_Mal_Type; E : Mal_Handle); + + overriding function Length (L : Vector_Mal_Type) return Natural; + + overriding function Is_Null (L : Vector_Mal_Type) return Boolean; + + overriding function Null_List (L : List_Types) return Vector_Mal_Type; + + -- Duplicate copies the list (logically). This is to allow concatenation, + -- The result is always a List_List. + overriding function Duplicate (The_List : Vector_Mal_Type) return Mal_Handle; + + overriding function Nth (L : Vector_Mal_Type; N : Natural) return Mal_Handle; + + overriding procedure Add_Defs (Defs : Vector_Mal_Type; Env : Envs.Env_Handle); + + -- Get the first item in the list: + overriding function Car (L : Vector_Mal_Type) return Mal_Handle; + + -- Get the rest of the list (second item onwards) + overriding function Cdr (L : Vector_Mal_Type) return Mal_Handle; + + overriding function Map + (Func_Ptr : Func_Access; + L : Vector_Mal_Type) + return Mal_Handle; + + type Vector_Ptr is access all Vector_Mal_Type; + + function Deref_Vector (SP : Mal_Handle) return Vector_Ptr; + +private + + subtype Vec_Index is Integer range 0 .. 100; + package Mal_Vectors is new + Ada.Containers.Vectors + (Index_Type => Vec_Index, + Element_Type => Mal_Handle, + "=" => "="); + + use Mal_Vectors; + + type Vector_Mal_Type is new List_Mal_Type with record + Vec : Mal_Vectors.Vector; + end record; + + overriding function To_Str + (T : Vector_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + +end Types.Vector; diff --git a/impls/ada/types.adb b/impls/ada/types.adb new file mode 100644 index 0000000000..0107a8dddb --- /dev/null +++ b/impls/ada/types.adb @@ -0,0 +1,1127 @@ +with Ada.Characters.Latin_1; +with Ada.Strings.Fixed; +with Ada.Strings.Maps.Constants; +with Ada.Text_IO; +with Ada.Unchecked_Deallocation; +with Envs; +with Eval_Callback; +with Smart_Pointers; +with Types.Vector; +with Types.Hash_Map; + +package body Types is + + package ACL renames Ada.Characters.Latin_1; + + function Nodes_Equal (A, B : Mal_Handle) return Boolean; + + + function "=" (A, B : Mal_Handle) return Mal_Handle is + begin + return New_Bool_Mal_Type (A = B); + end "="; + + + function Compare_List_And_Vector (A : List_Mal_Type; B : List_Mal_Type'Class) + return Boolean is + First_Node, First_Index : Mal_Handle; + I : Natural := 0; + begin + First_Node := A.The_List; + loop + if not Is_Null (First_Node) and I < B.Length then + First_Index := B.Nth (I); + if not "=" (Deref_Node (First_Node).Data, First_Index) then + return False; + end if; + First_Node := Deref_Node (First_Node).Next; + I := I + 1; + else + return Is_Null (First_Node) and I = B.Length; + end if; + end loop; + end Compare_List_And_Vector; + + + function "=" (A, B : Mal_Handle) return Boolean is + use Types.Vector; + use Types.Hash_Map; + begin + + if (not Is_Null (A) and not Is_Null (B)) and then + Deref (A).Sym_Type = Deref (B).Sym_Type then + + case Deref (A).Sym_Type is + when Nil => + return True; -- Both nil. + when Int => + return (Deref_Int (A).Get_Int_Val = Deref_Int (B).Get_Int_Val); + when Floating => + return (Deref_Float (A).Get_Float_Val = Deref_Float (B).Get_Float_Val); + when Bool => + return (Deref_Bool (A).Get_Bool = Deref_Bool (B).Get_Bool); + when List => + -- When Types.Vector was added, the choice was: + -- 1) use interfaces (because you need a class hierachy for the containers + -- and a corresponding hierarchy for the cursors and Ada is single dispatch + -- + interfaces. + -- 2) map out the combinations here and use nth to access vector items. + case Deref_List (A).Get_List_Type is + when List_List => + case Deref_List (B).Get_List_Type is + when List_List => + return Nodes_Equal (Deref_List (A).The_List, Deref_List (B).The_List); + when Vector_List => + return Compare_List_And_Vector + (Deref_List (A).all, Deref_List_Class (B).all); + when Hashed_List => return False; -- Comparing a list and a hash + end case; + when Vector_List => + case Deref_List (B).Get_List_Type is + when List_List => + return Compare_List_And_Vector + (Deref_List (B).all, Deref_List_Class (A).all); + when Vector_List => + return Vector."=" (Deref_Vector (A).all, Deref_Vector (B).all); + when Hashed_List => return False; -- Comparing a vector and a hash + end case; + when Hashed_List => + case Deref_List (B).Get_List_Type is + when List_List => return False; -- Comparing a list and a hash + when Vector_List => return False; -- Comparing a vector and a hash + when Hashed_List => + return Hash_Map."=" (Deref_Hash (A).all, Deref_Hash (B).all); + end case; + end case; + when Str => + return (Deref_String (A).Get_String = Deref_String (B).Get_String); + when Sym => + return (Deref_Sym (A).Get_Sym = Deref_Sym (B).Get_Sym); + when Atom => + return (Deref_Atom (A).Get_Atom = Deref_Atom (B).Get_Atom); + when Func => + return (Deref_Func (A).Get_Func_Name = Deref_Func (B).Get_Func_Name); + when Node => + return (Deref_Int(A).Get_Int_Val = Deref_Int(B).Get_Int_Val); + when Lambda => + return (Deref_Int(A).Get_Int_Val = Deref_Int(B).Get_Int_Val); + when Error => + return (Deref_Int(A).Get_Int_Val = Deref_Int(B).Get_Int_Val); + end case; + elsif Is_Null (A) and Is_Null (B) then + return True; + else -- either one of the args is null or the sym_types don't match + return False; + end if; + end "="; + + function Get_Meta (T : Mal_Type) return Mal_Handle is + begin + if T.Meta = Smart_Pointers.Null_Smart_Pointer then + return New_Nil_Mal_Type; + else + return T.Meta; + end if; + end Get_Meta; + + procedure Set_Meta (T : in out Mal_Type'Class; SP : Mal_Handle) is + begin + T.Meta := SP; + end Set_Meta; + + function Copy (M : Mal_Handle) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Mal_Type'Class'(Deref (M).all)); + end Copy; + + function To_String (T : Mal_Type'Class; Print_Readably : Boolean := True) + return Mal_String is + begin + return To_Str (T, Print_Readably); + end To_String; + + -- A helper function that just view converts the smart pointer. + function Deref (S : Mal_Handle) return Mal_Ptr is + begin + return Mal_Ptr (Smart_Pointers.Deref (S)); + end Deref; + + -- A helper function to detect null smart pointers. + function Is_Null (S : Mal_Handle) return Boolean is + use Smart_Pointers; + begin + return Smart_Pointers."="(S, Null_Smart_Pointer); + end Is_Null; + + + -- To_Str on the abstract type... + function To_Str (T : Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + raise Constraint_Error; -- Tha'll teach 'ee + return ""; -- Keeps the compiler happy. + end To_Str; + + + function New_Nil_Mal_Type return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Nil_Mal_Type'(Mal_Type with null record)); + end New_Nil_Mal_Type; + + overriding function Sym_Type (T : Nil_Mal_Type) return Sym_Types is + begin + return Nil; + end Sym_Type; + + overriding function To_Str (T : Nil_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + return "nil"; + end To_Str; + + + function New_Int_Mal_Type (Int : Mal_Integer) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Int_Mal_Type'(Mal_Type with Int_Val => Int)); + end New_Int_Mal_Type; + + overriding function Sym_Type (T : Int_Mal_Type) return Sym_Types is + begin + return Int; + end Sym_Type; + + function Get_Int_Val (T : Int_Mal_Type) return Mal_Integer is + begin + return T.Int_Val; + end Get_Int_Val; + + overriding function To_Str + (T : Int_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + Res : Mal_String := Mal_Integer'Image (T.Int_Val); + begin + return Ada.Strings.Fixed.Trim (Res, Ada.Strings.Left); + end To_Str; + + function Deref_Int (SP : Mal_Handle) return Int_Ptr is + begin + return Int_Ptr (Deref (SP)); + end Deref_Int; + + + function New_Float_Mal_Type (Floating : Mal_Float) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Float_Mal_Type'(Mal_Type with Float_Val => Floating)); + end New_Float_Mal_Type; + + overriding function Sym_Type (T : Float_Mal_Type) return Sym_Types is + begin + return Floating; + end Sym_Type; + + function Get_Float_Val (T : Float_Mal_Type) return Mal_Float is + begin + return T.Float_Val; + end Get_Float_Val; + + overriding function To_Str + (T : Float_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + Res : Mal_String := Mal_Float'Image (T.Float_Val); + begin + return Ada.Strings.Fixed.Trim (Res, Ada.Strings.Left); + end To_Str; + + function Deref_Float (SP : Mal_Handle) return Float_Ptr is + begin + return Float_Ptr (Deref (SP)); + end Deref_Float; + + + function New_Bool_Mal_Type (Bool : Boolean) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Bool_Mal_Type'(Mal_Type with Bool_Val => Bool)); + end New_Bool_Mal_Type; + + overriding function Sym_Type (T : Bool_Mal_Type) return Sym_Types is + begin + return Bool; + end Sym_Type; + + function Get_Bool (T : Bool_Mal_Type) return Boolean is + begin + return T.Bool_Val; + end Get_Bool; + + overriding function To_Str + (T : Bool_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + Res : Mal_String := Boolean'Image (T.Bool_Val); + begin + return Ada.Strings.Fixed.Translate + (Res, Ada.Strings.Maps.Constants.Lower_Case_Map); + end To_Str; + + function Deref_Bool (SP : Mal_Handle) return Bool_Ptr is + begin + return Bool_Ptr (Deref (SP)); + end Deref_Bool; + + + function New_String_Mal_Type (Str : Mal_String) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new String_Mal_Type' (Mal_Type with The_String => + Ada.Strings.Unbounded.To_Unbounded_String (Str))); + end New_String_Mal_Type; + + overriding function Sym_Type (T : String_Mal_Type) return Sym_Types is + begin + return Str; + end Sym_Type; + + function Get_String (T : String_Mal_Type) return Mal_String is + begin + return Ada.Strings.Unbounded.To_String (T.The_String); + end Get_String; + + function Deref_String (SP : Mal_Handle) return String_Ptr is + begin + return String_Ptr (Deref (SP)); + end Deref_String; + + + overriding function To_Str + (T : String_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + use Ada.Strings.Unbounded; + I : Positive := 1; + Str_Len : Natural; + Res : Unbounded_String; + Ch : Character; + begin + if Print_Readably then + Append (Res, '"'); + Str_Len := Length (T.The_String); + while I <= Str_Len loop + Ch := Element (T.The_String, I); + if Ch = '"' then + Append (Res, "\"""); + elsif Ch = '\' then + Append (Res, "\\"); + elsif Ch = Ada.Characters.Latin_1.LF then + Append (Res, "\n"); + else + Append (Res, Ch); + end if; + I := I + 1; + end loop; + Append (Res, '"'); + return To_String (Res); + else + return To_String (T.The_String); + end if; + end To_Str; + + + function New_Symbol_Mal_Type (Str : Mal_String) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Symbol_Mal_Type'(Mal_Type with The_Symbol => + Ada.Strings.Unbounded.To_Unbounded_String (Str))); + end New_Symbol_Mal_Type; + + overriding function Sym_Type (T : Symbol_Mal_Type) return Sym_Types is + begin + return Sym; + end Sym_Type; + + function Get_Sym (T : Symbol_Mal_Type) return Mal_String is + begin + return Ada.Strings.Unbounded.To_String (T.The_Symbol); + end Get_Sym; + + function Deref_Sym (S : Mal_Handle) return Sym_Ptr is + begin + return Sym_Ptr (Deref (S)); + end Deref_Sym; + + overriding function To_Str + (T : Symbol_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + return Ada.Strings.Unbounded.To_String (T.The_Symbol); + end To_Str; + + + function New_Atom_Mal_Type (MH : Mal_Handle) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Atom_Mal_Type'(Mal_Type with The_Atom => MH)); + end New_Atom_Mal_Type; + + overriding function Sym_Type (T : Atom_Mal_Type) return Sym_Types is + begin + return Atom; + end Sym_Type; + + function Get_Atom (T : Atom_Mal_Type) return Mal_Handle is + begin + return T.The_Atom; + end Get_Atom; + + procedure Set_Atom (T : in out Atom_Mal_Type; New_Val : Mal_Handle) is + begin + T.The_Atom := New_Val; + end Set_Atom; + + function Deref_Atom (S : Mal_Handle) return Atom_Ptr is + begin + return Atom_Ptr (Deref (S)); + end Deref_Atom; + + overriding function To_Str + (T : Atom_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + return "(atom " & To_String (Deref (T.The_Atom).all) & ')'; + end To_Str; + + + function New_Func_Mal_Type (Str : Mal_String; F : Builtin_Func) + return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Func_Mal_Type'(Mal_Type with + Func_Name => Ada.Strings.Unbounded.To_Unbounded_String (Str), + Func_P => F)); + end New_Func_Mal_Type; + + overriding function Sym_Type (T : Func_Mal_Type) return Sym_Types is + begin + return Func; + end Sym_Type; + + function Get_Func_Name (T : Func_Mal_Type) return Mal_String is + begin + return Ada.Strings.Unbounded.To_String (T.Func_Name); + end Get_Func_Name; + + function Call_Func + (FMT : Func_Mal_Type; Rest_List : Mal_Handle) + return Mal_Handle is + begin + return FMT.Func_P (Rest_List); + end Call_Func; + + function Deref_Func (S : Mal_Handle) return Func_Ptr is + begin + return Func_Ptr (Deref (S)); + end Deref_Func; + + overriding function To_Str + (T : Func_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + return Ada.Strings.Unbounded.To_String (T.Func_Name); + end To_Str; + + + function New_Error_Mal_Type (Str : Mal_String) return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Error_Mal_Type'(Mal_Type with Error_Msg => + Ada.Strings.Unbounded.To_Unbounded_String (Str))); + end New_Error_Mal_Type; + + overriding function Sym_Type (T : Error_Mal_Type) return Sym_Types is + begin + return Error; + end Sym_Type; + + overriding function To_Str + (T : Error_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + return Ada.Strings.Unbounded.To_String (T.Error_Msg); + end To_Str; + + + function Nodes_Equal (A, B : Mal_Handle) return Boolean is + begin + if (not Is_Null (A) and not Is_Null (B)) and then + Deref (A).Sym_Type = Deref (B).Sym_Type then + if Deref (A).Sym_Type = Node then + return + Nodes_Equal (Deref_Node (A).Data, Deref_Node (B).Data) and then + Nodes_Equal (Deref_Node (A).Next, Deref_Node (B).Next); + else + return A = B; + end if; + elsif Is_Null (A) and Is_Null (B) then + return True; + else -- either one of the args is null or the sym_types don't match + return False; + end if; + end Nodes_Equal; + + + function New_Node_Mal_Type + (Data : Mal_Handle; + Next : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) + return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Node_Mal_Type' + (Mal_Type with Data => Data, Next => Next)); + end New_Node_Mal_Type; + + + overriding function Sym_Type (T : Node_Mal_Type) return Sym_Types is + begin + return Node; + end Sym_Type; + + + -- Get the first item in the list: + function Car (L : List_Mal_Type) return Mal_Handle is + begin + if Is_Null (L.The_List) then + return Smart_Pointers.Null_Smart_Pointer; + else + return Deref_Node (L.The_List).Data; + end if; + end Car; + + + -- Get the rest of the list (second item onwards) + function Cdr (L : List_Mal_Type) return Mal_Handle is + Res : Mal_Handle; + LP : List_Ptr; + begin + + Res := New_List_Mal_Type (L.List_Type); + + if Is_Null (L.The_List) or else + Is_Null (Deref_Node (L.The_List).Next) then + return Res; + else + LP := Deref_List (Res); + LP.The_List := Deref_Node (L.The_List).Next; + LP.Last_Elem := L.Last_Elem; + return Res; + end if; + end Cdr; + + + function Length (L : List_Mal_Type) return Natural is + Res : Natural; + NP : Node_Ptr; + begin + Res := 0; + NP := Deref_Node (L.The_List); + while NP /= null loop + Res := Res + 1; + NP := Deref_Node (NP.Next); + end loop; + return Res; + end Length; + + + function Is_Null (L : List_Mal_Type) return Boolean is + use Smart_Pointers; + begin + return Smart_Pointers."="(L.The_List, Null_Smart_Pointer); + end Is_Null; + + + function Null_List (L : List_Types) return List_Mal_Type is + begin + return (Mal_Type with List_Type => L, + The_List => Smart_Pointers.Null_Smart_Pointer, + Last_Elem => Smart_Pointers.Null_Smart_Pointer); + end Null_List; + + + function Map + (Func_Ptr : Func_Access; + L : List_Mal_Type) + return Mal_Handle is + + Res, Old_List, First_New_Node, New_List : Mal_Handle; + LP : List_Ptr; + + begin + + Res := New_List_Mal_Type (List_Type => L.Get_List_Type); + + Old_List := L.The_List; + + if Is_Null (Old_List) then + return Res; + end if; + + First_New_Node := New_Node_Mal_Type (Func_Ptr.all (Deref_Node (Old_List).Data)); + + New_List := First_New_Node; + + Old_List := Deref_Node (Old_List).Next; + + while not Is_Null (Old_List) loop + + Deref_Node (New_List).Next := + New_Node_Mal_Type (Func_Ptr.all (Deref_Node (Old_List).Data)); + + New_List := Deref_Node (New_List).Next; + + Old_List := Deref_Node (Old_List).Next; + + end loop; + + LP := Deref_List (Res); + LP.The_List := First_New_Node; + LP.Last_Elem := New_List; + + return Res; + + end Map; + + + function Reduce + (Func_Ptr : Binary_Func_Access; + L : List_Mal_Type) + return Mal_Handle is + + C_Node : Node_Ptr; + Res : Mal_Handle; + use Smart_Pointers; + + begin + + C_Node := Deref_Node (L.The_List); + + if C_Node = null then + return Smart_Pointers.Null_Smart_Pointer; + end if; + + Res := C_Node.Data; + while not Is_Null (C_Node.Next) loop + C_Node := Deref_Node (C_Node.Next); + Res := Func_Ptr (Res, C_Node.Data); + end loop; + + return Res; + + end Reduce; + + + overriding function To_Str + (T : Node_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + if Is_Null (T.Data) then + -- Left is null and by implication so is right. + return ""; + elsif Is_Null (T.Next) then + -- Left is not null but right is. + return To_Str (Deref (T.Data).all, Print_Readably); + else + -- Left and right are both not null. + return To_Str (Deref (T.Data).all, Print_Readably) & + " " & + To_Str (Deref (T.Next).all, Print_Readably); + end if; + end To_Str; + + + function Cat_Str (T : Node_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + if Is_Null (T.Data) then + -- Left is null and by implication so is right. + return ""; + elsif Is_Null (T.Next) then + -- Left is not null but right is. + return To_Str (Deref (T.Data).all, Print_Readably); + + -- Left and right are both not null. + else + return To_Str (Deref (T.Data).all, Print_Readably) & + Cat_Str (Deref_Node (T.Next).all, Print_Readably); + end if; + end Cat_Str; + + + function Deref_Node (SP : Mal_Handle) return Node_Ptr is + begin + return Node_Ptr (Deref (SP)); + end Deref_Node; + + + function "=" (A, B : List_Mal_Type) return Boolean is + begin + return Nodes_Equal (A.The_List, B.The_List); + end "="; + + function New_List_Mal_Type + (The_List : List_Mal_Type) + return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new List_Mal_Type'(Mal_Type with + List_Type => The_List.List_Type, + The_List => The_List.The_List, + Last_Elem => The_List.Last_Elem)); + end New_List_Mal_Type; + + + function New_List_Mal_Type + (List_Type : List_Types; + The_First_Node : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) + return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new List_Mal_Type' + (Mal_Type with + List_Type => List_Type, + The_List => The_First_Node, + Last_Elem => The_First_Node)); + end New_List_Mal_Type; + + + function Make_New_List (Handle_List : Handle_Lists) return Mal_Handle is + + List_SP : Mal_Handle; + List_P : List_Ptr; + + begin + List_SP := New_List_Mal_Type (List_Type => List_List); + List_P := Deref_List (List_SP); + for I in Handle_List'Range loop + Append (List_P.all, Handle_List (I)); + end loop; + return List_SP; + end Make_New_List; + + + overriding function Sym_Type (T : List_Mal_Type) return Sym_Types is + begin + return List; + end Sym_Type; + + + function Get_List_Type (L : List_Mal_Type) return List_Types is + begin + return L.List_Type; + end Get_List_Type; + + + function Prepend (Op : Mal_Handle; To_List : List_Mal_Type) + return Mal_Handle is + begin + return New_List_Mal_Type + (List_List, + New_Node_Mal_Type (Op, To_List.The_List)); + end Prepend; + + + procedure Append (To_List : in out List_Mal_Type; Op : Mal_Handle) is + begin + if Is_Null (Op) then + return; -- Say what + end if; + + -- If the list is null just insert the new element + -- else use the last_elem pointer to insert it and then update it. + if Is_Null (To_List.The_List) then + To_List.The_List := New_Node_Mal_Type (Op); + To_List.Last_Elem := To_List.The_List; + else + Deref_Node (To_List.Last_Elem).Next := New_Node_Mal_Type (Op); + To_List.Last_Elem := Deref_Node (To_List.Last_Elem).Next; + end if; + end Append; + + + -- Duplicate copies the list (logically). This is to allow concatenation, + -- The result is always a List_List. + function Duplicate (The_List : List_Mal_Type) return Mal_Handle is + Res, Old_List, First_New_Node, New_List : Mal_Handle; + LP : List_Ptr; + begin + + Res := New_List_Mal_Type (List_List); + + Old_List := The_List.The_List; + + if Is_Null (Old_List) then + return Res; + end if; + + First_New_Node := New_Node_Mal_Type (Deref_Node (Old_List).Data); + New_List := First_New_Node; + Old_List := Deref_Node (Old_List).Next; + + while not Is_Null (Old_List) loop + + Deref_Node (New_List).Next := New_Node_Mal_Type (Deref_Node (Old_List).Data); + New_List := Deref_Node (New_List).Next; + Old_List := Deref_Node (Old_List).Next; + + end loop; + + LP := Deref_List (Res); + LP.The_List := First_New_Node; + LP.Last_Elem := New_List; + + return Res; + + end Duplicate; + + + function Nth (L : List_Mal_Type; N : Natural) return Mal_Handle is + + C : Natural; + Next : Mal_Handle; + + begin + + C := 0; + + Next := L.The_List; + + while not Is_Null (Next) loop + + if C >= N then + return Deref_Node (Next).Data; + end if; + + C := C + 1; + + Next := Deref_Node (Next).Next; + + end loop; + + raise Runtime_Exception with "Nth (list): Index out of range"; + + end Nth; + + + function Concat (Rest_Handle : List_Mal_Type) + return Types.Mal_Handle is + Rest_List : Types.List_Mal_Type; + List : Types.List_Class_Ptr; + Res_List_Handle, Dup_List : Mal_Handle; + Last_Node_P : Mal_Handle := Smart_Pointers.Null_Smart_Pointer; + begin + Rest_List := Rest_Handle; + + -- Set the result to the null list. + Res_List_Handle := New_List_Mal_Type (List_List); + + while not Is_Null (Rest_List) loop + + -- Find the next list in the list... + List := Deref_List_Class (Car (Rest_List)); + + -- Duplicate nodes to its contents. + Dup_List := Duplicate (List.all); + + -- If we haven't inserted a list yet, then take the duplicated list whole. + if Is_Null (Last_Node_P) then + Res_List_Handle := Dup_List; + else + -- Note that the first inserted list may have been the null list + -- and so may the newly duplicated one... + Deref_Node (Last_Node_P).Next := Deref_List (Dup_List).The_List; + if Is_Null (Deref_List (Res_List_Handle).The_List) then + Deref_List (Res_list_Handle).The_List := + Deref_List (Dup_List).The_List; + end if; + if not Is_Null (Deref_List (Dup_List).Last_Elem) then + Deref_List (Res_List_Handle).Last_Elem := + Deref_List (Dup_List).Last_Elem; + end if; + end if; + + Last_Node_P := Deref_List (Dup_List).Last_Elem; + + Rest_List := Deref_List (Cdr (Rest_List)).all; + + end loop; + + return Res_List_Handle; + + end Concat; + + + procedure Add_Defs (Defs : List_Mal_Type; Env : Envs.Env_Handle) is + D, L : List_Mal_Type; + begin + D := Defs; + while not Is_Null (D) loop + L := Deref_List (Cdr (D)).all; + Envs.Set + (Env, + Deref_Sym (Car (D)).Get_Sym, + Eval_Callback.Eval.all (Car (L), Env)); + D := Deref_List (Cdr(L)).all; + end loop; + end Add_Defs; + + + function Deref_List (SP : Mal_Handle) return List_Ptr is + begin + return List_Ptr (Deref (SP)); + end Deref_List; + + + function Deref_List_Class (SP : Mal_Handle) return List_Class_Ptr is + begin + return List_Class_Ptr (Deref (SP)); + end Deref_List_Class; + + + overriding function To_Str + (T : List_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + if Is_Null (T.The_List) then + return Opening (T.List_Type) & + Closing (T.List_Type); + else + return Opening (T.List_Type) & + To_String (Deref (T.The_List).all, Print_Readably) & + Closing (T.List_Type); + end if; + end To_Str; + + + function Pr_Str (T : List_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + if Is_Null (T.The_List) then + return ""; + else + return To_String (Deref_Node (T.The_List).all, Print_Readably); + end if; + end Pr_Str; + + + function Cat_Str (T : List_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin + if Is_Null (T.The_List) then + return ""; + else + return Cat_Str (Deref_Node (T.The_List).all, Print_Readably); + end if; + end Cat_Str; + + + function Opening (LT : List_Types) return Character is + Res : Character; + begin + case LT is + when List_List => + Res := '('; + when Vector_List => + Res := '['; + when Hashed_List => + Res := '{'; + end case; + return Res; + end Opening; + + + function Closing (LT : List_Types) return Character is + Res : Character; + begin + case LT is + when List_List => + Res := ')'; + when Vector_List => + Res := ']'; + when Hashed_List => + Res := '}'; + end case; + return Res; + end Closing; + + + function New_Lambda_Mal_Type + (Params : Mal_Handle; Expr : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle is + begin + return Smart_Pointers.New_Ptr + (new Lambda_Mal_Type' + (Mal_Type with + Params => Params, + Expr => Expr, + Env => Env, + Is_Macro => False)); + end New_Lambda_Mal_Type; + + overriding function Sym_Type (T : Lambda_Mal_Type) return Sym_Types is + begin + return Lambda; + end Sym_Type; + + function Get_Env (L : Lambda_Mal_Type) return Envs.Env_Handle is + begin + return L.Env; + end Get_Env; + + procedure Set_Env (L : in out Lambda_Mal_Type; Env : Envs.Env_Handle) is + begin + L.Env := Env; + end Set_Env; + + function Get_Params (L : Lambda_Mal_Type) return Mal_Handle is + begin + if Deref (L.Params).Sym_Type = List and then + Deref_List (L.Params).Get_List_Type = Vector_List then + -- Its a vector and we need a list... + return Deref_List_Class (L.Params).Duplicate; + else + return L.Params; + end if; + end Get_Params; + + function Get_Expr (L : Lambda_Mal_Type) return Mal_Handle is + begin + return L.Expr; + end Get_Expr; + + function Get_Is_Macro (L : Lambda_Mal_Type) return Boolean is + begin + return L.Is_Macro; + end Get_Is_Macro; + + procedure Set_Is_Macro (L : in out Lambda_Mal_Type; B : Boolean) is + begin + L.Is_Macro := B; + end Set_Is_Macro; + + + function Apply + (L : Lambda_Mal_Type; + Param_List : Mal_Handle) + return Mal_Handle is + + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + E := Envs.New_Env (L.Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Param_List).all) then + + Res := Eval_Callback.Eval.all (L.Get_Expr, E); + + else + + raise Runtime_Exception with "Bind failed in Apply"; + + end if; + + return Res; + + end Apply; + + overriding function To_Str + (T : Lambda_Mal_Type; Print_Readably : Boolean := True) + return Mal_String is + begin +-- return "(lambda " & Ada.Strings.Unbounded.To_String (T.Rep) & ")"; + return "#"; + end To_Str; + + function Deref_Lambda (SP : Mal_Handle) return Lambda_Ptr is + begin + return Lambda_Ptr (Deref (SP)); + end Deref_Lambda; + + + function Arith_Op (A, B : Mal_Handle) return Mal_Handle is + use Types; + A_Sym_Type : Sym_Types; + B_Sym_Type : Sym_Types; + begin + + if Is_Null (A) then + if Is_Null (B) then + -- both null, gotta be zero. + return New_Int_Mal_Type (0); + else -- A is null but B is not. + return Arith_Op (New_Int_Mal_Type (0), B); + end if; + elsif Is_Null (B) then + -- A is not null but B is. + return Arith_Op (A, New_Int_Mal_Type (0)); + end if; + + -- else both A and B and not null.:wq + A_Sym_Type := Deref (A).Sym_Type; + B_Sym_Type := Deref (B).Sym_Type; + if A_Sym_Type = Int and B_Sym_Type = Int then + return New_Int_Mal_Type + (Int_Op (Deref_Int (A).Get_Int_Val, Deref_Int (B).Get_Int_Val)); + elsif A_Sym_Type = Int and B_Sym_Type = Floating then + return New_Float_Mal_Type + (Float_Op (Mal_Float (Deref_Int (A).Get_Int_Val), + Deref_Float (B).Get_Float_Val)); + elsif A_Sym_Type = Floating and B_Sym_Type = Int then + return New_Float_Mal_Type + (Float_Op (Deref_Float (A).Get_Float_Val, + Mal_Float (Deref_Float (B).Get_Float_Val))); + elsif A_Sym_Type = Floating and B_Sym_Type = Floating then + return New_Float_Mal_Type + (Float_Op (Deref_Float (A).Get_Float_Val, + Deref_Float (B).Get_Float_Val)); + else + if A_Sym_Type = Error then + return A; + elsif B_Sym_Type = Error then + return B; + else + return New_Error_Mal_Type ("Invalid operands"); + end if; + end if; + end Arith_Op; + + + function Rel_Op (A, B : Mal_Handle) return Mal_Handle is + use Types; + A_Sym_Type : Sym_Types := Deref (A).Sym_Type; + B_Sym_Type : Sym_Types := Deref (B).Sym_Type; + begin + if A_Sym_Type = Int and B_Sym_Type = Int then + return New_Bool_Mal_Type + (Int_Rel_Op (Deref_Int (A).Get_Int_Val, Deref_Int (B).Get_Int_Val)); + elsif A_Sym_Type = Int and B_Sym_Type = Floating then + return New_Bool_Mal_Type + (Float_Rel_Op (Mal_Float (Deref_Int (A).Get_Int_Val), + Deref_Float (B).Get_Float_Val)); + elsif A_Sym_Type = Floating and B_Sym_Type = Int then + return New_Bool_Mal_Type + (Float_Rel_Op (Deref_Float (A).Get_Float_Val, + Mal_Float (Deref_Float (B).Get_Float_Val))); + else + return New_Bool_Mal_Type + (Float_Rel_Op (Deref_Float (A).Get_Float_Val, + Deref_Float (B).Get_Float_Val)); + end if; + end Rel_Op; + + +end Types; diff --git a/impls/ada/types.ads b/impls/ada/types.ads new file mode 100644 index 0000000000..5084d28bcb --- /dev/null +++ b/impls/ada/types.ads @@ -0,0 +1,438 @@ +-- This started out as a simple public variant record. +-- Then smart pointers were added. They were part of the Mal_Type and +-- were required to be public because of the dependencies and +-- how the variant record was public. Not very Ada-like. +-- The third version bites the bullet and delares Mal_Type as tagged. +-- Smart pointers are an OO version in a separate package. +-- The Doubly_Linked_Lists have been replaced with a tree-like list instead... +-- The tree-like list has been replaced with a singly linked list. Sigh. + +-- WARNING! This code contains: +-- Recursive data structures. +-- Object-based smart pointers. +-- Object-oriented code. +-- And strong-typing! + +-- Chris M Moore 25/03/2015 + +with Ada.Strings.Unbounded; +with Smart_Pointers; +with Envs; + +package Types is + + -- Some simple types. Not supposed to use the standard types directly. + + subtype Mal_Float is Float; + subtype Mal_Integer is Integer; + subtype Mal_String is String; + + -- Start off with the top-level abstract type. + + subtype Mal_Handle is Smart_Pointers.Smart_Pointer; + + function "=" (A, B : Mal_Handle) return Mal_Handle; + + function "=" (A, B : Mal_Handle) return Boolean; + + type Sym_Types is (Nil, Bool, Int, Floating, Str, Sym, Atom, Node, + List, Func, Lambda, Error); + + type Mal_Type is abstract new Smart_Pointers.Base_Class with private; + + function Sym_Type (T : Mal_Type) return Sym_Types is abstract; + + function Get_Meta (T : Mal_Type) return Mal_Handle; + + procedure Set_Meta (T : in out Mal_Type'Class; SP : Mal_Handle); + + function Copy (M : Mal_Handle) return Mal_Handle; + + function To_String (T : Mal_Type'Class; Print_Readably : Boolean := True) + return Mal_String; + + type Mal_Ptr is access all Mal_Type'Class; + + -- A helper function that just view converts the smart pointer to + -- a Mal_Type'Class pointer. + function Deref (S : Mal_Handle) return Mal_Ptr; + + -- A helper function to detect null smart pointers. + function Is_Null (S : Mal_Handle) return Boolean; + + -- Derived types. All boilerplate from here. + + type Nil_Mal_Type is new Mal_Type with private; + + function New_Nil_Mal_Type return Mal_Handle; + + overriding function Sym_Type (T : Nil_Mal_Type) return Sym_Types; + + + type Int_Mal_Type is new Mal_Type with private; + + function New_Int_Mal_Type (Int : Mal_Integer) return Mal_Handle; + + overriding function Sym_Type (T : Int_Mal_Type) return Sym_Types; + + function Get_Int_Val (T : Int_Mal_Type) return Mal_Integer; + + type Int_Ptr is access all Int_Mal_Type; + + function Deref_Int (SP : Mal_Handle) return Int_Ptr; + + + type Float_Mal_Type is new Mal_Type with private; + + function New_Float_Mal_Type (Floating : Mal_Float) return Mal_Handle; + + overriding function Sym_Type (T : Float_Mal_Type) return Sym_Types; + + function Get_Float_Val (T : Float_Mal_Type) return Mal_Float; + + type Float_Ptr is access all Float_Mal_Type; + + function Deref_Float (SP : Mal_Handle) return Float_Ptr; + + + type Bool_Mal_Type is new Mal_Type with private; + + function New_Bool_Mal_Type (Bool : Boolean) return Mal_Handle; + + overriding function Sym_Type (T : Bool_Mal_Type) return Sym_Types; + + function Get_Bool (T : Bool_Mal_Type) return Boolean; + + type Bool_Ptr is access all Bool_Mal_Type; + + function Deref_Bool (SP : Mal_Handle) return Bool_Ptr; + + + type String_Mal_Type is new Mal_Type with private; + + function New_String_Mal_Type (Str : Mal_String) return Mal_Handle; + + overriding function Sym_Type (T : String_Mal_Type) return Sym_Types; + + function Get_String (T : String_Mal_Type) return Mal_String; + + type String_Ptr is access all String_Mal_Type; + + function Deref_String (SP : Mal_Handle) return String_Ptr; + + + type Symbol_Mal_Type is new Mal_Type with private; + + function New_Symbol_Mal_Type (Str : Mal_String) return Mal_Handle; + + overriding function Sym_Type (T : Symbol_Mal_Type) return Sym_Types; + + function Get_Sym (T : Symbol_Mal_Type) return Mal_String; + + type Sym_Ptr is access all Symbol_Mal_Type; + + function Deref_Sym (S : Mal_Handle) return Sym_Ptr; + + + + type Atom_Mal_Type is new Mal_Type with private; + + function New_Atom_Mal_Type (MH : Mal_Handle) return Mal_Handle; + + overriding function Sym_Type (T : Atom_Mal_Type) return Sym_Types; + + function Get_Atom (T : Atom_Mal_Type) return Mal_Handle; + + procedure Set_Atom (T : in out Atom_Mal_Type; New_Val : Mal_Handle); + + type Atom_Ptr is access all Atom_Mal_Type; + + function Deref_Atom (S : Mal_Handle) return Atom_Ptr; + + + + type Error_Mal_Type is new Mal_Type with private; + + function New_Error_Mal_Type (Str : Mal_String) return Mal_Handle; + + overriding function Sym_Type (T : Error_Mal_Type) return Sym_Types; + + + -- Lists. + + type List_Types is (List_List, Vector_List, Hashed_List); + function Opening (LT : List_Types) return Character; + function Closing (LT : List_Types) return Character; + + type List_Mal_Type is new Mal_Type with private; + + function "=" (A, B : List_Mal_Type) return Boolean; + + function New_List_Mal_Type + (List_Type : List_Types; + The_First_Node : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) + return Mal_Handle; + + function New_List_Mal_Type + (The_List : List_Mal_Type) + return Mal_Handle; + + type Handle_Lists is array (Positive range <>) of Mal_Handle; + + -- Make a new list of the form: (Handle_List(1), Handle_List(2)...) + function Make_New_List (Handle_List : Handle_Lists) return Mal_Handle; + + overriding function Sym_Type (T : List_Mal_Type) return Sym_Types; + + function Get_List_Type (L : List_Mal_Type) return List_Types; + + function Prepend (Op : Mal_Handle; To_List : List_Mal_Type) + return Mal_Handle; + + procedure Append (To_List : in out List_Mal_Type; Op : Mal_Handle); + + function Length (L : List_Mal_Type) return Natural; + + function Nth (L : List_Mal_Type; N : Natural) return Mal_Handle; + + procedure Add_Defs (Defs : List_Mal_Type; Env : Envs.Env_Handle); + + -- Get the first item in the list: + function Car (L : List_Mal_Type) return Mal_Handle; + + -- Get the rest of the list (second item onwards) + function Cdr (L : List_Mal_Type) return Mal_Handle; + + type Func_Access is access + function (Elem : Mal_Handle) + return Mal_Handle; + + function Map + (Func_Ptr : Func_Access; + L : List_Mal_Type) + return Mal_Handle; + + type Binary_Func_Access is access + function (A, B : Mal_Handle) + return Mal_Handle; + + function Reduce + (Func_Ptr : Binary_Func_Access; + L : List_Mal_Type) + return Mal_Handle; + + function Is_Null (L : List_Mal_Type) return Boolean; + + function Null_List (L : List_Types) return List_Mal_Type; + + function Pr_Str (T : List_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + function Cat_Str (T : List_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + function Concat (Rest_Handle : List_Mal_Type) + return Types.Mal_Handle; -- a new list + + -- Duplicate copies the list (logically). This is to allow concatenation, + -- The result is always a List_List. + function Duplicate (The_List : List_Mal_Type) return Mal_Handle; + + type List_Ptr is access all List_Mal_Type; + + function Deref_List (SP : Mal_Handle) return List_Ptr; + + type List_Class_Ptr is access all List_Mal_Type'Class; + + function Deref_List_Class (SP : Mal_Handle) return List_Class_Ptr; + + + type Func_Mal_Type is new Mal_Type with private; + + type Builtin_Func is access + function (MH : Mal_Handle) return Mal_Handle; + + function New_Func_Mal_Type (Str : Mal_String; F : Builtin_Func) + return Mal_Handle; + + overriding function Sym_Type (T : Func_Mal_Type) return Sym_Types; + + function Get_Func_Name (T : Func_Mal_Type) return Mal_String; + + function Call_Func + (FMT : Func_Mal_Type; Rest_List : Mal_Handle) + return Mal_Handle; + + type Func_Ptr is access all Func_Mal_Type; + + function Deref_Func (S : Mal_Handle) return Func_Ptr; + + + + type Lambda_Mal_Type is new Mal_Type with private; + + function New_Lambda_Mal_Type + (Params : Mal_Handle; Expr : Mal_Handle; Env : Envs.Env_Handle) + return Mal_Handle; + + overriding function Sym_Type (T : Lambda_Mal_Type) return Sym_Types; + + function Get_Env (L : Lambda_Mal_Type) return Envs.Env_Handle; + + procedure Set_Env (L : in out Lambda_Mal_Type; Env : Envs.Env_Handle); + + function Get_Params (L : Lambda_Mal_Type) return Mal_Handle; + + function Get_Expr (L : Lambda_Mal_Type) return Mal_Handle; + + function Get_Is_Macro (L : Lambda_Mal_Type) return Boolean; + + procedure Set_Is_Macro (L : in out Lambda_Mal_Type; B : Boolean); + + function Apply + (L : Lambda_Mal_Type; + Param_List : Mal_Handle) return Mal_Handle; + + type Lambda_Ptr is access all Lambda_Mal_Type; + + function Deref_Lambda (SP : Mal_Handle) return Lambda_Ptr; + + generic + with function Int_Op (A, B : Mal_Integer) return Mal_Integer; + with function Float_Op (A, B : Mal_Float) return Mal_Float; + function Arith_Op (A, B : Mal_Handle) return Mal_Handle; + + generic + with function Int_Rel_Op (A, B : Mal_Integer) return Boolean; + with function Float_Rel_Op (A, B : Mal_Float) return Boolean; + function Rel_Op (A, B : Mal_Handle) return Mal_Handle; + + Runtime_Exception : exception; + + Mal_Exception : exception; -- So tempting to call this Mal_Function but... + + Mal_Exception_Value : Mal_Handle; -- Used by mal's throw command + +private + + type Mal_Type is abstract new Smart_Pointers.Base_Class with record + Meta : Mal_Handle; + end record; + + -- Not allowed to be abstract and private. RM 3.9.3(10) + -- So if you call this it'll just raise an exception. + function To_Str (T : Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Nil_Mal_Type is new Mal_Type with null record; + + overriding function To_Str (T : Nil_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Int_Mal_Type is new Mal_Type with record + Int_Val : Mal_Integer; + end record; + + overriding function To_Str (T : Int_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Float_Mal_Type is new Mal_Type with record + Float_Val : Mal_Float; + end record; + + overriding function To_Str (T : Float_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Bool_Mal_Type is new Mal_Type with record + Bool_Val : Boolean; + end record; + + overriding function To_Str (T : Bool_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type String_Mal_Type is new Mal_Type with record + The_String : Ada.Strings.Unbounded.Unbounded_String; + end record; + + overriding function To_Str (T : String_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Symbol_Mal_Type is new Mal_Type with record + The_Symbol : Ada.Strings.Unbounded.Unbounded_String; + end record; + + overriding function To_Str (T : Symbol_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Atom_Mal_Type is new Mal_Type with record + The_Atom : Mal_Handle; + end record; + + overriding function To_Str (T : Atom_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Func_Mal_Type is new Mal_Type with record + Func_Name : Ada.Strings.Unbounded.Unbounded_String; + Func_P : Builtin_Func; + end record; + + overriding function To_Str (T : Func_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Error_Mal_Type is new Mal_Type with record + Error_Msg : Ada.Strings.Unbounded.Unbounded_String; + end record; + + overriding function To_Str (T : Error_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + + -- Nodes have to be a differnt type from a List; + -- otherwise how do you represent a list within a list? + type Node_Mal_Type is new Mal_Type with record + Data : Mal_Handle; + Next : Mal_Handle; -- This is always a Node_Mal_Type handle + end record; + + function New_Node_Mal_Type + (Data : Mal_Handle; + Next : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) + return Mal_Handle; + + overriding function Sym_Type (T : Node_Mal_Type) return Sym_Types; + + overriding function To_Str + (T : Node_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Node_Ptr is access all Node_Mal_Type; + + function Deref_Node (SP : Mal_Handle) return Node_Ptr; + + + type List_Mal_Type is new Mal_Type with record + List_Type : List_Types; + The_List : Mal_Handle; + Last_Elem : Mal_Handle; + end record; + + overriding function To_Str + (T : List_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + type Container_Cursor is tagged record + The_Node : Node_Ptr := null; + end record; + + type Lambda_Mal_Type is new Mal_Type with record + Params, Expr : Mal_Handle; + Env : Envs.Env_Handle; + Is_Macro : Boolean; + end record; + + overriding function To_Str + (T : Lambda_Mal_Type; Print_Readably : Boolean := True) + return Mal_String; + + +end Types; diff --git a/impls/awk/Dockerfile b/impls/awk/Dockerfile new file mode 100644 index 0000000000..ee827698ad --- /dev/null +++ b/impls/awk/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# GNU Awk +RUN apt-get -y install gawk diff --git a/impls/awk/Makefile b/impls/awk/Makefile new file mode 100644 index 0000000000..ce864e0845 --- /dev/null +++ b/impls/awk/Makefile @@ -0,0 +1,20 @@ +SOURCES_BASE = types.awk reader.awk printer.awk +SOURCES_LISP = env.awk core.awk stepA_mal.awk +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.awk mal + +mal.awk: $(SOURCES) + echo 'arbitrary_long_name==0 "exec" "/usr/bin/gawk" "-O" "-f" "$$0" "$$@"' > $@ + cat $+ | grep -v "^@include " >> $@ + +mal: mal.awk + echo '#!/bin/sh' > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.awk mal diff --git a/impls/awk/core.awk b/impls/awk/core.awk new file mode 100644 index 0000000000..93a18ec759 --- /dev/null +++ b/impls/awk/core.awk @@ -0,0 +1,1141 @@ +@load "readfile" +@load "time" + +function core_eq_sub(lhs, rhs, i, len) +{ + if (lhs ~ /^[([]/ && rhs ~ /^[([]/) { + lhs = substr(lhs, 2) + rhs = substr(rhs, 2) + len = types_heap[lhs]["len"] + if (len != types_heap[rhs]["len"]) { + return 0 + } + for (i = 0; i < len; ++i) { + if (!core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) { + return 0 + } + } + return 1 + } else if (lhs ~ /^\{/ && rhs ~ /^\{/) { + lhs = substr(lhs, 2) + rhs = substr(rhs, 2) + if ( length(types_heap[lhs]) - ("meta" in types_heap[lhs]) != \ + length(types_heap[rhs]) - ("meta" in types_heap[rhs]) ) + { + return 0 + } + for (i in types_heap[lhs]) { + if ( i != "meta" && + types_heap[lhs][i] ~ /^["':+#([{?&$%]/ && + !core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) { + return 0 + } + } + return 1 + } else { + return lhs == rhs + } +} + +function core_eq(idx) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + return core_eq_sub(types_heap[idx][1], types_heap[idx][2]) ? "#true" : "#false" +} + +function core_throw(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'throw'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return "!" types_addref(types_heap[idx][1]) +} + + + +function core_nilp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'nil?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] == "#nil" ? "#true" : "#false" +} + +function core_truep(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'true?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] == "#true" ? "#true" : "#false" +} + +function core_falsep(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'false?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] == "#false" ? "#true" : "#false" +} + +function core_stringp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'string?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^"/ ? "#true" : "#false" +} + +function core_symbol(idx, str) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'symbol'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + str = types_heap[idx][1] + if (str !~ /^"/) { + return "!\"Incompatible type for argument 1 of builtin function 'symbol'. Expects string, supplied " types_typename(str) "." + } + return "'" substr(str, 2) +} + +function core_symbolp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'symbol?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^'/ ? "#true" : "#false" +} + +function core_keyword(idx, str) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'keyword'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + str = types_heap[idx][1] + switch (str) { + case /^:/: + return str + case /^"/: + return "::" substr(str, 2) + } + return "!\"Incompatible type for argument 1 of builtin function 'keyword'. Expects string or keyword, supplied " types_typename(str) "." +} + +function core_keywordp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'keyword?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^:/ ? "#true" : "#false" +} + +function core_numberp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'number?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^\+/ ? "#true" : "#false" +} + +function core_fnp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'fn?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + f = types_heap[idx][1] + return f ~ /^[$&%]/ && !types_heap[substr(f, 2)]["is_macro"] ? "#true" : "#false" +} + +function core_macrop(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'macro?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + f = types_heap[idx][1] + return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] ? "#true" : "#false" +} + + + +function core_pr_str(idx, i, len, result) +{ + len = types_heap[idx]["len"] + for (i = 1; i < len; ++i) { + result = result printer_pr_str(types_heap[idx][i], 1) " " + } + return "\"" substr(result, 1, length(result) - 1) +} + +function core_str(idx, i, len, result) +{ + len = types_heap[idx]["len"] + for (i = 1; i < len; ++i) { + result = result printer_pr_str(types_heap[idx][i], 0) + } + return "\"" result +} + +function core_prn(idx, i, len, result) +{ + len = types_heap[idx]["len"] + for (i = 1; i < len; ++i) { + result = result printer_pr_str(types_heap[idx][i], 1) " " + } + print substr(result, 1, length(result) - 1) + return "#nil" +} + +function core_println(idx, i, len, result) +{ + len = types_heap[idx]["len"] + for (i = 1; i < len; ++i) { + result = result printer_pr_str(types_heap[idx][i], 0) " " + } + print substr(result, 1, length(result) - 1) + return "#nil" +} + +function core_read_string(idx, str) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'read-string'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + str = types_heap[idx][1] + if (str !~ /^"/) { + return "!\"Incompatible type for argument 1 of builtin function 'read-string'. Expects string, supplied " types_typename(str) "." + } + return reader_read_str(substr(str, 2)) +} + +function core_readline(idx, prompt, var) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'readline'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + prompt = types_heap[idx][1] + if (prompt !~ /^"/) { + return "!\"Incompatible type for argument 1 of builtin function 'readline'. Expects string, supplied " types_typename(prompt) "." + } + printf("%s", printer_pr_str(prompt, 0)) + return getline var <= 0 ? "#nil" : "\"" var +} + +function core_slurp(idx, filename, str) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'slurp'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + filename = types_heap[idx][1] + if (filename !~ /^"/) { + return "!\"Incompatible type for argument 1 of builtin function 'slurp'. Expects string, supplied " types_typename(filename) "." + } + str = readfile(substr(filename, 2)) + if (str == "" && ERRNO != "") { + return "!\"cannot read file '" filename "', ERRNO = " ERRNO + } + return "\"" str +} + + + +function core_lt(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '<'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '<'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '<'. Expects number, supplied " types_typename(rhs) "." + } + return substr(lhs, 2) + 0 < substr(rhs, 2) + 0 ? "#true" : "#false" +} + +function core_le(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '<='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '<='. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '<='. Expects number, supplied " types_typename(rhs) "." + } + return substr(lhs, 2) + 0 <= substr(rhs, 2) + 0 ? "#true" : "#false" +} + +function core_gt(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '>'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '>'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '>'. Expects number, supplied " types_typename(rhs) "." + } + return substr(lhs, 2) + 0 > substr(rhs, 2) + 0 ? "#true" : "#false" +} + +function core_ge(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '>='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '>='. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '>='. Expects number, supplied " types_typename(rhs) "." + } + return substr(lhs, 2) + 0 >= substr(rhs, 2) + 0 ? "#true" : "#false" +} + +function core_add(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) + substr(rhs, 2)) +} + +function core_subtract(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) - substr(rhs, 2)) +} + +function core_multiply(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) * substr(rhs, 2)) +} + +function core_divide(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "." + } + return "+" int(substr(lhs, 2) / substr(rhs, 2)) +} + +function core_time_ms(idx) +{ + if (types_heap[idx]["len"] != 1) { + return "!\"Invalid argument length for builtin function 'time-ms'. Expects no arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + return "+" int(gettimeofday() * 1000) +} + + + +function core_list(idx, new_idx, len, i) +{ + new_idx = types_allocate() + len = types_heap[idx]["len"] + for (i = 1; i < len; ++i) { + types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i]) + } + types_heap[new_idx]["len"] = len - 1 + return "(" new_idx +} + +function core_listp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'list?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^\(/ ? "#true" : "#false" +} + +function core_vector(idx, new_idx, len, i) +{ + new_idx = types_allocate() + len = types_heap[idx]["len"] + for (i = 1; i < len; ++i) { + types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i]) + } + types_heap[new_idx]["len"] = len - 1 + return "[" new_idx +} + +function core_vectorp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'vector?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^\[/ ? "#true" : "#false" +} + +function core_hash_map(idx, len, new_idx, i, key) +{ + len = types_heap[idx]["len"] + if (len % 2 != 1) { + return "!\"Invalid argument length for builtin function 'hash-map'. Expects even number of arguments, supplied " (len - 1) "." + } + new_idx = types_allocate() + for (i = 1; i < len; i += 2) { + key = types_heap[idx][i] + if (key !~ /^[":]/) { + types_release("{" new_idx) + return "!\"Incompatible type for key argument of builtin function 'hash-map'. Expects string or keyword, supplied " types_typename(key) "." + } + if (key in types_heap[new_idx]) { + types_release(types_heap[new_idx][key]) + } + types_addref(types_heap[new_idx][key] = types_heap[idx][i + 1]) + } + return "{" new_idx +} + +function core_mapp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'map?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^\{/ ? "#true" : "#false" +} + +function core_assoc(idx, len, map, i, key, add_list, new_idx, map_idx) +{ + len = types_heap[idx]["len"] + if (len % 2 != 0) { + return "!\"Invalid argument length for builtin function 'assoc'. Expects odd number of arguments, supplied " (len - 1) "." + } + map = types_heap[idx][1] + if (map !~ /^\{/) { + return "!\"Incompatible type for argument 1 of builtin function 'assoc'. Expects hash-map, supplied " types_typename(map) "." + } + for (i = 2; i < len; i += 2) { + key = types_heap[idx][i] + if (key !~ /^[":]/) { + return "!\"Incompatible type for key argument of builtin function 'assoc'. Expects string or keyword, supplied " types_typename(key) "." + } + add_list[key] = types_heap[idx][i + 1] + } + new_idx = types_allocate() + map_idx = substr(map, 2) + for (key in types_heap[map_idx]) { + if (key ~ /^[":]|^meta$/ && !(key in add_list)) { + types_addref(types_heap[new_idx][key] = types_heap[map_idx][key]) + } + } + for (key in add_list) { + types_addref(types_heap[new_idx][key] = add_list[key]) + } + return "{" new_idx +} + +function core_dissoc(idx, len, map, i, key, del_list, new_idx, map_idx) +{ + len = types_heap[idx]["len"] + if (len < 2) { + return "!\"Invalid argument length for builtin function 'dissoc'. Expects at least 1 argument, supplied " (len - 1) "." + } + map = types_heap[idx][1] + if (map !~ /^\{/) { + return "!\"Incompatible type for argument 1 of builtin function 'dissoc'. Expects hash-map, supplied " types_typename(map) "." + } + for (i = 2; i < len; ++i) { + key = types_heap[idx][i] + if (key !~ /^[":]/) { + return "!\"Incompatible type for key argument of builtin function 'dissoc'. Expects string or keyword, supplied " types_typename(key) "." + } + del_list[key] = "1" + } + new_idx = types_allocate() + map_idx = substr(map, 2) + for (key in types_heap[map_idx]) { + if (key ~ /^[":]|^meta$/ && !(key in del_list)) { + types_addref(types_heap[new_idx][key] = types_heap[map_idx][key]) + } + } + return "{" new_idx +} + +function core_get(idx, map, key, map_idx) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function 'get'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + map = types_heap[idx][1] + if (map !~ /^\{/ && map != "#nil") { + return "!\"Incompatible type for argument 1 of builtin function 'get'. Expects hash-map or nil, supplied " types_typename(map) "." + } + key = types_heap[idx][2] + if (key !~ /^[":]/) { + return "!\"Incompatible type for argument 2 of builtin function 'get'. Expects string or keyword, supplied " types_typename(key) "." + } + if (map != "#nil" && key in types_heap[map_idx = substr(map, 2)]) { + return types_addref(types_heap[map_idx][key]) + } else { + return "#nil" + } +} + +function core_containsp(idx, map, key) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function 'contains?'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + map = types_heap[idx][1] + if (map !~ /^\{/) { + return "!\"Incompatible type for argument 1 of builtin function 'contains?'. Expects hash-map, supplied " types_typename(map) "." + } + key = types_heap[idx][2] + if (key !~ /^[":]/) { + return "!\"Incompatible type for argument 2 of builtin function 'contains?'. Expects string or keyword, supplied " types_typename(key) "." + } + return key in types_heap[substr(map, 2)] ? "#true" : "#false" +} + +function core_keys(idx, map, map_idx, new_idx, len, key) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'keys'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + map = types_heap[idx][1] + if (map !~ /^\{/) { + return "!\"Incompatible type for argument 1 of builtin function 'keys'. Expects hash-map, supplied " types_typename(map) "." + } + map_idx = substr(map, 2) + new_idx = types_allocate() + len = 0 + for (key in types_heap[map_idx]) { + if (key ~ /^[":]/) { + types_heap[new_idx][len++] = key + } + } + types_heap[new_idx]["len"] = len + return "(" new_idx +} + +function core_vals(idx, map, map_idx, new_idx, len, key) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'vals'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + map = types_heap[idx][1] + if (map !~ /^\{/) { + return "!\"Incompatible type for argument 1 of builtin function 'vals'. Expects hash-map, supplied " types_typename(map) "." + } + map_idx = substr(map, 2) + new_idx = types_allocate() + len = 0 + for (key in types_heap[map_idx]) { + if (key ~ /^[":]/) { + types_addref(types_heap[new_idx][len++] = types_heap[map_idx][key]) + } + } + types_heap[new_idx]["len"] = len + return "(" new_idx +} + + + +function core_sequentialp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'sequential?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^[([]/ ? "#true" : "#false" +} + +function core_cons(idx, lst, lst_idx, new_idx, len, i) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function 'cons'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lst = types_heap[idx][2] + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'cons'. Expects list or vector, supplied " types_typename(lst) "." + } + lst_idx = substr(lst, 2) + new_idx = types_allocate() + types_addref(types_heap[new_idx][0] = types_heap[idx][1]) + len = types_heap[lst_idx]["len"] + for (i = 0; i < len; ++i) { + types_addref(types_heap[new_idx][i + 1] = types_heap[lst_idx][i]) + } + types_heap[new_idx]["len"] = len + 1 + return "(" new_idx +} + +function core_concat(idx, new_idx, new_len, len, i, lst, lst_idx, lst_len, j) +{ + new_idx = types_allocate() + new_len = 0 + len = types_heap[idx]["len"] + for (i = 1; i < len; ++i) { + lst = types_heap[idx][i] + if (lst !~ /^[([]/) { + types_heap[new_idx]["len"] = new_len + types_release("(" new_idx) + return "!\"Incompatible type for argument ' (i - 1) ' of builtin function 'concat'. Expects list or vector, supplied " types_typename(lst) "." + } + lst_idx = substr(lst, 2) + lst_len = types_heap[lst_idx]["len"] + for (j = 0; j < lst_len; ++j) { + types_addref(types_heap[new_idx][new_len++] = types_heap[lst_idx][j]) + } + } + types_heap[new_idx]["len"] = new_len + return "(" new_idx +} + +function core_vec(idx, new_idx, len) +{ + len = types_heap[idx]["len"] + if (len != 2) + return "!\"Invalid argument length for builtin function 'vec'. Expects exactly 1 argument, supplied " (len - 1) "." + idx = types_heap[idx][1] + if (idx !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'vec'. Expects list or vector, supplied " types_typename(idx) "." + } + idx = substr(idx, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + types_heap[new_idx]["len"] = len + while (len--) + types_addref(types_heap[new_idx][len] = types_heap[idx][len]) + return "[" new_idx +} + +function core_nth(idx, lst, num, n, lst_idx) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function 'nth'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lst = types_heap[idx][1] + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'nth'. Expects list or vector, supplied " types_typename(lst) "." + } + num = types_heap[idx][2] + if (num !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function 'nth'. Expects number, supplied " types_typename(num) "." + } + n = substr(num, 2) + 0 + lst_idx = substr(lst, 2) + if (n < 0 || types_heap[lst_idx]["len"] <= n) { + return "!\"Index out of range. Sequence length is " types_heap[lst_idx]["len"] ", supplied " n "." + } + return types_addref(types_heap[lst_idx][n]) +} + +function core_first(idx, lst, lst_idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'first'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lst = types_heap[idx][1] + if (lst == "#nil") { + return "#nil" + } + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'first'. Expects list, vector or nil, supplied " types_typename(lst) "." + } + lst_idx = substr(lst, 2) + return types_heap[lst_idx]["len"] == 0 ? "#nil" : types_addref(types_heap[lst_idx][0]) +} + +function core_rest(idx, lst, lst_idx, lst_len, new_idx, i) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'rest'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lst = types_heap[idx][1] + if (lst == "#nil") { + new_idx = types_allocate() + types_heap[new_idx]["len"] = 0 + return "(" new_idx + } + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'rest'. Expects list, vector or nil, supplied " types_typename(lst) "." + } + lst_idx = substr(lst, 2) + lst_len = types_heap[lst_idx]["len"] + new_idx = types_allocate() + for (i = 1; i < lst_len; ++i) { + types_addref(types_heap[new_idx][i - 1] = types_heap[lst_idx][i]) + } + types_heap[new_idx]["len"] = lst_len - 1 + return "(" new_idx +} + +function core_emptyp(idx, lst) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'empty?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + lst = types_heap[idx][1] + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'empty?'. Expects list or vector, supplied " types_typename(lst) "." + } + return types_heap[substr(lst, 2)]["len"] == 0 ? "#true" : "#false" +} + +function core_count(idx, lst) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'count'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + lst = types_heap[idx][1] + if (lst ~ /^[([]/) { + return "+" types_heap[substr(lst, 2)]["len"] + } + if (lst == "#nil") { + return "+0" + } + return "!\"Incompatible type for argument 1 of builtin function 'count'. Expects list, vector or nil, supplied " types_typename(lst) "." +} + +function core_apply(idx, len, f, lst, new_idx, i, lst_idx, lst_len, f_idx, env, ret) +{ + len = types_heap[idx]["len"] + if (len < 3) { + return "!\"Invalid argument length for builtin function 'apply'. Expects at least 2 arguments, supplied " (len - 1) "." + } + f = types_heap[idx][1] + if (f !~ /^[$&%]/) { + return "!\"Incompatible type for argument 1 of builtin function 'apply'. Expects function, supplied " types_typename(f) "." + } + lst = types_heap[idx][len - 1] + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument ' (len - 1) ' of builtin function 'apply'. Expects list or vector, supplied " types_typename(lst) "." + } + + new_idx = types_allocate() + types_addref(types_heap[new_idx][0] = f) + for (i = 2; i < len - 1; ++i) { + types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i]) + } + lst_idx = substr(lst, 2) + lst_len = types_heap[lst_idx]["len"] + for (i = 0; i < lst_len; ++i) { + types_addref(types_heap[new_idx][len + i - 2] = types_heap[lst_idx][i]) + } + types_heap[new_idx]["len"] = len + lst_len - 2 + + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx) + types_release("(" new_idx) + if (env ~ /^!/) { + return env + } + ret = EVAL(types_addref(types_heap[f_idx]["body"]), env) + env_release(env) + return ret + case /^%/: + f_idx = types_heap[f_idx]["func"] + case /^&/: + ret = @f_idx(new_idx) + types_release("(" new_idx) + return ret + } +} + +function core_map(idx, f, lst, f_idx, lst_idx, lst_len, new_idx, expr_idx, i, env, ret, val) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function 'map'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + f = types_heap[idx][1] + if (f !~ /^[$&%]/) { + return "!\"Incompatible type for argument 1 of builtin function 'map'. Expects function, supplied " types_typename(f) "." + } + lst = types_heap[idx][2] + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument 2 of builtin function 'map'. Expects list or vector, supplied " types_typename(lst) "." + } + f_idx = substr(f, 2) + lst_idx = substr(lst, 2) + lst_len = types_heap[lst_idx]["len"] + new_idx = types_allocate() + types_heap[new_idx][0] = f + types_heap[new_idx]["len"] = 2 + expr_idx = types_allocate() + for (i = 0; i < lst_len; ++i) { + types_heap[new_idx][1] = types_heap[lst_idx][i] + switch (f) { + case /^\$/: + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx) + if (env ~ /^!/) { + types_heap[expr_idx]["len"] = i + types_heap[new_idx]["len"] = 0 + types_release("(" expr_idx) + types_release("(" new_idx) + return env + } + ret = EVAL(types_addref(types_heap[f_idx]["body"]), env) + env_release(env) + break + case /^%/: + f_idx = types_heap[f_idx]["func"] + case /^&/: + ret = @f_idx(new_idx) + break + } + if (ret ~ /^!/) { + types_heap[expr_idx]["len"] = i + types_heap[new_idx]["len"] = 0 + types_release("(" expr_idx) + types_release("(" new_idx) + return ret + } + types_heap[expr_idx][i] = ret + } + types_heap[expr_idx]["len"] = lst_len + types_heap[new_idx]["len"] = 0 + types_release("(" new_idx) + return "(" expr_idx +} + + + +function core_conj(idx, len, lst, lst_idx, lst_len, new_idx, i, j) +{ + len = types_heap[idx]["len"] + if (len < 3) { + return "!\"Invalid argument length for builtin function 'conj'. Expects at least 2 arguments, supplied " (len - 1) "." + } + lst = types_heap[idx][1] + if (lst !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'conj'. Expects list or vector, supplied " types_typename(lst) "." + } + lst_idx = substr(lst, 2) + lst_len = types_heap[lst_idx]["len"] + new_idx = types_allocate() + j = 0 + if (lst ~ /^\(/) { + for (i = len - 1; i >= 2; --i) { + types_addref(types_heap[new_idx][j++] = types_heap[idx][i]) + } + for (i = 0; i < lst_len; ++i) { + types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i]) + } + } else { + for (i = 0; i < lst_len; ++i) { + types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i]) + } + for (i = 2; i < len; ++i) { + types_addref(types_heap[new_idx][j++] = types_heap[idx][i]) + } + } + types_addref(types_heap[new_idx]["meta"] = types_heap[lst_idx]["meta"]) + types_heap[new_idx]["len"] = j + return substr(lst, 1, 1) new_idx +} + +function core_seq(idx, obj, obj_idx, new_idx, i, len, chars) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'seq'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + obj = types_heap[idx][1] + if (obj ~ /^[(]/) { + if (types_heap[substr(obj, 2)]["len"] == 0) { + return "#nil" + } + return types_addref(obj) + } else if (obj ~ /^\[/) { + obj_idx = substr(obj, 2) + len = types_heap[obj_idx]["len"] + if (len == 0) { return "#nil" } + new_idx = types_allocate() + for (i = 0; i < len; ++i) { + types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i]) + } + types_heap[new_idx]["len"] = len + return "(" new_idx + } else if (obj ~ /^"/) { + obj_idx = substr(obj, 2) + len = length(obj_idx) + if (len == 0) { return "#nil" } + new_idx = types_allocate() + split(obj_idx, chars, "") + for (i = 0; i <= len; ++i) { + types_heap[new_idx][i] = "\"" chars[i+1] + } + types_heap[new_idx]["len"] = len + return "(" new_idx + } else if (obj == "#nil") { + return "#nil" + } else { + return "!\"seq: called on non-sequence" + } +} + + +function core_meta(idx, obj, obj_idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'meta'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + obj = types_heap[idx][1] + if (obj ~ /^[([{$%]/ && "meta" in types_heap[obj_idx = substr(obj, 2)]) { + return types_addref(types_heap[obj_idx]["meta"]) + } + return "#nil" +} + +function core_with_meta(idx, obj, obj_idx, new_idx, i, len) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function 'with-meta'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + obj = types_heap[idx][1] + obj_idx = substr(obj, 2) + new_idx = types_allocate() + types_addref(types_heap[new_idx]["meta"] = types_heap[idx][2]) + switch (obj) { + case /^[([]/: + len = types_heap[obj_idx]["len"] + for (i = 0; i < len; ++i) { + types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i]) + } + types_heap[new_idx]["len"] = len + return substr(obj, 1, 1) new_idx + case /^\{/: + for (i in types_heap[obj_idx]) { + if (i ~ /^[":]/) { + types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i]) + } + } + return "{" new_idx + case /^\$/: + types_addref(types_heap[new_idx]["params"] = types_heap[obj_idx]["params"]) + types_addref(types_heap[new_idx]["body"] = types_heap[obj_idx]["body"]) + env_addref(types_heap[new_idx]["env"] = types_heap[obj_idx]["env"]) + return "$" new_idx + case /^&/: + types_heap[new_idx]["func"] = obj_idx + return "%" new_idx + case /^%/: + types_heap[new_idx]["func"] = types_heap[obj_idx]["func"] + return "%" new_idx + default: + types_release("{" new_idx) + return "!\"Incompatible type for argument 1 of builtin function 'with-meta'. Expects list, vector, hash-map or function, supplied " types_typename(lst) "." + } +} + +function core_atom(idx, atom_idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'atom'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + atom_idx = types_allocate() + types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][1]) + return "?" atom_idx +} + +function core_atomp(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'atom?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return types_heap[idx][1] ~ /^\?/ ? "#true" : "#false" +} + +function core_deref(idx, atom) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'deref'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + atom = types_heap[idx][1] + if (atom !~ /^\?/) { + return "!\"Incompatible type for argument 1 of builtin function 'deref'. Expects atom, supplied " types_typename(atom) "." + } + return types_addref(types_heap[substr(atom, 2)]["obj"]) +} + +function core_reset(idx, atom, atom_idx) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function 'reset!'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + atom = types_heap[idx][1] + if (atom !~ /^\?/) { + return "!\"Incompatible type for argument 1 of builtin function 'reset!'. Expects atom, supplied " types_typename(atom) "." + } + atom_idx = substr(atom, 2) + types_release(types_heap[atom_idx]["obj"]) + return types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][2]) +} + +function core_swap(idx, expr, atom, f, lst_idx, ret, f_idx, env, i, len, atom_idx) +{ + len = types_heap[idx]["len"] + if (len < 3) { + return "!\"Invalid argument length for builtin function 'swap!'. Expects at least 2 arguments, supplied " (len - 1) "." + } + atom = types_heap[idx][1] + if (atom !~ /^\?/) { + return "!\"Incompatible type for argument 1 of builtin function 'swap!'. Expects atom, supplied " types_typename(atom) "." + } + f = types_heap[idx][2] + if (f !~ /^[&$%]/) { + return "!\"Incompatible type for argument 2 of builtin function 'swap!'. Expects function, supplied " types_typename(f) "." + } + lst_idx = types_allocate() + atom_idx = substr(atom, 2) + types_addref(types_heap[lst_idx][0] = f) + types_addref(types_heap[lst_idx][1] = types_heap[atom_idx]["obj"]) + for (i = 3; i < len; ++i) { + types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) + } + types_heap[lst_idx]["len"] = len - 1 + + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], lst_idx) + types_release("(" lst_idx) + if (env ~ /^!/) { + return env + } + ret = EVAL(types_addref(types_heap[f_idx]["body"]), env) + env_release(env) + break + case /^%/: + f_idx = types_heap[f_idx]["func"] + case /^&/: + ret = @f_idx(lst_idx) + types_release("(" lst_idx) + break + } + + if (ret ~ /^!/) { + return ret + } + types_release(types_heap[atom_idx]["obj"]) + return types_addref(types_heap[atom_idx]["obj"] = ret) +} + +function core_init() +{ + core_ns["'="] = "&core_eq" + core_ns["'throw"] = "&core_throw" + + core_ns["'nil?"] = "&core_nilp" + core_ns["'true?"] = "&core_truep" + core_ns["'false?"] = "&core_falsep" + core_ns["'string?"] = "&core_stringp" + core_ns["'symbol"] = "&core_symbol" + core_ns["'symbol?"] = "&core_symbolp" + core_ns["'keyword"] = "&core_keyword" + core_ns["'keyword?"] = "&core_keywordp" + core_ns["'number?"] = "&core_numberp" + core_ns["'fn?"] = "&core_fnp" + core_ns["'macro?"] = "&core_macrop" + + core_ns["'pr-str"] = "&core_pr_str" + core_ns["'str"] = "&core_str" + core_ns["'prn"] = "&core_prn" + core_ns["'println"] = "&core_println" + core_ns["'read-string"] = "&core_read_string" + core_ns["'readline"] = "&core_readline" + core_ns["'slurp"] = "&core_slurp" + + core_ns["'<"] = "&core_lt" + core_ns["'<="] = "&core_le" + core_ns["'>"] = "&core_gt" + core_ns["'>="] = "&core_ge" + core_ns["'+"] = "&core_add" + core_ns["'-"] = "&core_subtract" + core_ns["'*"] = "&core_multiply" + core_ns["'/"] = "&core_divide" + core_ns["'time-ms"] = "&core_time_ms" + + core_ns["'list"] = "&core_list" + core_ns["'list?"] = "&core_listp" + core_ns["'vec"] = "&core_vec" + core_ns["'vector"] = "&core_vector" + core_ns["'vector?"] = "&core_vectorp" + core_ns["'hash-map"] = "&core_hash_map" + core_ns["'map?"] = "&core_mapp" + core_ns["'assoc"] = "&core_assoc" + core_ns["'dissoc"] = "&core_dissoc" + core_ns["'get"] = "&core_get" + core_ns["'contains?"] = "&core_containsp" + core_ns["'keys"] = "&core_keys" + core_ns["'vals"] = "&core_vals" + + core_ns["'sequential?"] = "&core_sequentialp" + core_ns["'cons"] = "&core_cons" + core_ns["'concat"] = "&core_concat" + core_ns["'nth"] = "&core_nth" + core_ns["'first"] = "&core_first" + core_ns["'rest"] = "&core_rest" + core_ns["'empty?"] = "&core_emptyp" + core_ns["'count"] = "&core_count" + core_ns["'apply"] = "&core_apply" + core_ns["'map"] = "&core_map" + + core_ns["'conj"] = "&core_conj" + core_ns["'seq"] = "&core_seq" + + core_ns["'meta"] = "&core_meta" + core_ns["'with-meta"] = "&core_with_meta" + core_ns["'atom"] = "&core_atom" + core_ns["'atom?"] = "&core_atomp" + core_ns["'deref"] = "&core_deref" + core_ns["'reset!"] = "&core_reset" + core_ns["'swap!"] = "&core_swap" +} + + + +BEGIN { + core_init() +} diff --git a/impls/awk/env.awk b/impls/awk/env.awk new file mode 100644 index 0000000000..8f5b6d7812 --- /dev/null +++ b/impls/awk/env.awk @@ -0,0 +1,126 @@ +function env_new(outer, params, args, idx, len, i, j, lst, param) +{ + if (params != "") { + params = substr(params, 2) + len = types_heap[params]["len"] + if (len >= 2 && types_heap[params][len - 2] == "'&") { + if (types_heap[args]["len"] < len - 1) { + return "!\"Invalid argument length for the function. Expects at least " (len - 2) " arguments, supplied " (types_heap[args]["len"] - 1) "." + } + } else { + if (types_heap[args]["len"] != len + 1) { + return "!\"Invalid argument length for the function. Expects exactly " len " arguments, supplied " (types_heap[args]["len"] - 1) "." + } + } + } + env_heap[env_heap_index]["ref"] = 1 + env_heap[env_heap_index]["outer"] = outer + if (params != "") { + for (i = 0; i < len; ++i) { + param = types_heap[params][i] + if (param == "'&") { + idx = types_allocate() + env_set(env_heap_index, types_heap[params][++i], "(" idx) + len = types_heap[args]["len"] + for (j = 0; i < len; ++j) { + types_addref(types_heap[idx][j] = types_heap[args][i++]) + } + types_heap[idx]["len"] = j + break + } + env_set(env_heap_index, param, types_heap[args][i + 1]) + types_addref(types_heap[args][i + 1]) + } + } + if (outer != "") { + env_addref(outer) + } + return env_heap_index++ +} + +function env_set(env, key, val) +{ + if (key in env_heap[env]) { + types_release(env_heap[env][key]) + } + if (val ~ /^&/) { + env_builtinnames[substr(val, 2)] = substr(key, 2) + } + env_heap[env][key] = val +} + +function env_find(env, key) +{ + while (env != "") { + if (key in env_heap[env]) { + return env + } + env = env_heap[env]["outer"] + } + return env +} + +function env_get(env, key) +{ + env = env_find(env, key) + if (env != "") { + return env_heap[env][key] + } + return "!\"'" substr(key, 2) "' not found" +} + +function env_addref(env) +{ + env_heap[env]["ref"]++ +} + +function env_release(env, i, outer) +{ + while (env != "" && --env_heap[env]["ref"] == 0) { + for (i in env_heap[env]) { + if (i ~ /^'/) { + types_release(env_heap[env][i]) + } + } + outer = env_heap[env]["outer"] + delete env_heap[env] + env = outer + } +} + +function env_dump(i, j) +{ + for (i = 0; i < env_heap_index; i++) { + if (i in env_heap) { + if (isarray(env_heap[i])) { + if (!("checked" in env_heap[i]) || env_heap[i]["checked"] != env_heap[i]["ref"]) { + for (j in env_heap[i]) { + print " env_heap[" i "][" j "] = " env_heap[i][j] + } + } + } else { + print " env_heap[" i "] = " env_heap[i] + } + } + } +} + +function env_check(env, i, outer) +{ + if (env_heap[env]["checked"]++) { + return + } + for (i in env_heap[env]) { + if (i != "ref" && i != "outer") { + types_check(env_heap[env][i]) + } + } + outer = env_heap[env]["outer"] + if (outer in env_heap) { + env_check(outer) + } +} + +BEGIN { + env_heap_index = 0 +} diff --git a/impls/awk/printer.awk b/impls/awk/printer.awk new file mode 100644 index 0000000000..f8f62d7726 --- /dev/null +++ b/impls/awk/printer.awk @@ -0,0 +1,63 @@ +function printer_pr_list(expr, print_readably, idx, len, i, str) +{ + idx = substr(expr, 2) + len = types_heap[idx]["len"] + for (i = 0; i < len; ++i) { + str = str printer_pr_str(types_heap[idx][i], print_readably) " " + } + return substr(str, 1, length(str) - 1) +} + +function printer_pr_hash(expr, print_readably, idx, var, str) +{ + idx = substr(expr, 2) + for (var in types_heap[idx]) { + switch (var) { + case /^"/: + str = str printer_pr_string(var, print_readably) " " printer_pr_str(types_heap[idx][var], print_readably) " " + break + case /^:/: + str = str substr(var, 2) " " printer_pr_str(types_heap[idx][var], print_readably) " " + break + } + } + return substr(str, 1, length(str) - 1) +} + +function printer_pr_string(expr, print_readably, v, r) +{ + if (!print_readably) { + return substr(expr, 2) + } + expr = substr(expr, 2) + while (match(expr, /["\n\\]/, r)) { + v = v substr(expr, 1, RSTART - 1) (r[0] == "\n" ? "\\n" : "\\" r[0]) + expr = substr(expr, RSTART + RLENGTH) + } + return "\"" v expr "\"" +} + +function printer_pr_str(expr, print_readably, var) +{ + switch (expr) { + case /^\(/: + return "(" printer_pr_list(expr, print_readably) ")" + case /^\[/: + return "[" printer_pr_list(expr, print_readably) "]" + case /^\{/: + return "{" printer_pr_hash(expr, print_readably) "}" + case /^"/: + return printer_pr_string(expr, print_readably) + case /^\$/: + var = substr(expr, 2) + return "# (fn* " printer_pr_str(types_heap[var]["params"], print_readably) " " printer_pr_str(types_heap[var]["body"], print_readably) ")" + case /^&/: + return "#" + case /^%/: + return "#" + case /^\?/: + return "(atom " printer_pr_str(types_heap[substr(expr, 2)]["obj"], print_readably) ")" + default: + return substr(expr, 2) + } +} diff --git a/impls/awk/reader.awk b/impls/awk/reader.awk new file mode 100644 index 0000000000..66295c9ea2 --- /dev/null +++ b/impls/awk/reader.awk @@ -0,0 +1,185 @@ +function reader_read_string(token, v, r) +{ + token = substr(token, 1, length(token) - 1) + gsub(/\\\\/, "\xf7", token) + gsub(/\\"/, "\"", token) + gsub(/\\n/, "\n", token) + gsub("\xf7", "\\", token) + return token +} + +function reader_read_atom(token) +{ + switch (token) { + case "true": + case "false": + case "nil": + return "#" token + case /^:/: + return ":" token + case /^"/: + if (token ~ /^"(\\.|[^\\"])*"$/) { + return reader_read_string(token) + } else { + return "!\"Expected '\"', got EOF." + } + case /^-?[0-9]+$/: + return "+" token + default: + return "'" token + } +} + +function reader_read_list(reader, type, end, idx, len, ret) +{ + idx = types_allocate() + len = 0 + while (reader["curidx"] in reader) { + if (reader[reader["curidx"]] == end) { + types_heap[idx]["len"] = len + reader["curidx"]++ + return type idx + } + ret = reader_read_from(reader) + if (ret ~ /^!/) { + types_heap[idx]["len"] = len + types_release(type idx) + return ret + } + types_heap[idx][len++] = ret + } + types_heap[idx]["len"] = len + types_release(type idx) + return "!\"expected '" end "', got EOF" +} + +function reader_read_hash(reader, idx, key, val) +{ + idx = types_allocate() + while (reader["curidx"] in reader) { + if (reader[reader["curidx"]] == "}") { + reader["curidx"]++ + return "{" idx + } + key = reader_read_from(reader) + if (key ~ /^!/) { + types_release("{" idx) + return key + } + if (key !~ /^[":]/) { + types_release(key) + types_release("{" idx) + return "!\"Hash-map key must be string or keyword." + } + if (!(reader["curidx"] in reader)) { + types_release("{" idx) + return "!\"Element count of hash-map must be even." + } + val = reader_read_from(reader) + if (val ~ /^!/) { + types_release("{" idx) + return val + } + types_heap[idx][key] = val + } + types_release("{" idx) + return "!\"expected '}', got EOF" +} + +function reader_read_abbrev(reader, symbol, val, idx) +{ + val = reader_read_from(reader) + if (val ~ /^!/) { + return val + } + idx = types_allocate() + types_heap[idx]["len"] = 2 + types_heap[idx][0] = symbol + types_heap[idx][1] = val + return "(" idx +} + +function reader_read_with_meta(reader, meta, val, idx) +{ + meta = reader_read_from(reader) + if (meta ~ /^!/) { + return meta + } + val = reader_read_from(reader) + if (val ~ /^!/) { + types_release(meta) + return val + } + idx = types_allocate() + types_heap[idx]["len"] = 3 + types_heap[idx][0] = "'with-meta" + types_heap[idx][1] = val + types_heap[idx][2] = meta + return "(" idx +} + +function reader_read_from(reader, current) +{ + current = reader[reader["curidx"]++] + switch (current) { + case "(": + return reader_read_list(reader, "(", ")") + case "[": + return reader_read_list(reader, "[", "]") + case "{": + return reader_read_hash(reader) + case ")": + case "]": + case "}": + return "!\"Unexpected token '" current "'." + case "'": + return reader_read_abbrev(reader, "'quote") + case "`": + return reader_read_abbrev(reader, "'quasiquote") + case "~": + return reader_read_abbrev(reader, "'unquote") + case "~@": + return reader_read_abbrev(reader, "'splice-unquote") + case "@": + return reader_read_abbrev(reader, "'deref") + case "^": + return reader_read_with_meta(reader) + default: + return reader_read_atom(current) + } +} + +function reader_tokenizer(str, reader, len, r) +{ + for (len = 0; match(str, /^[ \t\r\n,]*(~@|[\[\]{}()'`~^@]|\"(\\.|[^\\"])*\"?|;[^\r\n]*|[^ \t\r\n\[\]{}('"`,;)^~@][^ \t\r\n\[\]{}('"`,;)]*)/, r); ) { + if (substr(r[1], 1, 1) != ";") { + reader[len++] = r[1] + } + str = substr(str, RSTART + RLENGTH) + } + if (str !~ /^[ \t\r\n,]*$/) { + return "!\"Cannot tokenize '" str "'." + } + reader["len"] = len + return "" +} + +function reader_read_str(str, reader, ret) +{ + ret = reader_tokenizer(str, reader) + if (ret != "") { + return ret + } + if (reader["len"] == 0) { + return "#nil" + } + ret = reader_read_from(reader) + if (ret ~ /^!/) { + return ret + } + if (reader["len"] != reader["curidx"]) { + types_release(ret) + return "!\"Unexpected token '" reader[reader["curidx"]] "'." + } + return ret +} diff --git a/impls/awk/run b/impls/awk/run new file mode 100755 index 0000000000..9c3061869f --- /dev/null +++ b/impls/awk/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec awk -O -f $(dirname $0)/${STEP:-stepA_mal}.awk "${@}" diff --git a/impls/awk/step0_repl.awk b/impls/awk/step0_repl.awk new file mode 100644 index 0000000000..bb731fd7ee --- /dev/null +++ b/impls/awk/step0_repl.awk @@ -0,0 +1,35 @@ +function READ(str) +{ + return str +} + +function EVAL(ast) +{ + return ast +} + +function PRINT(expr) +{ + return expr +} + +function rep(str) +{ + return PRINT(EVAL(READ(str))) +} + +function main(str) +{ + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + print rep(str) + } +} + +BEGIN { + main() + exit(0) +} diff --git a/impls/awk/step1_read_print.awk b/impls/awk/step1_read_print.awk new file mode 100644 index 0000000000..a3cdfc7504 --- /dev/null +++ b/impls/awk/step1_read_print.awk @@ -0,0 +1,52 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +function EVAL(ast) +{ + return ast +} + +function PRINT(expr) +{ + return printer_pr_str(expr, 1) +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function main(str, ret) +{ + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + exit(0) +} diff --git a/impls/awk/step2_eval.awk b/impls/awk/step2_eval.awk new file mode 100644 index 0000000000..8b56497d46 --- /dev/null +++ b/impls/awk/step2_eval.awk @@ -0,0 +1,217 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL(ast, env, new_ast, ret, idx, f, f_idx) +{ + # print "EVAL: " printer_pr_str(ast, 1) + + switch (ast) { + case /^'/: # symbol + if (ast in env) { + ret = types_addref(env[ast]) + } else { + ret = "!\"'" substr(ast, 2) "' not found" + } + types_release(ast) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + return ret + case /^[^(]/: # not a list + types_release(ast) + return ast + } + idx = substr(ast, 2) + if (types_heap[idx]["len"] == 0) { + return ast + } + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + return f + } + new_ast = eval_ast(ast, env) + types_release(ast) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + if (f ~ /^&/) { + f_idx = substr(f, 2) + ret = @f_idx(idx) + types_release(new_ast) + return ret + } else { + types_release(new_ast) + return "!\"First element of list must be function, supplied " types_typename(f) "." + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function add(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) + substr(rhs, 2)) +} + +function subtract(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) - substr(rhs, 2)) +} + +function multiply(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) * substr(rhs, 2)) +} + +function divide(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "." + } + return "+" int(substr(lhs, 2) / substr(rhs, 2)) +} + +function main(str, ret) +{ + repl_env["'+"] = "&add" + repl_env["'-"] = "&subtract" + repl_env["'*"] = "&multiply" + repl_env["'/"] = "÷" + env_builtinnames["add"] = "+" + env_builtinnames["subtract"] = "-" + env_builtinnames["multiply"] = "*" + env_builtinnames["divide"] = "/" + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + exit(0) +} diff --git a/impls/awk/step3_env.awk b/impls/awk/step3_env.awk new file mode 100644 index 0000000000..c4c09d9c8a --- /dev/null +++ b/impls/awk/step3_env.awk @@ -0,0 +1,312 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret = EVAL(body, new_env) + env_release(new_env) + return ret +} + +function EVAL(ast, env, new_ast, ret, idx, f, f_idx) +{ + env_addref(env) + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + if (types_heap[idx]["len"] == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + return EVAL_let(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + f_idx = substr(f, 2) + switch (f) { + case /^&/: + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + return "!\"First element of list must be function, supplied " types_typename(f) "." + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function add(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) + substr(rhs, 2)) +} + +function subtract(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) - substr(rhs, 2)) +} + +function multiply(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "." + } + return "+" (substr(lhs, 2) * substr(rhs, 2)) +} + +function divide(idx, lhs, rhs) +{ + if (types_heap[idx]["len"] != 3) { + return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." + } + lhs = types_heap[idx][1] + if (lhs !~ /^\+/) { + return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "." + } + rhs = types_heap[idx][2] + if (rhs !~ /^\+/) { + return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "." + } + return "+" int(substr(lhs, 2) / substr(rhs, 2)) +} + +function main(str, ret) +{ + repl_env = env_new() + env_set(repl_env, "'+", "&add") + env_set(repl_env, "'-", "&subtract") + env_set(repl_env, "'*", "&multiply") + env_set(repl_env, "'/", "÷") + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/step4_if_fn_do.awk b/impls/awk/step4_if_fn_do.awk new file mode 100644 index 0000000000..57bd7c07f7 --- /dev/null +++ b/impls/awk/step4_if_fn_do.awk @@ -0,0 +1,366 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" +@include "core.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret = EVAL(body, new_env) + env_release(new_env) + return ret +} + +function EVAL_do(ast, env, idx, len, i, ret) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 1) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." + } + for (i = 1; i < len - 1; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + } + ret = EVAL(types_addref(types_heap[idx][len - 1]), env) + types_release(ast) + env_release(env) + return ret +} + +function EVAL_if(ast, env, idx, len, ret, body) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 3 && len != 4) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + switch (ret) { + case "#nil": + case "#false": + if (len == 3) { + types_release(ast) + env_release(env) + return "#nil" + } else { + types_addref(body = types_heap[idx][3]) + } + break + default: + types_addref(body = types_heap[idx][2]) + break + } + ret = EVAL(body, env) + types_release(ast) + env_release(env) + return ret +} + +function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + for (i = 0; i < params_len; ++i) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." + } + if (sym == "'&" && i + 2 != params_len) { + types_release(ast) + env_release(env) + return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." + } + } + f_idx = types_allocate() + types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) + types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) + types_heap[f_idx]["env"] = env + types_release(ast) + return "$" f_idx +} + +function EVAL(ast, env, new_ast, ret, idx, f, f_idx) +{ + env_addref(env) + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + if (types_heap[idx]["len"] == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + return EVAL_let(ast, env) + case "'do": + return EVAL_do(ast, env) + case "'if": + return EVAL_if(ast, env) + case "'fn*": + return EVAL_fn(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + if (env ~ /^!/) { + types_release(new_ast) + return env + } + types_addref(ast = types_heap[f_idx]["body"]) + types_release(new_ast) + ret = EVAL(ast, env) + env_release(env) + return ret + case /^&/: + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + return "!\"First element of list must be function, supplied " types_typename(f) "." + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function main(str, ret, i) +{ + repl_env = env_new() + for (i in core_ns) { + env_set(repl_env, i, core_ns[i]) + } + + rep("(def! not (fn* (a) (if a false true)))") + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/step5_tco.awk b/impls/awk/step5_tco.awk new file mode 100644 index 0000000000..de864fe99a --- /dev/null +++ b/impls/awk/step5_tco.awk @@ -0,0 +1,376 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" +@include "core.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret_env[0] = new_env + return body +} + +function EVAL_do(ast, env, idx, len, i, body, ret) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 1) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." + } + for (i = 1; i < len - 1; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + } + types_addref(body = types_heap[idx][len - 1]) + types_release(ast) + return body +} + +function EVAL_if(ast, env, idx, len, ret, body) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 3 && len != 4) { + types_release(ast) + return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + types_release(ret) + switch (ret) { + case "#nil": + case "#false": + if (len == 3) { + body = "#nil" + } else { + types_addref(body = types_heap[idx][3]) + } + break + default: + types_addref(body = types_heap[idx][2]) + break + } + types_release(ast) + return body +} + +function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + for (i = 0; i < params_len; ++i) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." + } + if (sym == "'&" && i + 2 != params_len) { + types_release(ast) + env_release(env) + return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." + } + } + f_idx = types_allocate() + types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) + types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) + types_heap[f_idx]["env"] = env + types_release(ast) + return "$" f_idx +} + +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) +{ + env_addref(env) + for (;;) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + ast = EVAL_let(ast, env, ret_env) + if (ast ~ /^!/) { + return ast + } + env = ret_env[0] + continue + case "'do": + ast = EVAL_do(ast, env) + if (ast ~ /^!/) { + return ast + } + continue + case "'if": + ast = EVAL_if(ast, env) + if (ast !~ /^['([{]/) { + env_release(env) + return ast + } + continue + case "'fn*": + return EVAL_fn(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + if (env ~ /^!/) { + types_release(new_ast) + return env + } + types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) + types_release(new_ast) + continue + case /^&/: + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret + } + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function main(str, ret, i) +{ + repl_env = env_new() + for (i in core_ns) { + env_set(repl_env, i, core_ns[i]) + } + + rep("(def! not (fn* (a) (if a false true)))") + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/step6_file.awk b/impls/awk/step6_file.awk new file mode 100644 index 0000000000..2ffa833b6d --- /dev/null +++ b/impls/awk/step6_file.awk @@ -0,0 +1,400 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" +@include "core.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret_env[0] = new_env + return body +} + +function EVAL_do(ast, env, idx, len, i, body, ret) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 1) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." + } + for (i = 1; i < len - 1; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + } + types_addref(body = types_heap[idx][len - 1]) + types_release(ast) + return body +} + +function EVAL_if(ast, env, idx, len, ret, body) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 3 && len != 4) { + types_release(ast) + return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + types_release(ret) + switch (ret) { + case "#nil": + case "#false": + if (len == 3) { + body = "#nil" + } else { + types_addref(body = types_heap[idx][3]) + } + break + default: + types_addref(body = types_heap[idx][2]) + break + } + types_release(ast) + return body +} + +function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + for (i = 0; i < params_len; ++i) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." + } + if (sym == "'&" && i + 2 != params_len) { + types_release(ast) + env_release(env) + return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." + } + } + f_idx = types_allocate() + types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) + types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) + types_heap[f_idx]["env"] = env + types_release(ast) + return "$" f_idx +} + +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) +{ + env_addref(env) + for (;;) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + ast = EVAL_let(ast, env, ret_env) + if (ast ~ /^!/) { + return ast + } + env = ret_env[0] + continue + case "'do": + ast = EVAL_do(ast, env) + if (ast ~ /^!/) { + return ast + } + continue + case "'if": + ast = EVAL_if(ast, env) + if (ast !~ /^['([{]/) { + env_release(env) + return ast + } + continue + case "'fn*": + return EVAL_fn(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + if (env ~ /^!/) { + types_release(new_ast) + return env + } + types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) + types_release(new_ast) + continue + case /^&/: + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret + } + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function eval(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return EVAL(types_addref(types_heap[idx][1]), repl_env) +} + +function main(str, ret, i, idx) +{ + repl_env = env_new() + for (i in core_ns) { + env_set(repl_env, i, core_ns[i]) + } + + env_set(repl_env, "'eval", "&eval") + + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") + + idx = types_allocate() + env_set(repl_env, "'*ARGV*", "(" idx) + if (ARGC > 1) { + for (i = 2; i < ARGC; ++i) { + types_heap[idx][i - 2] = "\"" ARGV[i] + } + types_heap[idx]["len"] = ARGC - 2 + ARGC = 1 + rep("(load-file \"" ARGV[1] "\")") + return + } + types_heap[idx]["len"] = 0 + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/step7_quote.awk b/impls/awk/step7_quote.awk new file mode 100644 index 0000000000..ae4e3328d2 --- /dev/null +++ b/impls/awk/step7_quote.awk @@ -0,0 +1,503 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" +@include "core.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) +{ + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] +} + +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) +{ + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { + new_idx = types_allocate() + types_heap[new_idx][0] = "'quote" + types_heap[new_idx][1] = ast + types_heap[new_idx]["len"] = 2 + return "(" new_idx + } + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { + types_release(ast) + return ret + } + if (ret) { + types_addref(ret) + types_release(ast) + return ret + } + new_idx = types_allocate() + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) + return "(" new_idx +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret_env[0] = new_env + return body +} + +function EVAL_do(ast, env, idx, len, i, body, ret) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 1) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." + } + for (i = 1; i < len - 1; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + } + types_addref(body = types_heap[idx][len - 1]) + types_release(ast) + return body +} + +function EVAL_if(ast, env, idx, len, ret, body) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 3 && len != 4) { + types_release(ast) + return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + types_release(ret) + switch (ret) { + case "#nil": + case "#false": + if (len == 3) { + body = "#nil" + } else { + types_addref(body = types_heap[idx][3]) + } + break + default: + types_addref(body = types_heap[idx][2]) + break + } + types_release(ast) + return body +} + +function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + for (i = 0; i < params_len; ++i) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." + } + if (sym == "'&" && i + 2 != params_len) { + types_release(ast) + env_release(env) + return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." + } + } + f_idx = types_allocate() + types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) + types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) + types_heap[f_idx]["env"] = env + types_release(ast) + return "$" f_idx +} + +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) +{ + env_addref(env) + for (;;) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + ast = EVAL_let(ast, env, ret_env) + if (ast ~ /^!/) { + return ast + } + env = ret_env[0] + continue + case "'quote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + env_release(env) + return body + case "'quasiquote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + ast = quasiquote(body) + if (ast ~ /^!/) { + env_release(env) + return ast + } + continue + case "'do": + ast = EVAL_do(ast, env) + if (ast ~ /^!/) { + return ast + } + continue + case "'if": + ast = EVAL_if(ast, env) + if (ast !~ /^['([{]/) { + env_release(env) + return ast + } + continue + case "'fn*": + return EVAL_fn(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + if (env ~ /^!/) { + types_release(new_ast) + return env + } + types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) + types_release(new_ast) + continue + case /^&/: + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret + } + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function eval(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return EVAL(types_addref(types_heap[idx][1]), repl_env) +} + +function main(str, ret, i, idx) +{ + repl_env = env_new() + for (i in core_ns) { + env_set(repl_env, i, core_ns[i]) + } + + env_set(repl_env, "'eval", "&eval") + + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") + + idx = types_allocate() + env_set(repl_env, "'*ARGV*", "(" idx) + if (ARGC > 1) { + for (i = 2; i < ARGC; ++i) { + types_heap[idx][i - 2] = "\"" ARGV[i] + } + types_heap[idx]["len"] = ARGC - 2 + ARGC = 1 + rep("(load-file \"" ARGV[1] "\")") + return + } + types_heap[idx]["len"] = 0 + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/step8_macros.awk b/impls/awk/step8_macros.awk new file mode 100644 index 0000000000..c8c6d15f62 --- /dev/null +++ b/impls/awk/step8_macros.awk @@ -0,0 +1,570 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" +@include "core.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) +{ + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] +} + +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) +{ + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { + new_idx = types_allocate() + types_heap[new_idx][0] = "'quote" + types_heap[new_idx][1] = ast + types_heap[new_idx]["len"] = 2 + return "(" new_idx + } + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { + types_release(ast) + return ret + } + if (ret) { + types_addref(ret) + types_release(ast) + return ret + } + new_idx = types_allocate() + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) + return "(" new_idx +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret_env[0] = new_env + return body +} + +function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'defmacro!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'defmacro!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + types_release(ast) + if (ret ~ /^!/) { + env_release(env) + return ret + } + if (ret !~ /^\$/) { + types_release(ret) + env_release(env) + return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." + } + + # Replace `ret` with a clone setting the `is_macro` bit. + fun_idx = substr(ret, 2) + mac_idx = types_allocate() + types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"]) + types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"]) + env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"]) + types_heap[mac_idx]["is_macro"] = 1 + types_release(ret) + ret = "$" mac_idx + + env_set(env, sym, ret) + types_addref(ret) + env_release(env) + return ret +} + +function EVAL_do(ast, env, idx, len, i, body, ret) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 1) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." + } + for (i = 1; i < len - 1; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + } + types_addref(body = types_heap[idx][len - 1]) + types_release(ast) + return body +} + +function EVAL_if(ast, env, idx, len, ret, body) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 3 && len != 4) { + types_release(ast) + return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + types_release(ret) + switch (ret) { + case "#nil": + case "#false": + if (len == 3) { + body = "#nil" + } else { + types_addref(body = types_heap[idx][3]) + } + break + default: + types_addref(body = types_heap[idx][2]) + break + } + types_release(ast) + return body +} + +function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + for (i = 0; i < params_len; ++i) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." + } + if (sym == "'&" && i + 2 != params_len) { + types_release(ast) + env_release(env) + return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." + } + } + f_idx = types_allocate() + types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) + types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) + types_heap[f_idx]["env"] = env + types_release(ast) + return "$" f_idx +} + +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) +{ + env_addref(env) + for (;;) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + ast = EVAL_let(ast, env, ret_env) + if (ast ~ /^!/) { + return ast + } + env = ret_env[0] + continue + case "'quote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + env_release(env) + return body + case "'quasiquote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + ast = quasiquote(body) + if (ast ~ /^!/) { + env_release(env) + return ast + } + continue + case "'defmacro!": + return EVAL_defmacro(ast, env) + case "'do": + ast = EVAL_do(ast, env) + if (ast ~ /^!/) { + return ast + } + continue + case "'if": + ast = EVAL_if(ast, env) + if (ast !~ /^['([{]/) { + env_release(env) + return ast + } + continue + case "'fn*": + return EVAL_fn(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + if (types_heap[f_idx]["is_macro"]) { + idx = substr(ast, 2) + ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + types_release(ast) + if (ret ~ /^!/) { + types_release(f) + types_release(env) + return ret + } + ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) + types_release(ret) + types_release(f) + continue + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + if (env ~ /^!/) { + types_release(new_ast) + return env + } + types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) + types_release(new_ast) + continue + case /^&/: + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret + } + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function eval(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return EVAL(types_addref(types_heap[idx][1]), repl_env) +} + +function main(str, ret, i, idx) +{ + repl_env = env_new() + for (i in core_ns) { + env_set(repl_env, i, core_ns[i]) + } + + env_set(repl_env, "'eval", "&eval") + + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + idx = types_allocate() + env_set(repl_env, "'*ARGV*", "(" idx) + if (ARGC > 1) { + for (i = 2; i < ARGC; ++i) { + types_heap[idx][i - 2] = "\"" ARGV[i] + } + types_heap[idx]["len"] = ARGC - 2 + ARGC = 1 + rep("(load-file \"" ARGV[1] "\")") + return + } + types_heap[idx]["len"] = 0 + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/step9_try.awk b/impls/awk/step9_try.awk new file mode 100644 index 0000000000..72c6b5c42e --- /dev/null +++ b/impls/awk/step9_try.awk @@ -0,0 +1,632 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" +@include "core.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) +{ + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] +} + +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) +{ + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { + new_idx = types_allocate() + types_heap[new_idx][0] = "'quote" + types_heap[new_idx][1] = ast + types_heap[new_idx]["len"] = 2 + return "(" new_idx + } + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { + types_release(ast) + return ret + } + if (ret) { + types_addref(ret) + types_release(ast) + return ret + } + new_idx = types_allocate() + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) + return "(" new_idx +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret_env[0] = new_env + return body +} + +function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'defmacro!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'defmacro!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + types_release(ast) + if (ret ~ /^!/) { + env_release(env) + return ret + } + if (ret !~ /^\$/) { + types_release(ret) + env_release(env) + return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." + } + + # Replace `ret` with a clone setting the `is_macro` bit. + fun_idx = substr(ret, 2) + mac_idx = types_allocate() + types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"]) + types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"]) + env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"]) + types_heap[mac_idx]["is_macro"] = 1 + types_release(ret) + ret = "$" mac_idx + + env_set(env, sym, ret) + types_addref(ret) + env_release(env) + return ret +} + +function EVAL_try(ast, env, catch_body, catch_env, idx, catch, catch_idx, catch_sym, ret, len, str) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 2 && len != 3) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'try*'. Expects 1 or 2 arguments, supplied" (len - 1) "." + } + if (len == 2) { + ret = EVAL(types_addref(types_heap[idx][1]), env) + types_release(ast) + env_release(env) + return ret + } + catch = types_heap[idx][2] + if (catch !~ /^\(/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 2 of 'try*'. Expects list, supplied " types_typename(catch) "." + } + catch_idx = substr(catch, 2) + if (types_heap[catch_idx]["len"] != 3) { + len = types_heap[catch_idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 2 of 'try*'. Expects exactly 3 elements, supplied " len "." + } + if (types_heap[catch_idx][0] != "'catch*") { + str = printer_pr_str(types_heap[catch_idx][0]) + types_release(ast) + env_release(env) + return "!\"Invalid first element of argument 2 of 'try*'. Expects symbol 'catch*', supplied '" str "'." + } + catch_sym = types_heap[catch_idx][1] + if (catch_sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for second element of argument 2 of 'try*'. Expects symbol, supplied " types_typename(catch_sym) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret !~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_addref(catch_body[0] = types_heap[catch_idx][2]) + catch_env[0] = env_new(env) + env_release(env) + env_set(catch_env[0], catch_sym, substr(ret, 2)) + types_release(ast) + return "" +} + +function EVAL_do(ast, env, idx, len, i, body, ret) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 1) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." + } + for (i = 1; i < len - 1; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + } + types_addref(body = types_heap[idx][len - 1]) + types_release(ast) + return body +} + +function EVAL_if(ast, env, idx, len, ret, body) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 3 && len != 4) { + types_release(ast) + return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + types_release(ret) + switch (ret) { + case "#nil": + case "#false": + if (len == 3) { + body = "#nil" + } else { + types_addref(body = types_heap[idx][3]) + } + break + default: + types_addref(body = types_heap[idx][2]) + break + } + types_release(ast) + return body +} + +function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + for (i = 0; i < params_len; ++i) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." + } + if (sym == "'&" && i + 2 != params_len) { + types_release(ast) + env_release(env) + return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." + } + } + f_idx = types_allocate() + types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) + types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) + types_heap[f_idx]["env"] = env + types_release(ast) + return "$" f_idx +} + +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) +{ + env_addref(env) + for (;;) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + ast = EVAL_let(ast, env, ret_env) + if (ast ~ /^!/) { + return ast + } + env = ret_env[0] + continue + case "'quote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + env_release(env) + return body + case "'quasiquote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + ast = quasiquote(body) + if (ast ~ /^!/) { + env_release(env) + return ast + } + continue + case "'defmacro!": + return EVAL_defmacro(ast, env) + case "'try*": + ret = EVAL_try(ast, env, ret_body, ret_env) + if (ret != "") { + return ret + } + ast = ret_body[0] + env = ret_env[0] + continue + case "'do": + ast = EVAL_do(ast, env) + if (ast ~ /^!/) { + return ast + } + continue + case "'if": + ast = EVAL_if(ast, env) + if (ast !~ /^['([{]/) { + env_release(env) + return ast + } + continue + case "'fn*": + return EVAL_fn(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + if (types_heap[f_idx]["is_macro"]) { + idx = substr(ast, 2) + ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + types_release(ast) + if (ret ~ /^!/) { + types_release(f) + types_release(env) + return ret + } + ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) + types_release(ret) + types_release(f) + continue + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + if (env ~ /^!/) { + types_release(new_ast) + return env + } + types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) + types_release(new_ast) + continue + case /^&/: + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret + } + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function eval(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return EVAL(types_addref(types_heap[idx][1]), repl_env) +} + +function main(str, ret, i, idx) +{ + repl_env = env_new() + for (i in core_ns) { + env_set(repl_env, i, core_ns[i]) + } + + env_set(repl_env, "'eval", "&eval") + + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + idx = types_allocate() + env_set(repl_env, "'*ARGV*", "(" idx) + if (ARGC > 1) { + for (i = 2; i < ARGC; ++i) { + types_heap[idx][i - 2] = "\"" ARGV[i] + } + types_heap[idx]["len"] = ARGC - 2 + ARGC = 1 + rep("(load-file \"" ARGV[1] "\")") + return + } + types_heap[idx]["len"] = 0 + + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/stepA_mal.awk b/impls/awk/stepA_mal.awk new file mode 100644 index 0000000000..de455ddaf4 --- /dev/null +++ b/impls/awk/stepA_mal.awk @@ -0,0 +1,637 @@ +@include "types.awk" +@include "reader.awk" +@include "printer.awk" +@include "env.awk" +@include "core.awk" + +function READ(str) +{ + return reader_read_str(str) +} + +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) +{ + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] +} + +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) +{ + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { + new_idx = types_allocate() + types_heap[new_idx][0] = "'quote" + types_heap[new_idx][1] = ast + types_heap[new_idx]["len"] = 2 + return "(" new_idx + } + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { + types_release(ast) + return ret + } + if (ret) { + types_addref(ret) + types_release(ast) + return ret + } + new_idx = types_allocate() + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) + return "(" new_idx +} + +function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_heap[new_idx]["len"] = i + types_release(substr(ast, 1, 1) new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + types_heap[new_idx]["len"] = len + return substr(ast, 1, 1) new_idx +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ + idx = substr(ast, 2) + new_idx = types_allocate() + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release("{" new_idx) + return ret + } + types_heap[new_idx][i] = ret + } + } + return "{" new_idx +} + +function EVAL_def(ast, env, idx, sym, ret, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + if (ret !~ /^!/) { + env_set(env, sym, ret) + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret +} + +function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + if (params_len % 2 != 0) { + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." + } + new_env = env_new(env) + env_release(env) + for (i = 0; i < params_len; i += 2) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(new_env) + return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) + if (ret ~ /^!/) { + types_release(ast) + env_release(new_env) + return ret + } + env_set(new_env, sym, ret) + } + types_addref(body = types_heap[idx][2]) + types_release(ast) + ret_env[0] = new_env + return body +} + +function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'defmacro!'. Expects exactly 2 arguments, supplied" (len - 1) "." + } + sym = types_heap[idx][1] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'defmacro!'. Expects symbol, supplied " types_typename(sym) "." + } + ret = EVAL(types_addref(types_heap[idx][2]), env) + types_release(ast) + if (ret ~ /^!/) { + env_release(env) + return ret + } + if (ret !~ /^\$/) { + types_release(ret) + env_release(env) + return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." + } + + # Replace `ret` with a clone setting the `is_macro` bit. + fun_idx = substr(ret, 2) + mac_idx = types_allocate() + types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"]) + types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"]) + env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"]) + types_heap[mac_idx]["is_macro"] = 1 + types_release(ret) + ret = "$" mac_idx + + env_set(env, sym, ret) + types_addref(ret) + env_release(env) + return ret +} + +function EVAL_try(ast, env, catch_body, catch_env, idx, catch, catch_idx, catch_sym, ret, len, str) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 2 && len != 3) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'try*'. Expects 1 or 2 arguments, supplied" (len - 1) "." + } + if (len == 2) { + ret = EVAL(types_addref(types_heap[idx][1]), env) + types_release(ast) + env_release(env) + return ret + } + catch = types_heap[idx][2] + if (catch !~ /^\(/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 2 of 'try*'. Expects list, supplied " types_typename(catch) "." + } + catch_idx = substr(catch, 2) + if (types_heap[catch_idx]["len"] != 3) { + len = types_heap[catch_idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid elements count for argument 2 of 'try*'. Expects exactly 3 elements, supplied " len "." + } + if (types_heap[catch_idx][0] != "'catch*") { + str = printer_pr_str(types_heap[catch_idx][0]) + types_release(ast) + env_release(env) + return "!\"Invalid first element of argument 2 of 'try*'. Expects symbol 'catch*', supplied '" str "'." + } + catch_sym = types_heap[catch_idx][1] + if (catch_sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for second element of argument 2 of 'try*'. Expects symbol, supplied " types_typename(catch_sym) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret !~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_addref(catch_body[0] = types_heap[catch_idx][2]) + catch_env[0] = env_new(env) + env_release(env) + env_set(catch_env[0], catch_sym, substr(ret, 2)) + types_release(ast) + return "" +} + +function EVAL_do(ast, env, idx, len, i, body, ret) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 1) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." + } + for (i = 1; i < len - 1; ++i) { + ret = EVAL(types_addref(types_heap[idx][i]), env) + if (ret ~ /^!/) { + types_release(ast) + env_release(env) + return ret + } + types_release(ret) + } + types_addref(body = types_heap[idx][len - 1]) + types_release(ast) + return body +} + +function EVAL_if(ast, env, idx, len, ret, body) +{ + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len != 3 && len != 4) { + types_release(ast) + return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." + } + ret = EVAL(types_addref(types_heap[idx][1]), env) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + types_release(ret) + switch (ret) { + case "#nil": + case "#false": + if (len == 3) { + body = "#nil" + } else { + types_addref(body = types_heap[idx][3]) + } + break + default: + types_addref(body = types_heap[idx][2]) + break + } + types_release(ast) + return body +} + +function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) +{ + idx = substr(ast, 2) + if (types_heap[idx]["len"] != 3) { + len = types_heap[idx]["len"] + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." + } + params = types_heap[idx][1] + if (params !~ /^[([]/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." + } + params_idx = substr(params, 2) + params_len = types_heap[params_idx]["len"] + for (i = 0; i < params_len; ++i) { + sym = types_heap[params_idx][i] + if (sym !~ /^'/) { + types_release(ast) + env_release(env) + return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." + } + if (sym == "'&" && i + 2 != params_len) { + types_release(ast) + env_release(env) + return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." + } + } + f_idx = types_allocate() + types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) + types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) + types_heap[f_idx]["env"] = env + types_release(ast) + return "$" f_idx +} + +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) +{ + env_addref(env) + for (;;) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + case /^\[/: # vector + ret = eval_ast(ast, env) + types_release(ast) + env_release(env) + return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast + } + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } + switch (types_heap[idx][0]) { + case "'def!": + return EVAL_def(ast, env) + case "'let*": + ast = EVAL_let(ast, env, ret_env) + if (ast ~ /^!/) { + return ast + } + env = ret_env[0] + continue + case "'quote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + env_release(env) + return body + case "'quasiquote": + if (len != 2) { + types_release(ast) + env_release(env) + return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + ast = quasiquote(body) + if (ast ~ /^!/) { + env_release(env) + return ast + } + continue + case "'defmacro!": + return EVAL_defmacro(ast, env) + case "'try*": + ret = EVAL_try(ast, env, ret_body, ret_env) + if (ret != "") { + return ret + } + ast = ret_body[0] + env = ret_env[0] + continue + case "'do": + ast = EVAL_do(ast, env) + if (ast ~ /^!/) { + return ast + } + continue + case "'if": + ast = EVAL_if(ast, env) + if (ast !~ /^['([{]/) { + env_release(env) + return ast + } + continue + case "'fn*": + return EVAL_fn(ast, env) + default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } + f_idx = substr(f, 2) + switch (f) { + case /^\$/: + if (types_heap[f_idx]["is_macro"]) { + idx = substr(ast, 2) + ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + types_release(ast) + if (ret ~ /^!/) { + types_release(f) + types_release(env) + return ret + } + ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) + types_release(ret) + types_release(f) + continue + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + if (env ~ /^!/) { + types_release(new_ast) + return env + } + types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) + types_release(new_ast) + continue + case /^%/: + f_idx = types_heap[f_idx]["func"] + types_release(f) + case /^&/: + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) + ret = @f_idx(idx) + types_release(new_ast) + return ret + default: + types_release(new_ast) + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret + } + } + } +} + +function PRINT(expr, str) +{ + str = printer_pr_str(expr, 1) + types_release(expr) + return str +} + +function rep(str, ast, expr) +{ + ast = READ(str) + if (ast ~ /^!/) { + return ast + } + expr = EVAL(ast, repl_env) + if (expr ~ /^!/) { + return expr + } + return PRINT(expr) +} + +function eval(idx) +{ + if (types_heap[idx]["len"] != 2) { + return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." + } + return EVAL(types_addref(types_heap[idx][1]), repl_env) +} + +function main(str, ret, i, idx) +{ + repl_env = env_new() + for (i in core_ns) { + env_set(repl_env, i, core_ns[i]) + } + + env_set(repl_env, "'eval", "&eval") + + rep("(def! *host-language* \"GNU awk\")") + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + idx = types_allocate() + env_set(repl_env, "'*ARGV*", "(" idx) + if (ARGC > 1) { + for (i = 2; i < ARGC; ++i) { + types_heap[idx][i - 2] = "\"" ARGV[i] + } + types_heap[idx]["len"] = ARGC - 2 + ARGC = 1 + rep("(load-file \"" ARGV[1] "\")") + return + } + types_heap[idx]["len"] = 0 + + rep("(println (str \"Mal [\" *host-language* \"]\"))") + while (1) { + printf("user> ") + if (getline str <= 0) { + break + } + ret = rep(str) + if (ret ~ /^!/) { + print "ERROR: " printer_pr_str(substr(ret, 2)) + } else { + print ret + } + } +} + +BEGIN { + main() + env_check(0) + #env_dump() + #types_dump() + exit(0) +} diff --git a/impls/awk/tests/step5_tco.mal b/impls/awk/tests/step5_tco.mal new file mode 100644 index 0000000000..b0bfbe0470 --- /dev/null +++ b/impls/awk/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; awk: skipping non-TCO recursion +;; Reason: completes up to 50,000 diff --git a/impls/awk/types.awk b/impls/awk/types.awk new file mode 100644 index 0000000000..68410ce499 --- /dev/null +++ b/impls/awk/types.awk @@ -0,0 +1,218 @@ + +# string" +# symbol ' +# keyword : +# number + +# nil # +# true # +# false # +# list ( +# vector [ +# hash { +# atom ? +# builtin function & +# builtin function with meta % +# user defined function $ + +function types_allocate() +{ + types_heap[types_heap_index]["ref"] = 1 + return types_heap_index++ +} + +function types_addref(ast) +{ + if (ast ~ /^[([{$%?]/) { + ++types_heap[substr(ast, 2)]["ref"] + } + return ast +} + +function types_release(ast, idx, ref, i, len) +{ + switch (ast) { + case /^[([]/: + idx = substr(ast, 2) + ref = --types_heap[idx]["ref"] + if (ref <= 0) { + if (ref < 0) { + print "ref count error:" ast ", " ref + } + len = types_heap[idx]["len"] + for (i = 0; i < len; ++i) { + types_release(types_heap[idx][i]) + } + types_release(types_heap[idx]["meta"]) + delete types_heap[idx] + } + return + case /^\{/: + idx = substr(ast, 2) + ref = --types_heap[idx]["ref"] + if (ref <= 0) { + if (ref < 0) { + print "ref count error:" ast ", " ref + } + for (i in types_heap[idx]) { + if (i ~ /^[":]/) { + types_release(types_heap[idx][i]) + } + } + types_release(types_heap[idx]["meta"]) + delete types_heap[idx] + } + return + case /^\$/: + idx = substr(ast, 2) + ref = --types_heap[idx]["ref"] + if (ref <= 0) { + if (ref < 0) { + print "ref count error:" ast ", " ref + } + types_release(types_heap[idx]["params"]) + types_release(types_heap[idx]["body"]) + types_release(types_heap[idx]["meta"]) + env_release(types_heap[idx]["env"]) + delete types_heap[idx] + } + return + case /^%/: + idx = substr(ast, 2) + ref = --types_heap[idx]["ref"] + if (ref <= 0) { + if (ref < 0) { + print "ref count error:" ast ", " ref + } + types_release(types_heap[idx]["meta"]) + delete types_heap[idx] + } + return + case /^\?/: + idx = substr(ast, 2) + ref = --types_heap[idx]["ref"] + if (ref <= 0) { + if (ref < 0) { + print "ref count error:" ast ", " ref + } + types_release(types_heap[idx]["obj"]) + delete types_heap[idx] + } + } +} + +function types_check(val, idx, len, i) +{ + if (val !~ /^[([{?%$]/) { + return + } + idx = substr(val, 2) + if (!(idx in types_heap)) { + print "dangling reference " val + return + } + if (types_heap[idx]["checked"]++) { + return + } + #types_heap[idx]["checked"] = 1 + switch (val) { + case /^[([]/: + if (!("len" in types_heap[idx])) { + print "length not found in " val + return + } + len = types_heap[idx]["len"] + for (i = 0; i < len; ++i) { + if (!(i in types_heap[idx])) { + print "sequence corrupted in " val " of " i + } else { + types_check(types_heap[idx][i]) + } + } + types_check(types_heap[idx]["meta"]) + return + case /^\{/: + for (i in types_heap[idx]) { + if (i != "ref") { + types_check(types_heap[idx][i]) + } + } + return + case /^\?/: + if (!("obj" in types_heap[idx])) { + print "atom corrupted in " val + } else { + types_check(types_heap[idx]["obj"]) + } + types_check(types_heap[idx]["meta"]) + return + case /^%/: + if (!("func" in types_heap[idx])) { + print "function corrupted in " val + } else { + types_check(types_heap[idx]["func"]) + } + types_check(types_heap[idx]["meta"]) + return + case /^\$/: + if (!("body" in types_heap[idx])) { + print "function body corrupted in " val + } else { + types_check(types_heap[idx]["body"]) + } + if (!("params" in types_heap[idx])) { + print "function params corrupted in " val + } else { + types_check(types_heap[idx]["params"]) + } + if (!("env" in types_heap[idx])) { + print "function env corrupted in " val + } else { + env_check(types_heap[idx]["env"]) + } + types_check(types_heap[idx]["meta"]) + return + default: + print "unknown type " val + return + } +} + +function types_dump(i, j) +{ + for (i = 0; i < types_heap_index; i++) { + if (i in types_heap) { + if (isarray(types_heap[i])) { + if (!("checked" in types_heap[i]) || types_heap[i]["checked"] != types_heap[i]["ref"]) { + for (j in types_heap[i]) { + print " types_heap[" i "][" j "] = " types_heap[i][j] + } + } + } else { + print " types_heap[" i "] = " types_heap[i] + } + } + } +} + +function types_typename(str) +{ + switch (str) { + case /^"/: return "string" + case /^'/: return "symbol" + case /^:/: return "keyword" + case /^\+/: return "number" + case /^#nil$/: return "nil" + case /^#true$/: return "true" + case /^#false$/: return "false" + case /^\(/: return "list" + case /^\[/: return "vector" + case /^\{/: return "hash" + case /^\?/: return "atom" + case /^[&%]/: return "builtin function" + case /^\$/: return "user defined function" + } +} + +BEGIN { + types_heap_index = 0 +} diff --git a/impls/bash/Dockerfile b/impls/bash/Dockerfile new file mode 100644 index 0000000000..db4ba29f1c --- /dev/null +++ b/impls/bash/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Nothing additional needed for bash diff --git a/impls/bash/Makefile b/impls/bash/Makefile new file mode 100644 index 0000000000..0f7bc0396a --- /dev/null +++ b/impls/bash/Makefile @@ -0,0 +1,19 @@ +SOURCES_BASE = types.sh reader.sh printer.sh +SOURCES_LISP = env.sh core.sh stepA_mal.sh +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.sh mal + +mal.sh: $(SOURCES) + cat $+ | grep -v "^source " > $@ + +mal: mal.sh + echo "#!/usr/bin/env bash" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.sh mal diff --git a/bash/core.sh b/impls/bash/core.sh similarity index 83% rename from bash/core.sh rename to impls/bash/core.sh index ca53c43478..28119cc7ab 100644 --- a/bash/core.sh +++ b/impls/bash/core.sh @@ -38,11 +38,15 @@ false? () { _false? "${1}" && r="${__true}" || r="${__false}"; } # Symbol functions +symbol () { _symbol "${ANON["${1}"]}"; } + symbol? () { _symbol? "${1}" && r="${__true}" || r="${__false}"; } # Keyword functions +keyword () { _keyword "${ANON["${1}"]}"; } + keyword? () { _keyword? "${1}" && r="${__true}" || r="${__false}"; } @@ -70,7 +74,7 @@ time_ms () { # String functions -string? () { _string? "${1}" && r="${__true}" || r="${__false}"; } +string? () { _string? "${1}" && ( ! _keyword? "${1}" ) && r="${__true}" || r="${__false}"; } pr_str () { local res="" @@ -88,15 +92,14 @@ prn () { local res="" for x in "${@}"; do _pr_str "${x}" yes; res="${res} ${r}"; done echo "${res:1}" - r="${__nil}"; + r="${__nil}"; } println () { local res="" for x in "${@}"; do _pr_str "${x}"; res="${res} ${r}"; done - res="${res//\\n/$'\n'}" - echo -e "${res:1}" - r="${__nil}"; + echo "${res:1}" + r="${__nil}"; } readline () { @@ -116,7 +119,8 @@ slurp () { # Function functions -function? () { _function? "${1}" && r="${__true}" || r="${__false}"; } +function? () { _function? "${1}" && [ -z "${ANON["${1}_ismacro_"]}" ] && r="${__true}" || r="${__false}"; } +macro? () { _function? "${1}" && [ "${ANON["${1}_ismacro_"]}" ] && r="${__true}" || r="${__false}"; } # List functions @@ -248,6 +252,20 @@ count () { _number "${r}" } +apply () { + local f="${ANON["${1}"]}"; shift + local items="${@:1:$(( ${#@} -1 ))} ${ANON["${!#}"]}" + eval ${f%%@*} ${items} +} + +# Takes a function object and an list object and invokes the function +# on each element of the list, returning a new list of the results. +map () { + local f="${ANON["${1}"]}"; shift + #echo _map "${f}" "${@}" + _map "${f}" "${@}" +} + conj () { local obj="${1}"; shift local obj_data="${ANON["${obj}"]}" @@ -263,18 +281,35 @@ conj () { fi } -apply () { - local f="${ANON["${1}"]}"; shift - local items="${@:1:$(( ${#@} -1 ))} ${ANON["${!#}"]}" - eval ${f%%@*} ${items} -} +seq () { + local obj="${1}"; shift + local obj_data="${ANON["${obj}"]}" -# Takes a function object and an list object and invokes the function -# on each element of the list, returning a new list of the results. -map () { - local f="${ANON["${1}"]}"; shift - #echo _map "${f}" "${@}" - _map "${f}" "${@}" + + if _list? "${obj}"; then + _count "${obj}" + if [ "${r}" -eq 0 ]; then r="${__nil}"; return; fi + r="${obj}" + elif _vector? "${obj}"; then + _count "${obj}" + if [ "${r}" -eq 0 ]; then r="${__nil}"; return; fi + __new_obj_hash_code + r="list_${r}" + ANON["${r}"]="${obj_data}" + elif _string? "${obj}"; then + if [ "${#obj_data}" -eq 0 ]; then r="${__nil}"; return; fi + local i=0 acc="" + for (( i=0; i < ${#obj_data}; i++ )); do + _string "${obj_data:$i:1}" + acc="${acc} ${r}" + done + _list + ANON["${r}"]="${acc:1}" + elif _nil? "${obj}"; then + r="${__nil}" + else + throw "seq: called on non-sequence" + fi } @@ -325,10 +360,14 @@ declare -A core_ns=( [nil?]=nil? [true?]=true? [false?]=false? - [symbol]=_symbol + [string?]=string? + [symbol]=symbol [symbol?]=symbol? - [keyword]=_keyword + [keyword]=keyword [keyword?]=keyword? + [number?]=number? + [fn?]=function? + [macro?]=macro? [pr-str]=pr_str [str]=str @@ -337,10 +376,10 @@ declare -A core_ns=( [readline]=readline [read-string]=read_string [slurp]=slurp - [<]=num_lt - [<=]=num_lte - [>]=num_gt - [>=]=num_gte + ['<']=num_lt + ['<=']=num_lte + ['>']=num_gt + ['>=']=num_gte [+]=num_plus [-]=num_minus [__STAR__]=num_multiply @@ -363,15 +402,18 @@ declare -A core_ns=( [sequential?]=sequential? [cons]=cons [concat]=concat + [vec]=vec [nth]=nth [first]=_first [rest]=_rest [empty?]=empty? [count]=count - [conj]=conj [apply]=apply [map]=map + [conj]=conj + [seq]=seq + [with-meta]=with_meta [meta]=meta [atom]=_atom diff --git a/bash/env.sh b/impls/bash/env.sh similarity index 95% rename from bash/env.sh rename to impls/bash/env.sh index 9595aa25fa..d7646909eb 100644 --- a/bash/env.sh +++ b/impls/bash/env.sh @@ -48,7 +48,7 @@ ENV_FIND () { r="${1}" else local obj="${ANON["${1}"]}" - eval local outer="\${${obj}["__outer__"]}" + eval 'local outer=${'${obj}'["__outer__"]}' if [[ "${outer}" && "${outer}" != "${__nil}" ]]; then ENV_FIND "${outer}" "${2}" else @@ -66,7 +66,7 @@ ENV_GET () { local key="${ANON["${2}"]}" if [[ "${r}" ]]; then local obj="${ANON["${env}"]}" - eval r="\${${obj}["${key}"]}" + eval 'r=${'${obj}'["'${key}'"]}' else _error "'${key}' not found" fi diff --git a/bash/printer.sh b/impls/bash/printer.sh similarity index 94% rename from bash/printer.sh rename to impls/bash/printer.sh index 0d2302821f..125b568e81 100644 --- a/bash/printer.sh +++ b/impls/bash/printer.sh @@ -38,9 +38,12 @@ _raw_string_pr_str () { local print_readably="${2}" if [[ "${s:0:1}" = "${__keyw}" ]]; then r=":${s:1}" + elif [[ "${s:0:2}" = "${__keyw}" ]]; then + r=":${s:2}" elif [ "${print_readably}" == "yes" ]; then s="${s//\\/\\\\}" - r="\"${s//\"/\\\"}\"" + s="${s//\"/\\\"}" + r="\"${s//$'\n'/\\n}\"" else r="${s}" fi diff --git a/bash/reader.sh b/impls/bash/reader.sh similarity index 81% rename from bash/reader.sh rename to impls/bash/reader.sh index a00e7a1bff..6e1ed362c0 100644 --- a/bash/reader.sh +++ b/impls/bash/reader.sh @@ -11,9 +11,17 @@ READ_ATOM () { local token=${__reader_tokens[${__reader_idx}]} __reader_idx=$(( __reader_idx + 1 )) case "${token}" in - [0-9]*) _number "${token}" ;; - \"*) token="${token:1:-1}" + [0-9]*) _number "${token}" ;; + -[0-9]*) _number "${token}" ;; + \"*) if [[ ! "${token}" =~ ^\"(\\.|[^\\\"])*\"$ ]]; then + _error "expected '\"', got EOF" + return + fi + token="${token:1:-1}" + token="${token//\\\\/${__keyw}}" token="${token//\\\"/\"}" + token="${token//\\n/$'\n'}" + token="${token//${__keyw}/\\}" _string "${token}" ;; :*) _keyword "${token:1}" ;; nil) r="${__nil}" ;; @@ -42,7 +50,7 @@ READ_SEQ () { while [[ "${token}" != "${end}" ]]; do if [[ ! "${token}" ]]; then r= - _error "exepected '${end}', got EOF" + _error "expected '${end}', got EOF" return fi READ_FORM @@ -95,6 +103,8 @@ READ_FORM () { esac } +TOKEN_PAT=$'^^([][{}\\(\\)^@])|^(~@)|^("(\\\\.|[^\\"])*"?)|^(;[^\n]*)|^([~\'`])|^([^][ ~`\'";{}\\(\\)^@,\n]+)|^(,)|^([[:space:]]+)' + # Returns __reader_tokens as an indexed array of tokens TOKENIZE () { local data="${*}" @@ -102,28 +112,27 @@ TOKENIZE () { local idx=0 local chunk=0 local chunksz=500 - local match= local token= local str= __reader_idx=0 - __reader_tokens= + declare -a -g __reader_tokens=() # global array while true; do if (( ${#str} < ( chunksz / 2) )) && (( chunk < datalen )); then str="${str}${data:${chunk}:${chunksz}}" chunk=$(( chunk + ${chunksz} )) fi (( ${#str} == 0 )) && break - [[ "${str}" =~ ^^([][{}\(\)^@])|^(~@)|(\"(\\.|[^\\\"])*\")|^(;[^$'\n']*)|^([~\'\`])|^([^][ ~\`\'\";{}\(\)^@\,]+)|^[,]|^[[:space:]]+ ]] - match=${BASH_REMATCH[0]} - str="${str:${#match}}" - token="${match//$'\n'/}" + [[ "${str}" =~ ${TOKEN_PAT} ]] + token=${BASH_REMATCH[0]} + str="${str:${#token}}" + token="${token}" #echo "MATCH: '${token}' / [${str}]" if ! [[ "${token}" =~ (^[,]$|^[[:space:]]*;.*$|^[[:space:]]*$) ]]; then __reader_tokens[${idx}]="${token}" idx=$(( idx + 1 )) fi - if [ -z "${match}" ]; then + if [ -z "${token}" ]; then _error "Tokenizing error at: ${str:0:50}" return 1 fi @@ -149,10 +158,10 @@ READ_STR () { READLINE_EOF= READLINE_HISTORY_FILE=${HOME}/.mal-history READLINE () { - history -r "${READLINE_HISTORY_FILE}" + history -r "${READLINE_HISTORY_FILE}" 2>/dev/null || true read -r -e -p "${1}" r || return "$?" history -s -- "${r}" - history -a "${READLINE_HISTORY_FILE}" + history -a "${READLINE_HISTORY_FILE}" 2>/dev/null || true } fi diff --git a/impls/bash/run b/impls/bash/run new file mode 100755 index 0000000000..05081b9ce6 --- /dev/null +++ b/impls/bash/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec bash $(dirname $0)/${STEP:-stepA_mal}.sh "${@}" diff --git a/bash/step0_repl.sh b/impls/bash/step0_repl.sh similarity index 88% rename from bash/step0_repl.sh rename to impls/bash/step0_repl.sh index 8e1fff08e2..97bce61d17 100755 --- a/bash/step0_repl.sh +++ b/impls/bash/step0_repl.sh @@ -5,8 +5,7 @@ READ () { } EVAL () { - r= - eval "${1}" + r="${1}" } PRINT () { diff --git a/bash/step1_read_print.sh b/impls/bash/step1_read_print.sh similarity index 94% rename from bash/step1_read_print.sh rename to impls/bash/step1_read_print.sh index 881c0c3ee7..8011fa6b86 100755 --- a/bash/step1_read_print.sh +++ b/impls/bash/step1_read_print.sh @@ -21,7 +21,7 @@ EVAL () { # print PRINT () { if [[ "${__ERROR}" ]]; then - _pr_str "${__ERROR}" yes + _pr_str "${__ERROR}" no r="Error: ${r}" __ERROR= else diff --git a/bash/step2_eval.sh b/impls/bash/step2_eval.sh similarity index 75% rename from bash/step2_eval.sh rename to impls/bash/step2_eval.sh index 54c645b4d1..54d75885c3 100755 --- a/bash/step2_eval.sh +++ b/impls/bash/step2_eval.sh @@ -10,7 +10,7 @@ READ () { } # eval -EVAL_AST () { +EVAL () { local ast="${1}" env="${2}" #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" _obj_type "${ast}"; local ot="${r}" @@ -18,13 +18,15 @@ EVAL_AST () { symbol) local val="${ANON["${ast}"]}" eval r="\${${env}["${val}"]}" - [ "${r}" ] || _error "'${val}' not found" ;; + [ "${r}" ] || _error "'${val}' not found" + return ;; list) - _map_with_type _list EVAL "${ast}" "${env}" ;; + ;; vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) - local res="" val="" hm="${ANON["${ast}"]}" + local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do @@ -32,25 +34,17 @@ EVAL_AST () { EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done - r="${new_hm}" ;; + r="${new_hm}" + return ;; *) - r="${ast}" ;; + r="${ast}" + return ;; esac -} - -EVAL () { - local ast="${1}" env="${2}" - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list - EVAL_AST "${ast}" "${env}" + _empty? "${ast}" && r="${ast}" && return + + _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && return 1 local el="${r}" _first "${el}"; local f="${r}" diff --git a/bash/step3_env.sh b/impls/bash/step3_env.sh similarity index 80% rename from bash/step3_env.sh rename to impls/bash/step3_env.sh index f00a6cdfa7..ba46e54306 100755 --- a/bash/step3_env.sh +++ b/impls/bash/step3_env.sh @@ -11,20 +11,30 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) - _map_with_type _list EVAL "${ast}" "${env}" ;; + ;; vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) - local res="" val="" hm="${ANON["${ast}"]}" + local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do @@ -32,24 +42,16 @@ EVAL_AST () { EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done - r="${new_hm}" ;; + r="${new_hm}" + return ;; *) - r="${ast}" ;; + r="${ast}" + return ;; esac -} - -EVAL () { - local ast="${1}" env="${2}" - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list + _empty? "${ast}" && r="${ast}" && return + _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -58,7 +60,7 @@ EVAL () { [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; - let*) ENV "${env}"; local let_env="${r}" + let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" @@ -69,7 +71,7 @@ EVAL () { done EVAL "${a2}" "${let_env}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${r}" diff --git a/bash/step4_if_fn_do.sh b/impls/bash/step4_if_fn_do.sh similarity index 81% rename from bash/step4_if_fn_do.sh rename to impls/bash/step4_if_fn_do.sh index fdd8ded3d8..24b45965fd 100755 --- a/bash/step4_if_fn_do.sh +++ b/impls/bash/step4_if_fn_do.sh @@ -12,20 +12,30 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) - _map_with_type _list EVAL "${ast}" "${env}" ;; + ;; vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) - local res="" val="" hm="${ANON["${ast}"]}" + local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do @@ -33,24 +43,16 @@ EVAL_AST () { EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done - r="${new_hm}" ;; + r="${new_hm}" + return ;; *) - r="${ast}" ;; + r="${ast}" + return ;; esac -} - -EVAL () { - local ast="${1}" env="${2}" - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list + _empty? "${ast}" && r="${ast}" && return + _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -59,7 +61,7 @@ EVAL () { [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; - let*) ENV "${env}"; local let_env="${r}" + let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" @@ -71,7 +73,7 @@ EVAL () { EVAL "${a2}" "${let_env}" return ;; do) _rest "${ast}" - EVAL_AST "${r}" "${env}" + _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${r}" return ;; @@ -90,10 +92,10 @@ EVAL () { EVAL "${a2}" "${env}" fi return ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" return ;; - *) EVAL_AST "${ast}" "${env}" + *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${ANON["${r}"]}" diff --git a/bash/step5_tco.sh b/impls/bash/step5_tco.sh similarity index 83% rename from bash/step5_tco.sh rename to impls/bash/step5_tco.sh index cee2763302..5e30751000 100755 --- a/bash/step5_tco.sh +++ b/impls/bash/step5_tco.sh @@ -12,20 +12,32 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) - _map_with_type _list EVAL "${ast}" "${env}" ;; + ;; vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) - local res="" val="" hm="${ANON["${ast}"]}" + local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do @@ -33,25 +45,16 @@ EVAL_AST () { EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done - r="${new_hm}" ;; + r="${new_hm}" + return ;; *) - r="${ast}" ;; + r="${ast}" + return ;; esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list + _empty? "${ast}" && r="${ast}" && return + _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -60,7 +63,7 @@ EVAL () { [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; - let*) ENV "${env}"; local let_env="${r}" + let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" @@ -75,7 +78,7 @@ EVAL () { ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" + _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" @@ -98,11 +101,11 @@ EVAL () { fi # Continue loop ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${ANON["${r}"]}" diff --git a/bash/step6_file.sh b/impls/bash/step6_file.sh similarity index 84% rename from bash/step6_file.sh rename to impls/bash/step6_file.sh index e8c3bcec5d..b87cbc1986 100755 --- a/bash/step6_file.sh +++ b/impls/bash/step6_file.sh @@ -12,20 +12,32 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) - _map_with_type _list EVAL "${ast}" "${env}" ;; + ;; vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) - local res="" val="" hm="${ANON["${ast}"]}" + local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do @@ -33,25 +45,16 @@ EVAL_AST () { EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done - r="${new_hm}" ;; + r="${new_hm}" + return ;; *) - r="${ast}" ;; + r="${ast}" + return ;; esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list + _empty? "${ast}" && r="${ast}" && return + _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" @@ -60,7 +63,7 @@ EVAL () { [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; - let*) ENV "${env}"; local let_env="${r}" + let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" @@ -75,7 +78,7 @@ EVAL () { ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" + _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" @@ -98,11 +101,11 @@ EVAL () { fi # Continue loop ;; - fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${ANON["${r}"]}" @@ -159,7 +162,7 @@ ENV_SET "${REPL_ENV}" "${r}" "${argv}"; # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" -REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" # load/run file from command line (then exit) if [[ "${1}" ]]; then diff --git a/impls/bash/step7_quote.sh b/impls/bash/step7_quote.sh new file mode 100755 index 0000000000..dc046f9fc2 --- /dev/null +++ b/impls/bash/step7_quote.sh @@ -0,0 +1,228 @@ +#!/usr/bin/env bash + +source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/env.sh +source $(dirname $0)/core.sh + +# read +READ () { + [ "${1}" ] && r="${1}" || READLINE + READ_STR "${r}" +} + +# eval +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] +} + +QUASIQUOTE () { + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list + else + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" + fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" + fi +} + +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { + local ast="${1}" env="${2}" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + + _obj_type "${ast}"; local ot="${r}" + case "${ot}" in + symbol) + ENV_GET "${env}" "${ast}" + return ;; + list) + ;; + vector) + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; + hash_map) + local res="" key= val="" hm="${ANON["${ast}"]}" + _hash_map; local new_hm="${r}" + eval local keys="\${!${hm}[@]}" + for key in ${keys}; do + eval val="\${${hm}[\"${key}\"]}" + EVAL "${val}" "${env}" + _assoc! "${new_hm}" "${key}" "${r}" + done + r="${new_hm}" + return ;; + *) + r="${ast}" + return ;; + esac + + # apply list + _empty? "${ast}" && r="${ast}" && return + + _nth "${ast}" 0; local a0="${r}" + _nth "${ast}" 1; local a1="${r}" + _nth "${ast}" 2; local a2="${r}" + case "${ANON["${a0}"]}" in + def!) EVAL "${a2}" "${env}" + [[ "${__ERROR}" ]] && return 1 + ENV_SET "${env}" "${a1}" "${r}" + return ;; + let__STAR__) ENV "${env}"; local let_env="${r}" + local let_pairs=(${ANON["${a1}"]}) + local idx=0 + #echo "let: [${let_pairs[*]}] for ${a2}" + while [[ "${let_pairs["${idx}"]}" ]]; do + EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" + ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" + idx=$(( idx + 2)) + done + ast="${a2}" + env="${let_env}" + # Continue loop + ;; + quote) + r="${a1}" + return ;; + quasiquote) + QUASIQUOTE "${a1}" + ast="${r}" + # Continue loop + ;; + do) _count "${ast}" + _slice "${ast}" 1 $(( ${r} - 2 )) + _map_with_type _list EVAL "${r}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + _last "${ast}" + ast="${r}" + # Continue loop + ;; + if) EVAL "${a1}" "${env}" + [[ "${__ERROR}" ]] && return 1 + if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then + # eval false form + _nth "${ast}" 3; local a3="${r}" + if [[ "${a3}" ]]; then + ast="${a3}" + else + r="${__nil}" + return + fi + else + # eval true condition + ast="${a2}" + fi + # Continue loop + ;; + fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" + return ;; + *) _map_with_type _list EVAL "${ast}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + local el="${r}" + _first "${el}"; local f="${ANON["${r}"]}" + _rest "${el}"; local args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" + if [[ "${f//@/ }" != "${f}" ]]; then + set -- ${f//@/ } + ast="${2}" + ENV "${3}" "${4}" ${args} + env="${r}" + else + eval ${f%%@*} ${args} + return + fi + # Continue loop + ;; + esac + done +} + +# print +PRINT () { + if [[ "${__ERROR}" ]]; then + _pr_str "${__ERROR}" yes + r="Error: ${r}" + __ERROR= + else + _pr_str "${1}" yes + fi +} + +# repl +ENV; REPL_ENV="${r}" +REP () { + r= + READ "${1}" + EVAL "${r}" "${REPL_ENV}" + PRINT "${r}" +} + +# core.sh: defined using bash +_fref () { + _symbol "${1}"; local sym="${r}" + _function "${2} \"\${@}\"" + ENV_SET "${REPL_ENV}" "${sym}" "${r}" +} +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done +_eval () { EVAL "${1}" "${REPL_ENV}"; } +_fref "eval" _eval +_list; argv="${r}" +for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done +_symbol "__STAR__ARGV__STAR__" +ENV_SET "${REPL_ENV}" "${r}" "${argv}"; + +# core.mal: defined using the language itself +REP "(def! not (fn* (a) (if a false true)))" +REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + +# load/run file from command line (then exit) +if [[ "${1}" ]]; then + REP "(load-file \"${1}\")" + exit 0 +fi + +# repl loop +while true; do + READLINE "user> " || exit "$?" + [[ "${r}" ]] && REP "${r}" && echo "${r}" +done diff --git a/impls/bash/step8_macros.sh b/impls/bash/step8_macros.sh new file mode 100755 index 0000000000..64710610e2 --- /dev/null +++ b/impls/bash/step8_macros.sh @@ -0,0 +1,254 @@ +#!/usr/bin/env bash + +source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/env.sh +source $(dirname $0)/core.sh + +# read +READ () { + [ "${1}" ] && r="${1}" || READLINE + READ_STR "${r}" +} + +# eval +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] +} + +QUASIQUOTE () { + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list + else + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" + fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" + fi +} + +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { + local ast="${1}" env="${2}" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + + _obj_type "${ast}"; local ot="${r}" + case "${ot}" in + symbol) + ENV_GET "${env}" "${ast}" + return ;; + list) + ;; + vector) + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; + hash_map) + local res="" key= val="" hm="${ANON["${ast}"]}" + _hash_map; local new_hm="${r}" + eval local keys="\${!${hm}[@]}" + for key in ${keys}; do + eval val="\${${hm}[\"${key}\"]}" + EVAL "${val}" "${env}" + _assoc! "${new_hm}" "${key}" "${r}" + done + r="${new_hm}" + return ;; + *) + r="${ast}" + return ;; + esac + + # apply list + _empty? "${ast}" && r="${ast}" && return + + _nth "${ast}" 0; local a0="${r}" + _nth "${ast}" 1; local a1="${r}" + _nth "${ast}" 2; local a2="${r}" + case "${ANON["${a0}"]}" in + def!) EVAL "${a2}" "${env}" + [[ "${__ERROR}" ]] && return 1 + ENV_SET "${env}" "${a1}" "${r}" + return ;; + let__STAR__) ENV "${env}"; local let_env="${r}" + local let_pairs=(${ANON["${a1}"]}) + local idx=0 + #echo "let: [${let_pairs[*]}] for ${a2}" + while [[ "${let_pairs["${idx}"]}" ]]; do + EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" + ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" + idx=$(( idx + 2)) + done + ast="${a2}" + env="${let_env}" + # Continue loop + ;; + quote) + r="${a1}" + return ;; + quasiquote) + QUASIQUOTE "${a1}" + ast="${r}" + # Continue loop + ;; + defmacro!) + EVAL "${a2}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local func="${r}" + __new_obj_like "${func}" + ANON["${r}"]="${ANON["${func}"]}" + ANON["${r}_ismacro_"]="yes" + ENV_SET "${env}" "${a1}" "${r}" + return ;; + do) _count "${ast}" + _slice "${ast}" 1 $(( ${r} - 2 )) + _map_with_type _list EVAL "${r}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + _last "${ast}" + ast="${r}" + # Continue loop + ;; + if) EVAL "${a1}" "${env}" + [[ "${__ERROR}" ]] && return 1 + if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then + # eval false form + _nth "${ast}" 3; local a3="${r}" + if [[ "${a3}" ]]; then + ast="${a3}" + else + r="${__nil}" + return + fi + else + # eval true condition + ast="${a2}" + fi + # Continue loop + ;; + fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" + return ;; + *) EVAL "${a0}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local f="${r}" + + _rest "${ast}" + # Should cause no error as ast is not empty. + local args="${r}" + + if [ "${ANON["${f}_ismacro_"]}" ]; then + f="${ANON["${f}"]}" + ${f%%@*} ${ANON["${args}"]} + ast="${r}" + continue + fi + + f="${ANON["${f}"]}" + + _map_with_type _list EVAL "${args}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + args="${ANON["${r}"]}" + + #echo "invoke: [${f}] ${args}" + if [[ "${f//@/ }" != "${f}" ]]; then + set -- ${f//@/ } + ast="${2}" + ENV "${3}" "${4}" ${args} + env="${r}" + else + eval ${f%%@*} ${args} + return + fi + # Continue loop + ;; + esac + done +} + +# print +PRINT () { + if [[ "${__ERROR}" ]]; then + _pr_str "${__ERROR}" yes + r="Error: ${r}" + __ERROR= + else + _pr_str "${1}" yes + fi +} + +# repl +ENV; REPL_ENV="${r}" +REP () { + r= + READ "${1}" + EVAL "${r}" "${REPL_ENV}" + PRINT "${r}" +} + +# core.sh: defined using bash +_fref () { + _symbol "${1}"; local sym="${r}" + _function "${2} \"\${@}\"" + ENV_SET "${REPL_ENV}" "${sym}" "${r}" +} +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done +_eval () { EVAL "${1}" "${REPL_ENV}"; } +_fref "eval" _eval +_list; argv="${r}" +for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done +_symbol "__STAR__ARGV__STAR__" +ENV_SET "${REPL_ENV}" "${r}" "${argv}"; + +# core.mal: defined using the language itself +REP "(def! not (fn* (a) (if a false true)))" +REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + +# load/run file from command line (then exit) +if [[ "${1}" ]]; then + REP "(load-file \"${1}\")" + exit 0 +fi + +# repl loop +while true; do + READLINE "user> " || exit "$?" + [[ "${r}" ]] && REP "${r}" && echo "${r}" +done diff --git a/impls/bash/step9_try.sh b/impls/bash/step9_try.sh new file mode 100755 index 0000000000..bc6336ac34 --- /dev/null +++ b/impls/bash/step9_try.sh @@ -0,0 +1,267 @@ +#!/usr/bin/env bash + +source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/env.sh +source $(dirname $0)/core.sh + +# read +READ () { + [ "${1}" ] && r="${1}" || READLINE + READ_STR "${r}" +} + +# eval +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] +} + +QUASIQUOTE () { + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list + else + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" + fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" + fi +} + +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { + local ast="${1}" env="${2}" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + + _obj_type "${ast}"; local ot="${r}" + case "${ot}" in + symbol) + ENV_GET "${env}" "${ast}" + return ;; + list) + ;; + vector) + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; + hash_map) + local res="" key= val="" hm="${ANON["${ast}"]}" + _hash_map; local new_hm="${r}" + eval local keys="\${!${hm}[@]}" + for key in ${keys}; do + eval val="\${${hm}[\"${key}\"]}" + EVAL "${val}" "${env}" + _assoc! "${new_hm}" "${key}" "${r}" + done + r="${new_hm}" + return ;; + *) + r="${ast}" + return ;; + esac + + # apply list + _empty? "${ast}" && r="${ast}" && return + + _nth "${ast}" 0; local a0="${r}" + _nth "${ast}" 1; local a1="${r}" + _nth "${ast}" 2; local a2="${r}" + case "${ANON["${a0}"]}" in + def!) EVAL "${a2}" "${env}" + [[ "${__ERROR}" ]] && return 1 + ENV_SET "${env}" "${a1}" "${r}" + return ;; + let__STAR__) ENV "${env}"; local let_env="${r}" + local let_pairs=(${ANON["${a1}"]}) + local idx=0 + #echo "let: [${let_pairs[*]}] for ${a2}" + while [[ "${let_pairs["${idx}"]}" ]]; do + EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" + ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" + idx=$(( idx + 2)) + done + ast="${a2}" + env="${let_env}" + # Continue loop + ;; + quote) + r="${a1}" + return ;; + quasiquote) + QUASIQUOTE "${a1}" + ast="${r}" + # Continue loop + ;; + defmacro!) + EVAL "${a2}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local func="${r}" + __new_obj_like "${func}" + ANON["${r}"]="${ANON["${func}"]}" + ANON["${r}_ismacro_"]="yes" + ENV_SET "${env}" "${a1}" "${r}" + return ;; + try__STAR__) EVAL "${a1}" "${env}" + [[ -z "${__ERROR}" ]] && return + _nth "${a2}" 0; local a20="${r}" + if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then + _nth "${a2}" 1; local a21="${r}" + _nth "${a2}" 2; local a22="${r}" + _list "${a21}"; local binds="${r}" + ENV "${env}" "${binds}" "${__ERROR}" + local try_env="${r}" + __ERROR= + EVAL "${a22}" "${try_env}" + fi # if no catch* clause, just propagate __ERROR + return ;; + do) _count "${ast}" + _slice "${ast}" 1 $(( ${r} - 2 )) + _map_with_type _list EVAL "${r}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + _last "${ast}" + ast="${r}" + # Continue loop + ;; + if) EVAL "${a1}" "${env}" + [[ "${__ERROR}" ]] && return 1 + if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then + # eval false form + _nth "${ast}" 3; local a3="${r}" + if [[ "${a3}" ]]; then + ast="${a3}" + else + r="${__nil}" + return + fi + else + # eval true condition + ast="${a2}" + fi + # Continue loop + ;; + fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" + return ;; + *) EVAL "${a0}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local f="${r}" + + _rest "${ast}" + # Should cause no error as ast is not empty. + local args="${r}" + + if [ "${ANON["${f}_ismacro_"]}" ]; then + f="${ANON["${f}"]}" + ${f%%@*} ${ANON["${args}"]} + ast="${r}" + continue + fi + + f="${ANON["${f}"]}" + + _map_with_type _list EVAL "${args}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + args="${ANON["${r}"]}" + + #echo "invoke: [${f}] ${args}" + if [[ "${f//@/ }" != "${f}" ]]; then + set -- ${f//@/ } + ast="${2}" + ENV "${3}" "${4}" ${args} + env="${r}" + else + eval ${f%%@*} ${args} + return + fi + # Continue loop + ;; + esac + done +} + +# print +PRINT () { + if [[ "${__ERROR}" ]]; then + _pr_str "${__ERROR}" yes + r="Error: ${r}" + __ERROR= + else + _pr_str "${1}" yes + fi +} + +# repl +ENV; REPL_ENV="${r}" +REP () { + r= + READ "${1}" + EVAL "${r}" "${REPL_ENV}" + PRINT "${r}" +} + +# core.sh: defined using bash +_fref () { + _symbol "${1}"; local sym="${r}" + _function "${2} \"\${@}\"" + ENV_SET "${REPL_ENV}" "${sym}" "${r}" +} +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done +_eval () { EVAL "${1}" "${REPL_ENV}"; } +_fref "eval" _eval +_list; argv="${r}" +for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done +_symbol "__STAR__ARGV__STAR__" +ENV_SET "${REPL_ENV}" "${r}" "${argv}"; + +# core.mal: defined using the language itself +REP "(def! not (fn* (a) (if a false true)))" +REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + +# load/run file from command line (then exit) +if [[ "${1}" ]]; then + REP "(load-file \"${1}\")" + exit 0 +fi + +# repl loop +while true; do + READLINE "user> " || exit "$?" + [[ "${r}" ]] && REP "${r}" && echo "${r}" +done diff --git a/impls/bash/stepA_mal.sh b/impls/bash/stepA_mal.sh new file mode 100755 index 0000000000..f65b4b1db2 --- /dev/null +++ b/impls/bash/stepA_mal.sh @@ -0,0 +1,279 @@ +#!/usr/bin/env bash + +source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/env.sh +source $(dirname $0)/core.sh + +# read +READ () { + [ "${1}" ] && r="${1}" || READLINE + READ_STR "${r}" +} + +# eval +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] +} + +QUASIQUOTE () { + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list + else + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" + fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" + fi +} + +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { + local ast="${1}" env="${2}" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + + _obj_type "${ast}"; local ot="${r}" + case "${ot}" in + symbol) + ENV_GET "${env}" "${ast}" + return ;; + list) + ;; + vector) + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; + hash_map) + local res="" key= val="" hm="${ANON["${ast}"]}" + _hash_map; local new_hm="${r}" + eval local keys="\${!${hm}[@]}" + for key in ${keys}; do + eval val="\${${hm}[\"${key}\"]}" + EVAL "${val}" "${env}" + _assoc! "${new_hm}" "${key}" "${r}" + done + r="${new_hm}" + return ;; + *) + r="${ast}" + return ;; + esac + + # apply list + _empty? "${ast}" && r="${ast}" && return + + _nth "${ast}" 0; local a0="${r}" + _nth "${ast}" 1; local a1="${r}" + _nth "${ast}" 2; local a2="${r}" + case "${ANON["${a0}"]}" in + def!) EVAL "${a2}" "${env}" + [[ "${__ERROR}" ]] && return 1 + ENV_SET "${env}" "${a1}" "${r}" + return ;; + let__STAR__) ENV "${env}"; local let_env="${r}" + local let_pairs=(${ANON["${a1}"]}) + local idx=0 + #echo "let: [${let_pairs[*]}] for ${a2}" + while [[ "${let_pairs["${idx}"]}" ]]; do + EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" + ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" + idx=$(( idx + 2)) + done + ast="${a2}" + env="${let_env}" + # Continue loop + ;; + quote) + r="${a1}" + return ;; + quasiquote) + QUASIQUOTE "${a1}" + ast="${r}" + # Continue loop + ;; + defmacro!) + EVAL "${a2}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local func="${r}" + __new_obj_like "${func}" + ANON["${r}"]="${ANON["${func}"]}" + ANON["${r}_ismacro_"]="yes" + ENV_SET "${env}" "${a1}" "${r}" + return ;; + sh__STAR__) EVAL "${a1}" "${env}" + local output="" + local line="" + r="${ANON["${r}"]}" + r="${r//__STAR__/*}" + while read -r line || [ -n "${line}" ]; do + output="${output}${line}"$'\n' + done < <(eval "${r}") + _string "${output%$'\n'}" + return ;; + try__STAR__) EVAL "${a1}" "${env}" + [[ -z "${__ERROR}" ]] && return + _nth "${a2}" 0; local a20="${r}" + if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then + _nth "${a2}" 1; local a21="${r}" + _nth "${a2}" 2; local a22="${r}" + _list "${a21}"; local binds="${r}" + ENV "${env}" "${binds}" "${__ERROR}" + local try_env="${r}" + __ERROR= + EVAL "${a22}" "${try_env}" + fi # if no catch* clause, just propagate __ERROR + return ;; + do) _count "${ast}" + _slice "${ast}" 1 $(( ${r} - 2 )) + _map_with_type _list EVAL "${r}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + _last "${ast}" + ast="${r}" + # Continue loop + ;; + if) EVAL "${a1}" "${env}" + [[ "${__ERROR}" ]] && return 1 + if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then + # eval false form + _nth "${ast}" 3; local a3="${r}" + if [[ "${a3}" ]]; then + ast="${a3}" + else + r="${__nil}" + return + fi + else + # eval true condition + ast="${a2}" + fi + # Continue loop + ;; + fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" + return ;; + *) EVAL "${a0}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local f="${r}" + + _rest "${ast}" + # Should cause no error as ast is not empty. + local args="${r}" + + if [ "${ANON["${f}_ismacro_"]}" ]; then + f="${ANON["${f}"]}" + ${f%%@*} ${ANON["${args}"]} + ast="${r}" + continue + fi + + f="${ANON["${f}"]}" + + _map_with_type _list EVAL "${args}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + args="${ANON["${r}"]}" + + #echo "invoke: [${f}] ${args}" + if [[ "${f//@/ }" != "${f}" ]]; then + set -- ${f//@/ } + ast="${2}" + ENV "${3}" "${4}" ${args} + env="${r}" + else + eval ${f%%@*} ${args} + return + fi + # Continue loop + ;; + esac + done +} + +# print +PRINT () { + if [[ "${__ERROR}" ]]; then + _pr_str "${__ERROR}" yes + r="Error: ${r}" + __ERROR= + else + _pr_str "${1}" yes + fi +} + +# repl +ENV; REPL_ENV="${r}" +REP () { + r= + READ "${1}" + EVAL "${r}" "${REPL_ENV}" + PRINT "${r}" +} + +# core.sh: defined using bash +_fref () { + _symbol "${1}"; local sym="${r}" + _function "${2} \"\${@}\"" + ENV_SET "${REPL_ENV}" "${sym}" "${r}" +} +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done +_eval () { EVAL "${1}" "${REPL_ENV}"; } +_fref "eval" _eval +_list; argv="${r}" +for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done +_symbol "__STAR__ARGV__STAR__" +ENV_SET "${REPL_ENV}" "${r}" "${argv}"; + +# core.mal: defined using the language itself +REP "(def! *host-language* \"bash\")" +REP "(def! not (fn* (a) (if a false true)))" +REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + +# load/run file from command line (then exit) +if [[ "${1}" ]]; then + REP "(load-file \"${1}\")" + exit 0 +fi + +# repl loop +REP "(println (str \"Mal [\" *host-language* \"]\"))" +while true; do + READLINE "user> " || exit "$?" + [[ "${r}" ]] && REP "${r}" && echo "${r}" +done diff --git a/impls/bash/tests/stepA_mal.mal b/impls/bash/tests/stepA_mal.mal new file mode 100644 index 0000000000..f977055b71 --- /dev/null +++ b/impls/bash/tests/stepA_mal.mal @@ -0,0 +1,32 @@ +;; Testing basic bash interop + +(sh* "echo 7") +;=>"7" + +(sh* "echo >&2 hello") +;/hello +;=>"" + +(sh* "foo=8; echo ${foo}") +;=>"8" + +(sh* "for x in a b c; do echo -n \"X${x}Y \"; done; echo") +;=>"XaY XbY XcY" + +(sh* "for x in 1 2 3; do echo -n \"$((1+$x)) \"; done; echo") +;=>"2 3 4" + +(sh* "for x in {1..10}; do echo $x; done") +;=>"1\n2\n3\n4\n5\n6\n7\n8\n9\n10" + +(sh* "echo -n {1..3}") +;=>"1 2 3" + +(sh* "echo hello; echo foo; echo yes;") +;=>"hello\nfoo\nyes" + +(sh* "grep -oE '\[.*!\]' core.sh") +;=>"[reset!]\n[swap!]" + +(sh* "ls cor*.sh") +;=>"core.sh" diff --git a/bash/types.sh b/impls/bash/types.sh similarity index 86% rename from bash/types.sh rename to impls/bash/types.sh index 4c2c824a46..556cca0436 100644 --- a/bash/types.sh +++ b/impls/bash/types.sh @@ -8,7 +8,7 @@ __mal_types_included=true declare -A ANON __obj_magic=__5bal7 -__keyw=$(echo -en "\u029e") +__keyw=$(echo -en "\xCA\x9E") # \u029E __obj_hash_code=${__obj_hash_code:-0} __new_obj_hash_code () { @@ -53,7 +53,12 @@ _obj_type () { func) r="function" ;; strn) local s="${ANON["${1}"]}" - [[ "${s:0:1}" = "${__keyw}" ]] && r="keyword" || r="string" ;; + if [[ "${1:0:1}" = "${__keyw}" ]] \ + || [[ "${1:0:2}" = "${__keyw}" ]]; then + r="keyword" + else + r="string" + fi ;; _nil) r="nil" ;; true) r="true" ;; fals) r="false" ;; @@ -76,7 +81,7 @@ _equal? () { case "${ot1}" in string|symbol|keyword|number) [[ "${ANON["${1}"]}" == "${ANON["${2}"]}" ]] ;; - list|vector|hash_map) + list|vector) _count "${1}"; local sz1="${r}" _count "${2}"; local sz2="${r}" [[ "${sz1}" == "${sz2}" ]] || return 1 @@ -86,6 +91,20 @@ _equal? () { _equal? "${a1[${i}]}" "${a2[${i}]}" || return 1 done ;; + hash_map) + local hm1="${ANON["${1}"]}" + eval local ks1="\${!${hm1}[@]}" + local hm2="${ANON["${2}"]}" + eval local ks2="\${!${hm2}[@]}" + [[ "${#ks1}" == "${#ks2}" ]] || return 1 + for k in ${ks1}; do + eval v1="\${${hm1}[\"${k}\"]}" + eval v2="\${${hm2}[\"${k}\"]}" + [ "${v1}" ] || return 1 + [ "${v2}" ] || return 1 + _equal? "${v1}" "${v2}" || return 1 + done + ;; *) [[ "${1}" == "${2}" ]] ;; esac @@ -118,13 +137,18 @@ _keyword () { local k="${1}" __new_obj_hash_code r="strn_${r}" - [[ "${1:1:1}" = "${__keyw}" ]] || k="${__keyw}${1}" + if [[ "${1:0:1}" = "${__keyw}" ]] \ + || [[ "${1:0:2}" = "${__keyw}" ]]; then + true + else + k="${__keyw}${1}" + fi ANON["${r}"]="${k//\*/__STAR__}" } _keyword? () { [[ ${1} =~ ^strn_ ]] || return 1 local s="${ANON["${1}"]}" - [[ "${s:0:1}" = "${__keyw}" ]] + [[ "${s:0:1}" = "${__keyw}" ]] || [[ "${s:0:2}" = "${__keyw}" ]] } @@ -185,6 +209,12 @@ _vector () { } _vector? () { [[ ${1} =~ ^vector_ ]]; } +vec () { + __new_obj_hash_code + r="vector_$r" + ANON["$r"]=${ANON["$1"]} +} + # hash maps (associative arrays) diff --git a/impls/basic/.args.mal b/impls/basic/.args.mal new file mode 100644 index 0000000000..db54c0e912 --- /dev/null +++ b/impls/basic/.args.mal @@ -0,0 +1 @@ +(def! -*ARGS*- (list )) diff --git a/impls/basic/Dockerfile b/impls/basic/Dockerfile new file mode 100644 index 0000000000..ea6125710c --- /dev/null +++ b/impls/basic/Dockerfile @@ -0,0 +1,43 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ + ca-certificates curl gcc g++ libasound2-dev \ + libglu1-mesa-dev mesa-common-dev patch unzip wget \ + xz-utils libncurses-dev + +# cbmbasic +# Remove duplicate RAM (https://github.com/mist64/cbmbasic/commit/352a313313dd0a15a47288c8f8031b54ac8c92a2). +RUN cd /tmp && \ + curl -L https://github.com/kanaka/cbmbasic/archive/master.zip -o cbmbasic.zip && \ + unzip cbmbasic.zip && \ + cd cbmbasic-master && \ + sed -i '/unsigned char RAM.65536.;/d' runtime.c && \ + make && \ + mv cbmbasic /usr/local/bin && \ + cd .. && \ + rm -r cbmbasic* + +# qbasic (using freebasic: `fbc -lang qb`) +RUN cd /opt && \ + curl -L https://sourceforge.net/projects/fbc/files/FreeBASIC-1.10.1/Binaries-Linux/FreeBASIC-1.10.1-ubuntu-22.04-x86_64.tar.xz | tar xvJf - && \ + ln -sf /opt/FreeBASIC-1.10.1-ubuntu-22.04-x86_64/bin/fbc /usr/local/bin/fbc + diff --git a/impls/basic/Makefile b/impls/basic/Makefile new file mode 100644 index 0000000000..2fbd365bf9 --- /dev/null +++ b/impls/basic/Makefile @@ -0,0 +1,62 @@ +basic_MODE = cbm +BASICPP_OPTS = --mode $(basic_MODE) + +FBC = fbc -lang qb + +STEPS4_A = step4_if_fn_do.bas step5_tco.bas step6_file.bas \ + step7_quote.bas step8_macros.bas step9_try.bas stepA_mal.bas +STEPS3_A = step3_env.bas $(STEPS4_A) +STEPS1_A = step1_read_print.bas step2_eval.bas $(STEPS3_A) +STEPS0_A = step0_repl.bas $(STEPS1_A) + +all: $(if $(filter qbasic,$(basic_MODE)),$(subst .bas,,$(STEPS0_A)),$(STEPS0_A)) + +$(STEPS0_A): debug.in.bas mem.in.bas readline.in.bas +$(STEPS1_A): types.in.bas reader.in.bas printer.in.bas +$(STEPS3_A): env.in.bas +$(STEPS4_A): core.in.bas + + + +step%.bas: step%.in.bas + ./basicpp.py $(BASICPP_OPTS) $< > $@ + +tests/%.bas: tests/%.in.bas + ./basicpp.py $(BASICPP_OPTS) $< > $@ + +# QBasic specific compilation rule +step%: step%.bas + $(FBC) $< -x $@ + +# CBM/C64 image rules + +%.prg: %.bas + cat $< | tr "A-Z" "a-z" > $<.tmp + #cat $< | sed 's/["]\@["]\@!/\L&/g' > $<.tmp + petcat -w2 -nc -o $@ $<.tmp + #rm $<.tmp + +mal.prg: stepA_mal.prg + cp $< $@ + +.args.mal.prg: .args.mal + petcat -text -w2 -o $@ $< + +core.mal.prg: ../core.mal + petcat -text -w2 -o $@ $< + +mal.d64: mal.prg .args.mal.prg core.mal.prg + c1541 -format "mal,01" d64 $@ \ + -attach $@ \ + -write $< mal \ + -write .args.mal.prg .args.mal \ + -write core.mal.prg core.mal + + +# Clean and Stats rules + +.PHONY: clean + +clean: + rm -f $(STEPS0_A) $(subst .bas,,$(STEPS0_A)) *.d64 *.prg + rm -rf ./internal diff --git a/impls/basic/basicpp.py b/impls/basic/basicpp.py new file mode 100755 index 0000000000..86a2e6c419 --- /dev/null +++ b/impls/basic/basicpp.py @@ -0,0 +1,335 @@ +#!/usr/bin/env python + +from __future__ import print_function +import argparse +import re +import sys + +def debug(*args, **kwargs): + print(*args, file=sys.stderr, **kwargs) + +def parse_args(): + parser = argparse.ArgumentParser(description='Preprocess Basic code.') + parser.add_argument('infiles', type=str, nargs='+', + help='the Basic files to preprocess') + parser.add_argument('--mode', choices=["cbm", "qbasic"], default="cbm") + parser.add_argument('--keep-rems', action='store_true', default=False, + help='The type of REMs to keep (0 (none) -> 4 (all)') + parser.add_argument('--keep-blank-lines', action='store_true', default=False, + help='Keep blank lines from the original file') + parser.add_argument('--keep-indent', action='store_true', default=False, + help='Keep line identing') + parser.add_argument('--skip-misc-fixups', action='store_true', default=False, + help='Skip miscellaneous fixup/shrink fixups') + parser.add_argument('--skip-combine-lines', action='store_true', default=False, + help='Do not combine lines using the ":" separator') + + args = parser.parse_args() + if args.keep_rems and not args.skip_combine_lines: + debug("Option --keep-rems implies --skip-combine-lines ") + args.skip_combine_lines = True + + if args.mode == 'qbasic' and not args.skip_misc_fixups: + debug("Mode 'qbasic' implies --skip-misc-fixups") + args.skip_misc_fixups = True + + return args + +# pull in include files +def resolve_includes(orig_lines, args): + included = {} + lines = orig_lines[:] + position = 0 + while position < len(lines): + line = lines[position] + m = re.match(r"^(?:#([^ ]*) )? *REM \$INCLUDE: '([^'\n]*)' *$", line) + if m: + mode = m.group(1) + f = m.group(2) + if mode and mode != args.mode: + position += 1 + elif f not in included: + ilines = [l.rstrip() for l in open(f).readlines()] + if args.keep_rems: lines.append("REM vvv BEGIN '%s' vvv" % f) + lines[position:position+1] = ilines + if args.keep_rems: lines.append("REM ^^^ END '%s' ^^^" % f) + else: + debug("Ignoring already included file: %s" % f) + else: + position += 1 + return lines + +def resolve_mode(orig_lines, args): + lines = [] + for line in orig_lines: + m = re.match(r"^ *#([^ \n]*) *([^\n]*)$", line) + if m: + if m.group(1) == args.mode: + lines.append(m.group(2)) + continue + lines.append(line) + return lines + +def drop_blank_lines(orig_lines): + lines = [] + for line in orig_lines: + if re.match(r"^\W*$", line): continue + lines.append(line) + return lines + + +def drop_rems(orig_lines): + lines = [] + for line in orig_lines: + if re.match(r"^ *REM", line): + continue + m = re.match(r"^(.*): *REM .*$", line) + if m: + lines.append(m.group(1)) + else: + lines.append(line) + return lines + +def remove_indent(orig_lines): + lines = [] + for line in orig_lines: + m = re.match(r"^ *([^ \n].*)$", line) + lines.append(m.group(1)) + return lines + +def misc_fixups(orig_lines): + text = "\n".join(orig_lines) + + # Remove GOTO after THEN + text = re.sub(r"\bTHEN GOTO\b", "THEN", text) + + # Remove spaces after keywords + text = re.sub(r"\bIF ", "IF", text) + text = re.sub(r"\bPRINT *", "PRINT", text) + text = re.sub(r"\bDIM ", "DIM", text) + text = re.sub(r"\bOPEN ", "OPEN", text) + text = re.sub(r"\bGET ", "GET", text) + text = re.sub(r"\bPOKE ", "POKE", text) + text = re.sub(r"\bCLOSE ", "CLOSE", text) + text = re.sub(r"\bFOR ", "FOR", text) + text = re.sub(r" TO ", "TO", text) + text = re.sub(r"\bNEXT ", "NEXT", text) + + # Remove spaces around GOTO/GOSUB/THEN + text = re.sub(r" *GOTO *", "GOTO", text) + text = re.sub(r" *GOSUB *", "GOSUB", text) + text = re.sub(r" *THEN *", r"THEN", text) + + # Remove spaces around AND/OR except after ST + text = re.sub(r"(?OR", text) + + return text.split("\n") + +def finalize(lines, args): + labels_lines = {} + lines_labels = {} + call_index = {} + + cur_sub = None + + # number lines, remove labels (but track line number), and replace + # CALLs with a stack based GOTO + src_lines = lines + lines = [] + lnum=1 + for line in src_lines: + + # Drop labels (track line number for GOTO/GOSUB) + m = re.match(r"^ *([^ :\n]*): *$", line) + if m: + label = m.groups(1)[0] + labels_lines[label] = lnum + lines_labels[lnum] = label + continue + + if re.match(r".*CALL *([^ :\n]*) *:", line): + raise Exception("CALL is not the last thing on line %s" % lnum) + + # Replace CALLs (track line number for replacement later) + #m = re.match(r"\bCALL *([^ :]*) *$", line) + m = re.match(r"(.*)CALL *([^ :\n]*) *$", line) + if m: + prefix = m.groups(1)[0] + sub = m.groups(1)[1] + if not sub in call_index: + call_index[sub] = 0 + call_index[sub] += 1 + label = sub+"_"+str(call_index[sub]) + + # Replace the CALL with stack based GOTO + if args.mode == "cbm": + lines.append("%s %sQ=%s:GOSUBPUSH_Q:GOTO%s" % ( + lnum, prefix, call_index[sub], sub)) + else: + lines.append("%s %sX=X+1:X%%(X)=%s:GOTO %s" % ( + lnum, prefix, call_index[sub], sub)) + lnum += 1 + + # Add the return spot + labels_lines[label] = lnum + lines_labels[lnum] = label + continue + + lines.append("%s %s" % (lnum, line)) + lnum += 1 + + # remove SUB (but track lines), and replace END SUB with ON GOTO + # that returns to original caller + src_lines = lines + lines = [] + lnum=1 + for line in src_lines: + # Drop subroutine defs (track line number for CALLS) + m = re.match(r"^([0-9][0-9]*) *SUB *([^ \n]*) *$", line) + if m: + lnum = int(m.groups(1)[0])+1 + label = m.groups(1)[1] + cur_sub = label + labels_lines[label] = lnum + lines_labels[lnum] = label + continue + + # Drop END SUB (track line number for replacement later) + m = re.match(r"^([0-9][0-9]*) *END SUB *$", line) + if m: + if cur_sub == None: + raise Exception("END SUB found without preceeding SUB") + lnum = int(m.groups(1)[0]) + index = call_index[cur_sub] + + ret_labels = [cur_sub+"_"+str(i) for i in range(1, index+1)] + if args.mode == "cbm": + line = "%s GOSUBPOP_Q:ONQGOTO%s" % (lnum, ",".join(ret_labels)) + else: + line = "%s X=X-1:ON X%%(X+1) GOTO %s" % (lnum, ",".join(ret_labels)) + cur_sub = None + + lines.append(line) + + def update_labels_lines(text, a, b): + stext = "" + while stext != text: + stext = text + text = re.sub(r"(THEN *)%s\b" % a, r"\g<1>%s" % b, stext) + #text = re.sub(r"(THEN)%s\b" % a, r"THEN%s" % b, stext) + if args.mode == "cbm": + text = re.sub(r"ON *([^:\n]*) *GOTO *([^:\n]*)\b%s\b" % a, r"ON\g<1>GOTO\g<2>%s" % b, text) + text = re.sub(r"ON *([^:\n]*) *GOSUB *([^:\n]*)\b%s\b" % a, r"ON\g<1>GOSUB\g<2>%s" % b, text) + else: + text = re.sub(r"(ON [^:\n]* *GOTO *[^:\n]*)\b%s\b" % a, r"\g<1>%s" % b, text) + text = re.sub(r"(ON [^:\n]* *GOSUB *[^:\n]*)\b%s\b" % a, r"\g<1>%s" % b, text) + text = re.sub(r"(GOSUB *)%s\b" % a, r"\g<1>%s" % b, text) + text = re.sub(r"(GOTO *)%s\b" % a, r"\g<1>%s" % b, text) + #text = re.sub(r"(GOTO)%s\b" % a, r"\1%s" % b, text) + return text + + # search for and replace GOTO/GOSUBs + src_lines = lines + text = "\n".join(lines) + for label, lnum in labels_lines.items(): + text = update_labels_lines(text, label, lnum) + lines = text.split("\n") + + # combine lines + if not args.skip_combine_lines: + renumber = {} + src_lines = lines + lines = [] + pos = 0 + acc_line = "" + def renum(line): + lnum = len(lines)+1 + renumber[old_num] = lnum + return "%s %s" % (lnum, line) + while pos < len(src_lines): + line = src_lines[pos] + m = re.match(r"^([0-9]*) (.*)$", line) + old_num = int(m.group(1)) + line = m.group(2) + + if acc_line == "": + # Starting a new line + acc_line = renum(line) + elif old_num in lines_labels or re.match(r"^ *FOR\b.*", line): + # This is a GOTO/GOSUB target or FOR loop so it must + # be on a line by itself + lines.append(acc_line) + acc_line = renum(line) + elif re.match(r".*(?:GOTO|THEN|RETURN).*", acc_line): + # GOTO/THEN/RETURN are last thing on the line + lines.append(acc_line) + acc_line = renum(line) + # TODO: not sure why this is 88 rather than 80 + elif len(acc_line) + 1 + len(line) < 88: + # Continue building up the line + acc_line = acc_line + ":" + line + # GOTO/IF/RETURN must be the last things on a line so + # start a new line + if re.match(r".*(?:GOTO|THEN|RETURN).*", line): + lines.append(acc_line) + acc_line = "" + else: + # Too long so start a new line + lines.append(acc_line) + acc_line = renum(line) + pos += 1 + if acc_line != "": + lines.append(acc_line) + + # Finally renumber GOTO/GOSUBS + src_lines = lines + text = "\n".join(lines) + # search for and replace GOTO/GOSUBs + for a in sorted(renumber.keys()): + b = renumber[a] + text = update_labels_lines(text, a, b) + lines = text.split("\n") + + return lines + +if __name__ == '__main__': + args = parse_args() + + debug("Preprocessing basic files: "+", ".join(args.infiles)) + + # read in lines + lines = [l.rstrip() for f in args.infiles + for l in open(f).readlines()] + debug("Original lines: %s" % len(lines)) + + # pull in include files + lines = resolve_includes(lines, args) + debug("Lines after includes: %s" % len(lines)) + + lines = resolve_mode(lines, args) + debug("Lines after resolving mode specific lines: %s" % len(lines)) + + # drop blank lines + if not args.keep_blank_lines: + lines = drop_blank_lines(lines) + debug("Lines after dropping blank lines: %s" % len(lines)) + + # keep/drop REMs + if not args.keep_rems: + lines = drop_rems(lines) + debug("Lines after dropping REMs: %s" % len(lines)) + + # keep/remove the indenting + if not args.keep_indent: + lines = remove_indent(lines) + + # apply some miscellaneous simple fixups/regex transforms + if not args.skip_misc_fixups: + lines = misc_fixups(lines) + + # number lines, drop/keep labels, combine lines + lines = finalize(lines, args) + debug("Lines after finalizing: %s" % len(lines)) + + print("\n".join(lines)) diff --git a/impls/basic/cbmbasic_console.patch b/impls/basic/cbmbasic_console.patch new file mode 100644 index 0000000000..d20dce1c83 --- /dev/null +++ b/impls/basic/cbmbasic_console.patch @@ -0,0 +1,26 @@ +diff --git a/runtime.c b/runtime.c +index 3066580..c635bd4 100644 +--- a/runtime.c ++++ b/runtime.c +@@ -535,7 +535,8 @@ printf("CHROUT: %d @ %x,%x,%x,%x\n", A, a, b, c, d); + left_cursor(); + break; + case '"': +- kernal_quote = 1; ++ // jdm: this doesn't match C64 behavior ++ //kernal_quote = 1; + // fallthrough + default: + putchar(A); +@@ -838,8 +839,10 @@ GETIN() { + /*Notice that EOF is also turned off in non-canonical mode*/ + A = getchar(); + if (A == 255) { A = 4; } // map actual EOF to 4 ++ ++ // jdm: this doesn't match C64 behavior + /* Simulate echo */ +- if (A != 0 && A != 4) { putchar(A); } ++ //if (A != 0 && A != 4) { putchar(A); } + + /*restore the old settings*/ + tcsetattr( STDIN_FILENO, TCSANOW, &oldt); diff --git a/impls/basic/core.in.bas b/impls/basic/core.in.bas new file mode 100644 index 0000000000..e87a205e99 --- /dev/null +++ b/impls/basic/core.in.bas @@ -0,0 +1,638 @@ +REM APPLY should really be in types.in.bas but it is here because it +REM calls DO_TCO_FUNCTION so it will cause syntax errors for steps1-3 +REM if it is in types.in.bas because there are unresolved labels. + +REM APPLY(F, AR) -> R +REM - restores E +REM - call using GOTO and with return label/address on the stack +SUB APPLY + REM if metadata, get the actual object + GOSUB TYPE_F + IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F + + ON T-8 GOTO APPLY_FUNCTION,APPLY_MAL_FUNCTION,APPLY_MAL_FUNCTION + + APPLY_FUNCTION: + REM regular function + IF Z%(F+1)<64 THEN GOSUB DO_FUNCTION:GOTO APPLY_DONE + REM for recur functions (apply, map, swap!), use GOTO + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION + GOTO APPLY_DONE + + APPLY_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment + + REM create new environ using env and params stored in the + REM function and bind the params to the apply arguments + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + A=Z%(F+1):E=R:CALL EVAL + + AY=E:GOSUB RELEASE: REM release the new environment + + GOSUB POP_Q:E=Q: REM pop/restore the saved environment + + APPLY_DONE: +END SUB + + +REM DO_TCO_FUNCTION(F, AR) +SUB DO_TCO_FUNCTION + G=Z%(F+1) + + REM Get argument values + A=Z%(AR+2) + B=Z%(Z%(AR+1)+2) + +REM PRINT "F:"+STR$(F)+", Z%(F):"+STR$(Z%(F))+", G:"+STR$(G) + ON G-64 GOTO DO_APPLY,DO_MAP,DO_SWAP_BANG + + DO_APPLY: + F=A + AR=Z%(AR+1) + A=AR:GOSUB COUNT:C=R + + A=Z%(AR+2) + REM no intermediate args, but not a list, so convert it first + GOSUB TYPE_A + IF C<=1 AND T<>6 THEN T=6:GOSUB FORCE_SEQ_TYPE:GOTO DO_APPLY_2 + REM no intermediate args, just call APPLY directly + IF C<=1 THEN GOTO DO_APPLY_1 + + REM prepend intermediate args to final args element + A=AR:B=0:C=C-1:GOSUB SLICE + REM release the terminator of new list (we skip over it) + REM we already checked for an empty list above, so R6 is pointer + REM a real non-empty list + AY=Z%(R6+1):GOSUB RELEASE + REM attach end of slice to final args element + A2=Z%(A+2) + Z%(R6+1)=A2 + Z%(A2)=Z%(A2)+32 + + GOTO DO_APPLY_2 + + DO_APPLY_1: + AR=A:CALL APPLY + + GOTO DO_TCO_FUNCTION_DONE + + DO_APPLY_2: + GOSUB PUSH_R: REM push/save new args for release + + AR=R:CALL APPLY + + REM pop/release new args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO DO_TCO_FUNCTION_DONE + + DO_MAP: + F=A + + REM setup the stack for the loop + T=6:GOSUB MAP_LOOP_START + + DO_MAP_LOOP: + IF Z%(B+1)=0 THEN GOTO DO_MAP_DONE + + REM create argument list for apply + T=6:L=6:M=Z%(B+2):GOSUB ALLOC + + GOSUB PUSH_R: REM push argument list + Q=F:GOSUB PUSH_Q: REM push F + Q=B:GOSUB PUSH_Q: REM push B + + AR=R:CALL APPLY + + GOSUB POP_Q:B=Q: REM pop B + GOSUB POP_Q:F=Q: REM pop F + GOSUB POP_Q: REM pop apply args and release them + AY=Q:GOSUB RELEASE + + REM main value is result of apply + M=R + + B=Z%(B+1): REM go to the next element + + REM if error, release the unattached element + IF ER<>-2 THEN AY=R:GOSUB RELEASE:GOTO DO_MAP_DONE + + REM update the return sequence structure + REM release N since list takes full ownership + C=1:T=6:GOSUB MAP_LOOP_UPDATE + + GOTO DO_MAP_LOOP + + DO_MAP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO DO_TCO_FUNCTION_DONE + + DO_SWAP_BANG: + F=B + + REM add atom to front of the args list + T=6:L=Z%(Z%(AR+1)+1):M=Z%(A+1):GOSUB ALLOC: REM cons + AR=R + + REM push args for release after + Q=AR:GOSUB PUSH_Q + + REM push atom + GOSUB PUSH_A + + CALL APPLY + + REM pop atom + GOSUB POP_A + + REM pop and release args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM use reset to update the value + B=R:GOSUB DO_RESET_BANG + + REM but decrease ref cnt of return by 1 (not sure why) + AY=R:GOSUB RELEASE + + GOTO DO_TCO_FUNCTION_DONE + + DO_TCO_FUNCTION_DONE: +END SUB + +REM DO_FUNCTION(F, AR) +DO_FUNCTION: + REM Get the function number + G=Z%(F+1) + + REM Get argument values + A=Z%(AR+2):A1=Z%(A+1) + B=Z%(Z%(AR+1)+2):B1=Z%(B+1) + + REM Switch on the function number + REM MEMORY DEBUGGING: + REM IF G>60 THEN ER=-1:E$="unknown function"+STR$(G):RETURN + ON INT(G/10)+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_59,DO_60_69 + + DO_1_9: + ON G GOTO DO_EQUAL_Q,DO_THROW,DO_NIL_Q,DO_TRUE_Q,DO_FALSE_Q,DO_STRING_Q,DO_SYMBOL,DO_SYMBOL_Q,DO_KEYWORD + DO_10_19: + ON G-9 GOTO DO_KEYWORD_Q,DO_NUMBER_Q,DO_FN_Q,DO_MACRO_Q,DO_PR_STR,DO_STR,DO_PRN,DO_PRINTLN,DO_READ_STRING,DO_READLINE + DO_20_29: + ON G-19 GOTO DO_SLURP,DO_LT,DO_LTE,DO_GT,DO_GTE,DO_ADD,DO_SUB,DO_MULT,DO_DIV,DO_TIME_MS + DO_30_39: + ON G-29 GOTO DO_LIST,DO_LIST_Q,DO_VECTOR,DO_VECTOR_Q,DO_HASH_MAP,DO_MAP_Q,DO_ASSOC,DO_THROW,DO_GET,DO_CONTAINS + DO_40_49: + ON G-39 GOTO DO_KEYS,DO_VALS,DO_SEQUENTIAL_Q,DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT + DO_50_59: + ON G-49 GOTO DO_CONJ,DO_SEQ,DO_WITH_META,DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE + DO_60_69: + ON G-59 GOTO DO_VEC,DO_PR_MEMORY_SUMMARY + + DO_EQUAL_Q: + GOSUB EQUAL_Q + GOTO RETURN_TRUE_FALSE + DO_THROW: + ER=A + Z%(ER)=Z%(ER)+32 + R=-1 + RETURN + DO_NIL_Q: + R=A=0 + GOTO RETURN_TRUE_FALSE + DO_TRUE_Q: + R=A=4 + GOTO RETURN_TRUE_FALSE + DO_FALSE_Q: + R=A=2 + GOTO RETURN_TRUE_FALSE + DO_STRING_Q: + R=0 + GOSUB TYPE_A + IF T<>4 THEN GOTO RETURN_TRUE_FALSE + IF MID$(S$(A1),1,1)=CHR$(127) THEN GOTO RETURN_TRUE_FALSE + R=1 + GOTO RETURN_TRUE_FALSE + DO_SYMBOL: + B$=S$(A1) + T=5:GOSUB STRING + RETURN + DO_SYMBOL_Q: + GOSUB TYPE_A + R=T=5 + GOTO RETURN_TRUE_FALSE + DO_KEYWORD: + B$=S$(A1) + IF MID$(B$,1,1)<>CHR$(127) THEN B$=CHR$(127)+B$ + T=4:GOSUB STRING + RETURN + DO_KEYWORD_Q: + R=0 + GOSUB TYPE_A + IF T<>4 THEN GOTO RETURN_TRUE_FALSE + IF MID$(S$(A1),1,1)<>CHR$(127) THEN GOTO RETURN_TRUE_FALSE + R=1 + GOTO RETURN_TRUE_FALSE + DO_NUMBER_Q: + GOSUB TYPE_A + R=T=2 + GOTO RETURN_TRUE_FALSE + DO_FN_Q: + GOSUB TYPE_A + R=T=9 OR T=10 + GOTO RETURN_TRUE_FALSE + DO_MACRO_Q: + GOSUB TYPE_A + R=T=11 + GOTO RETURN_TRUE_FALSE + + DO_PR_STR: + AZ=AR:B=1:B$=" ":GOSUB PR_STR_SEQ + B$=R$:T=4:GOSUB STRING + RETURN + DO_STR: + AZ=AR:B=0:B$="":GOSUB PR_STR_SEQ + B$=R$:T=4:GOSUB STRING + RETURN + DO_PRN: + AZ=AR:B=1:B$=" ":GOSUB PR_STR_SEQ + PRINT R$ + R=0 + GOTO INC_REF_R + DO_PRINTLN: + AZ=AR:B=0:B$=" ":GOSUB PR_STR_SEQ + PRINT R$ + R=0 + GOTO INC_REF_R + DO_READ_STRING: + A$=S$(A1) + GOSUB READ_STR + RETURN + DO_READLINE: + A$=S$(A1):GOSUB READLINE + IF EZ>0 THEN EZ=0:R=0:GOTO INC_REF_R + B$=R$:T=4:GOSUB STRING + RETURN + DO_SLURP: + R$="" + EZ=0 + #cbm OPEN 2,8,0,S$(A1) + #qbasic A$=S$(A1) + #qbasic OPEN A$ FOR INPUT AS #2 + #qbasic IF ERR()<>0 THEN ER=-1:E$="File not found":RETURN + DO_SLURP_LOOP: + C$="" + RJ=1:GOSUB READ_FILE_CHAR + #cbm IF ASC(C$)=10 THEN R$=R$+CHR$(13) + #qbasic IF ASC(C$)=10 THEN R$=R$+CHR$(10) + IF (ASC(C$)<>10) AND (C$<>"") THEN R$=R$+C$ + IF EZ>0 THEN GOTO DO_SLURP_DONE + GOTO DO_SLURP_LOOP + DO_SLURP_DONE: + CLOSE 2 + IF ER>-2 THEN RETURN + B$=R$:T=4:GOSUB STRING + RETURN + + DO_LT: + R=A1B1 + GOTO RETURN_TRUE_FALSE + DO_GTE: + R=A1>=B1 + GOTO RETURN_TRUE_FALSE + + DO_ADD: + T=2:L=A1+B1:GOSUB ALLOC + RETURN + DO_SUB: + T=2:L=A1-B1:GOSUB ALLOC + RETURN + DO_MULT: + T=2:L=A1*B1:GOSUB ALLOC + RETURN + DO_DIV: + T=2:L=A1/B1:GOSUB ALLOC + RETURN + DO_TIME_MS: + #cbm T=2:L=INT((TI-BT)*16.667):GOSUB ALLOC + #qbasic T=2:L=INT((TIMER()-BT#)*1000):GOSUB ALLOC + RETURN + + DO_LIST: + R=AR + GOTO INC_REF_R + DO_LIST_Q: + GOSUB LIST_Q + GOTO RETURN_TRUE_FALSE + DO_VECTOR: + A=AR:T=7:GOTO FORCE_SEQ_TYPE + DO_VECTOR_Q: + GOSUB TYPE_A + R=T=7 + GOTO RETURN_TRUE_FALSE + DO_HASH_MAP: + REM setup the stack for the loop + T=8:GOSUB MAP_LOOP_START + + A=AR + DO_HASH_MAP_LOOP: + IF Z%(A+1)=0 THEN GOTO DO_HASH_MAP_LOOP_DONE + + M=Z%(A+2) + N=Z%(Z%(A+1)+2) + + A=Z%(Z%(A+1)+1): REM skip two + + REM update the return sequence structure + REM do not release M and N since we are pulling them from the + REM arguments (and not creating them here) + C=0:GOSUB MAP_LOOP_UPDATE + + GOTO DO_HASH_MAP_LOOP + + DO_HASH_MAP_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + RETURN + + DO_MAP_Q: + GOSUB TYPE_A + R=T=8 + GOTO RETURN_TRUE_FALSE + DO_ASSOC: + H=A + AR=Z%(AR+1) + DO_ASSOC_LOOP: + K=Z%(AR+2) + C=Z%(Z%(AR+1)+2) + Z%(H)=Z%(H)+32 + GOSUB ASSOC1:H=R + AR=Z%(Z%(AR+1)+1) + IF AR=0 OR Z%(AR+1)=0 THEN RETURN + GOTO DO_ASSOC_LOOP + DO_GET: + IF A=0 THEN R=0:GOTO INC_REF_R + H=A:B$=S$(Z%(B+1)):GOSUB HASHMAP_GET + GOTO INC_REF_R + DO_CONTAINS: + H=A:B$=S$(Z%(B+1)):GOSUB HASHMAP_CONTAINS + GOTO RETURN_TRUE_FALSE + DO_KEYS: + T1=0 + GOTO DO_KEYS_VALS + DO_VALS: + T1=1 + DO_KEYS_VALS: + REM setup the stack for the loop + T=6:GOSUB MAP_LOOP_START + + DO_KEYS_VALS_LOOP: + IF Z%(A+1)=0 THEN GOTO DO_KEYS_VALS_LOOP_DONE + + IF T1=0 THEN M=Z%(A+2) + IF T1=1 THEN M=Z%(A+3) + + A=Z%(A+1): REM next element + + REM update the return sequence structure + REM do not release N since we are pulling it from the + REM hash-map (and not creating them here) + C=0:GOSUB MAP_LOOP_UPDATE + + GOTO DO_KEYS_VALS_LOOP + + DO_KEYS_VALS_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + RETURN + + DO_SEQUENTIAL_Q: + GOSUB TYPE_A + R=T=6 OR T=7 + GOTO RETURN_TRUE_FALSE + DO_CONS: + T=6:L=B:M=A:GOSUB ALLOC + RETURN + DO_CONCAT: + REM always a list + R=6:GOSUB INC_REF_R + GOSUB PUSH_R: REM current value + GOSUB PUSH_R: REM return value + + DO_CONCAT_LOOP: + IF AR<16 THEN GOTO DO_CONCAT_DONE: REM no more elements + + REM slice/copy current element to a list + A=Z%(AR+2) + IF A<16 THEN GOTO DO_CONCAT_LOOP_NEXT: REM skip empty elements + B=0:C=-1:GOSUB SLICE + + GOSUB PEEK_Q: REM return value + REM if this is the first element, set return element + IF Q=6 THEN Q=R:GOSUB PUT_Q:GOTO DO_CONCAT_LOOP_AGAIN + REM otherwise Q<>6, so attach current to sliced + GOSUB PEEK_Q_1 + Z%(Q+1)=R + + DO_CONCAT_LOOP_AGAIN: + REM update current to end of sliced list + Q=R6:GOSUB PUT_Q_1 + REM dec empty since no longer part of slice + AY=6:GOSUB RELEASE + DO_CONCAT_LOOP_NEXT: + REM next list element + AR=Z%(AR+1) + GOTO DO_CONCAT_LOOP + + DO_CONCAT_DONE: + GOSUB POP_R: REM pop return value + GOSUB POP_Q: REM pop current + RETURN + DO_VEC: + T=7:GOTO FORCE_SEQ_TYPE + + DO_NTH: + B=B1 + GOSUB COUNT + IF R<=B THEN R=-1:ER=-1:E$="nth: index out of range":RETURN + DO_NTH_LOOP: + IF B=0 THEN GOTO DO_NTH_DONE + B=B-1 + A=Z%(A+1) + GOTO DO_NTH_LOOP + DO_NTH_DONE: + R=Z%(A+2) + GOTO INC_REF_R + DO_FIRST: + R=0 + IF A=0 THEN GOTO INC_REF_R + IF A1<>0 THEN R=Z%(A+2) + GOTO INC_REF_R + DO_REST: + IF A=0 THEN R=6:GOTO INC_REF_R + IF A1<>0 THEN A=A1: REM get the next sequence element + T=6:GOSUB FORCE_SEQ_TYPE + RETURN + DO_EMPTY_Q: + R=A1=0 + GOTO RETURN_TRUE_FALSE + DO_COUNT: + GOSUB COUNT + T=2:L=R:GOSUB ALLOC + RETURN + DO_CONJ: + R=0 + GOTO INC_REF_R + DO_SEQ: + R=0 + GOTO INC_REF_R + + DO_WITH_META: + GOSUB TYPE_A + REM remove existing metadata first + IF T=14 THEN A=A1:GOTO DO_WITH_META + T=14:L=A:M=B:GOSUB ALLOC + RETURN + DO_META: + R=0 + GOSUB TYPE_A + IF T=14 THEN R=Z%(A+2) + GOTO INC_REF_R + DO_ATOM: + T=12:L=A:GOSUB ALLOC + RETURN + DO_ATOM_Q: + GOSUB TYPE_A + R=T=12 + GOTO RETURN_TRUE_FALSE + DO_DEREF: + R=A1 + GOTO INC_REF_R + DO_RESET_BANG: + R=B + REM release current value + REM can't use A1 here because DO_RESET_BANG is called from swap! + AY=Z%(A+1):GOSUB RELEASE + REM inc ref by 2 for atom ownership and since we are returning it + Z%(R)=Z%(R)+64 + REM update value + Z%(A+1)=R + RETURN + + DO_EVAL: + Q=E:GOSUB PUSH_Q: REM push/save environment + E=D:CALL EVAL + GOSUB POP_Q:E=Q + RETURN + + DO_READ_FILE: + A$=S$(A1) + GOSUB READ_FILE + RETURN + + REM DO_PR_MEMORY: + REM P1=ZT:P2=-1:GOSUB PR_MEMORY + REM RETURN + DO_PR_MEMORY_SUMMARY: + REM GOSUB PR_MEMORY_SUMMARY + GOSUB PR_MEMORY_SUMMARY_SMALL + R=0 + GOTO INC_REF_R + RETURN + +INIT_CORE_SET_FUNCTION: + T=9:L=A:GOSUB ALLOC: REM native function + C=R:GOSUB ENV_SET_S + A=A+1 + RETURN + +REM INIT_CORE_NS(E) +INIT_CORE_NS: + REM create the environment mapping + REM must match DO_FUNCTION mappings + + A=1 + B$="=":GOSUB INIT_CORE_SET_FUNCTION: REM A=1 + B$="throw":GOSUB INIT_CORE_SET_FUNCTION: REM A=2 + B$="nil?":GOSUB INIT_CORE_SET_FUNCTION: REM A=3 + B$="true?":GOSUB INIT_CORE_SET_FUNCTION: REM A=4 + B$="false?":GOSUB INIT_CORE_SET_FUNCTION: REM A=5 + B$="string?":GOSUB INIT_CORE_SET_FUNCTION: REM A=6 + B$="symbol":GOSUB INIT_CORE_SET_FUNCTION: REM A=7 + B$="symbol?":GOSUB INIT_CORE_SET_FUNCTION: REM A=8 + B$="keyword":GOSUB INIT_CORE_SET_FUNCTION: REM A=9 + B$="keyword?":GOSUB INIT_CORE_SET_FUNCTION: REM A=10 + B$="number?":GOSUB INIT_CORE_SET_FUNCTION: REM A=11 + B$="fn?":GOSUB INIT_CORE_SET_FUNCTION: REM A=12 + B$="macro?":GOSUB INIT_CORE_SET_FUNCTION: REM A=13 + + B$="pr-str":GOSUB INIT_CORE_SET_FUNCTION: REM A=14 + B$="str":GOSUB INIT_CORE_SET_FUNCTION: REM A=15 + B$="prn":GOSUB INIT_CORE_SET_FUNCTION: REM A=16 + B$="println":GOSUB INIT_CORE_SET_FUNCTION: REM A=17 + B$="read-string":GOSUB INIT_CORE_SET_FUNCTION: REM A=18 + B$="readline":GOSUB INIT_CORE_SET_FUNCTION: REM A=19 + B$="slurp":GOSUB INIT_CORE_SET_FUNCTION: REM A=20 + + B$="<":GOSUB INIT_CORE_SET_FUNCTION: REM A=21 + B$="<=":GOSUB INIT_CORE_SET_FUNCTION: REM A=22 + B$=">":GOSUB INIT_CORE_SET_FUNCTION: REM A=23 + B$=">=":GOSUB INIT_CORE_SET_FUNCTION: REM A=24 + B$="+":GOSUB INIT_CORE_SET_FUNCTION: REM A=25 + B$="-":GOSUB INIT_CORE_SET_FUNCTION: REM A=26 + B$="*":GOSUB INIT_CORE_SET_FUNCTION: REM A=27 + B$="/":GOSUB INIT_CORE_SET_FUNCTION: REM A=28 + B$="time-ms":GOSUB INIT_CORE_SET_FUNCTION: REM A=29 + + B$="list":GOSUB INIT_CORE_SET_FUNCTION: REM A=30 + B$="list?":GOSUB INIT_CORE_SET_FUNCTION: REM A=31 + B$="vector":GOSUB INIT_CORE_SET_FUNCTION: REM A=32 + B$="vector?":GOSUB INIT_CORE_SET_FUNCTION: REM A=33 + B$="hash-map":GOSUB INIT_CORE_SET_FUNCTION: REM A=34 + B$="map?":GOSUB INIT_CORE_SET_FUNCTION: REM A=35 + B$="assoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=36 + B$="dissoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=37 + B$="get":GOSUB INIT_CORE_SET_FUNCTION: REM A=38 + B$="contains?":GOSUB INIT_CORE_SET_FUNCTION: REM A=39 + B$="keys":GOSUB INIT_CORE_SET_FUNCTION: REM A=40 + B$="vals":GOSUB INIT_CORE_SET_FUNCTION: REM A=41 + + B$="sequential?":GOSUB INIT_CORE_SET_FUNCTION: REM A=42 + B$="cons":GOSUB INIT_CORE_SET_FUNCTION: REM A=43 + B$="concat":GOSUB INIT_CORE_SET_FUNCTION: REM A=44 + B$="nth":GOSUB INIT_CORE_SET_FUNCTION: REM A=45 + B$="first":GOSUB INIT_CORE_SET_FUNCTION: REM A=46 + B$="rest":GOSUB INIT_CORE_SET_FUNCTION: REM A=47 + B$="empty?":GOSUB INIT_CORE_SET_FUNCTION: REM A=48 + B$="count":GOSUB INIT_CORE_SET_FUNCTION: REM A=49 + + B$="conj":GOSUB INIT_CORE_SET_FUNCTION: REM A=50 + B$="seq":GOSUB INIT_CORE_SET_FUNCTION: REM A=51 + + B$="with-meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=52 + B$="meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=53 + B$="atom":GOSUB INIT_CORE_SET_FUNCTION: REM A=54 + B$="atom?":GOSUB INIT_CORE_SET_FUNCTION: REM A=55 + B$="deref":GOSUB INIT_CORE_SET_FUNCTION: REM A=56 + B$="reset!":GOSUB INIT_CORE_SET_FUNCTION: REM A=57 + + B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=58 + B$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=59 + B$="vec":GOSUB INIT_CORE_SET_FUNCTION: REM A=60 + B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=61 + + REM these are in DO_TCO_FUNCTION + A=65 + B$="apply":GOSUB INIT_CORE_SET_FUNCTION: REM A=65 + B$="map":GOSUB INIT_CORE_SET_FUNCTION: REM A=66 + B$="swap!":GOSUB INIT_CORE_SET_FUNCTION: REM A=67 + + RETURN diff --git a/impls/basic/debug.in.bas b/impls/basic/debug.in.bas new file mode 100644 index 0000000000..4d8b1ff297 --- /dev/null +++ b/impls/basic/debug.in.bas @@ -0,0 +1,220 @@ +REM CHECK_FREE_LIST() -> P2 +CHECK_FREE_LIST: + REM start and accumulator + P1=ZK + P2=0 + CHECK_FREE_LIST_LOOP: + IF P1>=ZI THEN RETURN + REM MEMORY DEBUGGING: + REM IF (Z%(P1)AND 31)<>15 THEN PRINT "corrupt free:"+STR$(P1):END + P2=P2+(Z%(P1)AND-32)/32 + P1=Z%(P1+1) + GOTO CHECK_FREE_LIST_LOOP + +PR_MEMORY_SUMMARY_SMALL: + #cbm P0=FRE(0) + + GOSUB CHECK_FREE_LIST + #cbm PRINT "Free:"+STR$(FRE(0))+", "; + PRINT "Values:"+STR$(ZI-1-P2)+", Emptys:"; + FOR P=0 TO 4 STEP 2:GOSUB PR_MEMORY_SUMMARY_SMALL_1:NEXT P + FOR P=6 TO 12 STEP 3:GOSUB PR_MEMORY_SUMMARY_SMALL_1:NEXT P + PRINT + RETURN + PR_MEMORY_SUMMARY_SMALL_1: + PRINT STR$(INT(Z%(P)/32))+","; + RETURN + +REM REM COUNT_STRINGS() -> P2 +REM COUNT_STRINGS: +REM P1=0 +REM P2=0 +REM COUNT_STRINGS_LOOP: +REM IF P1>S-1 THEN RETURN +REM IF S%(P1)>0 THEN P2=P2+1 +REM P1=P1+1 +REM GOTO COUNT_STRINGS_LOOP +REM +REM PR_MEMORY_SUMMARY: +REM #cbm P0=FRE(0) +REM +REM PRINT +REM #cbm PRINT "Free (FRE) :"+STR$(P0) +REM GOSUB CHECK_FREE_LIST: REM get count in P2 +REM PRINT "Values (Z%) :"+STR$(ZI-1-P2)+" /"+STR$(Z1) +REM REM PRINT " max:"+STR$(ZI-1); +REM REM PRINT ", freed:"+STR$(P2)+", after repl_env:"+STR$(ZT) +REM GOSUB COUNT_STRINGS +REM PRINT "Strings (S$) :"+STR$(P2)+" /"+STR$(Z2) +REM #qbasic PRINT "Stack (X%) :"+STR$(X+1)+" /"+STR$(Z3) +REM #cbm PRINT "Stack :"+STR$(X+2-Z3)+" / 1920" +REM RETURN +REM +REM #cbm PR_MEMORY_MAP: +REM #cbm PRINT +REM #cbm P1=PEEK(43)+PEEK(44)*256 +REM #cbm P2=PEEK(45)+PEEK(46)*256 +REM #cbm P3=PEEK(47)+PEEK(48)*256 +REM #cbm P4=PEEK(49)+PEEK(50)*256 +REM #cbm P5=PEEK(51)+PEEK(52)*256 +REM #cbm P6=PEEK(53)+PEEK(54)*256 +REM #cbm P7=PEEK(55)+PEEK(56)*256 +REM #cbm PRINT "BASIC beg. :"STR$(P1) +REM #cbm PRINT "Variable beg.:"STR$(P2) +REM #cbm PRINT "Array beg. :"STR$(P3) +REM #cbm PRINT "Array end :"STR$(P4) +REM #cbm PRINT "String beg. :"STR$(P5) +REM #cbm PRINT "String cur. :"STR$(P6) +REM #cbm PRINT "BASIC end :"STR$(P7) +REM #cbm PRINT +REM #cbm PRINT "Program Code :"STR$(P2-P1) +REM #cbm PRINT "Variables :"STR$(P3-P2) +REM #cbm PRINT "Arrays :"STR$(P4-P3) +REM #cbm PRINT "String Heap :"STR$(P7-P5) +REM #cbm RETURN +REM +REM REM PR_MEMORY_VALUE(I) -> J: +REM REM - I is memory value to print +REM REM - I is returned as last byte of value printed +REM REM - J is returned as type +REM PR_MEMORY_VALUE: +REM J=Z%(I)AND 31 +REM P3=Z%(I+1) +REM PRINT " "+STR$(I)+": type:"+STR$(J); +REM IF J<>15 THEN PRINT ", refs:"+STR$((Z%(I)-J)/32); +REM IF J=15 THEN PRINT ", size:"+STR$((Z%(I)AND-32)/32); +REM PRINT ", ["+STR$(Z%(I));+" |"+STR$(P3); +REM IF J<6 OR J=9 OR J=12 OR J=15 THEN PRINT " | --- | --- ]";:GOTO PR_MEM_SKIP +REM PRINT " |"+STR$(Z%(I+2)); +REM IF J=6 OR J=7 OR J=13 OR J=14 THEN PRINT " | --- ]";:GOTO PR_MEM_SKIP +REM PRINT " |"+STR$(Z%(I+3))+" ]"; +REM PR_MEM_SKIP: +REM PRINT " >> "; +REM ON J+1 GOTO PR_ENTRY_NIL,PR_ENTRY_BOOL,PR_ENTRY_INT,PR_ENTRY_FLOAT,PR_ENTRY_STR,PR_ENTRY_SYM,PR_ENTRY_LIST,PR_ENTRY_VECTOR,PR_ENTRY_HASH_MAP,PR_ENTRY_FN,PR_ENTRY_MALFN,PR_ENTRY_MAC,PR_ENTRY_ATOM,PR_ENTRY_ENV,PR_ENTRY_META,PR_ENTRY_FREE +REM PRINT "Unknown type:"+STR$(J):END +REM +REM PR_ENTRY_NIL: +REM PRINT "nil" +REM I=I+1 +REM RETURN +REM PR_ENTRY_BOOL: +REM IF P3=0 THEN PRINT "false" +REM IF P3=1 THEN PRINT "true" +REM I=I+1 +REM RETURN +REM PR_ENTRY_INT: +REM PR_ENTRY_FLOAT: +REM PRINT STR$(P3) +REM I=I+1 +REM RETURN +REM PR_ENTRY_STR: +REM PRINT "'"+S$(P3)+"'" +REM I=I+1 +REM RETURN +REM PR_ENTRY_SYM: +REM PRINT S$(P3) +REM I=I+1 +REM RETURN +REM PR_ENTRY_LIST: +REM I=I+2 +REM IF I<16 THEN PRINT "()":RETURN +REM PRINT "(..."+STR$(Z%(I))+" ...)" +REM RETURN +REM PR_ENTRY_VECTOR: +REM I=I+2 +REM IF I<16 THEN PRINT "[]":RETURN +REM PRINT "[..."+STR$(Z%(I))+" ...]" +REM RETURN +REM PR_ENTRY_HASH_MAP: +REM I=I+3 +REM IF I<16 THEN PRINT "{}":RETURN +REM IF J=8 THEN PRINT "{... key:"+STR$(Z%(I-1))+", val:"+STR$(Z%(I))+" ...}" +REM RETURN +REM PR_ENTRY_FN: +REM PRINT "#" +REM I=I+1 +REM RETURN +REM PR_ENTRY_MALFN: +REM PR_ENTRY_MAC: +REM IF I=11 THEN PRINT "MACRO "; +REM PRINT "(fn* param:"+STR$(Z%(I))+", env:"+STR$(Z%(I+1))+")" +REM I=I+3 +REM RETURN +REM PR_ENTRY_ATOM: +REM PRINT "(atom val:"+STR$(P3)+")" +REM I=I+1 +REM RETURN +REM PR_ENTRY_ENV: +REM PRINT "#" +REM I=I+2 +REM RETURN +REM PR_ENTRY_META: +REM PRINT "#" +REM I=I+2 +REM RETURN +REM PR_ENTRY_FREE: +REM PRINT "FREE next:"+STR$(P3); +REM IF I=ZK THEN PRINT " (free list start)"; +REM PRINT +REM I=I-1+(Z%(I)AND-32)/32 +REM RETURN +REM +REM REM PR_OBJECT(P1) -> nil +REM PR_OBJECT: +REM RD=0 +REM +REM IF P1=-1 THEN PRINT " "+STR$(-1)+": ---":RETURN +REM RD=RD+1 +REM Q=P1:GOSUB PUSH_Q +REM +REM PR_OBJ_LOOP: +REM IF RD=0 THEN RETURN +REM RD=RD-1 +REM +REM GOSUB PEEK_Q:I=Q +REM REM IF I<15 THEN GOSUB POP_Q:GOTO PR_OBJ_LOOP +REM GOSUB PR_MEMORY_VALUE +REM REM J holds type now +REM GOSUB POP_Q:I=Q +REM +REM IF J<6 OR J=9 THEN GOTO PR_OBJ_LOOP: REM no contained references +REM REM reference in first position +REM IF Z%(I+1)<>0 THEN RD=RD+1:Q=Z%(I+1):GOSUB PUSH_Q +REM IF J=12 OR J=15 THEN PR_OBJ_LOOP: REM no more reference +REM REM reference in second position +REM IF Z%(I+2)<>0 THEN RD=RD+1:Q=Z%(I+2):GOSUB PUSH_Q +REM IF J=6 OR J=7 OR J=13 OR J=14 THEN PR_OBJ_LOOP: REM no more references +REM IF Z%(I+3)<>0 THEN RD=RD+1:Q=Z%(I+3):GOSUB PUSH_Q +REM GOTO PR_OBJ_LOOP +REM +REM REM PR_MEMORY(P1, P2) -> nil +REM PR_MEMORY: +REM IF P2"+STR$(P2); +REM PRINT " (ZI: "+STR$(ZI)+", ZK: "+STR$(ZK)+"):" +REM IF P2P2 THEN GOTO PR_MEMORY_AFTER_VALUES +REM GOSUB PR_MEMORY_VALUE +REM I=I+1 +REM GOTO PR_MEMORY_VALUE_LOOP +REM PR_MEMORY_AFTER_VALUES: +REM PRINT "S$ String Memory (S: "+STR$(S)+"):" +REM IF S<=0 THEN PRINT " ---":GOTO PR_MEMORY_SKIP_STRINGS +REM FOR I=0 TO S-1 +REM PRINT " "+STR$(I)+": '"+S$(I)+"'" +REM NEXT I +REM PR_MEMORY_SKIP_STRINGS: +REM PRINT "X% Stack Memory (X: "+STR$(X)+"):" +REM #cbm IF X R +ENV_NEW: + REM allocate the data hashmap + GOSUB HASHMAP + AY=R + + REM set the outer and data pointer + T=13:L=R:M=C:GOSUB ALLOC + GOSUB RELEASE: REM environment takes ownership + RETURN + +REM see RELEASE types.in.bas for environment cleanup + +REM ENV_NEW_BINDS(C, A, B) -> R +ENV_NEW_BINDS: + GOSUB ENV_NEW + E=R + REM process bindings + ENV_NEW_BINDS_LOOP: + IF Z%(A+1)=0 THEN R=E:RETURN + REM get/deref the key from A + K=Z%(A+2) + + IF S$(Z%(K+1))="&" THEN GOTO EVAL_NEW_BINDS_VARGS + + EVAL_NEW_BINDS_1x1: + REM get/deref the key from B + C=Z%(B+2) + REM set the binding in the environment data + GOSUB ENV_SET + REM go to next element of A and B + A=Z%(A+1) + B=Z%(B+1) + GOTO ENV_NEW_BINDS_LOOP + + EVAL_NEW_BINDS_VARGS: + REM get/deref the key from next element of A + A=Z%(A+1) + K=Z%(A+2) + REM the value is the remaining list in B + A=B:T=6:GOSUB FORCE_SEQ_TYPE + C=R + REM set the binding in the environment data + GOSUB ENV_SET + R=E + AY=C:GOSUB RELEASE: REM list is owned by environment + RETURN + +REM ENV_SET(E, K, C) -> R +ENV_SET: + H=Z%(E+1) + GOSUB ASSOC1 + Z%(E+1)=R + R=C + RETURN + +REM ENV_SET_S(E, B$, C) -> R +ENV_SET_S: + H=Z%(E+1) + GOSUB ASSOC1_S + Z%(E+1)=R + R=C + RETURN + +REM ENV_GET(E, B$) -> R +REM - R3=1 if the key was found, else 0 +SUB ENV_GET + T=E + ENV_FIND_LOOP: + H=Z%(T+1) + REM More efficient to use GET for value (R) and contains? (R3) + GOSUB HASHMAP_GET + REM if we found it, return it + IF R3=1 THEN GOTO ENV_FIND_DONE + T=Z%(T+2): REM get outer environment + IF T>0 THEN GOTO ENV_FIND_LOOP + ENV_FIND_DONE: +END SUB diff --git a/impls/basic/mem.in.bas b/impls/basic/mem.in.bas new file mode 100644 index 0000000000..266a1aec59 --- /dev/null +++ b/impls/basic/mem.in.bas @@ -0,0 +1,391 @@ +REM Memory layout: +REM +REM type bytes +REM ---------- ---------- +REM nil ref/ 0 | 0 | | +REM false ref/ 1 | 0 | | +REM true ref/ 1 | 1 | | +REM integer ref/ 2 | int | | +REM float ref/ 3 | ??? | | +REM string/kw ref/ 4 | S$ idx | | +REM symbol ref/ 5 | S$ idx | | +REM list ref/ 6 | next Z% idx | val Z% idx | +REM vector ref/ 7 | next Z% idx | val Z% idx | +REM hashmap ref/ 8 | next Z% idx | key Z% idx | val Z% idx +REM function ref/ 9 | fn idx | | +REM mal function ref/10 | body Z% idx | param Z% idx | env Z% idx +REM macro fn ref/11 | body Z% idx | param Z% idx | env Z% idx +REM atom ref/12 | val Z% idx | | +REM environment ref/13 | hmap Z% idx | outer Z% idx | +REM metadata ref/14 | obj Z% idx | meta Z% idx | +REM FREE sz/15 | next Z% idx | | +REM +REM Locations 0-15 are for constant/persistent values: +REM 0: nil +REM 2: false +REM 4: true +REM 6: empty list +REM 9: empty vector +REM 12: empty hash-map + +REM Note: DIM_MEMORY for C64 BASIC and the INIT_MEMORY function are at +REM end of this file for efficiency on C64. The most commonly used +REM function should be at the top since C64 BASIC scans line numbers +REM for every GOTO/GOSUB. On the other hand, QBasic requires that +REM arrays are dimensioned at the top of the file, not just as the +REM first operation on that array so DIM_MEMORY for QBasic is here at +REM the top. + +#qbasic DIM_MEMORY: +#qbasic T=0 +#qbasic +#qbasic Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each) +#qbasic Z2=199: REM S$/S% (string memory) size (3+2 bytes each) +#qbasic Z3=200: REM X% (call stack) size (2 bytes each) +#qbasic Z4=64: REM Y% (release stack) size (4 bytes each) +#qbasic +#qbasic REM boxed element memory +#qbasic DIM Z%(Z1): REM TYPE ARRAY +#qbasic +#qbasic REM string memory storage +#qbasic S=0:DIM S$(Z2):DIM S%(Z2) +#qbasic +#qbasic REM call/logic stack +#qbasic X=-1:DIM X%(Z3): REM stack of Z% indexes +#qbasic +#qbasic REM pending release stack +#qbasic Y=-1:DIM Y%(Z4,1): REM stack of Z% indexes and level/LV values +#qbasic +#qbasic RETURN + +REM stack functions + +#qbasic PUSH_A: +#qbasic X=X+1:X%(X)=A:RETURN +#qbasic POP_A: +#qbasic A=X%(X):X=X-1:RETURN +#qbasic +#qbasic PUSH_R: +#qbasic X=X+1:X%(X)=R:RETURN +#qbasic POP_R: +#qbasic R=X%(X):X=X-1:RETURN +#qbasic +#qbasic PUSH_Q: +#qbasic X=X+1:X%(X)=Q:RETURN +#qbasic POP_Q: +#qbasic Q=X%(X):X=X-1:RETURN +#qbasic PEEK_Q: +#qbasic Q=X%(X):RETURN +#qbasic PEEK_Q_1: +#qbasic Q=X%(X-1):RETURN +#qbasic PEEK_Q_2: +#qbasic Q=X%(X-2):RETURN +#qbasic PEEK_Q_Q: +#qbasic Q=X%(X-Q):RETURN +#qbasic PUT_Q: +#qbasic X%(X)=Q:RETURN +#qbasic PUT_Q_1: +#qbasic X%(X-1)=Q:RETURN +#qbasic PUT_Q_2: +#qbasic X%(X-2)=Q:RETURN + +#cbm PUSH_A: +#cbm X=X+2:POKE X,A AND255:POKE X+1,A/256:RETURN +#cbm POP_A: +#cbm A=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN +#cbm +#cbm PUSH_R: +#cbm X=X+2:POKE X,R AND255:POKE X+1,R/256:RETURN +#cbm POP_R: +#cbm R=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN +#cbm +#cbm PUSH_Q: +#cbm X=X+2:POKE X,Q AND255:POKE X+1,Q/256:RETURN +#cbm POP_Q: +#cbm Q=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN +#cbm PEEK_Q: +#cbm Q=PEEK(X)+PEEK(X+1)*256:RETURN +#cbm PEEK_Q_1: +#cbm Q=PEEK(X-2)+PEEK(X-1)*256:RETURN +#cbm PEEK_Q_2: +#cbm Q=PEEK(X-4)+PEEK(X-3)*256:RETURN +#cbm PEEK_Q_Q: +#cbm Q=PEEK(X-Q*2)+PEEK(X-Q*2+1)*256:RETURN +#cbm PUT_Q: +#cbm POKE X,Q AND255:POKE X+1,Q/256:RETURN +#cbm PUT_Q_1: +#cbm POKE X-2,Q AND255:POKE X-1,Q/256:RETURN +#cbm PUT_Q_2: +#cbm POKE X-4,Q AND255:POKE X-3,Q/256:RETURN + +REM memory functions + +REM ALLOC(T,L) -> R +REM ALLOC(T,L,M) -> R +REM ALLOC(T,L,M,N) -> R +REM L is value for Z%(R+1) +REM M is value for Z%(R+2), if SZ>2 +REM N is value for Z%(R+3), if SZ>3 +ALLOC: + SZ=3 + IF T<6 OR T=9 OR T=12 THEN SZ=2 + IF T=8 OR T=10 OR T=11 THEN SZ=4 + REM PRINT "ALLOC T: "+STR$(T)+", SZ: "+STR$(SZ)+", ZK: "+STR$(ZK) + U=ZK + R=ZK + ALLOC_LOOP: + IF R=ZI THEN GOTO ALLOC_UNUSED + REM TODO sanity check that type is 15 + IF ((Z%(R)AND-32)/32)=SZ THEN GOTO ALLOC_MIDDLE + REM PRINT "ALLOC search: U: "+STR$(U)+", R: "+STR$(R) + U=R: REM previous set to current + R=Z%(R+1): REM current set to next + GOTO ALLOC_LOOP + ALLOC_MIDDLE: + REM PRINT "ALLOC_MIDDLE: U: "+STR$(U)+", R: "+STR$(R) + REM set free pointer (ZK) to next free + IF R=ZK THEN ZK=Z%(R+1) + REM set previous free to next free + IF R<>ZK THEN Z%(U+1)=Z%(R+1) + GOTO ALLOC_DONE + ALLOC_UNUSED: + REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U: "+STR$(U)+", R: "+STR$(R) + IF R+SZ>Z1 THEN GOSUB PR_MEMORY_SUMMARY_SMALL:PRINT "Out of mal memory!":END + ZI=ZI+SZ + IF U=R THEN ZK=ZI + REM set previous free to new memory top + IF U<>R THEN Z%(U+1)=ZI + GOTO ALLOC_DONE + ALLOC_DONE: + Z%(R)=T+32 + REM set Z%(R+1) to default L + Z%(R+1)=L + IF T>5 AND T<>9 THEN Z%(L)=Z%(L)+32: REM value is a Z% idx + IF SZ>2 THEN Z%(M)=Z%(M)+32:Z%(R+2)=M + IF SZ>3 THEN Z%(N)=Z%(N)+32:Z%(R+3)=N + + RETURN + +REM FREE(AY, SZ) -> nil +FREE: + REM assumes reference count cleanup already (see RELEASE) + Z%(AY)=(SZ*32)+15: REM set type(15) and size + Z%(AY+1)=ZK + ZK=AY + IF SZ>=3 THEN Z%(AY+2)=0 + IF SZ=4 THEN Z%(AY+3)=0 + REM TODO: fail if SZ>4 + RETURN + + +REM RELEASE(AY) -> nil +REM R should not be affected by this call +RELEASE: + RC=0 + + GOTO RELEASE_ONE + + RELEASE_TOP: + + IF RC=0 THEN RETURN + + REM pop next object to release, decrease remaining count + GOSUB POP_Q:AY=Q + RC=RC-1 + + RELEASE_ONE: + IF AY=-1 THEN RETURN + + U=Z%(AY)AND 31: REM type + V=Z%(AY+1): REM main value/reference + + REM set the size + REM TODO: share with ALLOC calculation + SZ=3 + IF U<6 OR U=9 OR U=12 THEN SZ=2 + IF U=8 OR U=10 OR U=11 THEN SZ=4 + + REM AZ=AY: B=1: GOSUB PR_STR + REM PRINT "RELEASE AY:"+STR$(AY)+" ["+R$+"] (byte0:"+STR$(Z%(AY))+", SZ:"+STR$(SZ)+")" + + REM sanity check not already freed + REM MEMORY DEBUGGING: + REM IF U=15 THEN PRINT "RELEASE of free:"+STR$(AY):END + REM IF Z%(AY)<15 THEN PRINT "RELEASE of unowned:"+STR$(AY):END + + REM decrease reference count by one + Z%(AY)=Z%(AY)-32 + + REM nil, false, true, empty sequences + REM MEMORY DEBUGGING: + REM IF AY<16 AND Z%(AY)<32 THEN PRINT "RELEASE of empty:"+STR$(AY):END + IF AY<16 THEN GOTO RELEASE_TOP + + REM our reference count is not 0, so don't release + IF Z%(AY)>=32 GOTO RELEASE_TOP + + REM switch on type + ON U+1 GOSUB RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_STRING,RELEASE_STRING,RELEASE_SEQ,RELEASE_SEQ,RELEASE_HASH_MAP,RELEASE_SIMPLE,RELEASE_MAL_FUNCTION,RELEASE_MAL_FUNCTION,RELEASE_ATOM,RELEASE_ENV,RELEASE_METADATA + + REM free the current element and continue, SZ already set + GOSUB FREE + GOTO RELEASE_TOP + + RELEASE_SIMPLE: + RETURN + RELEASE_STRING: + REM string type, release interned string, then FREE reference + REM MEMORY DEBUGGING: + REM IF S%(V)=0 THEN PRINT "RELEASE of free string:"+STR$(S%(V)):END + S%(V)=S%(V)-1 + IF S%(V)=0 THEN S$(V)="": REM free BASIC string + REM free the atom itself + RETURN + RELEASE_SEQ: + IF V=0 THEN RETURN + REM add value and next element to stack + RC=RC+2 + Q=Z%(AY+2):GOSUB PUSH_Q + Q=V:GOSUB PUSH_Q + RETURN + RELEASE_HASH_MAP: + IF V=0 THEN RETURN + REM add key, value and next element to stack + RC=RC+3 + Q=Z%(AY+2):GOSUB PUSH_Q + Q=Z%(AY+3):GOSUB PUSH_Q + Q=V:GOSUB PUSH_Q + RETURN + RELEASE_ATOM: + REM add contained/referred value + RC=RC+1 + Q=V:GOSUB PUSH_Q + REM free the atom itself + RETURN + RELEASE_MAL_FUNCTION: + REM add ast, params and environment to stack + RC=RC+3 + Q=V:GOSUB PUSH_Q + Q=Z%(AY+2):GOSUB PUSH_Q + Q=Z%(AY+3):GOSUB PUSH_Q + REM free the current 3 element mal_function + RETURN + RELEASE_ENV: + REM add the hashmap data to the stack + RC=RC+1 + Q=V:GOSUB PUSH_Q + REM if outer set, add outer env to stack + IF Z%(AY+2)<>0 THEN RC=RC+1:Q=Z%(AY+2):GOSUB PUSH_Q + RETURN + RELEASE_METADATA: + REM add object and metadata object + RC=RC+2 + Q=V:GOSUB PUSH_Q + Q=Z%(AY+2):GOSUB PUSH_Q + RETURN + + +REM INC_REF_R(R) -> R +REM - return R with 1 ref cnt increase +REM - call with GOTO to return at caller callsite +REM - call with GOSUB to return to caller +INC_REF_R: + Z%(R)=Z%(R)+32 + RETURN + +REM RETURN_TRUE_FALSE(R) -> R +REM - take BASIC true/false R, return mal true/false R with ref cnt +REM - called with GOTO as a return RETURN +RETURN_TRUE_FALSE: + IF R THEN R=4 + IF R=0 THEN R=2 + GOTO INC_REF_R + + +REM release stack functions + +#qbasic PEND_A_LV: +#qbasic Y=Y+1:Y%(Y,0)=A:Y%(Y,1)=LV:RETURN +#qbasic +#qbasic REM RELEASE_PEND(LV) -> nil +#qbasic RELEASE_PEND: +#qbasic IF Y<0 THEN RETURN +#qbasic IF Y%(Y,1)<=LV THEN RETURN +#qbasic REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0)) +#qbasic AY=Y%(Y,0):GOSUB RELEASE +#qbasic Y=Y-1 +#qbasic GOTO RELEASE_PEND + +#cbm PEND_A_LV: +#cbm Y=Y+4:POKE Y,A AND255:POKE Y+1,A/256 +#cbm POKE Y+2,LV AND255:POKE Y+3,LV/256:RETURN +#cbm +#cbm REM RELEASE_PEND(LV) -> nil +#cbm RELEASE_PEND: +#cbm IF Y=0 : pointer to error object + ER=-2 + E$="" + + REM Predefine nil, false, true, and an empty sequences + FOR I=0 TO 15:Z%(I)=0:NEXT I + Z%(0)=32: REM nil + Z%(2)=1+32: REM false + Z%(4)=1+32:Z%(5)=1: REM true + Z%(6)=6+32: REM emtpy list + Z%(9)=7+32: REM empty vector + Z%(12)=8+32: REM empty hash-map + + REM start of unused memory + ZI=16 + + REM start of free list + ZK=16 + + REM start of time clock + #cbm BT=TI + #qbasic BT#=TIMER() + + RETURN + + diff --git a/impls/basic/printer.in.bas b/impls/basic/printer.in.bas new file mode 100644 index 0000000000..55c6360b47 --- /dev/null +++ b/impls/basic/printer.in.bas @@ -0,0 +1,116 @@ +REM PR_STR(AZ, B) -> R$ +PR_STR: + R$="" + PR_STR_RECUR: + T=Z%(AZ)AND 31 + U=Z%(AZ+1) + REM PRINT "AZ: "+STR$(AZ)+", T: "+STR$(T)+", U: "+STR$(U) + IF T=0 THEN R$="nil":RETURN + REM if metadata, then get actual object + IF T>=14 THEN AZ=U:GOTO PR_STR_RECUR + ON T GOTO PR_BOOLEAN,PR_INTEGER,PR_UNKNOWN,PR_STRING_MAYBE,PR_SYMBOL,PR_SEQ,PR_SEQ,PR_SEQ,PR_FUNCTION,PR_MAL_FUNCTION,PR_MAL_FUNCTION,PR_ATOM,PR_ENV,PR_RECUR,PR_FREE + + PR_UNKNOWN: + REM MEMORY DEBUGGING: + REM R$="#" + RETURN + PR_RECUR: + AZ=U + GOTO PR_STR_RECUR + PR_BOOLEAN: + R$="true" + IF U=0 THEN R$="false" + RETURN + PR_INTEGER: + T$=STR$(U) + REM Remove initial space + IF U>=0 THEN T$=RIGHT$(T$,LEN(T$)-1) + R$=R$+T$ + RETURN + PR_STRING_MAYBE: + R$=S$(U) + IF LEN(R$)=0 THEN GOTO PR_STRING + IF MID$(R$,1,1)=CHR$(127) THEN R$=":"+MID$(R$,2,LEN(R$)-1):RETURN + PR_STRING: + IF B=1 THEN GOTO PR_STRING_READABLY + RETURN + PR_STRING_READABLY: + S1$="\":S2$="\\":GOSUB REPLACE: REM escape backslash " + S1$=CHR$(34):S2$="\"+CHR$(34):GOSUB REPLACE: REM escape quotes " + #cbm S1$=CHR$(13):S2$="\n":GOSUB REPLACE: REM escape newlines + #qbasic S1$=CHR$(10):S2$="\n":GOSUB REPLACE: REM escape newlines + R$=CHR$(34)+R$+CHR$(34) + RETURN + PR_SYMBOL: + R$=S$(U) + RETURN + PR_SEQ: + REM push the type and where we are in the sequence + Q=T:GOSUB PUSH_Q + Q=AZ:GOSUB PUSH_Q + REM save the current rendered string + S$(S)=R$:S=S+1 + PR_SEQ_LOOP: + IF Z%(AZ+1)=0 THEN GOTO PR_SEQ_DONE + AZ=Z%(AZ+2):GOSUB PR_STR:GOSUB PEEK_Q_1:T=Q + REM append what we just rendered it + S$(S-1)=S$(S-1)+R$ + + REM if this is a hash-map, print the next element + IF T=8 THEN GOSUB PEEK_Q:AZ=Z%(Q+3):GOSUB PR_STR:S$(S-1)=S$(S-1)+" "+R$ + + REM restore current seq type + GOSUB PEEK_Q_1:T=Q + REM Go to next list element + GOSUB PEEK_Q + AZ=Z%(Q+1) + Q=AZ:GOSUB PUT_Q + IF Z%(AZ+1)<>0 THEN S$(S-1)=S$(S-1)+" " + GOTO PR_SEQ_LOOP + PR_SEQ_DONE: + REM restore the current string + S=S-1:R$=S$(S) + REM pop where we are the sequence and type + GOSUB POP_Q + GOSUB POP_Q:T=Q: REM get type + IF T=6 THEN R$="("+R$+")" + IF T=7 THEN R$="["+R$+"]" + IF T=8 THEN R$="{"+R$+"}" + RETURN + PR_FUNCTION: + R$="#" + RETURN + PR_MAL_FUNCTION: + T1=AZ + AZ=Z%(T1+2):GOSUB PR_STR + REM append what we just rendered it + S$(S)="(fn* "+R$:S=S+1 + AZ=Z%(T1+1):GOSUB PR_STR + S=S-1 + R$=S$(S)+" "+R$+")" + RETURN + PR_ATOM: + AZ=U:GOSUB PR_STR + R$="(atom "+R$+")" + RETURN + PR_ENV: + R$="#" + RETURN + PR_FREE: + R$="#" + RETURN + +REM PR_STR_SEQ(AZ, B, B$) -> R$ +REM - B is print_readably +REM - B$ is the separator +PR_STR_SEQ: + V=AZ + S$(S)="":S=S+1 + PR_STR_SEQ_LOOP: + IF Z%(V+1)=0 THEN S=S-1:R$=S$(S):RETURN + AZ=Z%(V+2):GOSUB PR_STR + REM goto the next sequence element + V=Z%(V+1) + IF Z%(V+1)=0 THEN S$(S-1)=S$(S-1)+R$ + IF Z%(V+1)<>0 THEN S$(S-1)=S$(S-1)+R$+B$ + GOTO PR_STR_SEQ_LOOP diff --git a/impls/basic/reader.in.bas b/impls/basic/reader.in.bas new file mode 100644 index 0000000000..d8dc46298a --- /dev/null +++ b/impls/basic/reader.in.bas @@ -0,0 +1,276 @@ +REM READ_TOKEN(RF=0, A$, RI) -> T$ +REM READ_TOKEN(RF=1) -> T$ +READ_TOKEN: + IF RF=1 THEN RF=2:T$="(":RETURN + IF RF=2 THEN RF=3:T$="do":RETURN + GOSUB SKIP_SPACES + REM PRINT "READ_TOKEN: "+STR$(RI)+", "+MID$(A$,RI,1) + GOSUB READ_CHAR + IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_TOKEN + T$=C$ + IF T$="(" OR T$=")" OR T$="[" OR T$="]" OR T$="{" OR T$="}" OR T$="'" OR T$="`" OR T$="@" THEN RETURN + IF T$="^" THEN RETURN + GOSUB PEEK_CHAR: REM peek at next character + IF T$="~" AND C$<>"@" THEN RETURN + S1=0:S2=0: REM S1: INSTRING?, S2: ESCAPED? + IF T$=CHR$(34) THEN S1=1 + READ_TOKEN_LOOP: + GOSUB PEEK_CHAR: REM peek at next character + IF C$="" THEN RETURN + IF S1 THEN GOTO READ_TOKEN_CONT + IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN + IF C$="(" OR C$=")" OR C$="[" OR C$="]" OR C$="{" OR C$="}" THEN RETURN + READ_TOKEN_CONT: + GOSUB READ_CHAR + T$=T$+C$ + IF T$="~@" THEN RETURN + IF S1=0 OR S2=1 THEN S2=0:GOTO READ_TOKEN_LOOP + REM S1=1 (INSTRING?) and S2=0 (not ESCAPED?) + IF C$=CHR$(92) THEN S2=1 + IF C$=CHR$(34) THEN RETURN + GOTO READ_TOKEN_LOOP + + +REM READ_CHAR(A$, RI) -> C$ +READ_CHAR: + RJ=1:GOSUB DO_READ_CHAR + RETURN + +REM PEEK_CHAR(A$, RI) -> C$ +PEEK_CHAR: + RJ=0:GOSUB DO_READ_CHAR + RETURN + +REM DO_READ_CHAR(RJ, A$, RI): +REM - RI is position in A$ +REM - RJ=1 is read, RJ=0 is peek +DO_READ_CHAR: + C$="" + IF RF>0 THEN GOTO READ_FILE_CHAR + IF RI<=LEN(A$) THEN C$=MID$(A$,RI,1):RI=RI+RJ + RETURN + +REM READ_FILE_CHAR(RJ) -> C$ +REM - RJ=1 is read, RJ=0 is peek +REM - D$ is global used for already read pending character +REM - EZ is global used for end of file state +READ_FILE_CHAR: + IF D$<>"" THEN C$=D$:IF RJ=0 THEN RETURN + IF D$<>"" AND RJ=1 THEN D$="":RETURN + D$="" + IF EZ>2 THEN C$="" + IF EZ=2 THEN C$=")" + IF EZ=1 THEN C$=CHR$(10) + IF EZ>0 THEN EZ=EZ+RJ:RETURN + #cbm GET#2,C$ + #qbasic C$=INPUT$(1,2) + #qbasic IF EOF(2) THEN EZ=1:RETURN + IF RJ=0 THEN D$=C$ + #cbm IF (ST AND 64) THEN EZ=1:RETURN + #cbm IF (ST AND 255) THEN EZ=1:ER=-1:E$="File read error"+STR$(ST) + RETURN + +SKIP_SPACES: + GOSUB PEEK_CHAR: REM peek at next character + IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN GOSUB READ_CHAR:GOTO SKIP_SPACES + RETURN + +SKIP_TO_EOL: + GOSUB READ_CHAR + IF C$="" OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN + GOTO SKIP_TO_EOL + + +REM READ_FORM(A$, RI, RF) -> R +SUB READ_FORM + Q=T:GOSUB PUSH_Q: REM save current value of T + READ_FORM_RECUR: + IF ER<>-2 THEN GOTO READ_FORM_RETURN + GOSUB READ_TOKEN + REM PRINT "READ_FORM T$: ["+T$+"]" + IF T$="" THEN R=0:GOSUB INC_REF_R:GOTO READ_FORM_RETURN + IF T$="nil" THEN T=0:GOTO READ_NIL_BOOL + IF T$="false" THEN T=1:GOTO READ_NIL_BOOL + IF T$="true" THEN T=2:GOTO READ_NIL_BOOL + IF T$="'" THEN B$="quote":GOTO READ_MACRO + IF T$="`" THEN B$="quasiquote":GOTO READ_MACRO + IF T$="~" THEN B$="unquote":GOTO READ_MACRO + IF T$="~@" THEN B$="splice-unquote":GOTO READ_MACRO + IF T$="^" THEN B$="with-meta":GOTO READ_MACRO + IF T$="@" THEN B$="deref":GOTO READ_MACRO + C$=MID$(T$,1,1) + REM PRINT "C$: ["+C$+"]("+STR$(ASC(C$))+")" + IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER + IF C$="-" THEN GOTO READ_SYMBOL_MAYBE + + IF C$=CHR$(34) THEN GOTO READ_STRING + IF C$=":" THEN GOTO READ_KEYWORD + REM set end character in Q and read the sequence + IF C$="(" THEN T=6:Q=41:GOTO READ_SEQ_START: REM ")" + IF C$="[" THEN T=7:Q=93:GOTO READ_SEQ_START: REM "]" + IF C$="{" THEN T=8:Q=125:GOTO READ_SEQ_START: REM "}" + IF C$=")" OR C$="]" OR C$="}" THEN R=-1:ER=-1:E$="unexpected "+C$:GOTO READ_FORM_RETURN + GOTO READ_SYMBOL + + READ_NIL_BOOL: + REM PRINT "READ_NIL_BOOL" + R=T*2 + GOSUB INC_REF_R + GOTO READ_FORM_RETURN + READ_NUMBER: + REM PRINT "READ_NUMBER" + T=2:L=VAL(T$):GOSUB ALLOC + GOTO READ_FORM_RETURN + READ_MACRO: + REM push macro type + Q=-1*(T$="^"):GOSUB PUSH_Q + + REM B$ is set above + T=5:GOSUB STRING + REM push string + GOSUB PUSH_R + + CALL READ_FORM + REM push first form + GOSUB PUSH_R + IF ER>-2 THEN GOTO READ_MACRO_DONE + + GOSUB PEEK_Q_2 + IF Q THEN GOTO READ_MACRO_3 + + READ_MACRO_2: + GOSUB PEEK_Q_1:B=Q + GOSUB PEEK_Q:A=Q + GOSUB LIST2 + GOTO READ_MACRO_DONE + + READ_MACRO_3: + CALL READ_FORM + GOSUB PEEK_Q_1:C=Q + B=R + GOSUB PEEK_Q:A=Q + GOSUB LIST3 + AY=C:GOSUB RELEASE + + READ_MACRO_DONE: + REM release values, list has ownership + AY=B:GOSUB RELEASE + AY=A:GOSUB RELEASE + + REM pop the stack + GOSUB POP_Q: REM pop first form + GOSUB POP_Q: REM pop string + GOSUB POP_Q: REM pop macro type + T$="": REM necessary to prevent unexpected EOF errors + GOTO READ_FORM_RETURN + + READ_STRING: + REM PRINT "READ_STRING" + C=ASC(MID$(T$,LEN(T$),1)) + IF C<>34 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"', got EOF":GOTO READ_FORM_RETURN + J=2:R$="" + READ_STRING_LOOP: + #qbasic I=INSTR(J,T$,CHR$(92)) + #cbm I=J + #cbm INSTR_LOOP: + #cbm IF I>LEN(T$) THEN I=0:GOTO INSTR_DONE + #cbm IF MID$(T$,I,1)=CHR$(92) THEN GOTO INSTR_DONE + #cbm I=I+1 + #cbm GOTO INSTR_LOOP + #cbm INSTR_DONE: + IF I=0 THEN GOTO READ_STRING_DONE + R$=R$+MID$(T$,J,I-J) + C$=MID$(T$,I+1,1) + #qbasic IF C$="n" THEN R$=R$+CHR$(10) ELSE R$=R$+C$ + #cbm IF C$="n" THEN R$=R$+CHR$(13) + #cbm IF C$<>"n" THEN R$=R$+C$ + J=I+2 + GOTO READ_STRING_LOOP + READ_STRING_DONE: + IF J=LEN(T$)+1 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"', got EOF":GOTO READ_FORM_RETURN + R$=R$+MID$(T$,J,LEN(T$)-J) + REM intern string value + B$=R$:T=4:GOSUB STRING + GOTO READ_FORM_RETURN + READ_KEYWORD: + R$=CHR$(127)+MID$(T$,2,LEN(T$)-1) + B$=R$:T=4:GOSUB STRING + GOTO READ_FORM_RETURN + READ_SYMBOL_MAYBE: + C$=MID$(T$,2,1) + IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER + READ_SYMBOL: + REM PRINT "READ_SYMBOL" + B$=T$:T=5:GOSUB STRING + GOTO READ_FORM_RETURN + + READ_SEQ_START: + SD=SD+1 + + GOSUB PUSH_Q: REM push return character + + REM setup the stack for the loop, T has type + GOSUB MAP_LOOP_START + + READ_SEQ_LOOP: + + REM TODO: reduce redundancy with READ_TOKEN + GOSUB SKIP_SPACES + GOSUB PEEK_CHAR: REM peek at next character + IF C$="" THEN ER=-1:E$="unexpected EOF":GOTO READ_SEQ_DONE + IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_SEQ_LOOP + Q=3:GOSUB PEEK_Q_Q + IF C$=CHR$(Q) THEN GOSUB READ_CHAR:GOTO READ_SEQ_DONE + + CALL READ_FORM + M=R: REM value (or key for hash-maps) + + REM if error, release the unattached element + IF ER<>-2 THEN AY=R:GOSUB RELEASE:GOTO READ_SEQ_DONE + + REM if this is a hash-map, READ_FORM again + IF T=8 THEN GOSUB PUSH_R:CALL READ_FORM + IF T=8 THEN N=R:GOSUB POP_Q:M=Q: REM set key and value + + REM update the return sequence structure + REM release N since list takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + GOTO READ_SEQ_LOOP + + READ_SEQ_DONE: + SD=SD-1 + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + + GOSUB POP_Q: REM pop end character ptr + GOTO READ_FORM_RETURN + + READ_FORM_RETURN: + GOSUB POP_Q:T=Q: REM restore current value of T + +END SUB + + +REM READ_STR(A$) -> R +READ_STR: + RI=1: REM index into A$ + RF=0: REM not reading from file + SD=0: REM sequence read depth + CALL READ_FORM + RETURN + +REM READ_FILE(A$) -> R +READ_FILE: + RF=1: REM reading from file + EZ=0: REM file read state (1: EOF) + SD=0: REM sequence read depth + D$="": REM pending read/peek character + #cbm OPEN 2,8,0,A$ + #qbasic OPEN A$ FOR INPUT AS #2 + #qbasic IF ERR()<>0 THEN ER=-1:E$="File not found":RETURN + REM READ_TOKEN adds "(do ... )" + CALL READ_FORM + CLOSE 2 + EZ=0 + RETURN diff --git a/impls/basic/readline.in.bas b/impls/basic/readline.in.bas new file mode 100644 index 0000000000..0ec7f232f6 --- /dev/null +++ b/impls/basic/readline.in.bas @@ -0,0 +1,32 @@ +REM READLINE(A$) -> R$ +READLINE: + EZ=0 + PRINT A$; + C$="":R$="":C=0 + READCH: + #cbm GET C$ + #qbasic C$=INKEY$ + IF C$="" THEN GOTO READCH + C=ASC(C$) + #qbasic IF ASC(C$)=8 THEN C=20:C$=CHR$(20) + IF C=4 OR C=0 THEN EZ=1:GOTO RL_DONE: REM EOF + IF C=127 OR C=20 THEN GOSUB RL_BACKSPACE + IF C=127 OR C=20 THEN GOTO READCH + IF (C<32 OR C>127) AND C<>13 THEN GOTO READCH + PRINT C$; + IF LEN(R$)<255 AND C$<>CHR$(13) THEN R$=R$+C$ + IF LEN(R$)<255 AND C$<>CHR$(13) THEN GOTO READCH + RL_DONE: + #qbasic PRINT + RETURN + + REM Assumes R$ has input buffer + RL_BACKSPACE: + IF LEN(R$)=0 THEN RETURN + R$=LEFT$(R$,LEN(R$)-1) + #cbm PRINT CHR$(157)+" "+CHR$(157); + #qbasic LOCATE ,POS(0)-1 + #qbasic PRINT " "; + #qbasic LOCATE ,POS(0)-1 + RETURN + diff --git a/impls/basic/run b/impls/basic/run new file mode 100755 index 0000000000..9b394f8c0b --- /dev/null +++ b/impls/basic/run @@ -0,0 +1,8 @@ +#!/usr/bin/env bash +cd $(dirname $0) +(echo "(def! -*ARGS*- (list $(for a in "${@}"; do echo -n " \"${a}\""; done)))") > .args.mal +case ${basic_MODE:-cbm} in + cbm) exec cbmbasic ${STEP:-stepA_mal}.bas "${@}" ;; + qbasic) exec ./${STEP:-stepA_mal} "${@}" ;; + *) echo "Invalid basic_MODE: ${basic_MODE}"; exit 2 ;; +esac diff --git a/impls/basic/step0_repl.in.bas b/impls/basic/step0_repl.in.bas new file mode 100755 index 0000000000..417e316695 --- /dev/null +++ b/impls/basic/step0_repl.in.bas @@ -0,0 +1,41 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'readline.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM EVAL(A$) -> R$ +SUB EVAL + R$=A$ +END SUB + +REM PRINT is inlined in REP + +REM REP(A$) -> R$ +SUB REP + REM inlined READ (not affecting A$) + CALL EVAL + REM inlined PRINT (not affecting A$) +END SUB + +REM MAIN program +MAIN: + GOSUB DIM_MEMORY + + REPL_LOOP: + A$="user> ":GOSUB READLINE: REM call input parser + IF EZ=1 THEN GOTO QUIT + IF R$="" THEN GOTO REPL_LOOP + + A$=R$:CALL REP + + PRINT R$ + GOTO REPL_LOOP + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + #cbm END + #qbasic SYSTEM diff --git a/impls/basic/step1_read_print.in.bas b/impls/basic/step1_read_print.in.bas new file mode 100755 index 0000000000..ca9ba1f90a --- /dev/null +++ b/impls/basic/step1_read_print.in.bas @@ -0,0 +1,77 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM EVAL(A) -> R +SUB EVAL + R=A +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:CALL EVAL + + RE_DONE: + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + ZT=ZI: REM top of memory after base repl_env + + REPL_LOOP: + A$="user> ":GOSUB READLINE: REM call input parser + IF EZ=1 THEN GOTO QUIT + IF R$="" THEN GOTO REPL_LOOP + + A$=R$:CALL REP + + IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step2_eval.in.bas b/impls/basic/step2_eval.in.bas new file mode 100755 index 0000000000..53fd4a4942 --- /dev/null +++ b/impls/basic/step2_eval.in.bas @@ -0,0 +1,265 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A on the stack + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A off the stack + GOSUB POP_A +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A on the stack + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM AZ=A:B=1:GOSUB PR_STR + REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + + GOSUB TYPE_A + T=T-4 + IF 0-2 THEN GOTO EVAL_RETURN + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 0 R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + GOSUB HASHMAP:D=R + + REM + function + T=9:L=1:GOSUB ALLOC: REM native function + H=D:B$="+":C=R:GOSUB ASSOC1_S:D=R + + REM - function + T=9:L=2:GOSUB ALLOC: REM native function + H=D:B$="-":C=R:GOSUB ASSOC1_S:D=R + + REM * function + T=9:L=3:GOSUB ALLOC: REM native function + H=D:B$="*":C=R:GOSUB ASSOC1_S:D=R + + REM / function + T=9:L=4:GOSUB ALLOC: REM native function + H=D:B$="/":C=R:GOSUB ASSOC1_S:D=R + + ZT=ZI: REM top of memory after base repl_env + + REPL_LOOP: + A$="user> ":GOSUB READLINE: REM call input parser + IF EZ=1 THEN GOTO QUIT + IF R$="" THEN GOTO REPL_LOOP + + A$=R$:CALL REP + + IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step3_env.in.bas b/impls/basic/step3_env.in.bas new file mode 100755 index 0000000000..e89209be67 --- /dev/null +++ b/impls/basic/step3_env.in.bas @@ -0,0 +1,336 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + IF ER<>-2 THEN GOTO EVAL_RETURN + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 05 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:CALL EVAL: REM eval A2 using let_env + GOTO EVAL_RETURN + EVAL_INVOKE: + CALL EVAL_AST + W=R + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 0 R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + E=D + + REM + function + T=9:L=1:GOSUB ALLOC: REM native function + B$="+":C=R:GOSUB ENV_SET_S + + REM - function + T=9:L=2:GOSUB ALLOC: REM native function + B$="-":C=R:GOSUB ENV_SET_S + + REM * function + T=9:L=3:GOSUB ALLOC: REM native function + B$="*":C=R:GOSUB ENV_SET_S + + REM / function + T=9:L=4:GOSUB ALLOC: REM native function + B$="/":C=R:GOSUB ENV_SET_S + + ZT=ZI: REM top of memory after base repl_env + + REPL_LOOP: + A$="user> ":GOSUB READLINE: REM call input parser + IF EZ=1 THEN GOTO QUIT + IF R$="" THEN GOTO REPL_LOOP + + A$=R$:CALL REP + + IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step4_if_fn_do.in.bas b/impls/basic/step4_if_fn_do.in.bas new file mode 100755 index 0000000000..d37898116d --- /dev/null +++ b/impls/basic/step4_if_fn_do.in.bas @@ -0,0 +1,371 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'core.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + EVAL_TCO_RECUR: + + IF ER<>-2 THEN GOTO EVAL_RETURN + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 05 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + IF A$="do" THEN GOTO EVAL_DO + IF A$="if" THEN GOTO EVAL_IF + IF A$="fn*" THEN GOTO EVAL_FN + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:CALL EVAL: REM eval A2 using let_env + GOTO EVAL_RETURN + EVAL_DO: + A=Z%(A+1): REM rest + + CALL EVAL_AST + + GOSUB PUSH_R: REM push eval'd list + A=R:GOSUB LAST: REM return the last element + GOSUB POP_Q:AY=Q: REM pop eval'd list + GOSUB RELEASE: REM release the eval'd list + GOTO EVAL_RETURN + + EVAL_IF: + GOSUB EVAL_GET_A1: REM set A1 + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL + GOSUB POP_A: REM pop/restore A + IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE + + EVAL_IF_TRUE: + AY=R:GOSUB RELEASE + GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_IF_FALSE: + AY=R:GOSUB RELEASE + REM if no false case (A3), return nil + GOSUB COUNT + IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN + GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL + A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_FN: + GOSUB EVAL_GET_A2: REM set A1 and A2 + T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function + GOTO EVAL_RETURN + + EVAL_INVOKE: + CALL EVAL_AST + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM push f/args for release after call + GOSUB PUSH_R + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 064 THEN CALL DO_TCO_FUNCTION + EVAL_DO_FUNCTION_SKIP: + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO EVAL_RETURN + + EVAL_DO_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment for release + + REM create new environ using env and params stored in function + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + REM release previous env if it is not the top one on the + REM stack (X%(X-2)) because our new env refers to it and + REM we no longer need to track it (since we are TCO recurring) + GOSUB POP_Q:AY=Q + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + REM claim the AST before releasing the list containing it + A=Z%(F+1):Z%(A)=Z%(A)+32 + REM add AST to pending release queue to free as soon as EVAL + REM actually returns (LV+1) + LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM A set above + E=R:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_RETURN: + REM AZ=R: B=1: GOSUB PR_STR + REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) + + REM release environment if not the top one on the stack + GOSUB PEEK_Q_1 + IF E<>Q THEN AY=E:GOSUB RELEASE + + LV=LV-1: REM track basic return stack level + + REM release everything we couldn't release earlier + GOSUB RELEASE_PEND + + REM trigger GC + #cbm T=FRE(0) + #qbasic T=0 + + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q + +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + + REM core.EXT: defined in Basic + E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env + + ZT=ZI: REM top of memory after base repl_env + + REM core.mal: defined using the language itself + A$="(def! not (fn* (a) (if a false true)))" + GOSUB RE:AY=R:GOSUB RELEASE + + REPL_LOOP: + A$="user> ":GOSUB READLINE: REM call input parser + IF EZ=1 THEN GOTO QUIT + IF R$="" THEN GOTO REPL_LOOP + + A$=R$:CALL REP + + IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step5_tco.in.bas b/impls/basic/step5_tco.in.bas new file mode 100755 index 0000000000..bf56efcf3e --- /dev/null +++ b/impls/basic/step5_tco.in.bas @@ -0,0 +1,395 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'core.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + EVAL_TCO_RECUR: + + IF ER<>-2 THEN GOTO EVAL_RETURN + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 05 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + IF A$="do" THEN GOTO EVAL_DO + IF A$="if" THEN GOTO EVAL_IF + IF A$="fn*" THEN GOTO EVAL_FN + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + Q=E:GOSUB PUSH_Q: REM push env for for later release + + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:AY=Q: REM pop previous env + + REM release previous environment if not the current EVAL env + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DO: + A=Z%(A+1): REM rest + GOSUB PUSH_A: REM push/save A + + REM this must be EVAL_AST call #2 for EVAL_AST to return early + REM and for TCO to work + CALL EVAL_AST + + REM cleanup + AY=R: REM get eval'd list for release + + GOSUB POP_A: REM pop/restore original A for LAST + GOSUB LAST: REM get last element for return + A=R: REM new recur AST + + REM cleanup + GOSUB RELEASE: REM release eval'd list + AY=A:GOSUB RELEASE: REM release LAST value (not sure why) + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_IF: + GOSUB EVAL_GET_A1: REM set A1 + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL + GOSUB POP_A: REM pop/restore A + IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE + + EVAL_IF_TRUE: + AY=R:GOSUB RELEASE + GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_IF_FALSE: + AY=R:GOSUB RELEASE + REM if no false case (A3), return nil + GOSUB COUNT + IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN + GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL + A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_FN: + GOSUB EVAL_GET_A2: REM set A1 and A2 + T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function + GOTO EVAL_RETURN + + EVAL_INVOKE: + CALL EVAL_AST + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM push f/args for release after call + GOSUB PUSH_R + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 064 THEN CALL DO_TCO_FUNCTION + EVAL_DO_FUNCTION_SKIP: + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO EVAL_RETURN + + EVAL_DO_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment for release + + REM create new environ using env and params stored in function + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + REM release previous env if it is not the top one on the + REM stack (X%(X-2)) because our new env refers to it and + REM we no longer need to track it (since we are TCO recurring) + GOSUB POP_Q:AY=Q + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + REM claim the AST before releasing the list containing it + A=Z%(F+1):Z%(A)=Z%(A)+32 + REM add AST to pending release queue to free as soon as EVAL + REM actually returns (LV+1) + LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM A set above + E=R:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_RETURN: + REM AZ=R: B=1: GOSUB PR_STR + REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) + + REM release environment if not the top one on the stack + GOSUB PEEK_Q_1 + IF E<>Q THEN AY=E:GOSUB RELEASE + + LV=LV-1: REM track basic return stack level + + REM release everything we couldn't release earlier + GOSUB RELEASE_PEND + + REM trigger GC + #cbm T=FRE(0) + #qbasic T=0 + + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q + +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + + REM core.EXT: defined in Basic + E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env + + ZT=ZI: REM top of memory after base repl_env + + REM core.mal: defined using the language itself + A$="(def! not (fn* (a) (if a false true)))" + GOSUB RE:AY=R:GOSUB RELEASE + + REPL_LOOP: + A$="user> ":GOSUB READLINE: REM call input parser + IF EZ=1 THEN GOTO QUIT + IF R$="" THEN GOTO REPL_LOOP + + A$=R$:CALL REP + + IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step6_file.in.bas b/impls/basic/step6_file.in.bas new file mode 100755 index 0000000000..ac9c470c46 --- /dev/null +++ b/impls/basic/step6_file.in.bas @@ -0,0 +1,424 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'core.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + EVAL_TCO_RECUR: + + IF ER<>-2 THEN GOTO EVAL_RETURN + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 05 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + IF A$="do" THEN GOTO EVAL_DO + IF A$="if" THEN GOTO EVAL_IF + IF A$="fn*" THEN GOTO EVAL_FN + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + Q=E:GOSUB PUSH_Q: REM push env for for later release + + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:AY=Q: REM pop previous env + + REM release previous environment if not the current EVAL env + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DO: + A=Z%(A+1): REM rest + GOSUB PUSH_A: REM push/save A + + REM this must be EVAL_AST call #2 for EVAL_AST to return early + REM and for TCO to work + CALL EVAL_AST + + REM cleanup + AY=R: REM get eval'd list for release + + GOSUB POP_A: REM pop/restore original A for LAST + GOSUB LAST: REM get last element for return + A=R: REM new recur AST + + REM cleanup + GOSUB RELEASE: REM release eval'd list + AY=A:GOSUB RELEASE: REM release LAST value (not sure why) + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_IF: + GOSUB EVAL_GET_A1: REM set A1 + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL + GOSUB POP_A: REM pop/restore A + IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE + + EVAL_IF_TRUE: + AY=R:GOSUB RELEASE + GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_IF_FALSE: + AY=R:GOSUB RELEASE + REM if no false case (A3), return nil + GOSUB COUNT + IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN + GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL + A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_FN: + GOSUB EVAL_GET_A2: REM set A1 and A2 + T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function + GOTO EVAL_RETURN + + EVAL_INVOKE: + CALL EVAL_AST + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM push f/args for release after call + GOSUB PUSH_R + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 064 THEN CALL DO_TCO_FUNCTION + EVAL_DO_FUNCTION_SKIP: + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO EVAL_RETURN + + EVAL_DO_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment for release + + REM create new environ using env and params stored in function + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + REM release previous env if it is not the top one on the + REM stack (X%(X-2)) because our new env refers to it and + REM we no longer need to track it (since we are TCO recurring) + GOSUB POP_Q:AY=Q + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + REM claim the AST before releasing the list containing it + A=Z%(F+1):Z%(A)=Z%(A)+32 + REM add AST to pending release queue to free as soon as EVAL + REM actually returns (LV+1) + LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM A set above + E=R:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_RETURN: + REM AZ=R: B=1: GOSUB PR_STR + REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) + + REM release environment if not the top one on the stack + GOSUB PEEK_Q_1 + IF E<>Q THEN AY=E:GOSUB RELEASE + + LV=LV-1: REM track basic return stack level + + REM release everything we couldn't release earlier + GOSUB RELEASE_PEND + + REM trigger GC + #cbm T=FRE(0) + #qbasic T=0 + + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q + +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + + REM core.EXT: defined in Basic + E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env + + ZT=ZI: REM top of memory after base repl_env + + REM core.mal: defined using the language itself + A$="(def! not (fn* (a) (if a false true)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM load the args file + A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" + GOSUB RE:AY=R:GOSUB RELEASE + + IF ER>-2 THEN GOSUB PRINT_ERROR:END + + REM set the argument list + A$="(def! *ARGV* (rest -*ARGS*-))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM get the first argument + A$="(first -*ARGS*-)" + GOSUB RE + + REM no arguments, start REPL loop + REM if there is an argument, then run it as a program + IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + RUN_PROG: + REM free up first arg because we get it again + AY=R:GOSUB RELEASE + REM run a single mal program and exit + A$="(load-file (first -*ARGS*-))" + GOSUB RE + IF ER<>-2 THEN GOSUB PRINT_ERROR + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step7_quote.in.bas b/impls/basic/step7_quote.in.bas new file mode 100755 index 0000000000..8cf109a00b --- /dev/null +++ b/impls/basic/step7_quote.in.bas @@ -0,0 +1,551 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'core.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM QUASIQUOTE(A) -> R +SUB QUASIQUOTE + GOSUB TYPE_A + T=T-4 + IF 05 THEN GOTO QQ_LIST_NORMAL + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL + + REM Indeed. Return a list containing 'unquote and the form. + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO QQ_DONE + + QQ_LIST_NORMAL: + REM Normal list, process with QQ_FOLDR. + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) + GOSUB PUSH_A + A=Z%(A+1):CALL QQ_FOLDR + GOSUB POP_A + + REM Set A to elt = (first A) + A=Z%(A+2) + + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + B=Z%(A+2) + IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + + REM ('concat, A[1], R) + B=Z%(Z%(A+1)+2) + A=R + B$="concat":T=5:GOSUB STRING:C=R + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=C:GOSUB RELEASE + + GOTO QQ_FOLDR_DONE + + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE + +QQ_FOLDR_DONE: +END SUB + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + EVAL_TCO_RECUR: + + IF ER<>-2 THEN GOTO EVAL_RETURN + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 05 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE + IF A$="do" THEN GOTO EVAL_DO + IF A$="if" THEN GOTO EVAL_IF + IF A$="fn*" THEN GOTO EVAL_FN + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + Q=E:GOSUB PUSH_Q: REM push env for for later release + + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:AY=Q: REM pop previous env + + REM release previous environment if not the current EVAL env + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DO: + A=Z%(A+1): REM rest + GOSUB PUSH_A: REM push/save A + + REM this must be EVAL_AST call #2 for EVAL_AST to return early + REM and for TCO to work + CALL EVAL_AST + + REM cleanup + AY=R: REM get eval'd list for release + + GOSUB POP_A: REM pop/restore original A for LAST + GOSUB LAST: REM get last element for return + A=R: REM new recur AST + + REM cleanup + GOSUB RELEASE: REM release eval'd list + AY=A:GOSUB RELEASE: REM release LAST value (not sure why) + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_QUOTE: + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO EVAL_RETURN + + EVAL_QUASIQUOTE: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + A=R + REM add quasiquote result to pending release queue to free when + REM next lower EVAL level returns (LV) + GOSUB PEND_A_LV + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_IF: + GOSUB EVAL_GET_A1: REM set A1 + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL + GOSUB POP_A: REM pop/restore A + IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE + + EVAL_IF_TRUE: + AY=R:GOSUB RELEASE + GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_IF_FALSE: + AY=R:GOSUB RELEASE + REM if no false case (A3), return nil + GOSUB COUNT + IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN + GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL + A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_FN: + GOSUB EVAL_GET_A2: REM set A1 and A2 + T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function + GOTO EVAL_RETURN + + EVAL_INVOKE: + CALL EVAL_AST + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM push f/args for release after call + GOSUB PUSH_R + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 064 THEN CALL DO_TCO_FUNCTION + EVAL_DO_FUNCTION_SKIP: + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO EVAL_RETURN + + EVAL_DO_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment for release + + REM create new environ using env and params stored in function + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + REM release previous env if it is not the top one on the + REM stack (X%(X-2)) because our new env refers to it and + REM we no longer need to track it (since we are TCO recurring) + GOSUB POP_Q:AY=Q + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + REM claim the AST before releasing the list containing it + A=Z%(F+1):Z%(A)=Z%(A)+32 + REM add AST to pending release queue to free as soon as EVAL + REM actually returns (LV+1) + LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM A set above + E=R:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_RETURN: + REM AZ=R: B=1: GOSUB PR_STR + REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) + + REM release environment if not the top one on the stack + GOSUB PEEK_Q_1 + IF E<>Q THEN AY=E:GOSUB RELEASE + + LV=LV-1: REM track basic return stack level + + REM release everything we couldn't release earlier + GOSUB RELEASE_PEND + + REM trigger GC + #cbm T=FRE(0) + #qbasic T=0 + + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q + +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + + REM core.EXT: defined in Basic + E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env + + ZT=ZI: REM top of memory after base repl_env + + REM core.mal: defined using the language itself + A$="(def! not (fn* (a) (if a false true)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM load the args file + A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" + GOSUB RE:AY=R:GOSUB RELEASE + + IF ER>-2 THEN GOSUB PRINT_ERROR:END + + REM set the argument list + A$="(def! *ARGV* (rest -*ARGS*-))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM get the first argument + A$="(first -*ARGS*-)" + GOSUB RE + + REM no arguments, start REPL loop + REM if there is an argument, then run it as a program + IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + RUN_PROG: + REM free up first arg because we get it again + AY=R:GOSUB RELEASE + REM run a single mal program and exit + A$="(load-file (first -*ARGS*-))" + GOSUB RE + IF ER<>-2 THEN GOSUB PRINT_ERROR + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step8_macros.in.bas b/impls/basic/step8_macros.in.bas new file mode 100755 index 0000000000..60be62305e --- /dev/null +++ b/impls/basic/step8_macros.in.bas @@ -0,0 +1,614 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'core.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM QUASIQUOTE(A) -> R +SUB QUASIQUOTE + GOSUB TYPE_A + T=T-4 + IF 05 THEN GOTO QQ_LIST_NORMAL + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL + + REM Indeed. Return a list containing 'unquote and the form. + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO QQ_DONE + + QQ_LIST_NORMAL: + REM Normal list, process with QQ_FOLDR. + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) + GOSUB PUSH_A + A=Z%(A+1):CALL QQ_FOLDR + GOSUB POP_A + + REM Set A to elt = (first A) + A=Z%(A+2) + + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + B=Z%(A+2) + IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + + REM ('concat, A[1], R) + B=Z%(Z%(A+1)+2) + A=R + B$="concat":T=5:GOSUB STRING:C=R + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=C:GOSUB RELEASE + + GOTO QQ_FOLDR_DONE + + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE + +QQ_FOLDR_DONE: +END SUB + +REM MACROEXPAND(A, E) -> A: +SUB MACROEXPAND + GOSUB PUSH_A + + MACROEXPAND_LOOP: + REM list? + GOSUB TYPE_A + IF T<>6 THEN GOTO MACROEXPAND_DONE + REM non-empty? + IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE + B=Z%(A+2) + REM symbol? in first position + IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE + REM defined in environment? + B$=S$(Z%(B+1)):CALL ENV_GET + IF R3=0 THEN GOTO MACROEXPAND_DONE + B=R + REM macro? + IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE + + GOSUB INC_REF_R + F=B:AR=Z%(A+1):CALL APPLY + A=R + + GOSUB PEEK_Q:AY=Q + REM if previous A was not the first A into macroexpand (i.e. an + REM intermediate form) then free it + IF A<>AY THEN GOSUB PEND_A_LV + + IF ER<>-2 THEN GOTO MACROEXPAND_DONE + GOTO MACROEXPAND_LOOP + + MACROEXPAND_DONE: + GOSUB POP_Q: REM pop original A +END SUB + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + EVAL_TCO_RECUR: + + IF ER<>-2 THEN GOTO EVAL_RETURN + + EVAL_NOT_LIST: + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 01 THEN GOTO EVAL_NOT_LIST + + GOSUB EMPTY_Q + IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN + + A0=Z%(A+2) + + REM get symbol in A$ + IF (Z%(A0)AND 31)<>5 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE + IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO + IF A$="do" THEN GOTO EVAL_DO + IF A$="if" THEN GOTO EVAL_IF + IF A$="fn*" THEN GOTO EVAL_FN + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + Q=E:GOSUB PUSH_Q: REM push env for for later release + + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:AY=Q: REM pop previous env + + REM release previous environment if not the current EVAL env + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DO: + A=Z%(A+1): REM rest + GOSUB PUSH_A: REM push/save A + + REM this must be EVAL_AST call #2 for EVAL_AST to return early + REM and for TCO to work + CALL EVAL_AST + + REM cleanup + AY=R: REM get eval'd list for release + + GOSUB POP_A: REM pop/restore original A for LAST + GOSUB LAST: REM get last element for return + A=R: REM new recur AST + + REM cleanup + GOSUB RELEASE: REM release eval'd list + AY=A:GOSUB RELEASE: REM release LAST value (not sure why) + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_QUOTE: + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO EVAL_RETURN + + EVAL_QUASIQUOTE: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + A=R + REM add quasiquote result to pending release queue to free when + REM next lower EVAL level returns (LV) + GOSUB PEND_A_LV + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DEFMACRO: + REM PRINT "defmacro!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q: REM push A1 + A=A2:CALL EVAL: REM eval A2 + GOSUB POP_Q:A1=Q: REM pop A1 + + REM change function to macro + Z%(R)=Z%(R)+1 + + REM set A1 in env to A2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_IF: + GOSUB EVAL_GET_A1: REM set A1 + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL + GOSUB POP_A: REM pop/restore A + IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE + + EVAL_IF_TRUE: + AY=R:GOSUB RELEASE + GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_IF_FALSE: + AY=R:GOSUB RELEASE + REM if no false case (A3), return nil + GOSUB COUNT + IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN + GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL + A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_FN: + GOSUB EVAL_GET_A2: REM set A1 and A2 + T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function + GOTO EVAL_RETURN + + EVAL_INVOKE: + CALL EVAL_AST + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM push f/args for release after call + GOSUB PUSH_R + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 064 THEN CALL DO_TCO_FUNCTION + EVAL_DO_FUNCTION_SKIP: + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO EVAL_RETURN + + EVAL_DO_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment for release + + REM create new environ using env and params stored in function + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + REM release previous env if it is not the top one on the + REM stack (X%(X-2)) because our new env refers to it and + REM we no longer need to track it (since we are TCO recurring) + GOSUB POP_Q:AY=Q + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + REM claim the AST before releasing the list containing it + A=Z%(F+1):Z%(A)=Z%(A)+32 + REM add AST to pending release queue to free as soon as EVAL + REM actually returns (LV+1) + LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM A set above + E=R:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_RETURN: + REM AZ=R: B=1: GOSUB PR_STR + REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) + + REM release environment if not the top one on the stack + GOSUB PEEK_Q_1 + IF E<>Q THEN AY=E:GOSUB RELEASE + + LV=LV-1: REM track basic return stack level + + REM release everything we couldn't release earlier + GOSUB RELEASE_PEND + + REM trigger GC + #cbm T=FRE(0) + #qbasic T=0 + + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q + +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + + REM core.EXT: defined in Basic + E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env + + ZT=ZI: REM top of memory after base repl_env + + REM core.mal: defined using the language itself + A$="(def! not (fn* (a) (if a false true)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)" + A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of" + A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM load the args file + A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" + GOSUB RE:AY=R:GOSUB RELEASE + + IF ER>-2 THEN GOSUB PRINT_ERROR:END + + REM set the argument list + A$="(def! *ARGV* (rest -*ARGS*-))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM get the first argument + A$="(first -*ARGS*-)" + GOSUB RE + + REM no arguments, start REPL loop + REM if there is an argument, then run it as a program + IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + RUN_PROG: + REM free up first arg because we get it again + AY=R:GOSUB RELEASE + REM run a single mal program and exit + A$="(load-file (first -*ARGS*-))" + GOSUB RE + IF ER<>-2 THEN GOSUB PRINT_ERROR + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/step9_try.in.bas b/impls/basic/step9_try.in.bas new file mode 100755 index 0000000000..47cfc0a8b9 --- /dev/null +++ b/impls/basic/step9_try.in.bas @@ -0,0 +1,649 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'core.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM QUASIQUOTE(A) -> R +SUB QUASIQUOTE + GOSUB TYPE_A + T=T-4 + IF 05 THEN GOTO QQ_LIST_NORMAL + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL + + REM Indeed. Return a list containing 'unquote and the form. + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO QQ_DONE + + QQ_LIST_NORMAL: + REM Normal list, process with QQ_FOLDR. + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) + GOSUB PUSH_A + A=Z%(A+1):CALL QQ_FOLDR + GOSUB POP_A + + REM Set A to elt = (first A) + A=Z%(A+2) + + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + B=Z%(A+2) + IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + + REM ('concat, A[1], R) + B=Z%(Z%(A+1)+2) + A=R + B$="concat":T=5:GOSUB STRING:C=R + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=C:GOSUB RELEASE + + GOTO QQ_FOLDR_DONE + + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE + +QQ_FOLDR_DONE: +END SUB + +REM MACROEXPAND(A, E) -> A: +SUB MACROEXPAND + GOSUB PUSH_A + + MACROEXPAND_LOOP: + REM list? + GOSUB TYPE_A + IF T<>6 THEN GOTO MACROEXPAND_DONE + REM non-empty? + IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE + B=Z%(A+2) + REM symbol? in first position + IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE + REM defined in environment? + B$=S$(Z%(B+1)):CALL ENV_GET + IF R3=0 THEN GOTO MACROEXPAND_DONE + B=R + REM macro? + IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE + + GOSUB INC_REF_R + F=B:AR=Z%(A+1):CALL APPLY + A=R + + GOSUB PEEK_Q:AY=Q + REM if previous A was not the first A into macroexpand (i.e. an + REM intermediate form) then free it + IF A<>AY THEN GOSUB PEND_A_LV + + IF ER<>-2 THEN GOTO MACROEXPAND_DONE + GOTO MACROEXPAND_LOOP + + MACROEXPAND_DONE: + GOSUB POP_Q: REM pop original A +END SUB + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + EVAL_TCO_RECUR: + + IF ER<>-2 THEN GOTO EVAL_RETURN + + EVAL_NOT_LIST: + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 01 THEN GOTO EVAL_NOT_LIST + + GOSUB EMPTY_Q + IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN + + A0=Z%(A+2) + + REM get symbol in A$ + IF (Z%(A0)AND 31)<>5 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE + IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO + IF A$="try*" THEN GOTO EVAL_TRY + IF A$="do" THEN GOTO EVAL_DO + IF A$="if" THEN GOTO EVAL_IF + IF A$="fn*" THEN GOTO EVAL_FN + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + Q=E:GOSUB PUSH_Q: REM push env for for later release + + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:AY=Q: REM pop previous env + + REM release previous environment if not the current EVAL env + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DO: + A=Z%(A+1): REM rest + GOSUB PUSH_A: REM push/save A + + REM this must be EVAL_AST call #2 for EVAL_AST to return early + REM and for TCO to work + CALL EVAL_AST + + REM cleanup + AY=R: REM get eval'd list for release + + GOSUB POP_A: REM pop/restore original A for LAST + GOSUB LAST: REM get last element for return + A=R: REM new recur AST + + REM cleanup + GOSUB RELEASE: REM release eval'd list + AY=A:GOSUB RELEASE: REM release LAST value (not sure why) + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_QUOTE: + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO EVAL_RETURN + + EVAL_QUASIQUOTE: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + A=R + REM add quasiquote result to pending release queue to free when + REM next lower EVAL level returns (LV) + GOSUB PEND_A_LV + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DEFMACRO: + REM PRINT "defmacro!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q: REM push A1 + A=A2:CALL EVAL: REM eval A2 + GOSUB POP_Q:A1=Q: REM pop A1 + + REM change function to macro + Z%(R)=Z%(R)+1 + + REM set A1 in env to A2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_TRY: + REM PRINT "try*" + GOSUB EVAL_GET_A1: REM set A1 + + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL: REM eval A1 + GOSUB POP_A: REM pop/restore A + + GOSUB EVAL_GET_A2: REM set A1 and A2 + + REM if there is no error or catch block then return + IF ER=-2 OR A2=0 THEN GOTO EVAL_RETURN + + REM create environment for the catch block eval + C=E:GOSUB ENV_NEW:E=R + + A=A2:GOSUB EVAL_GET_A2: REM set A1 and A2 from catch block + + REM create object for ER=-1 type raw string errors + IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:GOSUB INC_REF_R + + REM bind the catch symbol to the error object + K=A1:C=ER:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, env took ownership + + REM unset error for catch eval + ER=-2:E$="" + + A=A2:CALL EVAL + + GOTO EVAL_RETURN + + EVAL_IF: + GOSUB EVAL_GET_A1: REM set A1 + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL + GOSUB POP_A: REM pop/restore A + IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE + + EVAL_IF_TRUE: + AY=R:GOSUB RELEASE + GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_IF_FALSE: + AY=R:GOSUB RELEASE + REM if no false case (A3), return nil + GOSUB COUNT + IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN + GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL + A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_FN: + GOSUB EVAL_GET_A2: REM set A1 and A2 + T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function + GOTO EVAL_RETURN + + EVAL_INVOKE: + CALL EVAL_AST + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM push f/args for release after call + GOSUB PUSH_R + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + GOSUB TYPE_F + T=T-8 + IF 064 THEN CALL DO_TCO_FUNCTION + EVAL_DO_FUNCTION_SKIP: + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO EVAL_RETURN + + EVAL_DO_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment for release + + REM create new environ using env and params stored in function + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + REM release previous env if it is not the top one on the + REM stack (X%(X-2)) because our new env refers to it and + REM we no longer need to track it (since we are TCO recurring) + GOSUB POP_Q:AY=Q + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + REM claim the AST before releasing the list containing it + A=Z%(F+1):Z%(A)=Z%(A)+32 + REM add AST to pending release queue to free as soon as EVAL + REM actually returns (LV+1) + LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM A set above + E=R:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_RETURN: + REM AZ=R: B=1: GOSUB PR_STR + REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) + + REM release environment if not the top one on the stack + GOSUB PEEK_Q_1 + IF E<>Q THEN AY=E:GOSUB RELEASE + + LV=LV-1: REM track basic return stack level + + REM release everything we couldn't release earlier + GOSUB RELEASE_PEND + + REM trigger GC + #cbm T=FRE(0) + #qbasic T=0 + + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q + +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + + REM core.EXT: defined in Basic + E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env + + ZT=ZI: REM top of memory after base repl_env + + REM core.mal: defined using the language itself + A$="(def! not (fn* (a) (if a false true)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)" + A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of" + A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM load the args file + A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" + GOSUB RE:AY=R:GOSUB RELEASE + + IF ER>-2 THEN GOSUB PRINT_ERROR:END + + REM set the argument list + A$="(def! *ARGV* (rest -*ARGS*-))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM get the first argument + A$="(first -*ARGS*-)" + GOSUB RE + + REM no arguments, start REPL loop + REM if there is an argument, then run it as a program + IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + RUN_PROG: + REM free up first arg because we get it again + AY=R:GOSUB RELEASE + REM run a single mal program and exit + A$="(load-file (first -*ARGS*-))" + GOSUB RE + IF ER<>-2 THEN GOSUB PRINT_ERROR + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + REM if the error is an object, then print and free it + IF ER>=0 THEN AZ=ER:B=0:GOSUB PR_STR:E$=R$:AY=ER:GOSUB RELEASE + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/stepA_mal.in.bas b/impls/basic/stepA_mal.in.bas new file mode 100755 index 0000000000..4d06608852 --- /dev/null +++ b/impls/basic/stepA_mal.in.bas @@ -0,0 +1,660 @@ +GOTO MAIN + +REM $INCLUDE: 'mem.in.bas' +REM $INCLUDE: 'types.in.bas' +REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'reader.in.bas' +REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'core.in.bas' + +REM $INCLUDE: 'debug.in.bas' + +REM READ is inlined in RE + +REM QUASIQUOTE(A) -> R +SUB QUASIQUOTE + GOSUB TYPE_A + T=T-4 + IF 05 THEN GOTO QQ_LIST_NORMAL + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL + + REM Indeed. Return a list containing 'unquote and the form. + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO QQ_DONE + + QQ_LIST_NORMAL: + REM Normal list, process with QQ_FOLDR. + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) + GOSUB PUSH_A + A=Z%(A+1):CALL QQ_FOLDR + GOSUB POP_A + + REM Set A to elt = (first A) + A=Z%(A+2) + + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + B=Z%(A+2) + IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + + REM ('concat, A[1], R) + B=Z%(Z%(A+1)+2) + A=R + B$="concat":T=5:GOSUB STRING:C=R + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=C:GOSUB RELEASE + + GOTO QQ_FOLDR_DONE + + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE + +QQ_FOLDR_DONE: +END SUB + +REM MACROEXPAND(A, E) -> A: +SUB MACROEXPAND + GOSUB PUSH_A + + MACROEXPAND_LOOP: + REM list? + GOSUB TYPE_A + IF T<>6 THEN GOTO MACROEXPAND_DONE + REM non-empty? + IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE + B=Z%(A+2) + REM symbol? in first position + IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE + REM defined in environment? + B$=S$(Z%(B+1)):CALL ENV_GET + IF R3=0 THEN GOTO MACROEXPAND_DONE + B=R + REM macro? + IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE + + GOSUB INC_REF_R + F=B:AR=Z%(A+1):CALL APPLY + A=R + + GOSUB PEEK_Q:AY=Q + REM if previous A was not the first A into macroexpand (i.e. an + REM intermediate form) then free it + IF A<>AY THEN GOSUB PEND_A_LV + + IF ER<>-2 THEN GOTO MACROEXPAND_DONE + GOTO MACROEXPAND_LOOP + + MACROEXPAND_DONE: + GOSUB POP_Q: REM pop original A +END SUB + +REM EVAL_AST(A, E) -> R +SUB EVAL_AST + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + IF ER<>-2 THEN GOTO EVAL_AST_RETURN + + GOSUB TYPE_A + IF T<6 OR 88 THEN A=Z%(A+2) + IF T=8 THEN A=Z%(A+3) + Q=T:GOSUB PUSH_Q: REM push/save type + CALL EVAL + GOSUB POP_Q:T=Q: REM pop/restore type + GOSUB POP_A + M=R + + REM if error, release the unattached element + REM TODO: is R=0 correct? + IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE + + REM for hash-maps, copy the key (inc ref since we are going to + REM release it below) + IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 + + REM update the return sequence structure + REM release N (and M if T=8) since seq takes full ownership + C=1:GOSUB MAP_LOOP_UPDATE + + REM process the next sequence entry from source list + A=Z%(A+1) + + GOTO EVAL_AST_SEQ_LOOP + EVAL_AST_SEQ_LOOP_DONE: + REM cleanup stack and get return value + GOSUB MAP_LOOP_DONE + GOTO EVAL_AST_RETURN + + EVAL_AST_RETURN: + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q +END SUB + +REM EVAL(A, E) -> R +SUB EVAL + LV=LV+1: REM track basic return stack level + + REM push A and E on the stack + Q=E:GOSUB PUSH_Q + GOSUB PUSH_A + + REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) + + EVAL_TCO_RECUR: + + IF ER<>-2 THEN GOTO EVAL_RETURN + + EVAL_NOT_LIST: + + B$="DEBUG-EVAL":CALL ENV_GET + IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE + AZ=A:B=1:GOSUB PR_STR + PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" + DEBUG_EVAL_DONE: + + GOSUB TYPE_A + T=T-4 + IF 01 THEN GOTO EVAL_NOT_LIST + + GOSUB EMPTY_Q + IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN + + A0=Z%(A+2) + + REM get symbol in A$ + IF (Z%(A0)AND 31)<>5 THEN A$="" + IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) + + IF A$="def!" THEN GOTO EVAL_DEF + IF A$="let*" THEN GOTO EVAL_LET + IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE + IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO + IF A$="try*" THEN GOTO EVAL_TRY + IF A$="do" THEN GOTO EVAL_DO + IF A$="if" THEN GOTO EVAL_IF + IF A$="fn*" THEN GOTO EVAL_FN + GOTO EVAL_INVOKE + + EVAL_GET_A3: + A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) + EVAL_GET_A2: + A2=Z%(Z%(Z%(A+1)+1)+2) + EVAL_GET_A1: + A1=Z%(Z%(A+1)+2) + RETURN + + EVAL_DEF: + REM PRINT "def!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q + A=A2:CALL EVAL: REM eval a2 + GOSUB POP_Q:A1=Q + + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM set a1 in env to a2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_LET: + REM PRINT "let*" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A2:GOSUB PUSH_Q: REM push/save A2 + Q=E:GOSUB PUSH_Q: REM push env for for later release + + REM create new environment with outer as current environment + C=E:GOSUB ENV_NEW + E=R + EVAL_LET_LOOP: + IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE + + Q=A1:GOSUB PUSH_Q: REM push A1 + REM eval current A1 odd element + A=Z%(Z%(A1+1)+2):CALL EVAL + GOSUB POP_Q:A1=Q: REM pop A1 + + IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE + + REM set key/value in the environment + K=Z%(A1+2):C=R:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership + + REM skip to the next pair of A1 elements + A1=Z%(Z%(A1+1)+1) + GOTO EVAL_LET_LOOP + + EVAL_LET_LOOP_DONE: + GOSUB POP_Q:AY=Q: REM pop previous env + + REM release previous environment if not the current EVAL env + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + GOSUB POP_Q:A2=Q: REM pop A2 + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DO: + A=Z%(A+1): REM rest + GOSUB PUSH_A: REM push/save A + + REM this must be EVAL_AST call #2 for EVAL_AST to return early + REM and for TCO to work + CALL EVAL_AST + + REM cleanup + AY=R: REM get eval'd list for release + + GOSUB POP_A: REM pop/restore original A for LAST + GOSUB LAST: REM get last element for return + A=R: REM new recur AST + + REM cleanup + GOSUB RELEASE: REM release eval'd list + AY=A:GOSUB RELEASE: REM release LAST value (not sure why) + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_QUOTE: + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R + GOTO EVAL_RETURN + + EVAL_QUASIQUOTE: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + A=R + REM add quasiquote result to pending release queue to free when + REM next lower EVAL level returns (LV) + GOSUB PEND_A_LV + + GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_DEFMACRO: + REM PRINT "defmacro!" + GOSUB EVAL_GET_A2: REM set A1 and A2 + + Q=A1:GOSUB PUSH_Q: REM push A1 + A=A2:CALL EVAL: REM eval A2 + GOSUB POP_Q:A1=Q: REM pop A1 + + REM change function to macro + Z%(R)=Z%(R)+1 + + REM set A1 in env to A2 + K=A1:C=R:GOSUB ENV_SET + GOTO EVAL_RETURN + + EVAL_TRY: + REM PRINT "try*" + GOSUB EVAL_GET_A1: REM set A1 + + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL: REM eval A1 + GOSUB POP_A: REM pop/restore A + + GOSUB EVAL_GET_A2: REM set A1 and A2 + + REM if there is no error or catch block then return + IF ER=-2 OR A2=0 THEN GOTO EVAL_RETURN + + REM create environment for the catch block eval + C=E:GOSUB ENV_NEW:E=R + + A=A2:GOSUB EVAL_GET_A2: REM set A1 and A2 from catch block + + REM create object for ER=-1 type raw string errors + IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:GOSUB INC_REF_R + + REM bind the catch symbol to the error object + K=A1:C=ER:GOSUB ENV_SET + AY=R:GOSUB RELEASE: REM release our use, env took ownership + + REM unset error for catch eval + ER=-2:E$="" + + A=A2:CALL EVAL + + GOTO EVAL_RETURN + + EVAL_IF: + GOSUB EVAL_GET_A1: REM set A1 + GOSUB PUSH_A: REM push/save A + A=A1:CALL EVAL + GOSUB POP_A: REM pop/restore A + IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE + + EVAL_IF_TRUE: + AY=R:GOSUB RELEASE + GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL + A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_IF_FALSE: + AY=R:GOSUB RELEASE + REM if no false case (A3), return nil + GOSUB COUNT + IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN + GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL + A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_FN: + GOSUB EVAL_GET_A2: REM set A1 and A2 + T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function + GOTO EVAL_RETURN + + EVAL_INVOKE: + CALL EVAL_AST + + REM if error, return f/args for release by caller + IF ER<>-2 THEN GOTO EVAL_RETURN + + REM push f/args for release after call + GOSUB PUSH_R + + AR=Z%(R+1): REM rest + F=Z%(R+2) + + REM if metadata, get the actual object + GOSUB TYPE_F + IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F + T=T-8 + IF 064 THEN CALL DO_TCO_FUNCTION + EVAL_DO_FUNCTION_SKIP: + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + GOTO EVAL_RETURN + + EVAL_DO_MAL_FUNCTION: + Q=E:GOSUB PUSH_Q: REM save the current environment for release + + REM create new environ using env and params stored in function + C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS + + REM release previous env if it is not the top one on the + REM stack (X%(X-2)) because our new env refers to it and + REM we no longer need to track it (since we are TCO recurring) + GOSUB POP_Q:AY=Q + GOSUB PEEK_Q_2 + IF AY<>Q THEN GOSUB RELEASE + + REM claim the AST before releasing the list containing it + A=Z%(F+1):Z%(A)=Z%(A)+32 + REM add AST to pending release queue to free as soon as EVAL + REM actually returns (LV+1) + LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 + + REM pop and release f/args + GOSUB POP_Q:AY=Q + GOSUB RELEASE + + REM A set above + E=R:GOTO EVAL_TCO_RECUR: REM TCO loop + + EVAL_RETURN: + REM AZ=R: B=1: GOSUB PR_STR + REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) + + REM release environment if not the top one on the stack + GOSUB PEEK_Q_1 + IF E<>Q THEN AY=E:GOSUB RELEASE + + LV=LV-1: REM track basic return stack level + + REM release everything we couldn't release earlier + GOSUB RELEASE_PEND + + REM trigger GC + #cbm T=FRE(0) + #qbasic T=0 + + REM pop A and E off the stack + GOSUB POP_A + GOSUB POP_Q:E=Q + +END SUB + +REM PRINT is inlined in REP + +REM RE(A$) -> R +REM Assume D has repl_env +REM caller must release result +RE: + R1=-1 + GOSUB READ_STR: REM inlined READ + R1=R + IF ER<>-2 THEN GOTO RE_DONE + + A=R:E=D:CALL EVAL + + RE_DONE: + REM Release memory from READ + AY=R1:GOSUB RELEASE + RETURN: REM caller must release result of EVAL + +REM REP(A$) -> R$ +REM Assume D has repl_env +SUB REP + R2=-1 + + GOSUB RE + R2=R + IF ER<>-2 THEN GOTO REP_DONE + + AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT + + REP_DONE: + REM Release memory from EVAL + AY=R2:GOSUB RELEASE +END SUB + +REM MAIN program +MAIN: + GOSUB INIT_MEMORY + + LV=0 + + REM create repl_env + C=0:GOSUB ENV_NEW:D=R + + REM core.EXT: defined in Basic + E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env + + ZT=ZI: REM top of memory after base repl_env + + REM core.mal: defined using the language itself + #cbm A$="(def! *host-language* "+CHR$(34)+"C64 BASIC"+CHR$(34)+")" + #qbasic A$="(def! *host-language* "+CHR$(34)+"QBasic"+CHR$(34)+")" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(def! not (fn* (a) (if a false true)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" + GOSUB RE:AY=R:GOSUB RELEASE + + A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)" + A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of" + A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM load the args file + A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" + GOSUB RE:AY=R:GOSUB RELEASE + + IF ER>-2 THEN GOSUB PRINT_ERROR:END + + REM set the argument list + A$="(def! *ARGV* (rest -*ARGS*-))" + GOSUB RE:AY=R:GOSUB RELEASE + + REM get the first argument + A$="(first -*ARGS*-)" + GOSUB RE + + REM no arguments, start REPL loop + REM if there is an argument, then run it as a program + IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP + PRINT R$ + GOTO REPL_LOOP + + RUN_PROG: + REM free up first arg because we get it again + AY=R:GOSUB RELEASE + REM run a single mal program and exit + A$="(load-file (first -*ARGS*-))" + GOSUB RE + IF ER<>-2 THEN GOSUB PRINT_ERROR + + QUIT: + REM GOSUB PR_MEMORY_SUMMARY_SMALL + REM GOSUB PR_MEMORY_MAP + REM P1=0:P2=ZI:GOSUB PR_MEMORY + REM P1=D:GOSUB PR_OBJECT + REM P1=ZK:GOSUB PR_OBJECT + #cbm END + #qbasic SYSTEM + + PRINT_ERROR: + REM if the error is an object, then print and free it + IF ER>=0 THEN AZ=ER:B=0:GOSUB PR_STR:E$=R$:AY=ER:GOSUB RELEASE + PRINT "Error: "+E$ + ER=-2:E$="" + RETURN diff --git a/impls/basic/types.in.bas b/impls/basic/types.in.bas new file mode 100644 index 0000000000..ddbb5a1087 --- /dev/null +++ b/impls/basic/types.in.bas @@ -0,0 +1,308 @@ +REM general functions + +REM TYPE_A(A) -> T +TYPE_A: + T=Z%(A)AND 31 + RETURN + +REM TYPE_F(F) -> T +TYPE_F: + T=Z%(F)AND 31 + RETURN + +REM EQUAL_Q(A, B) -> R +EQUAL_Q: + ED=0: REM recursion depth + R=-1: REM return value + + EQUAL_Q_RECUR: + + REM push A and B + GOSUB PUSH_A + Q=B:GOSUB PUSH_Q + ED=ED+1 + + GOSUB TYPE_A + T2=Z%(B)AND 31 + IF T>5 AND T<8 AND T2>5 AND T2<8 THEN GOTO EQUAL_Q_SEQ + IF T=8 AND T2=8 THEN GOTO EQUAL_Q_HM + + IF T<>T2 OR Z%(A+1)<>Z%(B+1) THEN R=0 + GOTO EQUAL_Q_DONE + + EQUAL_Q_SEQ: + IF Z%(A+1)=0 AND Z%(B+1)=0 THEN GOTO EQUAL_Q_DONE + IF Z%(A+1)=0 OR Z%(B+1)=0 THEN R=0:GOTO EQUAL_Q_DONE + + REM compare the elements + A=Z%(A+2):B=Z%(B+2) + GOTO EQUAL_Q_RECUR + + EQUAL_Q_SEQ_CONTINUE: + REM next elements of the sequences + GOSUB PEEK_Q_1:A=Q + GOSUB PEEK_Q:B=Q + A=Z%(A+1):B=Z%(B+1) + Q=A:GOSUB PUT_Q_1 + Q=B:GOSUB PUT_Q + GOTO EQUAL_Q_SEQ + + EQUAL_Q_HM: + R=0 + GOTO EQUAL_Q_DONE + + EQUAL_Q_DONE: + REM pop current A and B + GOSUB POP_Q + GOSUB POP_Q + ED=ED-1 + IF R>-1 AND ED>0 THEN GOTO EQUAL_Q_DONE: REM unwind + IF ED=0 AND R=-1 THEN R=1 + IF ED=0 THEN RETURN + GOTO EQUAL_Q_SEQ_CONTINUE + +REM string functions + +REM STRING(B$, T) -> R +REM intern string and allocate reference (return Z% index) +STRING: + IF S=0 THEN GOTO STRING_NOT_FOUND + + REM search for matching string in S$ + I=0 + STRING_FIND_LOOP: + IF I>S-1 THEN GOTO STRING_NOT_FOUND + IF S%(I)>0 AND B$=S$(I) THEN GOTO STRING_DONE + I=I+1 + GOTO STRING_FIND_LOOP + + STRING_NOT_FOUND: + I=S-1 + STRING_FIND_GAP_LOOP: + REM TODO: don't search core function names (store position) + IF I=-1 THEN GOTO STRING_NEW + IF S%(I)=0 THEN GOTO STRING_SET + I=I-1 + GOTO STRING_FIND_GAP_LOOP + + STRING_NEW: + I=S + S=S+1 + REM fallthrough + + STRING_SET: + S$(I)=B$ + REM fallthrough + + STRING_DONE: + S%(I)=S%(I)+1 + L=I:GOSUB ALLOC + RETURN + +REM REPLACE(R$, S1$, S2$) -> R$ +REPLACE: + T3$=R$ + R$="" + I=1 + J=LEN(T3$) + REPLACE_LOOP: + IF I>J THEN RETURN + C$=MID$(T3$,I,LEN(S1$)) + IF C$=S1$ THEN R$=R$+S2$:I=I+LEN(S1$) + IF C$<>S1$ THEN R$=R$+MID$(T3$,I,1):I=I+1 + GOTO REPLACE_LOOP + + +REM sequence functions + +REM FORCE_SEQ_TYPE(A,T) -> R +FORCE_SEQ_TYPE: + REM if it's already the right type, inc ref cnt and return it + IF (Z%(A)AND 31)=T THEN R=A:GOTO INC_REF_R + REM if it's empty, return the empty sequence match T + IF A<16 THEN R=(T-4)*3:GOTO INC_REF_R + REM otherwise, copy first element to turn it into correct type + B=Z%(A+2): REM value to copy + L=Z%(A+1):M=B:GOSUB ALLOC: REM T already set + IF Z%(A+1)=0 THEN RETURN + RETURN + +REM MAP_LOOP_START(T): +REM - setup stack for map loop +MAP_LOOP_START: + REM point to empty sequence to start off + R=(T-4)*3: REM calculate location of empty seq + + GOSUB PUSH_R: REM push return ptr + GOSUB PUSH_R: REM push empty ptr + GOSUB PUSH_R: REM push current ptr + GOTO INC_REF_R + +REM MAP_LOOP_UPDATE(C,M): +REM MAP_LOOP_UPDATE(C,M,N): +REM - called after M (and N if T=8) are set +REM - C indicates whether to free M (and N if T=8) +REM - update the structure of the return sequence +MAP_LOOP_UPDATE: + GOSUB PEEK_Q_1:L=Q: REM empty ptr + + GOSUB ALLOC: REM allocate new sequence element + + REM sequence took ownership + AY=L:GOSUB RELEASE + IF C THEN AY=M:GOSUB RELEASE + IF C AND T=8 THEN AY=N:GOSUB RELEASE + + REM if not first element, set current next to point to new element + GOSUB PEEK_Q + IF Q>14 THEN Z%(Q+1)=R + REM if first element, set return to new element + IF Q<15 THEN Q=R:GOSUB PUT_Q_2 + Q=R:GOSUB PUT_Q: REM update current ptr to new element + + RETURN + +REM MAP_LOOP_DONE() -> R +REM - cleanup stack and set return value +MAP_LOOP_DONE: + GOSUB POP_Q: REM pop current ptr + GOSUB POP_Q: REM pop empty ptr + GOSUB POP_R: REM pop return ptr + RETURN + + +REM LIST_Q(A) -> R +LIST_Q: + R=0 + GOSUB TYPE_A + IF T=6 THEN R=1 + RETURN + +REM EMPTY_Q(A) -> R +EMPTY_Q: + R=0 + IF Z%(A+1)=0 THEN R=1 + RETURN + +REM COUNT(A) -> R +REM - returns length of list, not a Z% index +COUNT: + GOSUB PUSH_A + R=-1 + DO_COUNT_LOOP: + R=R+1 + IF Z%(A+1)<>0 THEN A=Z%(A+1):GOTO DO_COUNT_LOOP + GOSUB POP_A + RETURN + +REM LAST(A) -> R +LAST: + REM TODO check that actually a list/vector + IF Z%(A+1)=0 THEN R=0:RETURN: REM empty seq, return nil + W=0 + LAST_LOOP: + IF Z%(A+1)=0 THEN GOTO LAST_DONE: REM end, return previous value + W=A: REM current becomes previous entry + A=Z%(A+1): REM next entry + GOTO LAST_LOOP + LAST_DONE: + R=Z%(W+2) + GOTO INC_REF_R + +REM SLICE(A,B,C) -> R +REM make copy of sequence A from index B to C +REM returns R6 as reference to last element of slice before empty +REM returns A as next element following slice (of original) +SLICE: + I=0 + R=6: REM always a list + GOSUB INC_REF_R + R6=-1: REM last list element before empty + W=R: REM temporary for return as R + REM advance A to position B + SLICE_FIND_B: + IF I0 THEN A=Z%(A+1):I=I+1:GOTO SLICE_FIND_B + SLICE_LOOP: + REM if current position is C, then return + IF C<>-1 AND I>=C THEN R=W:RETURN + REM if we reached end of A, then return + IF Z%(A+1)=0 THEN R=W:RETURN + REM allocate new list element with copied value + T=6:L=6:M=Z%(A+2):GOSUB ALLOC + REM sequence took ownership + AY=L:GOSUB RELEASE + REM if not first element, set last to point to new element + IF R6>-1 THEN Z%(R6+1)=R + REM if first element, set return value to new element + IF R6=-1 THEN W=R + R6=R: REM update last list element + REM advance to next element of A + A=Z%(A+1) + I=I+1 + GOTO SLICE_LOOP + +REM LIST2(B,A) -> R +LIST2: + REM last element is 3 (empty list), second element is A + T=6:L=6:M=A:GOSUB ALLOC + + REM first element is B + T=6:L=R:M=B:GOSUB ALLOC + AY=L:GOSUB RELEASE: REM new list takes ownership of previous + + RETURN + +REM LIST3(C,B,A) -> R +LIST3: + GOSUB LIST2 + + REM first element is C + T=6:L=R:M=C:GOSUB ALLOC + AY=L:GOSUB RELEASE: REM new list takes ownership of previous + + RETURN + + +REM hashmap functions + +REM HASHMAP() -> R +HASHMAP: + REM just point to static empty hash-map + R=12 + GOTO INC_REF_R + +REM ASSOC1(H, K, C) -> R +ASSOC1: + REM create key/value entry + T=8:L=H:M=K:N=C:GOSUB ALLOC + AY=L:GOSUB RELEASE: REM we took ownership of previous hashmap + RETURN + +REM ASSOC1_S(H, B$, C) -> R +ASSOC1_S: + REM add the key string + T=4:GOSUB STRING + K=R:GOSUB ASSOC1 + AY=K:GOSUB RELEASE: REM map took ownership of key + RETURN + +REM HASHMAP_GET(H, B$) -> R +REM - returns R3 with whether we found it or not +HASHMAP_GET: + R3=0: REM whether found or not (for HASHMAP_CONTAINS) + R=0 + HASHMAP_GET_LOOP: + REM no matching key found + IF Z%(H+1)=0 THEN R=0:RETURN + REM get search string is equal to key string we found it + IF B$=S$(Z%(Z%(H+2)+1)) THEN R3=1:R=Z%(H+3):RETURN + REM skip to next key/value + H=Z%(H+1) + GOTO HASHMAP_GET_LOOP + +REM HASHMAP_CONTAINS(H, K) -> R +HASHMAP_CONTAINS: + GOSUB HASHMAP_GET + R=R3 + RETURN + diff --git a/impls/basic/variables.txt b/impls/basic/variables.txt new file mode 100644 index 0000000000..a970a0aae5 --- /dev/null +++ b/impls/basic/variables.txt @@ -0,0 +1,108 @@ +Global Unique: + +Z% : boxed memory values +Z1 : Z% size +Z2 : S$ size +Z3 : stack start address (cbm) or X% size (qbasic) +Z4 : release stack start address (cbm) or Y% size (qbasic) +ZI : start of unused memory (index into Z%) +ZK : start of free list (index into Z%) +ZT : top of memory after repl env allocations + +S$ : string memory storage +S : next free index in S$ + +X% : logic/call stack (Z% indexes) +X : top element of X% stack + +Y% : pending release stack [index into Z%, eval level] +Y : top element of Y% stack + +D : root repl environment + +BT : begin time (TI) +ER : error type (-2: none, -1: string, >=0: object) +E$ : error string (ER=-1) +EZ : READLINE EOF return, READ_FILE EOF temp + +LV : EVAL stack call level/depth + +RI : reader current string position +RJ : READ_TOKEN current character index + + +Calling arguments/temporaries: + +A : common call argument (especially EVAL, EVAL_AST) +A$ : common call argument (READLINE, reader, string temp, key value) +B : common call argument +B$ : STRING arg for HASHMAP_GET, PR_STR_SEQ separator + : INIT_CORE_SET_FUNCTION, ENV_SET_S, ASSOC1_S +C : common call argument, DO_TCO_FUNCTION temp in DO_APPLY +E : environment (EVAL, EVAL_AST) +F : function +H : hash map +K : hash map key (Z% index) +L : ALLOC* Z%(R,1) default +M : ALLOC* Z%(R+1,0) default +N : ALLOC* Z%(R+1,1) default +R : common return value +R$ : common string return value +T : type arg, common temp +Q : PUSH*, POP*, PEEK* return value (and PEEK_Q_Q call arg) + +AR : APPLY, DO_*_FUNCTION arg list +AY : RELEASE/FREE arg +AZ : PR_STR arg +P1 : PR_MEMORY*, PR_OBJECT, CHECK_FREE_LIST start +P2 : PR_MEMORY*, PR_OBJECT, CHECK_FREE_LIST end +P3 : PR_OBJECT, PR_MEMORY_VALUE +R1 : REP, RE - MAL_READ result temp +R2 : REP, RE - EVAL result temp +R3 : HASHMAP_GET, DO_HASH_MAP, DO_KEYS_VALS temp and return value +R6 : SLICE return value (last element) +SZ : size argument to ALLOC +S1$ : REPLACE needle +S2$ : REPLACE replacement + + +Other temporaries: + +A0 : EVAL ast elements +A1 : EVAL ast elements, DO_FUNCTION temp +A2 : EVAL ast elements, DO_FUNCTION temp +A3 : EVAL ast elements +B1 : DO_FUNCTION temp + +CZ : DO_CONCAT stack position +ED : EQUAL_Q recursion depth counter +RD : PR_OBJECT recursion depth +SD : READ_STR sequence read recursion depth + +C$ : READ_TOKEN, SKIP_SPACES, SKIP_TO_EOL current character +D$ : READ_TOKEN/READ_FILE_CHAR temp +G : function value ON GOTO switch flag, EVAL_AST changed flag +I : STRING, REPLACE, SLICE, PR_MEMORY, PR_OBJECT, PR_MEMORY_VALUE +J : REPLACE, PR_MEMORY_VALUE +U : ALLOC, RELEASE, PR_STR temp +V : RELEASE, PR_STR_SEQ temp +W : SLICE, LAST, QUASIQUOTE, DO_HASH_MAP, DO_KEYS_VALS, step2-3 EVAL temp +P : PR_MEMORY_SUMMARY_SMALL +RC : RELEASE remaining number of elements to release +RF : reader reading from file flag +S1 : READ_TOKEN in a string? +S2 : READ_TOKEN escaped? +T$ : READ_* current token string +T1 : EQUAL_Q, PR_STR, DO_KEYS_VALS temp +T2 : EQUAL_Q, DO_KEY_VALS, HASH_MAP_GET +T3$ : REPLACE temp + + +Unused: + +O + + +Counting number of times each variable is assigned: + sed 's/:/\n /g' readline.in.bas types.in.bas reader.in.bas printer.in.bas env.in.bas core.in.bas stepA_mal.in.bas | grep "[A-Z][A-Z0-9]*[%$]*=" | sed 's/.*[^A-Z]\([A-Z][A-Z0-9]*[%$]*\)=.*/\1/g' | sort | uniq -c | sort -n + diff --git a/impls/bbc-basic/Dockerfile b/impls/bbc-basic/Dockerfile new file mode 100644 index 0000000000..11ea280294 --- /dev/null +++ b/impls/bbc-basic/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install brandy diff --git a/impls/bbc-basic/Makefile b/impls/bbc-basic/Makefile new file mode 100644 index 0000000000..16aee59775 --- /dev/null +++ b/impls/bbc-basic/Makefile @@ -0,0 +1,5 @@ +all: + +.PHONY: clean + +clean: diff --git a/impls/bbc-basic/README.md b/impls/bbc-basic/README.md new file mode 100644 index 0000000000..5a7cafc960 --- /dev/null +++ b/impls/bbc-basic/README.md @@ -0,0 +1,93 @@ +# Introduction + +This is an implementation of mal in BBC BASIC V. While there +is already an implementation of mal in BASIC (in the "basic" +directory), it's targeted at much more primitive versions of BASIC and +relies on a pre-processor, both of which make it fairly un-idiomatic +as a BBC BASIC V program. + +BBC BASIC V is the version of BBC BASIC supplied with Acorn's +ARM-based computers from the mid-1980s. It has substantial +enhancements from the 6502-based versions of BBC BASIC, which were +themselves at the advanced end of 8-bit BASICs. Mal uses many of the +advanced features of BBC BASIC V and porting it to older versions +would be difficult. + +Mal is intended to run on all versions of BBC BASIC V and BBC BASIC +VI, as well as on Brandy 1.20.1. For compatibility with Brandy, it +avoids operating system calls where possible. The only exception +is that is has separate mechanisms for reading command-line arguments +under Brandy and RISC OS. + +# Running under Unix + +On Unix systems, this mal implementation can run on the Brandy +interpreter. The tests require the "simple text" build, but mal will +work interactively in graphical builds as well. You can invoke mal +like this: + +``` +cd bbc-basic +brandy stepA_mal.bbc +``` + +# Running under RISC OS + +To run mal under RISC OS, you obviously need to get the files onto +your RISC OS system, and you also need to arrange to tokenize the +BASIC source files. There are scripts to do the latter in the +`riscos` directory, but they do require that the mal source tree be +available under RISC OS without its filenames' being truncated, which +may restrict with filing systems can be used. The HostFS supplied +with ArcEm works fine. + +Once you have the files in RISC OS, you can set things up by running: + +``` +*Dir bbc-basic.riscos +*Run setup +``` + +Then you can invoke the interpreter directly: + +``` +*Run stepA_mal +``` + +At present, there's no filename translation in the `slurp` function, +so many of the example mal programs will fail because they can't load +`core.mal`. + +# Interesting features + +This appears to be the first mal implementation that uses an table-driven +deterministic finite automoton (a state machine) to implement its +tokenizer. + +The mal heap is represented as a large array of fixed-size objects. +Lists and vectors are linked lists of these objects, while hash-maps +are crit-bit trees. + +Mal exceptions are implemented as BBC BASIC errors. Errors generated +by mal are numbered from &40E80900. + +## Assigned error numbers + +No.| Description +---|------------ +&00| Native mal error generated by 'throw' +&1x| Object not of type 'x' +&1F| Miscellaneous type mismatch +&20| Invalid operation on empty list +&21| Wrong number of arguments to function +&22| Undefined symbol +&23| Subscript out of range +&24| Invalid 'catch*' clause +&30| Unexpected end of input +&31| Unexpected ')' +&32| Hash-map key mush be a string +&40| File not found +&50| Out of memory +&Fx| Internal errors (indicating a bug in mal) +&F0| Unprintable value +&F1| Call to non-existent core function diff --git a/impls/bbc-basic/core b/impls/bbc-basic/core new file mode 120000 index 0000000000..221a59b075 --- /dev/null +++ b/impls/bbc-basic/core @@ -0,0 +1 @@ +core.bas \ No newline at end of file diff --git a/impls/bbc-basic/core.bas b/impls/bbc-basic/core.bas new file mode 100644 index 0000000000..37cdbc2a93 --- /dev/null +++ b/impls/bbc-basic/core.bas @@ -0,0 +1,495 @@ +REM > core function library for mal in BBC BASIC + +REM BBC BASIC doesn't have function pointers. There are essentially +REM two ways to work around this. One is to use the BASIC EVAL function, +REM constructing a string that will call an arbitrary function with the +REM specified arguments. The other is to us a big CASE statement. +REM Following the suggestion in Hints.md, this code takes the latter +REM approach. + +DEF PROCcore_ns + RESTORE +0 + REM The actual DATA statements are embedded in the dispatch table below. +ENDPROC + +REM Call a core function, taking the function number and a mal list of +REM objects to pass as arguments. +DEF FNcore_call(fn%, args%) + LOCAL args%(), arg$ + DIM args%(1) + CASE fn% OF + DATA +, 0 + WHEN 0 + PROCcore_prepare_args("ii", "+") + =FNalloc_int(args%(0) + args%(1)) + DATA -, 1 + WHEN 1 + PROCcore_prepare_args("ii", "-") + =FNalloc_int(args%(0) - args%(1)) + DATA *, 2 + WHEN 2 + PROCcore_prepare_args("ii", "*") + =FNalloc_int(args%(0) * args%(1)) + DATA /, 3 + WHEN 3 + PROCcore_prepare_args("ii", "/") + =FNalloc_int(args%(0) DIV args%(1)) + DATA list, 5 + WHEN 5 + =FNas_list(args%) + DATA list?, 6 + WHEN 6 + PROCcore_prepare_args("?", "list?") + =FNalloc_boolean(FNis_list(args%(0))) + DATA empty?, 7 + WHEN 7 + PROCcore_prepare_args("l", "empty?") + =FNalloc_boolean(FNis_empty(args%(0))) + DATA count, 8 + WHEN 8 + PROCcore_prepare_args("C", "count") + IF FNis_nil(args%(0)) THEN =FNalloc_int(0) + =FNalloc_int(FNcount(args%(0))) + DATA =, 9 + WHEN 9 + PROCcore_prepare_args("??", "=") + =FNalloc_boolean(FNcore_equal(args%(0), args%(1))) + DATA <, 10 + WHEN 10 + PROCcore_prepare_args("ii", "<") + =FNalloc_boolean(args%(0) < args%(1)) + DATA <=, 11 + WHEN 11 + PROCcore_prepare_args("ii", "<=") + =FNalloc_boolean(args%(0) <= args%(1)) + DATA >, 12 + WHEN 12 + PROCcore_prepare_args("ii", ">") + =FNalloc_boolean(args%(0) > args%(1)) + DATA >=, 13 + WHEN 13 + PROCcore_prepare_args("ii", ">=") + =FNalloc_boolean(args%(0) >= args%(1)) + DATA read-string, 14 + WHEN 14 + PROCcore_prepare_args("t", "read-string") + =FNread_str(args%(0)) + DATA slurp, 15 + WHEN 15 + PROCcore_prepare_args("s", "slurp") + =FNcore_slurp(arg$) + DATA eval, 16 + WHEN 16 + PROCcore_prepare_args("?", "eval") + =FNEVAL(args%(0), repl_env%) + DATA pr-str, 17 + WHEN 17 + =FNcore_print(TRUE, " ", args%) + DATA str, 18 + WHEN 18 + =FNcore_print(FALSE, "", args%) + DATA prn, 4 + WHEN 4 + PRINT FNunbox_string(FNcore_print(TRUE, " ", args%)) + =FNnil + DATA println, 19 + WHEN 19 + PRINT FNunbox_string(FNcore_print(FALSE, " ", args%)) + =FNnil + DATA atom, 20 + WHEN 20 + PROCcore_prepare_args("?", "atom") + =FNalloc_atom(args%(0)) + DATA atom?, 21 + WHEN 21 + PROCcore_prepare_args("?", "atom?") + =FNalloc_boolean(FNis_atom(args%(0))) + DATA deref, 22 + WHEN 22 + PROCcore_prepare_args("a", "deref") + =FNatom_deref(args%(0)) + DATA reset!, 23 + WHEN 23 + PROCcore_prepare_args("a?", "reset!") + PROCatom_reset(args%(0), args%(1)) + =args%(1) + DATA swap!, 24 + WHEN 24 + PROCcore_prepare_args("af*", "swap!") + PROCatom_reset(args%(0), FNcore_apply(args%(1), FNalloc_pair(FNatom_deref(args%(0)), args%))) + =FNatom_deref(args%(0)) + DATA cons, 25 + WHEN 25 + PROCcore_prepare_args("?l", "cons") + =FNalloc_pair(args%(0), args%(1)) + DATA concat, 26 + WHEN 26 + =FNcore_concat(args%) + DATA nth, 27 + WHEN 27 + PROCcore_prepare_args("li", "nth") + =FNnth(args%(0), args%(1)) + DATA first, 28 + WHEN 28 + PROCcore_prepare_args("C", "first") + IF FNis_nil(args%(0)) THEN =FNnil + =FNfirst(args%(0)) + DATA rest, 29 + WHEN 29 + PROCcore_prepare_args("C", "rest") + IF FNis_nil(args%(0)) THEN =FNempty + =FNas_list(FNrest(args%(0))) + DATA throw, 30 + WHEN 30 + PROCcore_prepare_args("?", "throw") + MAL_ERR% = args%(0) + ERROR &40E80900, "Mal exception: " + FNunbox_string(FNpr_str(args%(0), FALSE)) + DATA apply, 31 + WHEN 31 + PROCcore_prepare_args("f?*", "apply") + =FNcore_apply(args%(0), FNcore_apply_args(FNalloc_pair(args%(1), args%))) + DATA map, 32 + WHEN 32 + PROCcore_prepare_args("fl", "map") + =FNcore_map(args%(0), args%(1)) + DATA nil?, 33 + WHEN 33 + PROCcore_prepare_args("?", "nil?") + =FNalloc_boolean(FNis_nil(args%(0))) + DATA true?, 34 + WHEN 34 + PROCcore_prepare_args("?", "true?") + IF NOT FNis_boolean(args%(0)) THEN =FNalloc_boolean(FALSE) + =args%(0) + DATA false?, 35 + WHEN 35 + PROCcore_prepare_args("?", "false?") + IF NOT FNis_boolean(args%(0)) THEN =FNalloc_boolean(FALSE) + =FNalloc_boolean(NOT FNunbox_boolean(args%(0))) + DATA symbol?, 36 + WHEN 36 + PROCcore_prepare_args("?", "symbol?") + =FNalloc_boolean(FNis_symbol(args%(0))) + DATA symbol, 37 + WHEN 37 + PROCcore_prepare_args("s", "symbol") + =FNalloc_symbol(arg$) + DATA keyword, 38 + WHEN 38 + PROCcore_prepare_args("s", "keyword") + IF LEFT$(arg$, 1) <> CHR$(127) THEN arg$ = CHR$(127) + arg$ + =FNalloc_string(arg$) + DATA keyword?, 39 + WHEN 39 + PROCcore_prepare_args("?", "keyword?") + IF FNis_string(args%(0)) THEN + =FNalloc_boolean(LEFT$(FNunbox_string(args%(0)), 1) = CHR$(127)) + ENDIF + =FNalloc_boolean(FALSE) + DATA vector, 40 + WHEN 40 + =FNas_vector(args%) + DATA vector?, 41 + WHEN 41 + PROCcore_prepare_args("?", "vector?") + =FNalloc_boolean(FNis_vector(args%(0))) + DATA sequential?, 42 + WHEN 42 + PROCcore_prepare_args("?", "sequential?") + =FNalloc_boolean(FNis_seq(args%(0))) + DATA hash-map, 43 + WHEN 43 + =FNcore_assoc(FNempty_hashmap, args%) + DATA map?, 44 + WHEN 44 + PROCcore_prepare_args("?", "map?") + =FNalloc_boolean(FNis_hashmap(args%(0))) + DATA assoc, 45 + WHEN 45 + PROCcore_prepare_args("h*", "assoc") + =FNcore_assoc(args%(0), args%) + DATA dissoc, 46 + WHEN 46 + PROCcore_prepare_args("h*", "dissoc") + WHILE NOT FNis_empty(args%) + args%(0) = FNhashmap_remove(args%(0), FNunbox_string(FNfirst(args%))) + args% = FNrest(args%) + ENDWHILE + =args%(0) + DATA get, 47 + WHEN 47 + IF FNis_nil(FNfirst(args%)) THEN =FNnil + PROCcore_prepare_args("hs", "get") + =FNhashmap_get(args%(0), arg$) + DATA contains?, 48 + WHEN 48 + PROCcore_prepare_args("hs", "contains?") + =FNalloc_boolean(FNhashmap_contains(args%(0), arg$)) + DATA keys, 49 + WHEN 49 + PROCcore_prepare_args("h", "keys") + =FNhashmap_keys(args%(0)) + DATA vals, 50 + WHEN 50 + PROCcore_prepare_args("h", "vals") + =FNhashmap_vals(args%(0)) + DATA readline, 51 + WHEN 51 + PROCcore_prepare_args("s", "readline") + PRINT arg$; + LINE INPUT "" arg$ + =FNalloc_string(arg$) + DATA meta, 52 + WHEN 52 + PROCcore_prepare_args("?", "meta") + =FNmeta(args%(0)) + DATA with-meta, 53 + WHEN 53 + PROCcore_prepare_args("??", "with-meta") + =FNwith_meta(args%(0), args%(1)) + DATA time-ms, 54 + WHEN 54 + PROCcore_prepare_args("", "time-ms") + =FNalloc_int(TIME * 10) + DATA conj, 55 + WHEN 55 + PROCcore_prepare_args("l*", "conj") + IF FNis_list(args%(0)) THEN + WHILE NOT FNis_empty(args%) + args%(0) = FNalloc_pair(FNfirst(args%), args%(0)) + args% = FNrest(args%) + ENDWHILE + =args%(0) + ELSE : REM args%(0) is a vector + =FNas_vector(FNcore_concat1(args%(0), args%)) + ENDIF + DATA string?, 56 + WHEN 56 + PROCcore_prepare_args("?", "string?") + IF FNis_string(args%(0)) THEN + =FNalloc_boolean(LEFT$(FNunbox_string(args%(0)), 1) <> CHR$(127)) + ENDIF + =FNalloc_boolean(FALSE) + DATA number?, 57 + WHEN 57 + PROCcore_prepare_args("?", "number?") + =FNalloc_boolean(FNis_int(args%(0))) + DATA fn?, 58 + WHEN 58 + PROCcore_prepare_args("?", "fn?") + =FNalloc_boolean(FNis_nonmacro_fn(args%(0)) OR FNis_corefn(args%(0))) + DATA macro?, 59 + WHEN 59 + PROCcore_prepare_args("?", "macro?") + =FNalloc_boolean(FNis_macro(args%(0))) + DATA seq, 60 + WHEN 60 + PROCcore_prepare_args("?", "seq") + =FNcore_seq(args%(0)) + DATA vec, 61 + WHEN 61 + PROCcore_prepare_args("l", "vec") + =FNas_vector(args%(0)) + DATA "", -1 + ENDCASE +ERROR &40E809F1, "Call to non-existent core function" + +DEF PROCcore_prepare_args(spec$, fn$) + REM Check that a core function is being provided with the correct + REM number and type of arguments and unbox them as appropriate. + REM spec$ is the argument specification as a string. Each character + REM represents an argument: + + REM "i" - Must be an integer; unbox into args%() + REM "s" - Must be a string; unbox into arg$ + REM "t" - Must be a string; stuff into args%() + REM "l" - Must be a sequence; stuff into args%() + REM "f" - Must be a function; stuff into args%() + REM "a" - Must be an atom; stuff into args%() + REM "h" - Must be a hash-map; stuff into args%() + REM "C" - Must be 'count'able stuff into args%() + REM "?" - Any single argument stuff into args%() + REM "*" - Any number of (trailing) arguments; leave in args% + + REM This function shares some local variables with FNcore_call. + + LOCAL i%, val% + + IF RIGHT$(spec$) = "*" THEN + spec$ = LEFT$(spec$) + IF FNcount(args%) < LEN(spec$) THEN + ERROR &40E80921, "Core function '"+fn$+"' requires at least "+STR$(LEN(spec$))+" arguments" + ENDIF + ELSE + IF FNcount(args%) <> LEN(spec$) THEN + ERROR &40E80921, "Core function '"+fn$+"' requires "+STR$(LEN(spec$))+" arguments" + ENDIF + ENDIF + FOR i% = 1 TO LEN(spec$) + val% = FNfirst(args%) + CASE MID$(spec$, i%, 1) OF + WHEN "i" + IF NOT FNis_int(val%) THEN + ERROR &40E80911, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be an integer" + ENDIF + args%(i% - 1) = FNunbox_int(val%) + WHEN "s" + IF NOT FNis_string(val%) THEN + ERROR &40E80914, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a string" + ENDIF + arg$ = FNunbox_string(val%) + WHEN "t" + IF NOT FNis_string(val%) THEN + ERROR &40E80914, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a string" + ENDIF + args%(i% - 1) = val% + WHEN "l" + IF NOT FNis_seq(val%) THEN + ERROR &40E80916, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a sequence" + ENDIF + args%(i% - 1) = val% + WHEN "f" + IF NOT FNis_fn(val%) AND NOT FNis_corefn(val%) THEN + ERROR &40E80919, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a function" + ENDIF + args%(i% - 1) = val% + WHEN "a" + IF NOT FNis_atom(val%) THEN + ERROR &40E8091C, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be an atom" + ENDIF + args%(i% - 1) = val% + WHEN "h" + IF NOT FNis_hashmap(val%) THEN + ERROR &40E8091D, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a hash-map" + ENDIF + args%(i% - 1) = val% + WHEN "C" + IF NOT FNis_seq(val%) AND NOT FNis_nil(val%) THEN + ERROR &40E8091F, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a countable value" + ENDIF + args%(i% - 1) = val% + WHEN "?" + args%(i% - 1) = val% + ENDCASE + args% = FNrest(args%) + NEXT i% +ENDPROC + +REM Innards of the '=' function. +DEF FNcore_equal(a%, b%) + IF a% = b% THEN =TRUE + IF FNis_int(a%) AND FNis_int(b%) THEN =FNunbox_int(a%) = FNunbox_int(b%) + IF FNis_symbol(a%) AND FNis_symbol(b%) THEN + =FNunbox_symbol(a%) = FNunbox_symbol(b%) + ENDIF + IF FNis_string(a%) AND FNis_string(b%) THEN + =FNunbox_string(a%) = FNunbox_string(b%) + ENDIF + IF FNis_seq(a%) AND FNis_seq(b%) THEN + IF FNis_empty(a%) AND FNis_empty(b%) THEN =TRUE + IF FNis_empty(a%) <> FNis_empty(b%) THEN =FALSE + IF NOT FNcore_equal(FNfirst(a%), FNfirst(b%)) THEN =FALSE + =FNcore_equal(FNrest(a%), FNrest(b%)) + ENDIF + IF FNis_hashmap(a%) AND FNis_hashmap(b%) THEN + REM Take advantage of the sorted keys in our hash-maps. + IF FNcore_equal(FNhashmap_keys(a%), FNhashmap_keys(b%)) THEN + IF FNcore_equal(FNhashmap_vals(a%), FNhashmap_vals(b%)) THEN =TRUE + ENDIF + ENDIF +=FALSE + +REM Innards of the 'slurp' function. +DEF FNcore_slurp(file$) + LOCAL f%, out% + f% = OPENIN(file$) + IF f% = 0 THEN ERROR &40E80940, "File '"+file$+"' not found" + out% = FNcore_slurp_channel(f%) + CLOSE#f% +=out% + +DEF FNcore_slurp_channel(f%) + LOCAL this% + IF EOF#f% THEN =FNalloc_string("") + REM GET$# doesn't include a trailing newline. + this% = FNalloc_string(GET$#f% + CHR$(10)) +=FNstring_concat(this%, FNcore_slurp_channel(f%)) + +REM General-purpose printing function +DEF FNcore_print(print_readably%, sep$, args%) + LOCAL out% + IF FNis_empty(args%) THEN =FNalloc_string("") + out% = FNpr_str(FNfirst(args%), print_readably%) + args% = FNrest(args%) + WHILE NOT FNis_empty(args%) + out% = FNstring_append(out%, sep$) + out% = FNstring_concat(out%, FNpr_str(FNfirst(args%), print_readably%)) + args% = FNrest(args%) + ENDWHILE +=out% + +REM Innards of the 'apply' function, also used by 'swap!' +DEF FNcore_apply(fn%, args%) + LOCAL ast%, env% + IF FNis_corefn(fn%) THEN =FNcore_call(FNunbox_corefn(fn%), args%) + IF FNis_fn(fn%) THEN + ast% = FNfn_ast(fn%) + env% = FNnew_env(FNfn_env(fn%), FNfn_params(fn%), args%) + =FNEVAL(ast%, env%) + ENDIF +ERROR &40E80918, "Not a function" + +REM Innards of 'concat' function +DEF FNcore_concat(args%) + LOCAL tail% + IF FNis_empty(args%) THEN =FNempty + tail% = FNcore_concat(FNrest(args%)) +=FNcore_concat1(FNfirst(args%), tail%) + +DEF FNcore_concat1(prefix%, tail%) + IF FNis_empty(prefix%) THEN =tail% +=FNalloc_pair(FNfirst(prefix%), FNcore_concat1(FNrest(prefix%), tail%)) + +REM Recursively assemble the argument list for 'apply' +DEF FNcore_apply_args(args%) + IF FNis_empty(FNrest(args%)) THEN =FNfirst(args%) +=FNalloc_pair(FNfirst(args%), FNcore_apply_args(FNrest(args%))) + +REM Innards of the 'map' function +DEF FNcore_map(fn%, args%) + LOCAL car%, cdr% + IF FNis_empty(args%) THEN =args% + car% = FNcore_apply(fn%, FNalloc_pair(FNfirst(args%), FNempty)) + cdr% = FNcore_map(fn%, FNrest(args%)) +=FNalloc_pair(car%, cdr%) + +REM Innards of the 'hash-map' function +DEF FNcore_assoc(map%, args%) + LOCAL args%() + DIM args%(1) + WHILE NOT FNis_empty(args%) + PROCcore_prepare_args("s?*", "hash-map") + map% = FNhashmap_set(map%, arg$, args%(1)) + ENDWHILE +=map% + +REM Innards of the 'seq' function +DEF FNcore_seq(val%) + LOCAL s$, i% + IF FNis_empty(val%) OR FNis_nil(val%) THEN =FNnil + IF FNis_list(val%) THEN =val% + IF FNis_vector(val%) THEN =FNas_list(val%) + IF FNis_string(val%) THEN + s$ = FNunbox_string(val%) + IF s$ = "" THEN =FNnil + val% = FNempty + FOR i% = LEN(s$) TO 1 STEP -1 + val% = FNalloc_pair(FNalloc_string(MID$(s$, i%, 1)), val%) + NEXT i% + =val% + ENDIF +ERROR &40E8091F, "Argument to 'seq' must be list, vector, string, or nil" + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/env b/impls/bbc-basic/env new file mode 120000 index 0000000000..df140814ee --- /dev/null +++ b/impls/bbc-basic/env @@ -0,0 +1 @@ +env.bas \ No newline at end of file diff --git a/impls/bbc-basic/env.bas b/impls/bbc-basic/env.bas new file mode 100644 index 0000000000..43fc219b27 --- /dev/null +++ b/impls/bbc-basic/env.bas @@ -0,0 +1,39 @@ +REM > env library for mal in BBC BASIC + +DEF FNnew_env(outer%, binds%, exprs%) + LOCAL env%, key$ + env% = FNalloc_environment(outer%) + WHILE NOT FNis_empty(binds%) + key$ = FNunbox_symbol(FNfirst(binds%)) + IF key$ = "&" THEN + PROCenv_set(env%, FNunbox_symbol(FNnth(binds%, 1)), FNas_list(exprs%)) + binds% = FNempty + ELSE + PROCenv_set(env%, key$, FNfirst(exprs%)) + binds% = FNrest(binds%) : exprs% = FNrest(exprs%) + ENDIF + ENDWHILE +=env% + +DEF PROCenv_set(env%, key$, val%) + LOCAL data% + data% = FNenvironment_data(env%) + data% = FNhashmap_set(data%, key$, val%) + PROCenvironment_set_data(env%, data%) +ENDPROC + +DEF FNenv_find(env%, key$) + WHILE NOT FNis_nil(env%) + IF FNhashmap_contains(FNenvironment_data(env%), key$) THEN =env% + env% = FNenvironment_outer(env%) + ENDWHILE +=FNnil + +DEF FNenv_get(env%, key$) + env% = FNenv_find(env%, key$) + IF FNis_nil(env%) THEN ERROR &40E80922, "'"+key$+"' not found" +=FNhashmap_get(FNenvironment_data(env%), key$) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/printer b/impls/bbc-basic/printer new file mode 120000 index 0000000000..0f91f6344b --- /dev/null +++ b/impls/bbc-basic/printer @@ -0,0 +1 @@ +printer.bas \ No newline at end of file diff --git a/impls/bbc-basic/printer.bas b/impls/bbc-basic/printer.bas new file mode 100644 index 0000000000..15f1aa8c1c --- /dev/null +++ b/impls/bbc-basic/printer.bas @@ -0,0 +1,66 @@ +REM > printer library for mal in BBC BASIC + +DEF FNpr_str(val%, print_readably%) + LOCAL ret%, term$, val$, keys%, vals% + IF FNis_nil(val%) THEN =FNalloc_string("nil") + IF FNis_boolean(val%) THEN + IF FNunbox_boolean(val%) THEN =FNalloc_string("true") + =FNalloc_string("false") + ENDIF + IF FNis_int(val%) THEN =FNalloc_string(STR$(FNunbox_int(val%))) + IF FNis_string(val%) THEN + IF FNstring_chr(val%, 1) = CHR$(127) THEN =FNalloc_string(":" + MID$(FNunbox_string(val%), 2)) + IF print_readably% THEN =FNalloc_string(FNformat_string(FNunbox_string(val%))) ELSE =val% + ENDIF + IF FNis_symbol(val%) THEN =FNalloc_string(FNunbox_symbol(val%)) + IF FNis_corefn(val%) OR FNis_fn(val%) THEN =FNalloc_string("#") + IF FNis_seq(val%) THEN + IF FNis_vector(val%) THEN + ret% = FNalloc_string("[") : term$ = "]" + ELSE + ret% = FNalloc_string("(") : term$ = ")" + ENDIF + WHILE NOT FNis_empty(val%) + IF FNstring_len(ret%) > 1 THEN ret% = FNstring_append(ret%, " ") + ret% = FNstring_concat(ret%, FNpr_str(FNfirst(val%), print_readably%)) + val% = FNrest(val%) + ENDWHILE + =FNstring_append(ret%, term$) + ENDIF + IF FNis_hashmap(val%) THEN + ret% = FNalloc_string("{") + keys% = FNhashmap_keys(val%) + vals% = FNhashmap_vals(val%) + WHILE NOT FNis_empty(keys%) + IF FNstring_len(ret%) > 1 THEN ret% = FNstring_append(ret%, " ") + ret% = FNstring_concat(ret%, FNpr_str(FNfirst(keys%), print_readably%)) + ret% = FNstring_append(ret%, " ") + ret% = FNstring_concat(ret%, FNpr_str(FNfirst(vals%), print_readably%)) + keys% = FNrest(keys%) + vals% = FNrest(vals%) + ENDWHILE + =FNstring_append(ret%, "}") + ENDIF + IF FNis_atom(val%) THEN + ret% = FNalloc_string("(atom ") + ret% = FNstring_concat(ret%, FNpr_str(FNatom_deref(val%), print_readably%)) + =FNstring_append(ret%, ")") + ENDIF + ERROR &40E809F0, "Unprintable value" + +DEF FNformat_string(strval$) + LOCAL ptr%, c$, out$ + IF strval$ = "" THEN ="""""" + FOR ptr% = 1 TO LEN(strval$) + c$ = MID$(strval$, ptr%, 1) + CASE c$ OF + WHEN "\", """": out$ += "\" + c$ + WHEN CHR$(10): out$ += "\n" + OTHERWISE: out$ += c$ + ENDCASE + NEXT ptr% +="""" + out$ + """" + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/reader b/impls/bbc-basic/reader new file mode 120000 index 0000000000..2ea5e5744f --- /dev/null +++ b/impls/bbc-basic/reader @@ -0,0 +1 @@ +reader.bas \ No newline at end of file diff --git a/impls/bbc-basic/reader.bas b/impls/bbc-basic/reader.bas new file mode 100644 index 0000000000..18e736d69f --- /dev/null +++ b/impls/bbc-basic/reader.bas @@ -0,0 +1,198 @@ +REM > reader library for mal in BBC BASIC + +REM ** Reader ** + +REM The Reader object is implemented as an array and a mutable pointer. + +DEF FNreader_peek(tokens$(), RETURN tokptr%) +=tokens$(tokptr%) + +DEF FNreader_next(token$(), RETURN tokptr%) + tokptr% += 1 +=tokens$(tokptr% - 1) + +DEF FNread_str(src%) + LOCAL ntokens%, tokptr%, tokens$() + DIM tokens$(2048) + ntokens% = FNtokenize(src%, tokens$()) + tokptr% = 0 +=FNread_form(tokens$(), tokptr%) + +REM ** Tokenizer ** + +DEF FNtokenize(src%, tokens$()) + REM The tokenizer is implemented explicitly as a deterministic + REM finite automaton. + LOCAL p%, state%, tok$, tokptr%, c$, rc$, match$, action% + LOCAL DATA + + state% = 1 + tokptr% = 0 + tok$ = "" + FOR p% = 1 TO FNstring_len(src%) + c$ = FNstring_chr(src%, p%) + rc$ = c$ + REM Convert some characters to ones that are easier to put into + REM DATA statements. These substitutions are only used for + REM matching: the token still contains the original character. + CASE ASC(c$) OF + REM Fold some upper-case letters together so that we can re-use + REM them to represent more awkward characters. + WHEN 78, 81: c$ = "A" + REM Now convert newlines into "N" + WHEN 10: c$ = "N" + REM These are the other characters that Perl's "\s" escape matches. + WHEN 9, 11, 12, 13: c$ = " " + REM Brandy has a bug whereby it doesn't correctly parse strings + REM in DATA statements that begin with quotation marks, so convert + REM quotation marks to "Q". + WHEN 34: c$ = "Q" + ENDCASE + REM The state table consists of a DATA statement for each current + REM state, which triples representing transitions. Each triple + REM consists of a string of characters to match, an action, and a + REM next state. A matching string of "" matches any character, + REM and hence marks the end of a state. + + REM Actions are: + REM 0: Add this character to the current token + REM 1: Emit token; start a new token with this character + REM 5: Emit token; skip this character + + RESTORE +state% + REM state 1: Initial state, or inside a bare word + DATA " N,",5,1, "~",1,5, "[]{}()'`^@",1,3, Q,1,7, ";",5,11, "",0,1 + REM state 3: Just seen the end of a token + DATA " N,",5,1, "~",1,5, "[]{}()'`^@",1,3, Q,1,7, ";",5,11, "",1,1 + REM state 5: Just seen a "~" + DATA " N,",5,1, "@",0,3, "~",1,5, "[]{}()'`^@",1,3, Q,1,7, ";",5,11, "",1,1 + REM state 7: Inside a quoted string + DATA "\",0,9, Q,0,3, "",0,7 + REM state 9: After a backslash in a string + DATA "",0,7 + REM state 11: Inside a comment + DATA N,5,3, "",5,11 + + REM Find a matching transition from the current state. + REM PRINT ;state%;"-->"; + REPEAT + READ match$, action%, state% + REM PRINT "[";match$;"](";action%;",";state%;")"; + UNTIL match$ = "" OR INSTR(match$, c$) > 0 + REM PRINT ;"-->";state% + + REM Execute any actions. + IF action% AND 1 AND tokens$(tokptr%) <> "" THEN tokptr% += 1 + IF (action% AND 4) = 0 THEN tokens$(tokptr%) += rc$ + NEXT p% + IF tokens$(tokptr%) <> "" THEN tokptr% += 1 +=tokptr% + +REM ** More Reader ** + +DEF FNread_form(tokens$(), RETURN tokptr%) + LOCAL tok$, x% + tok$ = FNreader_peek(tokens$(), tokptr%) + CASE tok$ OF + WHEN "" : ERROR &40E80930, "Unexpected end of input" + WHEN "(": =FNread_list(tokens$(), tokptr%) + WHEN "[": =FNread_vector(tokens$(), tokptr%) + WHEN "{": =FNread_hashmap(tokens$(), tokptr%) + WHEN ")", "]", "}": ERROR &40E80931, "Unexpected '"+tok$ +"'" + WHEN "'": =FNreader_macro("quote", tokens$(), tokptr%) + WHEN "`": =FNreader_macro("quasiquote", tokens$(), tokptr%) + WHEN "~": =FNreader_macro("unquote", tokens$(), tokptr%) + WHEN "~@":=FNreader_macro("splice-unquote", tokens$(), tokptr%) + WHEN "@": =FNreader_macro("deref", tokens$(), tokptr%) + WHEN "^": =FNread_with_meta(tokens$(), tokptr%) + ENDCASE +=FNread_atom(tokens$(), tokptr%) + +DEF FNread_list(tokens$(), RETURN tokptr%) + LOCAL tok$ + tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "(" +=FNread_list_tail(tokens$(), tokptr%, ")") + +DEF FNread_vector(tokens$(), RETURN tokptr%) + LOCAL tok$ + tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "[" +=FNas_vector(FNread_list_tail(tokens$(), tokptr%, "]")) + +DEF FNread_list_tail(tokens$(), RETURN tokptr%, term$) + LOCAL tok$, car%, cdr% + IF FNreader_peek(tokens$(), tokptr%) = term$ THEN + tok$ = FNreader_next(tokens$(), tokptr%) + =FNempty + ENDIF + car% = FNread_form(tokens$(), tokptr%) + cdr% = FNread_list_tail(tokens$(), tokptr%, term$) +=FNalloc_pair(car%, cdr%) + +DEF FNread_hashmap(tokens$(), RETURN tokptr%) + LOCAL tok$, map%, key%, val% + tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "{" + map% = FNempty_hashmap + WHILE FNreader_peek(tokens$(), tokptr%) <> "}" + key% = FNread_form(tokens$(), tokptr%) + IF NOT FNis_string(key%) ERROR &40E80932, "Hash-map key must be a string" + val% = FNread_form(tokens$(), tokptr%) + map% = FNhashmap_set(map%, FNunbox_string(key%), val%) + ENDWHILE + tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "}" +=map% + +DEF FNreader_macro(quote$, token$(), RETURN tokptr%) + LOCAL tok$ + tok$ = FNreader_next(tokens$(), tokptr%) : REM skip quoting token +=FNalloc_list2(FNalloc_symbol(quote$), FNread_form(tokens$(), tokptr%)) + +DEF FNread_with_meta(token$(), RETURN tokptr%) + LOCAL tok$, wm%, base%, meta% + tok$ = FNreader_next(tokens$(), tokptr%) : REM skip '^' token + wm% = FNalloc_symbol("with-meta") + meta% = FNread_form(tokens$(), tokptr%) + base% = FNread_form(tokens$(), tokptr%) +=FNalloc_list3(wm%, base%, meta%) + +DEF FNis_token_numeric(tok$) + LOCAL i%, c% + IF LEFT$(tok$, 1) = "-" THEN tok$ = MID$(tok$, 2) + IF LEN(tok$) = 0 THEN =FALSE + FOR i% = 1 TO LEN(tok$) + c% = ASC(MID$(tok$, i%, 1)) + IF c% < &30 OR c% > &39 THEN =FALSE + NEXT i% +=TRUE + +DEF FNread_atom(tokens$(), RETURN tokptr%) + LOCAL strval$ + strval$ = FNreader_next(tokens$(), tokptr%) + IF strval$ = "nil" THEN =FNnil + IF strval$ = "true" THEN =FNalloc_boolean(TRUE) + IF strval$ = "false" THEN =FNalloc_boolean(FALSE) + IF LEFT$(strval$, 1) = """" THEN =FNalloc_string(FNunquote_string(strval$)) + IF LEFT$(strval$, 1) = ":" THEN =FNalloc_string(CHR$(127) + MID$(strval$, 2)) + IF FNis_token_numeric(strval$) THEN =FNalloc_int(VAL(strval$)) +=FNalloc_symbol(strval$) + +DEF FNunquote_string(strval$) + LOCAL inptr%, bs%, out$, c$ + IF RIGHT$(strval$, 1) <> """" THEN ERROR &40E80930, "Unexpected end of input" + inptr% = 2 + REPEAT + bs% = INSTR(strval$, "\", inptr%) + IF bs% > 0 THEN + out$ += MID$(strval$, inptr%, bs% - inptr%) + c$ = MID$(strval$, bs% + 1, 1) + IF c$ = "n" THEN c$ = CHR$(10) + out$ += c$ + inptr% = bs% + 2 + ENDIF + UNTIL bs% = 0 + IF inptr% = LEN(strval$) + 1 THEN ERROR &40E80930, "Unexpected end of input" + out$ += MID$(strval$, inptr%, LEN(strval$) - inptr%) +=out$ + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/riscos/.gitignore b/impls/bbc-basic/riscos/.gitignore new file mode 100644 index 0000000000..22421ae290 --- /dev/null +++ b/impls/bbc-basic/riscos/.gitignore @@ -0,0 +1 @@ +*,ffb diff --git a/impls/bbc-basic/riscos/setup,feb b/impls/bbc-basic/riscos/setup,feb new file mode 100644 index 0000000000..a99ea78e63 --- /dev/null +++ b/impls/bbc-basic/riscos/setup,feb @@ -0,0 +1,2 @@ +| This Obey file sets up the environment for running mal on RISC OS. +BASIC { < tokenize } diff --git a/impls/bbc-basic/riscos/tokenize,ffe b/impls/bbc-basic/riscos/tokenize,ffe new file mode 100644 index 0000000000..f192e6f9da --- /dev/null +++ b/impls/bbc-basic/riscos/tokenize,ffe @@ -0,0 +1,36 @@ +REM Tokenizing libraries... +TEXTLOAD "^.core/bas" +SAVE "core" +TEXTLOAD "^.env/bas" +SAVE "env" +TEXTLOAD "^.printer/bas" +SAVE "printer" +TEXTLOAD "^.reader/bas" +SAVE "reader" +TEXTLOAD "^.types/bas" +SAVE "types" +REM Tokenizing steps... +TEXTLOAD "^.step0_repl/bas" +SAVE "step0_repl" +TEXTLOAD "^.step1_read_print/bas" +SAVE "step1_read_print" +TEXTLOAD "^.step2_eval/bas" +SAVE "step2_eval" +TEXTLOAD "^.step3_env/bas" +SAVE "step3_env" +TEXTLOAD "^.step4_if_fn_do/bas" +SAVE "step4_if_fn_do" +TEXTLOAD "^.step5_tco/bas" +SAVE "step5_tco" +TEXTLOAD "^.step6_file/bas" +SAVE "step6_file" +TEXTLOAD "^.step7_quote/bas" +SAVE "step7_quote" +TEXTLOAD "^.step8_macros/bas" +SAVE "step8_macros" +TEXTLOAD "^.step9_try/bas" +SAVE "step9_try" +TEXTLOAD "^.stepA_mal/bas" +SAVE "stepA_mal" +REM All done. +QUIT diff --git a/impls/bbc-basic/run b/impls/bbc-basic/run new file mode 100755 index 0000000000..b3e2049a09 --- /dev/null +++ b/impls/bbc-basic/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +exec "${BRANDY:-sbrandy}" -size 1024k \ + -path ../bbc-basic -quit $(dirname $0)/${STEP:-stepA_mal}.bas "${@}" diff --git a/impls/bbc-basic/step0_repl.bas b/impls/bbc-basic/step0_repl.bas new file mode 100644 index 0000000000..aa2a41261e --- /dev/null +++ b/impls/bbc-basic/step0_repl.bas @@ -0,0 +1,25 @@ +REM Step 0 of mal in BBC BASIC + +REPEAT + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=a$ + +DEF FNEVAL(a$) +=a$ + +DEF FNPRINT(a$) +=a$ + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$))) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step1_read_print.bas b/impls/bbc-basic/step1_read_print.bas new file mode 100644 index 0000000000..eae2bd5fa6 --- /dev/null +++ b/impls/bbc-basic/step1_read_print.bas @@ -0,0 +1,36 @@ +REM Step 1 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" + +PROCtypes_init + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNEVAL(a%) +=a% + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$))) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step2_eval.bas b/impls/bbc-basic/step2_eval.bas new file mode 100644 index 0000000000..1e76d3927b --- /dev/null +++ b/impls/bbc-basic/step2_eval.bas @@ -0,0 +1,83 @@ +REM Step 2 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" + +PROCtypes_init + +REM These correspond with the CASE statement in FNcore_call +repl_env% = FNempty_hashmap +repl_env% = FNhashmap_set(repl_env%, "+", FNalloc_corefn(0)) +repl_env% = FNhashmap_set(repl_env%, "-", FNalloc_corefn(1)) +repl_env% = FNhashmap_set(repl_env%, "*", FNalloc_corefn(2)) +repl_env% = FNhashmap_set(repl_env%, "/", FNalloc_corefn(3)) + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNEVAL(ast%, env%) + LOCAL car%, val%, key$ + REM PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + IF FNis_symbol(ast%) THEN + val% = FNhashmap_get(env%, FNunbox_symbol(ast%)) + IF val% = FNnil THEN ERROR &40E80922, "Symbol not in environment" + =val% + ENDIF + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNEVAL(FNfirst(ast%), env%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, FNeval_ast(FNrest(ast%), env%)) + =FNcore_call(FNunbox_corefn(car%), FNeval_ast(FNrest(ast%), env%)) + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +REM Call a core function, taking the function number and a mal list of +REM objects to pass as arguments. +DEF FNcore_call(fn%, args%) + LOCAL x%, y%, z% + x% = FNunbox_int(FNfirst(args%)) + y% = FNunbox_int(FNfirst(FNrest(args%))) + CASE fn% OF + WHEN 0 : z% = x% + y% + WHEN 1 : z% = x% - y% + WHEN 2 : z% = x% * y% + WHEN 3 : z% = x% DIV y% + OTHERWISE : ERROR &40E809F1, "Call to non-existent core function" + ENDCASE +=FNalloc_int(z%) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step3_env.bas b/impls/bbc-basic/step3_env.bas new file mode 100644 index 0000000000..0892117ba3 --- /dev/null +++ b/impls/bbc-basic/step3_env.bas @@ -0,0 +1,109 @@ +REM Step 3 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" + +PROCtypes_init + +REM These correspond with the CASE statement in FNcore_call +repl_env% = FNalloc_environment(FNnil) +PROCenv_set(repl_env%, "+", FNalloc_corefn(0)) +PROCenv_set(repl_env%, "-", FNalloc_corefn(1)) +PROCenv_set(repl_env%, "*", FNalloc_corefn(2)) +PROCenv_set(repl_env%, "/", FNalloc_corefn(3)) + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNEVAL(ast%, env%) + LOCAL car%, val%, bindings%, key$ + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + =FNEVAL(FNnth(ast%, 2), env%) + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNeval_ast(FNrest(ast%), env%) + =FNcore_call(FNunbox_corefn(car%), ast%) + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +REM Call a core function, taking the function number and a mal list of +REM objects to pass as arguments. +DEF FNcore_call(fn%, args%) + LOCAL x%, y%, z% + x% = FNunbox_int(FNfirst(args%)) + y% = FNunbox_int(FNfirst(FNrest(args%))) + CASE fn% OF + WHEN 0 : z% = x% + y% + WHEN 1 : z% = x% - y% + WHEN 2 : z% = x% * y% + WHEN 3 : z% = x% DIV y% + OTHERWISE : ERROR &40E809F1, "Call to non-existent core function" + ENDCASE +=FNalloc_int(z%) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step4_if_fn_do.bas b/impls/bbc-basic/step4_if_fn_do.bas new file mode 100644 index 0000000000..8ed4898840 --- /dev/null +++ b/impls/bbc-basic/step4_if_fn_do.bas @@ -0,0 +1,124 @@ +REM Step 4 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" +LIBRARY "core" + +PROCtypes_init + +repl_env% = FNalloc_environment(FNnil) +PROCcore_ns : REM This sets the data pointer +REPEAT + READ sym$, i% + IF sym$ <> "" THEN + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) + ENDIF +UNTIL sym$ = "" + +val$ = FNrep("(def! not (fn* (a) (if a false true)))") + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNEVAL(ast%, env%) + PROCgc + PROCgc_enter +=FNgc_exit(FNEVAL_(ast%, env%)) + +DEF FNEVAL_(ast%, env%) + LOCAL car%, val%, bindings%, key$ + PROCgc_keep_only2(ast%, env%) + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + =FNEVAL(FNnth(ast%, 2), env%) + WHEN "do" + WHILE TRUE + ast% = FNrest(ast%) + IF FNis_empty(ast%) THEN = val% + val% = FNEVAL(FNfirst(ast%), env%) + ENDWHILE + WHEN "if" + IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN =FNEVAL(FNnth(ast%, 2), env%) + IF FNcount(ast%) = 3 THEN =FNnil + =FNEVAL(FNnth(ast%, 3), env%) + WHEN "fn*" + =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNeval_ast(FNrest(ast%), env%) + IF FNis_corefn(car%) THEN + =FNcore_call(FNunbox_corefn(car%), ast%) + ENDIF + IF FNis_fn(car%) THEN + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) + =FNEVAL(FNfn_ast(car%), env%) + ENDIF + ERROR &40E80918, "Not a function" + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step5_tco.bas b/impls/bbc-basic/step5_tco.bas new file mode 100644 index 0000000000..2a3674e536 --- /dev/null +++ b/impls/bbc-basic/step5_tco.bas @@ -0,0 +1,136 @@ +REM Step 5 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" +LIBRARY "core" + +PROCtypes_init + +repl_env% = FNalloc_environment(FNnil) +PROCcore_ns : REM This sets the data pointer +REPEAT + READ sym$, i% + IF sym$ <> "" THEN + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) + ENDIF +UNTIL sym$ = "" + +val$ = FNrep("(def! not (fn* (a) (if a false true)))") + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNEVAL(ast%, env%) + PROCgc_enter +=FNgc_exit(FNEVAL_(ast%, env%)) + +DEF FNEVAL_(ast%, env%) + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop + PROCgc_keep_only2(ast%, env%) + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + ast% = FNnth(ast%, 2) + GOTO 31416 + WHEN "do" + REM The guide has us call FNeval_ast on the sub-list that excludes + REM the last element of ast%, but that's a bit painful without + REM native list slicing, so it's easier to just re-implement the + REM bit of FNeval_ast that we need. + ast% = FNrest(ast%) + WHILE NOT FNis_empty(FNrest(ast%)) + val% = FNEVAL(FNfirst(ast%), env%) + ast% = FNrest(ast%) + ENDWHILE + ast% = FNfirst(ast%) + GOTO 31416 + WHEN "if" + IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN + ast% = FNnth(ast%, 2) + ELSE + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) + ENDIF + GOTO 31416 + WHEN "fn*" + =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNeval_ast(FNrest(ast%), env%) + IF FNis_corefn(car%) THEN + =FNcore_call(FNunbox_corefn(car%), ast%) + ENDIF + IF FNis_fn(car%) THEN + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) + ast% = FNfn_ast(car%) + GOTO 31416 + ENDIF + ERROR &40E80918, "Not a function" + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step6_file.bas b/impls/bbc-basic/step6_file.bas new file mode 100644 index 0000000000..15d6788f59 --- /dev/null +++ b/impls/bbc-basic/step6_file.bas @@ -0,0 +1,198 @@ +REM Step 6 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" +LIBRARY "core" + +PROCtypes_init + +repl_env% = FNalloc_environment(FNnil) +PROCcore_ns : REM This sets the data pointer +REPEAT + READ sym$, i% + IF sym$ <> "" THEN + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) + ENDIF +UNTIL sym$ = "" + +REM Initial forms to evaluate +RESTORE +0 +DATA (def! not (fn* (a) (if a false true))) +DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +DATA "" +REPEAT + READ form$ + IF form$ <> "" THEN val$ = FNrep(form$) +UNTIL form$ = "" + +argv% = FNget_argv + +IF FNis_empty(argv%) THEN + PROCenv_set(repl_env%, "*ARGV*", FNempty) +ELSE + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) + val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") + END +ENDIF + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNEVAL(ast%, env%) + PROCgc_enter +=FNgc_exit(FNEVAL_(ast%, env%)) + +DEF FNEVAL_(ast%, env%) + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop + PROCgc_keep_only2(ast%, env%) + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + ast% = FNnth(ast%, 2) + GOTO 31416 + WHEN "do" + REM The guide has us call FNeval_ast on the sub-list that excludes + REM the last element of ast%, but that's a bit painful without + REM native list slicing, so it's easier to just re-implement the + REM bit of FNeval_ast that we need. + ast% = FNrest(ast%) + WHILE NOT FNis_empty(FNrest(ast%)) + val% = FNEVAL(FNfirst(ast%), env%) + ast% = FNrest(ast%) + ENDWHILE + ast% = FNfirst(ast%) + GOTO 31416 + WHEN "if" + IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN + ast% = FNnth(ast%, 2) + ELSE + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) + ENDIF + GOTO 31416 + WHEN "fn*" + =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNeval_ast(FNrest(ast%), env%) + IF FNis_corefn(car%) THEN + =FNcore_call(FNunbox_corefn(car%), ast%) + ENDIF + IF FNis_fn(car%) THEN + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) + ast% = FNfn_ast(car%) + GOTO 31416 + ENDIF + ERROR &40E80918, "Not a function" + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +DEF FNget_argv + PROCgc_enter + LOCAL argv%, rargv%, cmdptr%, arg$, len% + argv% = FNempty + IF !PAGE = &D7C1C7C5 THEN + REM Running under Brandy, so ARGC and ARGV$ are usable. + IF ARGC >= 1 THEN + FOR i% = ARGC TO 1 STEP -1 + argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) + NEXT i% + ENDIF + ELSE + IF (INKEY(-256) AND &F0) = &A0 THEN + rargv% = FNempty + REM Running under RISC OS + REM Vexingly, we can only get the command line that was passed to + REM the BASIC interpreter. This means that we need to extract + REM the arguments from that. Typically, we will have been started + REM with "BASIC -quit ". + + DIM q% 256 + SYS "OS_GetEnv" TO cmdptr% + WHILE ?cmdptr% >= 32 + SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% + q%?len% = 13 + rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) + ENDWHILE + REM Put argv back into the right order. + WHILE NOT FNis_empty(rargv%) + argv% = FNalloc_pair(FNfirst(rargv%), argv%) + rargv% = FNrest(rargv%) + ENDWHILE + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "BASIC" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "-quit" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip filename + ENDIF + ENDIF +=FNgc_exit(argv%) + + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step7_quote.bas b/impls/bbc-basic/step7_quote.bas new file mode 100644 index 0000000000..6c0278b533 --- /dev/null +++ b/impls/bbc-basic/step7_quote.bas @@ -0,0 +1,231 @@ +REM Step 7 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" +LIBRARY "core" + +PROCtypes_init + +repl_env% = FNalloc_environment(FNnil) +PROCcore_ns : REM This sets the data pointer +REPEAT + READ sym$, i% + IF sym$ <> "" THEN + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) + ENDIF +UNTIL sym$ = "" + +REM Initial forms to evaluate +RESTORE +0 +DATA (def! not (fn* (a) (if a false true))) +DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +DATA "" +REPEAT + READ form$ + IF form$ <> "" THEN val$ = FNrep(form$) +UNTIL form$ = "" + +argv% = FNget_argv + +IF FNis_empty(argv%) THEN + PROCenv_set(repl_env%, "*ARGV*", FNempty) +ELSE + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) + val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") + END +ENDIF + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) + +DEF FNquasiquote(ast%) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) + ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) + ENDIF + =ast% + +DEF FNEVAL(ast%, env%) + PROCgc_enter +=FNgc_exit(FNEVAL_(ast%, env%)) + +DEF FNEVAL_(ast%, env%) + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop + PROCgc_keep_only2(ast%, env%) + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + ast% = FNnth(ast%, 2) + GOTO 31416 + WHEN "do" + REM The guide has us call FNeval_ast on the sub-list that excludes + REM the last element of ast%, but that's a bit painful without + REM native list slicing, so it's easier to just re-implement the + REM bit of FNeval_ast that we need. + ast% = FNrest(ast%) + WHILE NOT FNis_empty(FNrest(ast%)) + val% = FNEVAL(FNfirst(ast%), env%) + ast% = FNrest(ast%) + ENDWHILE + ast% = FNfirst(ast%) + GOTO 31416 + WHEN "if" + IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN + ast% = FNnth(ast%, 2) + ELSE + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) + ENDIF + GOTO 31416 + WHEN "fn*" + =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) + WHEN "quote" + =FNnth(ast%, 1) + WHEN "quasiquote" + ast% = FNquasiquote(FNnth(ast%, 1)) + GOTO 31416 + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNeval_ast(FNrest(ast%), env%) + IF FNis_corefn(car%) THEN + =FNcore_call(FNunbox_corefn(car%), ast%) + ENDIF + IF FNis_fn(car%) THEN + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) + ast% = FNfn_ast(car%) + GOTO 31416 + ENDIF + ERROR &40E80918, "Not a function" + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +DEF FNget_argv + PROCgc_enter + LOCAL argv%, rargv%, cmdptr%, arg$, len% + argv% = FNempty + IF !PAGE = &D7C1C7C5 THEN + REM Running under Brandy, so ARGC and ARGV$ are usable. + IF ARGC >= 1 THEN + FOR i% = ARGC TO 1 STEP -1 + argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) + NEXT i% + ENDIF + ELSE + IF (INKEY(-256) AND &F0) = &A0 THEN + rargv% = FNempty + REM Running under RISC OS + REM Vexingly, we can only get the command line that was passed to + REM the BASIC interpreter. This means that we need to extract + REM the arguments from that. Typically, we will have been started + REM with "BASIC -quit ". + + DIM q% 256 + SYS "OS_GetEnv" TO cmdptr% + WHILE ?cmdptr% >= 32 + SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% + q%?len% = 13 + rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) + ENDWHILE + REM Put argv back into the right order. + WHILE NOT FNis_empty(rargv%) + argv% = FNalloc_pair(FNfirst(rargv%), argv%) + rargv% = FNrest(rargv%) + ENDWHILE + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "BASIC" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "-quit" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip filename + ENDIF + ENDIF +=FNgc_exit(argv%) + + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step8_macros.bas b/impls/bbc-basic/step8_macros.bas new file mode 100644 index 0000000000..59b2164865 --- /dev/null +++ b/impls/bbc-basic/step8_macros.bas @@ -0,0 +1,242 @@ +REM Step 8 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" +LIBRARY "core" + +PROCtypes_init + +repl_env% = FNalloc_environment(FNnil) +PROCcore_ns : REM This sets the data pointer +REPEAT + READ sym$, i% + IF sym$ <> "" THEN + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) + ENDIF +UNTIL sym$ = "" + +REM Initial forms to evaluate +RESTORE +0 +DATA (def! not (fn* (a) (if a false true))) +DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +DATA (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) +DATA "" +REPEAT + READ form$ + IF form$ <> "" THEN val$ = FNrep(form$) +UNTIL form$ = "" + +argv% = FNget_argv + +IF FNis_empty(argv%) THEN + PROCenv_set(repl_env%, "*ARGV*", FNempty) +ELSE + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) + val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") + END +ENDIF + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) + +DEF FNquasiquote(ast%) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) + ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) + ENDIF + =ast% + +DEF FNEVAL(ast%, env%) + PROCgc_enter +=FNgc_exit(FNEVAL_(ast%, env%)) + +DEF FNEVAL_(ast%, env%) + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop + PROCgc_keep_only2(ast%, env%) + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "defmacro!" + val% = FNEVAL(FNnth(ast%, 2), env%) + IF FNis_fn(val%) THEN val% = FNas_macro(val%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + ast% = FNnth(ast%, 2) + GOTO 31416 + WHEN "do" + REM The guide has us call FNeval_ast on the sub-list that excludes + REM the last element of ast%, but that's a bit painful without + REM native list slicing, so it's easier to just re-implement the + REM bit of FNeval_ast that we need. + ast% = FNrest(ast%) + WHILE NOT FNis_empty(FNrest(ast%)) + val% = FNEVAL(FNfirst(ast%), env%) + ast% = FNrest(ast%) + ENDWHILE + ast% = FNfirst(ast%) + GOTO 31416 + WHEN "if" + IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN + ast% = FNnth(ast%, 2) + ELSE + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) + ENDIF + GOTO 31416 + WHEN "fn*" + =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) + WHEN "quote" + =FNnth(ast%, 1) + WHEN "quasiquote" + ast% = FNquasiquote(FNnth(ast%, 1)) + GOTO 31416 + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNrest(ast%) + IF FNis_macro(car%) THEN + ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) + GOTO 31416 + ENDIF + ast% = FNeval_ast(ast%, env%) + IF FNis_corefn(car%) THEN + =FNcore_call(FNunbox_corefn(car%), ast%) + ENDIF + IF FNis_fn(car%) THEN + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) + ast% = FNfn_ast(car%) + GOTO 31416 + ENDIF + ERROR &40E80918, "Not a function" + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +DEF FNget_argv + PROCgc_enter + LOCAL argv%, rargv%, cmdptr%, arg$, len% + argv% = FNempty + IF !PAGE = &D7C1C7C5 THEN + REM Running under Brandy, so ARGC and ARGV$ are usable. + IF ARGC >= 1 THEN + FOR i% = ARGC TO 1 STEP -1 + argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) + NEXT i% + ENDIF + ELSE + IF (INKEY(-256) AND &F0) = &A0 THEN + rargv% = FNempty + REM Running under RISC OS + REM Vexingly, we can only get the command line that was passed to + REM the BASIC interpreter. This means that we need to extract + REM the arguments from that. Typically, we will have been started + REM with "BASIC -quit ". + + DIM q% 256 + SYS "OS_GetEnv" TO cmdptr% + WHILE ?cmdptr% >= 32 + SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% + q%?len% = 13 + rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) + ENDWHILE + REM Put argv back into the right order. + WHILE NOT FNis_empty(rargv%) + argv% = FNalloc_pair(FNfirst(rargv%), argv%) + rargv% = FNrest(rargv%) + ENDWHILE + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "BASIC" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "-quit" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip filename + ENDIF + ENDIF +=FNgc_exit(argv%) + + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/step9_try.bas b/impls/bbc-basic/step9_try.bas new file mode 100644 index 0000000000..e7294185c8 --- /dev/null +++ b/impls/bbc-basic/step9_try.bas @@ -0,0 +1,286 @@ +REM Step 9 of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" +LIBRARY "core" + +PROCtypes_init + +repl_env% = FNalloc_environment(FNnil) +PROCcore_ns : REM This sets the data pointer +REPEAT + READ sym$, i% + IF sym$ <> "" THEN + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) + ENDIF +UNTIL sym$ = "" + +REM Initial forms to evaluate +RESTORE +0 +DATA (def! not (fn* (a) (if a false true))) +DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +DATA (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) +DATA "" +REPEAT + READ form$ + IF form$ <> "" THEN val$ = FNrep(form$) +UNTIL form$ = "" + +argv% = FNget_argv + +IF FNis_empty(argv%) THEN + PROCenv_set(repl_env%, "*ARGV*", FNempty) +ELSE + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) + val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") + END +ENDIF + +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) + +DEF FNquasiquote(ast%) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) + ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) + ENDIF + =ast% + +DEF FNtry_catch(ast%, env%) + LOCAL is_error%, ret% + REM If there's no 'catch*' clause then we just evaluate the 'try*'. + IF FNcount(ast%) < 3 THEN =FNEVAL(FNnth(ast%, 1), env%) + IF FNunbox_symbol(FNfirst(FNnth(ast%, 2))) <> "catch*" THEN + ERROR &40E80924, "Invalid 'catch*' clause" + ENDIF + ret% = FNtry(FNnth(ast%, 1), env%, is_error%) + IF is_error% THEN =FNcatch(FNnth(ast%, 2), env%, ret%) +=ret% + +REM Evaluate an expression, returning either the result or an exception +REM raised during evaluation. is_error% indicates which it was. +DEF FNtry(ast%, env%, RETURN is_error%) + LOCAL trysav% + trysav% = FNgc_save + is_error% = FALSE + LOCAL ERROR + ON ERROR LOCAL is_error% = TRUE : =FNgc_restore(trysav%, FNwrap_exception) +=FNgc_restore(trysav%, FNEVAL(ast%, env%)) + +REM Return a mal value corresponding to the most-recently thrown exception. +DEF FNwrap_exception + REM There are three cases to handle. When the error was generated + REM by 'throw', we should return the value that 'throw' stashed in + REM MAL_ERR%. When the error was generated by mal, we should just + REM return the error message. When the error was generated by BASIC + REM or the OS, we should wrap the message and the error number in + REM a hash-map. + IF ERR = &40E80900 THEN =MAL_ERR% : REM Error generated by 'throw' + IF (ERR AND &FFFFFF00) = &40E80900 THEN =FNalloc_string(REPORT$) + LOCAL e% + e% = FNhashmap_set(FNempty_hashmap, "err", FNalloc_int(ERR)) +=FNhashmap_set(e%, "message", FNalloc_string(REPORT$)) + +DEF FNcatch(ast%, env%, err%) + LOCAL binds%, exprs% + binds% = FNalloc_pair(FNnth(ast%, 1), FNempty) + exprs% = FNalloc_pair(err%, FNempty) + env% = FNnew_env(env%, binds%, exprs%) +=FNEVAL(FNnth(ast%, 2), env%) + +DEF FNEVAL(ast%, env%) + PROCgc_enter +=FNgc_exit(FNEVAL_(ast%, env%)) + +DEF FNEVAL_(ast%, env%) + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop + PROCgc_keep_only2(ast%, env%) + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "defmacro!" + val% = FNEVAL(FNnth(ast%, 2), env%) + IF FNis_fn(val%) THEN val% = FNas_macro(val%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + ast% = FNnth(ast%, 2) + GOTO 31416 + WHEN "do" + REM The guide has us call FNeval_ast on the sub-list that excludes + REM the last element of ast%, but that's a bit painful without + REM native list slicing, so it's easier to just re-implement the + REM bit of FNeval_ast that we need. + ast% = FNrest(ast%) + WHILE NOT FNis_empty(FNrest(ast%)) + val% = FNEVAL(FNfirst(ast%), env%) + ast% = FNrest(ast%) + ENDWHILE + ast% = FNfirst(ast%) + GOTO 31416 + WHEN "if" + IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN + ast% = FNnth(ast%, 2) + ELSE + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) + ENDIF + GOTO 31416 + WHEN "fn*" + =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) + WHEN "quote" + =FNnth(ast%, 1) + WHEN "quasiquote" + ast% = FNquasiquote(FNnth(ast%, 1)) + GOTO 31416 + WHEN "try*" + =FNtry_catch(ast%, env%) + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNrest(ast%) + IF FNis_macro(car%) THEN + ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) + GOTO 31416 + ENDIF + ast% = FNeval_ast(ast%, env%) + IF FNis_corefn(car%) THEN + =FNcore_call(FNunbox_corefn(car%), ast%) + ENDIF + IF FNis_fn(car%) THEN + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) + ast% = FNfn_ast(car%) + GOTO 31416 + ENDIF + ERROR &40E80918, "Not a function" + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +DEF FNget_argv + PROCgc_enter + LOCAL argv%, rargv%, cmdptr%, arg$, len% + argv% = FNempty + IF !PAGE = &D7C1C7C5 THEN + REM Running under Brandy, so ARGC and ARGV$ are usable. + IF ARGC >= 1 THEN + FOR i% = ARGC TO 1 STEP -1 + argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) + NEXT i% + ENDIF + ELSE + IF (INKEY(-256) AND &F0) = &A0 THEN + rargv% = FNempty + REM Running under RISC OS + REM Vexingly, we can only get the command line that was passed to + REM the BASIC interpreter. This means that we need to extract + REM the arguments from that. Typically, we will have been started + REM with "BASIC -quit ". + + DIM q% 256 + SYS "OS_GetEnv" TO cmdptr% + WHILE ?cmdptr% >= 32 + SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% + q%?len% = 13 + rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) + ENDWHILE + REM Put argv back into the right order. + WHILE NOT FNis_empty(rargv%) + argv% = FNalloc_pair(FNfirst(rargv%), argv%) + rargv% = FNrest(rargv%) + ENDWHILE + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "BASIC" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "-quit" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip filename + ENDIF + ENDIF +=FNgc_exit(argv%) + + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/stepA_mal.bas b/impls/bbc-basic/stepA_mal.bas new file mode 100644 index 0000000000..a74d1cb9cf --- /dev/null +++ b/impls/bbc-basic/stepA_mal.bas @@ -0,0 +1,288 @@ +REM Step A of mal in BBC BASIC + +LIBRARY "types" +LIBRARY "reader" +LIBRARY "printer" +LIBRARY "env" +LIBRARY "core" + +PROCtypes_init + +repl_env% = FNalloc_environment(FNnil) +PROCcore_ns : REM This sets the data pointer +REPEAT + READ sym$, i% + IF sym$ <> "" THEN + PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) + ENDIF +UNTIL sym$ = "" + +REM Initial forms to evaluate +RESTORE +0 +DATA (def! not (fn* (a) (if a false true))) +DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +DATA (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) +DATA (def! *host-language* "BBC BASIC V") +DATA "" +REPEAT + READ form$ + IF form$ <> "" THEN val$ = FNrep(form$) +UNTIL form$ = "" + +argv% = FNget_argv + +IF FNis_empty(argv%) THEN + PROCenv_set(repl_env%, "*ARGV*", FNempty) +ELSE + PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) + val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") + END +ENDIF + +val$ = FNrep("(println (str ""Mal ["" *host-language* ""]""))") +sav% = FNgc_save +REPEAT + REM Catch all errors apart from "Escape". + ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ + PROCgc_restore(sav%) + sav% = FNgc_save + PRINT "user> "; + LINE INPUT "" line$ + PRINT FNrep(line$) +UNTIL FALSE + +END + +DEF FNREAD(a$) +=FNread_str(FNalloc_string(a$)) + +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) + +DEF FNquasiquote(ast%) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) + ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) + ENDIF + =ast% + +DEF FNtry_catch(ast%, env%) + LOCAL is_error%, ret% + REM If there's no 'catch*' clause then we just evaluate the 'try*'. + IF FNcount(ast%) < 3 THEN =FNEVAL(FNnth(ast%, 1), env%) + IF FNunbox_symbol(FNfirst(FNnth(ast%, 2))) <> "catch*" THEN + ERROR &40E80924, "Invalid 'catch*' clause" + ENDIF + ret% = FNtry(FNnth(ast%, 1), env%, is_error%) + IF is_error% THEN =FNcatch(FNnth(ast%, 2), env%, ret%) +=ret% + +REM Evaluate an expression, returning either the result or an exception +REM raised during evaluation. is_error% indicates which it was. +DEF FNtry(ast%, env%, RETURN is_error%) + LOCAL trysav% + trysav% = FNgc_save + is_error% = FALSE + LOCAL ERROR + ON ERROR LOCAL is_error% = TRUE : =FNgc_restore(trysav%, FNwrap_exception) +=FNgc_restore(trysav%, FNEVAL(ast%, env%)) + +REM Return a mal value corresponding to the most-recently thrown exception. +DEF FNwrap_exception + REM There are three cases to handle. When the error was generated + REM by 'throw', we should return the value that 'throw' stashed in + REM MAL_ERR%. When the error was generated by mal, we should just + REM return the error message. When the error was generated by BASIC + REM or the OS, we should wrap the message and the error number in + REM a hash-map. + IF ERR = &40E80900 THEN =MAL_ERR% : REM Error generated by 'throw' + IF (ERR AND &FFFFFF00) = &40E80900 THEN =FNalloc_string(REPORT$) + LOCAL e% + e% = FNhashmap_set(FNempty_hashmap, "err", FNalloc_int(ERR)) +=FNhashmap_set(e%, "message", FNalloc_string(REPORT$)) + +DEF FNcatch(ast%, env%, err%) + LOCAL binds%, exprs% + binds% = FNalloc_pair(FNnth(ast%, 1), FNempty) + exprs% = FNalloc_pair(err%, FNempty) + env% = FNnew_env(env%, binds%, exprs%) +=FNEVAL(FNnth(ast%, 2), env%) + +DEF FNEVAL(ast%, env%) + PROCgc_enter +=FNgc_exit(FNEVAL_(ast%, env%)) + +DEF FNEVAL_(ast%, env%) + LOCAL car%, val%, bindings%, key$ +31416 REM tail call optimization loop + PROCgc_keep_only2(ast%, env%) + val% = FNenv_find(env%, "DEBUG-EVAL") + IF NOT FNis_nil(val%) THEN + IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN + PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) + ENDIF + ENDIF + IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% + IF FNis_empty(ast%) THEN =ast% + car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) + IF FNis_symbol(car%) THEN + key$ = FNunbox_symbol(car%) + CASE key$ OF + REM Special forms + WHEN "def!" + val% = FNEVAL(FNnth(ast%, 2), env%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "defmacro!" + val% = FNEVAL(FNnth(ast%, 2), env%) + IF FNis_fn(val%) THEN val% = FNas_macro(val%) + PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) + =val% + WHEN "let*" + env% = FNalloc_environment(env%) + bindings% = FNnth(ast%, 1) + WHILE NOT FNis_empty(bindings%) + PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) + bindings% = FNrest(FNrest(bindings%)) + ENDWHILE + ast% = FNnth(ast%, 2) + GOTO 31416 + WHEN "do" + REM The guide has us call FNeval_ast on the sub-list that excludes + REM the last element of ast%, but that's a bit painful without + REM native list slicing, so it's easier to just re-implement the + REM bit of FNeval_ast that we need. + ast% = FNrest(ast%) + WHILE NOT FNis_empty(FNrest(ast%)) + val% = FNEVAL(FNfirst(ast%), env%) + ast% = FNrest(ast%) + ENDWHILE + ast% = FNfirst(ast%) + GOTO 31416 + WHEN "if" + IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN + ast% = FNnth(ast%, 2) + ELSE + IF FNcount(ast%) = 3 THEN =FNnil + ast% = FNnth(ast%, 3) + ENDIF + GOTO 31416 + WHEN "fn*" + =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) + WHEN "quote" + =FNnth(ast%, 1) + WHEN "quasiquote" + ast% = FNquasiquote(FNnth(ast%, 1)) + GOTO 31416 + WHEN "try*" + =FNtry_catch(ast%, env%) + OTHERWISE + car% = FNenv_get(env%, key$) + ENDCASE + ELSE + car% = FNEVAL(car%, env%) + ENDIF + REM This is the "apply" part. + ast% = FNrest(ast%) + IF FNis_macro(car%) THEN + ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) + GOTO 31416 + ENDIF + ast% = FNeval_ast(ast%, env%) + IF FNis_corefn(car%) THEN + =FNcore_call(FNunbox_corefn(car%), ast%) + ENDIF + IF FNis_fn(car%) THEN + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) + ast% = FNfn_ast(car%) + GOTO 31416 + ENDIF + ERROR &40E80918, "Not a function" + +DEF FNPRINT(a%) +=FNunbox_string(FNpr_str(a%, TRUE)) + +DEF FNrep(a$) +=FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) + +DEF FNeval_ast(ast%, env%) + IF FNis_empty(ast%) THEN =ast% + =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) + +DEF FNget_argv + PROCgc_enter + LOCAL argv%, rargv%, cmdptr%, arg$, len% + argv% = FNempty + IF !PAGE = &D7C1C7C5 THEN + REM Running under Brandy, so ARGC and ARGV$ are usable. + IF ARGC >= 1 THEN + FOR i% = ARGC TO 1 STEP -1 + argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) + NEXT i% + ENDIF + ELSE + IF (INKEY(-256) AND &F0) = &A0 THEN + rargv% = FNempty + REM Running under RISC OS + REM Vexingly, we can only get the command line that was passed to + REM the BASIC interpreter. This means that we need to extract + REM the arguments from that. Typically, we will have been started + REM with "BASIC -quit ". + + DIM q% 256 + SYS "OS_GetEnv" TO cmdptr% + WHILE ?cmdptr% >= 32 + SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% + q%?len% = 13 + rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) + ENDWHILE + REM Put argv back into the right order. + WHILE NOT FNis_empty(rargv%) + argv% = FNalloc_pair(FNfirst(rargv%), argv%) + rargv% = FNrest(rargv%) + ENDWHILE + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "BASIC" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip "-quit" + IF FNis_empty(argv%) THEN =FNgc_exit(argv%) + argv% = FNrest(argv%) : REM skip filename + ENDIF + ENDIF +=FNgc_exit(argv%) + + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/bbc-basic/types b/impls/bbc-basic/types new file mode 120000 index 0000000000..6f75a240cf --- /dev/null +++ b/impls/bbc-basic/types @@ -0,0 +1 @@ +types.bas \ No newline at end of file diff --git a/impls/bbc-basic/types.bas b/impls/bbc-basic/types.bas new file mode 100644 index 0000000000..b1f3413fb6 --- /dev/null +++ b/impls/bbc-basic/types.bas @@ -0,0 +1,709 @@ +REM > types library for mal in BBC BASIC + +REM This library should be the only thing that understands the +REM implementation of mal data types in BBC BASIC. All other +REM code should use routines in this library to access them. + +REM As far as other code is concerned, a mal object is just an +REM opaque 32-bit integer, which might be a pointer, or might not. + +REM All mal objects live in an array, Z%(), with string values held +REM in a parallel array, Z$(). There's one row in Z%(), and one +REM entry in Z$(), for each mal object. + +REM Z%(x,0) holds the type of an object and other small amounts of +REM information. The bottom bit indicates the semantics of Z%(x,1): + +REM &01 : Z%(x,1) is a pointer into Z%() + +REM Z%(x,2) and Z%(x,3) are always pointers into Z%(), to 'nil' if nothing +REM else. + +REM The &40 bit is used to distinguish empty lists, vectors and hash-maps. +REM The &80 bit distinguishes vectors from lists and macros from functions. + +REM sS%() is a shadow stack, used to keep track of which mal values might +REM be referenced from local variables at a given depth of the BASIC call +REM stack. It grows upwards. sSP% points to the first unused word. sFP% +REM points to the start of the current shadow stack frame. The first word +REM of each shadow stack frame is the saved value of sFP%. The rest are +REM mal values. + +REM Types are: +REM &00 nil +REM &04 boolean +REM &08 integer +REM &0C core function +REM &01 atom +REM &05 free block +REM &09 list/vector (each object is a cons cell) +REM &0D environment +REM &11 hash-map internal node +REM &15 mal function (first part) +REM &19 mal function (second part) +REM &02 string/keyword +REM &06 symbol +REM &0A hash-map leaf node + +REM Formats of individual objects are defined below. + +DEF PROCtypes_init + REM Mal's heap has to be statically dimensioned, but we also + REM need to leave enough space for BASIC's stack and heap. + REM The BASIC heap is where all strings live. + REM + REM Each row of Z%() consumes 16 bytes. The size of each entry + REM in Z$() varies by platform: 5 bytes in ARM BBC BASIC V, + REM 8 bytes in Brandy on a 32-bit system, 16 bytes in Brandy on + REM a 64-bit system. + + DIM Z%((HIMEM-LOMEM)/110,3), Z$((HIMEM-LOMEM)/110) + DIM sS%((HIMEM-LOMEM)/64) + + Z%(1,0) = &04 : REM false + Z%(2,0) = &04 : Z%(2,1) = TRUE : REM true + Z%(3,0) = &49 : Z%(3,1) = 3 : REM empty list + Z%(4,0) = &C9 : Z%(4,1) = 4 : REM empty vector + Z%(5,0) = &51 : REM empty hashmap + next_Z% = 6 + sSP% = 1 + sFP% = 0 + F% = 0 +ENDPROC + +DEF FNtype_of(val%) +=Z%(val%,0) AND &1F + +DEF PROCgc_enter + REM PRINT ;sFP%; + sS%(sSP%) = sFP% + sFP% = sSP% + sSP% += 1 + REM PRINT " >>> ";sFP% +ENDPROC + +REM FNgc_save is equivalent to PROCgc_enter except that it returns a +REM value that can be passed to PROCgc_restore to pop all the stack +REM frames back to (and including) the one pushed by FNgc_save. +DEF FNgc_save + PROCgc_enter +=sFP% + +DEF PROCgc_exit + REM PRINT ;sS%(sFP%);" <<< ";sFP% + sSP% = sFP% + sFP% = sS%(sFP%) +ENDPROC + +DEF PROCgc_restore(oldFP%) + sFP% = oldFP% + REM PRINT "!!! FP reset" + PROCgc_exit +ENDPROC + +DEF FNref_local(val%) + sS%(sSP%) = val% + sSP% += 1 +=val% + +DEF FNgc_exit(val%) + PROCgc_exit +=FNref_local(val%) + +DEF FNgc_restore(oldFP%, val%) + PROCgc_restore(oldFP%) +=FNref_local(val%) + +DEF PROCgc_keep_only2(val1%, val2%) + PROCgc_exit + PROCgc_enter + val1% = FNref_local(val1%) + val2% = FNref_local(val2%) +ENDPROC + +DEF FNmalloc(type%) + LOCAL val% + REM If the heap is full, collect garbage first. + IF F% = 0 AND next_Z% > DIM(Z%(),1) THEN + PROCgc + IF F% = 0 ERROR &40E80950, "Out of mal heap memory" + ENDIF + IF F% <> 0 THEN + val% = F% + F% = Z%(val%,1) + ELSE + val% = next_Z% + next_Z% += 1 + ENDIF + Z%(val%,0) = type% +=FNref_local(val%) + +DEF PROCfree(val%) + Z%(val%,0) = &05 + Z%(val%,1) = F% + Z%(val%,2) = 0 + Z%(val%,3) = 0 + Z$(val%) = "" + F% = val% +ENDPROC + +DEF PROCgc + REM PRINT "** START GC **" + PROCgc_markall + PROCgc_sweep + REM PRINT "** FINISH GC **" +ENDPROC + +DEF PROCgc_markall + LOCAL sp%, fp% + fp% = sFP% + REM PRINT ">>marking..."; + FOR sp% = sSP% - 1 TO 0 STEP -1 + IF sp% = fp% THEN + fp% = sS%(sp%) + REM PRINT " / "; + ELSE PROCgc_mark(sS%(sp%)) + ENDIF + NEXT sp% + REM PRINT +ENDPROC + +DEF PROCgc_mark(val%) + IF (Z%(val%,0) AND &100) = 0 THEN + REM PRINT " ";val%; + Z%(val%,0) += &100 + IF (Z%(val%,0) AND &01) THEN PROCgc_mark(Z%(val%,1)) + PROCgc_mark(Z%(val%,2)) + PROCgc_mark(Z%(val%,3)) + ENDIF +ENDPROC + +DEF PROCgc_sweep + LOCAL val% + REM PRINT ">>sweeping ..."; + FOR val% = 6 TO next_Z% - 1 + IF FNtype_of(val%) <> &05 AND (Z%(val%,0) AND &100) = 0 THEN + REM PRINT " ";val%; + PROCfree(val%) + ELSE + Z%(val%,0) -= &100 + ENDIF + NEXT val% + REM PRINT +ENDPROC + +DEF FNmeta(val%) +=Z%(val%,3) + +DEF FNwith_meta(val%, meta%) + LOCAL newval% + newval% = FNmalloc(Z%(val%,0)) + Z%(newval%,1) = Z%(val%,1) + Z%(newval%,2) = Z%(val%,2) + Z%(newval%,3) = meta% + Z$(newval%) = Z$(val%) +=newval% + +REM ** Nil ** + +DEF FNis_nil(val%) +=FNtype_of(val%) = 0 + +DEF FNnil +=0 + +REM ** Boolean ** + +REM Z%(x,1) = TRUE or FALSE + +DEF FNis_boolean(val%) +=FNtype_of(val%) = &04 + +DEF FNalloc_boolean(bval%) + IF bval% THEN =2 +=1 + +DEF FNunbox_boolean(val%) + IF NOT FNis_boolean(val%) THEN ERROR &40E80911, "Not a boolean" +=Z%(val%,1) + +DEF FNis_truish(val%) + IF FNis_nil(val%) THEN =FALSE + IF FNis_boolean(val%) THEN =FNunbox_boolean(val%) +=TRUE + +REM ** Integers ** + +REM Z%(x,1) = integer value + +DEF FNis_int(val%) +=FNtype_of(val%) = &08 + +DEF FNalloc_int(ival%) + LOCAL val% + val% = FNmalloc(&08) + Z%(val%,1) = ival% +=val% + +DEF FNunbox_int(val%) + IF NOT FNis_int(val%) THEN ERROR &40E80912, "Not an integer" +=Z%(val%,1) + +REM ** Strings and keywords ** + +REM Z$(x) is the string value +REM Z%(x,2) points to the next part of the string +REM A keyword is a string with first character CHR$(127). + +DEF FNis_string(val%) +=FNtype_of(val%) = &02 + +DEF FNalloc_string(sval$) + LOCAL val% + val% = FNmalloc(&02) + Z$(val%) = sval$ +=val% + +DEF FNunbox_string(val%) + IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" + IF NOT FNis_nil(Z%(val%,2)) ERROR &40E80914, "Cannot unbox a long string" +=Z$(val%) + +DEF FNstring_append(val%, add$) + LOCAL newval% + IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" + newval% = FNalloc_string(Z$(val%)) + IF FNis_nil(Z%(val%,2)) THEN + IF LEN(Z$(newval%)) + LEN(add$) <= 255 THEN + Z$(newval%) += add$ + ELSE + Z%(newval%,2) = FNalloc_string(add$) + ENDIF + ELSE + Z%(newval%,2) = FNstring_append(Z%(val%,2), add$) + ENDIF +=newval% + +DEF FNstring_concat(val%, add%) + LOCAL newval% + IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" + IF NOT FNis_string(add%) THEN ERROR &40E80914, "Not a string" + newval% = FNalloc_string(Z$(val%)) + IF FNis_nil(Z%(val%,2)) THEN + IF LEN(Z$(newval%)) + LEN(Z$(add%)) <= 255 THEN + Z$(newval%) += Z$(add%) + Z%(newval%,2) = Z%(add%,2) + ELSE + Z%(newval%,2) = add% + ENDIF + ELSE + Z%(newval%,2) = FNstring_concat(Z%(val%,2), add%) + ENDIF +=newval% + +DEF FNstring_len(val%) + LOCAL len% + WHILE NOT FNis_nil(val%) + len% += LEN(Z$(val%)) + val% = Z%(val%,2) + ENDWHILE +=len% + +DEF FNstring_chr(val%, pos%) + WHILE pos% > LEN(Z$(val%)) + pos% -= LEN(Z$(val%)) + val% = Z%(val%,2) + IF FNis_nil(val%) THEN ="" + ENDWHILE +=MID$(Z$(val%), pos%, 1) + +REM ** Symbols ** + +REM Z$(x) = value of the symbol + +DEF FNis_symbol(val%) +=FNtype_of(val%) = &06 + +DEF FNalloc_symbol(sval$) + LOCAL val% + val% = FNmalloc(&06) + Z$(val%) = sval$ +=val% + +DEF FNunbox_symbol(val%) + IF NOT FNis_symbol(val%) THEN ERROR &40E80915, "Not a symbol" +=Z$(val%) + +REM ** Lists and vectors ** + +REM Lists and vectors are both represented as linked lists: the only +REM difference is in the state of the is_vector flag in the head cell +REM of the list. Note that this means that the tail of a list may be +REM a vector, and vice versa. FNas_list and FNas_vector can be used +REM to convert a sequence to a particular type as necessary. + +REM Z%(x,0) AND &80 = is_vector flag +REM Z%(x,1) = index in Z%() of next pair +REM Z%(x,2) = index in Z%() of first element + +REM The empty list is a distinguished value, with elements that match +REM the spec of 'first' and 'rest'. + +DEF FNempty +=3 + +DEF FNempty_vector +=4 + +DEF FNalloc_pair(car%, cdr%) + LOCAL val% + val% = FNmalloc(&09) + Z%(val%,2) = car% + Z%(val%,1) = cdr% +=val% + +DEF FNalloc_vector_pair(car%, cdr%) + LOCAL val% + val% = FNalloc_pair(car%, cdr%) + Z%(val%,0) = Z%(val%,0) OR &80 +=val% + +DEF FNis_empty(val%) +=(Z%(val%,0) AND &40) = &40 + +DEF FNis_seq(val%) +=FNtype_of(val%) = &09 + +DEF FNis_list(val%) +=FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &00 + +DEF FNis_vector(val%) +=FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &80 + +DEF FNas_list(val%) + IF FNis_list(val%) THEN =val% + IF FNis_empty(val%) THEN =FNempty +=FNalloc_pair(FNfirst(val%), FNrest(val%)) + +DEF FNas_vector(val%) + IF FNis_vector(val%) THEN =val% + IF FNis_empty(val%) THEN =FNempty_vector +=FNalloc_vector_pair(FNfirst(val%), FNrest(val%)) + +DEF FNfirst(val%) + IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get car of non-sequence" +=FNref_local(Z%(val%,2)) + +DEF FNrest(val%) + IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get cdr of non-sequence" +=FNref_local(Z%(val%,1)) + +DEF FNalloc_list2(val0%, val1%) + =FNalloc_pair(val0%, FNalloc_pair(val1%, FNempty)) + +DEF FNalloc_list3(val0%, val1%, val2%) + =FNalloc_pair(val0%, FNalloc_pair(val1%, FNalloc_pair(val2%, FNempty))) + +DEF FNcount(val%) + LOCAL i% + WHILE NOT FNis_empty(val%) + val% = FNrest(val%) + i% += 1 + ENDWHILE += i% + +DEF FNnth(val%, n%) + WHILE n% > 0 + IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range" + val% = FNrest(val%) + n% -= 1 + ENDWHILE + IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range" +=FNfirst(val%) + +REM ** Core functions ** + +REM Z%(x,1) = index of function in FNcore_call + +DEF FNis_corefn(val%) +=FNtype_of(val%) = &0C + +DEF FNalloc_corefn(fn%) + LOCAL val% + val% = FNmalloc(&0C) + Z%(val%,1) = fn% +=val% + +DEF FNunbox_corefn(val%) + IF NOT FNis_corefn(val%) THEN ERROR &40E80919, "Not a core function" +=Z%(val%,1) + +REM ** Hash-maps ** + +REM Hash-maps are represented as a crit-bit tree. + +REM An internal node has: +REM Z%(x,0) >> 16 = next bit of key to check +REM Z%(x,1) = index in Z%() of left child (if next bit of key is 0) +REM Z%(x,2) = index in Z%() of right child (if next bit of key is 1) + +REM A leaf node has +REM Z$(x) = key +REM Z%(x,2) = index in Z%() of value + +REM The empty hash-map is a special value containing no data. + +DEF FNempty_hashmap +=5 + +DEF FNhashmap_alloc_leaf(key$, val%) + LOCAL entry% + entry% = FNmalloc(&0A) + Z$(entry%) = key$ + Z%(entry%,2) = val% +=entry% + +DEF FNhashmap_alloc_node(bit%, left%, right%) + LOCAL entry% + entry% = FNmalloc(&11) + Z%(entry%,0) += (bit% << 16) + Z%(entry%,1) = left% + Z%(entry%,2) = right% +=entry% + +DEF FNis_hashmap(val%) + LOCAL t% + t% = FNtype_of(val%) +=t% = &11 OR t% = &0A + +DEF FNkey_bit(key$, bit%) + LOCAL cnum% + cnum% = bit% >> 3 + IF cnum% >= LEN(key$) THEN =FALSE +=ASC(MID$(key$, cnum% + 1, 1)) AND (&80 >> (bit% AND 7)) + +DEF FNkey_bitdiff(key1$, key2$) + LOCAL bit% + WHILE FNkey_bit(key1$, bit%) = FNkey_bit(key2$, bit%) + bit% += 1 + ENDWHILE +=bit% + +DEF FNhashmap_set(map%, key$, val%) + LOCAL bit%, nearest% + IF FNis_empty(map%) THEN =FNhashmap_alloc_leaf(key$, val%) + nearest% = FNhashmap_find(map%, key$) + IF Z$(nearest%) = key$ THEN =FNhashmap_replace(map%, key$, val%) + bit% = FNkey_bitdiff(key$, Z$(nearest%)) +=FNhashmap_insert(map%, bit%, key$, val%) + +DEF FNhashmap_insert(map%, bit%, key$, val%) + LOCAL left%, right% + IF FNtype_of(map%) = &11 AND (Z%(map%,0) >> 16) < bit% THEN + IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN + left% = Z%(map%,1) + right% = FNhashmap_insert(Z%(map%,2), bit%, key$, val%) + ELSE + left% = FNhashmap_insert(Z%(map%,1), bit%, key$, val%) + right% = Z%(map%,2) + ENDIF + =FNhashmap_alloc_node(Z%(map%,0)>>16, left%, right%) + ENDIF + IF FNkey_bit(key$, bit%) THEN + left% = map% + right% = FNhashmap_alloc_leaf(key$, val%) + ELSE + left% = FNhashmap_alloc_leaf(key$, val%) + right% = map% + ENDIF +=FNhashmap_alloc_node(bit%, left%, right%) + + +REM Replace a known-present key in a non-empty hashmap. +DEF FNhashmap_replace(map%, key$, val%) + LOCAL left%, right% + IF FNtype_of(map%) = &0A THEN =FNhashmap_alloc_leaf(key$, val%) + IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN + left% = Z%(map%,1) + right% = FNhashmap_replace(Z%(map%,2), key$, val%) + ELSE + left% = FNhashmap_replace(Z%(map%,1), key$, val%) + right% = Z%(map%,2) + ENDIF +=FNhashmap_alloc_node(Z%(map%,0)>>16, left%, right%) + +DEF FNhashmap_remove(map%, key$) + LOCAL child% + IF FNis_empty(map%) THEN =map% + IF FNtype_of(map%) = &0A THEN + IF Z$(map%) = key$ THEN =FNempty_hashmap + ENDIF + IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN + child% = FNhashmap_remove(Z%(map%,2), key$) + IF FNis_empty(child%) THEN =Z%(map%,1) + =FNhashmap_alloc_node(Z%(map%,0)>>16, Z%(map%,1), child%) + ELSE + child% = FNhashmap_remove(Z%(map%,1), key$) + IF FNis_empty(child%) THEN =Z%(map%,2) + =FNhashmap_alloc_node(Z%(map%,0)>>16, child%, Z%(map%,2)) + ENDIF + +REM FNhashmap_find finds the nearest entry in a non-empty hash-map to +REM the key requested, and returns the entire entry. +DEF FNhashmap_find(map%, key$) + WHILE FNtype_of(map%) = &11 + IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN map% = Z%(map%,2) ELSE map% = Z%(map%,1) + ENDWHILE +=map% + +DEF FNhashmap_get(map%, key$) + IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap" + IF FNis_empty(map%) THEN =FNnil + map% = FNhashmap_find(map%, key$) +IF Z$(map%) = key$ THEN =FNref_local(Z%(map%,2)) ELSE =FNnil + +DEF FNhashmap_contains(map%, key$) + IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap" + IF FNis_empty(map%) THEN =FALSE + map% = FNhashmap_find(map%, key$) +=Z$(map%) = key$ + +DEF FNhashmap_keys(map%) +=FNhashmap_keys1(map%, FNempty) + +DEF FNhashmap_keys1(map%, acc%) + IF FNis_empty(map%) THEN =acc% + IF FNtype_of(map%) = &0A THEN + =FNalloc_pair(FNalloc_string(Z$(map%)), acc%) + ENDIF +=FNhashmap_keys1(Z%(map%,1), FNhashmap_keys1(Z%(map%,2), acc%)) + +DEF FNhashmap_vals(map%) +=FNhashmap_vals1(map%, FNempty) + +DEF FNhashmap_vals1(map%, acc%) + IF FNis_empty(map%) THEN =acc% + IF FNtype_of(map%) = &0A THEN + =FNalloc_pair(Z%(map%,2), acc%) + ENDIF +=FNhashmap_vals1(Z%(map%,1), FNhashmap_vals1(Z%(map%,2), acc%)) + +DEF PROChashmap_dump(map%) + IF FNis_empty(map%) THEN + PRINT "[empty]" + ELSE + PRINT "[-----]" + PROChashmap_dump_internal(map%, "") + ENDIF +ENDPROC + +DEF PROChashmap_dump_internal(map%, prefix$) + IF FNtype_of(map%) = &0A PRINT prefix$;Z$(map%) + IF FNtype_of(map%) = &11 THEN + PRINT prefix$;"<";Z%(map%,0) >> 16;">" + PROChashmap_dump_internal(Z%(map%,1), prefix$ + "L ") + PROChashmap_dump_internal(Z%(map%,2), prefix$ + "R ") + ENDIF +ENDPROC + +REM ** Functions ** + +REM A function is represented by two cells: +REM Z%(x,0) AND &80 = is_macro flag +REM Z%(x,1) = index in Z%() of ast +REM Z%(x,2) = y + +REM Z%(y,1) = index in Z%() of params +REM Z%(y,2) = index in Z%() of env + +DEF FNis_fn(val%) +=FNtype_of(val%) = &15 + +DEF FNis_nonmacro_fn(val%) +=FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &00 + +DEF FNis_macro(val%) +=FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &80 + +DEF FNalloc_fn(ast%, params%, env%) + LOCAL val1%, val2% + val1% = FNmalloc(&15) + Z%(val1%,1) = ast% + val2% = FNmalloc(&19) + Z%(val1%,2) = val2% + Z%(val2%,1) = params% + Z%(val2%,2) = env% +=val1% + +DEF FNas_macro(val%) + IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" + LOCAL newval% + newval% = FNmalloc(Z%(val%,0) OR &80) + Z%(newval%,1) = Z%(val%,1) + Z%(newval%,2) = Z%(val%,2) + Z%(newval%,3) = Z%(val%,3) +=newval% + +DEF FNfn_ast(val%) + IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" +=FNref_local(Z%(val%,1)) + +DEF FNfn_params(val%) + IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" +=FNref_local(Z%(Z%(val%,2),1)) + +DEF FNfn_env(val%) + IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" +=FNref_local(Z%(Z%(val%,2),2)) + +REM ** Atoms ** + +REM Z%(x,1) = index in Z% of current referent + +DEF FNis_atom(val%) +=FNtype_of(val%) = &01 + +DEF FNalloc_atom(contents%) + LOCAL val% + val% = FNmalloc(&01) + Z%(val%,1) = contents% +=val% + +DEF FNatom_deref(val%) +=FNref_local(Z%(val%,1)) + +DEF PROCatom_reset(val%, contents%) + Z%(val%,1) = contents% +ENDPROC + +REM ** Environments ** + +REM Z%(x,1) = index in Z% of hash-map +REM Z%(x,2) = index in Z% of outer environment + +DEF FNis_environment(val%) +=FNtype_of(val%) = &0D + +DEF FNalloc_environment(outer%) + LOCAL val% + val% = FNmalloc(&0D) + Z%(val%,1) = FNempty_hashmap + Z%(val%,2) = outer% +=val% + +DEF FNenvironment_data(val%) + IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" +=FNref_local(Z%(val%,1)) + +DEF PROCenvironment_set_data(val%, data%) + IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" + Z%(val%,1) = data% +ENDPROC + +DEF FNenvironment_outer(val%) + IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" +=FNref_local(Z%(val%,2)) + +REM Local Variables: +REM indent-tabs-mode: nil +REM End: diff --git a/impls/c.2/Dockerfile b/impls/c.2/Dockerfile new file mode 100644 index 0000000000..69737b5dc7 --- /dev/null +++ b/impls/c.2/Dockerfile @@ -0,0 +1,26 @@ +FROM ubuntu:24.04 +MAINTAINER Duncan Watts + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Install gcc +RUN apt-get -y install gcc + +# Libraries needed for the C impl +RUN apt-get -y install libffi-dev libgc-dev libedit-dev pkgconf diff --git a/impls/c.2/Makefile b/impls/c.2/Makefile new file mode 100644 index 0000000000..fb75f9be3e --- /dev/null +++ b/impls/c.2/Makefile @@ -0,0 +1,76 @@ +CC = gcc + +CFLAGS = -std=c99 -g -Wall -Wextra -fanalyzer + +# The code defines new format specifiers. +CPPFLAGS = -Wno-format + +ifdef debug_reader + CPPFLAGS += -DDEBUG_READER +endif +ifdef debug_hash + CPPFLAGS += -DDEBUG_HASH +endif +ifdef debug_hashmap + CPPFLAGS += -DDEBUG_HASHMAP +endif +ifdef debug_hash_collisions + CPPFLAGS += -DDEBUG_HASH_COLLISIONS +endif +ifndef no_fast + CFLAGS += -flto -O3 -DNDEBUG + LDFLAGS += -flto +endif +ifdef profile + CFLAGS += -pg + LDFLAGS += -pg +endif +ifdef readline + pkgconfig_modules += readline + CFLAGS += -DUSE_READLINE +else + pkgconfig_modules += libedit +endif +ifndef no_ffi + pkgconfig_modules += libffi + CFLAGS += -DWITH_FFI +endif + +pkgconfig_modules += bdw-gc +CFLAGS += $(shell pkg-config --cflags $(pkgconfig_modules)) +LDLIBS += $(shell pkg-config --libs $(pkgconfig_modules)) + +S0 = step0_repl +S1 = step1_read_print +S2 = step2_eval +S3 = step3_env +S4 = step4_if_fn_do +S5 = step5_tco +S6 = step6_file +S7 = step7_quote +S8 = step8_macros +S9 = step9_try +SA = stepA_mal + +S4+ := $(S4) $(S5) $(S6) $(S7) $(S8) $(S9) $(SA) +S3+ := $(S3) $(S4+) +S1+ := $(S1) $(S2) $(S3+) +S0+ := $(S0) $(S1+) + +all: $(S0+) + +# GCC could create temporary objects files, but separate recipes for +# .o objects give faster build cycles when debugging. +$(S0+): readline.o +$(S1+): error.o hashmap.o linked_list.o printer.o reader.o types.o vector.o +$(S3+): env.o +$(S4+): core.o + +include deps +deps: + $(CC) -MM -MF- *.c > $@ + +clean: + rm -f $(S0+) *.o deps gmon.out + +.PHONY: all clean diff --git a/impls/c.2/README b/impls/c.2/README new file mode 100644 index 0000000000..6ef28c37b2 --- /dev/null +++ b/impls/c.2/README @@ -0,0 +1,13 @@ +make -Cimpls/c.2/ clean +make -Cimpls/c.2/ no_fast=1 +make test^c.2 HARD=1 REGRESS=1 +make test^mal HARD=1 MAL_IMPL=c.2 + +make -Cimpls/c.2/ clean +make -Cimpls/c.2/ +make perf^c.2 + +make -Cimpls/c.2/ clean +make -Cimpls/c.2/ stepA_mal profile=1 +make perf^c.2 +(cd impls/c.2/ && gprof stepA_mal | less) diff --git a/impls/c.2/core.c b/impls/c.2/core.c new file mode 100644 index 0000000000..fb53881c4c --- /dev/null +++ b/impls/c.2/core.c @@ -0,0 +1,1081 @@ +#include +#include +#include +#include +#include + +#include + +/* only needed for ffi */ +#ifdef WITH_FFI +#include +#include +#endif + +#include "hashmap.h" +#include "core.h" +#include "printer.h" +#include "reader.h" +#include "error.h" +#include "linked_list.h" +#include "readline.h" +#include "vector.h" + +/* forward references to main file */ +MalType apply(MalType fn, list args); + +// Helper functions + +MalType make_boolean(bool); + +/* core ns functions */ +MalType mal_add(list); +MalType mal_sub(list); +MalType mal_mul(list); +MalType mal_div(list); + +MalType mal_prn(list); +MalType mal_println(list); +MalType mal_pr_str(list); +MalType mal_str(list); +MalType mal_read_string(list); +MalType mal_slurp(list); + +MalType mal_list_questionmark(list); +MalType mal_empty_questionmark(list); +MalType mal_count(list); +MalType mal_cons(list); +MalType mal_concat(list); +MalType mal_nth(list); +MalType mal_first(list); +MalType mal_rest(list); + +MalType mal_equals(list); +MalType mal_lessthan(list); +MalType mal_lessthanorequalto(list); +MalType mal_greaterthan(list); +MalType mal_greaterthanorequalto(list); + +MalType mal_atom(list); +MalType mal_atom_questionmark(list); +MalType mal_deref(list); +MalType mal_reset_bang(list); +MalType mal_swap_bang(list); + +MalType mal_throw(list); +MalType mal_apply(list); +MalType mal_map(list); + +MalType mal_nil_questionmark(list); +MalType mal_true_questionmark(list); +MalType mal_false_questionmark(list); +MalType mal_symbol_questionmark(list); +MalType mal_keyword_questionmark(list); +MalType mal_symbol(list); +MalType mal_keyword(list); + +MalType mal_vec(list); +MalType mal_vector(list); +MalType mal_vector_questionmark(list); +MalType mal_sequential_questionmark(list); +MalType mal_hash_map(list); +MalType mal_map_questionmark(list); +MalType mal_assoc(list); +MalType mal_dissoc(list); +MalType mal_get(list); +MalType mal_contains_questionmark(list); +MalType mal_keys(list); +MalType mal_vals(list); +MalType mal_string_questionmark(list); +MalType mal_number_questionmark(list); +MalType mal_fn_questionmark(list); +MalType mal_macro_questionmark(list); + +MalType mal_time_ms(list); +MalType mal_conj(list); +MalType mal_seq(list); +MalType mal_meta(list); +MalType mal_with_meta(list); + +MalType mal_readline(list); + +/* only needed for ffi */ +#ifdef WITH_FFI +MalType mal_dot(list); +#endif + +struct ns_s THE_CORE_NS[] = { + + /* arithmetic */ + { "+", mal_add }, + { "-", mal_sub }, + { "*", mal_mul }, + { "/", mal_div }, + + /* strings */ + { "prn", mal_prn }, + { "pr-str", mal_pr_str }, + { "str", mal_str }, + { "println", mal_println }, + { "read-string", mal_read_string }, + + /* files */ + { "slurp", mal_slurp }, + + /* lists */ + { "list", make_list }, + { "empty?", mal_empty_questionmark }, + { "count", mal_count }, + { "cons", mal_cons }, + { "concat", mal_concat }, + { "nth", mal_nth }, + { "first", mal_first }, + { "rest", mal_rest }, + + /* predicates */ + { "=", mal_equals }, + { "<", mal_lessthan }, + { "<=", mal_lessthanorequalto }, + { ">", mal_greaterthan }, + { ">=", mal_greaterthanorequalto }, + + { "list?", mal_list_questionmark }, + { "nil?", mal_nil_questionmark }, + { "true?", mal_true_questionmark }, + { "false?", mal_false_questionmark }, + { "symbol?", mal_symbol_questionmark }, + { "keyword?", mal_keyword_questionmark }, + { "vector?", mal_vector_questionmark }, + { "sequential?", mal_sequential_questionmark }, + { "map?", mal_map_questionmark }, + { "string?", mal_string_questionmark }, + { "number?", mal_number_questionmark }, + { "fn?", mal_fn_questionmark }, + { "macro?", mal_macro_questionmark }, + + /* atoms */ + { "atom", mal_atom }, + { "atom?", mal_atom_questionmark }, + { "deref", mal_deref }, + { "reset!", mal_reset_bang }, + { "swap!", mal_swap_bang }, + + /* other */ + { "throw", mal_throw }, + { "apply", mal_apply }, + { "map", mal_map }, + + { "symbol", mal_symbol }, + { "keyword", mal_keyword }, + { "vec", mal_vec }, + { "vector", mal_vector }, + { "hash-map", mal_hash_map }, + + /* hash-maps */ + { "contains?", mal_contains_questionmark }, + { "assoc", mal_assoc }, + { "dissoc", mal_dissoc }, + { "get", mal_get }, + { "keys", mal_keys }, + { "vals", mal_vals }, + + /* misc */ + { "time-ms", mal_time_ms }, + { "conj", mal_conj }, + { "seq", mal_seq }, + { "meta", mal_meta }, + { "with-meta", mal_with_meta }, + + { "readline", mal_readline }, + + /* only needed for ffi */ + #ifdef WITH_FFI + { ".", mal_dot }, + #endif +}; + +void ns_make_core(ns* core, size_t* size) { + *core = THE_CORE_NS; + *size = sizeof(THE_CORE_NS) / sizeof(struct ns_s); +} + +/* core function definitons */ + +#define generic_arithmetic(name, op, iconst, fconst) \ + MalType name(list args) { \ + explode2(#op, args, a1, a2); \ + long i1, i2; \ + double f1, f2; \ + if (is_integer(a1, &i1)) { \ + if (is_integer(a2, &i2)) return iconst(i1 op i2); \ + if (is_float (a2, &f2)) return fconst(i1 op f2); \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ + } \ + if (is_float(a1, &f1)) { \ + if (is_integer(a2, &i2)) return iconst(f1 op i2); \ + if (is_float (a2, &f2)) return fconst(f1 op f2); \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ + } \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a1); \ + } +generic_arithmetic(mal_add, +, make_integer, make_float) +generic_arithmetic(mal_sub, -, make_integer, make_float) +generic_arithmetic(mal_mul, *, make_integer, make_float) +generic_arithmetic(mal_div, /, make_integer, make_float) +generic_arithmetic(mal_lessthan, <, make_boolean, make_boolean) +generic_arithmetic(mal_lessthanorequalto, <=, make_boolean, make_boolean) +generic_arithmetic(mal_greaterthan, >, make_boolean, make_boolean) +generic_arithmetic(mal_greaterthanorequalto, >=, make_boolean, make_boolean) + +#define generic_type_predicate(name, mask) \ + MalType mal_##name##_questionmark(list args) { \ + explode1(#name "?", args, val); \ + return make_boolean(type(val) & (mask)); \ + } +generic_type_predicate(list, MALTYPE_LIST) +generic_type_predicate(atom, MALTYPE_ATOM) +generic_type_predicate(nil, MALTYPE_NIL) +generic_type_predicate(true, MALTYPE_TRUE) +generic_type_predicate(false, MALTYPE_FALSE) +generic_type_predicate(symbol, MALTYPE_SYMBOL) +generic_type_predicate(keyword, MALTYPE_KEYWORD) +generic_type_predicate(vector, MALTYPE_VECTOR) +generic_type_predicate(sequential, MALTYPE_LIST | MALTYPE_VECTOR) +generic_type_predicate(map, MALTYPE_HASHMAP) +generic_type_predicate(string, MALTYPE_STRING) +generic_type_predicate(number, MALTYPE_FLOAT | MALTYPE_INTEGER) +generic_type_predicate(fn, MALTYPE_CLOSURE | MALTYPE_FUNCTION) +generic_type_predicate(macro, MALTYPE_MACRO) + +MalType mal_equals(list args) { + /* Accepts any type of arguments */ + + explode2("=", args, first_val, second_val); + return make_boolean(equal_forms(first_val, second_val)); +} + +MalType mal_nth(list args) { + + explode2("nth", args, lst, n); + + vector_t v; + list l; + long idx; + if (!is_integer(n, &idx)) { + bad_type("nth", MALTYPE_INTEGER, n); + } + if(idx < 0) { + make_error("'nth': negative index: %d", idx); + } + if (is_list(lst, &l)) { + while(l) { + if(!idx) + return l->data; + l = l->next; + idx--; + } + } + else if ((v = is_vector(lst))) { + if ((size_t)idx < v->count) { + return v->nth[idx]; + } + } else { + bad_type("nth", MALTYPE_LIST | MALTYPE_VECTOR, lst); + } + make_error("'nth': index %M out of bounds for: %M", n, lst); +} + +MalType mal_first(list args) { + + explode1("first", args, lst); + + list result; + vector_t v; + if(is_nil(lst)) { + return make_nil(); + } + else if ((v = is_vector(lst))) { + return v->count ? v->nth[0] : make_nil(); + } + else if (!is_list(lst, &result)) { + bad_type("first", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL, lst); + } + + if (result) { + return result->data; + } + else { + return make_nil(); + } +} + +MalType mal_rest(list args) { + + explode1("rest", args, lst); + + list result = NULL; + vector_t v; + if(is_nil(lst)) { + return make_list(NULL); + } + else if ((v = is_vector(lst))) { + for (size_t i = v->count; 1 < i--; ) { + result = list_push(result, v->nth[i]); + } + return make_list(result); + } + else if (!is_list(lst, &result)) { + bad_type("rest", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL, lst); + } + + if (result) { + result = result->next; + } + return make_list(result); +} + + +MalType mal_cons(list args) { + + explode2("cons", args, a1, lst); + + list result = NULL; + vector_t v; + if ((v = is_vector(lst))) { + for (size_t i = v->count; i--; ) { + result = list_push(result, v->nth[i]); + } + } + else if (is_list(lst, &result)) { + } + else if (is_nil(lst)) { + } + else { + bad_type("cons", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL, lst); + } + return make_list(list_push(result, a1)); +} + +MalType mal_concat(list args) { + + // Could reuse the last if it is not nil... + + list new_list = NULL; + list* new_list_last = &new_list; + while (args) { + + MalType val = args->data; + + /* skip nils */ + if (is_nil(val)) { + } + /* concatenate lists and vectors */ + else if (type(val) & (MALTYPE_LIST | MALTYPE_VECTOR)) { + for (seq_cursor lst = seq_iter(val); seq_cont(val, lst); lst = seq_next(val, lst)) { + *new_list_last = list_push(NULL, seq_item(val, lst)); + new_list_last = &(*new_list_last)->next; + } + } + /* raise an error for any non-sequence types */ + else { + bad_type("concat", MALTYPE_NIL | MALTYPE_LIST | MALTYPE_VECTOR, val); + } + args = args->next; + } + return make_list(new_list); +} + +MalType mal_count(list args) { + + explode1("count", args, val); + + vector_t v; + list mal_list; + if(is_nil(val)) { + return make_integer(0); + } + else if ((v = is_vector(val))) { + return make_integer(v->count); + } + else if (!is_list(val, &mal_list)) { + bad_type("count", MALTYPE_LIST | MALTYPE_NIL | MALTYPE_VECTOR, val); + } + return make_integer((long)list_count(mal_list)); +} + +MalType mal_empty_questionmark(list args) { + + explode1("empty?", args, val); + + vector_t v; + list l; + if ((v = is_vector(val))) { + return make_boolean(!v->count); + } + else if (is_list(val, &l)) { + return make_boolean(!l); + } + else { + bad_type("empty?", MALTYPE_LIST | MALTYPE_VECTOR, val); + } +} + +MalType mal_pr_str(list args) { + /* Accepts any number and type of arguments */ + return make_string(mal_printf("%N", args)); +} + +MalType mal_str(list args) { + /* Accepts any number and type of arguments */ + return make_string(mal_printf("%# N", args)); +} + +MalType mal_prn(list args) { + /* Accepts any number and type of arguments */ + printf("%N\n", args); + return make_nil(); +} + +MalType mal_println(list args) { + /* Accepts any number and type of arguments */ + printf("%#N\n", args); + return make_nil(); +} + +MalType mal_read_string(list args) { + + explode1("read-string", args, val); + + const char* s = is_string(val); + if (!s) { + bad_type("read-string", MALTYPE_STRING, val); + } + return read_str(s); + // Implicit error propagation +} + +MalType mal_slurp(list args) { + + explode1("slurp", args, a1); + + const char* filename = is_string(a1); + if (!filename) { + bad_type("slurp", MALTYPE_STRING, a1); + } + + FILE* file = fopen(filename, "rb"); + + if (!file){ + make_error("'slurp': file not found '%s'", filename); + } + + fseek(file, 0, SEEK_END); + size_t file_length = ftell(file); + fseek(file, 0, SEEK_SET); + + char* buffer = (char*)GC_MALLOC(sizeof(*buffer) * file_length + 1); + size_t read = fread(buffer, sizeof(*buffer), file_length, file); + // close before raising an exception + fclose(file); + if (file_length != read) { + make_error("'slurp': failed to read file '%s'", filename); + } + + buffer[file_length] = '\0'; + return make_string(buffer); +} + +MalType mal_atom(list args) { + explode1("atom", args, val); + return make_atom(val); +} +MalType mal_deref(list args) { + explode1("deref", args, val); + MalType* atm = is_atom(val); + if (!atm) { + bad_type("deref", MALTYPE_ATOM, val); + } + return *atm; +} +MalType mal_reset_bang(list args) { + explode2("reset!", args, a1, a2); + MalType* atm = is_atom(a1); + if (!atm) { + bad_type("reset!", MALTYPE_ATOM, a1); + } + *atm = a2; + return a2; +} +MalType mal_swap_bang(list args) { + if (!args || !args->next) { + bad_arg_count("swap!", "at least two arguments", args); + } + MalType* atm = is_atom(args->data); + if (!atm) { + bad_type("swap!", MALTYPE_ATOM, args->data); + } + MalType fn = args->next->data; + check_type("swap!", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, fn); + list fn_args = list_push(args->next->next, *atm); + MalType result = apply(fn, fn_args); + + if (mal_error) { + return NULL; + } + else { + *atm = result; + return result; + } +} + +MalType mal_throw(list args) { + explode1("throw", args, a1); + + /* re-throw an existing exception */ + assert(!mal_error); + /* create a new exception */ + mal_error = a1; + return NULL; +} + +MalType mal_apply(list args) { + + if (!args || !args->next) { + bad_arg_count("apply", "at least two arguments", args); + } + MalType func = args->data; + check_type("apply", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); + args = args->next; + + /* assemble loose arguments */ + list lst = NULL; + list* lst_last = &lst; + while(args->next) { + *lst_last = list_push(NULL, args->data); + lst_last = &(*lst_last)->next; + args = args->next; + } + + MalType final = args->data; + + vector_t v = is_vector(final); + // Append the elements of the final sequence, + // efficiently if it is a list. + if (v) { + for (size_t i = v->count; i--; ) { + *lst_last = list_push(*lst_last, v->nth[i]); + } + } + else if (!is_list(final, lst_last)) { + bad_type("swap!", MALTYPE_LIST | MALTYPE_VECTOR, final); + } + + return apply(func, lst); + // Implicit error propagation +} + +MalType mal_map(list args) { + + explode2("map", args, func, arg); + + check_type("map", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); + // This check is not redundant when arg is empty. + + check_type("map", MALTYPE_LIST | MALTYPE_VECTOR, arg); + seq_cursor arg_list = seq_iter(arg); + list result_list = NULL; + list* result_list_last = &result_list; + + while(seq_cont(arg, arg_list)) { + + MalType result = apply(func, list_push(NULL, seq_item(arg, arg_list))); + + /* early return if error */ + if (mal_error) { + return NULL; + } + else { + *result_list_last = list_push(NULL, result); + result_list_last = &(*result_list_last)->next; + + } + arg_list = seq_next(arg, arg_list); + } + return make_list(result_list); +} + +MalType mal_symbol(list args) { + explode1("symbol", args, val); + + const char* s = is_string(val); + if (!s) { + bad_type("symbol", MALTYPE_STRING, val); + } + return make_symbol(s); +} + +MalType mal_keyword(list args) { + + explode1("keyword", args, val); + + const char* s; + if ((s = is_string (val))) { + return make_keyword(s); + } + else if ((s = is_keyword(val))) { + return val; + } + else { + bad_type("keyword", MALTYPE_KEYWORD | MALTYPE_STRING, val); + } +} + +MalType mal_vector(list args) { + /* Accepts any number and type of arguments */ + size_t capacity = list_count(args); + struct vector* v = vector_new(capacity); + while (args) { + vector_append(&capacity, &v, args->data); + args = args->next; + } + assert(v->count == capacity); + return make_vector(v); +} + +MalType mal_vec(list args) { + + /* Accepts a single argument */ + + explode1("vec", args, val); + + list l; + vector_t v; + if ((v = is_vector(val))) { + return val; + } + else if (is_list ( val, &l)) { + return mal_vector(l); + } + else { + bad_type("vec", MALTYPE_LIST | MALTYPE_VECTOR, val); + } +} + +MalType map_assoc_mutate(const char* context, struct map* new_lst, list args) { + for (list a = args; a ; a = a->next->next) { + check_type(context, MALTYPE_KEYWORD | MALTYPE_STRING, a->data); + if (!a->next) { + bad_arg_count("assoc", "an even count of key/value pairs", args); + } + new_lst = hashmap_put(new_lst, a->data, a->next->data); + } + return make_hashmap(new_lst); +} + +MalType mal_hash_map(list args) { + return map_assoc_mutate("hash-map", map_empty(), args); +} + +MalType mal_get(list args) { + + explode2("get", args, map, key); + + check_type("get", MALTYPE_KEYWORD | MALTYPE_STRING, key); + + hashmap mal_list; + if(is_nil(map)) { + return make_nil(); + } + else if(!(mal_list = is_hashmap(map))) { + bad_type("get", MALTYPE_HASHMAP | MALTYPE_NIL, map); + } + + MalType result = hashmap_get(mal_list, key); + + if (!result) { + return make_nil(); + } + + return result; +} + +MalType mal_contains_questionmark(list args) { + + explode2("contains?", args, map, key); + + check_type("contains?", MALTYPE_KEYWORD | MALTYPE_STRING, key); + + hashmap mal_list; + if(is_nil(map)) { + return make_nil(); + } + if (!(mal_list = is_hashmap(map))) { + bad_type("contains?", MALTYPE_HASHMAP | MALTYPE_NIL, map); + } + + MalType result = hashmap_get(mal_list, key); + + return make_boolean(result); +} + +MalType mal_assoc(list args) { + if (!args) { + bad_arg_count("assoc", "at least one argument", args); + } + MalType map = args->data; + hashmap m = is_hashmap(map); + if (!m) { + bad_type("assoc", MALTYPE_HASHMAP, map); + } + return map_assoc_mutate("assoc", map_copy(m), args->next); +} + +MalType mal_dissoc(list args) { + + if (!args) { + bad_arg_count("dissoc", "at least one argument", args); + } + MalType map = args->data; + hashmap m = is_hashmap(map); + if (!m) { + bad_type("dissoc", MALTYPE_HASHMAP, map); + } + struct map* new_list = map_copy(m); + + args = args->next; + + list dis_args = args; + + while(dis_args) { + + check_type("dissoc", MALTYPE_KEYWORD | MALTYPE_STRING, dis_args->data); + map_dissoc_mutate(new_list, dis_args->data); + dis_args = dis_args->next; + } + + return make_hashmap(new_list); +} + + +MalType mal_keys(list args) { + + explode1("keys", args, map); + + hashmap m = is_hashmap(map); + if (!m) { + bad_type("keys", MALTYPE_HASHMAP, map); + } + map_cursor lst = map_iter(m); + + list result = NULL; + while(map_cont(m, lst)) { + + result = list_push(result, map_key(m, lst)); + lst = map_next(m, lst); + } + return make_list(result); +} + +MalType mal_vals(list args) { + + explode1("vals", args, map); + + hashmap m = is_hashmap(map); + if (!m) { + bad_type("vals", MALTYPE_HASHMAP, map); + } + map_cursor lst = map_iter(m); + + list result = NULL; + while(map_cont(m, lst)) { + + result = list_push(result, map_val(m, lst)); + lst = map_next(m, lst); + } + return make_list(result); +} + +MalType mal_time_ms(list args) { + explode0("time-ms", args); + + struct timeval tv; + gettimeofday(&tv, NULL); + long ms = tv.tv_sec * 1000 + tv.tv_usec/1000.0 + 0.5; + + return make_float(ms); +} + + +MalType mal_conj(list args) { + + if (!args) { + bad_arg_count("conj", "at least one argument", args); + } + MalType lst = args->data; + + list rest = args->next; + + vector_t src; + list new_lst; + if (is_list(lst, &new_lst)) { + + while(rest) { + new_lst = list_push(new_lst, rest->data); + rest = rest->next; + } + return make_list(new_lst); + } + else if ((src = is_vector(lst))) { + + size_t capacity = src->count + list_count(rest); + struct vector* new_vec = vector_new(capacity); + + for (size_t i = 0; i < src->count; i++) { + vector_append(&capacity, &new_vec, src->nth[i]); + } + + while(rest) { + vector_append(&capacity, &new_vec, rest->data); + rest = rest->next; + } + assert(new_vec->count == capacity); + return make_vector(new_vec); + } + else { + bad_type("conj", MALTYPE_LIST | MALTYPE_VECTOR, lst); + } +} + +MalType mal_seq(list args) { + + explode1("seq", args, val); + + vector_t v; + list lst = NULL; + const char* ch; + + if (is_list(val, &lst)) { + return lst ? val : make_nil(); + } + else if ((ch = is_string(val))) { + + /* empty string */ + if (*ch == '\0') { + return make_nil(); + } + else { + for (size_t i = strlen(ch); i--; ) { + char* new_ch = GC_MALLOC(2); + *new_ch = ch[i]; + assert(!new_ch[1]); + + lst = list_push(lst, make_string(new_ch)); + } + return make_list(lst); + } + } + else if ((v = is_vector(val))) { + for (size_t i = v->count; i--; ) { + lst = list_push(lst, v->nth[i]); + } + return lst ? make_list(lst) : make_nil(); + } + else if (is_nil(val)) { + return make_nil(); + } + else { + bad_type("seq", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL | MALTYPE_STRING, val); + } +} + +MalType mal_meta(list args) { + + explode1("meta", args, val); + + return meta(val); +} + +MalType mal_with_meta(list args) { + + explode2("with-meta", args, val, metadata); + + list l; + if (is_list(val, &l)) return make_list_m(l, metadata); + vector_t v = is_vector(val); + if (v) return make_vector_m(v, metadata); + hashmap m = is_hashmap(val); + if (m) return make_hashmap_m(m, metadata); + function_t f = is_function(val); + if (f) return make_function_m(f, metadata); + MalClosure c = is_closure(val); + if (c) return make_closure_m(c->env, c->fnstar_args, metadata); + bad_type("with-meta", + MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_HASHMAP | MALTYPE_FUNCTION | MALTYPE_CLOSURE, + val); +} + +MalType mal_readline(list args) { + explode1("readline", args, prompt); + + const char* prompt_str = is_string(prompt); + if (!prompt_str) { + bad_type("readline", MALTYPE_STRING, prompt); + } + const char* str = readline_gc(prompt_str); + if(!str) + return make_nil(); + return make_string(str); +} + + +/* helper functions */ + +inline MalType make_boolean(bool x) { + return x ? make_true() : make_false(); +} + + +#ifdef WITH_FFI +struct { + const char* c_type; + enum mal_type_t mal_type; + ffi_type* ffit; +} core_ffi_translations[] = { + { "void", MALTYPE_NIL, &ffi_type_void }, + { "string", MALTYPE_STRING, &ffi_type_pointer }, + { "char*", MALTYPE_STRING, &ffi_type_pointer }, + { "char *", MALTYPE_STRING, &ffi_type_pointer }, + { "integer", MALTYPE_INTEGER, &ffi_type_sint64 }, + { "int64", MALTYPE_INTEGER, &ffi_type_sint64 }, + { "int32", MALTYPE_INTEGER, &ffi_type_sint32 }, + { "double", MALTYPE_FLOAT, &ffi_type_double }, + { "float", MALTYPE_FLOAT, &ffi_type_float }, +}; +size_t core_ffi_find(const char *type) { + for (size_t i = 0; + i < sizeof(core_ffi_translations) / sizeof(*core_ffi_translations); + i++) { + if (!strcmp(core_ffi_translations[i].c_type, type)) { + return i; + } + } + make_error("'ffi': unknown type '%s'", type); +} +MalType mal_dot(list args) { + + /* (. "lib" "return type" "function" "arg1 type" "arg 1" ...) */ + + list a; + if (!args || !(a = args->next) || !a->next) { + bad_arg_count(".", "at least three arguments", args); + } + + const char* lib_name = is_string(args->data); + if (!lib_name && !is_nil(args->data)) { + bad_type(".", MALTYPE_STRING | MALTYPE_NIL, args->data); + } + + const char* return_type_str = is_string(a->data); + if (!return_type_str) { + bad_type(".", MALTYPE_STRING, a->data); + } + size_t return_type = core_ffi_find(return_type_str); + if (mal_error) return NULL; + + a = a->next; + + const char* fn_name = is_string(a->data); + if (!fn_name) { + bad_type(".", MALTYPE_STRING, a->data); + } + + a = a->next; + + int arg_count = 0; + ffi_type* arg_types[20]; + void* arg_vals [20]; + while (a) { + if (20 <= arg_count) { + bad_arg_count(".", "less than 20 C arguments", args); + } + const char* val_type = is_string(a->data); + if (!val_type) { + bad_type(".", MALTYPE_STRING, a->data); + } + size_t val_type_index = core_ffi_find(val_type); + if (mal_error) return NULL; + arg_types[arg_count] = core_ffi_translations[val_type_index].ffit; + + a = a->next; + + if (!a) { + bad_arg_count(".", "an even number of argument types and values", args); + } + arg_vals[arg_count] = mal_type_value_address(a->data); + + a = a->next; + arg_count++; + } + + /* open a shared library dynamically and get hold of a function */ + void* lib_handle = dlopen(lib_name, RTLD_LAZY); + + if (!lib_handle) { + make_error("'ffi': reports: %s", dlerror()); + } + + void* fn = dlsym(lib_handle, fn_name); + + const char* error = dlerror(); + if (error) { + make_error("'ffi': dlsym could not get handle to function '%s': %s", fn_name, error); + } + + /* use libffi to call function */ + /* perform the call */ + ffi_cif cif; + ffi_status status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, arg_count, + core_ffi_translations[return_type].ffit, + arg_types); + if (status != FFI_OK) { + make_error("'ffi': call to ffi_prep_cif failed with code: %d", status); + } + + /* set return type */ + MalType result; + switch (core_ffi_translations[return_type].mal_type) { + case MALTYPE_NIL: { + char retval; + ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); + result = make_nil(); + break; + } + case MALTYPE_STRING: { + char* retval; + ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); + result = make_string(retval); + break; + } + case MALTYPE_INTEGER: { + long retval; + ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); + result = make_integer(retval); + break; + } + case MALTYPE_FLOAT: { + double retval; + ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); + result = make_float(retval); + break; + } + default: + assert(false); + } + + /* close the library */ + dlclose(lib_handle); + + return result; +} + +#endif diff --git a/impls/c.2/core.h b/impls/c.2/core.h new file mode 100644 index 0000000000..1d193e9f7d --- /dev/null +++ b/impls/c.2/core.h @@ -0,0 +1,17 @@ +#ifndef _MAL_CORE_H +#define _MAL_CORE_H + +#include "types.h" + +typedef const struct ns_s* ns; + +struct ns_s { + + const char* key; + function_t value; + +}; + +void ns_make_core(ns* core, size_t* size); + +#endif diff --git a/impls/c.2/env.c b/impls/c.2/env.c new file mode 100644 index 0000000000..5d412bed2f --- /dev/null +++ b/impls/c.2/env.c @@ -0,0 +1,34 @@ +#include + +#include "env.h" +#include "hashmap.h" + +struct Env_s { + const Env* outer; + struct map* data; +}; + +Env* env_make(const Env* outer) { + struct Env_s* env = GC_MALLOC(sizeof(*env)); + env->outer = outer; + env->data = map_empty(); + return env; +} + +inline void env_set(Env* current, MalType symbol, MalType value) { + current->data = hashmap_put(current->data, symbol, value); +} + +MalType env_get(const Env* current, MalType symbol) { + do { + MalType value = hashmap_get(current->data, symbol); + if (value) { + return value; + } + } while((current = current->outer)); + return NULL; +} + +hashmap env_as_map(const Env* current) { + return current->data; +} diff --git a/impls/c.2/env.h b/impls/c.2/env.h new file mode 100644 index 0000000000..d2a9ffc66f --- /dev/null +++ b/impls/c.2/env.h @@ -0,0 +1,18 @@ +#ifndef _MAL_ENV_H +#define _MAL_ENV_H + +#include "types.h" + +// types.h defines Env as struct Env_s. + +Env* env_make(const Env* outer); + +void env_set(Env* current, MalType symbol, MalType value); + +MalType env_get(const Env* current, MalType symbol); +/* Returns NULL if the symbol is not found. */ + +hashmap env_as_map(const Env* current); +// For debugging. + +#endif diff --git a/impls/c.2/error.c b/impls/c.2/error.c new file mode 100644 index 0000000000..0059ae2838 --- /dev/null +++ b/impls/c.2/error.c @@ -0,0 +1,5 @@ +#include + +#include "error.h" + +MalType mal_error = NULL; diff --git a/impls/c.2/error.h b/impls/c.2/error.h new file mode 100644 index 0000000000..3ce18c2e49 --- /dev/null +++ b/impls/c.2/error.h @@ -0,0 +1,47 @@ +#ifndef MAL_ERROR_H +#define MAL_ERROR_H + +#include "types.h" + +extern MalType mal_error; + +#define make_error(...) { \ + mal_error = make_string(mal_printf(__VA_ARGS__)); \ + return 0; \ + } + +#define bad_type(context, mask, form) \ + make_error("'%s': bad argument type: expected %T, got %M", context, mask, form) + +#define check_type(context, mask, form) \ + if (type(form) & ~(mask)) \ + bad_type(context, mask, form) + +#define bad_arg_count(context, expected, args) \ + make_error("'" context "': bad argument count: expected %s, got [%N]", expected, args) + +#define explode0(context, args) \ + if (args) \ + bad_arg_count(context, "no argument", args) + +#define explode1(context, args, var1) \ + if (!args || args->next) \ + bad_arg_count(context, "one argument", args); \ + MalType var1 = args->data + +#define explode2(context, args, var1, var2) \ + list _a; \ + if (!args || !(_a = args->next) || _a->next) \ + bad_arg_count(context, "two arguments", args); \ + MalType var1 = args->data; \ + MalType var2 = _a->data + +#define explode3(context, args, var1, var2, var3) \ + list _a, _b; \ + if (!args || !(_a = args->next) || !(_b = _a->next) || _b->next) \ + bad_arg_count(context, "three arguments", args); \ + MalType var1 = args->data; \ + MalType var2 = _a->data; \ + MalType var3 = _b->data + +#endif diff --git a/impls/c.2/hashmap.c b/impls/c.2/hashmap.c new file mode 100644 index 0000000000..a1d8109c49 --- /dev/null +++ b/impls/c.2/hashmap.c @@ -0,0 +1,186 @@ +#include +#include + +#include + +#include "hashmap.h" + +#ifdef DEBUG_HASHMAP +# include +# include "printer.h" +#endif +#ifdef DEBUG_HASH_COLLISIONS +# include +# include "printer.h" +#endif + +// Removals or redefinitions are rare. +// Most structures are quite small, except two ones. +// the REPL environment and +// the map representing the hosted REPL environment. +// Most maps are built once, then constant. +// MAL spends a lot of its time searching DEBUG-EVAL in environments. + +// Either a map has less than 3 keys, or be generous. +// After changing this, try "make debug_hash_collisions=1", +// because a collison for DEBUG-EVAL in REPL is costly. +#define MIN_BUCKETS 7 +#define GROW_FACTOR 25 + +struct map { + // Invariants: + // table contains size buckets. + // 0 <= 2*used < size + // A bucket may have three states: + // unused (both key and value == NULL) + // used normally (both key and value != NULL) + // used deleted (key != NULL but value == NULL) + // In case of collision, search after the intended one. + size_t used; + size_t size; + struct bucket { + MalType key; + void* value; + } buckets[]; +}; + +struct map* map_empty() { + struct map* m = GC_MALLOC(sizeof(*m) + MIN_BUCKETS*sizeof(struct bucket)); + // GC_MALLOC sets all the allocated space to zero. + m->size = MIN_BUCKETS; + return m; +} + +struct map* map_copy(hashmap map) { + size_t bytes = sizeof(*map) + map->size * sizeof(struct bucket); + struct map* m = GC_MALLOC(bytes); + memcpy(m, map, bytes); + return m; +} + +size_t search(hashmap map, MalType key) { + // The key of the returned index is either NULL or equal to key. + + size_t index = get_hash(key) % map->size; + while (true) { + MalType current = map->buckets[index].key; + if (!current || equal_forms(key, current)) break; +#ifdef DEBUG_HASH_COLLISIONS + printf("collision %M(h:%u i:%u) %M(h:%u i:%u)\n", + key, get_hash(key), get_hash(key) % map->size, + current, get_hash(current), get_hash(current) % map->size); +#endif + index++; + if (index == map->size) index = 0; + } +#ifdef DEBUG_HASH_COLLISIONS + if (index != get_hash(key) % map->size) { + printf("collision (%.1f%% of %u) key %M stored in bucket %d instead of %d\n", + (float)(100*map->used) / (float)(map->size), map->size, + key, index, get_hash(key) % map->size); + } +#endif +#ifdef DEBUG_HASHMAP + printf("HASHMAP: search:%M hash:%u index:%u\n", key, get_hash(key), index); + for (size_t i = 0; i < map->size; i++) { + if (map->buckets[i].key) { + if (map->buckets[i].value) { + printf(" bucket:%u/%u key:%M val:%M\n", + i, map->size, map->buckets[i].key, map->buckets[i].value); + } + else { + printf(" bucket:%u/%u key:%M (removed)\n", + i, map->size, map->buckets[i].key); + } + } + else { + assert(!map->buckets[i].value); + } + printf(""); + } +#endif + return index; +} + +void put(struct map* map, MalType key, void* value) { + size_t i = search(map, key); + if (!map->buckets[i].key) { + map->used++; + map->buckets[i].key = key; + } + // else replace the existing/deleted value + map->buckets[i].value = value; +} + +struct map* hashmap_put(struct map* map, MalType key, void* value) { + assert(value); + if (map->size <= 2 * (map->used + 1)) { + // Reallocate. + size_t size = map->size * GROW_FACTOR; + struct map* m = GC_MALLOC(sizeof(*m) + size*sizeof(struct bucket)); + // GC_MALLOC sets all the allocated space to zero. + m->size = size; + for (size_t i = 0; i < map->size; i++) { + if (map->buckets[i].key && map->buckets[i].value) { + put(m, map->buckets[i].key, map->buckets[i].value); + } + } + map = m; + } + put(map, key, value); + return map; +} + +inline void* hashmap_get(hashmap map, MalType key) { + return map->buckets[search(map, key)].value; // may be null +} + +void map_dissoc_mutate(struct map* map, MalType key) { + size_t i = search(map, key); + if (map->buckets[i].key) { + map->buckets[i].value = NULL; + } +} + +inline size_t map_count(hashmap map) { + return map->used; +} + +map_cursor next_valid(hashmap map, size_t i) { + while ((i < map->size) && !(map->buckets[i].key && map->buckets[i].value)) { + i++; + } + return i; +} + +inline map_cursor map_iter(hashmap map) { + return next_valid(map, 0); +} + +inline bool map_cont(hashmap map, map_cursor position) { + return position < map->size; +} + +inline MalType map_key(hashmap map, map_cursor position) { + assert(position < map->size); + assert(map->buckets[position].key); + assert(map->buckets[position].value); + + return map->buckets[position].key; +} + +inline void* map_val(hashmap map, map_cursor position) { + assert(position < map->size); + assert(map->buckets[position].key); + assert(map->buckets[position].value); + + return map->buckets[position].value; +} + +inline map_cursor map_next(hashmap map, map_cursor position) { + assert(position < map->size); + assert(map->buckets[position].key); + assert(map->buckets[position].value); + + return next_valid(map, position + 1); +} diff --git a/impls/c.2/hashmap.h b/impls/c.2/hashmap.h new file mode 100644 index 0000000000..8a18dd0936 --- /dev/null +++ b/impls/c.2/hashmap.h @@ -0,0 +1,36 @@ +#ifndef MAL_HASHMAP_H +#define MAL_HASHMAP_H + +#include + +#include "types.h" + +// Keys must be keywords, strings or symbols. + +struct map* map_empty(); +// not NULL + +struct map* map_copy(hashmap); + +struct map* hashmap_put(struct map* map, MalType key, void* value); +// Value must not be NULL. +// May reallocate. + +void* hashmap_get(hashmap map, MalType key); +// Returns NULL if the map does not contain the key. + +void map_dissoc_mutate(struct map* map, MalType key); + +size_t map_count(hashmap); + +typedef size_t map_cursor; +// The same (unmodified) container must be be provided to each +// function during iteration. + +map_cursor map_iter(hashmap); +bool map_cont(hashmap, map_cursor); +map_cursor map_next(hashmap, map_cursor); +MalType map_key(hashmap, map_cursor); +void* map_val(hashmap, map_cursor); + +#endif diff --git a/impls/c.2/linked_list.c b/impls/c.2/linked_list.c new file mode 100644 index 0000000000..c0b6ec11d3 --- /dev/null +++ b/impls/c.2/linked_list.c @@ -0,0 +1,25 @@ +#include + +#include "linked_list.h" + +list list_push(list lst, MalType data_ptr) { + + struct pair_s* new_head = GC_malloc(sizeof(*new_head)); + new_head->data = data_ptr; + new_head->next = lst; + + return new_head; +} + +size_t list_count(list lst) { + + size_t counter = 0; + + while(lst) { + + counter++; + lst = lst->next; + } + + return counter; +} diff --git a/impls/c.2/linked_list.h b/impls/c.2/linked_list.h new file mode 100644 index 0000000000..b7469ed205 --- /dev/null +++ b/impls/c.2/linked_list.h @@ -0,0 +1,19 @@ +#ifndef _MAL_LINKED_LIST_H +#define _MAL_LINKED_LIST_H + +#include "types.h" + +/* linked list is constructed of pairs */ +/* a list is just a pointer to the pair at the head of the list */ +struct pair_s { + + MalType data; + list next; + +}; + +/* interface */ +list list_push(list lst, MalType data_ptr); +size_t list_count(list lst); + +#endif diff --git a/impls/c.2/printer.c b/impls/c.2/printer.c new file mode 100644 index 0000000000..01daf7e1d6 --- /dev/null +++ b/impls/c.2/printer.c @@ -0,0 +1,280 @@ +#include +#include +#include + +#include + +#include "linked_list.h" +#include "printer.h" +#include "hashmap.h" +#include "vector.h" + +#define PRINT_NIL "nil" +#define PRINT_TRUE "true" +#define PRINT_FALSE "false" + +int escape_string(FILE *stream, const char* str); +int pr_str_vector(FILE* stream, const struct printf_info *i, vector_t v); + +// Execute count once. +#define ADD(count) { \ + int more = count; \ + if(more < 0) \ + return more; \ + written += more; \ + } + +int print_M(FILE *stream, const struct printf_info *i, const void *const *a) { + MalType val = *((const MalType*)(*a)); + + int written = 0; + + switch(type(val)) { + + case MALTYPE_SYMBOL: + + ADD(fprintf(stream, "%s", is_symbol(val))); + break; + + case MALTYPE_KEYWORD: + + ADD(fprintf(stream, ":%s", is_keyword(val))); + break; + + case MALTYPE_INTEGER: + { + long mal_integer; + is_integer(val, &mal_integer); + ADD(fprintf(stream, "%ld", mal_integer)); + break; + } + case MALTYPE_FLOAT: + { + double mal_float; + is_float(val, &mal_float); + ADD(fprintf(stream, "%lf", mal_float)); + break; + } + case MALTYPE_STRING: + + if (!i->alt) { + ADD(escape_string(stream, is_string(val))); + } + else { + ADD(fprintf(stream, "%s", is_string(val))); + } + break; + + case MALTYPE_TRUE: + + ADD(fprintf(stream, PRINT_TRUE)); + break; + + case MALTYPE_FALSE: + + ADD(fprintf(stream, PRINT_FALSE)); + break; + + case MALTYPE_NIL: + + ADD(fprintf(stream, PRINT_NIL)); + break; + + case MALTYPE_LIST: + { + list mal_list; + is_list(val, &mal_list); + ADD(fprintf(stream, i->alt ? "(%#N)" : "(%N)", mal_list)); + break; + } + case MALTYPE_VECTOR: + + ADD(pr_str_vector(stream, i, is_vector(val))); + break; + + case MALTYPE_HASHMAP: + + ADD(fprintf(stream, i->alt ? "{%#H}" : "{%H}", is_hashmap(val))); + break; + + case MALTYPE_FUNCTION: + + ADD(fprintf(stream, "#")); + break; + + case MALTYPE_CLOSURE: + + ADD(fprintf(stream, i->alt ? "#" : "#", + is_closure(val)->fnstar_args)); + break; + + case MALTYPE_MACRO: + + ADD(fprintf(stream, i->alt ? "#" : "#", + is_macro(val)->fnstar_args)); + break; + + case MALTYPE_ATOM: + + ADD(fprintf(stream, i->alt ? "(atom %#M)" : "(atom %M)", *is_atom(val))); + + } + + if (written < i->width) { + ADD(fprintf(stream, "%*s", i->width - written, "")); + } + return written; +} + + +int print_L(FILE* stream, const struct printf_info *i, const void *const *a) { + + int written = 0; + for (list lst = *((const list*)(*a)); lst; lst = lst->next) { + ADD(fprintf(stream, i->alt ? "%s%#M" : "%s%M", + !i->space && written ? " " : "", lst->data)); + } + return written; +} + +int pr_str_vector(FILE* stream, const struct printf_info *i, vector_t v) { + int written = 0; + ADD(fprintf(stream, "[")); + for (size_t j = 0; j < v->count; j++) { + ADD(fprintf(stream, + i->alt ? "%s%#M" : "%s%M", + j ? " " : "", + v->nth[j])); + } + ADD(fprintf(stream, "]")); + return written; +} + +int pr_str_map(FILE* stream, const struct printf_info *i, const void *const *a) { + hashmap map = *((const hashmap*)(*a)); + int written = 0; + for (map_cursor c = map_iter(map); map_cont(map, c); c = map_next(map, c)) { + ADD(fprintf(stream, i->alt ? "%s%#M %#M" : "%s%M %M", written ? " " : "", + map_key(map, c), map_val(map, c))); + } + return written; +} + + +int escape_string(FILE *stream, const char* str) { + + int written = 0; + + ADD(fprintf(stream, "\"")); + + const char* curr = str; + while(*curr != '\0') { + + switch (*curr) { + + case 0x0A: + + ADD(fprintf(stream, "\\n")); + break; + + case '"': + case '\\': + ADD(fprintf(stream, "\\")); + // fall through + + default: + ADD(fprintf(stream, "%c", *curr)); + } + curr++; + } + ADD(fprintf(stream, "\"")); + return written; +} + +// The order must match the one in types.c. +const char* print_T_table[] = { + "a symbol", + "a keyword", + "an integer", + "a float", + "a string", + "true", + "false", + "nil", + "a list", + "a vector", + "a map", + "a function", + "a closure", + "an atom", + "a macro", +}; + +int print_T(FILE *stream, const struct printf_info *, const void *const *a) { + enum mal_type_t mask = *((const enum mal_type_t*)(*a)); + assert(0 < mask); + int written = 0; + const char** p = print_T_table; + while (mask) { + assert(p < print_T_table + sizeof(print_T_table) / sizeof(*print_T_table)); + if (mask & 1) { + ADD(fprintf(stream, "%s%s", written ? " or " : "", *p)); + } + p++; + mask >>= 1; + } + return written; +} + +#define generic_arg(specifier, type) \ + int arg_##specifier(const struct printf_info*, \ + size_t n,int *argtypes, int *size) { \ + if(n < 1) return -1; \ + argtypes[0] = PA_POINTER; \ + *size = sizeof(type); \ + return 1; \ + } +generic_arg(M, MalType); +generic_arg(N, list); +generic_arg(T, enum mal_type_t); +generic_arg(H, hashmap); + +void printer_init() { + + int ret1 = register_printf_specifier('N', print_L, arg_N); + int ret2 = register_printf_specifier('M', print_M, arg_M); + int ret3 = register_printf_specifier('T', print_T, arg_T); + int ret4 = register_printf_specifier('H', pr_str_map, arg_H); + assert(!ret1); + assert(!ret2); + assert(!ret3); + assert(!ret4); +#ifdef NDEBUG + (void)ret1; + (void)ret2; + (void)ret3; + (void)ret4; +#endif +} + +const char* mal_printf(const char* fmt, ...) { + + va_list argptr; + + va_start(argptr, fmt); + int n = vsnprintf(NULL, 0, fmt, argptr); + assert(0 <= n); + va_end(argptr); + + char* buffer = GC_MALLOC(n + 1); + + va_start(argptr, fmt); + int again = vsnprintf(buffer, n+1, fmt, argptr); + assert(n == again); +#ifdef NDEBUG + (void)again; +#endif + va_end(argptr); + + return buffer; +} diff --git a/impls/c.2/printer.h b/impls/c.2/printer.h new file mode 100644 index 0000000000..65559a2ce1 --- /dev/null +++ b/impls/c.2/printer.h @@ -0,0 +1,22 @@ +#ifndef _PRINTER_H +#define _PRINTER_H + +// This function must be called during startup. +void printer_init(); +// It adds the following conversion specifiers (requires GNU libc). + +// specifier type modifiers meaning +// +// %M MalType # no string escape +// positive width right padding +// %N list # no string escape +// ' ' no space separator +// %T enum mal_type_t +// %H hashmap # no string escape + +// Similar to asprintf, except that +// the memory is allocated with GC_MALLOC instead of malloc, +// errors crash the program instead of being reported. +const char* mal_printf(const char* fmt, ...); + +#endif diff --git a/impls/c.2/reader.c b/impls/c.2/reader.c new file mode 100644 index 0000000000..af3b1a5477 --- /dev/null +++ b/impls/c.2/reader.c @@ -0,0 +1,370 @@ +#include +#include +#include +#include +#include +#include + +#include + +#include "hashmap.h" +#include "printer.h" +#include "reader.h" +#include "linked_list.h" +#include "vector.h" +#include "error.h" + +#define SYMBOL_NIL "nil" +#define SYMBOL_TRUE "true" +#define SYMBOL_FALSE "false" + +#ifdef DEBUG_READER +# define DEBUG(fmt, ...) printf("READER: %s \"%s\": " fmt "\n", __func__, *reader, ## __VA_ARGS__) +#else +# define DEBUG(...) +#endif + +typedef const char** Reader; + +MalType read_form(Reader reader); +MalType read_with_meta(Reader reader); +MalType read_string(Reader reader); +MalType read_number(Reader reader); +const char* read_symbol (Reader reader); +MalType read_list(Reader reader); +MalType read_vector(Reader reader); +MalType read_map(Reader reader); +void skip_spaces(Reader reader); +MalType make_symbol_list(Reader reader, MalType symbol_name); + +void skip_spaces(Reader reader) { + + while(true) { + if(**reader == ';') { + do { + (*reader)++; + if(**reader == 0x00) return; + } while(**reader != 0x0A); + } + else if((**reader != ',') && !isspace(**reader)) { + return; + } + (*reader)++; + } +} + +MalType read_str(const char* source) { + + MalType result = read_form(&source); + if(mal_error) return NULL; + skip_spaces(&source); + if(*source) + make_error("reader: trailing characters (after %M): %s", + result, source); + return result; +} + +const char* read_symbol (Reader reader) { + + DEBUG(); + + const char* start = *reader; + while(!isspace(**reader)) { + switch(**reader) { + case 0: + return start; + case '[': + case '{': + case '(': + case ']': + case '}': + case ')': + case '\'': + case '@': + case '`': + case '^': + case '~': + case '"': + case ',': + case ';': + goto finished; + default: + (*reader)++; + } + } + finished: + size_t len = *reader - start; + char* result = GC_MALLOC(len + 1); + strncpy(result, start, len); + assert(!result[len]); + return result; +} + +MalType read_form(Reader reader) { + + DEBUG(); + + skip_spaces(reader); + switch (**reader) { + case 0: + make_error("reader: input string is empty"); + case '[': + return read_vector(reader); + // Implicit error propagation + case '{': + return read_map(reader); + // Implicit error propagation + case '(': + return read_list(reader); + // Implicit error propagation + case ']': + case '}': + case ')': + make_error("reader: unmatched '%c'", **reader); + case '\'': + return make_symbol_list(reader, SYMBOL_QUOTE); + case '@': + return make_symbol_list(reader, SYMBOL_DEREF); + case '`': + return make_symbol_list(reader, SYMBOL_QUASIQUOTE); + case '^': + return read_with_meta(reader); + // Implicit error propagation + case '~': + if(*(*reader + 1) == '@') { + (*reader)++; + return make_symbol_list(reader, SYMBOL_SPLICE_UNQUOTE); + } + return make_symbol_list(reader, SYMBOL_UNQUOTE); + case '"': + return read_string(reader); + // Implicit error propagation + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + return read_number(reader); + case '+': + case '-': + if(isdigit(*(*reader + 1))) + return read_number(reader); + else + return make_symbol(read_symbol(reader)); + case ':': + (*reader)++; + return make_keyword(read_symbol(reader)); + default: + { + const char* sym = read_symbol(reader); + if(!strcmp(sym, SYMBOL_NIL)) return make_nil(); + if(!strcmp(sym, SYMBOL_FALSE)) return make_false(); + if(!strcmp(sym, SYMBOL_TRUE)) return make_true(); + return make_symbol(sym); + } + } +} + +MalType read_number(Reader reader) { + + DEBUG(); + + const char* start = *reader; + // Skip the initial character, which is a digit or a +- sign + // (followed by a digit). + (*reader)++; + + bool has_decimal_point = false; + + while(true) { + if(**reader == '.') { + if(has_decimal_point) break; + has_decimal_point = true; + (*reader)++; + } + else if(isdigit(**reader)) + (*reader)++; + else + break; + } + + size_t len = *reader - start; + char buffer[len + 1]; + strncpy(buffer, start, len); + buffer[len] = 0; + + if(has_decimal_point) + return make_float(atof(buffer)); + else + return make_integer(atol(buffer)); +} + +MalType read_with_meta(Reader reader) { + + DEBUG(); + + /* create and return a MalType list (with-meta + where first form should ne a metadata map and second form is somethingh + that can have metadata attached */ + (*reader)++; + + /* grab the components of the list */ + MalType symbol = SYMBOL_WITH_META; + MalType first_form = read_form(reader); + if(mal_error) return NULL; + MalType second_form = read_form(reader); + if(mal_error) return NULL; + + /* push the symbol and the following forms onto a list */ + list lst = NULL; + lst = list_push(lst, first_form); + lst = list_push(lst, second_form); + lst = list_push(lst, symbol); + + return make_list(lst); + } + +MalType read_list(Reader reader) { + + (*reader)++; + list lst = NULL; + list* lst_last = &lst; + + while(true) { + DEBUG("searching ')', already read: %N", lst); + skip_spaces(reader); + + if(!**reader) { + /* unbalanced parentheses */ + make_error("reader: unbalanced '('"); + } + + if(**reader == ')') + break; + MalType val = read_form(reader); + if(mal_error) return NULL; + *lst_last = list_push(NULL, val); + lst_last = &(*lst_last)->next; + } + (*reader)++; + return make_list(lst); +} + +MalType read_vector(Reader reader) { + (*reader)++; + size_t capacity = 10; + struct vector* v = vector_new(capacity); + while(true) { + DEBUG("searching ']'"); + skip_spaces(reader); + if (!**reader) { + make_error("reader: unbalanced '['"); + } + if (**reader == ']') + break; + MalType val = read_form(reader); + if (mal_error) return NULL; + vector_append(&capacity, &v, val); + } + (*reader)++; + return make_vector(v); +} + +MalType read_map(Reader reader) { + (*reader)++; + struct map* map = map_empty(); + while(true) { + DEBUG("searching '}' or key"); + skip_spaces(reader); + if (!**reader) { + make_error("reader: unbalanced '{'"); + } + if (**reader == '}') + break; + MalType key = read_form(reader); + if (mal_error) return NULL; + check_type("reading map literal", MALTYPE_KEYWORD | MALTYPE_STRING, key); + DEBUG("searching map value for %M", key); + skip_spaces(reader); + if (!**reader) { + make_error("reader: unbalanced '{'"); + } + if (**reader == '}') { + make_error("reader: odd count of bindings in map litteral"); + } + MalType value = read_form(reader); + if (mal_error) return NULL; + map = hashmap_put(map, key, value); + } + (*reader)++; + return make_hashmap(map); +} + +MalType make_symbol_list(Reader reader, MalType symbol) { + + DEBUG(); + + (*reader)++; + list lst = NULL; + + /* push the symbol and the following form onto the list */ + MalType form = read_form(reader); + if(mal_error) return NULL; + lst = list_push(lst, form); + lst = list_push(lst, symbol); + + return make_list(lst); +} + +MalType read_string(Reader reader) { + + DEBUG(); + + (*reader)++; // initial '"' + size_t count = 0; + + // Compute the length. + for(const char* p=*reader; *p!='"'; p++) { + if(!*p) + make_error("reader: unbalanced '\"'"); + if(*p == '\\') { + p++; + switch(*p) { + case 0: + make_error("reader: incomplete \\ escape sequence"); + case '\\': + case 'n': + case '"': + break; + + default: + make_error("reader: incomplete escape sequence '\\%c'", *p); + } + } + count++; + } + + // Copy/unescape the characters, add final 0. + char* result = GC_MALLOC(count + 1); + const char* src; + char* dst = result; + for(src=*reader; *src!='"'; src++) { + if(*src == '\\') { + src++; + if(*src == 'n') { + *dst++ = 0x0A; + continue; + } + } + *dst++ = *src; + } + *dst = 0; + + *reader = src + 1; + return make_string(result); +} diff --git a/impls/c.2/reader.h b/impls/c.2/reader.h new file mode 100644 index 0000000000..25dde53145 --- /dev/null +++ b/impls/c.2/reader.h @@ -0,0 +1,8 @@ +#ifndef _MAL_READER_H +#define _MAL_READER_H + +#include "types.h" + +MalType read_str(const char*); + +#endif diff --git a/impls/c.2/readline.c b/impls/c.2/readline.c new file mode 100644 index 0000000000..aabd40ffe5 --- /dev/null +++ b/impls/c.2/readline.c @@ -0,0 +1,26 @@ +#include +#include + +#include +#if USE_READLINE +# include +# include +#else +# include +# include +#endif + +const char* readline_gc(const char* prompt) { + + char* str = readline(prompt); + if (!str) { + return NULL; + } + add_history(str); + /* Copy the input into an area managed by libgc. */ + size_t n = strlen(str) + 1; + char* result = GC_MALLOC(n); + memcpy(result, str, n); + free(str); + return result; +} diff --git a/impls/c.2/readline.h b/impls/c.2/readline.h new file mode 100644 index 0000000000..cfc09948ad --- /dev/null +++ b/impls/c.2/readline.h @@ -0,0 +1,7 @@ +#ifndef MAL_READLINE_H +#define MAL_READLINE_H + +const char* readline_gc(const char* prompt); +// NULL if EOF + +#endif diff --git a/impls/c.2/run b/impls/c.2/run new file mode 100755 index 0000000000..6efdc3de32 --- /dev/null +++ b/impls/c.2/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/c.2/step0_repl.c b/impls/c.2/step0_repl.c new file mode 100644 index 0000000000..8eda5ce878 --- /dev/null +++ b/impls/c.2/step0_repl.c @@ -0,0 +1,42 @@ +#include +#include + +#include "readline.h" + +#define PROMPT_STRING "user> " + +const char* READ(const char* str) { + + return str; +} + +const char* EVAL(const char* ast) { + + return ast; +} + +void PRINT(const char* str) { + + printf("%s\n", str); +} + +void rep(const char* str) { + + PRINT(EVAL(READ(str))); +} + +int main() { + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input); + } + printf("\n"); + + return EXIT_SUCCESS; +} diff --git a/impls/c.2/step1_read_print.c b/impls/c.2/step1_read_print.c new file mode 100644 index 0000000000..15ccc8e816 --- /dev/null +++ b/impls/c.2/step1_read_print.c @@ -0,0 +1,57 @@ +#include +#include + +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "error.h" +#include "readline.h" + +#define PROMPT_STRING "user> " + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +MalType EVAL(MalType ast) { + + return ast; +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str) { + + MalType a = READ(str); + if (!mal_error) { + PRINT(EVAL(a)); + return; + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +int main() { + + types_init(); + printer_init(); + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input); + } + printf("\n"); + + return EXIT_SUCCESS; +} diff --git a/impls/c.2/step2_eval.c b/impls/c.2/step2_eval.c new file mode 100644 index 0000000000..e429bb04fd --- /dev/null +++ b/impls/c.2/step2_eval.c @@ -0,0 +1,192 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, hashmap); +MalType evaluate_vector(vector_t, hashmap); +MalType evaluate_hashmap(hashmap, hashmap); + +#define generic_arithmetic(name, op, iconst, fconst) \ + MalType name(list args) { \ + explode2(#op, args, a1, a2); \ + long i1, i2; \ + double f1, f2; \ + if (is_integer(a1, &i1)) { \ + if (is_integer(a2, &i2)) return iconst(i1 op i2); \ + if (is_float (a2, &f2)) return fconst(i1 op f2); \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ + } \ + if (is_float(a1, &f1)) { \ + if (is_integer(a2, &i2)) return iconst(f1 op i2); \ + if (is_float (a2, &f2)) return fconst(f1 op f2); \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ + } \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a1); \ + } +generic_arithmetic(mal_add, +, make_integer, make_float) +generic_arithmetic(mal_sub, -, make_integer, make_float) +generic_arithmetic(mal_mul, *, make_integer, make_float) +generic_arithmetic(mal_div, /, make_integer, make_float) + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +MalType EVAL(MalType ast, hashmap env) { + + /* printf("EVAL: %M\n", ast); */ + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = hashmap_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_FUNCTION, func); + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, hashmap env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +int main() { + + types_init(); + printer_init(); + + struct map* repl_env = map_empty(); + + repl_env = hashmap_put(repl_env, make_symbol("+"), make_function(mal_add)); + repl_env = hashmap_put(repl_env, make_symbol("-"), make_function(mal_sub)); + repl_env = hashmap_put(repl_env, make_symbol("*"), make_function(mal_mul)); + repl_env = hashmap_put(repl_env, make_symbol("/"), make_function(mal_div)); + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + + return EXIT_SUCCESS; +} + +list evaluate_list(list lst, hashmap env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, hashmap env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, hashmap env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType apply(MalType fn, list args) { + + function_t fun_ptr = is_function(fn); + assert(fun_ptr); + + return (*fun_ptr)(args); + // Implicit error propagation +} diff --git a/impls/c.2/step3_env.c b/impls/c.2/step3_env.c new file mode 100644 index 0000000000..e07e4496d7 --- /dev/null +++ b/impls/c.2/step3_env.c @@ -0,0 +1,259 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env*); +MalType eval_letstar(list, Env*); + +typedef MalType (*special_t)(list, Env*); +struct map* specials; + +#define generic_arithmetic(name, op, iconst, fconst) \ + MalType name(list args) { \ + explode2(#op, args, a1, a2); \ + long i1, i2; \ + double f1, f2; \ + if (is_integer(a1, &i1)) { \ + if (is_integer(a2, &i2)) return iconst(i1 op i2); \ + if (is_float (a2, &f2)) return fconst(i1 op f2); \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ + } \ + if (is_float(a1, &f1)) { \ + if (is_integer(a2, &i2)) return iconst(f1 op i2); \ + if (is_float (a2, &f2)) return fconst(f1 op f2); \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ + } \ + bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a1); \ + } +generic_arithmetic(mal_add, +, make_integer, make_float) +generic_arithmetic(mal_sub, -, make_integer, make_float) +generic_arithmetic(mal_mul, *, make_integer, make_float) +generic_arithmetic(mal_div, /, make_integer, make_float) + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +MalType EVAL(MalType ast, Env* env) { + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + return special(lst, env); + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_FUNCTION, func); + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +int main() { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + + Env* repl_env = env_make(NULL); + + env_set(repl_env, make_symbol("+"), make_function(mal_add)); + env_set(repl_env, make_symbol("-"), make_function(mal_sub)); + env_set(repl_env, make_symbol("*"), make_function(mal_mul)); + env_set(repl_env, make_symbol("/"), make_function(mal_div)); + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env* env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(env, defbang_symbol, result); + return result; +} + +MalType eval_letstar(list lst, Env* env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + return EVAL(forms, letstar_env); +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType apply(MalType fn, list args) { + + function_t fun_ptr = is_function(fn); + assert(fun_ptr); + + return (*fun_ptr)(args); + // Implicit error propagation +} diff --git a/impls/c.2/step4_if_fn_do.c b/impls/c.2/step4_if_fn_do.c new file mode 100644 index 0000000000..aa2409e63e --- /dev/null +++ b/impls/c.2/step4_if_fn_do.c @@ -0,0 +1,421 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "core.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env*); +MalType eval_letstar(list, Env*); +MalType eval_if(list, Env*); +MalType eval_fnstar(list, const Env*); +MalType eval_do(list, Env*); + +typedef MalType (*special_t)(list, Env*); +struct map* specials; + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +Env* env_apply(MalClosure closure, list args) { + // Return the closure definition and update env if all went OK, + // else return an error. + Env* fn_env = env_make(closure->env); + MalType params = closure->fnstar_args->data; + + assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); + seq_cursor c = seq_iter(params); + list a = args; + while (true) { + if (!seq_cont(params, c)) { + if (a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + break; + } + MalType parameter = seq_item(params, c); + if (equal_forms(parameter, SYMBOL_AMPERSAND)) { + c = seq_next(params, c); + assert(seq_cont(params, c)); + env_set(fn_env, seq_item(params, c), make_list(a)); + break; + } + if (!a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + env_set(fn_env, parameter, a->data); + c = seq_next(params, c); + a = a->next; + } + return fn_env; +} + +MalType EVAL(MalType ast, Env* env) { + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + return special(lst, env); + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + MalClosure closure; + if ((closure = is_closure(func))) { + + return EVAL(closure->fnstar_args->next->data, + env_apply(closure, evlst)); + // Implicit error propagation + } + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +// Variant reporting errors during startup. +void re(const char *str, Env* env) { + MalType a = READ(str); + if (!mal_error) { + EVAL(a, env); + if (!mal_error) { + return; + } + } + MalType result = mal_error; + mal_error = NULL; // before printing + printf("Error during startup: %M\n", result); + exit(EXIT_FAILURE); +} + +int main() { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + specials = hashmap_put(specials, SYMBOL_IF, eval_if); + specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); + specials = hashmap_put(specials, SYMBOL_DO, eval_do); + + Env* repl_env = env_make(NULL); + + ns core; + size_t core_size; + ns_make_core(&core, &core_size); + while(core_size--) { + const char* symbol = core[core_size].key; + function_t function = core[core_size].value; + env_set(repl_env, make_symbol(symbol), make_function(function)); + } + + /* add functions written in mal - not using rep as it prints the result */ + re("(def! not (fn* (a) (if a false true)))", repl_env); + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env* env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(env, defbang_symbol, result); + return result; +} + +MalType eval_letstar(list lst, Env* env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + return EVAL(forms, letstar_env); +} + +MalType eval_if(list lst, Env* env) { + + if (!lst) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType raw_condition = lst->data; + list l1 = lst->next; + if (!l1) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType then_form = l1->data; + list l2 = l1->next; + MalType else_form; + if (l2) { + else_form = l2->data; + if (l2->next) { + bad_arg_count("if", "two or three arguments", lst); + } + } + else { + else_form = NULL; + } + + MalType condition = EVAL(raw_condition, env); + + if (mal_error) { + return NULL; + } + + if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { + + /* check whether false branch is present */ + if(else_form) { + return EVAL(else_form, env); + } + else { + return make_nil(); + } + + } else { + return EVAL(then_form, env); + } +} + +MalType eval_do(list lst, Env* env) { + + /* handle empty 'do' */ + if (!lst) { + return make_nil(); + } + + /* evaluate all but the last form */ + while (lst->next) { + + EVAL(lst->data, env); + + /* return error early */ + if (mal_error) { + return NULL; + } + lst = lst->next; + } + /* return the last form for TCE evaluation */ + return EVAL(lst->data, env); +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType eval_fnstar(list lst, const Env* env) { + + if (!lst || !lst->next || lst->next->next) { + bad_arg_count("fn*", "two parameters", lst); + } + MalType parameters = lst->data; + check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); + + for (seq_cursor c = seq_iter(parameters); + seq_cont(parameters, c); + c = seq_next(parameters, c)) { + + MalType val = seq_item(parameters, c); + + if (!is_symbol(val)) { + bad_type("fn*", MALTYPE_SYMBOL, val); + } + + if (equal_forms(val, SYMBOL_AMPERSAND)) { + c = seq_next(parameters, c); + if (!val) { + make_error("'fn*': no symbol after &: '%N'", lst); + } + val = seq_item(parameters, c); + /* & is found and there is a single symbol after */ + check_type("fn*", MALTYPE_SYMBOL, val); + /* & is found and there extra symbols after */ + c = seq_next(parameters, c); + if (seq_cont(parameters, c)) { + make_error("'fn*': extra symbols after &: '%N'", lst); + } + break; + } + } + + return make_closure(env, lst); +} + +MalType apply(MalType fn, list args) { + + function_t fun_ptr; + if ((fun_ptr = is_function(fn))) { + + return (*fun_ptr)(args); + // Implicit error propagation + } + else { + + MalClosure closure = is_closure(fn); + assert(closure); + MalType ast = closure->fnstar_args->next->data; + Env* env = env_apply(closure, args); + if (mal_error) return NULL; + return EVAL(ast, env); + // Implicit error propagation + } +} diff --git a/impls/c.2/step5_tco.c b/impls/c.2/step5_tco.c new file mode 100644 index 0000000000..f654eed801 --- /dev/null +++ b/impls/c.2/step5_tco.c @@ -0,0 +1,436 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "core.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env**); +MalType eval_letstar(list, Env**); +MalType eval_if(list, Env**); +MalType eval_fnstar(list, Env**); +MalType eval_do(list, Env**); + +typedef MalType (*special_t)(list, Env**); +struct map* specials; + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +Env* env_apply(MalClosure closure, list args) { + // Return the closure definition and update env if all went OK, + // else return an error. + Env* fn_env = env_make(closure->env); + MalType params = closure->fnstar_args->data; + + assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); + seq_cursor c = seq_iter(params); + list a = args; + while (true) { + if (!seq_cont(params, c)) { + if (a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + break; + } + MalType parameter = seq_item(params, c); + if (equal_forms(parameter, SYMBOL_AMPERSAND)) { + c = seq_next(params, c); + assert(seq_cont(params, c)); + env_set(fn_env, seq_item(params, c), make_list(a)); + break; + } + if (!a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + env_set(fn_env, parameter, a->data); + c = seq_next(params, c); + a = a->next; + } + return fn_env; +} + +MalType EVAL(MalType ast, Env* env) { + + /* Use goto to jump here rather than calling eval for tail-call elimination */ + TCE_entry_point: + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + ast = special(lst, &env); + if (mal_error) return NULL; + + if(!env) { return ast; } + goto TCE_entry_point; + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + MalClosure closure; + if ((closure = is_closure(func))) { + + /* TCE - modify ast and env directly and jump back to eval */ + ast = closure->fnstar_args->next->data; + env = env_apply(closure, evlst); + + if (mal_error) return NULL; + goto TCE_entry_point; + } + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +// Variant reporting errors during startup. +void re(const char *str, Env* env) { + MalType a = READ(str); + if (!mal_error) { + EVAL(a, env); + if (!mal_error) { + return; + } + } + MalType result = mal_error; + mal_error = NULL; // before printing + printf("Error during startup: %M\n", result); + exit(EXIT_FAILURE); +} + +int main() { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + specials = hashmap_put(specials, SYMBOL_IF, eval_if); + specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); + specials = hashmap_put(specials, SYMBOL_DO, eval_do); + + Env* repl_env = env_make(NULL); + + ns core; + size_t core_size; + ns_make_core(&core, &core_size); + while(core_size--) { + const char* symbol = core[core_size].key; + function_t function = core[core_size].value; + env_set(repl_env, make_symbol(symbol), make_function(function)); + } + + /* add functions written in mal - not using rep as it prints the result */ + re("(def! not (fn* (a) (if a false true)))", repl_env); + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env** env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_letstar(list lst, Env** env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(*env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + *env = letstar_env; + return forms; +} + +MalType eval_if(list lst, Env** env) { + + if (!lst) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType raw_condition = lst->data; + list l1 = lst->next; + if (!l1) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType then_form = l1->data; + list l2 = l1->next; + MalType else_form; + if (l2) { + else_form = l2->data; + if (l2->next) { + bad_arg_count("if", "two or three arguments", lst); + } + } + else { + else_form = NULL; + } + + MalType condition = EVAL(raw_condition, *env); + + if (mal_error) { + return NULL; + } + + if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { + + /* check whether false branch is present */ + if(else_form) { + return else_form; + } + else { + *env = NULL; // no TCO + return make_nil(); + } + + } else { + return then_form; + } +} + +MalType eval_do(list lst, Env** env) { + + /* handle empty 'do' */ + if (!lst) { + return make_nil(); + } + + /* evaluate all but the last form */ + while (lst->next) { + + EVAL(lst->data, *env); + + /* return error early */ + if (mal_error) { + return NULL; + } + lst = lst->next; + } + /* return the last form for TCE evaluation */ + return lst->data; +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType eval_fnstar(list lst, Env** env) { + + if (!lst || !lst->next || lst->next->next) { + bad_arg_count("fn*", "two parameters", lst); + } + MalType parameters = lst->data; + check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); + + for (seq_cursor c = seq_iter(parameters); + seq_cont(parameters, c); + c = seq_next(parameters, c)) { + + MalType val = seq_item(parameters, c); + + if (!is_symbol(val)) { + bad_type("fn*", MALTYPE_SYMBOL, val); + } + + if (equal_forms(val, SYMBOL_AMPERSAND)) { + c = seq_next(parameters, c); + if (!val) { + make_error("'fn*': no symbol after &: '%N'", lst); + } + val = seq_item(parameters, c); + /* & is found and there is a single symbol after */ + check_type("fn*", MALTYPE_SYMBOL, val); + /* & is found and there extra symbols after */ + c = seq_next(parameters, c); + if (seq_cont(parameters, c)) { + make_error("'fn*': extra symbols after &: '%N'", lst); + } + break; + } + } + Env* fn_env = *env; + *env = NULL; // no TCO + return make_closure(fn_env, lst); +} + +/* used by core functions but not EVAL as doesn't do TCE */ +MalType apply(MalType fn, list args) { + + function_t fun_ptr; + if ((fun_ptr = is_function(fn))) { + + return (*fun_ptr)(args); + // Implicit error propagation + } + else { + + MalClosure closure = is_closure(fn); + assert(closure); + MalType ast = closure->fnstar_args->next->data; + Env* env = env_apply(closure, args); + if (mal_error) return NULL; + return EVAL(ast, env); + // Implicit error propagation + } +} diff --git a/impls/c.2/step6_file.c b/impls/c.2/step6_file.c new file mode 100644 index 0000000000..fc5a2a697b --- /dev/null +++ b/impls/c.2/step6_file.c @@ -0,0 +1,466 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "core.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env**); +MalType eval_letstar(list, Env**); +MalType eval_if(list, Env**); +MalType eval_fnstar(list, Env**); +MalType eval_do(list, Env**); + +typedef MalType (*special_t)(list, Env**); +struct map* specials; + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +Env* env_apply(MalClosure closure, list args) { + // Return the closure definition and update env if all went OK, + // else return an error. + Env* fn_env = env_make(closure->env); + MalType params = closure->fnstar_args->data; + + assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); + seq_cursor c = seq_iter(params); + list a = args; + while (true) { + if (!seq_cont(params, c)) { + if (a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + break; + } + MalType parameter = seq_item(params, c); + if (equal_forms(parameter, SYMBOL_AMPERSAND)) { + c = seq_next(params, c); + assert(seq_cont(params, c)); + env_set(fn_env, seq_item(params, c), make_list(a)); + break; + } + if (!a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + env_set(fn_env, parameter, a->data); + c = seq_next(params, c); + a = a->next; + } + return fn_env; +} + +MalType EVAL(MalType ast, Env* env) { + + /* Use goto to jump here rather than calling eval for tail-call elimination */ + TCE_entry_point: + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + ast = special(lst, &env); + if (mal_error) return NULL; + + if(!env) { return ast; } + goto TCE_entry_point; + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + MalClosure closure; + if ((closure = is_closure(func))) { + + /* TCE - modify ast and env directly and jump back to eval */ + ast = closure->fnstar_args->next->data; + env = env_apply(closure, evlst); + + if (mal_error) return NULL; + goto TCE_entry_point; + } + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +// Variant reporting errors during startup. +void re(const char *str, Env* env) { + MalType a = READ(str); + if (!mal_error) { + EVAL(a, env); + if (!mal_error) { + return; + } + } + MalType result = mal_error; + mal_error = NULL; // before printing + printf("Error during startup: %M\n", result); + exit(EXIT_FAILURE); +} + +/* declare as global so it can be accessed by mal_eval */ +Env* repl_env; + +MalType mal_eval(list args) { + + explode1("eval", args, ast); + return EVAL(ast, repl_env); + // Implicit error propagation +} + +int main(int argc, char** argv) { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + specials = hashmap_put(specials, SYMBOL_IF, eval_if); + specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); + specials = hashmap_put(specials, SYMBOL_DO, eval_do); + + repl_env = env_make(NULL); + + ns core; + size_t core_size; + ns_make_core(&core, &core_size); + while(core_size--) { + const char* symbol = core[core_size].key; + function_t function = core[core_size].value; + env_set(repl_env, make_symbol(symbol), make_function(function)); + } + + env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); + + /* add functions written in mal - not using rep as it prints the result */ + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + + /* make command line arguments available in the environment */ + list lst = NULL; + while(1 < --argc) { + lst = list_push(lst, make_string(argv[argc])); + } + env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); + + /* run in script mode if a filename is given */ + if (argc) { + + /* first argument on command line is filename */ + const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); + re(load_command, repl_env); + } + /* run in repl mode when no cmd line args */ + else { + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + } + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env** env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_letstar(list lst, Env** env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(*env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + *env = letstar_env; + return forms; +} + +MalType eval_if(list lst, Env** env) { + + if (!lst) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType raw_condition = lst->data; + list l1 = lst->next; + if (!l1) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType then_form = l1->data; + list l2 = l1->next; + MalType else_form; + if (l2) { + else_form = l2->data; + if (l2->next) { + bad_arg_count("if", "two or three arguments", lst); + } + } + else { + else_form = NULL; + } + + MalType condition = EVAL(raw_condition, *env); + + if (mal_error) { + return NULL; + } + + if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { + + /* check whether false branch is present */ + if(else_form) { + return else_form; + } + else { + *env = NULL; // no TCO + return make_nil(); + } + + } else { + return then_form; + } +} + +MalType eval_do(list lst, Env** env) { + + /* handle empty 'do' */ + if (!lst) { + return make_nil(); + } + + /* evaluate all but the last form */ + while (lst->next) { + + EVAL(lst->data, *env); + + /* return error early */ + if (mal_error) { + return NULL; + } + lst = lst->next; + } + /* return the last form for TCE evaluation */ + return lst->data; +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType eval_fnstar(list lst, Env** env) { + + if (!lst || !lst->next || lst->next->next) { + bad_arg_count("fn*", "two parameters", lst); + } + MalType parameters = lst->data; + check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); + + for (seq_cursor c = seq_iter(parameters); + seq_cont(parameters, c); + c = seq_next(parameters, c)) { + + MalType val = seq_item(parameters, c); + + if (!is_symbol(val)) { + bad_type("fn*", MALTYPE_SYMBOL, val); + } + + if (equal_forms(val, SYMBOL_AMPERSAND)) { + c = seq_next(parameters, c); + if (!val) { + make_error("'fn*': no symbol after &: '%N'", lst); + } + val = seq_item(parameters, c); + /* & is found and there is a single symbol after */ + check_type("fn*", MALTYPE_SYMBOL, val); + /* & is found and there extra symbols after */ + c = seq_next(parameters, c); + if (seq_cont(parameters, c)) { + make_error("'fn*': extra symbols after &: '%N'", lst); + } + break; + } + } + Env* fn_env = *env; + *env = NULL; // no TCO + return make_closure(fn_env, lst); +} + +/* used by core functions but not EVAL as doesn't do TCE */ +MalType apply(MalType fn, list args) { + + function_t fun_ptr; + if ((fun_ptr = is_function(fn))) { + + return (*fun_ptr)(args); + // Implicit error propagation + } + else { + + MalClosure closure = is_closure(fn); + assert(closure); + MalType ast = closure->fnstar_args->next->data; + Env* env = env_apply(closure, args); + if (mal_error) return NULL; + return EVAL(ast, env); + // Implicit error propagation + } +} diff --git a/impls/c.2/step7_quote.c b/impls/c.2/step7_quote.c new file mode 100644 index 0000000000..74455cd211 --- /dev/null +++ b/impls/c.2/step7_quote.c @@ -0,0 +1,584 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "core.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env**); +MalType eval_letstar(list, Env**); +MalType eval_if(list, Env**); +MalType eval_fnstar(list, Env**); +MalType eval_do(list, Env**); +MalType eval_quote(list, Env**); +MalType eval_quasiquote(list, Env**); +MalType quasiquote(MalType); +MalType quasiquote_vector(vector_t); +MalType quasiquote_list(list); +MalType quasiquote_folder(MalType first, MalType qq_rest); + +typedef MalType (*special_t)(list, Env**); +struct map* specials; + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +Env* env_apply(MalClosure closure, list args) { + // Return the closure definition and update env if all went OK, + // else return an error. + Env* fn_env = env_make(closure->env); + MalType params = closure->fnstar_args->data; + + assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); + seq_cursor c = seq_iter(params); + list a = args; + while (true) { + if (!seq_cont(params, c)) { + if (a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + break; + } + MalType parameter = seq_item(params, c); + if (equal_forms(parameter, SYMBOL_AMPERSAND)) { + c = seq_next(params, c); + assert(seq_cont(params, c)); + env_set(fn_env, seq_item(params, c), make_list(a)); + break; + } + if (!a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + env_set(fn_env, parameter, a->data); + c = seq_next(params, c); + a = a->next; + } + return fn_env; +} + +MalType EVAL(MalType ast, Env* env) { + + /* Use goto to jump here rather than calling eval for tail-call elimination */ + TCE_entry_point: + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + ast = special(lst, &env); + if (mal_error) return NULL; + + if(!env) { return ast; } + goto TCE_entry_point; + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + MalClosure closure; + if ((closure = is_closure(func))) { + + /* TCE - modify ast and env directly and jump back to eval */ + ast = closure->fnstar_args->next->data; + env = env_apply(closure, evlst); + + if (mal_error) return NULL; + goto TCE_entry_point; + } + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +// Variant reporting errors during startup. +void re(const char *str, Env* env) { + MalType a = READ(str); + if (!mal_error) { + EVAL(a, env); + if (!mal_error) { + return; + } + } + MalType result = mal_error; + mal_error = NULL; // before printing + printf("Error during startup: %M\n", result); + exit(EXIT_FAILURE); +} + +/* declare as global so it can be accessed by mal_eval */ +Env* repl_env; + +MalType mal_eval(list args) { + + explode1("eval", args, ast); + return EVAL(ast, repl_env); + // Implicit error propagation +} + +int main(int argc, char** argv) { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + specials = hashmap_put(specials, SYMBOL_IF, eval_if); + specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); + specials = hashmap_put(specials, SYMBOL_DO, eval_do); + specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); + specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); + + repl_env = env_make(NULL); + + ns core; + size_t core_size; + ns_make_core(&core, &core_size); + while(core_size--) { + const char* symbol = core[core_size].key; + function_t function = core[core_size].value; + env_set(repl_env, make_symbol(symbol), make_function(function)); + } + + env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); + + /* add functions written in mal - not using rep as it prints the result */ + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + + /* make command line arguments available in the environment */ + list lst = NULL; + while(1 < --argc) { + lst = list_push(lst, make_string(argv[argc])); + } + env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); + + /* run in script mode if a filename is given */ + if (argc) { + + /* first argument on command line is filename */ + const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); + re(load_command, repl_env); + } + /* run in repl mode when no cmd line args */ + else { + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + } + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env** env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_letstar(list lst, Env** env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(*env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + *env = letstar_env; + return forms; +} + +MalType eval_if(list lst, Env** env) { + + if (!lst) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType raw_condition = lst->data; + list l1 = lst->next; + if (!l1) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType then_form = l1->data; + list l2 = l1->next; + MalType else_form; + if (l2) { + else_form = l2->data; + if (l2->next) { + bad_arg_count("if", "two or three arguments", lst); + } + } + else { + else_form = NULL; + } + + MalType condition = EVAL(raw_condition, *env); + + if (mal_error) { + return NULL; + } + + if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { + + /* check whether false branch is present */ + if(else_form) { + return else_form; + } + else { + *env = NULL; // no TCO + return make_nil(); + } + + } else { + return then_form; + } +} + +MalType eval_do(list lst, Env** env) { + + /* handle empty 'do' */ + if (!lst) { + return make_nil(); + } + + /* evaluate all but the last form */ + while (lst->next) { + + EVAL(lst->data, *env); + + /* return error early */ + if (mal_error) { + return NULL; + } + lst = lst->next; + } + /* return the last form for TCE evaluation */ + return lst->data; +} + +MalType eval_quote(list lst, Env** env) { + + explode1("quote", lst, form); + *env = NULL; // no TCO + return form; +} + +MalType eval_quasiquote(list lst, Env**) { + explode1("quasiquote", lst, form); + return quasiquote(form); + // Implicit error propagation. +} + +MalType quasiquote(MalType ast) { + + /* argument to quasiquote is a vector: (quasiquote [first rest]) */ + list lst; + vector_t vec; + if ((vec = is_vector(ast))) { + + return quasiquote_vector(vec); + // Implicit error propagation + } + + /* argument to quasiquote is a list: (quasiquote (first rest)) */ + else if (is_list(ast, &lst)){ + + if(lst) { + MalType first = lst->data; + if(equal_forms(first, SYMBOL_UNQUOTE)) { + lst = lst->next; + explode1("unquote", lst, unquoted); + return unquoted; + } + } + return quasiquote_list(lst); + // Implicit error propagation + } + /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) + => (quote val) */ + else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { + + list lst = NULL; + lst = list_push(lst, ast); + lst = list_push(lst, SYMBOL_QUOTE); + return make_list(lst); + } + /* argument to quasiquote is self-evaluating: (quasiquote val) + => val */ + else { + return ast; + } +} + +MalType quasiquote_vector(vector_t vec) { + + MalType result = make_list(NULL); + for (size_t i = vec->count; i--; ) { + result = quasiquote_folder(vec->nth[i], result); + if (mal_error) return NULL; + } + + list lst = NULL; + lst = list_push(lst, result); + lst = list_push(lst, SYMBOL_VEC); + + return make_list(lst); +} + +MalType quasiquote_list(list args) { + + /* handle empty list: (quasiquote ()) + => () */ + if (!args) { + return make_list(NULL); + } + + MalType first = args->data; + + MalType qq_rest = quasiquote_list(args->next); + if(mal_error) return NULL; + + return quasiquote_folder(first, qq_rest); + // Implicit error propagation. +} + +MalType quasiquote_folder(MalType first, MalType qq_rest) { + + /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) + => (concat first-second (quasiquote rest)) */ + list lst; + if(is_list(first, &lst)) { + if(lst) { + MalType lst_first = lst->data; + if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { + lst = lst->next; + explode1("splice-unquote", lst, unquoted); + return make_list(list_push(list_push(list_push(NULL, qq_rest), + unquoted), + SYMBOL_CONCAT)); + } + } + } + MalType qqted = quasiquote(first); + if(mal_error) return NULL; + return make_list(list_push(list_push(list_push(NULL, qq_rest), + qqted), + SYMBOL_CONS)); +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType eval_fnstar(list lst, Env** env) { + + if (!lst || !lst->next || lst->next->next) { + bad_arg_count("fn*", "two parameters", lst); + } + MalType parameters = lst->data; + check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); + + for (seq_cursor c = seq_iter(parameters); + seq_cont(parameters, c); + c = seq_next(parameters, c)) { + + MalType val = seq_item(parameters, c); + + if (!is_symbol(val)) { + bad_type("fn*", MALTYPE_SYMBOL, val); + } + + if (equal_forms(val, SYMBOL_AMPERSAND)) { + c = seq_next(parameters, c); + if (!val) { + make_error("'fn*': no symbol after &: '%N'", lst); + } + val = seq_item(parameters, c); + /* & is found and there is a single symbol after */ + check_type("fn*", MALTYPE_SYMBOL, val); + /* & is found and there extra symbols after */ + c = seq_next(parameters, c); + if (seq_cont(parameters, c)) { + make_error("'fn*': extra symbols after &: '%N'", lst); + } + break; + } + } + Env* fn_env = *env; + *env = NULL; // no TCO + return make_closure(fn_env, lst); +} + +/* used by core functions but not EVAL as doesn't do TCE */ +MalType apply(MalType fn, list args) { + + function_t fun_ptr; + if ((fun_ptr = is_function(fn))) { + + return (*fun_ptr)(args); + // Implicit error propagation + } + else { + + MalClosure closure = is_closure(fn); + assert(closure); + MalType ast = closure->fnstar_args->next->data; + Env* env = env_apply(closure, args); + if (mal_error) return NULL; + return EVAL(ast, env); + // Implicit error propagation + } +} diff --git a/impls/c.2/step8_macros.c b/impls/c.2/step8_macros.c new file mode 100644 index 0000000000..5cab68ef5b --- /dev/null +++ b/impls/c.2/step8_macros.c @@ -0,0 +1,612 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "core.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env**); +MalType eval_letstar(list, Env**); +MalType eval_if(list, Env**); +MalType eval_fnstar(list, Env**); +MalType eval_do(list, Env**); +MalType eval_quote(list, Env**); +MalType eval_quasiquote(list, Env**); +MalType quasiquote(MalType); +MalType quasiquote_vector(vector_t); +MalType quasiquote_list(list); +MalType quasiquote_folder(MalType first, MalType qq_rest); +MalType eval_defmacrobang(list, Env**); + +typedef MalType (*special_t)(list, Env**); +struct map* specials; + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +Env* env_apply(MalClosure closure, list args) { + // Return the closure definition and update env if all went OK, + // else return an error. + Env* fn_env = env_make(closure->env); + MalType params = closure->fnstar_args->data; + + assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); + seq_cursor c = seq_iter(params); + list a = args; + while (true) { + if (!seq_cont(params, c)) { + if (a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + break; + } + MalType parameter = seq_item(params, c); + if (equal_forms(parameter, SYMBOL_AMPERSAND)) { + c = seq_next(params, c); + assert(seq_cont(params, c)); + env_set(fn_env, seq_item(params, c), make_list(a)); + break; + } + if (!a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + env_set(fn_env, parameter, a->data); + c = seq_next(params, c); + a = a->next; + } + return fn_env; +} + +MalType EVAL(MalType ast, Env* env) { + + /* Use goto to jump here rather than calling eval for tail-call elimination */ + TCE_entry_point: + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + ast = special(lst, &env); + if (mal_error) return NULL; + + if(!env) { return ast; } + goto TCE_entry_point; + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); + if (type(func) == MALTYPE_MACRO) { + ast = apply(func, lst); + if (mal_error) { return NULL; } + goto TCE_entry_point; + } + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + MalClosure closure; + if ((closure = is_closure(func))) { + + /* TCE - modify ast and env directly and jump back to eval */ + ast = closure->fnstar_args->next->data; + env = env_apply(closure, evlst); + + if (mal_error) return NULL; + goto TCE_entry_point; + } + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +// Variant reporting errors during startup. +void re(const char *str, Env* env) { + MalType a = READ(str); + if (!mal_error) { + EVAL(a, env); + if (!mal_error) { + return; + } + } + MalType result = mal_error; + mal_error = NULL; // before printing + printf("Error during startup: %M\n", result); + exit(EXIT_FAILURE); +} + +/* declare as global so it can be accessed by mal_eval */ +Env* repl_env; + +MalType mal_eval(list args) { + + explode1("eval", args, ast); + return EVAL(ast, repl_env); + // Implicit error propagation +} + +int main(int argc, char** argv) { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + specials = hashmap_put(specials, SYMBOL_IF, eval_if); + specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); + specials = hashmap_put(specials, SYMBOL_DO, eval_do); + specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); + specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); + specials = hashmap_put(specials, SYMBOL_DEFMACRO, eval_defmacrobang); + + repl_env = env_make(NULL); + + ns core; + size_t core_size; + ns_make_core(&core, &core_size); + while(core_size--) { + const char* symbol = core[core_size].key; + function_t function = core[core_size].value; + env_set(repl_env, make_symbol(symbol), make_function(function)); + } + + env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); + + /* add functions written in mal - not using rep as it prints the result */ + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + /* make command line arguments available in the environment */ + list lst = NULL; + while(1 < --argc) { + lst = list_push(lst, make_string(argv[argc])); + } + env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); + + /* run in script mode if a filename is given */ + if (argc) { + + /* first argument on command line is filename */ + const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); + re(load_command, repl_env); + } + /* run in repl mode when no cmd line args */ + else { + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + } + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env** env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_letstar(list lst, Env** env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(*env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + *env = letstar_env; + return forms; +} + +MalType eval_if(list lst, Env** env) { + + if (!lst) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType raw_condition = lst->data; + list l1 = lst->next; + if (!l1) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType then_form = l1->data; + list l2 = l1->next; + MalType else_form; + if (l2) { + else_form = l2->data; + if (l2->next) { + bad_arg_count("if", "two or three arguments", lst); + } + } + else { + else_form = NULL; + } + + MalType condition = EVAL(raw_condition, *env); + + if (mal_error) { + return NULL; + } + + if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { + + /* check whether false branch is present */ + if(else_form) { + return else_form; + } + else { + *env = NULL; // no TCO + return make_nil(); + } + + } else { + return then_form; + } +} + +MalType eval_do(list lst, Env** env) { + + /* handle empty 'do' */ + if (!lst) { + return make_nil(); + } + + /* evaluate all but the last form */ + while (lst->next) { + + EVAL(lst->data, *env); + + /* return error early */ + if (mal_error) { + return NULL; + } + lst = lst->next; + } + /* return the last form for TCE evaluation */ + return lst->data; +} + +MalType eval_quote(list lst, Env** env) { + + explode1("quote", lst, form); + *env = NULL; // no TCO + return form; +} + +MalType eval_quasiquote(list lst, Env**) { + explode1("quasiquote", lst, form); + return quasiquote(form); + // Implicit error propagation. +} + +MalType quasiquote(MalType ast) { + + /* argument to quasiquote is a vector: (quasiquote [first rest]) */ + list lst; + vector_t vec; + if ((vec = is_vector(ast))) { + + return quasiquote_vector(vec); + // Implicit error propagation + } + + /* argument to quasiquote is a list: (quasiquote (first rest)) */ + else if (is_list(ast, &lst)){ + + if(lst) { + MalType first = lst->data; + if(equal_forms(first, SYMBOL_UNQUOTE)) { + lst = lst->next; + explode1("unquote", lst, unquoted); + return unquoted; + } + } + return quasiquote_list(lst); + // Implicit error propagation + } + /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) + => (quote val) */ + else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { + + list lst = NULL; + lst = list_push(lst, ast); + lst = list_push(lst, SYMBOL_QUOTE); + return make_list(lst); + } + /* argument to quasiquote is self-evaluating: (quasiquote val) + => val */ + else { + return ast; + } +} + +MalType quasiquote_vector(vector_t vec) { + + MalType result = make_list(NULL); + for (size_t i = vec->count; i--; ) { + result = quasiquote_folder(vec->nth[i], result); + if (mal_error) return NULL; + } + + list lst = NULL; + lst = list_push(lst, result); + lst = list_push(lst, SYMBOL_VEC); + + return make_list(lst); +} + +MalType quasiquote_list(list args) { + + /* handle empty list: (quasiquote ()) + => () */ + if (!args) { + return make_list(NULL); + } + + MalType first = args->data; + + MalType qq_rest = quasiquote_list(args->next); + if(mal_error) return NULL; + + return quasiquote_folder(first, qq_rest); + // Implicit error propagation. +} + +MalType quasiquote_folder(MalType first, MalType qq_rest) { + + /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) + => (concat first-second (quasiquote rest)) */ + list lst; + if(is_list(first, &lst)) { + if(lst) { + MalType lst_first = lst->data; + if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { + lst = lst->next; + explode1("splice-unquote", lst, unquoted); + return make_list(list_push(list_push(list_push(NULL, qq_rest), + unquoted), + SYMBOL_CONCAT)); + } + } + } + MalType qqted = quasiquote(first); + if(mal_error) return NULL; + return make_list(list_push(list_push(list_push(NULL, qq_rest), + qqted), + SYMBOL_CONS)); +} + +MalType eval_defmacrobang(list lst, Env** env) { + + explode2("defmacro!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + + if (mal_error) return NULL; + + MalClosure closure = is_closure(result); + if (!closure) { + bad_type("defmacro!", MALTYPE_CLOSURE, result); + } + result = make_macro(closure->env, closure->fnstar_args); + check_type("defmacro!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType eval_fnstar(list lst, Env** env) { + + if (!lst || !lst->next || lst->next->next) { + bad_arg_count("fn*", "two parameters", lst); + } + MalType parameters = lst->data; + check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); + + for (seq_cursor c = seq_iter(parameters); + seq_cont(parameters, c); + c = seq_next(parameters, c)) { + + MalType val = seq_item(parameters, c); + + if (!is_symbol(val)) { + bad_type("fn*", MALTYPE_SYMBOL, val); + } + + if (equal_forms(val, SYMBOL_AMPERSAND)) { + c = seq_next(parameters, c); + if (!val) { + make_error("'fn*': no symbol after &: '%N'", lst); + } + val = seq_item(parameters, c); + /* & is found and there is a single symbol after */ + check_type("fn*", MALTYPE_SYMBOL, val); + /* & is found and there extra symbols after */ + c = seq_next(parameters, c); + if (seq_cont(parameters, c)) { + make_error("'fn*': extra symbols after &: '%N'", lst); + } + break; + } + } + Env* fn_env = *env; + *env = NULL; // no TCO + return make_closure(fn_env, lst); +} + +/* used by core functions but not EVAL as doesn't do TCE */ +MalType apply(MalType fn, list args) { + + function_t fun_ptr; + if ((fun_ptr = is_function(fn))) { + + return (*fun_ptr)(args); + // Implicit error propagation + } + else { + + MalClosure closure = is_closure(fn); + if (!closure) closure = is_macro(fn); + assert(closure); + MalType ast = closure->fnstar_args->next->data; + Env* env = env_apply(closure, args); + if (mal_error) return NULL; + return EVAL(ast, env); + // Implicit error propagation + } +} diff --git a/impls/c.2/step9_try.c b/impls/c.2/step9_try.c new file mode 100644 index 0000000000..953178f612 --- /dev/null +++ b/impls/c.2/step9_try.c @@ -0,0 +1,662 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "core.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env**); +MalType eval_letstar(list, Env**); +MalType eval_if(list, Env**); +MalType eval_fnstar(list, Env**); +MalType eval_do(list, Env**); +MalType eval_quote(list, Env**); +MalType eval_quasiquote(list, Env**); +MalType quasiquote(MalType); +MalType quasiquote_vector(vector_t); +MalType quasiquote_list(list); +MalType quasiquote_folder(MalType first, MalType qq_rest); +MalType eval_defmacrobang(list, Env**); +MalType eval_try(list, Env**); + +typedef MalType (*special_t)(list, Env**); +struct map* specials; + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +Env* env_apply(MalClosure closure, list args) { + // Return the closure definition and update env if all went OK, + // else return an error. + Env* fn_env = env_make(closure->env); + MalType params = closure->fnstar_args->data; + + assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); + seq_cursor c = seq_iter(params); + list a = args; + while (true) { + if (!seq_cont(params, c)) { + if (a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + break; + } + MalType parameter = seq_item(params, c); + if (equal_forms(parameter, SYMBOL_AMPERSAND)) { + c = seq_next(params, c); + assert(seq_cont(params, c)); + env_set(fn_env, seq_item(params, c), make_list(a)); + break; + } + if (!a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + env_set(fn_env, parameter, a->data); + c = seq_next(params, c); + a = a->next; + } + return fn_env; +} + +MalType EVAL(MalType ast, Env* env) { + + /* Use goto to jump here rather than calling eval for tail-call elimination */ + TCE_entry_point: + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + ast = special(lst, &env); + if (mal_error) return NULL; + + if(!env) { return ast; } + goto TCE_entry_point; + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); + if (type(func) == MALTYPE_MACRO) { + ast = apply(func, lst); + if (mal_error) { return NULL; } + goto TCE_entry_point; + } + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + MalClosure closure; + if ((closure = is_closure(func))) { + + /* TCE - modify ast and env directly and jump back to eval */ + ast = closure->fnstar_args->next->data; + env = env_apply(closure, evlst); + + if (mal_error) return NULL; + goto TCE_entry_point; + } + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +// Variant reporting errors during startup. +void re(const char *str, Env* env) { + MalType a = READ(str); + if (!mal_error) { + EVAL(a, env); + if (!mal_error) { + return; + } + } + MalType result = mal_error; + mal_error = NULL; // before printing + printf("Error during startup: %M\n", result); + exit(EXIT_FAILURE); +} + +/* declare as global so it can be accessed by mal_eval */ +Env* repl_env; + +MalType mal_eval(list args) { + + explode1("eval", args, ast); + return EVAL(ast, repl_env); + // Implicit error propagation +} + +int main(int argc, char** argv) { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + specials = hashmap_put(specials, SYMBOL_IF, eval_if); + specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); + specials = hashmap_put(specials, SYMBOL_DO, eval_do); + specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); + specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); + specials = hashmap_put(specials, SYMBOL_DEFMACRO, eval_defmacrobang); + specials = hashmap_put(specials, SYMBOL_TRY, eval_try); + + repl_env = env_make(NULL); + + ns core; + size_t core_size; + ns_make_core(&core, &core_size); + while(core_size--) { + const char* symbol = core[core_size].key; + function_t function = core[core_size].value; + env_set(repl_env, make_symbol(symbol), make_function(function)); + } + + env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); + + /* add functions written in mal - not using rep as it prints the result */ + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + /* make command line arguments available in the environment */ + list lst = NULL; + while(1 < --argc) { + lst = list_push(lst, make_string(argv[argc])); + } + env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); + + /* run in script mode if a filename is given */ + if (argc) { + + /* first argument on command line is filename */ + const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); + re(load_command, repl_env); + } + /* run in repl mode when no cmd line args */ + else { + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + } + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env** env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_letstar(list lst, Env** env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(*env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + *env = letstar_env; + return forms; +} + +MalType eval_if(list lst, Env** env) { + + if (!lst) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType raw_condition = lst->data; + list l1 = lst->next; + if (!l1) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType then_form = l1->data; + list l2 = l1->next; + MalType else_form; + if (l2) { + else_form = l2->data; + if (l2->next) { + bad_arg_count("if", "two or three arguments", lst); + } + } + else { + else_form = NULL; + } + + MalType condition = EVAL(raw_condition, *env); + + if (mal_error) { + return NULL; + } + + if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { + + /* check whether false branch is present */ + if(else_form) { + return else_form; + } + else { + *env = NULL; // no TCO + return make_nil(); + } + + } else { + return then_form; + } +} + +MalType eval_do(list lst, Env** env) { + + /* handle empty 'do' */ + if (!lst) { + return make_nil(); + } + + /* evaluate all but the last form */ + while (lst->next) { + + EVAL(lst->data, *env); + + /* return error early */ + if (mal_error) { + return NULL; + } + lst = lst->next; + } + /* return the last form for TCE evaluation */ + return lst->data; +} + +MalType eval_quote(list lst, Env** env) { + + explode1("quote", lst, form); + *env = NULL; // no TCO + return form; +} + +MalType eval_quasiquote(list lst, Env**) { + explode1("quasiquote", lst, form); + return quasiquote(form); + // Implicit error propagation. +} + +MalType quasiquote(MalType ast) { + + /* argument to quasiquote is a vector: (quasiquote [first rest]) */ + list lst; + vector_t vec; + if ((vec = is_vector(ast))) { + + return quasiquote_vector(vec); + // Implicit error propagation + } + + /* argument to quasiquote is a list: (quasiquote (first rest)) */ + else if (is_list(ast, &lst)){ + + if(lst) { + MalType first = lst->data; + if(equal_forms(first, SYMBOL_UNQUOTE)) { + lst = lst->next; + explode1("unquote", lst, unquoted); + return unquoted; + } + } + return quasiquote_list(lst); + // Implicit error propagation + } + /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) + => (quote val) */ + else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { + + list lst = NULL; + lst = list_push(lst, ast); + lst = list_push(lst, SYMBOL_QUOTE); + return make_list(lst); + } + /* argument to quasiquote is self-evaluating: (quasiquote val) + => val */ + else { + return ast; + } +} + +MalType quasiquote_vector(vector_t vec) { + + MalType result = make_list(NULL); + for (size_t i = vec->count; i--; ) { + result = quasiquote_folder(vec->nth[i], result); + if (mal_error) return NULL; + } + + list lst = NULL; + lst = list_push(lst, result); + lst = list_push(lst, SYMBOL_VEC); + + return make_list(lst); +} + +MalType quasiquote_list(list args) { + + /* handle empty list: (quasiquote ()) + => () */ + if (!args) { + return make_list(NULL); + } + + MalType first = args->data; + + MalType qq_rest = quasiquote_list(args->next); + if(mal_error) return NULL; + + return quasiquote_folder(first, qq_rest); + // Implicit error propagation. +} + +MalType quasiquote_folder(MalType first, MalType qq_rest) { + + /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) + => (concat first-second (quasiquote rest)) */ + list lst; + if(is_list(first, &lst)) { + if(lst) { + MalType lst_first = lst->data; + if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { + lst = lst->next; + explode1("splice-unquote", lst, unquoted); + return make_list(list_push(list_push(list_push(NULL, qq_rest), + unquoted), + SYMBOL_CONCAT)); + } + } + } + MalType qqted = quasiquote(first); + if(mal_error) return NULL; + return make_list(list_push(list_push(list_push(NULL, qq_rest), + qqted), + SYMBOL_CONS)); +} + +MalType eval_defmacrobang(list lst, Env** env) { + + explode2("defmacro!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + + if (mal_error) return NULL; + + MalClosure closure = is_closure(result); + if (!closure) { + bad_type("defmacro!", MALTYPE_CLOSURE, result); + } + result = make_macro(closure->env, closure->fnstar_args); + check_type("defmacro!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_try(list lst, Env** env) { + + if (!lst) { + bad_arg_count("try*", "one or two arguments", lst); + } + + MalType try_clause = lst->data; + + list l = lst->next; + if (!l) { + /* no catch* clause */ + return try_clause; + } + + MalType catch_clause = l->data; + if (l->next) { + bad_arg_count("try*", "one or two arguments", lst); + } + + /* process catch* clause */ + check_type("try*", MALTYPE_LIST, catch_clause); + list catch_list; + if (!is_list(catch_clause, &catch_list)) { + bad_type("try*", MALTYPE_LIST, catch_clause); + } + explode3("try*(catch clause)", catch_list, catch_symbol, a2, handler); + if (!equal_forms(catch_symbol, SYMBOL_CATCH)) { + make_error("'try*': catch* clause is missing catch* symbol: %M", + catch_clause); + } + check_type("try*", MALTYPE_SYMBOL, a2); + + MalType try_result = EVAL(try_clause, *env); + if(!mal_error) { + *env = NULL; // prevent TCO + return try_result; + } + + /* bind the symbol to the exception */ + Env* catch_env = env_make(*env); + env_set(catch_env, + a2, mal_error); + mal_error = NULL; + *env = catch_env; + + return handler; +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType eval_fnstar(list lst, Env** env) { + + if (!lst || !lst->next || lst->next->next) { + bad_arg_count("fn*", "two parameters", lst); + } + MalType parameters = lst->data; + check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); + + for (seq_cursor c = seq_iter(parameters); + seq_cont(parameters, c); + c = seq_next(parameters, c)) { + + MalType val = seq_item(parameters, c); + + if (!is_symbol(val)) { + bad_type("fn*", MALTYPE_SYMBOL, val); + } + + if (equal_forms(val, SYMBOL_AMPERSAND)) { + c = seq_next(parameters, c); + if (!val) { + make_error("'fn*': no symbol after &: '%N'", lst); + } + val = seq_item(parameters, c); + /* & is found and there is a single symbol after */ + check_type("fn*", MALTYPE_SYMBOL, val); + /* & is found and there extra symbols after */ + c = seq_next(parameters, c); + if (seq_cont(parameters, c)) { + make_error("'fn*': extra symbols after &: '%N'", lst); + } + break; + } + } + Env* fn_env = *env; + *env = NULL; // no TCO + return make_closure(fn_env, lst); +} + +/* used by core functions but not EVAL as doesn't do TCE */ +MalType apply(MalType fn, list args) { + + function_t fun_ptr; + if ((fun_ptr = is_function(fn))) { + + return (*fun_ptr)(args); + // Implicit error propagation + } + else { + + MalClosure closure = is_closure(fn); + if (!closure) closure = is_macro(fn); + assert(closure); + MalType ast = closure->fnstar_args->next->data; + Env* env = env_apply(closure, args); + if (mal_error) return NULL; + return EVAL(ast, env); + // Implicit error propagation + } +} diff --git a/impls/c.2/stepA_mal.c b/impls/c.2/stepA_mal.c new file mode 100644 index 0000000000..d36259dc65 --- /dev/null +++ b/impls/c.2/stepA_mal.c @@ -0,0 +1,666 @@ +#include +#include +#include + +#include "linked_list.h" +#include "types.h" +#include "reader.h" +#include "printer.h" +#include "env.h" +#include "core.h" +#include "error.h" +#include "hashmap.h" +#include "readline.h" +#include "vector.h" + +#define PROMPT_STRING "user> " + +MalType apply(MalType, list); // For the apply phase and core apply/map/swap. +list evaluate_list(list, Env*); +MalType evaluate_vector(vector_t, Env*); +MalType evaluate_hashmap(hashmap lst, Env* env); +MalType eval_defbang(list, Env**); +MalType eval_letstar(list, Env**); +MalType eval_if(list, Env**); +MalType eval_fnstar(list, Env**); +MalType eval_do(list, Env**); +MalType eval_quote(list, Env**); +MalType eval_quasiquote(list, Env**); +MalType quasiquote(MalType); +MalType quasiquote_vector(vector_t); +MalType quasiquote_list(list); +MalType quasiquote_folder(MalType first, MalType qq_rest); +MalType eval_defmacrobang(list, Env**); +MalType eval_try(list, Env**); + +typedef MalType (*special_t)(list, Env**); +struct map* specials; + +MalType READ(const char* str) { + + return read_str(str); + // Implicit error propagation +} + +Env* env_apply(MalClosure closure, list args) { + // Return the closure definition and update env if all went OK, + // else return an error. + Env* fn_env = env_make(closure->env); + MalType params = closure->fnstar_args->data; + + assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); + seq_cursor c = seq_iter(params); + list a = args; + while (true) { + if (!seq_cont(params, c)) { + if (a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + break; + } + MalType parameter = seq_item(params, c); + if (equal_forms(parameter, SYMBOL_AMPERSAND)) { + c = seq_next(params, c); + assert(seq_cont(params, c)); + env_set(fn_env, seq_item(params, c), make_list(a)); + break; + } + if (!a) { + make_error("'apply': expected %M, got [%N]", params, args); + } + env_set(fn_env, parameter, a->data); + c = seq_next(params, c); + a = a->next; + } + return fn_env; +} + +MalType EVAL(MalType ast, Env* env) { + + /* Use goto to jump here rather than calling eval for tail-call elimination */ + TCE_entry_point: + + MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); + if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) + printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); + + if (type(ast) == MALTYPE_SYMBOL) { + MalType symbol_value = env_get(env, ast); + if (symbol_value) + return symbol_value; + else + make_error("'%M' not found", ast); + } + + vector_t vec; + if ((vec = is_vector(ast))) { + return evaluate_vector(vec, env); + // Implicit error propagation + } + + hashmap map; + if ((map = is_hashmap(ast))) { + return evaluate_hashmap(map, env); + // Implicit error propagation + } + + /* not a list */ + list lst; + if (!is_list(ast, &lst)) { return ast; } + + /* empty list */ + if(lst == NULL) { return ast; } + + /* list */ + MalType first = lst->data; + lst = lst->next; + + /* handle special symbols first */ + if (type(first) & MALTYPE_SYMBOL) { + special_t special = hashmap_get(specials, first); + if (special) { + ast = special(lst, &env); + if (mal_error) return NULL; + + if(!env) { return ast; } + goto TCE_entry_point; + } + } + + /* first element is not a special symbol */ + MalType func = EVAL(first, env); + if (mal_error) { return NULL; } + check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); + if (type(func) == MALTYPE_MACRO) { + ast = apply(func, lst); + if (mal_error) { return NULL; } + goto TCE_entry_point; + } + // Evaluate the arguments + list evlst = evaluate_list(lst, env); + if (mal_error) return NULL; + + /* apply the first element of the list to the arguments */ + MalClosure closure; + if ((closure = is_closure(func))) { + + /* TCE - modify ast and env directly and jump back to eval */ + ast = closure->fnstar_args->next->data; + env = env_apply(closure, evlst); + + if (mal_error) return NULL; + goto TCE_entry_point; + } + return apply(func, evlst); + // Implicit error propagation +} + +void PRINT(MalType val) { + + printf("%M\n", val); +} + +void rep(const char* str, Env* env) { + + MalType a = READ(str); + if (!mal_error) { + MalType b = EVAL(a, env); + if (!mal_error) { + PRINT(b); + return; + } + } + MalType e = mal_error; + mal_error = NULL; // before printing + printf("Uncaught error: %M\n", e); +} + +// Variant reporting errors during startup. +void re(const char *str, Env* env) { + MalType a = READ(str); + if (!mal_error) { + EVAL(a, env); + if (!mal_error) { + return; + } + } + MalType result = mal_error; + mal_error = NULL; // before printing + printf("Error during startup: %M\n", result); + exit(EXIT_FAILURE); +} + +/* declare as global so it can be accessed by mal_eval */ +Env* repl_env; + +MalType mal_eval(list args) { + + explode1("eval", args, ast); + return EVAL(ast, repl_env); + // Implicit error propagation +} + +int main(int argc, char** argv) { + + types_init(); + printer_init(); + + specials = map_empty(); + specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); + specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); + specials = hashmap_put(specials, SYMBOL_IF, eval_if); + specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); + specials = hashmap_put(specials, SYMBOL_DO, eval_do); + specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); + specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); + specials = hashmap_put(specials, SYMBOL_DEFMACRO, eval_defmacrobang); + specials = hashmap_put(specials, SYMBOL_TRY, eval_try); + + repl_env = env_make(NULL); + + ns core; + size_t core_size; + ns_make_core(&core, &core_size); + while(core_size--) { + const char* symbol = core[core_size].key; + function_t function = core[core_size].value; + env_set(repl_env, make_symbol(symbol), make_function(function)); + } + + env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); + + /* add functions written in mal - not using rep as it prints the result */ + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + /* make command line arguments available in the environment */ + list lst = NULL; + while(1 < --argc) { + lst = list_push(lst, make_string(argv[argc])); + } + env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); + env_set(repl_env, make_symbol("*host-language*"), make_string("c.2")); + + /* run in script mode if a filename is given */ + if (argc) { + + /* first argument on command line is filename */ + const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); + re(load_command, repl_env); + } + /* run in repl mode when no cmd line args */ + else { + + /* Greeting message */ + re("(println (str \"Mal [\" *host-language* \"]\"))", repl_env); + + const char* input; + while((input = readline_gc(PROMPT_STRING))) { + + /* print prompt and get input*/ + /* Check for EOF (Ctrl-D) */ + + /* call Read-Eval-Print */ + rep(input, repl_env); + } + printf("\n"); + } + return EXIT_SUCCESS; +} + +MalType eval_defbang(list lst, Env** env) { + + explode2("def!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + if (mal_error) { + return NULL; + } + check_type("def!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_letstar(list lst, Env** env) { + + explode2("let*", lst, bindings, forms); + + check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); + + seq_cursor bindings_list = seq_iter(bindings); + Env* letstar_env = env_make(*env); + + /* evaluate the bindings */ + while(seq_cont(bindings, bindings_list)) { + + MalType symbol = seq_item(bindings, bindings_list); + bindings_list = seq_next(bindings, bindings_list); + if(!seq_cont(bindings, bindings_list)) { + bad_arg_count("let*", "an even number of binding pairs", + bindings); + } + MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); + + /* early return from error */ + if (mal_error) { + return NULL; + } + + check_type("let*", MALTYPE_SYMBOL, symbol); + env_set(letstar_env, symbol, value); + bindings_list = seq_next(bindings, bindings_list); + } + + *env = letstar_env; + return forms; +} + +MalType eval_if(list lst, Env** env) { + + if (!lst) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType raw_condition = lst->data; + list l1 = lst->next; + if (!l1) { + bad_arg_count("if", "two or three arguments", lst); + } + MalType then_form = l1->data; + list l2 = l1->next; + MalType else_form; + if (l2) { + else_form = l2->data; + if (l2->next) { + bad_arg_count("if", "two or three arguments", lst); + } + } + else { + else_form = NULL; + } + + MalType condition = EVAL(raw_condition, *env); + + if (mal_error) { + return NULL; + } + + if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { + + /* check whether false branch is present */ + if(else_form) { + return else_form; + } + else { + *env = NULL; // no TCO + return make_nil(); + } + + } else { + return then_form; + } +} + +MalType eval_do(list lst, Env** env) { + + /* handle empty 'do' */ + if (!lst) { + return make_nil(); + } + + /* evaluate all but the last form */ + while (lst->next) { + + EVAL(lst->data, *env); + + /* return error early */ + if (mal_error) { + return NULL; + } + lst = lst->next; + } + /* return the last form for TCE evaluation */ + return lst->data; +} + +MalType eval_quote(list lst, Env** env) { + + explode1("quote", lst, form); + *env = NULL; // no TCO + return form; +} + +MalType eval_quasiquote(list lst, Env**) { + explode1("quasiquote", lst, form); + return quasiquote(form); + // Implicit error propagation. +} + +MalType quasiquote(MalType ast) { + + /* argument to quasiquote is a vector: (quasiquote [first rest]) */ + list lst; + vector_t vec; + if ((vec = is_vector(ast))) { + + return quasiquote_vector(vec); + // Implicit error propagation + } + + /* argument to quasiquote is a list: (quasiquote (first rest)) */ + else if (is_list(ast, &lst)){ + + if(lst) { + MalType first = lst->data; + if(equal_forms(first, SYMBOL_UNQUOTE)) { + lst = lst->next; + explode1("unquote", lst, unquoted); + return unquoted; + } + } + return quasiquote_list(lst); + // Implicit error propagation + } + /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) + => (quote val) */ + else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { + + list lst = NULL; + lst = list_push(lst, ast); + lst = list_push(lst, SYMBOL_QUOTE); + return make_list(lst); + } + /* argument to quasiquote is self-evaluating: (quasiquote val) + => val */ + else { + return ast; + } +} + +MalType quasiquote_vector(vector_t vec) { + + MalType result = make_list(NULL); + for (size_t i = vec->count; i--; ) { + result = quasiquote_folder(vec->nth[i], result); + if (mal_error) return NULL; + } + + list lst = NULL; + lst = list_push(lst, result); + lst = list_push(lst, SYMBOL_VEC); + + return make_list(lst); +} + +MalType quasiquote_list(list args) { + + /* handle empty list: (quasiquote ()) + => () */ + if (!args) { + return make_list(NULL); + } + + MalType first = args->data; + + MalType qq_rest = quasiquote_list(args->next); + if(mal_error) return NULL; + + return quasiquote_folder(first, qq_rest); + // Implicit error propagation. +} + +MalType quasiquote_folder(MalType first, MalType qq_rest) { + + /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) + => (concat first-second (quasiquote rest)) */ + list lst; + if(is_list(first, &lst)) { + if(lst) { + MalType lst_first = lst->data; + if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { + lst = lst->next; + explode1("splice-unquote", lst, unquoted); + return make_list(list_push(list_push(list_push(NULL, qq_rest), + unquoted), + SYMBOL_CONCAT)); + } + } + } + MalType qqted = quasiquote(first); + if(mal_error) return NULL; + return make_list(list_push(list_push(list_push(NULL, qq_rest), + qqted), + SYMBOL_CONS)); +} + +MalType eval_defmacrobang(list lst, Env** env) { + + explode2("defmacro!", lst, defbang_symbol, defbang_value); + + MalType result = EVAL(defbang_value, *env); + + if (mal_error) return NULL; + + MalClosure closure = is_closure(result); + if (!closure) { + bad_type("defmacro!", MALTYPE_CLOSURE, result); + } + result = make_macro(closure->env, closure->fnstar_args); + check_type("defmacro!", MALTYPE_SYMBOL, defbang_symbol); + env_set(*env, defbang_symbol, result); + *env = NULL; // no TCO + return result; +} + +MalType eval_try(list lst, Env** env) { + + if (!lst) { + bad_arg_count("try*", "one or two arguments", lst); + } + + MalType try_clause = lst->data; + + list l = lst->next; + if (!l) { + /* no catch* clause */ + return try_clause; + } + + MalType catch_clause = l->data; + if (l->next) { + bad_arg_count("try*", "one or two arguments", lst); + } + + /* process catch* clause */ + check_type("try*", MALTYPE_LIST, catch_clause); + list catch_list; + if (!is_list(catch_clause, &catch_list)) { + bad_type("try*", MALTYPE_LIST, catch_clause); + } + explode3("try*(catch clause)", catch_list, catch_symbol, a2, handler); + if (!equal_forms(catch_symbol, SYMBOL_CATCH)) { + make_error("'try*': catch* clause is missing catch* symbol: %M", + catch_clause); + } + check_type("try*", MALTYPE_SYMBOL, a2); + + MalType try_result = EVAL(try_clause, *env); + if(!mal_error) { + *env = NULL; // prevent TCO + return try_result; + } + + /* bind the symbol to the exception */ + Env* catch_env = env_make(*env); + env_set(catch_env, + a2, mal_error); + mal_error = NULL; + *env = catch_env; + + return handler; +} + +list evaluate_list(list lst, Env* env) { + + list evlst = NULL; + list* evlst_last = &evlst; + while (lst) { + + MalType val = EVAL(lst->data, env); + + if (mal_error) { + return NULL; + } + + *evlst_last = list_push(NULL, val); + evlst_last = &(*evlst_last)->next; + lst = lst->next; + } + return evlst; +} + +MalType evaluate_vector(vector_t lst, Env* env) { + size_t capacity = lst->count; + struct vector* evlst = vector_new(capacity); + for (size_t i = 0; i < capacity; i++) { + MalType new = EVAL(lst->nth[i], env); + if (mal_error) return NULL; + vector_append(&capacity, &evlst, new); + } + assert(evlst->count == capacity); + return make_vector(evlst); +} + +MalType evaluate_hashmap(hashmap lst, Env* env) { + // map_empty() would be OK, but we know the size in advance and can + // spare inefficient reallocations. + struct map* evlst = map_copy(lst); + for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { + MalType new = EVAL(map_val(lst, c), env); + if (mal_error) return false; + evlst = hashmap_put(evlst, map_key(lst, c), new); + } + return make_hashmap(evlst); +} + +MalType eval_fnstar(list lst, Env** env) { + + if (!lst || !lst->next || lst->next->next) { + bad_arg_count("fn*", "two parameters", lst); + } + MalType parameters = lst->data; + check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); + + for (seq_cursor c = seq_iter(parameters); + seq_cont(parameters, c); + c = seq_next(parameters, c)) { + + MalType val = seq_item(parameters, c); + + if (!is_symbol(val)) { + bad_type("fn*", MALTYPE_SYMBOL, val); + } + + if (equal_forms(val, SYMBOL_AMPERSAND)) { + c = seq_next(parameters, c); + if (!val) { + make_error("'fn*': no symbol after &: '%N'", lst); + } + val = seq_item(parameters, c); + /* & is found and there is a single symbol after */ + check_type("fn*", MALTYPE_SYMBOL, val); + /* & is found and there extra symbols after */ + c = seq_next(parameters, c); + if (seq_cont(parameters, c)) { + make_error("'fn*': extra symbols after &: '%N'", lst); + } + break; + } + } + Env* fn_env = *env; + *env = NULL; // no TCO + return make_closure(fn_env, lst); +} + +/* used by core functions but not EVAL as doesn't do TCE */ +MalType apply(MalType fn, list args) { + + function_t fun_ptr; + if ((fun_ptr = is_function(fn))) { + + return (*fun_ptr)(args); + // Implicit error propagation + } + else { + + MalClosure closure = is_closure(fn); + if (!closure) closure = is_macro(fn); + assert(closure); + MalType ast = closure->fnstar_args->next->data; + Env* env = env_apply(closure, args); + if (mal_error) return NULL; + return EVAL(ast, env); + // Implicit error propagation + } +} diff --git a/impls/c.2/tests/stepA_mal.mal b/impls/c.2/tests/stepA_mal.mal new file mode 100644 index 0000000000..d9294e7e52 --- /dev/null +++ b/impls/c.2/tests/stepA_mal.mal @@ -0,0 +1,22 @@ +;; Testing FFI of "strlen" +(. nil "int32" "strlen" "string" "abcde") +;=>5 +(. nil "int32" "strlen" "string" "") +;=>0 + +;; Testing FFI of "strcmp" + +(. nil "int32" "strcmp" "string" "abc" "string" "abcA") +;=>-65 +(. nil "int32" "strcmp" "string" "abcA" "string" "abc") +;=>65 +(. nil "int32" "strcmp" "string" "abc" "string" "abc") +;=>0 + + +;; Testing FFI of "pow" (libm.so) + +(. "libm.so.6" "double" "pow" "double" 2.0 "double" 3.0) +;=>8.000000 +(. "libm.so.6" "double" "pow" "double" 3.0 "double" 2.0) +;=>9.000000 diff --git a/impls/c.2/types.c b/impls/c.2/types.c new file mode 100644 index 0000000000..40733569bf --- /dev/null +++ b/impls/c.2/types.c @@ -0,0 +1,349 @@ +#include +#ifdef DEBUG_HASH +# include "stdio.h" +#endif +#include + +#include + +#include "types.h" +#include "vector.h" +#include "hashmap.h" +#include "linked_list.h" +#ifdef DEBUG_HASH +# include "printer.h" +#endif + +struct MalType_s { + enum mal_type_t type; + + union MalType_u { + long mal_integer; + double mal_float; + struct { + const char* s; + size_t hash; + } mal_string; + struct { + list l; + MalType meta; + } mal_list; + struct { + vector_t v; + MalType meta; + } mal_vector; + struct { + hashmap m; + MalType meta; + } mal_hashmap; + struct { + function_t f; + MalType meta; + } mal_function; + struct { + struct MalClosure_s c; + MalType meta; + } mal_closure; + MalType mal_atom; + } value; +}; + +struct MalType_s THE_NIL = { MALTYPE_NIL, {0}}; +struct MalType_s THE_TRUE = { MALTYPE_TRUE, {0}}; +struct MalType_s THE_FALSE = { MALTYPE_FALSE, {0}}; + +bool is_nil(MalType val) { return val == &THE_NIL; } +bool is_false(MalType val) { return val == &THE_FALSE; } +bool is_true(MalType val) { return val == &THE_TRUE; } + +inline bool is_integer(MalType val, long* result) { + bool ok = val->type & MALTYPE_INTEGER; + if (ok) *result = val->value.mal_integer; + return ok; +} +MalType make_integer(long value) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_INTEGER, {.mal_integer=value}}; + return mal_val; +} + +inline bool is_float(MalType val, double* result) { + bool ok = val->type & MALTYPE_FLOAT; + if (ok) *result = val->value.mal_float; + return ok; +} +MalType make_float(double value) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_FLOAT, {.mal_float=value}}; + return mal_val; +} + +#define NO_HASH_YET (size_t)(-1) + +size_t hash(const char* s) { +# ifdef DEBUG_HASH + printf("HASH %s\n", s); +# endif + size_t h = 0; + // 8 characters are sufficient to ensure distinct hashes for + // "keyword" and "keyword?". + for (size_t i = 0; i < 8; i++) { + unsigned char c = s[i]; + if (!c) break; + h = h << 1 ^ c; +# ifdef DEBUG_HASH + printf("HASH %c %08b %064lb\n", c, c, h); +# endif + } + return h; +} + +inline const char* is_string(MalType val) { + return val->type & MALTYPE_STRING ? val->value.mal_string.s : NULL; +} +MalType make_string(const char* value) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_STRING, {.mal_string={value, NO_HASH_YET}}}; + return mal_val; +} + +inline const char* is_keyword(MalType val) { + return val->type & MALTYPE_KEYWORD ? val->value.mal_string.s : NULL; +} +MalType make_keyword(const char* value) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_KEYWORD, {.mal_string={value, NO_HASH_YET}}}; + return mal_val; +} + +inline const char* is_symbol(MalType val) { + return val->type & MALTYPE_SYMBOL ? val->value.mal_string.s : NULL; +} +MalType make_symbol(const char* value) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_SYMBOL, {.mal_string={value, NO_HASH_YET}}}; + return mal_val; +} + +inline bool is_list(MalType val, list* result) { + bool ok = val->type & MALTYPE_LIST; + if (ok) *result = val->value.mal_list.l; + return ok; +} +MalType make_list_m(list value, MalType metadata) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_LIST, {.mal_list={value, metadata}}}; + return mal_val; +} +inline MalType make_list(list value) { + return make_list_m(value, &THE_NIL); +} + +inline vector_t is_vector(MalType val) { + return val->type & MALTYPE_VECTOR ? val->value.mal_vector.v : NULL; +} +MalType make_vector_m(vector_t value, MalType metadata) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_VECTOR, {.mal_vector={value, metadata}}}; + return mal_val; +} +inline MalType make_vector(vector_t value) { + return make_vector_m(value, &THE_NIL); +} + +inline hashmap is_hashmap(MalType val) { + return val->type & MALTYPE_HASHMAP ? val->value.mal_hashmap.m : NULL; +} +MalType make_hashmap_m(hashmap value, MalType metadata) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_HASHMAP, {.mal_hashmap={value, metadata}}}; + return mal_val; +} +inline MalType make_hashmap(hashmap value) { + return make_hashmap_m(value, &THE_NIL); +} + +inline function_t is_function(MalType val) { + return val->type & MALTYPE_FUNCTION ? val->value.mal_function.f : NULL; +} +MalType make_function_m(function_t value, MalType metadata) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_FUNCTION, {.mal_function={value, metadata}}}; + return mal_val; +} +inline MalType make_function(function_t value) { + return make_function_m(value, &THE_NIL); +} + +inline MalClosure is_closure(MalType val) { + return val->type & MALTYPE_CLOSURE ? &val->value.mal_closure.c : NULL; +} +MalType make_closure_m(const Env* env, list fnstar_args, MalType metadata) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_CLOSURE, {.mal_closure={{env, fnstar_args}, metadata}}}; + return mal_val; +} +inline MalType make_closure(const Env* env, list fnstar_args) { + return make_closure_m(env, fnstar_args, &THE_NIL); +} + +inline MalClosure is_macro(MalType val) { + return val->type & MALTYPE_MACRO ? &val->value.mal_closure.c : NULL; +} +MalType make_macro(const Env* env, list fnstar_args) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_MACRO, {.mal_closure={{env, fnstar_args}, &THE_NIL}}}; + return mal_val; +} + +inline MalType* is_atom(MalType val) { + return val->type & MALTYPE_ATOM ? &val->value.mal_atom : NULL; +} +MalType make_atom(MalType value) { + struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); + *mal_val = (struct MalType_s){MALTYPE_ATOM, {.mal_atom=value}}; + return mal_val; +} + +MalType meta(MalType form) { + switch (form->type) { + case MALTYPE_LIST : return form->value.mal_list .meta; + case MALTYPE_VECTOR : return form->value.mal_vector .meta; + case MALTYPE_HASHMAP : return form->value.mal_hashmap .meta; + case MALTYPE_FUNCTION: return form->value.mal_function.meta; + case MALTYPE_CLOSURE : return form->value.mal_closure .meta; + default: return &THE_NIL; + } +} + +inline enum mal_type_t type(MalType val) { + return val->type; +} + +inline size_t get_hash(MalType form) { + assert(form->type & (MALTYPE_KEYWORD | MALTYPE_STRING | MALTYPE_SYMBOL)); + if(form->value.mal_string.hash == NO_HASH_YET) { + form->value.mal_string.hash = hash(form->value.mal_string.s); + } + return form->value.mal_string.hash; +} + +void* mal_type_value_address(MalType form) { + switch (form->type) { + case MALTYPE_NIL: + case MALTYPE_INTEGER: + return (void*)&form->value.mal_integer; + case MALTYPE_STRING: + return (void*)&form->value.mal_string.s; + case MALTYPE_FLOAT: + return (void*)&form->value.mal_integer; + default: + assert(false); + return NULL; // silent a warning when NDEBUG. + } +} + +bool equal_forms(MalType first, MalType second) { + // Compare strings as soon as possible because EVAL, map_get and + // env_get call this function often. Conclude early if the hashes + // do not match. + + if (first->type & (MALTYPE_LIST | MALTYPE_VECTOR)) { + if (second->type & ~ (MALTYPE_LIST | MALTYPE_VECTOR)) return false; + seq_cursor c2 = seq_iter(second); + for (seq_cursor c1 = seq_iter(first); + seq_cont(first, c1); + c1 = seq_next(first, c1)) { + if (!seq_cont(second, c2) + || !equal_forms(seq_item(first, c1), seq_item(second, c2))) + return false; + c2 = seq_next(second, c2); + } + return !seq_cont(second, c2); + } + + if (first->type != second->type) return false; + + if (first->type & (MALTYPE_KEYWORD | MALTYPE_STRING | MALTYPE_SYMBOL)) { + // via get_hash because the hash may not be computed yet. + return get_hash(first) == get_hash(second) + && !strcmp(first->value.mal_string.s, second->value.mal_string.s); + } + + if (first->type & (MALTYPE_NIL | MALTYPE_FALSE | MALTYPE_TRUE)) return true; + + if (first->type == MALTYPE_INTEGER) { + return first->value.mal_integer == second->value.mal_integer; + } + if (first->type == MALTYPE_FLOAT) { + return first->value.mal_float == second->value.mal_float; + } + if (first->type == MALTYPE_HASHMAP) { + hashmap m1 = first->value.mal_hashmap.m; + hashmap m2 = second->value.mal_hashmap.m; + if (map_count(m1) != map_count(m2)) + return false; + for (map_cursor c = map_iter(m1); map_cont(m1, c); c = map_next(m1, c)) { + MalType val2 = hashmap_get(m2, map_key(m1, c)); + if (!val2 || !equal_forms(map_val(m1, c), val2)) + return false; + } + return true; + } + return false; +} + +MalType SYMBOL_AMPERSAND; +MalType SYMBOL_CATCH; +MalType SYMBOL_CONCAT; +MalType SYMBOL_CONS; +MalType SYMBOL_DEBUG_EVAL; +MalType SYMBOL_DEF; +MalType SYMBOL_DEFMACRO; +MalType SYMBOL_DEREF; +MalType SYMBOL_DO; +MalType SYMBOL_FN; +MalType SYMBOL_IF; +MalType SYMBOL_LET; +MalType SYMBOL_QUASIQUOTE; +MalType SYMBOL_QUOTE; +MalType SYMBOL_SPLICE_UNQUOTE; +MalType SYMBOL_TRY; +MalType SYMBOL_UNQUOTE; +MalType SYMBOL_VEC; +MalType SYMBOL_WITH_META; + +void types_init() { + SYMBOL_AMPERSAND = make_symbol("&"); + SYMBOL_CATCH = make_symbol("catch*"); + SYMBOL_CONCAT = make_symbol("concat"); + SYMBOL_CONCAT = make_symbol("concat"); + SYMBOL_CONS = make_symbol("cons"); + SYMBOL_DEBUG_EVAL = make_symbol("DEBUG-EVAL"); + SYMBOL_DEF = make_symbol("def!"); + SYMBOL_DEFMACRO = make_symbol("defmacro!"); + SYMBOL_DEREF = make_symbol("deref"); + SYMBOL_DO = make_symbol("do"); + SYMBOL_FN = make_symbol("fn*"); + SYMBOL_IF = make_symbol("if"); + SYMBOL_LET = make_symbol("let*"); + SYMBOL_QUASIQUOTE = make_symbol("quasiquote"); + SYMBOL_QUOTE = make_symbol("quote"); + SYMBOL_SPLICE_UNQUOTE = make_symbol("splice-unquote"); + SYMBOL_TRY = make_symbol("try*"); + SYMBOL_UNQUOTE = make_symbol("unquote"); + SYMBOL_VEC = make_symbol("vec"); + SYMBOL_WITH_META = make_symbol("with-meta"); +} + +inline MalType make_true() { + return &THE_TRUE; +} + +inline MalType make_false() { + return &THE_FALSE; +} + +inline MalType make_nil() { + return &THE_NIL; +} diff --git a/impls/c.2/types.h b/impls/c.2/types.h new file mode 100644 index 0000000000..f8cc83b538 --- /dev/null +++ b/impls/c.2/types.h @@ -0,0 +1,118 @@ +#ifndef _MAL_TYPES_H +#define _MAL_TYPES_H + +#include + +// The order must match the one in printer.c. +enum mal_type_t { + MALTYPE_SYMBOL = 1 << 0, + MALTYPE_KEYWORD = 1 << 1, + MALTYPE_INTEGER = 1 << 2, + MALTYPE_FLOAT = 1 << 3, + MALTYPE_STRING = 1 << 4, + MALTYPE_TRUE = 1 << 5, + MALTYPE_FALSE = 1 << 6, + MALTYPE_NIL = 1 << 7, + MALTYPE_LIST = 1 << 8, + MALTYPE_VECTOR = 1 << 9, + MALTYPE_HASHMAP = 1 << 10, + MALTYPE_FUNCTION = 1 << 11, + MALTYPE_CLOSURE = 1 << 12, + MALTYPE_ATOM = 1 << 13, + MALTYPE_MACRO = 1 << 14, +}; + +typedef struct MalType_s* MalType; +typedef const struct MalClosure_s* MalClosure; +typedef struct pair_s* list; // mutable for appends +typedef MalType(*function_t)(list); +typedef struct Env_s Env; +typedef const struct map* hashmap; +typedef const struct vector* vector_t; + +struct MalClosure_s { + + const Env* env; + list fnstar_args; // (parameters body) + // parameters is a list or vector of symbols + // If "&" is present, it stands right before the last symbol. + +}; + +MalType make_symbol(const char* value); +MalType make_integer(long value); +MalType make_float(double value); +MalType make_keyword(const char* value); +MalType make_string(const char* value); +MalType make_list(list value); +MalType make_list_m(list value, MalType meta); +MalType make_vector(vector_t value); +MalType make_vector_m(vector_t value, MalType meta); +MalType make_hashmap(hashmap value); +MalType make_hashmap_m(hashmap value, MalType meta); +MalType make_true(); +MalType make_false(); +MalType make_nil(); +MalType make_atom(MalType value); +MalType make_function_m(function_t value, MalType meta); +MalType make_function(function_t value); +MalType make_closure_m(const Env* env, list fnstar_args, MalType meta); +MalType make_closure(const Env* env, list fnstar_args); +MalType make_macro(const Env* env, list fnstar_args); + +// A NULL result means that the type differs, except for lists. +bool is_list(MalType val, list*); +vector_t is_vector(MalType val); +hashmap is_hashmap(MalType val); +bool is_nil(MalType val); +const char* is_string(MalType val); +bool is_false(MalType val); +const char* is_symbol(MalType val); +const char* is_keyword(MalType val); +function_t is_function(MalType val); +MalClosure is_closure(MalType val); +MalClosure is_macro(MalType val); +bool is_integer(MalType val, long*); +bool is_float(MalType val, double*); +MalType* is_atom(MalType val); +bool is_true(MalType val); + + +enum mal_type_t type(MalType); +MalType meta(MalType); // Returns nil for types without metadata. +size_t get_hash(MalType); // Crashes for types without hash. + +// These parts could be implemented outside types, but improve +// readability in core, hashmap and steps. + +// This also improves efficiency because +// a lost of allocations of the same symbol are avoided +// amost symbol comparisons in EVAL will only need the precomputed hash. +bool equal_forms(MalType, MalType); +extern MalType SYMBOL_AMPERSAND; +extern MalType SYMBOL_CATCH; +extern MalType SYMBOL_CONCAT; +extern MalType SYMBOL_CONS; +extern MalType SYMBOL_DEBUG_EVAL; +extern MalType SYMBOL_DEF; +extern MalType SYMBOL_DEFMACRO; +extern MalType SYMBOL_DEREF; +extern MalType SYMBOL_DO; +extern MalType SYMBOL_FN; +extern MalType SYMBOL_IF; +extern MalType SYMBOL_LET; +extern MalType SYMBOL_QUASIQUOTE; +extern MalType SYMBOL_QUOTE; +extern MalType SYMBOL_SPLICE_UNQUOTE; +extern MalType SYMBOL_TRY; +extern MalType SYMBOL_UNQUOTE; +extern MalType SYMBOL_VEC; +extern MalType SYMBOL_WITH_META; + +void types_init(); + +// Evil trick for FFI. +// Should at least be const void*. +void* mal_type_value_address(MalType); + +#endif diff --git a/impls/c.2/vector.c b/impls/c.2/vector.c new file mode 100644 index 0000000000..7b93821fd2 --- /dev/null +++ b/impls/c.2/vector.c @@ -0,0 +1,67 @@ +#include + +#include + +#include "linked_list.h" +#include "vector.h" + +struct vector* vector_new(size_t capacity) { + struct vector* v = GC_MALLOC(sizeof(*v) + capacity*sizeof(MalType)); + v->count = 0; + return v; +} + +void vector_append(size_t* capacity, struct vector** v, MalType new_item) { + if ((*v)->count == *capacity) { + // + 1 in case capacity is 0. + *capacity = (*capacity + 1) << 1; + *v = GC_REALLOC(*v, sizeof(**v) + *capacity * sizeof(MalType)); + } + (*v)->nth[(*v)->count++] = new_item; +} + +seq_cursor seq_iter(MalType container) { + list l; + if (is_list(container, &l)) { + return (seq_cursor){.l=l}; + } + else { + assert(type(container) == MALTYPE_VECTOR); + return (seq_cursor){.i=0}; + } +} + +bool seq_cont(MalType container, seq_cursor position) { + assert(type(container) & (MALTYPE_LIST | MALTYPE_VECTOR)); + vector_t v; + if ((v = is_vector(container))) { + return position.i < v->count; + } + else { + return position.l != NULL; + } +} + +seq_cursor seq_next(MalType container, seq_cursor position) { + assert(type(container) & (MALTYPE_LIST | MALTYPE_VECTOR)); + vector_t v; + if ((v = is_vector(container))) { + assert(position.i < v->count); + return (seq_cursor){.i=position.i + 1}; + } + else { + return (seq_cursor){.l=position.l->next}; + } +} + +MalType seq_item(MalType container, seq_cursor position) { + assert(type(container) & (MALTYPE_LIST | MALTYPE_VECTOR)); + vector_t v; + if ((v = is_vector(container))) { + assert(position.i < v->count); + return v->nth[position.i]; + } + else { + return position.l->data; + } +} diff --git a/impls/c.2/vector.h b/impls/c.2/vector.h new file mode 100644 index 0000000000..854c6c52a7 --- /dev/null +++ b/impls/c.2/vector.h @@ -0,0 +1,32 @@ +#ifndef MAL_VECTOR_H +#define MAL_VECTOR_H + +#include + +#include "types.h" +// typedef const struct vector* vector_t; + +struct vector { + size_t count; + MalType nth[]; +}; + +struct vector* vector_new(size_t capacity); +// The capacity first additions cause no reallocation. + +void vector_append(size_t* capacity, struct vector** v, MalType new_item); + +// Convenient way to iterate either on a list or a vector. +// The same (unmodified) container must be be provided to each +// function during iteration. +// It must be a list or a vector. +typedef union seq_cursor { + list l; + size_t i; +} seq_cursor; +seq_cursor seq_iter(MalType); +bool seq_cont(MalType, seq_cursor); +seq_cursor seq_next(MalType, seq_cursor); +MalType seq_item(MalType, seq_cursor); + +#endif diff --git a/impls/c/Dockerfile b/impls/c/Dockerfile new file mode 100644 index 0000000000..39ddd95eda --- /dev/null +++ b/impls/c/Dockerfile @@ -0,0 +1,28 @@ +FROM ubuntu:vivid +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Install g++ for any C/C++ based implementations +RUN apt-get -y install g++ + +# Libraries needed for the C impl +RUN apt-get -y install libglib2.0 libglib2.0-dev libffi-dev libgc-dev diff --git a/impls/c/Makefile b/impls/c/Makefile new file mode 100644 index 0000000000..56c2e5934c --- /dev/null +++ b/impls/c/Makefile @@ -0,0 +1,61 @@ +USE_READLINE ?= +USE_GC ?= 1 +CFLAGS ?= -g -O2 +LDFLAGS ?= -g + +##################### + +SRCS = step0_repl.c step1_read_print.c step2_eval.c step3_env.c \ + step4_if_fn_do.c step5_tco.c step6_file.c step7_quote.c \ + step8_macros.c step9_try.c stepA_mal.c +OBJS = $(SRCS:%.c=%.o) +BINS = $(OBJS:%.o=%) +OTHER_OBJS = types.o readline.o reader.o printer.o env.o core.o interop.o +OTHER_HDRS = types.h readline.h reader.h printer.h core.h interop.h + +GLIB_CFLAGS ?= $(shell pkg-config --cflags glib-2.0) +GLIB_LDFLAGS ?= $(shell pkg-config --libs glib-2.0) + +FFI_CFLAGS ?= $(shell pkg-config libffi --cflags) +FFI_LDFLAGS ?= $(shell pkg-config libffi --libs) + +ifeq ($(shell uname -s),Darwin) + darwin_CPPFLAGS ?= -DOSX=1 +endif + +ifeq (,$(USE_READLINE)) +RL_LIBRARY ?= edit +else +RL_LIBRARY ?= readline + rl_CFLAGS ?= -DUSE_READLINE=1 +endif + +ifneq (,$(USE_GC)) + gc_CFLAGS ?= -DUSE_GC=1 + gc_LIBS ?= -lgc +endif + +# Rewrite CPPFLAGS for the Make recipes, but let existing user options +# take precedence. +override CPPFLAGS := \ + ${darwin_CPPFLAGS} ${rl_CFLAGS} ${gc_CFLAGS} ${GLIB_CFLAGS} ${FFI_CFLAGS} \ + ${CPPFLAGS} +override LDLIBS += \ + ${gc_LIBS} -l${RL_LIBRARY} ${GLIB_LDFLAGS} ${FFI_LDFLAGS} -ldl + +##################### + +all: $(BINS) + +dist: mal + +mal: $(word $(words $(BINS)),$(BINS)) + cp $< $@ + +$(OBJS) $(OTHER_OBJS): %.o: %.c $(OTHER_HDRS) + +$(patsubst %.o,%,$(filter step%,$(OBJS))): $(OTHER_OBJS) +$(BINS): %: %.o + +clean: + rm -f $(OBJS) $(BINS) $(OTHER_OBJS) mal diff --git a/impls/c/core.c b/impls/c/core.c new file mode 100644 index 0000000000..72a4a59393 --- /dev/null +++ b/impls/c/core.c @@ -0,0 +1,594 @@ +#include +#include +#include +#include +#include +#include +#include +#include + +#include "types.h" +#include "core.h" +#include "reader.h" +#include "printer.h" + +// Errors/Exceptions +void throw(MalVal *obj) { + mal_error = obj; +} + + +// General functions + +MalVal *equal_Q(MalVal *a, MalVal *b) { + if (_equal_Q(a, b)) { return &mal_true; } + else { return &mal_false; } +} + + +// Misc predicates + +MalVal *nil_Q(MalVal *seq) { return seq->type & MAL_NIL ? &mal_true : &mal_false; } +MalVal *true_Q(MalVal *seq) { return seq->type & MAL_TRUE ? &mal_true : &mal_false; } +MalVal *false_Q(MalVal *seq) { return seq->type & MAL_FALSE ? &mal_true : &mal_false; } +MalVal *string_Q(MalVal *seq) { + if ((seq->type & MAL_STRING) && (seq->val.string[0] != '\x7f')) { + return &mal_true; + } else { + return &mal_false; + } +} +MalVal *number_Q(MalVal *obj) { + return obj->type & MAL_INTEGER || obj->type & MAL_FLOAT + ? &mal_true + : &mal_false; +} +MalVal *fn_Q(MalVal *obj) { + return (obj->type & MAL_FUNCTION_C || obj->type & MAL_FUNCTION_MAL) && + !obj->ismacro + ? &mal_true + : &mal_false; +} +MalVal *macro_Q(MalVal *obj) { return obj->ismacro ? &mal_true : &mal_false; } + + + +// Symbol functions + +MalVal *symbol(MalVal *args) { + assert_type(args, MAL_STRING, + "symbol called with non-string value"); + args->type = MAL_SYMBOL; // change string to symbol + return args; +} + +MalVal *symbol_Q(MalVal *seq) { + return seq->type & MAL_SYMBOL ? &mal_true : &mal_false; } + + +// Keyword functions + +MalVal *keyword(MalVal *args) { + assert_type(args, MAL_STRING, + "keyword called with non-string value"); + if (args->val.string[0] == '\x7f') { + return args; + } else { + return malval_new_keyword(args->val.string); + } +} + +MalVal *keyword_Q(MalVal *seq) { + return seq->type & MAL_STRING && seq->val.string[0] == '\x7f' + ? &mal_true + : &mal_false; +} + + +// String functions + +// Return a string representation of a MalVal sequence (in a format that can +// be read by the reader). Returned string must be freed by caller. +MalVal *pr_str(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "pr_str called with non-sequential args"); + return malval_new_string(_pr_str_args(args, " ", 1)); +} + +// Return a string representation of a MalVal sequence with every item +// concatenated together. Returned string must be freed by caller. +MalVal *str(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "str called with non-sequential args"); + return malval_new_string(_pr_str_args(args, "", 0)); +} + +// Print a string representation of a MalVal sequence (in a format that can +// be read by the reader) followed by a newline. Returns nil. +MalVal *prn(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "prn called with non-sequential args"); + char *repr = _pr_str_args(args, " ", 1); + puts(repr); + MAL_GC_FREE(repr); + return &mal_nil; +} + +// Print a string representation of a MalVal sequence (for human consumption) +// followed by a newline. Returns nil. +MalVal *println(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "println called with non-sequential args"); + char *repr = _pr_str_args(args, " ", 0); + puts(repr); + MAL_GC_FREE(repr); + return &mal_nil; +} + +MalVal *mal_readline(MalVal *str) { + assert_type(str, MAL_STRING, "readline of non-string"); + char * line = _readline(str->val.string); + if (line) { return malval_new_string(line); } + else { return &mal_nil; } +} + +MalVal *read_string(MalVal *str) { + assert_type(str, MAL_STRING, "read_string of non-string"); + return read_str(str->val.string); +} + +char *slurp_raw(char *path) { + char *data; + struct stat fst; + int fd = open(path, O_RDONLY), + sz; + if (fd < 0) { + abort("slurp failed to open '%s'", path); + } + if (fstat(fd, &fst) < 0) { + abort("slurp failed to stat '%s'", path); + } + data = MAL_GC_MALLOC(fst.st_size+1); + sz = read(fd, data, fst.st_size); + if (sz < fst.st_size) { + abort("slurp failed to read '%s'", path); + } + data[sz] = '\0'; + return data; +} +MalVal *slurp(MalVal *path) { + assert_type(path, MAL_STRING, "slurp of non-string"); + char *data = slurp_raw(path->val.string); + if (!data || mal_error) { return NULL; } + return malval_new_string(data); +} + + + + +// Number functions + +WRAP_INTEGER_OP(plus,+) +WRAP_INTEGER_OP(minus,-) +WRAP_INTEGER_OP(multiply,*) +WRAP_INTEGER_OP(divide,/) +WRAP_INTEGER_CMP_OP(gt,>) +WRAP_INTEGER_CMP_OP(gte,>=) +WRAP_INTEGER_CMP_OP(lt,<) +WRAP_INTEGER_CMP_OP(lte,<=) + +MalVal *time_ms(MalVal *_) { + struct timeval tv; + long msecs; + gettimeofday(&tv, NULL); + msecs = tv.tv_sec * 1000 + tv.tv_usec/1000.0 + 0.5; + + return malval_new_integer(msecs); +} + + +// List functions + +MalVal *list(MalVal *args) { return _list(args); } +MalVal *list_Q(MalVal *seq) { return _list_Q(seq) ? &mal_true : &mal_false; } + + +// Vector functions + +MalVal *vector(MalVal *args) { return _vector(args); } +MalVal *vector_Q(MalVal *seq) { return _vector_Q(seq) ? &mal_true : &mal_false; } + + +// Hash map functions + +MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; } + +MalVal *assoc(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "assoc called with non-sequential arguments"); + assert(_count(args) >= 2, + "assoc needs at least 2 arguments"); + GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table); + MalVal *hm = malval_new_hash_map(htable); + return _assoc_BANG(hm, _rest(args)); +} + +MalVal *dissoc(MalVal* args) { + GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table); + MalVal *hm = malval_new_hash_map(htable); + return _dissoc_BANG(hm, _rest(args)); +} + +MalVal *keys(MalVal *obj) { + assert_type(obj, MAL_HASH_MAP, + "keys called on non-hash-map"); + + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(obj))); + g_hash_table_iter_init (&iter, obj->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + } + return seq; +} + +MalVal *vals(MalVal *obj) { + assert_type(obj, MAL_HASH_MAP, + "vals called on non-hash-map"); + + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(obj))); + g_hash_table_iter_init (&iter, obj->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + g_array_append_val(seq->val.array, value); + } + return seq; +} + + +// hash map and vector functions +MalVal *get(MalVal *obj, MalVal *key) { + MalVal *val; + switch (obj->type) { + case MAL_VECTOR: + return _nth(obj, key->val.intnum); + case MAL_HASH_MAP: + if (g_hash_table_lookup_extended(obj->val.hash_table, + key->val.string, + NULL, (gpointer*)&val)) { + return val; + } else { + return &mal_nil; + } + case MAL_NIL: + return &mal_nil; + default: + abort("get called on unsupported type %d", obj->type); + } +} + +MalVal *contains_Q(MalVal *obj, MalVal *key) { + switch (obj->type) { + case MAL_VECTOR: + if (key->val.intnum < obj->val.array->len) { + return &mal_true; + } else { + return &mal_false; + } + case MAL_HASH_MAP: + if (g_hash_table_contains(obj->val.hash_table, key->val.string)) { + return &mal_true; + } else { + return &mal_false; + } + default: + abort("contains? called on unsupported type %d", obj->type); + } +} + + +// Sequence functions + +MalVal *sequential_Q(MalVal *seq) { + return _sequential_Q(seq) ? &mal_true : &mal_false; +} + +MalVal *cons(MalVal *x, MalVal *seq) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "second argument to cons is non-sequential"); + int i, len = _count(seq); + GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + len+1); + g_array_append_val(new_arr, x); + for (i=0; ival.array, MalVal*, i)); + } + return malval_new_list(MAL_LIST, new_arr); +} + +MalVal *concat(MalVal *args) { + MalVal *arg, *e, *lst; + int i, j, arg_cnt = _count(args); + lst = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), arg_cnt)); + for (i=0; ival.array, MalVal*, i); + assert_type(arg, MAL_LIST|MAL_VECTOR, + "concat called with non-sequential"); + for (j=0; j<_count(arg); j++) { + e = g_array_index(arg->val.array, MalVal*, j); + g_array_append_val(lst->val.array, e); + } + } + return lst; +} + +MalVal *vec(MalVal *seq) { + switch(seq->type) { + case MAL_VECTOR: + return seq; + case MAL_LIST: { + const GArray * const src = seq->val.array; + const int len = src->len; + GArray * const dst = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len); + int i; + for (i=0; ival.array, MalVal*, i)); + return malval_new_list(MAL_VECTOR, dst); + } + default: + _error("vec called with non-sequential"); + } +} + +MalVal *nth(MalVal *seq, MalVal *idx) { + return _nth(seq, idx->val.intnum); +} + +MalVal *empty_Q(MalVal *seq) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "empty? called with non-sequential"); + return (seq->val.array->len == 0) ? &mal_true : &mal_false; +} + +MalVal *count(MalVal *seq) { + return malval_new_integer(_count(seq)); +} + +MalVal *apply(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "apply called with non-sequential"); + MalVal *f = _nth(args, 0); + MalVal *last_arg = _last(args); + assert_type(last_arg, MAL_LIST|MAL_VECTOR, + "last argument to apply is non-sequential"); + int i, len = _count(args) - 2 + _count(last_arg); + GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + len); + // Initial arguments + for (i=1; i<_count(args)-1; i++) { + g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); + } + // Add arguments from last_arg + for (i=0; i<_count(last_arg); i++) { + g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i)); + } + return _apply(f, malval_new_list(MAL_LIST, new_arr)); +} + +MalVal *map(MalVal *mvf, MalVal *lst) { + MalVal *res, *el; + assert_type(mvf, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "map called with non-function"); + assert_type(lst, MAL_LIST|MAL_VECTOR, + "map called with non-sequential"); + int i, len = _count(lst); + el = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); + for (i=0; itype & MAL_FUNCTION_MAL) { + Env *fn_env = new_env(mvf->val.func.env, + mvf->val.func.args, + _slice(lst, i, i+1)); + res = mvf->val.func.evaluator(mvf->val.func.body, fn_env); + } else { + res = mvf->val.f1(g_array_index(lst->val.array, MalVal*, i)); + } + if (!res || mal_error) return NULL; + g_array_append_val(el->val.array, res); + } + return el; +} + +MalVal *sconj(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "conj called with non-sequential"); + MalVal *src_lst = _nth(args, 0); + assert_type(args, MAL_LIST|MAL_VECTOR, + "first argument to conj is non-sequential"); + int i, len = _count(src_lst) + _count(args) - 1; + GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + len); + // Copy in src_lst + for (i=0; i<_count(src_lst); i++) { + g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i)); + } + // Conj extra args + for (i=1; i<_count(args); i++) { + if (src_lst->type & MAL_LIST) { + g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i)); + } else { + g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); + } + } + return malval_new_list(src_lst->type, new_arr); +} + +MalVal *seq(MalVal *obj) { + assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_STRING|MAL_NIL, + "seq: called with non-sequential"); + int cnt, i; + MalVal *lst, *mstr; + switch (obj->type) { + case MAL_LIST: + cnt = _count(obj); + if (cnt == 0) { return &mal_nil; } + return obj; + case MAL_VECTOR: + cnt = _count(obj); + if (cnt == 0) { return &mal_nil; } + lst = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), cnt)); + lst->val.array = obj->val.array; + return lst; + case MAL_STRING: + cnt = strlen(obj->val.string); + if (cnt == 0) { return &mal_nil; } + lst = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), cnt)); + for (i=0; ival.string[i])); + g_array_append_val(lst->val.array, mstr); + } + return lst; + case MAL_NIL: + return &mal_nil; + } +} + + +// Metadata functions + +MalVal *with_meta(MalVal *obj, MalVal *meta) { + MalVal *new_obj = malval_new(obj->type, meta); + new_obj->val = obj->val; + return new_obj; +} + +MalVal *meta(MalVal *obj) { + assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_HASH_MAP| + MAL_FUNCTION_C|MAL_FUNCTION_MAL|MAL_ATOM, + "attempt to get metadata from non-collection type"); + if (obj->metadata == NULL) { + return &mal_nil; + } else { + return obj->metadata; + } +} + + +// Atoms + +MalVal *atom(MalVal *val) { + return malval_new_atom(val); +} + +MalVal *atom_Q(MalVal *exp) { return _atom_Q(exp) ? &mal_true : &mal_false; } + +MalVal *deref(MalVal *atm) { + assert_type(atm, MAL_ATOM, + "deref called on non-atom"); + return atm->val.atom_val; +} + +MalVal *reset_BANG(MalVal *atm, MalVal *val) { + assert_type(atm, MAL_ATOM, + "reset! called with non-atom"); + atm->val.atom_val = val; + return val; +} + +MalVal *swap_BANG(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "swap! called with invalid arguments"); + assert(_count(args) >= 2, + "swap! called with %d args, needs at least 2", _count(args)); + MalVal *atm = _nth(args, 0), + *f = _nth(args, 1), + *sargs = _slice(args, 2, _count(args)), + *fargs = cons(atm->val.atom_val, sargs), + *new_val = _apply(f, fargs); + if (mal_error) { return NULL; } + atm->val.atom_val = new_val; + return new_val; +} + + + +core_ns_entry core_ns[] = { + {"=", (void*(*)(void*))equal_Q, 2}, + {"throw", (void*(*)(void*))throw, 1}, + {"nil?", (void*(*)(void*))nil_Q, 1}, + {"true?", (void*(*)(void*))true_Q, 1}, + {"false?", (void*(*)(void*))false_Q, 1}, + {"string?", (void*(*)(void*))string_Q, 1}, + {"symbol", (void*(*)(void*))symbol, 1}, + {"symbol?", (void*(*)(void*))symbol_Q, 1}, + {"keyword", (void*(*)(void*))keyword, 1}, + {"keyword?", (void*(*)(void*))keyword_Q, 1}, + {"number?", (void*(*)(void*))number_Q, 1}, + {"fn?", (void*(*)(void*))fn_Q, 1}, + {"macro?", (void*(*)(void*))macro_Q, 1}, + + {"pr-str", (void*(*)(void*))pr_str, -1}, + {"str", (void*(*)(void*))str, -1}, + {"prn", (void*(*)(void*))prn, -1}, + {"println", (void*(*)(void*))println, -1}, + {"readline", (void*(*)(void*))mal_readline, 1}, + {"read-string", (void*(*)(void*))read_string, 1}, + {"slurp", (void*(*)(void*))slurp, 1}, + {"<", (void*(*)(void*))int_lt, 2}, + {"<=", (void*(*)(void*))int_lte, 2}, + {">", (void*(*)(void*))int_gt, 2}, + {">=", (void*(*)(void*))int_gte, 2}, + {"+", (void*(*)(void*))int_plus, 2}, + {"-", (void*(*)(void*))int_minus, 2}, + {"*", (void*(*)(void*))int_multiply, 2}, + {"/", (void*(*)(void*))int_divide, 2}, + {"time-ms", (void*(*)(void*))time_ms, 0}, + + {"list", (void*(*)(void*))list, -1}, + {"list?", (void*(*)(void*))list_Q, 1}, + {"vector", (void*(*)(void*))vector, -1}, + {"vector?", (void*(*)(void*))vector_Q, 1}, + {"hash-map", (void*(*)(void*))_hash_map, -1}, + {"map?", (void*(*)(void*))hash_map_Q, 1}, + {"assoc", (void*(*)(void*))assoc, -1}, + {"dissoc", (void*(*)(void*))dissoc, -1}, + {"get", (void*(*)(void*))get, 2}, + {"contains?", (void*(*)(void*))contains_Q, 2}, + {"keys", (void*(*)(void*))keys, 1}, + {"vals", (void*(*)(void*))vals, 1}, + + {"sequential?", (void*(*)(void*))sequential_Q, 1}, + {"cons", (void*(*)(void*))cons, 2}, + {"concat", (void*(*)(void*))concat, -1}, + {"vec", (void*(*)(void*))vec, 1}, + {"nth", (void*(*)(void*))nth, 2}, + {"first", (void*(*)(void*))_first, 1}, + {"rest", (void*(*)(void*))_rest, 1}, + {"last", (void*(*)(void*))_last, 1}, + {"empty?", (void*(*)(void*))empty_Q, 1}, + {"count", (void*(*)(void*))count, 1}, + {"apply", (void*(*)(void*))apply, -1}, + {"map", (void*(*)(void*))map, 2}, + + {"conj", (void*(*)(void*))sconj, -1}, + {"seq", (void*(*)(void*))seq, 1}, + + {"with-meta", (void*(*)(void*))with_meta, 2}, + {"meta", (void*(*)(void*))meta, 1}, + {"atom", (void*(*)(void*))atom, 1}, + {"atom?", (void*(*)(void*))atom_Q, 1}, + {"deref", (void*(*)(void*))deref, 1}, + {"reset!", (void*(*)(void*))reset_BANG, 2}, + {"swap!", (void*(*)(void*))swap_BANG, -1}, + }; diff --git a/impls/c/core.h b/impls/c/core.h new file mode 100644 index 0000000000..2e871d6eb5 --- /dev/null +++ b/impls/c/core.h @@ -0,0 +1,15 @@ +#ifndef __MAL_CORE__ +#define __MAL_CORE__ + +#include + +// namespace of type functions +typedef struct { + char *name; + void *(*func)(void*); + int arg_cnt; +} core_ns_entry; + +extern core_ns_entry core_ns[62]; + +#endif diff --git a/impls/c/env.c b/impls/c/env.c new file mode 100644 index 0000000000..b0204280aa --- /dev/null +++ b/impls/c/env.c @@ -0,0 +1,51 @@ +#include +#include "types.h" + +// Env + +Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { + Env *e = MAL_GC_MALLOC(sizeof(Env)); + e->table = g_hash_table_new(g_str_hash, g_str_equal); + e->outer = outer; + + if (binds && exprs) { + assert_type(binds, MAL_LIST|MAL_VECTOR, + "new_env called with non-sequential bindings"); + assert_type(exprs, MAL_LIST|MAL_VECTOR, + "new_env called with non-sequential expressions"); + int binds_len = _count(binds), + exprs_len = _count(exprs), + varargs = 0, i; + for (i=0; i exprs_len) { break; } + if (_nth(binds, i)->val.string[0] == '&') { + varargs = 1; + env_set(e, _nth(binds, i+1)->val.string, + _slice(exprs, i, _count(exprs))); + break; + } else { + env_set(e, _nth(binds, i)->val.string, _nth(exprs, i)); + } + } + assert(varargs || (binds_len == exprs_len), + "Arity mismatch: %d formal params vs %d actual params", + binds_len, exprs_len); + + } + return e; +} + +MalVal *env_get(Env *env, const char *key) { + MalVal *val = g_hash_table_lookup(env->table, key); + if (val) { + return val; + } else if (env->outer) { + return env_get(env->outer, key); + } else { + return NULL; + } +} + +void env_set(Env *env, char *key, MalVal *val) { + g_hash_table_insert(env->table, key, val); +} diff --git a/c/interop.c b/impls/c/interop.c similarity index 98% rename from c/interop.c rename to impls/c/interop.c index 276b99e42d..a1f6b00fc3 100644 --- a/c/interop.c +++ b/impls/c/interop.c @@ -1,11 +1,18 @@ +#include #include -#include +#if OSX + #include +#else + #include +#endif + #include "types.h" GHashTable *loaded_dls = NULL; int get_byte_size(char *type) { + return 0; } typedef struct Raw64 { diff --git a/c/interop.h b/impls/c/interop.h similarity index 100% rename from c/interop.h rename to impls/c/interop.h diff --git a/impls/c/printer.c b/impls/c/printer.c new file mode 100644 index 0000000000..339eff450a --- /dev/null +++ b/impls/c/printer.c @@ -0,0 +1,154 @@ +#include +#include +#include "types.h" +#include "printer.h" + +char *_pr_str_hash_map(MalVal *obj, int print_readably) { + int start = 1; + char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL, + *key2 = NULL; + GHashTableIter iter; + gpointer key, value; + + repr = g_strdup_printf("{"); + + g_hash_table_iter_init (&iter, obj->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + //g_print ("%s/%p ", (const char *) key, (void *) value); + if (((char*)key)[0] == '\x7f') { + key2 = g_strdup_printf("%s", (char*)key); + key2[0] = ':'; + } else { + key2 = g_strdup_printf("\"%s\"", (char*)key); + } + + repr_tmp1 = _pr_str((MalVal*)value, print_readably); + if (start) { + start = 0; + repr = g_strdup_printf("{%s %s", (char*)key2, repr_tmp1); + } else { + repr_tmp2 = repr; + repr = g_strdup_printf("%s %s %s", repr_tmp2, (char*)key2, repr_tmp1); + MAL_GC_FREE(repr_tmp2); + } + MAL_GC_FREE(repr_tmp1); + } + repr_tmp2 = repr; + repr = g_strdup_printf("%s}", repr_tmp2); + MAL_GC_FREE(repr_tmp2); + return repr; +} + +char *_pr_str_list(MalVal *obj, int print_readably, char start, char end) { + int i; + char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL; + repr = g_strdup_printf("%c", start); + for (i=0; i<_count(obj); i++) { + repr_tmp1 = _pr_str(g_array_index(obj->val.array, MalVal*, i), + print_readably); + if (i == 0) { + repr = g_strdup_printf("%c%s", start, repr_tmp1); + } else { + repr_tmp2 = repr; + repr = g_strdup_printf("%s %s", repr_tmp2, repr_tmp1); + MAL_GC_FREE(repr_tmp2); + } + MAL_GC_FREE(repr_tmp1); + } + repr_tmp2 = repr; + repr = g_strdup_printf("%s%c", repr_tmp2, end); + MAL_GC_FREE(repr_tmp2); + return repr; +} + +// Return a string representation of the MalVal object. Returned string must +// be freed by caller. +char *_pr_str(MalVal *obj, int print_readably) { + char *repr = NULL; + if (obj == NULL) { return NULL; } + switch (obj->type) { + case MAL_NIL: + repr = g_strdup_printf("nil"); + break; + case MAL_TRUE: + repr = g_strdup_printf("true"); + break; + case MAL_FALSE: + repr = g_strdup_printf("false"); + break; + case MAL_STRING: + if (obj->val.string[0] == '\x7f') { + // Keyword + repr = g_strdup_printf("%s", obj->val.string); + repr[0] = ':'; + } else if (print_readably) { + char *repr_tmp = g_strescape(obj->val.string, ""); + repr = g_strdup_printf("\"%s\"", repr_tmp); + MAL_GC_FREE(repr_tmp); + } else { + repr = g_strdup_printf("%s", obj->val.string); + } + break; + case MAL_SYMBOL: + repr = g_strdup_printf("%s", obj->val.string); + break; + case MAL_INTEGER: + repr = g_strdup_printf("%" G_GINT64_FORMAT, obj->val.intnum); + break; + case MAL_FLOAT: + repr = g_strdup_printf("%f", obj->val.floatnum); + break; + case MAL_HASH_MAP: + repr = _pr_str_hash_map(obj, print_readably); + break; + case MAL_LIST: + repr = _pr_str_list(obj, print_readably, '(', ')'); + break; + case MAL_VECTOR: + repr = _pr_str_list(obj, print_readably, '[', ']'); + break; + case MAL_ATOM: + repr = g_strdup_printf("(atom %s)", + _pr_str(obj->val.atom_val, print_readably)); + break; + case MAL_FUNCTION_C: + repr = g_strdup_printf("#", obj->val.f0); + break; + case MAL_FUNCTION_MAL: + repr = g_strdup_printf("#", + _pr_str(obj->val.func.args, print_readably), + _pr_str(obj->val.func.body, print_readably)); + break; + default: + printf("pr_str unknown type %d\n", obj->type); + repr = g_strdup_printf(""); + } + return repr; +} + +// Return a string representation of the MalVal arguments. Returned string must +// be freed by caller. +char *_pr_str_args(MalVal *args, char *sep, int print_readably) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "_pr_str called with non-sequential args"); + int i; + char *repr = g_strdup_printf("%s", ""), + *repr2 = NULL; + for (i=0; i<_count(args); i++) { + MalVal *obj = g_array_index(args->val.array, MalVal*, i); + if (i != 0) { + repr2 = repr; + repr = g_strdup_printf("%s%s", repr2, sep); + MAL_GC_FREE(repr2); + } + repr2 = repr; + repr = g_strdup_printf("%s%s", + repr2, _pr_str(obj, print_readably)); + MAL_GC_FREE(repr2); + } + char* res = MAL_GC_STRDUP(repr); + MAL_GC_FREE(repr); + // TODO - check why STRDUP was needed here + return res; +} + diff --git a/c/printer.h b/impls/c/printer.h similarity index 100% rename from c/printer.h rename to impls/c/printer.h diff --git a/impls/c/reader.c b/impls/c/reader.c new file mode 100644 index 0000000000..588246ca3c --- /dev/null +++ b/impls/c/reader.c @@ -0,0 +1,261 @@ +#include +#include +#include + +//#include +//#include +#include + +#include "types.h" +#include "reader.h" + +// Declare +MalVal *read_form(Reader *reader); + +Reader *reader_new() { + Reader *reader = (Reader*)MAL_GC_MALLOC(sizeof(Reader)); + reader->array = g_array_sized_new(TRUE, FALSE, sizeof(char *), 8); + reader->position = 0; + return reader; +} + +int reader_append(Reader *reader, char* token) { + g_array_append_val(reader->array, token); + return TRUE; +} + +char *reader_peek(Reader *reader) { + return g_array_index(reader->array, char*, reader->position); +} + +char *reader_next(Reader *reader) { + if (reader->position >= reader->array->len) { + return NULL; + } else { + return g_array_index(reader->array, char*, reader->position++); + } +} + +void reader_free(Reader *reader) { + int i; + for(i=0; i < reader->array->len; i++) { + MAL_GC_FREE(g_array_index(reader->array, char*, i)); + } + g_array_free(reader->array, TRUE); + MAL_GC_FREE(reader); +} + +Reader *tokenize(char *line) { + GRegex *regex; + GMatchInfo *matchInfo; + GError *err = NULL; + + Reader *reader = reader_new(); + + regex = g_regex_new ("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)", 0, 0, &err); + g_regex_match (regex, line, 0, &matchInfo); + + if (err != NULL) { + fprintf(stderr, "Tokenize error: %s\n", err->message); + return NULL; + } + + while (g_match_info_matches(matchInfo)) { + gchar *result = g_match_info_fetch(matchInfo, 1); + if (result[0] != '\0' && result[0] != ';') { + reader_append(reader, result); + } + g_match_info_next(matchInfo, &err); + } + g_match_info_free(matchInfo); + g_regex_unref(regex); + if (reader->array->len == 0) { + reader_free(reader); + return NULL; + } else { + return reader; + } +} + + +MalVal *read_atom(Reader *reader) { + char *token; + GRegex *regex; + GMatchInfo *matchInfo; + GError *err = NULL; + gint pos; + MalVal *atom; + + token = reader_next(reader); + //g_print("read_atom token: %s\n", token); + + regex = g_regex_new ("(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"((?:[\\\\].|[^\\\\\"])*)\"$|^\"(.*)\"?$|:(.*)|(^[^\"]*$)", 0, 0, &err); + g_regex_match (regex, token, 0, &matchInfo); + + if (g_match_info_fetch_pos(matchInfo, 1, &pos, NULL) && pos != -1) { + //g_print("read_atom integer\n"); + atom = malval_new_integer(g_ascii_strtoll(token, NULL, 10)); + } else if (g_match_info_fetch_pos(matchInfo, 2, &pos, NULL) && pos != -1) { + //g_print("read_atom float\n"); + atom = malval_new_float(g_ascii_strtod(token, NULL)); + } else if (g_match_info_fetch_pos(matchInfo, 3, &pos, NULL) && pos != -1) { + //g_print("read_atom nil\n"); + atom = &mal_nil; + } else if (g_match_info_fetch_pos(matchInfo, 4, &pos, NULL) && pos != -1) { + //g_print("read_atom true\n"); + atom = &mal_true; + } else if (g_match_info_fetch_pos(matchInfo, 5, &pos, NULL) && pos != -1) { + //g_print("read_atom false\n"); + atom = &mal_false; + } else if (g_match_info_fetch_pos(matchInfo, 6, &pos, NULL) && pos != -1) { + //g_print("read_atom string: %s\n", token); + int end = strlen(token)-1; + token[end] = '\0'; + atom = malval_new_string(g_strcompress(g_match_info_fetch(matchInfo, 6))); + } else if (g_match_info_fetch_pos(matchInfo, 7, &pos, NULL) && pos != -1) { + abort("expected '\"', got EOF"); + } else if (g_match_info_fetch_pos(matchInfo, 8, &pos, NULL) && pos != -1) { + //g_print("read_atom keyword\n"); + atom = malval_new_keyword(MAL_GC_STRDUP(g_match_info_fetch(matchInfo, 8))); + } else if (g_match_info_fetch_pos(matchInfo, 9, &pos, NULL) && pos != -1) { + //g_print("read_atom symbol\n"); + atom = malval_new_symbol(MAL_GC_STRDUP(g_match_info_fetch(matchInfo, 9))); + } else { + malval_free(atom); + atom = NULL; + } + + return atom; +} + +MalVal *read_list(Reader *reader, MalType type, char start, char end) { + MalVal *ast, *form; + char *token = reader_next(reader); + //g_print("read_list start token: %s\n", token); + if (token[0] != start) { abort("expected '(', '[', or '{'"); } + + ast = malval_new_list(type, g_array_new(TRUE, TRUE, sizeof(MalVal*))); + + while ((token = reader_peek(reader)) && + token[0] != end) { + //g_print("read_list internal token %s\n", token); + form = read_form(reader); + if (!form) { + if (!mal_error) { abort("unknown read_list failure"); } + g_array_free(ast->val.array, TRUE); + malval_free(ast); + return NULL; + } + g_array_append_val(ast->val.array, form); + } + if (!token) { abort("expected ')', ']', or '}', got EOF"); } + reader_next(reader); + //g_print("read_list end token: %s\n", token); + return ast; +} + +MalVal *read_hash_map(Reader *reader) { + MalVal *lst = read_list(reader, MAL_LIST, '{', '}'); + if (!lst) { return NULL; } + MalVal *hm = _hash_map(lst); + malval_free(lst); + return hm; +} + + +MalVal *read_form(Reader *reader) { + char *token; + MalVal *form = NULL, *tmp; + +// while(token = reader_next(reader)) { +// printf("token: %s\n", token); +// } +// return NULL; + + token = reader_peek(reader); + + if (!token) { return NULL; } + //g_print("read_form token: %s\n", token); + + switch (token[0]) { + case ';': + abort("comments not yet implemented"); + break; + case '\'': + reader_next(reader); + form = _listX(2, malval_new_symbol("quote"), + read_form(reader)); + break; + case '`': + reader_next(reader); + form = _listX(2, malval_new_symbol("quasiquote"), + read_form(reader)); + break; + case '~': + reader_next(reader); + if (token[1] == '@') { + form = _listX(2, malval_new_symbol("splice-unquote"), + read_form(reader)); + } else { + form = _listX(2, malval_new_symbol("unquote"), + read_form(reader)); + }; + break; + case '^': + reader_next(reader); + MalVal *meta = read_form(reader); + form = _listX(3, malval_new_symbol("with-meta"), + read_form(reader), meta); + break; + case '@': + reader_next(reader); + form = _listX(2, malval_new_symbol("deref"), + read_form(reader)); + break; + + + // list + case ')': + abort("unexpected ')'"); + break; + case '(': + form = read_list(reader, MAL_LIST, '(', ')'); + break; + + // vector + case ']': + abort("unexpected ']'"); + break; + case '[': + form = read_list(reader, MAL_VECTOR, '[', ']'); + break; + + // hash-map + case '}': + abort("unexpected '}'"); + break; + case '{': + form = read_hash_map(reader); + break; + + default: + form = read_atom(reader); + break; + } + return form; + +} + +MalVal *read_str (char *str) { + Reader *reader; + char *token; + MalVal *ast = NULL; + + reader = tokenize(str); + if (reader) { + ast = read_form(reader); + reader_free(reader); + } + + return ast; +} diff --git a/c/reader.h b/impls/c/reader.h similarity index 100% rename from c/reader.h rename to impls/c/reader.h diff --git a/impls/c/readline.c b/impls/c/readline.c new file mode 100644 index 0000000000..3594a1a0db --- /dev/null +++ b/impls/c/readline.c @@ -0,0 +1,75 @@ +#include +#include +#include + +#if USE_READLINE + #include + #include + #include +#else + #include +#endif + +int history_loaded = 0; + +char HISTORY_FILE[] = "~/.mal-history"; + +void load_history() { + if (history_loaded) { return; } + int ret; + char *hf = tilde_expand(HISTORY_FILE); + if (access(hf, F_OK) != -1) { + // TODO: check if file exists first, use non-static path +#if USE_READLINE + ret = read_history(hf); +#else + FILE *fp = fopen(hf, "r"); + char *line = malloc(80); // getline reallocs as necessary + size_t sz = 80; + while ((ret = getline(&line, &sz, fp)) > 0) { + add_history(line); // Add line to in-memory history + } + free(line); + fclose(fp); +#endif + history_loaded = 1; + } + free(hf); +} + +void append_to_history() { + char *hf = tilde_expand(HISTORY_FILE); +#ifdef USE_READLINE + append_history(1, hf); +#else +#if defined(RL_READLINE_VERSION) + HIST_ENTRY *he = history_get(history_base+history_length-1); +#else + // libedit-2 segfaults if we add history_base + HIST_ENTRY *he = history_get(history_length-1); +#endif + FILE *fp = fopen(hf, "a"); + if (fp) { + fprintf(fp, "%s\n", he->line); + fclose(fp); + } +#endif + free(hf); +} + + +// line must be freed by caller +char *_readline (char prompt[]) { + char *line; + + load_history(); + + line = readline(prompt); + if (!line) return NULL; // EOF + add_history(line); // Add input to in-memory history + + append_to_history(); // Flush new line of history to disk + + return line; +} + diff --git a/c/readline.h b/impls/c/readline.h similarity index 100% rename from c/readline.h rename to impls/c/readline.h diff --git a/impls/c/run b/impls/c/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/c/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/c/step0_repl.c b/impls/c/step0_repl.c new file mode 100644 index 0000000000..ddb7f6e2b7 --- /dev/null +++ b/impls/c/step0_repl.c @@ -0,0 +1,44 @@ +#include +#include +#include + +#ifdef USE_READLINE + #include + #include +#else + #include +#endif + +char *READ(char prompt[]) { + char *line; + line = readline(prompt); + if (!line) return NULL; // EOF + add_history(line); // Add input to history. + return line; +} + +char *EVAL(char *ast, void *env) { + return ast; +} + +char *PRINT(char *exp) { + return exp; +} + +int main() +{ + char *ast, *exp; + char prompt[100]; + + // Set the initial prompt + snprintf(prompt, sizeof(prompt), "user> "); + + for(;;) { + ast = READ(prompt); + if (!ast) return 0; + exp = EVAL(ast, NULL); + puts(PRINT(exp)); + + free(ast); // Free input string + } +} diff --git a/impls/c/step1_read_print.c b/impls/c/step1_read_print.c new file mode 100644 index 0000000000..cdc45cd441 --- /dev/null +++ b/impls/c/step1_read_print.c @@ -0,0 +1,86 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +MalVal *EVAL(MalVal *ast, GHashTable *env) { + if (!ast || mal_error) return NULL; + return ast; +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(GHashTable *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +int main() +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt + snprintf(prompt, sizeof(prompt), "user> "); + + // repl loop + for(;;) { + exp = RE(NULL, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step2_eval.c b/impls/c/step2_eval.c new file mode 100644 index 0000000000..b0b786e807 --- /dev/null +++ b/impls/c/step2_eval.c @@ -0,0 +1,151 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" + +// Declarations +MalVal *EVAL(MalVal *ast, GHashTable *env); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +MalVal *EVAL(MalVal *ast, GHashTable *env) { + if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + // TODO: check if not found + MalVal *res = g_hash_table_lookup(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + if (_count(ast) == 0) { return ast; } + MalVal *a0 = _nth(ast, 0); + assert_type(a0, MAL_SYMBOL, "Cannot invoke %s", _pr_str(a0,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) { return NULL; } + MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); + //g_print("eval_invoke el: %s\n", _pr_str(el,1)); + return f(_nth(el, 1), _nth(el, 2)); +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(GHashTable *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +GHashTable *repl_env; + +WRAP_INTEGER_OP(plus,+) +WRAP_INTEGER_OP(minus,-) +WRAP_INTEGER_OP(multiply,*) +WRAP_INTEGER_OP(divide,/) + +void init_repl_env() { + repl_env = g_hash_table_new(g_str_hash, g_str_equal); + + g_hash_table_insert(repl_env, "+", int_plus); + g_hash_table_insert(repl_env, "-", int_minus); + g_hash_table_insert(repl_env, "*", int_multiply); + g_hash_table_insert(repl_env, "/", int_divide); +} + +int main() +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(); + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step3_env.c b/impls/c/step3_env.c new file mode 100644 index 0000000000..30c63336fd --- /dev/null +++ b/impls/c/step3_env.c @@ -0,0 +1,183 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +MalVal *EVAL(MalVal *ast, Env *env) { + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); + int i, len; + if (_count(ast) == 0) { return ast; } + MalVal *a0 = _nth(ast, 0); + assert_type(a0, MAL_SYMBOL, "Cannot apply %s", _pr_str(a0,1)); + if (strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if (strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + return EVAL(a2, let_env); + } else { + //g_print("eval apply\n"); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) { return NULL; } + MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); + return f(_nth(el, 1), _nth(el, 2)); + } +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +WRAP_INTEGER_OP(plus,+) +WRAP_INTEGER_OP(minus,-) +WRAP_INTEGER_OP(multiply,*) +WRAP_INTEGER_OP(divide,/) + +void init_repl_env() { + repl_env = new_env(NULL, NULL, NULL); + + env_set(repl_env, "+", (MalVal *)int_plus); + env_set(repl_env, "-", (MalVal *)int_minus); + env_set(repl_env, "*", (MalVal *)int_multiply); + env_set(repl_env, "/", (MalVal *)int_divide); +} + +int main() +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(); + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step4_if_fn_do.c b/impls/c/step4_if_fn_do.c new file mode 100644 index 0000000000..6413a4e43d --- /dev/null +++ b/impls/c/step4_if_fn_do.c @@ -0,0 +1,220 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +MalVal *EVAL(MalVal *ast, Env *env) { + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); + int i, len; + if (_count(ast) == 0) { return ast; } + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + return EVAL(a2, let_env); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _rest(ast), env); + return _last(el); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + if (ast->val.array->len > 3) { + return EVAL(_nth(ast, 3), env); + } else { + return &mal_nil; + } + } else { + // eval true slot form + MalVal *a2 = _nth(ast, 2); + return EVAL(a2, env); + } + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) { return NULL; } + MalVal *f = _first(el), + *args = _rest(el); + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + return _apply(f, args); + } +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +void init_repl_env() { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); +} + +int main() +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(); + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step5_tco.c b/impls/c/step5_tco.c new file mode 100644 index 0000000000..26e9beb592 --- /dev/null +++ b/impls/c/step5_tco.c @@ -0,0 +1,233 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); + int i, len; + if (_count(ast) == 0) { return ast; } + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast) - 1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + if (ast->val.array->len > 3) { + ast = _nth(ast, 3); + } else { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) { return NULL; } + MalVal *f = _first(el), + *args = _rest(el); + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +void init_repl_env() { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); +} + +int main() +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(); + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step6_file.c b/impls/c/step6_file.c new file mode 100644 index 0000000000..7126ce525b --- /dev/null +++ b/impls/c/step6_file.c @@ -0,0 +1,252 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); + int i, len; + if (_count(ast) == 0) { return ast; } + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + if (ast->val.array->len > 3) { + ast = _nth(ast, 3); + } else { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) { return NULL; } + MalVal *f = _first(el), + *args = _rest(el); + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } + +void init_repl_env(int argc, char *argv[]) { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + env_set(repl_env, "eval", + malval_new_function((void*(*)(void *))do_eval, 1)); + + MalVal *_argv = _listX(0); + for (i=2; i < argc; i++) { + MalVal *arg = malval_new_string(argv[i]); + g_array_append_val(_argv->val.array, arg); + } + env_set(repl_env, "*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +} + +int main(int argc, char *argv[]) +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(argc, argv); + + if (argc > 1) { + char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); + RE(repl_env, "", cmd); + return 0; + } + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step7_quote.c b/impls/c/step7_quote.c new file mode 100644 index 0000000000..71dfc608c1 --- /dev/null +++ b/impls/c/step7_quote.c @@ -0,0 +1,300 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; +} + +MalVal *quasiquote(MalVal *ast) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) + return _nth(ast, 1); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; + } +} + +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); + int i, len; + if (_count(ast) == 0) { return ast; } + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quote", a0->val.string) == 0) { + //g_print("eval apply quote\n"); + return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquote", a0->val.string) == 0) { + //g_print("eval apply quasiquote\n"); + MalVal *a1 = _nth(ast, 1); + ast = quasiquote(a1); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + if (ast->val.array->len > 3) { + ast = _nth(ast, 3); + } else { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) { return NULL; } + MalVal *f = _first(el), + *args = _rest(el); + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } + +void init_repl_env(int argc, char *argv[]) { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + env_set(repl_env, "eval", + malval_new_function((void*(*)(void *))do_eval, 1)); + + MalVal *_argv = _listX(0); + for (i=2; i < argc; i++) { + MalVal *arg = malval_new_string(argv[i]); + g_array_append_val(_argv->val.array, arg); + } + env_set(repl_env, "*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +} + +int main(int argc, char *argv[]) +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(argc, argv); + + if (argc > 1) { + char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); + RE(repl_env, "", cmd); + return 0; + } + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step8_macros.c b/impls/c/step8_macros.c new file mode 100644 index 0000000000..2311b63be0 --- /dev/null +++ b/impls/c/step8_macros.c @@ -0,0 +1,319 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; +} + +MalVal *quasiquote(MalVal *ast) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) + return _nth(ast, 1); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; + } +} + +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + if (_count(ast) == 0) { return ast; } + + int i, len; + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quote", a0->val.string) == 0) { + //g_print("eval apply quote\n"); + return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquote", a0->val.string) == 0) { + //g_print("eval apply quasiquote\n"); + MalVal *a1 = _nth(ast, 1); + ast = quasiquote(a1); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("defmacro!", a0->val.string) == 0) { + //g_print("eval apply defmacro!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *old = EVAL(a2, env); + if (mal_error) return NULL; + MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); + res->val.func = old->val.func; + res->ismacro = TRUE; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + if (ast->val.array->len > 3) { + ast = _nth(ast, 3); + } else { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->ismacro = FALSE; + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _rest(ast); + if (f->ismacro) { + ast = _apply(f, rest); + continue; + } + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } + +void init_repl_env(int argc, char *argv[]) { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + env_set(repl_env, "eval", + malval_new_function((void*(*)(void *))do_eval, 1)); + + MalVal *_argv = _listX(0); + for (i=2; i < argc; i++) { + MalVal *arg = malval_new_string(argv[i]); + g_array_append_val(_argv->val.array, arg); + } + env_set(repl_env, "*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +} + +int main(int argc, char *argv[]) +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(argc, argv); + + if (argc > 1) { + char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); + RE(repl_env, "", cmd); + return 0; + } + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/step9_try.c b/impls/c/step9_try.c new file mode 100644 index 0000000000..9bdf356330 --- /dev/null +++ b/impls/c/step9_try.c @@ -0,0 +1,344 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" +#include "interop.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; +} + +MalVal *quasiquote(MalVal *ast) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) + return _nth(ast, 1); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; + } +} + +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + if (_count(ast) == 0) { return ast; } + + int i, len; + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quote", a0->val.string) == 0) { + //g_print("eval apply quote\n"); + return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquote", a0->val.string) == 0) { + //g_print("eval apply quasiquote\n"); + MalVal *a1 = _nth(ast, 1); + ast = quasiquote(a1); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("defmacro!", a0->val.string) == 0) { + //g_print("eval apply defmacro!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *old = EVAL(a2, env); + if (mal_error) return NULL; + MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); + res->val.func = old->val.func; + res->ismacro = TRUE; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("try*", a0->val.string) == 0) { + //g_print("eval apply try*\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *res = EVAL(a1, env); + if (ast->val.array->len < 3) { + return &mal_nil; + } + MalVal *a2 = _nth(ast, 2); + if (!mal_error) { return res; } + MalVal *a20 = _nth(a2, 0); + if (strcmp("catch*", a20->val.string) == 0) { + MalVal *a21 = _nth(a2, 1); + MalVal *a22 = _nth(a2, 2); + Env *catch_env = new_env(env, + _listX(1, a21), + _listX(1, mal_error)); + //malval_free(mal_error); + mal_error = NULL; + res = EVAL(a22, catch_env); + return res; + } else { + return &mal_nil; + } + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + if (ast->val.array->len > 3) { + ast = _nth(ast, 3); + } else { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->ismacro = FALSE; + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _rest(ast); + if (f->ismacro) { + ast = _apply(f, rest); + continue; + } + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } + +void init_repl_env(int argc, char *argv[]) { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + env_set(repl_env, "eval", + malval_new_function((void*(*)(void *))do_eval, 1)); + + MalVal *_argv = _listX(0); + for (i=2; i < argc; i++) { + MalVal *arg = malval_new_string(argv[i]); + g_array_append_val(_argv->val.array, arg); + } + env_set(repl_env, "*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +} + +int main(int argc, char *argv[]) +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(argc, argv); + + if (argc > 1) { + char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); + RE(repl_env, "", cmd); + return 0; + } + + // repl loop + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/stepA_mal.c b/impls/c/stepA_mal.c new file mode 100644 index 0000000000..95862d2a5c --- /dev/null +++ b/impls/c/stepA_mal.c @@ -0,0 +1,352 @@ +#include +#include +#include +#include + +#include "types.h" +#include "readline.h" +#include "reader.h" +#include "core.h" +#include "interop.h" + +// Declarations +MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); + +// read +MalVal *READ(char prompt[], char *str) { + char *line; + MalVal *ast; + if (str) { + line = str; + } else { + line = _readline(prompt); + if (!line) { + _error("EOF"); + return NULL; + } + } + ast = read_str(line); + if (!str) { MAL_GC_FREE(line); } + return ast; +} + +// eval +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; +} + +MalVal *quasiquote(MalVal *ast) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) + return _nth(ast, 1); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; + } +} + +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + + if (!ast || mal_error) return NULL; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); + } + + if (ast->type == MAL_SYMBOL) { + //g_print("EVAL symbol: %s\n", ast->val.string); + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { + //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); + if (!el || mal_error) return NULL; + el->type = ast->type; + return el; + } else if (ast->type == MAL_HASH_MAP) { + //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(ast))); + g_hash_table_iter_init (&iter, ast->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + MalVal *new_val = EVAL((MalVal *)value, env); + g_array_append_val(seq->val.array, new_val); + } + return _hash_map(seq); + } else { + //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); + return ast; + } + + // apply list + if (_count(ast) == 0) { return ast; } + + int i, len; + MalVal *a0 = _nth(ast, 0); + if ((a0->type & MAL_SYMBOL) && + strcmp("def!", a0->val.string) == 0) { + //g_print("eval apply def!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *res = EVAL(a2, env); + if (mal_error) return NULL; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp("let*", a0->val.string) == 0) { + //g_print("eval apply let*\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2), + *key, *val; + assert_type(a1, MAL_LIST|MAL_VECTOR, + "let* bindings must be list or vector"); + len = _count(a1); + assert((len % 2) == 0, "odd number of let* bindings forms"); + Env *let_env = new_env(env, NULL, NULL); + for(i=0; ival.array, MalVal*, i); + val = g_array_index(a1->val.array, MalVal*, i+1); + assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); + env_set(let_env, key->val.string, EVAL(val, let_env)); + } + ast = a2; + env = let_env; + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quote", a0->val.string) == 0) { + //g_print("eval apply quote\n"); + return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquote", a0->val.string) == 0) { + //g_print("eval apply quasiquote\n"); + MalVal *a1 = _nth(ast, 1); + ast = quasiquote(a1); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("defmacro!", a0->val.string) == 0) { + //g_print("eval apply defmacro!\n"); + MalVal *a1 = _nth(ast, 1), + *a2 = _nth(ast, 2); + MalVal *old = EVAL(a2, env); + if (mal_error) return NULL; + MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); + res->val.func = old->val.func; + res->ismacro = TRUE; + env_set(env, a1->val.string, res); + return res; + } else if ((a0->type & MAL_SYMBOL) && + strcmp(".", a0->val.string) == 0) { + //g_print("eval apply .\n"); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)), env); + if (!el || mal_error) return NULL; + return invoke_native(el); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("try*", a0->val.string) == 0) { + //g_print("eval apply try*\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *res = EVAL(a1, env); + if (ast->val.array->len < 3) { + return &mal_nil; + } + MalVal *a2 = _nth(ast, 2); + if (!mal_error) { return res; } + MalVal *a20 = _nth(a2, 0); + if (strcmp("catch*", a20->val.string) == 0) { + MalVal *a21 = _nth(a2, 1); + MalVal *a22 = _nth(a2, 2); + Env *catch_env = new_env(env, + _listX(1, a21), + _listX(1, mal_error)); + //malval_free(mal_error); + mal_error = NULL; + res = EVAL(a22, catch_env); + return res; + } else { + return &mal_nil; + } + } else if ((a0->type & MAL_SYMBOL) && + strcmp("do", a0->val.string) == 0) { + //g_print("eval apply do\n"); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); + ast = _last(ast); + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("if", a0->val.string) == 0) { + //g_print("eval apply if\n"); + MalVal *a1 = _nth(ast, 1); + MalVal *cond = EVAL(a1, env); + if (!cond || mal_error) return NULL; + if (cond->type & (MAL_FALSE|MAL_NIL)) { + // eval false slot form + if (ast->val.array->len > 3) { + ast = _nth(ast, 3); + } else { + return &mal_nil; + } + } else { + // eval true slot form + ast = _nth(ast, 2); + } + // Continue loop + } else if ((a0->type & MAL_SYMBOL) && + strcmp("fn*", a0->val.string) == 0) { + //g_print("eval apply fn*\n"); + MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); + mf->ismacro = FALSE; + mf->val.func.evaluator = EVAL; + mf->val.func.args = _nth(ast, 1); + mf->val.func.body = _nth(ast, 2); + mf->val.func.env = env; + return mf; + } else { + //g_print("eval apply\n"); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _rest(ast); + if (f->ismacro) { + ast = _apply(f, rest); + continue; + } + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "cannot apply '%s'", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + ast = f->val.func.body; + env = new_env(f->val.func.env, f->val.func.args, args); + // Continue loop + } else { + return _apply(f, args); + } + } + + } // TCO while loop +} + +// print +char *PRINT(MalVal *exp) { + if (mal_error) { + return NULL; + } + return _pr_str(exp,1); +} + +// repl + +// read and eval +MalVal *RE(Env *env, char *prompt, char *str) { + MalVal *ast, *exp; + ast = READ(prompt, str); + if (!ast || mal_error) return NULL; + exp = EVAL(ast, env); + if (ast != exp) { + malval_free(ast); // Free input structure + } + return exp; +} + +// Setup the initial REPL environment +Env *repl_env; + +MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } + +void init_repl_env(int argc, char *argv[]) { + repl_env = new_env(NULL, NULL, NULL); + + // core.c: defined using C + int i; + for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + env_set(repl_env, core_ns[i].name, + malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); + } + env_set(repl_env, "eval", + malval_new_function((void*(*)(void *))do_eval, 1)); + + MalVal *_argv = _listX(0); + for (i=2; i < argc; i++) { + MalVal *arg = malval_new_string(argv[i]); + g_array_append_val(_argv->val.array, arg); + } + env_set(repl_env, "*ARGV*", _argv); + + // core.mal: defined using the language itself + RE(repl_env, "", "(def! *host-language* \"c\")"); + RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); + RE(repl_env, "", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); +} + +int main(int argc, char *argv[]) +{ + MalVal *exp; + char *output; + char prompt[100]; + + MAL_GC_SETUP(); + + // Set the initial prompt and environment + snprintf(prompt, sizeof(prompt), "user> "); + init_repl_env(argc, argv); + + if (argc > 1) { + char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); + RE(repl_env, "", cmd); + return 0; + } + + // repl loop + RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))"); + for(;;) { + exp = RE(repl_env, prompt, NULL); + if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { + return 0; + } + output = PRINT(exp); + + if (mal_error) { + fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); + malval_free(mal_error); + mal_error = NULL; + } else if (output) { + puts(output); + MAL_GC_FREE(output); // Free output string + } + + //malval_free(exp); // Free evaluated expression + } +} diff --git a/impls/c/tests/step5_tco.mal b/impls/c/tests/step5_tco.mal new file mode 100644 index 0000000000..be6a117a62 --- /dev/null +++ b/impls/c/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; C: skipping non-TCO recursion +;; Reason: segfaults (unrecoverable) diff --git a/c/tests/stepA_mal.mal b/impls/c/tests/stepA_mal.mal similarity index 100% rename from c/tests/stepA_mal.mal rename to impls/c/tests/stepA_mal.mal diff --git a/impls/c/types.c b/impls/c/types.c new file mode 100644 index 0000000000..2798a1f4e4 --- /dev/null +++ b/impls/c/types.c @@ -0,0 +1,520 @@ +#include +#include +#include +#include +#include "types.h" +#include "printer.h" + +#ifdef USE_GC +void nop_free(void* ptr) { + (void)ptr; // Unused argument +} + +static GMemVTable gc_gmem_vtable = { + .malloc = GC_malloc, + .realloc = GC_realloc, + .free = nop_free, + .calloc = NULL, + .try_malloc = NULL, + .try_realloc = NULL +}; + +void GC_setup() { + GC_INIT(); + setenv("G_SLICE", "always-malloc", 1); + g_mem_gc_friendly = TRUE; + g_mem_set_vtable(&gc_gmem_vtable); +} + +char* GC_strdup(const char *src) { + if (!src) { + return NULL; + } + char* dst = (char*)MAL_GC_MALLOC(strlen(src) + 1); + strcpy(dst, src); + return dst; +} +#endif + + +// Errors/Exceptions + +MalVal *mal_error = NULL; // WARNGIN: global state +void _error(const char *fmt, ...) { + va_list args; + va_start(args, fmt); + mal_error = malval_new_string(g_strdup_vprintf(fmt, args)); +} + +// Constant atomic values + +MalVal mal_nil = {MAL_NIL, NULL, {0}, 0}; +MalVal mal_true = {MAL_TRUE, NULL, {0}, 0}; +MalVal mal_false = {MAL_FALSE, NULL, {0}, 0}; + + +// General Functions + +// Print a hash table +#include +void g_hash_table_print(GHashTable *hash_table) { + GHashTableIter iter; + gpointer key, value; + + g_hash_table_iter_init (&iter, hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + g_print ("%s/%p ", (const char *) key, (void *) value); + //g_print ("%s ", (const char *) key); + } +} + +GHashTable *g_hash_table_copy(GHashTable *src_table) { + GHashTable *new_table = g_hash_table_new(g_str_hash, g_str_equal); + GHashTableIter iter; + gpointer key, value; + + g_hash_table_iter_init (&iter, src_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + g_hash_table_insert(new_table, key, value); + } + return new_table; +} + +int min(int a, int b) { return a < b ? a : b; } +int max(int a, int b) { return a > b ? a : b; } + +int _count(MalVal *obj) { + switch (obj->type) { + case MAL_NIL: return 0; + case MAL_LIST: return obj->val.array->len; + case MAL_VECTOR: return obj->val.array->len; + case MAL_HASH_MAP: return g_hash_table_size(obj->val.hash_table); + case MAL_STRING: return strlen(obj->val.string); + default: + _error("count unsupported for type %d\n", obj->type); + return 0; + } +} + +// Allocate a malval and set its type and value +MalVal *malval_new(MalType type, MalVal *metadata) { + MalVal *mv = (MalVal*)MAL_GC_MALLOC(sizeof(MalVal)); + mv->type = type; + mv->metadata = metadata; + return mv; +} + +void malval_free(MalVal *mv) { + // TODO: free collection items + if (!(mv->type & (MAL_NIL|MAL_TRUE|MAL_FALSE))) { + MAL_GC_FREE(mv); + } +} + +MalVal *malval_new_integer(gint64 val) { + MalVal *mv = malval_new(MAL_INTEGER, NULL); + mv->val.intnum = val; + return mv; +} + +MalVal *malval_new_float(gdouble val) { + MalVal *mv = malval_new(MAL_FLOAT, NULL); + mv->val.floatnum = val; + return mv; +} + +MalVal *malval_new_string(char *val) { + MalVal *mv = malval_new(MAL_STRING, NULL); + mv->val.string = val; + return mv; +} + +MalVal *malval_new_symbol(char *val) { + MalVal *mv = malval_new(MAL_SYMBOL, NULL); + mv->val.string = val; + return mv; +} + +MalVal *malval_new_keyword(char *val) { + MalVal *mv = malval_new(MAL_STRING, NULL); + mv->val.string = g_strdup_printf("\x7f%s", val); + return mv; +} + +MalVal *malval_new_list(MalType type, GArray *val) { + MalVal *mv = malval_new(type, NULL); + mv->val.array = val; + return mv; +} + +MalVal *malval_new_hash_map(GHashTable *val) { + MalVal *mv = malval_new(MAL_HASH_MAP, NULL); + mv->val.hash_table = val; + return mv; +} + +MalVal *malval_new_atom(MalVal *val) { + MalVal *mv = malval_new(MAL_ATOM, NULL); + mv->val.atom_val = val; + return mv; +} + + +MalVal *malval_new_function(void *(*func)(void *), int arg_cnt) { + MalVal *mv = malval_new(MAL_FUNCTION_C, NULL); + mv->func_arg_cnt = arg_cnt; + assert(mv->func_arg_cnt <= 20, + "native function restricted to 20 args (%d given)", + mv->func_arg_cnt); + mv->ismacro = FALSE; + switch (arg_cnt) { + case -1: mv->val.f1 = (void *(*)(void*))func; break; + case 0: mv->val.f0 = (void *(*)())func; break; + case 1: mv->val.f1 = (void *(*)(void*))func; break; + case 2: mv->val.f2 = (void *(*)(void*,void*))func; break; + case 3: mv->val.f3 = (void *(*)(void*,void*,void*))func; break; + case 4: mv->val.f4 = (void *(*)(void*,void*,void*,void*))func; break; + case 5: mv->val.f5 = (void *(*)(void*,void*,void*,void*,void*))func; break; + case 6: mv->val.f6 = (void *(*)(void*,void*,void*,void*,void*, + void*))func; break; + case 7: mv->val.f7 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*))func; break; + case 8: mv->val.f8 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*))func; break; + case 9: mv->val.f9 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*))func; break; + case 10: mv->val.f10 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*))func; break; + case 11: mv->val.f11 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*))func; break; + case 12: mv->val.f12 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*))func; break; + case 13: mv->val.f13 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*))func; break; + case 14: mv->val.f14 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*))func; break; + case 15: mv->val.f15 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*))func; break; + case 16: mv->val.f16 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*))func; break; + case 17: mv->val.f17 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*))func; break; + case 18: mv->val.f18 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*))func; break; + case 19: mv->val.f19 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*))func; break; + case 20: mv->val.f20 = (void *(*)(void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*))func; break; + } + return mv; +} + +MalVal *_apply(MalVal *f, MalVal *args) { + MalVal *res; + assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "Cannot invoke %s", _pr_str(f,1)); + if (f->type & MAL_FUNCTION_MAL) { + Env *fn_env = new_env(f->val.func.env, f->val.func.args, args); + res = f->val.func.evaluator(f->val.func.body, fn_env); + return res; + } else { + MalVal *a = args; + assert((f->func_arg_cnt == -1) || + (f->func_arg_cnt == _count(args)), + "Length of formal params (%d) does not match actual parameters (%d)", + f->func_arg_cnt, _count(args)); + switch (f->func_arg_cnt) { + case -1: res=f->val.f1 (a); break; + case 0: res=f->val.f0 (); break; + case 1: res=f->val.f1 (_nth(a,0)); break; + case 2: res=f->val.f2 (_nth(a,0),_nth(a,1)); break; + case 3: res=f->val.f3 (_nth(a,0),_nth(a,1),_nth(a,2)); break; + case 4: res=f->val.f4 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3)); break; + case 5: res=f->val.f5 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4)); break; + case 6: res=f->val.f6 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5)); break; + case 7: res=f->val.f7 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6)); break; + case 8: res=f->val.f8 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7)); break; + case 9: res=f->val.f9 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8)); break; + case 10: res=f->val.f10(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9)); break; + case 11: res=f->val.f11(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10)); break; + case 12: res=f->val.f12(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11)); break; + case 13: res=f->val.f13(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12)); break; + case 14: res=f->val.f14(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13)); break; + case 15: res=f->val.f15(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14)); break; + case 16: res=f->val.f16(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), + _nth(a,15)); break; + case 17: res=f->val.f17(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), + _nth(a,15),_nth(a,16)); break; + case 18: res=f->val.f18(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), + _nth(a,15),_nth(a,16),_nth(a,17)); break; + case 19: res=f->val.f19(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), + _nth(a,15),_nth(a,16),_nth(a,17),_nth(a,18)); break; + case 20: res=f->val.f20(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), + _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), + _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), + _nth(a,15),_nth(a,16),_nth(a,17),_nth(a,18),_nth(a,19)); break; + } + return res; + } +} + + +int _equal_Q(MalVal *a, MalVal *b) { + GHashTableIter iter; + gpointer key, value; + + if (a == NULL || b == NULL) { return FALSE; } + + // If types are the same or both are sequential then they might be equal + if (!((a->type == b->type) || + (_sequential_Q(a) && _sequential_Q(b)))) { + return FALSE; + } + switch (a->type) { + case MAL_NIL: + case MAL_TRUE: + case MAL_FALSE: + return a->type == b->type; + case MAL_INTEGER: + return a->val.intnum == b->val.intnum; + case MAL_FLOAT: + return a->val.floatnum == b->val.floatnum; + case MAL_SYMBOL: + case MAL_STRING: + if (strcmp(a->val.string, b->val.string) == 0) { + return TRUE; + } else { + return FALSE; + } + case MAL_LIST: + case MAL_VECTOR: + if (a->val.array->len != b->val.array->len) { + return FALSE; + } + int i; + for (i=0; ival.array->len; i++) { + if (! _equal_Q(g_array_index(a->val.array, MalVal*, i), + g_array_index(b->val.array, MalVal*, i))) { + return FALSE; + } + } + return TRUE; + case MAL_HASH_MAP: + if (g_hash_table_size(a->val.hash_table) != + g_hash_table_size(b->val.hash_table)) { + return FALSE; + } + g_hash_table_iter_init (&iter, a->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + if (!g_hash_table_contains(b->val.hash_table, key)) { + return FALSE; + } + MalVal *aval = (MalVal *) g_hash_table_lookup(a->val.hash_table, key); + MalVal *bval = (MalVal *) g_hash_table_lookup(b->val.hash_table, key); + if (!_equal_Q(aval, bval)) { + return FALSE; + } + } + return TRUE; + case MAL_FUNCTION_C: + case MAL_FUNCTION_MAL: + return a->val.f0 == b->val.f0; + default: + _error("_equal_Q unsupported comparison type %d\n", a->type); + return FALSE; + } +} + + +// Lists +MalVal *_listX(int count, ...) { + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + count)); + MalVal *v; + va_list ap; + va_start(ap, count); + while (count-- > 0) { + v = va_arg(ap, MalVal*); + g_array_append_val(seq->val.array, v); + } + va_end(ap); + return seq; +} + +MalVal *_list(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "list called with invalid arguments"); + args->type = MAL_LIST; + return args; +} + +int _list_Q(MalVal *seq) { + return seq->type & MAL_LIST; +} + + +// Vectors +MalVal *_vector(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "vector called with invalid arguments"); + args->type = MAL_VECTOR; + return args; +} + +int _vector_Q(MalVal *seq) { + return seq->type & MAL_VECTOR; +} + + +// Hash maps +MalVal *_hash_map(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "hash-map called with non-sequential arguments"); + GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal); + MalVal *hm = malval_new_hash_map(htable); + return _assoc_BANG(hm, args); +} + +int _hash_map_Q(MalVal *seq) { + return seq->type & MAL_HASH_MAP; +} + +MalVal *_assoc_BANG(MalVal* hm, MalVal *args) { + assert((_count(args) % 2) == 0, + "odd number of parameters to assoc!"); + GHashTable *htable = hm->val.hash_table; + int i; + MalVal *k, *v; + for (i=0; i<_count(args); i+=2) { + k = g_array_index(args->val.array, MalVal*, i); + assert_type(k, MAL_STRING, + "assoc! called with non-string key"); + v = g_array_index(args->val.array, MalVal*, i+1); + g_hash_table_insert(htable, k->val.string, v); + } + return hm; +} + +MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) { + GHashTable *htable = hm->val.hash_table; + int i; + MalVal *k, *v; + for (i=0; i<_count(args); i++) { + k = g_array_index(args->val.array, MalVal*, i); + assert_type(k, MAL_STRING, + "dissoc! called with non-string key"); + g_hash_table_remove(htable, k->val.string); + } + return hm; +} + + +// Atoms +int _atom_Q(MalVal *exp) { + return exp->type & MAL_ATOM; +} + + +// Sequence functions +MalVal *_slice(MalVal *seq, int start, int end) { + int i, new_len = max(0, min(end-start, + _count(seq)-start)); + GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + new_len); + for (i=start; ival.array, MalVal*, i)); + } + return malval_new_list(MAL_LIST, new_arr); +} + + +int _sequential_Q(MalVal *seq) { + return seq->type & (MAL_LIST|MAL_VECTOR); +} + +MalVal *_nth(MalVal *seq, int idx) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "_nth called with non-sequential"); + if (idx >= _count(seq)) { + abort("nth: index out of range"); + } + return g_array_index(seq->val.array, MalVal*, idx); +} + +MalVal *_first(MalVal *seq) { + assert_type(seq, MAL_NIL|MAL_LIST|MAL_VECTOR, + "_first called with non-sequential"); + if (_count(seq) == 0) { + return &mal_nil; + } + return g_array_index(seq->val.array, MalVal*, 0); +} + +MalVal *_last(MalVal *seq) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "_last called with non-sequential"); + if (_count(seq) == 0) { + return &mal_nil; + } + return g_array_index(seq->val.array, MalVal*, _count(seq)-1); +} + + +MalVal *_rest(MalVal *seq) { + return _slice(seq, 1, _count(seq)); +} + + +MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) { + MalVal *e, *el; + assert_type(lst, MAL_LIST|MAL_VECTOR, + "_map called with non-sequential"); + int i, len = _count(lst); + el = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); + for (i=0; ival.array, MalVal*, i), arg2); + if (!e || mal_error) return NULL; + g_array_append_val(el->val.array, e); + } + return el; +} diff --git a/impls/c/types.h b/impls/c/types.h new file mode 100644 index 0000000000..d4674c9ef9 --- /dev/null +++ b/impls/c/types.h @@ -0,0 +1,197 @@ +#ifndef __MAL_TYPES__ +#define __MAL_TYPES__ + +#include + +#ifdef USE_GC + +#include +void nop_free(void* ptr); +void GC_setup(); +char* GC_strdup(const char *src); +#define MAL_GC_SETUP() GC_setup() +#define MAL_GC_MALLOC GC_MALLOC +#define MAL_GC_FREE nop_free +#define MAL_GC_STRDUP GC_strdup + +#else + +#include +#define MAL_GC_SETUP() +#define MAL_GC_MALLOC malloc +#define MAL_GC_FREE free +#define MAL_GC_STRDUP strdup + +#endif + +struct MalVal; // pre-declare + + +// Env (implentation in env.c) + +typedef struct Env { + struct Env *outer; + GHashTable *table; +} Env; + +Env *new_env(Env *outer, struct MalVal* binds, struct MalVal *exprs); +struct MalVal *env_get(Env *env, const char *key); +// Returns NULL if the key is missing. +void env_set(Env *env, char *key, struct MalVal *val); + + +// Utility functiosn +void g_hash_table_print(GHashTable *hash_table); +GHashTable *g_hash_table_copy(GHashTable *src_table); + + +// Errors/exceptions + +extern struct MalVal *mal_error; +void _error(const char *fmt, ...); + +#define abort(format, ...) \ + { _error(format, ##__VA_ARGS__); return NULL; } + +#define assert(test, format, ...) \ + if (!(test)) { \ + _error(format, ##__VA_ARGS__); \ + return NULL; \ + } + +#define assert_type(mv, typ, format, ...) \ + if (!(mv->type & (typ))) { \ + _error(format, ##__VA_ARGS__); \ + return NULL; \ + } + + +typedef enum { + MAL_NIL = 1, + MAL_TRUE = 2, + MAL_FALSE = 4, + MAL_INTEGER = 8, + MAL_FLOAT = 16, + MAL_SYMBOL = 32, + MAL_STRING = 64, + MAL_LIST = 128, + MAL_VECTOR = 256, + MAL_HASH_MAP = 512, + MAL_ATOM = 1024, + MAL_FUNCTION_C = 2048, + MAL_FUNCTION_MAL = 4096, +} MalType; + +typedef struct MalVal { + MalType type; + struct MalVal *metadata; + union { + gint64 intnum; + gdouble floatnum; + char *string; + GArray *array; + GHashTable *hash_table; + struct MalVal *atom_val; + void *(*f0) (); + void *(*f1) (void*); + void *(*f2) (void*,void*); + void *(*f3) (void*,void*,void*); + void *(*f4) (void*,void*,void*,void*); + void *(*f5) (void*,void*,void*,void*,void*); + void *(*f6) (void*,void*,void*,void*,void*,void*); + void *(*f7) (void*,void*,void*,void*,void*,void*,void*); + void *(*f8) (void*,void*,void*,void*,void*,void*,void*,void*); + void *(*f9) (void*,void*,void*,void*,void*,void*,void*,void*,void*); + void *(*f10)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*); + void *(*f11)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*); + void *(*f12)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*); + void *(*f13)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*); + void *(*f14)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*,void*); + void *(*f15)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*); + void *(*f16)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*,void*); + void *(*f17)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*,void*,void*); + void *(*f18)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*,void*,void*,void*); + void *(*f19)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*,void*,void*,void*,void*); + void *(*f20)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, + void*,void*,void*,void*,void*,void*,void*,void*,void*,void*); + struct { + struct MalVal *(*evaluator)(struct MalVal *, Env *); + struct MalVal *args; + struct MalVal *body; + struct Env *env; + } func; + } val; + int func_arg_cnt; + int ismacro; +} MalVal; + +// Constants + +extern MalVal mal_nil; +extern MalVal mal_true; +extern MalVal mal_false; + + +// Declare functions used internally (by other C code). +// Mal visible functions are "exported" in types_ns + +MalVal *malval_new(MalType type, MalVal *metadata); +void malval_free(MalVal *mv); +MalVal *malval_new_integer(gint64 val); +MalVal *malval_new_float(gdouble val); +MalVal *malval_new_string(char *val); +MalVal *malval_new_symbol(char *val); +MalVal *malval_new_keyword(char *val); +MalVal *malval_new_list(MalType type, GArray *val); +MalVal *malval_new_hash_map(GHashTable *val); +MalVal *malval_new_atom(MalVal *val); +MalVal *malval_new_function(void *(*func)(void *), int arg_cnt); + +// Numbers +#define WRAP_INTEGER_OP(name, op) \ + static MalVal *int_ ## name(MalVal *a, MalVal *b) { \ + return malval_new_integer(a->val.intnum op b->val.intnum); \ + } +#define WRAP_INTEGER_CMP_OP(name, op) \ + static MalVal *int_ ## name(MalVal *a, MalVal *b) { \ + return a->val.intnum op b->val.intnum ? &mal_true : &mal_false; \ + } + +// Collections +MalVal *_listX(int count, ...); +MalVal *_list(MalVal *args); +MalVal *_vector(MalVal *args); +MalVal *_hash_map(MalVal *args); +MalVal *_assoc_BANG(MalVal* hm, MalVal *args); +MalVal *_dissoc_BANG(MalVal* hm, MalVal *args); + +MalVal *_apply(MalVal *f, MalVal *el); + +char *_pr_str(MalVal *args, int print_readably); + +MalVal *_slice(MalVal *seq, int start, int end); +MalVal *_nth(MalVal *seq, int idx); +MalVal *_first(MalVal *seq); +MalVal *_rest(MalVal *seq); +MalVal *_last(MalVal *seq); +int _count(MalVal *obj); + +int _atom_Q(MalVal *exp); +int _sequential_Q(MalVal *seq); +int _list_Q(MalVal *seq); +int _vector_Q(MalVal *seq); +int _hash_map_Q(MalVal *seq); +int _equal_Q(MalVal *a, MalVal *b); + +MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2); + +#endif diff --git a/impls/chuck/Dockerfile b/impls/chuck/Dockerfile new file mode 100644 index 0000000000..6f65a5e951 --- /dev/null +++ b/impls/chuck/Dockerfile @@ -0,0 +1,38 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +# Some typical implementation and test requirements +RUN apt-get -y install curl + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Chuck +RUN apt-get -y install bison gcc g++ flex +RUN apt-get -y install libasound2-dev libsndfile1-dev +RUN cd /tmp && curl -O https://chuck.cs.princeton.edu/release/files/chuck-1.5.2.5.tgz \ + && tar xvzf /tmp/chuck-1.5.2.5.tgz && cd chuck-1.5.2.5/src \ + && make linux-alsa && make install \ + && rm -r /tmp/chuck-1.5.2.5* +RUN cd /tmp && curl -Lo chugins-chuck-1.5.2.5.tgz https://github.com/ccrma/chugins/archive/refs/tags/chuck-1.5.2.5.tar.gz \ + && tar xvzf /tmp/chugins-chuck-1.5.2.5.tgz && cd chugins-chuck-1.5.2.5/RegEx \ + && make linux && mkdir -p /usr/local/lib/chuck/1.5.2.5 \ + && cp RegEx.chug /usr/local/lib/chuck/1.5.2.5/RegEx.chug \ + && rm -r /tmp/chugins-chuck-1.5.2.5* + +ENV HOME /mal diff --git a/impls/chuck/Makefile b/impls/chuck/Makefile new file mode 100644 index 0000000000..bee2d7baae --- /dev/null +++ b/impls/chuck/Makefile @@ -0,0 +1,5 @@ +all: + +clean: + +.PHONY: all clean diff --git a/impls/chuck/chuck.md b/impls/chuck/chuck.md new file mode 100644 index 0000000000..e87f384258 --- /dev/null +++ b/impls/chuck/chuck.md @@ -0,0 +1,117 @@ +- I've found a potential bug in their substring function: + https://github.com/ccrma/chuck/issues/55 +- later I've found one in their regex replace function, too: + https://github.com/ccrma/chuck/issues/60 +- this suggests there hasn't been much testing done on things + unrelated to audio which is not that unexpected in an audio + programming language, but still... +- the manual isn't up to date, so you need to look at `VERSIONS` and + the examples instead, sometimes the sources, too +- the manual only speaks of the debug syntax for printing + (`<<>>;` which goes to stderr), I've found a `chout` object you + can send strings to for outputting to stdout +- quitting is done via `C-c` only +- you'll want to use `--silent` to disable audio errors/processing, + but then the process will use 100% CPU and ignore any waiting +- stdin handling is terrible: + - the manual shows a keyboard example with HID devices, but it + doesn't work on linux + - there's a "hacked" `ConsoleInput` class with only an example file + for it, it works for most of the part, but doesn't accept `C-d` + - the obvious alternative is printing a prompt manually, then + waiting for `KBHit` events and printing them, but that's rather + tedious as you'd have to convert the ascii numbers into chars + yourself and make a buffer-like thing + - I've also considered writing a thing sending OSC events per + keyboard hit and processing these in ChucK as they come in, but + that would most likely not work with the test harness ._. +- the OOP system is seriously weird + - influenced by C++ *and* java + - one public class per file + - to export functionality, you must use a public class (and static + functions/variables) + - if you use static variables, you can't assign values to them + directly, you'll have to do that after the class has been defined + - worse, you can't even declare anything that's not a primitive, so + if you want to declare a reference type, use the reference + operator instead... + - no interfaces + - no generics (copy/paste code for all types you need!) + - no unions (use Object, then cast to the correct type) + - there is no obvious way of casting to arrays of types + - no private (things are public by default, public keyword is used + to export code) + - no self-references in classes (so no trees, static "constructors" + work though) + - no meaningful way of working with null for primitive types (mutate + a reference and look at the return code instead) + - no boxed versions of primitive types + - no automatic boxing/unboxing + - no upcasting/downcasting +- No module system + - `Machine.add(file)` is the only mechanism available from code (no + read all file contents and eval), but if you use it, it defers + loading the files until the file it's used in, rendering it + useless + - Therefore the only way to make use of it is writing a file that + only consists of these instructions + - The only practical alternative is specifying all files you need + loaded in the right order when starting chuck + - That's why I wrote a runner script extracting `// @import file.ck` + lines (hello JS!) and running chuck with them +- No real exception system + - The VM is able to throw exceptions (out of bounds, nullpointer), + but you can't do anything about them and only get a hint what kind + of operation caused it (no stacktrace or anything) + - No user-definable exceptions, no mechanism to catch or throw them + (other than intentionally doing something illegal) + - This means that you should use C-style error checking by + converting the potentially erroneous functions into returning a + status code and mutating a reference passed to them as argument + which is highly weird in a otherwise Java-like language + - An alternative is defining an error object (which belongs to the + same supertype as the other legal return values) and checking its + type by inspecting the user-tracked type field +- No function pointers/functors/closures + - This is a bit unexpected as if you leave away the parentheses + holding the argument list and debug print a function, you'll see + it being recognized as a function, yet you can't store it anywhere + for passing it around + - This is not quite right as you can store it in an `Object`, just + not call it in any way or cast it to a function type + - So you get to implement functors and closures yourself... + - A functor is a class with a call method taking an argument list + and executing the code of the function you intend to pass around + - To use it, store an instance of its class somewhere, then use its + call method with an argument list + - Closures can be implemented with a data structure holding a + snapshot of the current environment, the parameter list and AST, + the last two being a way of representing an anonymous function. +- Other oddities + - strict distinction between assigning values and references with + two separate operators for them (`<<` for array append doesn't + seem to care though) + - strings are supposedly reference types, yet you can assign them + with the regular operator... + - `<<` on an `type[]` gives you a weird error as you need to use an + `type[0]` (and a `type[]` is merely a reference...) + - The compiler will find lots of mistakes for you, but cannot figure + out code branches not returning anything which means that return + type violations will blow up in your face unless there's a + reasonable default value (null for `Object` isn't, 0 for `int` and + "" for `string` is) + - If you abuse the type system too much, chances are you get a + segfault or assert instead of an exception... + - Debug print shows the object and its type if you pass one + argument, if you pass more than one, it prints the concatenation + of their representations instead, so it's a bit hard to make out + what is a debug print and what isn't + - there are no hash maps, just the possibility to use a string key + on an array for storing and fetching contents (like in PHP, eww) + and no way of retrieving keys/values or even iterating over these + - I think I've spotted a weird scoping bug that prefers a member + variable over a local variable after nesting scopes, therefore I + consider the language to not implement proper lexical scoping + - another proof of it is declaring variables in consequent if-blocks + as that gives you an error instead of being permitted as they + should be in different local scopes... diff --git a/impls/chuck/core.ck b/impls/chuck/core.ck new file mode 100644 index 0000000000..b7c7636875 --- /dev/null +++ b/impls/chuck/core.ck @@ -0,0 +1,100 @@ +public class Core +{ + static string names[]; + static MalSubr ns[]; +} + +["+", "-", "*", "/", + "list", "list?", "empty?", "count", + "=", "<", "<=", ">", ">=", + "pr-str", "str", "prn", "println", + "read-string", "slurp", + "atom", "atom?", "deref", "reset!", "swap!", + "vec", "cons", "concat", + "nth", "first", "rest", + "throw", + "apply", "map", + "nil?", "true?", "false?", "number?", "symbol?", "keyword?", "vector?", "map?", + "symbol", "keyword", "vector", "hash-map", + "assoc", "dissoc", "get", "contains?", "keys", "vals", + "sequential?", "fn?", "macro?", + "readline", "meta", "with-meta", + "time-ms", "conj", "string?", "seq"] @=> Core.names; +MalSubr ns[0] @=> Core.ns; + +new MalAdd @=> Core.ns["+"]; +new MalSub @=> Core.ns["-"]; +new MalMul @=> Core.ns["*"]; +new MalDiv @=> Core.ns["/"]; + +new MalListify @=> Core.ns["list"]; +new MalIsList @=> Core.ns["list?"]; +new MalIsEmpty @=> Core.ns["empty?"]; +new MalCount @=> Core.ns["count"]; + +new MalEqual @=> Core.ns["="]; +new MalLess @=> Core.ns["<"]; +new MalLessEqual @=> Core.ns["<="]; +new MalGreater @=> Core.ns[">"]; +new MalGreaterEqual @=> Core.ns[">="]; + +new MalPrStr @=> Core.ns["pr-str"]; +new MalStr @=> Core.ns["str"]; +new MalPrn @=> Core.ns["prn"]; +new MalPrintln @=> Core.ns["println"]; + +new MalReadStr @=> Core.ns["read-string"]; +new MalSlurp @=> Core.ns["slurp"]; + +new MalAtomify @=> Core.ns["atom"]; +new MalIsAtom @=> Core.ns["atom?"]; +new MalDeref @=> Core.ns["deref"]; +new MalDoReset @=> Core.ns["reset!"]; +new MalDoSwap @=> Core.ns["swap!"]; + +new MalVec @=> Core.ns["vec"]; +new MalCons @=> Core.ns["cons"]; +new MalConcat @=> Core.ns["concat"]; + +new MalNth @=> Core.ns["nth"]; +new MalFirst @=> Core.ns["first"]; +new MalRest @=> Core.ns["rest"]; + +new MalThrow @=> Core.ns["throw"]; + +new MalApply @=> Core.ns["apply"]; +new MalMap @=> Core.ns["map"]; + +new MalIsNil @=> Core.ns["nil?"]; +new MalIsTrue @=> Core.ns["true?"]; +new MalIsFalse @=> Core.ns["false?"]; +new MalIsNumber @=> Core.ns["number?"]; +new MalIsSymbol @=> Core.ns["symbol?"]; +new MalIsKeyword @=> Core.ns["keyword?"]; +new MalIsVector @=> Core.ns["vector?"]; +new MalIsHashMap @=> Core.ns["map?"]; + +new MalSymbolify @=> Core.ns["symbol"]; +new MalKeywordify @=> Core.ns["keyword"]; +new MalVectorify @=> Core.ns["vector"]; +new MalHashMapify @=> Core.ns["hash-map"]; + +new MalAssoc @=> Core.ns["assoc"]; +new MalDissoc @=> Core.ns["dissoc"]; +new MalGet @=> Core.ns["get"]; +new MalIsContains @=> Core.ns["contains?"]; +new MalKeys @=> Core.ns["keys"]; +new MalVals @=> Core.ns["vals"]; + +new MalSequential @=> Core.ns["sequential?"]; +new MalIsFn @=> Core.ns["fn?"]; +new MalIsMacro @=> Core.ns["macro?"]; + +new MalReadline @=> Core.ns["readline"]; +new MalMeta @=> Core.ns["meta"]; +new MalWithMeta @=> Core.ns["with-meta"]; + +new MalTimeMs @=> Core.ns["time-ms"]; +new MalConj @=> Core.ns["conj"]; +new MalIsString @=> Core.ns["string?"]; +new MalSeq @=> Core.ns["seq"]; diff --git a/impls/chuck/env.ck b/impls/chuck/env.ck new file mode 100644 index 0000000000..386ea75512 --- /dev/null +++ b/impls/chuck/env.ck @@ -0,0 +1,92 @@ +public class Env extends MalObject +{ + MalObject outer; // this would ideally be Env, but isn't supported + MalObject data[0]; + + fun void init(MalObject env) + { + env @=> outer; + } + + fun void init(MalObject env, string binds[], MalObject exprs[]) + { + env @=> outer; + + for( 0 => int i; i < binds.size(); i++ ) + { + binds[i] => string bind; + + if( bind == "&" ) + { + MalObject.slice(exprs, i) @=> MalObject rest_binds[]; + MalList.create(rest_binds) @=> data[binds[i+1]]; + break; + } + else + { + exprs[i] @=> data[bind]; + } + } + } + + fun static Env create(MalObject env) + { + Env e; + e.init(env); + return e; + } + + fun static Env create(MalObject env, string binds[], MalObject exprs[]) + { + Env e; + e.init(env, binds, exprs); + return e; + } + + fun MalObject clone() + { + Env value; + + this.outer @=> value.outer; + this.data @=> value.data; + + return value; + } + + fun void set(string key, MalObject value) + { + value @=> data[key]; + } + + fun MalObject find(string key) + { + data[key] @=> MalObject value; + + if( value != null ) + { + return value; + } + else if( outer != null ) + { + return (outer$Env).find(key); + } + else + { + return null; + } + } + + fun MalObject get(string key) + { + find(key) @=> MalObject value; + + if( value != null ) + { + return value; + } + else + { + return MalError.create("'" + key + "' not found"); + } + } +} diff --git a/impls/chuck/func.ck b/impls/chuck/func.ck new file mode 100644 index 0000000000..15d4bd9df3 --- /dev/null +++ b/impls/chuck/func.ck @@ -0,0 +1,35 @@ +public class Func extends MalObject +{ + "func" => type; + Env env; + string args[]; + MalObject ast; + int isMacro; + + fun void init(Env env, string args[], MalObject ast) + { + env @=> this.env; + args @=> this.args; + ast @=> this.ast; + } + + fun static Func create(Env env, string args[], MalObject ast) + { + Func func; + func.init(env, args, ast); + return func; + } + + fun MalObject clone() + { + Func value; + + this.type => value.type; + this.env @=> value.env; + this.args @=> value.args; + this.ast @=> value.ast; + this.isMacro @=> value.isMacro; + + return value; + } +} diff --git a/impls/chuck/notes.md b/impls/chuck/notes.md new file mode 100644 index 0000000000..c467d15bc9 --- /dev/null +++ b/impls/chuck/notes.md @@ -0,0 +1,155 @@ +# Step 1 + +- What if I don't have an OOP language? +- types.qx could be more prominently mentioned... +- A table with all types and suggested object names would be hugely + useful +- Same for a list of all errors and their messages +- Mention return types and argument types consistently +- More on int/float and their grammar (int is mentioned implicitly in + the ASCII art, nothing on signs or bases or their lack of) +- Note that a string must be parsed for the `print_readably` thing to + work and mention how one could do that (like, by using a `read` or + `eval`-like thing or alternatively, chopping off the surrounding + quotes and doing the inverse transformation of the printing) +- How is an atom printed? + +# Step 2 + +- What if my language doesn't support lambdas, let alone passing + around named functions? Ideally write something about + implementing/using functors/delegates or replacing that namespace + with a big switch as with VHDL. Another problem is that if you + choose a different solution in step 4, step 2 could end up no longer + functional... +- What kind of error (read: what message?) is raised when no value can + be looked up for the symbol? Is it arbitrary? Do I need to extend + my error handling to allow for format strings? +- It would be worth a mention that you should extend the printer to + handle "native" functions (or in oldtimey terms, subrs) + +# Step 3 + +- You should modify both eval_ast *and* EVAL +- Suggest the trick with destructuring the AST into `a0`, `a1`, + etc. variables for easier access. Perhaps this can be used to clear + up the general language used with AST manipulation (like, first + parameter and second list element)? +- What does def! return? Emacs Lisp for instance returns the symbol + whereas the tests suggest the value should be returned instead... + +# Step 4 + +- "Implement the strings functions" +- The "no closures" paragraph isn't quite clear. Asides from that, do + native functions don't really need to be wrapped the same way as the + `fn*` objects, just introduce another type (like, a Subr and a Func + type) and do a check before applying the arguments to it +- Why does the guide say that the first argument of `count` can be + treated as list, yet there's a test performing `(count nil)` and + expecting zero as result? +- Does it make sense to compare, say, atoms in `=`? + +# Step 5 + +- "This is especially important in Lisp languages because they tend to + prefer using recursion instead of iteration for control structures." + <- I'd argue it's less of a lisp thing (see everything else related + to CL) and more a thing functional programming proponents have + considered more elegant than introducing iteration constructs (see + haskell, ocaml, erlang) +- It's not really clear that the TCO change for `let*` involves the + form you'd normally pass to `EVAL` to become the new `ast`. I had to + reread this a few more times to understand that the "second `ast`" + is actually its third argument... +- Where did the check for `do` not being broken by TCO go? +- What's the deal with the `quux/tests/step5_tco.qx` file? + +# Step 6 + +- "The closure calls the your EVAL function […]." +- I still don't have any closures. How the heck do I implement + `eval`? What about `swap!`? +- It would be useful to mention that `swap!` sort of requires + implementing `apply` first... + +# Step 7 + +- Why the scare quotes for splicing? +- "Before implementing the quoting forms, you will need to implement + some supporting functions in the core namespace:" should be one list + item +- "this function takes a list as its second parameter and returns a + new list that has the first argument prepended to it." reads backwards +- The quasiquote paragraph is hard to read +- It's rather confusing to refer to the argument of `ast` and to an + `ast` parameter, perhaps name the latter a form? +- What could also help would be a visualization of the four + conditionals: + - \`42, \`() + - \`~foo + - \`(~@foo) and more + - \`(42 ~@foo) and everything else +- Mal/mal is inconsistently capitalized +- "Expand the conditional with reader `read_form` function to add the + following four cases" is again weird, better refer to the + `read_form` function in reader.qx +- "concat should support concatenation of lists, vectors, or a mix or + both." <- "or a mix or both" is redundant + +# Step 8 + +- "In the previous step, quoting enabled some simple manipulation [of] + data structures" +- The macroexpand function step refers to call/apply, it's unclear how + to proceed if you don't have such a thing +- How should the exception for invalid `nth` access look like? Also, + why is it an exception and not an error like with the reader? +- How can `first` take a list (or vector), but work on `nil`? +- The description of `rest` is inconsistent with the tests +- "In the main program, use the rep function to define two new control + structures macros." +- Why does the definition of `cond` use `throw` although it's only + introduced in the next chapter? + +# Step 9 + +- It's not really clear that you really just have a `try*` special + form, with `catch*` merely existing inside it... +- Another thing to clarify is that the exception value is a string + containing the message you'd see (unless you're using `throw`) +- Generally, it would be better to explain the general exception + handling mechanism (with some examples), then showing how one + implements it for both languages with and without exceptions +- Another way than using a global variable is introducing an error + type next to the other MAL types and checking whether something a + function returned is one, although the hint about returning one at + each use of `EVAL` still stands... +- Shouldn't either trick be mentioned at the beginning, simply because + you'll need it in a language without exceptions to do error handling? +- Why this bizarre treatment for `keyword`? Why is there no test for + it? +- Is there a test for whether hash maps deduplicate identical keys + when using `hash-map` or `assoc`? +- What exactly are keys the specification for `dissoc`, `get` and + `contains?` are speaking of? Can I assume these are either strings + or keywords? +- Why is it not documented that `get` may take `nil` instead of a map? +- Perhaps it's worth adding more tests involving symbols to ensure + that functions using apply internally don't evaluate their args? + +# Step A + +- "Add meta-data support to mal functions." <- Shouldn't you mention + that this involves implementing `with-meta` and `meta`? +- "TODO. Should be separate from the function macro flag." <- Why is + this even related? +- It would be worth to mention that `with-meta` shall clone its + argument to avoid one of the more sneaky test failure reasons +- "The value of this entry should be a mal string containing the name + of the current implementation." +- "When the REPL starts up (as opposed to when it is called with a + script and/or arguments), call the rep function with this string to + print a startup header: `"(println (str \"Mal + [\" *host-language* \"]\"))".`" <- proof that you better quote these + because the asterisks just disappear... diff --git a/impls/chuck/printer.ck b/impls/chuck/printer.ck new file mode 100644 index 0000000000..4e1c9f5931 --- /dev/null +++ b/impls/chuck/printer.ck @@ -0,0 +1,75 @@ +public class Printer +{ + fun static string pr_str(MalObject m, int print_readably) + { + m.type => string type; + + if( type == "true" || type == "false" || type == "nil" ) + { + return type; + } + else if( type == "int" ) + { + return Std.itoa(m.intValue); + } + else if( type == "string" ) + { + if( print_readably ) + { + return String.repr(m.stringValue); + } + else + { + return m.stringValue; + } + } + else if( type == "symbol" ) + { + return m.stringValue; + } + else if( type == "keyword" ) + { + return ":" + m.stringValue; + } + else if( type == "atom" ) + { + return "(atom " + pr_str(m.malObjectValue(), print_readably) + ")"; + } + else if( type == "subr" ) + { + return "#"; + } + else if( type == "func" ) + { + return "#"; + } + else if( type == "list" ) + { + return pr_list(m.malObjectValues(), print_readably, "(", ")"); + } + else if( type == "vector" ) + { + return pr_list(m.malObjectValues(), print_readably, "[", "]"); + } + else if( type == "hashmap" ) + { + return pr_list(m.malObjectValues(), print_readably, "{", "}"); + } + else + { + return "Unknown type"; + } + } + + fun static string pr_list(MalObject m[], int print_readably, string start, string end) + { + string parts[m.size()]; + + for( 0 => int i; i < m.size(); i++ ) + { + pr_str(m[i], print_readably) => parts[i]; + } + + return start + String.join(parts, " ") + end; + } +} diff --git a/impls/chuck/reader.ck b/impls/chuck/reader.ck new file mode 100644 index 0000000000..135a052073 --- /dev/null +++ b/impls/chuck/reader.ck @@ -0,0 +1,245 @@ +public class Reader +{ + 0 => int position; + string tokens[]; + + fun string peek() + { + return tokens[position]; + } + + fun string next() + { + return tokens[position++]; + } + + fun static string[] tokenizer(string input) + { + "^[ \n,]*(~@|[][{}()'`~^@]|\"(\\\\.|[^\\\"])*\"|;[^\n]*|[^][ \n{}()^~@'`,;\"]*)" => string tokenRe; + "^([ \n,]*|;[^\n]*)$" => string blankRe; + + string tokens[0]; + + while( true ) + { + string matches[1]; + RegEx.match(tokenRe, input, matches); + matches[1] => string token; + + if( token.length() == 0 && !RegEx.match(blankRe, input) ) + { + tokens << input; + break; + } + + if( !RegEx.match(blankRe, token) ) + { + tokens << token; + } + + matches[0].length() => int tokenStart; + String.slice(input, tokenStart) => input; + + if( input.length() == 0 ) + { + break; + } + } + + return tokens; + } + + fun static MalObject read_str(string input) + { + Reader reader; + tokenizer(input) @=> reader.tokens; + + if( reader.tokens.size() == 0 ) + { + return MalError.create("empty input"); + } + else + { + return read_form(reader); + } + } + + fun static MalObject read_form(Reader reader) + { + reader.peek() => string token; + if( token == "(" ) + { + return read_list(reader, "(", ")"); + } + else if( token == "[" ) + { + return read_list(reader, "[", "]"); + } + else if( token == "{" ) + { + return read_list(reader, "{", "}"); + } + else if( token == ")" || token == "]" || token == "}" ) + { + return MalError.create("unexpected '" + token + "'"); + } + else if( token == "'" ) + { + return read_simple_reader_macro(reader, "quote"); + } + else if( token == "`" ) + { + return read_simple_reader_macro(reader, "quasiquote"); + } + else if( token == "~" ) + { + return read_simple_reader_macro(reader, "unquote"); + } + else if( token == "~@" ) + { + return read_simple_reader_macro(reader, "splice-unquote"); + } + else if( token == "@" ) + { + return read_simple_reader_macro(reader, "deref"); + } + else if( token == "^" ) + { + return read_meta_reader_macro(reader); + } + else + { + return read_atom(reader); + } + } + + fun static MalObject read_list(Reader reader, string start, string end) + { + MalObject items[0]; + + reader.next(); // discard list start token + + while( true ) + { + // HACK: avoid checking for reader.peek() returning null + // (as doing that directly isn't possible and too + // bothersome to do indirectly) + if( reader.position == reader.tokens.size() ) + { + return MalError.create("expected '" + end + "', got EOF"); + } + + if( reader.peek() == end ) + { + break; + } + + read_form(reader) @=> MalObject item; + + if( item.type == "error" ) + { + return item; + } + else + { + items << item; + } + } + + reader.next(); // discard list end token + + if( start == "(" ) + { + return MalList.create(items); + } + else if( start == "[" ) + { + return MalVector.create(items); + } + else if( start == "{" ) + { + return MalHashMap.create(items); + } + else + { + Util.panic("Programmer error (failed to specify correct start token)"); + return null; + } + } + + fun static MalObject read_atom(Reader reader) + { + "^[+-]?[0-9]+$" => string intRe; + "^\"(\\\\.|[^\\\"])*\"$" => string stringRe; + + reader.next() => string token; + + if( token == "true" ) + { + return Constants.TRUE; + } + else if( token == "false" ) + { + return Constants.FALSE; + } + else if( token == "nil" ) + { + return Constants.NIL; + } + else if( RegEx.match(intRe, token) ) + { + return MalInt.create(Std.atoi(token)); + } + else if( token.substring(0, 1) == "\"" ) + { + if( RegEx.match(stringRe, token) ) + { + return MalString.create(String.parse(token)); + } + else + { + return MalError.create("expected '\"', got EOF"); + } + } + else if( token.substring(0, 1) == ":" ) + { + return MalKeyword.create(String.slice(token, 1)); + } + else + { + return MalSymbol.create(token); + } + } + + fun static MalObject read_simple_reader_macro(Reader reader, string symbol) + { + reader.next(); // discard reader macro token + + read_form(reader) @=> MalObject form; + if( form.type == "error" ) + { + return form; + } + + return MalList.create([MalSymbol.create(symbol), form]); + } + + fun static MalObject read_meta_reader_macro(Reader reader) + { + reader.next(); // discard reader macro token + + read_form(reader) @=> MalObject meta; + if( meta.type == "error" ) + { + return meta; + } + + read_form(reader) @=> MalObject form; + if( form.type == "error" ) + { + return meta; + } + + return MalList.create([MalSymbol.create("with-meta"), form, meta]); + } +} diff --git a/impls/chuck/readline.ck b/impls/chuck/readline.ck new file mode 100644 index 0000000000..7f3881ac14 --- /dev/null +++ b/impls/chuck/readline.ck @@ -0,0 +1,72 @@ +public class Readline +{ + fun static string readline(string prompt) + { + int done; + string input; + KBHit kb; + int char; + string repr; + + ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", + "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", + "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", + "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", + " ", "!", "\"", "#", "$", "%", "&", "'", + "(", ")", "*", "+", ",", "-", ".", "/", + "0", "1", "2", "3", "4", "5", "6", "7", + "8", "9", ":", ";", "<", "=", ">", "?", + "@", "A", "B", "C", "D", "E", "F", "G", + "H", "I", "J", "K", "L", "M", "N", "O", + "P", "Q", "R", "S", "T", "U", "V", "W", + "X", "Y", "Z", "[", "\\", "]", "^", "_", + "`", "a", "b", "c", "d", "e", "f", "g", + "h", "i", "j", "k", "l", "m", "n", "o", + "p", "q", "r", "s", "t", "u", "v", "w", + "x", "y", "z", "{", "|", "}", "~", "DEL"] @=> string asciiTable[]; + + chout <= prompt; + chout.flush(); + + while( !done ) + { + kb => now; + + while( kb.more() && !done ) + { + kb.getchar() => char; + asciiTable[char] => repr; + + if( repr == "EOT" || repr == "LF" || repr == "CR" ) + { + true => done; + } + else if( repr == "DEL" && Std.getenv("TERM") != "dumb") + { + if( input.length() > 0) + { + chout <= "\033[1D\033[0K"; + chout.flush(); + input.substring(0, input.length()-1) => input; + } + } + else + { + chout <= repr; + chout.flush(); + repr +=> input; + } + } + } + + chout <= "\n"; + + if( repr == "EOT" ) + { + return null; + } + + return input; + } +} + diff --git a/impls/chuck/run b/impls/chuck/run new file mode 100755 index 0000000000..99137daea7 --- /dev/null +++ b/impls/chuck/run @@ -0,0 +1,11 @@ +#!/usr/bin/env bash +regex_chugin=${REGEX_CHUGIN:-/usr/local/lib/chuck/1.5.2.5/RegEx.chug} +if [[ ! -f "$regex_chugin" ]]; then + echo "Set \$REGEX_CHUGIN to the absolute path of RegEx.chug"; exit 1 +fi + +imports=$(grep "^ *// *@import" "$(dirname $0)/${STEP:-stepA_mal}.ck" | awk '{print $3}') +imports=$(for i in ${imports}; do ls $(dirname $0)/${i}; done) +old_IFS="${IFS}"; IFS=$'\a'; export CHUCK_ARGS="${*}"; IFS="${old_IFS}" + +exec chuck --caution-to-the-wind --silent --chugin:"$regex_chugin" ${imports} $(dirname $-1)/${STEP:-stepA_mal}.ck diff --git a/impls/chuck/step0_repl.ck b/impls/chuck/step0_repl.ck new file mode 100644 index 0000000000..7591170706 --- /dev/null +++ b/impls/chuck/step0_repl.ck @@ -0,0 +1,42 @@ +// @import readline.ck + +fun string READ(string input) +{ + return input; +} + +fun string EVAL(string input) +{ + return input; +} + +fun string PRINT(string input) +{ + return input; +} + +fun string rep(string input) +{ + return input => READ => EVAL => PRINT; +} + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + chout <= rep(input) + "\n"; + } + else + { + true => done; + } + } +} + +main(); diff --git a/impls/chuck/step1_read_print.ck b/impls/chuck/step1_read_print.ck new file mode 100644 index 0000000000..b7704e2347 --- /dev/null +++ b/impls/chuck/step1_read_print.ck @@ -0,0 +1,81 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun MalObject EVAL(MalObject m) +{ + return m; +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + else + { + return PRINT(EVAL(m)); + } +} + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +main(); diff --git a/impls/chuck/step2_eval.ck b/impls/chuck/step2_eval.ck new file mode 100644 index 0000000000..aea71e172b --- /dev/null +++ b/impls/chuck/step2_eval.ck @@ -0,0 +1,183 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun MalObject EVAL(MalObject m, MalSubr env[]) +{ + + // Util.println("EVAL: " + Printer.pr_str(m, true)); + + if( m.type == "symbol" ) + { + m.stringValue => string symbol; + env[symbol] @=> MalSubr subr; + + if( subr == null ) + { + return MalError.create("'" + symbol + "' not found"); + } + else + { + return subr; + } + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + if( first.type == "subr" ) + { + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else + { + Util.panic("Programmer error: cannot apply"); + return null; + } + } + else + { + return m; + } +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +MalSubr repl_env[0]; +new MalAdd @=> repl_env["+"]; +new MalSub @=> repl_env["-"]; +new MalMul @=> repl_env["*"]; +new MalDiv @=> repl_env["/"]; + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +main(); diff --git a/impls/chuck/step3_env.ck b/impls/chuck/step3_env.ck new file mode 100644 index 0000000000..372198413d --- /dev/null +++ b/impls/chuck/step3_env.ck @@ -0,0 +1,215 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun MalObject EVAL(MalObject m, Env env) +{ + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + return EVAL(ast[2], let_env); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + if( first.type == "subr" ) + { + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else + { + Util.panic("Programmer error: cannot apply"); + return null; + } + } + else + { + return m; + } +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +repl_env.set("+", new MalAdd); +repl_env.set("-", new MalSub); +repl_env.set("*", new MalMul); +repl_env.set("/", new MalDiv); + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +main(); diff --git a/impls/chuck/step4_if_fn_do.ck b/impls/chuck/step4_if_fn_do.ck new file mode 100644 index 0000000000..c15bc224d4 --- /dev/null +++ b/impls/chuck/step4_if_fn_do.ck @@ -0,0 +1,277 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck +// @import core.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun MalObject EVAL(MalObject m, Env env) +{ + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + return EVAL(ast[2], let_env); + } + else if( a0 == "do" ) + { + MalObject value; + for( 1 => int i; i < ast.size(); i++ ) + { + EVAL(ast[i], env) @=> value; + if( value.type == "error" ) + { + return value; + } + } + return value; + } + else if( a0 == "if" ) + { + EVAL(ast[1], env) @=> MalObject condition; + + if( condition.type == "error" ) + { + return condition; + } + + if( !(condition.type == "nil") && !(condition.type == "false") ) + { + return EVAL(ast[2], env); + } + else + { + if( ast.size() < 4 ) + { + return Constants.NIL; + } + else + { + return EVAL(ast[3], env); + } + } + } + else if( a0 == "fn*" ) + { + ast[1].malObjectValues() @=> MalObject arg_values[]; + string args[arg_values.size()]; + + for( 0 => int i; i < arg_values.size(); i++ ) + { + arg_values[i].stringValue => args[i]; + } + + ast[2] @=> MalObject _ast; + + return Func.create(env, args, _ast); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + if( first.type == "subr" ) + { + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else if( first.type == "func" ) + { + first$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + return EVAL(func.ast, eval_env); + } + else + { + Util.panic("Programmer error: cannot apply"); + return null; + } + } + else + { + return m; + } +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +for( 0 => int i; i < Core.names.size(); i++ ) +{ + Core.names[i] => string name; + repl_env.set(name, Core.ns[name]); +} + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +rep("(def! not (fn* (a) (if a false true)))"); + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +main(); diff --git a/impls/chuck/step5_tco.ck b/impls/chuck/step5_tco.ck new file mode 100644 index 0000000000..dfbf7e70d8 --- /dev/null +++ b/impls/chuck/step5_tco.ck @@ -0,0 +1,285 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck +// @import core.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun MalObject EVAL(MalObject m, Env env) +{ + while( true ) + { + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + let_env @=> env; + ast[2] @=> m; + continue; // TCO + } + else if( a0 == "do" ) + { + for( 1 => int i; i < ast.size() - 1; i++ ) + { + EVAL(ast[i], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + } + + // HACK: this assumes do gets at least one argument... + ast[ast.size()-1] @=> m; + continue; // TCO + } + else if( a0 == "if" ) + { + EVAL(ast[1], env) @=> MalObject condition; + + if( condition.type == "error" ) + { + return condition; + } + + if( !(condition.type == "nil") && !(condition.type == "false") ) + { + ast[2] @=> m; + continue; // TCO + } + else + { + if( ast.size() < 4 ) + { + return Constants.NIL; + } + else + { + ast[3] @=> m; + continue; // TCO + } + } + } + else if( a0 == "fn*" ) + { + ast[1].malObjectValues() @=> MalObject arg_values[]; + string args[arg_values.size()]; + + for( 0 => int i; i < arg_values.size(); i++ ) + { + arg_values[i].stringValue => args[i]; + } + + ast[2] @=> MalObject _ast; + + return Func.create(env, args, _ast); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + if( first.type == "subr" ) + { + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else if( first.type == "func" ) + { + first$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + eval_env @=> env; + func.ast @=> m; + continue; // TCO + } + } + else + { + return m; + } + } + Util.panic("Programmer error: TCO loop left incorrectly"); + return null; +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +for( 0 => int i; i < Core.names.size(); i++ ) +{ + Core.names[i] => string name; + repl_env.set(name, Core.ns[name]); +} + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +rep("(def! not (fn* (a) (if a false true)))"); + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +main(); diff --git a/impls/chuck/step6_file.ck b/impls/chuck/step6_file.ck new file mode 100644 index 0000000000..71581e0924 --- /dev/null +++ b/impls/chuck/step6_file.ck @@ -0,0 +1,338 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck +// @import core.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun MalObject EVAL(MalObject m, Env env) +{ + while( true ) + { + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + let_env @=> env; + ast[2] @=> m; + continue; // TCO + } + else if( a0 == "do" ) + { + for( 1 => int i; i < ast.size() - 1; i++ ) + { + EVAL(ast[i], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + } + + // HACK: this assumes do gets at least one argument... + ast[ast.size()-1] @=> m; + continue; // TCO + } + else if( a0 == "if" ) + { + EVAL(ast[1], env) @=> MalObject condition; + + if( condition.type == "error" ) + { + return condition; + } + + if( !(condition.type == "nil") && !(condition.type == "false") ) + { + ast[2] @=> m; + continue; // TCO + } + else + { + if( ast.size() < 4 ) + { + return Constants.NIL; + } + else + { + ast[3] @=> m; + continue; // TCO + } + } + } + else if( a0 == "fn*" ) + { + ast[1].malObjectValues() @=> MalObject arg_values[]; + string args[arg_values.size()]; + + for( 0 => int i; i < arg_values.size(); i++ ) + { + arg_values[i].stringValue => args[i]; + } + + ast[2] @=> MalObject _ast; + + return Func.create(env, args, _ast); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + if( first.type == "subr" ) + { + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else if( first.type == "func" ) + { + first$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + eval_env @=> env; + func.ast @=> m; + continue; // TCO + } + } + else + { + return m; + } + } + Util.panic("Programmer error: TCO loop left incorrectly"); + return null; +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +for( 0 => int i; i < Core.names.size(); i++ ) +{ + Core.names[i] => string name; + repl_env.set(name, Core.ns[name]); +} + +// HACK, HACK, HACK +class MalEval extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject m; + return EVAL(args[0], repl_env); + } + + fun MalObject apply(MalObject f, MalObject args[]) + { + if( f.type == "subr" ) + { + return (f$MalSubr).call(args); + } + else // f.type == "func" + { + f$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + return EVAL(func.ast, eval_env); + } + } +} + +new MalEval @=> MalEval eval; +repl_env.set("eval", new MalEval); +eval @=> (repl_env.get("swap!")$MalSubr).eval; + +fun MalObject[] MalArgv(string args[]) +{ + MalObject values[0]; + + for( 1 => int i; i < args.size(); i++ ) + { + values << MalString.create(args[i]); + } + + return values; +} + +// NOTE: normally I'd use \0, but strings are null-terminated... +String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; +repl_env.set("*ARGV*", MalList.create(MalArgv(args))); + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +if( args.size() > 0 ) +{ + args[0] => string filename; + rep("(load-file \"" + filename + "\")"); +} +else +{ + main(); +} diff --git a/impls/chuck/step7_quote.ck b/impls/chuck/step7_quote.ck new file mode 100644 index 0000000000..d99386b89d --- /dev/null +++ b/impls/chuck/step7_quote.ck @@ -0,0 +1,410 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck +// @import core.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun int startsWith(MalObject a[], string sym) +{ + if (a.size() != 2) + { + return false; + } + + a[0] @=> MalObject a0; + return a0.type == "symbol" && a0.stringValue == sym; +} + +fun MalList qqLoop(MalObject elt, MalList acc) +{ + if( elt.type == "list" ) + { + elt.malObjectValues() @=> MalObject ast[]; + + if( startsWith(ast, "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), ast[1], acc]); + } + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} + +fun MalList qqFoldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qqLoop(a[i], acc) @=> acc; + } + + return acc; +} + +fun MalObject quasiquote(MalObject ast) +{ + ast.type => string type; + if (type == "list") { + ast.malObjectValues() @=> MalObject a[]; + if (startsWith(a, "unquote")) + { + return a[1]; + } + return qqFoldr(a); + } + + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); + } + + if (type == "symbol" || type == "hashmap") + { + return MalList.create([MalSymbol.create("quote"), ast]); + } + + return ast; +} + +fun MalObject EVAL(MalObject m, Env env) +{ + while( true ) + { + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + let_env @=> env; + ast[2] @=> m; + continue; // TCO + } + else if( a0 == "quote" ) + { + return ast[1]; + } + else if( a0 == "quasiquote" ) + { + quasiquote(ast[1]) @=> m; + continue; // TCO + } + else if( a0 == "do" ) + { + for( 1 => int i; i < ast.size() - 1; i++ ) + { + EVAL(ast[i], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + } + + // HACK: this assumes do gets at least one argument... + ast[ast.size()-1] @=> m; + continue; // TCO + } + else if( a0 == "if" ) + { + EVAL(ast[1], env) @=> MalObject condition; + + if( condition.type == "error" ) + { + return condition; + } + + if( !(condition.type == "nil") && !(condition.type == "false") ) + { + ast[2] @=> m; + continue; // TCO + } + else + { + if( ast.size() < 4 ) + { + return Constants.NIL; + } + else + { + ast[3] @=> m; + continue; // TCO + } + } + } + else if( a0 == "fn*" ) + { + ast[1].malObjectValues() @=> MalObject arg_values[]; + string args[arg_values.size()]; + + for( 0 => int i; i < arg_values.size(); i++ ) + { + arg_values[i].stringValue => args[i]; + } + + ast[2] @=> MalObject _ast; + + return Func.create(env, args, _ast); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + if( first.type == "subr" ) + { + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else if( first.type == "func" ) + { + first$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + eval_env @=> env; + func.ast @=> m; + continue; // TCO + } + } + else + { + return m; + } + } + Util.panic("Programmer error: TCO loop left incorrectly"); + return null; +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +for( 0 => int i; i < Core.names.size(); i++ ) +{ + Core.names[i] => string name; + repl_env.set(name, Core.ns[name]); +} + +// HACK, HACK, HACK +class MalEval extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject m; + return EVAL(args[0], repl_env); + } + + fun MalObject apply(MalObject f, MalObject args[]) + { + if( f.type == "subr" ) + { + return (f$MalSubr).call(args); + } + else // f.type == "func" + { + f$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + return EVAL(func.ast, eval_env); + } + } +} + +new MalEval @=> MalEval eval; +repl_env.set("eval", new MalEval); +eval @=> (repl_env.get("swap!")$MalSubr).eval; + +fun MalObject[] MalArgv(string args[]) +{ + MalObject values[0]; + + for( 1 => int i; i < args.size(); i++ ) + { + values << MalString.create(args[i]); + } + + return values; +} + +// NOTE: normally I'd use \0, but strings are null-terminated... +String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; +repl_env.set("*ARGV*", MalList.create(MalArgv(args))); + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +if( args.size() > 0 ) +{ + args[0] => string filename; + rep("(load-file \"" + filename + "\")"); +} +else +{ + main(); +} diff --git a/impls/chuck/step8_macros.ck b/impls/chuck/step8_macros.ck new file mode 100644 index 0000000000..69a15c5abf --- /dev/null +++ b/impls/chuck/step8_macros.ck @@ -0,0 +1,443 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck +// @import core.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun int startsWith(MalObject a[], string sym) +{ + if (a.size() != 2) + { + return false; + } + + a[0] @=> MalObject a0; + return a0.type == "symbol" && a0.stringValue == sym; +} + +fun MalList qqLoop(MalObject elt, MalList acc) +{ + if( elt.type == "list" ) + { + elt.malObjectValues() @=> MalObject ast[]; + + if( startsWith(ast, "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), ast[1], acc]); + } + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} + +fun MalList qqFoldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qqLoop(a[i], acc) @=> acc; + } + + return acc; +} + +fun MalObject quasiquote(MalObject ast) +{ + ast.type => string type; + if (type == "list") { + ast.malObjectValues() @=> MalObject a[]; + if (startsWith(a, "unquote")) + { + return a[1]; + } + return qqFoldr(a); + } + + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); + } + + if (type == "symbol" || type == "hashmap") + { + return MalList.create([MalSymbol.create("quote"), ast]); + } + + return ast; +} + +fun MalObject EVAL(MalObject m, Env env) +{ + while( true ) + { + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + let_env @=> env; + ast[2] @=> m; + continue; // TCO + } + else if( a0 == "quote" ) + { + return ast[1]; + } + else if( a0 == "quasiquote" ) + { + quasiquote(ast[1]) @=> m; + continue; // TCO + } + else if( a0 == "defmacro!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + value.clone() @=> value; + true => (value$Func).isMacro; + + env.set(a1, value); + return value; + } + else if( a0 == "do" ) + { + for( 1 => int i; i < ast.size() - 1; i++ ) + { + EVAL(ast[i], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + } + + // HACK: this assumes do gets at least one argument... + ast[ast.size()-1] @=> m; + continue; // TCO + } + else if( a0 == "if" ) + { + EVAL(ast[1], env) @=> MalObject condition; + + if( condition.type == "error" ) + { + return condition; + } + + if( !(condition.type == "nil") && !(condition.type == "false") ) + { + ast[2] @=> m; + continue; // TCO + } + else + { + if( ast.size() < 4 ) + { + return Constants.NIL; + } + else + { + ast[3] @=> m; + continue; // TCO + } + } + } + else if( a0 == "fn*" ) + { + ast[1].malObjectValues() @=> MalObject arg_values[]; + string args[arg_values.size()]; + + for( 0 => int i; i < arg_values.size(); i++ ) + { + arg_values[i].stringValue => args[i]; + } + + ast[2] @=> MalObject _ast; + + return Func.create(env, args, _ast); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + else if( first.type == "subr" ) + { + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else if( first.type == "func" ) + { + first$Func @=> Func func; + if( func.isMacro ) + { + MalObject.slice(ast, 1) @=> MalObject args[]; + Env.create(func.env, func.args, args) @=> Env eval_env; + EVAL(func.ast, eval_env) @=> m; + continue; // TCO + } + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + Env.create(func.env, func.args, args) @=> Env eval_env; + eval_env @=> env; + func.ast @=> m; + continue; // TCO + } + } + else + { + return m; + } + } + Util.panic("Programmer error: TCO loop left incorrectly"); + return null; +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +for( 0 => int i; i < Core.names.size(); i++ ) +{ + Core.names[i] => string name; + repl_env.set(name, Core.ns[name]); +} + +// HACK, HACK, HACK +class MalEval extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject m; + return EVAL(args[0], repl_env); + } + + fun MalObject apply(MalObject f, MalObject args[]) + { + if( f.type == "subr" ) + { + return (f$MalSubr).call(args); + } + else // f.type == "func" + { + f$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + return EVAL(func.ast, eval_env); + } + } +} + +new MalEval @=> MalEval eval; +repl_env.set("eval", new MalEval); +eval @=> (repl_env.get("swap!")$MalSubr).eval; + +fun MalObject[] MalArgv(string args[]) +{ + MalObject values[0]; + + for( 1 => int i; i < args.size(); i++ ) + { + values << MalString.create(args[i]); + } + + return values; +} + +// NOTE: normally I'd use \0, but strings are null-terminated... +String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; +repl_env.set("*ARGV*", MalList.create(MalArgv(args))); + +fun string errorMessage(MalObject m) +{ + return "exception: " + String.repr(m.malObjectValue().stringValue); +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +if( args.size() > 0 ) +{ + args[0] => string filename; + rep("(load-file \"" + filename + "\")"); +} +else +{ + main(); +} diff --git a/impls/chuck/step9_try.ck b/impls/chuck/step9_try.ck new file mode 100644 index 0000000000..c940fcdec5 --- /dev/null +++ b/impls/chuck/step9_try.ck @@ -0,0 +1,473 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck +// @import core.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun int startsWith(MalObject a[], string sym) +{ + if (a.size() != 2) + { + return false; + } + + a[0] @=> MalObject a0; + return a0.type == "symbol" && a0.stringValue == sym; +} + +fun MalList qqLoop(MalObject elt, MalList acc) +{ + if( elt.type == "list" ) + { + elt.malObjectValues() @=> MalObject ast[]; + + if( startsWith(ast, "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), ast[1], acc]); + } + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} + +fun MalList qqFoldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qqLoop(a[i], acc) @=> acc; + } + + return acc; +} + +fun MalObject quasiquote(MalObject ast) +{ + ast.type => string type; + if (type == "list") { + ast.malObjectValues() @=> MalObject a[]; + if (startsWith(a, "unquote")) + { + return a[1]; + } + return qqFoldr(a); + } + + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); + } + + if (type == "symbol" || type == "hashmap") + { + return MalList.create([MalSymbol.create("quote"), ast]); + } + + return ast; +} + +fun MalObject EVAL(MalObject m, Env env) +{ + while( true ) + { + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + let_env @=> env; + ast[2] @=> m; + continue; // TCO + } + else if( a0 == "quote" ) + { + return ast[1]; + } + else if( a0 == "quasiquote" ) + { + quasiquote(ast[1]) @=> m; + continue; // TCO + } + else if( a0 == "defmacro!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + value.clone() @=> value; + true => (value$Func).isMacro; + + env.set(a1, value); + return value; + } + else if( a0 == "try*" ) + { + EVAL(ast[1], env) @=> MalObject value; + + if( (value.type != "error") || (ast.size() < 3) ) + { + return value; + } + + ast[2].malObjectValues() @=> MalObject form[]; + form[1].stringValue => string name; + value.malObjectValue() @=> MalObject error; + + Env.create(env, [name], [error]) @=> Env error_env; + return EVAL(form[2], error_env); + } + else if( a0 == "do" ) + { + for( 1 => int i; i < ast.size() - 1; i++ ) + { + EVAL(ast[i], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + } + + // HACK: this assumes do gets at least one argument... + ast[ast.size()-1] @=> m; + continue; // TCO + } + else if( a0 == "if" ) + { + EVAL(ast[1], env) @=> MalObject condition; + + if( condition.type == "error" ) + { + return condition; + } + + if( !(condition.type == "nil") && !(condition.type == "false") ) + { + ast[2] @=> m; + continue; // TCO + } + else + { + if( ast.size() < 4 ) + { + return Constants.NIL; + } + else + { + ast[3] @=> m; + continue; // TCO + } + } + } + else if( a0 == "fn*" ) + { + ast[1].malObjectValues() @=> MalObject arg_values[]; + string args[arg_values.size()]; + + for( 0 => int i; i < arg_values.size(); i++ ) + { + arg_values[i].stringValue => args[i]; + } + + ast[2] @=> MalObject _ast; + + return Func.create(env, args, _ast); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + else if( first.type == "subr" ) + { + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else if( first.type == "func" ) + { + first$Func @=> Func func; + if( func.isMacro ) + { + MalObject.slice(ast, 1) @=> MalObject args[]; + Env.create(func.env, func.args, args) @=> Env eval_env; + EVAL(func.ast, eval_env) @=> m; + continue; // TCO + } + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + Env.create(func.env, func.args, args) @=> Env eval_env; + eval_env @=> env; + func.ast @=> m; + continue; // TCO + } + } + else + { + return m; + } + } + Util.panic("Programmer error: TCO loop left incorrectly"); + return null; +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +for( 0 => int i; i < Core.names.size(); i++ ) +{ + Core.names[i] => string name; + repl_env.set(name, Core.ns[name]); +} + +// HACK, HACK, HACK +class MalEval extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject m; + return EVAL(args[0], repl_env); + } + + fun MalObject apply(MalObject f, MalObject args[]) + { + if( f.type == "subr" ) + { + return (f$MalSubr).call(args); + } + else // f.type == "func" + { + f$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + return EVAL(func.ast, eval_env); + } + } +} + +new MalEval @=> MalEval eval; +repl_env.set("eval", new MalEval); +eval @=> (repl_env.get("swap!")$MalSubr).eval; +eval @=> (repl_env.get("apply")$MalSubr).eval; +eval @=> (repl_env.get("map")$MalSubr).eval; + +fun MalObject[] MalArgv(string args[]) +{ + MalObject values[0]; + + for( 1 => int i; i < args.size(); i++ ) + { + values << MalString.create(args[i]); + } + + return values; +} + +// NOTE: normally I'd use \0, but strings are null-terminated... +String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; +repl_env.set("*ARGV*", MalList.create(MalArgv(args))); + +fun string errorMessage(MalObject m) +{ + m.malObjectValue() @=> MalObject e; + string message; + + if( e.type == "string" ) + { + String.repr(e.stringValue) => message; + } + else + { + Printer.pr_str(e, true) => message; + } + + return "exception: " + message; +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +if( args.size() > 0 ) +{ + args[0] => string filename; + rep("(load-file \"" + filename + "\")"); +} +else +{ + main(); +} diff --git a/impls/chuck/stepA_mal.ck b/impls/chuck/stepA_mal.ck new file mode 100644 index 0000000000..230adea8a3 --- /dev/null +++ b/impls/chuck/stepA_mal.ck @@ -0,0 +1,476 @@ +// @import readline.ck +// @import types/MalObject.ck +// @import types/mal/MalAtom.ck +// @import types/mal/MalString.ck +// @import types/mal/MalError.ck +// @import types/mal/MalNil.ck +// @import types/mal/MalFalse.ck +// @import types/mal/MalTrue.ck +// @import types/mal/MalInt.ck +// @import types/mal/MalSymbol.ck +// @import types/mal/MalKeyword.ck +// @import types/mal/MalList.ck +// @import types/mal/MalVector.ck +// @import types/mal/MalHashMap.ck +// @import util/*.ck +// @import reader.ck +// @import printer.ck +// @import env.ck +// @import func.ck +// @import types/MalSubr.ck +// @import types/subr/*.ck +// @import core.ck + +fun MalObject READ(string input) +{ + return Reader.read_str(input); +} + +fun int startsWith(MalObject a[], string sym) +{ + if (a.size() != 2) + { + return false; + } + + a[0] @=> MalObject a0; + return a0.type == "symbol" && a0.stringValue == sym; +} + +fun MalList qqLoop(MalObject elt, MalList acc) +{ + if( elt.type == "list" ) + { + elt.malObjectValues() @=> MalObject ast[]; + + if( startsWith(ast, "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), ast[1], acc]); + } + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} + +fun MalList qqFoldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qqLoop(a[i], acc) @=> acc; + } + + return acc; +} + +fun MalObject quasiquote(MalObject ast) +{ + ast.type => string type; + if (type == "list") { + ast.malObjectValues() @=> MalObject a[]; + if (startsWith(a, "unquote")) + { + return a[1]; + } + return qqFoldr(a); + } + + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); + } + + if (type == "symbol" || type == "hashmap") + { + return MalList.create([MalSymbol.create("quote"), ast]); + } + + return ast; +} + +fun MalObject EVAL(MalObject m, Env env) +{ + while( true ) + { + env.find("DEBUG-EVAL") @=> MalObject debugEval; + if( debugEval != null && (debugEval.type != "false" && + debugEval.type != "nil" ) ) + { + Util.println("EVAL: " + Printer.pr_str(m, true)); + } + + if( m.type == "symbol" ) + { + return env.get(m.stringValue); + } + else if( m.type == "vector" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + EVAL(values[i], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> results[i]; + } + return MalVector.create(results); + } + else if( m.type == "hashmap" ) + { + m.malObjectValues() @=> MalObject values[]; + MalObject results[values.size()]; + for( 0 => int i; i < values.size(); i++ ) + { + if( i % 2 == 0 ) + { + values[i] @=> results[i]; + } + else + { + EVAL(values[i], env) @=> results[i]; + } + } + return MalHashMap.create(results); + } + else if( m.type == "list" ) + { + m.malObjectValues() @=> MalObject ast[]; + + if( ast.size() == 0 ) + { + return m; + } + else if( ast[0].type == "symbol" ) + { + ast[0].stringValue => string a0; + + if( a0 == "def!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + env.set(a1, value); + return value; + } + else if( a0 == "let*" ) + { + Env.create(env) @=> Env let_env; + ast[1].malObjectValues() @=> MalObject bindings[]; + + for( 0 => int i; i < bindings.size(); 2 +=> i) + { + bindings[i].stringValue => string symbol; + EVAL(bindings[i+1], let_env) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + let_env.set(symbol, value); + } + + let_env @=> env; + ast[2] @=> m; + continue; // TCO + } + else if( a0 == "quote" ) + { + return ast[1]; + } + else if( a0 == "quasiquote" ) + { + quasiquote(ast[1]) @=> m; + continue; // TCO + } + else if( a0 == "defmacro!" ) + { + ast[1].stringValue => string a1; + + EVAL(ast[2], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + + value.clone() @=> value; + true => (value$Func).isMacro; + + env.set(a1, value); + return value; + } + else if( a0 == "try*" ) + { + EVAL(ast[1], env) @=> MalObject value; + + if( (value.type != "error") || (ast.size() < 3) ) + { + return value; + } + + ast[2].malObjectValues() @=> MalObject form[]; + form[1].stringValue => string name; + value.malObjectValue() @=> MalObject error; + + Env.create(env, [name], [error]) @=> Env error_env; + return EVAL(form[2], error_env); + } + else if( a0 == "do" ) + { + for( 1 => int i; i < ast.size() - 1; i++ ) + { + EVAL(ast[i], env) @=> MalObject value; + if( value.type == "error" ) + { + return value; + } + } + + // HACK: this assumes do gets at least one argument... + ast[ast.size()-1] @=> m; + continue; // TCO + } + else if( a0 == "if" ) + { + EVAL(ast[1], env) @=> MalObject condition; + + if( condition.type == "error" ) + { + return condition; + } + + if( !(condition.type == "nil") && !(condition.type == "false") ) + { + ast[2] @=> m; + continue; // TCO + } + else + { + if( ast.size() < 4 ) + { + return Constants.NIL; + } + else + { + ast[3] @=> m; + continue; // TCO + } + } + } + else if( a0 == "fn*" ) + { + ast[1].malObjectValues() @=> MalObject arg_values[]; + string args[arg_values.size()]; + + for( 0 => int i; i < arg_values.size(); i++ ) + { + arg_values[i].stringValue => args[i]; + } + + ast[2] @=> MalObject _ast; + + return Func.create(env, args, _ast); + } + } + + EVAL(ast[0], env) @=> MalObject first; + if( first.type == "error" ) + { + return first; + } + else if( first.type == "subr" ) + { + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + first$MalSubr @=> MalSubr subr; + return subr.call(args); + } + else if( first.type == "func" ) + { + first$Func @=> Func func; + if( func.isMacro ) + { + MalObject.slice(ast, 1) @=> MalObject args[]; + Env.create(func.env, func.args, args) @=> Env eval_env; + EVAL(func.ast, eval_env) @=> m; + continue; // TCO + } + MalObject args[ast.size() - 1]; + for( 0 => int i; i < args.size(); i++ ) + { + EVAL(ast[i + 1], env) @=> MalObject result; + if( result.type == "error" ) + { + return result; + } + result @=> args[i]; + } + Env.create(func.env, func.args, args) @=> Env eval_env; + eval_env @=> env; + func.ast @=> m; + continue; // TCO + } + } + else + { + return m; + } + } + Util.panic("Programmer error: TCO loop left incorrectly"); + return null; +} + +fun string PRINT(MalObject m) +{ + return Printer.pr_str(m, true); +} + +Env.create(null) @=> Env repl_env; +for( 0 => int i; i < Core.names.size(); i++ ) +{ + Core.names[i] => string name; + repl_env.set(name, Core.ns[name]); +} + +// HACK, HACK, HACK +class MalEval extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject m; + return EVAL(args[0], repl_env); + } + + fun MalObject apply(MalObject f, MalObject args[]) + { + if( f.type == "subr" ) + { + return (f$MalSubr).call(args); + } + else // f.type == "func" + { + f$Func @=> Func func; + Env.create(func.env, func.args, args) @=> Env eval_env; + return EVAL(func.ast, eval_env); + } + } +} + +new MalEval @=> MalEval eval; +repl_env.set("eval", new MalEval); +eval @=> (repl_env.get("swap!")$MalSubr).eval; +eval @=> (repl_env.get("apply")$MalSubr).eval; +eval @=> (repl_env.get("map")$MalSubr).eval; + +fun MalObject[] MalArgv(string args[]) +{ + MalObject values[0]; + + for( 1 => int i; i < args.size(); i++ ) + { + values << MalString.create(args[i]); + } + + return values; +} + +// NOTE: normally I'd use \0, but strings are null-terminated... +String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; +repl_env.set("*ARGV*", MalList.create(MalArgv(args))); + +repl_env.set("*host-language*", MalString.create("chuck")); + +fun string errorMessage(MalObject m) +{ + m.malObjectValue() @=> MalObject e; + string message; + + if( e.type == "string" ) + { + String.repr(e.stringValue) => message; + } + else + { + Printer.pr_str(e, true) => message; + } + + return "exception: " + message; +} + +fun string rep(string input) +{ + READ(input) @=> MalObject m; + + if( m.type == "error" ) + { + return errorMessage(m); + } + + EVAL(m, repl_env) @=> MalObject result; + if( result.type == "error" ) + { + return errorMessage(result); + } + + return PRINT(result); +} + +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +fun void main() +{ + int done; + + while( !done ) + { + Readline.readline("user> ") => string input; + + if( input != null ) + { + rep(input) => string output; + + if( output == "exception: \"empty input\"" ) + { + // proceed immediately with prompt + } + else + { + Util.println(output); + } + } + else + { + true => done; + } + } +} + +if( args.size() > 0 ) +{ + args[0] => string filename; + rep("(load-file \"" + filename + "\")"); +} +else +{ + rep("(println (str \"Mal [\" *host-language* \"]\"))"); + main(); +} diff --git a/impls/chuck/tests/step5_tco.mal b/impls/chuck/tests/step5_tco.mal new file mode 100644 index 0000000000..c4a73cc207 --- /dev/null +++ b/impls/chuck/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; ChucK: skipping non-TCO recursion +;; Reason: stackoverflow (non-recoverable) diff --git a/impls/chuck/types/MalObject.ck b/impls/chuck/types/MalObject.ck new file mode 100644 index 0000000000..b45a1ffc6c --- /dev/null +++ b/impls/chuck/types/MalObject.ck @@ -0,0 +1,108 @@ +public class MalObject +{ + string type; + + int intValue; + string stringValue; + // HACK: data types can't be self-referential, so Object it is + Object object; + Object objects[]; + // NOTE: an object member does *not* default to null... + null => Object meta; + + fun MalObject malObjectValue() + { + return object$MalObject; + } + + fun MalObject[] malObjectValues() + { + MalObject values[objects.size()]; + + for( 0 => int i; i < objects.size(); i++ ) + { + objects[i]$MalObject @=> values[i]; + } + + return values; + } + + fun MalObject clone() + { + MalObject value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } + + // helpers for sequence types + + fun static Object[] toObjectArray(MalObject objects[]) + { + Object values[objects.size()]; + + for( 0 => int i; i < objects.size(); i++ ) + { + objects[i]$Object @=> values[i]; + } + + return values; + } + + fun static MalObject[] slice(MalObject objects[], int index) + { + MalObject values[objects.size() - index]; + + for( index => int i; i < objects.size(); i++ ) + { + objects[i] @=> values[i - index]; + } + + return values; + } + + fun static MalObject[] slice(MalObject objects[], int from, int to) + { + MalObject values[0]; + + for( from => int i; i < to; i++ ) + { + values << objects[i]; + } + + return values; + } + + fun static MalObject[] append(MalObject as[], MalObject bs[]) + { + MalObject output[as.size()+bs.size()]; + + for( 0 => int i; i < as.size(); i++ ) + { + as[i] @=> output[i]; + } + + for( 0 => int i; i < bs.size(); i++ ) + { + bs[i] @=> output[as.size()+i]; + } + + return output; + } + + fun static MalObject[] reverse(MalObject objects[]) + { + MalObject output[objects.size()]; + + for( 0 => int i; i < output.size(); i++ ) + { + objects[i] @=> output[output.size()-i-1]; + } + + return output; + } +} diff --git a/impls/chuck/types/MalSubr.ck b/impls/chuck/types/MalSubr.ck new file mode 100644 index 0000000000..0dc99a3762 --- /dev/null +++ b/impls/chuck/types/MalSubr.ck @@ -0,0 +1,17 @@ +public class MalSubr extends MalObject +{ + "subr" => type; + string name; + // HACK + MalObject eval; + + fun MalObject call(MalObject args[]) + { + return new MalObject; + } + + fun MalObject apply(MalObject f, MalObject args[]) + { + return new MalObject; + } +} diff --git a/impls/chuck/types/mal/MalAtom.ck b/impls/chuck/types/mal/MalAtom.ck new file mode 100644 index 0000000000..618b5b3873 --- /dev/null +++ b/impls/chuck/types/mal/MalAtom.ck @@ -0,0 +1,28 @@ +public class MalAtom extends MalObject +{ + "atom" => type; + + fun void init(MalObject value) + { + value @=> object; + } + + fun static MalObject create(MalObject value) + { + MalAtom m; + m.init(value); + return m; + } + + fun MalObject clone() + { + MalAtom value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalError.ck b/impls/chuck/types/mal/MalError.ck new file mode 100644 index 0000000000..67ca1c67cc --- /dev/null +++ b/impls/chuck/types/mal/MalError.ck @@ -0,0 +1,23 @@ +public class MalError extends MalObject +{ + "error" => type; + + fun void init(MalObject value) + { + value @=> object; + } + + fun static MalError create(string value) + { + MalError m; + m.init(MalString.create(value)); + return m; + } + + fun static MalError create(MalObject value) + { + MalError m; + m.init(value); + return m; + } +} diff --git a/impls/chuck/types/mal/MalFalse.ck b/impls/chuck/types/mal/MalFalse.ck new file mode 100644 index 0000000000..cb3171d5e3 --- /dev/null +++ b/impls/chuck/types/mal/MalFalse.ck @@ -0,0 +1,28 @@ +public class MalFalse extends MalObject +{ + "false" => type; + + fun void init() + { + 0 => intValue; + } + + fun static MalFalse create() + { + MalFalse m; + m.init(); + return m; + } + + fun MalObject clone() + { + MalFalse value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalHashMap.ck b/impls/chuck/types/mal/MalHashMap.ck new file mode 100644 index 0000000000..e4d64b1003 --- /dev/null +++ b/impls/chuck/types/mal/MalHashMap.ck @@ -0,0 +1,69 @@ +// HACK: it's hard to pull in util before data types + +public class MalHashMap extends MalObject +{ + "hashmap" => type; + + + fun string keyName(MalObject m) + { + if( m.type == "string" || m.type == "keyword" ) + { + return m.stringValue; + } + else + { + cherr <= "User error (non-string/keyword key)\n"; + return ""; + } + } + + fun void init(MalObject values[]) + { + MalObject result[0]; + MalObject cachedKeys[0]; + MalObject cachedValues[0]; + string keys[0]; + + for( 0 => int i; i < values.size(); 2 +=> i ) + { + keyName(values[i]) => string key; + + if( cachedValues[key] == null ) + { + keys << key; + } + + values[i] @=> cachedKeys[key]; + values[i+1] @=> cachedValues[key]; + } + + for( 0 => int i; i < keys.size(); i++ ) + { + keys[i] => string key; + result << cachedKeys[key]; + result << cachedValues[key]; + } + + MalObject.toObjectArray(result) @=> objects; + } + + fun static MalHashMap create(MalObject values[]) + { + MalHashMap m; + m.init(values); + return m; + } + + fun MalObject clone() + { + MalHashMap value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalInt.ck b/impls/chuck/types/mal/MalInt.ck new file mode 100644 index 0000000000..1bc347e63a --- /dev/null +++ b/impls/chuck/types/mal/MalInt.ck @@ -0,0 +1,28 @@ +public class MalInt extends MalObject +{ + "int" => type; + + fun void init(int value) + { + value => intValue; + } + + fun static MalInt create(int value) + { + MalInt m; + m.init(value); + return m; + } + + fun MalObject clone() + { + MalInt value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalKeyword.ck b/impls/chuck/types/mal/MalKeyword.ck new file mode 100644 index 0000000000..5a55885a95 --- /dev/null +++ b/impls/chuck/types/mal/MalKeyword.ck @@ -0,0 +1,28 @@ +public class MalKeyword extends MalObject +{ + "keyword" => type; + + fun void init(string value) + { + value => stringValue; + } + + fun static MalKeyword create(string value) + { + MalKeyword m; + m.init(value); + return m; + } + + fun MalObject clone() + { + MalKeyword value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalList.ck b/impls/chuck/types/mal/MalList.ck new file mode 100644 index 0000000000..3371119ae4 --- /dev/null +++ b/impls/chuck/types/mal/MalList.ck @@ -0,0 +1,28 @@ +public class MalList extends MalObject +{ + "list" => type; + + fun void init(MalObject values[]) + { + MalObject.toObjectArray(values) @=> objects; + } + + fun static MalList create(MalObject values[]) + { + MalList m; + m.init(values); + return m; + } + + fun MalObject clone() + { + MalList value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalNil.ck b/impls/chuck/types/mal/MalNil.ck new file mode 100644 index 0000000000..66a3def23f --- /dev/null +++ b/impls/chuck/types/mal/MalNil.ck @@ -0,0 +1,28 @@ +public class MalNil extends MalObject +{ + "nil" => type; + + fun void init() + { + -1 => intValue; + } + + fun static MalNil create() + { + MalNil m; + m.init(); + return m; + } + + fun MalObject clone() + { + MalNil value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalString.ck b/impls/chuck/types/mal/MalString.ck new file mode 100644 index 0000000000..7ca8f82f03 --- /dev/null +++ b/impls/chuck/types/mal/MalString.ck @@ -0,0 +1,28 @@ +public class MalString extends MalObject +{ + "string" => type; + + fun void init(string value) + { + value => stringValue; + } + + fun static MalString create(string value) + { + MalString m; + m.init(value); + return m; + } + + fun MalObject clone() + { + MalString value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalSymbol.ck b/impls/chuck/types/mal/MalSymbol.ck new file mode 100644 index 0000000000..194c1ae1f6 --- /dev/null +++ b/impls/chuck/types/mal/MalSymbol.ck @@ -0,0 +1,28 @@ +public class MalSymbol extends MalObject +{ + "symbol" => type; + + fun void init(string value) + { + value => stringValue; + } + + fun static MalSymbol create(string value) + { + MalSymbol m; + m.init(value); + return m; + } + + fun MalObject clone() + { + MalSymbol value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalTrue.ck b/impls/chuck/types/mal/MalTrue.ck new file mode 100644 index 0000000000..a54d601d06 --- /dev/null +++ b/impls/chuck/types/mal/MalTrue.ck @@ -0,0 +1,28 @@ +public class MalTrue extends MalObject +{ + "true" => type; + + fun void init() + { + 1 => intValue; + } + + fun static MalTrue create() + { + MalTrue m; + m.init(); + return m; + } + + fun MalObject clone() + { + MalTrue value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/mal/MalVector.ck b/impls/chuck/types/mal/MalVector.ck new file mode 100644 index 0000000000..565d50eb7f --- /dev/null +++ b/impls/chuck/types/mal/MalVector.ck @@ -0,0 +1,28 @@ +public class MalVector extends MalObject +{ + "vector" => type; + + fun void init(MalObject values[]) + { + MalObject.toObjectArray(values) @=> objects; + } + + fun static MalVector create(MalObject values[]) + { + MalVector m; + m.init(values); + return m; + } + + fun MalObject clone() + { + MalVector value; + + this.type => value.type; + this.object @=> value.object; + this.objects @=> value.objects; + this.meta @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/types/subr/MalAdd.ck b/impls/chuck/types/subr/MalAdd.ck new file mode 100644 index 0000000000..4d6cf63a0f --- /dev/null +++ b/impls/chuck/types/subr/MalAdd.ck @@ -0,0 +1,7 @@ +public class MalAdd extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalInt.create(args[0].intValue + args[1].intValue); + } +} diff --git a/impls/chuck/types/subr/MalApply.ck b/impls/chuck/types/subr/MalApply.ck new file mode 100644 index 0000000000..84e1c09e98 --- /dev/null +++ b/impls/chuck/types/subr/MalApply.ck @@ -0,0 +1,12 @@ +public class MalApply extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject f; + MalObject.slice(args, 1, args.size()-1) @=> MalObject _args[]; + args[args.size()-1].malObjectValues() @=> MalObject rest[]; + + MalObject.append(_args, rest) @=> _args; + return (eval$MalSubr).apply(f, _args); + } +} diff --git a/impls/chuck/types/subr/MalAssoc.ck b/impls/chuck/types/subr/MalAssoc.ck new file mode 100644 index 0000000000..2da4325a8a --- /dev/null +++ b/impls/chuck/types/subr/MalAssoc.ck @@ -0,0 +1,45 @@ +public class MalAssoc extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].malObjectValues() @=> MalObject map[]; + MalObject.slice(args, 1) @=> MalObject kvs[]; + + MalObject result[0]; + MalObject cachedKeys[0]; + MalObject cachedValues[0]; + string keys[0]; + + for( 0 => int i; i < map.size(); 2 +=> i ) + { + map[i].stringValue => string key; + + keys << key; + + map[i] @=> cachedKeys[key]; + map[i+1] @=> cachedValues[key]; + } + + for( 0 => int i; i < kvs.size(); 2 +=> i ) + { + kvs[i].stringValue => string key; + + if( cachedValues[key] == null ) + { + keys << key; + } + + kvs[i] @=> cachedKeys[key]; + kvs[i+1] @=> cachedValues[key]; + } + + for( 0 => int i; i < keys.size(); i++ ) + { + keys[i] => string key; + result << cachedKeys[key]; + result << cachedValues[key]; + } + + return MalHashMap.create(result); + } +} diff --git a/impls/chuck/types/subr/MalAtomify.ck b/impls/chuck/types/subr/MalAtomify.ck new file mode 100644 index 0000000000..3ec8b21733 --- /dev/null +++ b/impls/chuck/types/subr/MalAtomify.ck @@ -0,0 +1,8 @@ +public class MalAtomify extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject m; + return MalAtom.create(m); + } +} diff --git a/impls/chuck/types/subr/MalConcat.ck b/impls/chuck/types/subr/MalConcat.ck new file mode 100644 index 0000000000..0574ca78dd --- /dev/null +++ b/impls/chuck/types/subr/MalConcat.ck @@ -0,0 +1,15 @@ +public class MalConcat extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + MalObject value[0]; + + for( 0 => int i; i < args.size(); i++ ) + { + args[i].malObjectValues() @=> MalObject list[]; + MalObject.append(value, list) @=> value; + } + + return MalList.create(value); + } +} diff --git a/impls/chuck/types/subr/MalConj.ck b/impls/chuck/types/subr/MalConj.ck new file mode 100644 index 0000000000..feb305f76b --- /dev/null +++ b/impls/chuck/types/subr/MalConj.ck @@ -0,0 +1,17 @@ +public class MalConj extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].malObjectValues() @=> MalObject list[]; + MalObject.slice(args, 1) @=> MalObject rest[]; + + if( args[0].type == "list" ) + { + return MalList.create(MalObject.append(MalObject.reverse(rest), list)); + } + else // args[0].type == "vector" + { + return MalVector.create(MalObject.append(list, rest)); + } + } +} diff --git a/impls/chuck/types/subr/MalCons.ck b/impls/chuck/types/subr/MalCons.ck new file mode 100644 index 0000000000..f33559651f --- /dev/null +++ b/impls/chuck/types/subr/MalCons.ck @@ -0,0 +1,9 @@ +public class MalCons extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + args[1].malObjectValues() @=> MalObject list[]; + return MalList.create(MalObject.append([arg], list)); + } +} diff --git a/impls/chuck/types/subr/MalCount.ck b/impls/chuck/types/subr/MalCount.ck new file mode 100644 index 0000000000..8952732d3a --- /dev/null +++ b/impls/chuck/types/subr/MalCount.ck @@ -0,0 +1,15 @@ +public class MalCount extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].type => string kind; + if( kind == "list" || kind == "vector" ) + { + return MalInt.create(args[0].objects.size()); + } + else + { + return MalInt.create(0); + } + } +} diff --git a/impls/chuck/types/subr/MalDeref.ck b/impls/chuck/types/subr/MalDeref.ck new file mode 100644 index 0000000000..ce2fb4fa69 --- /dev/null +++ b/impls/chuck/types/subr/MalDeref.ck @@ -0,0 +1,7 @@ +public class MalDeref extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return args[0].malObjectValue(); + } +} diff --git a/impls/chuck/types/subr/MalDissoc.ck b/impls/chuck/types/subr/MalDissoc.ck new file mode 100644 index 0000000000..1c89842e3b --- /dev/null +++ b/impls/chuck/types/subr/MalDissoc.ck @@ -0,0 +1,31 @@ +public class MalDissoc extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].malObjectValues() @=> MalObject map[]; + MalObject.slice(args, 1) @=> MalObject ks[]; + + MalObject result[0]; + string cachedKeys[0]; + + for( 0 => int i; i < ks.size(); i++ ) + { + ks[i].type => cachedKeys[ks[i].stringValue]; + } + + for( 0 => int i; i < map.size(); 2 +=> i ) + { + map[i] @=> MalObject key; + map[i+1] @=> MalObject value; + + if ( cachedKeys[key.stringValue] == null + || cachedKeys[key.stringValue] != key.type ) + { + result << key; + result << value; + } + } + + return MalHashMap.create(result); + } +} diff --git a/impls/chuck/types/subr/MalDiv.ck b/impls/chuck/types/subr/MalDiv.ck new file mode 100644 index 0000000000..9bc95831f8 --- /dev/null +++ b/impls/chuck/types/subr/MalDiv.ck @@ -0,0 +1,7 @@ +public class MalDiv extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalInt.create(args[0].intValue / args[1].intValue); + } +} diff --git a/impls/chuck/types/subr/MalDoReset.ck b/impls/chuck/types/subr/MalDoReset.ck new file mode 100644 index 0000000000..74838e3b4a --- /dev/null +++ b/impls/chuck/types/subr/MalDoReset.ck @@ -0,0 +1,12 @@ +public class MalDoReset extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0]$MalAtom @=> MalAtom atom; + args[1]$MalObject @=> MalObject value; + + value @=> atom.object; + + return value; + } +} diff --git a/impls/chuck/types/subr/MalDoSwap.ck b/impls/chuck/types/subr/MalDoSwap.ck new file mode 100644 index 0000000000..da285b361a --- /dev/null +++ b/impls/chuck/types/subr/MalDoSwap.ck @@ -0,0 +1,15 @@ +public class MalDoSwap extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0]$MalAtom @=> MalAtom atom; + atom.malObjectValue() @=> MalObject value; + args[1] @=> MalObject f; + MalObject.slice(args, 2) @=> MalObject _args[]; + MalObject.append([value], _args) @=> _args; + + (eval$MalSubr).apply(f, _args) @=> value; + value @=> atom.object; + return value; + } +} diff --git a/impls/chuck/types/subr/MalEqual.ck b/impls/chuck/types/subr/MalEqual.ck new file mode 100644 index 0000000000..8b7fd90585 --- /dev/null +++ b/impls/chuck/types/subr/MalEqual.ck @@ -0,0 +1,126 @@ +public class MalEqual extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject a; + args[1] @=> MalObject b; + + if( ( a.type == "list" || a.type == "vector" ) && + ( b.type == "list" || b.type == "vector" ) ) + { + a.malObjectValues() @=> MalObject as[]; + b.malObjectValues() @=> MalObject bs[]; + + if( as.size() != bs.size() ) + { + return Constants.FALSE; + } + + for( 0 => int i; i < as.size(); i++ ) + { + call([as[i], bs[i]]) @=> MalObject value; + if( value.type != "true" ) + { + return Constants.FALSE; + } + } + + return Constants.TRUE; + } + + if( a.type == "hashmap" && b.type == "hashmap" ) + { + a.malObjectValues() @=> MalObject akvs[]; + b.malObjectValues() @=> MalObject bkvs[]; + + if( akvs.size() != bkvs.size() ) + { + return Constants.FALSE; + } + + MalObject bmap[0]; + + for( 0 => int i; i < bkvs.size(); 2 +=> i ) + { + bkvs[i].stringValue => string keyName; + bkvs[i+1] @=> bmap[keyName]; + } + + + for( 0 => int i; i < akvs.size(); 2 +=> i ) + { + akvs[i] @=> MalObject key; + akvs[i+1] @=> MalObject value; + key.stringValue => string keyName; + + if( bmap[keyName] == null || + call([value, bmap[keyName]]).type != "true" ) + { + return Constants.FALSE; + } + } + + return Constants.TRUE; + } + + if( a.type != b.type ) + { + return Constants.FALSE; + } + + // NOTE: normally I'd go for a type variable, but its scope + // isn't handled properly in the presence of a member variable + a.type => string kind; + if( kind == "true" || kind == "false" || kind == "nil" ) + { + return Constants.TRUE; + } + else if( kind == "int" ) + { + if( a.intValue == b.intValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } + else if( kind == "string" ) + { + if( a.stringValue == b.stringValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } + else if( kind == "symbol" ) + { + if( a.stringValue == b.stringValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } + else if( kind == "keyword" ) + { + if( a.stringValue == b.stringValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } + + // HACK: return false for everything unknown for now + return Constants.FALSE; + } +} diff --git a/impls/chuck/types/subr/MalFirst.ck b/impls/chuck/types/subr/MalFirst.ck new file mode 100644 index 0000000000..7750ec6633 --- /dev/null +++ b/impls/chuck/types/subr/MalFirst.ck @@ -0,0 +1,23 @@ +public class MalFirst extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "nil" ) + { + return Constants.NIL; + } + + arg.malObjectValues() @=> MalObject list[]; + + if( list.size() > 0 ) + { + return list[0]; + } + else + { + return Constants.NIL; + } + } +} diff --git a/impls/chuck/types/subr/MalGet.ck b/impls/chuck/types/subr/MalGet.ck new file mode 100644 index 0000000000..6d95072444 --- /dev/null +++ b/impls/chuck/types/subr/MalGet.ck @@ -0,0 +1,40 @@ +public class MalGet extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].type == "nil" ) + { + return Constants.NIL; + } + + args[0].malObjectValues() @=> MalObject map[]; + args[1].stringValue => string keyName; + + MalObject mapKey; + MalObject mapValue; + false => int isKeyPresent; + 0 => int i; + + while( !isKeyPresent && i < map.size() ) + { + map[i] @=> mapKey; + map[i+1] @=> mapValue; + + if( keyName == mapKey.stringValue && args[1].type == mapKey.type ) + { + true => isKeyPresent; + } + + 2 +=> i; + } + + if( isKeyPresent ) + { + return mapValue; + } + else + { + return Constants.NIL; + } + } +} diff --git a/impls/chuck/types/subr/MalGreater.ck b/impls/chuck/types/subr/MalGreater.ck new file mode 100644 index 0000000000..a49da4be31 --- /dev/null +++ b/impls/chuck/types/subr/MalGreater.ck @@ -0,0 +1,14 @@ +public class MalGreater extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].intValue > args[1].intValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalGreaterEqual.ck b/impls/chuck/types/subr/MalGreaterEqual.ck new file mode 100644 index 0000000000..719f22872d --- /dev/null +++ b/impls/chuck/types/subr/MalGreaterEqual.ck @@ -0,0 +1,14 @@ +public class MalGreaterEqual extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].intValue >= args[1].intValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalHashMapify.ck b/impls/chuck/types/subr/MalHashMapify.ck new file mode 100644 index 0000000000..0c4b4adc7e --- /dev/null +++ b/impls/chuck/types/subr/MalHashMapify.ck @@ -0,0 +1,7 @@ +public class MalHashMapify extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalHashMap.create(args); + } +} diff --git a/impls/chuck/types/subr/MalIsAtom.ck b/impls/chuck/types/subr/MalIsAtom.ck new file mode 100644 index 0000000000..3377edb782 --- /dev/null +++ b/impls/chuck/types/subr/MalIsAtom.ck @@ -0,0 +1,14 @@ +public class MalIsAtom extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].type == "atom" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsContains.ck b/impls/chuck/types/subr/MalIsContains.ck new file mode 100644 index 0000000000..10c5105a44 --- /dev/null +++ b/impls/chuck/types/subr/MalIsContains.ck @@ -0,0 +1,34 @@ +public class MalIsContains extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].malObjectValues() @=> MalObject map[]; + args[1].stringValue => string keyName; + + MalObject mapKey; + MalObject mapValue; + false => int isKeyPresent; + 0 => int i; + + while( !isKeyPresent && i < map.size() ) + { + map[i] @=> mapKey; + + if( keyName == mapKey.stringValue && args[1].type == mapKey.type ) + { + true => isKeyPresent; + } + + 2 +=> i; + } + + if( isKeyPresent ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsEmpty.ck b/impls/chuck/types/subr/MalIsEmpty.ck new file mode 100644 index 0000000000..6bbf33f7a9 --- /dev/null +++ b/impls/chuck/types/subr/MalIsEmpty.ck @@ -0,0 +1,14 @@ +public class MalIsEmpty extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].objects.size() == 0 ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsFalse.ck b/impls/chuck/types/subr/MalIsFalse.ck new file mode 100644 index 0000000000..b4866d1d21 --- /dev/null +++ b/impls/chuck/types/subr/MalIsFalse.ck @@ -0,0 +1,16 @@ +public class MalIsFalse extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "false" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsFn.ck b/impls/chuck/types/subr/MalIsFn.ck new file mode 100644 index 0000000000..a3df6131f7 --- /dev/null +++ b/impls/chuck/types/subr/MalIsFn.ck @@ -0,0 +1,15 @@ +public class MalIsFn extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].type == "subr" || ( args[0].type == "func" && + !(args[0]$Func).isMacro ) ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsHashMap.ck b/impls/chuck/types/subr/MalIsHashMap.ck new file mode 100644 index 0000000000..00dfe7e7df --- /dev/null +++ b/impls/chuck/types/subr/MalIsHashMap.ck @@ -0,0 +1,16 @@ +public class MalIsHashMap extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "hashmap" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsKeyword.ck b/impls/chuck/types/subr/MalIsKeyword.ck new file mode 100644 index 0000000000..4e76dc4de8 --- /dev/null +++ b/impls/chuck/types/subr/MalIsKeyword.ck @@ -0,0 +1,16 @@ +public class MalIsKeyword extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "keyword" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsList.ck b/impls/chuck/types/subr/MalIsList.ck new file mode 100644 index 0000000000..63dd165c22 --- /dev/null +++ b/impls/chuck/types/subr/MalIsList.ck @@ -0,0 +1,14 @@ +public class MalIsList extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].type == "list" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsMacro.ck b/impls/chuck/types/subr/MalIsMacro.ck new file mode 100644 index 0000000000..1ed2fc73a2 --- /dev/null +++ b/impls/chuck/types/subr/MalIsMacro.ck @@ -0,0 +1,14 @@ +public class MalIsMacro extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].type == "func" && (args[0]$Func).isMacro ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsNil.ck b/impls/chuck/types/subr/MalIsNil.ck new file mode 100644 index 0000000000..32940d3b3b --- /dev/null +++ b/impls/chuck/types/subr/MalIsNil.ck @@ -0,0 +1,16 @@ +public class MalIsNil extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "nil" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsNumber.ck b/impls/chuck/types/subr/MalIsNumber.ck new file mode 100644 index 0000000000..09231ceff8 --- /dev/null +++ b/impls/chuck/types/subr/MalIsNumber.ck @@ -0,0 +1,14 @@ +public class MalIsNumber extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].type == "int" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsString.ck b/impls/chuck/types/subr/MalIsString.ck new file mode 100644 index 0000000000..d85d58c3ce --- /dev/null +++ b/impls/chuck/types/subr/MalIsString.ck @@ -0,0 +1,14 @@ +public class MalIsString extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].type == "string" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsSymbol.ck b/impls/chuck/types/subr/MalIsSymbol.ck new file mode 100644 index 0000000000..3ebb65698c --- /dev/null +++ b/impls/chuck/types/subr/MalIsSymbol.ck @@ -0,0 +1,16 @@ +public class MalIsSymbol extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "symbol" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsTrue.ck b/impls/chuck/types/subr/MalIsTrue.ck new file mode 100644 index 0000000000..913e4b61b9 --- /dev/null +++ b/impls/chuck/types/subr/MalIsTrue.ck @@ -0,0 +1,16 @@ +public class MalIsTrue extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "true" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalIsVector.ck b/impls/chuck/types/subr/MalIsVector.ck new file mode 100644 index 0000000000..e74ffc08ea --- /dev/null +++ b/impls/chuck/types/subr/MalIsVector.ck @@ -0,0 +1,16 @@ +public class MalIsVector extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "vector" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalKeys.ck b/impls/chuck/types/subr/MalKeys.ck new file mode 100644 index 0000000000..3b0e1b15d1 --- /dev/null +++ b/impls/chuck/types/subr/MalKeys.ck @@ -0,0 +1,15 @@ +public class MalKeys extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].malObjectValues() @=> MalObject map[]; + MalObject results[0]; + + for( 0 => int i; i < map.size(); 2 +=> i ) + { + results << map[i]; + } + + return MalList.create(results); + } +} diff --git a/impls/chuck/types/subr/MalKeywordify.ck b/impls/chuck/types/subr/MalKeywordify.ck new file mode 100644 index 0000000000..c2dc34eaa2 --- /dev/null +++ b/impls/chuck/types/subr/MalKeywordify.ck @@ -0,0 +1,7 @@ +public class MalKeywordify extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalKeyword.create(args[0].stringValue); + } +} diff --git a/impls/chuck/types/subr/MalLess.ck b/impls/chuck/types/subr/MalLess.ck new file mode 100644 index 0000000000..b28c474eb7 --- /dev/null +++ b/impls/chuck/types/subr/MalLess.ck @@ -0,0 +1,14 @@ +public class MalLess extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].intValue < args[1].intValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalLessEqual.ck b/impls/chuck/types/subr/MalLessEqual.ck new file mode 100644 index 0000000000..90e3c23e14 --- /dev/null +++ b/impls/chuck/types/subr/MalLessEqual.ck @@ -0,0 +1,14 @@ +public class MalLessEqual extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if( args[0].intValue <= args[1].intValue ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalListify.ck b/impls/chuck/types/subr/MalListify.ck new file mode 100644 index 0000000000..81a5cde1eb --- /dev/null +++ b/impls/chuck/types/subr/MalListify.ck @@ -0,0 +1,7 @@ +public class MalListify extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalList.create(args); + } +} diff --git a/impls/chuck/types/subr/MalMap.ck b/impls/chuck/types/subr/MalMap.ck new file mode 100644 index 0000000000..b11bfe4ab1 --- /dev/null +++ b/impls/chuck/types/subr/MalMap.ck @@ -0,0 +1,22 @@ +public class MalMap extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject f; + args[1].malObjectValues() @=> MalObject list[]; + + for( 0 => int i; i < list.size(); i++ ) + { + (eval$MalSubr).apply(f, [list[i]]) @=> MalObject value; + + if( value.type == "error" ) + { + return value; + } + + value @=> list[i]; + } + + return MalList.create(list); + } +} diff --git a/impls/chuck/types/subr/MalMeta.ck b/impls/chuck/types/subr/MalMeta.ck new file mode 100644 index 0000000000..05689629d2 --- /dev/null +++ b/impls/chuck/types/subr/MalMeta.ck @@ -0,0 +1,16 @@ +public class MalMeta extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.meta == null ) + { + return Constants.NIL; + } + else + { + return (arg.meta)$MalObject; + } + } +} diff --git a/impls/chuck/types/subr/MalMul.ck b/impls/chuck/types/subr/MalMul.ck new file mode 100644 index 0000000000..0b3109d37b --- /dev/null +++ b/impls/chuck/types/subr/MalMul.ck @@ -0,0 +1,7 @@ +public class MalMul extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalInt.create(args[0].intValue * args[1].intValue); + } +} diff --git a/impls/chuck/types/subr/MalNth.ck b/impls/chuck/types/subr/MalNth.ck new file mode 100644 index 0000000000..6e194e0584 --- /dev/null +++ b/impls/chuck/types/subr/MalNth.ck @@ -0,0 +1,17 @@ +public class MalNth extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].malObjectValues() @=> MalObject list[]; + args[1].intValue => int n; + + if( n < list.size() ) + { + return list[n]; + } + else + { + return MalError.create("out of bounds"); + } + } +} diff --git a/impls/chuck/types/subr/MalPrStr.ck b/impls/chuck/types/subr/MalPrStr.ck new file mode 100644 index 0000000000..22376c28a4 --- /dev/null +++ b/impls/chuck/types/subr/MalPrStr.ck @@ -0,0 +1,14 @@ +public class MalPrStr extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + string values[args.size()]; + + for( 0 => int i; i < values.size(); i++ ) + { + Printer.pr_str(args[i], true) => values[i]; + } + + return MalString.create(String.join(values, " ")); + } +} diff --git a/impls/chuck/types/subr/MalPrintln.ck b/impls/chuck/types/subr/MalPrintln.ck new file mode 100644 index 0000000000..30d56a15f1 --- /dev/null +++ b/impls/chuck/types/subr/MalPrintln.ck @@ -0,0 +1,15 @@ +public class MalPrintln extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + string values[args.size()]; + + for( 0 => int i; i < values.size(); i++ ) + { + Printer.pr_str(args[i], false) => values[i]; + } + + Util.println(String.join(values, " ")); + return Constants.NIL; + } +} diff --git a/impls/chuck/types/subr/MalPrn.ck b/impls/chuck/types/subr/MalPrn.ck new file mode 100644 index 0000000000..f2137fcb22 --- /dev/null +++ b/impls/chuck/types/subr/MalPrn.ck @@ -0,0 +1,15 @@ +public class MalPrn extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + string values[args.size()]; + + for( 0 => int i; i < values.size(); i++ ) + { + Printer.pr_str(args[i], true) => values[i]; + } + + Util.println(String.join(values, " ")); + return Constants.NIL; + } +} diff --git a/impls/chuck/types/subr/MalReadStr.ck b/impls/chuck/types/subr/MalReadStr.ck new file mode 100644 index 0000000000..f408a9fc13 --- /dev/null +++ b/impls/chuck/types/subr/MalReadStr.ck @@ -0,0 +1,8 @@ +public class MalReadStr extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].stringValue => string input; + return Reader.read_str(input); + } +} diff --git a/impls/chuck/types/subr/MalReadline.ck b/impls/chuck/types/subr/MalReadline.ck new file mode 100644 index 0000000000..bfbcb84747 --- /dev/null +++ b/impls/chuck/types/subr/MalReadline.ck @@ -0,0 +1,17 @@ +public class MalReadline extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].stringValue => string prompt; + Readline.readline(prompt) => string input; + + if( input == null ) + { + return Constants.NIL; + } + else + { + return MalString.create(input); + } + } +} diff --git a/impls/chuck/types/subr/MalRest.ck b/impls/chuck/types/subr/MalRest.ck new file mode 100644 index 0000000000..0fb9851aaa --- /dev/null +++ b/impls/chuck/types/subr/MalRest.ck @@ -0,0 +1,22 @@ +public class MalRest extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + MalObject result[0]; + + if( arg.type == "nil" ) + { + return MalList.create(result); + } + + args[0].malObjectValues() @=> MalObject list[]; + + if( list.size() > 0 ) + { + MalObject.slice(list, 1) @=> result; + } + + return MalList.create(result); + } +} diff --git a/impls/chuck/types/subr/MalSeq.ck b/impls/chuck/types/subr/MalSeq.ck new file mode 100644 index 0000000000..f62893ba3d --- /dev/null +++ b/impls/chuck/types/subr/MalSeq.ck @@ -0,0 +1,49 @@ +public class MalSeq extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "nil" ) + { + return Constants.NIL; + } + else if( arg.type == "list" || arg.type == "vector" ) + { + args[0].malObjectValues() @=> MalObject list[]; + + if( list.size() > 0 ) + { + return MalList.create(list); + } + else + { + return Constants.NIL; + } + } + else if( arg.type == "string" ) + { + args[0].stringValue => string value; + + if( value.length() > 0 ) + { + MalObject chars[value.length()]; + + for( 0 => int i; i < value.length(); i++ ) + { + MalString.create(value.substring(i, 1)) @=> chars[i]; + } + + return MalList.create(chars); + } + else + { + return Constants.NIL; + } + } + else + { + return MalError.create("Invalid argument"); + } + } +} diff --git a/impls/chuck/types/subr/MalSequential.ck b/impls/chuck/types/subr/MalSequential.ck new file mode 100644 index 0000000000..7587499841 --- /dev/null +++ b/impls/chuck/types/subr/MalSequential.ck @@ -0,0 +1,16 @@ +public class MalSequential extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + + if( arg.type == "list" || arg.type == "vector" ) + { + return Constants.TRUE; + } + else + { + return Constants.FALSE; + } + } +} diff --git a/impls/chuck/types/subr/MalSlurp.ck b/impls/chuck/types/subr/MalSlurp.ck new file mode 100644 index 0000000000..f67eee7731 --- /dev/null +++ b/impls/chuck/types/subr/MalSlurp.ck @@ -0,0 +1,27 @@ +public class MalSlurp extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].stringValue => string filename; + FileIO f; + string output[0]; + + f.open(filename, FileIO.READ); + + while( f.more() ) + { + output << f.readLine(); + } + + // HACK: not only do we assume files are joined by \n, but the + // final newline cannot be detected otherwise + String.join(output, "\n") => string content; + if( f.size() == content.length() + 1 ) + { + "\n" +=> content; + } + + f.close(); + return MalString.create(content); + } +} diff --git a/impls/chuck/types/subr/MalStr.ck b/impls/chuck/types/subr/MalStr.ck new file mode 100644 index 0000000000..c6477dd254 --- /dev/null +++ b/impls/chuck/types/subr/MalStr.ck @@ -0,0 +1,14 @@ +public class MalStr extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + string values[args.size()]; + + for( 0 => int i; i < values.size(); i++ ) + { + Printer.pr_str(args[i], false) => values[i]; + } + + return MalString.create(String.join(values, "")); + } +} diff --git a/impls/chuck/types/subr/MalSub.ck b/impls/chuck/types/subr/MalSub.ck new file mode 100644 index 0000000000..c6cbc74281 --- /dev/null +++ b/impls/chuck/types/subr/MalSub.ck @@ -0,0 +1,7 @@ +public class MalSub extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalInt.create(args[0].intValue - args[1].intValue); + } +} diff --git a/impls/chuck/types/subr/MalSymbolify.ck b/impls/chuck/types/subr/MalSymbolify.ck new file mode 100644 index 0000000000..a204db4c06 --- /dev/null +++ b/impls/chuck/types/subr/MalSymbolify.ck @@ -0,0 +1,8 @@ +public class MalSymbolify extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].stringValue => string name; + return MalSymbol.create(name); + } +} diff --git a/impls/chuck/types/subr/MalThrow.ck b/impls/chuck/types/subr/MalThrow.ck new file mode 100644 index 0000000000..3d1dcee147 --- /dev/null +++ b/impls/chuck/types/subr/MalThrow.ck @@ -0,0 +1,7 @@ +public class MalThrow extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalError.create(args[0]); + } +} diff --git a/impls/chuck/types/subr/MalTimeMs.ck b/impls/chuck/types/subr/MalTimeMs.ck new file mode 100644 index 0000000000..3a2b91afc1 --- /dev/null +++ b/impls/chuck/types/subr/MalTimeMs.ck @@ -0,0 +1,18 @@ +public class MalTimeMs extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + // HACK: Std.system returns the status code only... + "/tmp/chuck-date." + Std.rand2(1000,9999) => string temp_file; + Std.system("date +%s%3N > " + temp_file); + + FileIO f; + f.open(temp_file, FileIO.READ); + f => int timestamp; + f.close(); + + Std.system("rm " + temp_file); + + return MalInt.create(timestamp); + } +} diff --git a/impls/chuck/types/subr/MalVals.ck b/impls/chuck/types/subr/MalVals.ck new file mode 100644 index 0000000000..4cdb3bd9fd --- /dev/null +++ b/impls/chuck/types/subr/MalVals.ck @@ -0,0 +1,15 @@ +public class MalVals extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0].malObjectValues() @=> MalObject map[]; + MalObject results[0]; + + for( 1 => int i; i < map.size(); 2 +=> i ) + { + results << map[i]; + } + + return MalList.create(results); + } +} diff --git a/impls/chuck/types/subr/MalVec.ck b/impls/chuck/types/subr/MalVec.ck new file mode 100644 index 0000000000..f0d9a15cd8 --- /dev/null +++ b/impls/chuck/types/subr/MalVec.ck @@ -0,0 +1,15 @@ +public class MalVec extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if (args.size() == 1) { + args[0] @=> MalObject a0; + if (a0.type == "vector") { + return a0; + } else if (a0.type == "list") { + return MalVector.create(a0.malObjectValues()); + } + } + return MalError.create("vec: wrong arguments"); + } +} diff --git a/impls/chuck/types/subr/MalVectorify.ck b/impls/chuck/types/subr/MalVectorify.ck new file mode 100644 index 0000000000..97c8439d33 --- /dev/null +++ b/impls/chuck/types/subr/MalVectorify.ck @@ -0,0 +1,7 @@ +public class MalVectorify extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + return MalVector.create(args); + } +} diff --git a/impls/chuck/types/subr/MalWithMeta.ck b/impls/chuck/types/subr/MalWithMeta.ck new file mode 100644 index 0000000000..7e8fba1cec --- /dev/null +++ b/impls/chuck/types/subr/MalWithMeta.ck @@ -0,0 +1,15 @@ +public class MalWithMeta extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + args[0] @=> MalObject arg; + args[1] @=> MalObject meta; + + MalObject value; + arg.clone() @=> value; + + meta$Object @=> value.meta; + + return value; + } +} diff --git a/impls/chuck/util/Constants.ck b/impls/chuck/util/Constants.ck new file mode 100644 index 0000000000..9e89854d44 --- /dev/null +++ b/impls/chuck/util/Constants.ck @@ -0,0 +1,10 @@ +public class Constants +{ + static MalTrue @ TRUE; + static MalFalse @ FALSE; + static MalNil @ NIL; +} + +MalTrue.create() @=> Constants.TRUE; +MalFalse.create() @=> Constants.FALSE; +MalNil.create() @=> Constants.NIL; diff --git a/impls/chuck/util/String.ck b/impls/chuck/util/String.ck new file mode 100644 index 0000000000..a243ff72d5 --- /dev/null +++ b/impls/chuck/util/String.ck @@ -0,0 +1,119 @@ +public class String +{ + // "x".substring(1) errors out (bug?), this doesn't + fun static string slice(string input, int index) + { + if( index == input.length() ) + { + return ""; + } + else + { + return input.substring(index); + } + } + + fun static string slice(string input, int start, int end) + { + if( start == input.length() ) + { + return ""; + } + else + { + return input.substring(start, end - start); + } + } + + fun static string join(string parts[], string separator) + { + if( parts.size() == 0 ) + { + return ""; + } + + parts[0] => string output; + + for( 1 => int i; i < parts.size(); i++ ) + { + output + separator + parts[i] => output; + } + + return output; + } + + fun static string[] split(string input, string separator) + { + string output[0]; + + if( input == "" ) + { + return output; + } + + 0 => int offset; + int index; + + while( true ) + { + input.find(separator, offset) => index; + + if( index == -1 ) + { + output << input.substring(offset); + break; + } + + output << input.substring(offset, index - offset); + index + separator.length() => offset; + } + + return output; + } + + fun static string replaceAll(string input, string pat, string rep) + { + 0 => int offset; + input => string output; + int index; + + while( true ) + { + if( offset >= output.length() ) + { + break; + } + + output.find(pat, offset) => index; + + if( index == -1 ) + { + break; + } + + output.replace(index, pat.length(), rep); + index + rep.length() => offset; + } + + return output; + } + + fun static string parse(string input) + { + slice(input, 1, input.length() - 1) => string output; + replaceAll(output, "\\\\", "\177") => output; + replaceAll(output, "\\\"", "\"") => output; + replaceAll(output, "\\n", "\n") => output; + replaceAll(output, "\177", "\\") => output; + return output; + } + + fun static string repr(string input) + { + input => string output; + replaceAll(output, "\\", "\\\\") => output; + replaceAll(output, "\n", "\\n") => output; + replaceAll(output, "\"", "\\\"") => output; + return "\"" + output + "\""; + } +} diff --git a/impls/chuck/util/Util.ck b/impls/chuck/util/Util.ck new file mode 100644 index 0000000000..bf68d962e9 --- /dev/null +++ b/impls/chuck/util/Util.ck @@ -0,0 +1,13 @@ +public class Util +{ + fun static void println(string message) + { + chout <= message + "\n"; + } + + fun static void panic(string message) + { + println("This shouldn't happen because: " + message); + Machine.crash(); + } +} diff --git a/impls/clojure/Dockerfile b/impls/clojure/Dockerfile new file mode 100644 index 0000000000..4c824b4247 --- /dev/null +++ b/impls/clojure/Dockerfile @@ -0,0 +1,51 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install curl libreadline-dev libedit-dev + +# +# Clojure (Java and lein) +# + +RUN apt-get -y install leiningen +ENV LEIN_HOME /mal/.lein +ENV LEIN_JVM_OPTS -Duser.home=/mal + +# +# ClojureScript (Node and Lumo) +# + +# For building node modules +RUN apt-get -y install g++ + +# Add nodesource apt repo config for 10.x stable +RUN apt-get -y install gnupg +RUN curl -sL https://deb.nodesource.com/setup_10.x | bash - + +# Install nodejs +RUN apt-get -y install nodejs + +ENV NPM_CONFIG_CACHE /mal/.npm + +## Install ffi and lumo-cljs modules globally +#RUN npm install -g ffi lumo-cljs + +ENV HOME=/mal diff --git a/impls/clojure/Makefile b/impls/clojure/Makefile new file mode 100644 index 0000000000..120dd20b65 --- /dev/null +++ b/impls/clojure/Makefile @@ -0,0 +1,36 @@ +clojure_MODE ?= clj +SOURCES_UTIL = src/mal/readline.$(clojure_MODE) +SOURCES_BASE = $(SOURCES_UTIL) src/mal/reader.cljc src/mal/printer.cljc +SOURCES_LISP = src/mal/env.cljc src/mal/core.cljc src/mal/stepA_mal.cljc +SRCS = $(SOURCES_BASE) src/mal/env.cljc src/mal/core.cljc +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +DEPS = $(if $(filter cljs,$(clojure_MODE)),node_modules,deps) + +dist: $(if $(filter cljs,$(clojure_MODE)),node_modules,mal.jar mal) + +deps: + lein deps + +mal.jar: $(SOURCES) + lein with-profile stepA uberjar + cp target/stepA_mal.jar $@ + +SHELL := bash +mal: mal.jar + cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ + chmod +x mal + +src/mal/%.cljc: $(DEPS) + @true + +#src/mal/stepA_mal.cljc: $(DEPS) + +target/%.jar: src/mal/%.cljc $(SRCS) + lein with-profile $(word 1,$(subst _, ,$*)) uberjar + +node_modules: + npm install + +clean: + rm -rf target/ mal.jar mal diff --git a/impls/clojure/package.json b/impls/clojure/package.json new file mode 100644 index 0000000000..79599be076 --- /dev/null +++ b/impls/clojure/package.json @@ -0,0 +1,9 @@ +{ + "name": "mal", + "version": "0.0.1", + "description": "Make a Lisp (mal) language implemented in ClojureScript", + "dependencies": { + "ffi-napi": "2.4.x", + "lumo-cljs": "1.10.1" + } +} diff --git a/impls/clojure/project.clj b/impls/clojure/project.clj new file mode 100644 index 0000000000..8f5c61b5a8 --- /dev/null +++ b/impls/clojure/project.clj @@ -0,0 +1,44 @@ +(defproject mal "0.0.1-SNAPSHOT" + :description "Make-A-Lisp" + + :dependencies [[org.clojure/clojure "1.10.0"] + [net.n01se/clojure-jna "1.0.0"]] + + ;; To run a step with correct readline behavior: + ;; lein trampoline with-profile stepX run + ;; To generate a executable uberjar (in target/) for a step: + ;; lein with-profile stepX repl + :profiles {:step0 {:main mal.step0-repl + :uberjar-name "step0_repl.jar" + :aot [mal.step0-repl]} + :step1 {:main mal.step1-read-print + :uberjar-name "step1_read_print.jar" + :aot [mal.step1-read-print]} + :step2 {:main mal.step2-eval + :uberjar-name "step2_eval.jar" + :aot [mal.step2-eval]} + :step3 {:main mal.step3-env + :uberjar-name "step3_env.jar" + :aot [mal.step3-env]} + :step4 {:main mal.step4-if-fn-do + :uberjar-name "step4_if_fn_do.jar" + :aot [mal.step4-if-fn-do]} + :step5 {:main mal.step5-tco + :uberjar-name "step5_tco.jar" + :aot [mal.step5-tco]} + :step6 {:main mal.step6-file + :uberjar-name "step6_file.jar" + :aot [mal.step6-file]} + :step7 {:main mal.step7-quote + :uberjar-name "step7_quote.jar" + :aot [mal.step7-quote]} + :step8 {:main mal.step8-macros + :uberjar-name "step8_macros.jar" + :aot [mal.step8-macros]} + :step9 {:main mal.step9-try + :uberjar-name "step9_try.jar" + :aot [mal.step9-try]} + :stepA {:main mal.stepA-mal + :uberjar-name "stepA_mal.jar" + :aot [mal.stepA-mal]}}) + diff --git a/impls/clojure/run b/impls/clojure/run new file mode 100755 index 0000000000..5fe4d92804 --- /dev/null +++ b/impls/clojure/run @@ -0,0 +1,8 @@ +#!/usr/bin/env bash +export PATH=$PATH:$(dirname $0)/node_modules/.bin +STEP=${STEP:-stepA_mal} +if [ "${clojure_MODE}" = "cljs" ]; then + exec lumo -c $(dirname $0)/src -m mal.${STEP//_/-} "${@}" +else + exec java -jar $(dirname $0)/target/${STEP}.jar "${@}" +fi diff --git a/impls/clojure/src/mal/core.cljc b/impls/clojure/src/mal/core.cljc new file mode 100644 index 0000000000..e1df93261d --- /dev/null +++ b/impls/clojure/src/mal/core.cljc @@ -0,0 +1,95 @@ +(ns mal.core + (:refer-clojure :exclude [pr-str]) + (:require [clojure.string :refer [join]] + [mal.readline :as readline] + [mal.reader :as reader] + [mal.printer :refer [pr-str atom?]])) + +;; Errors/exceptions +(defn mal_throw [obj] + (throw (ex-info "mal exception" {:data obj}))) + +;; String functions +#?(:cljs (defn slurp [f] (.readFileSync (js/require "fs") f "utf-8"))) + +;; Numeric functions +#?(:clj (defn time-ms [] (System/currentTimeMillis)) + :cljs (defn time-ms [] (.getTime (js/Date.)))) + +;; Metadata functions +;; - store metadata at :meta key of the real metadata +(defn mal_with_meta [obj m] + (let [new-meta (assoc (meta obj) :meta m)] + (with-meta obj new-meta))) + +(defn mal_meta [obj] + (:meta (meta obj))) + +;; core_ns is core namespaces functions +(def core_ns + [['= =] + ['throw mal_throw] + ['nil? nil?] + ['true? true?] + ['false? false?] + ['string? string?] + ['symbol symbol] + ['symbol? symbol?] + ['keyword keyword] + ['keyword? keyword?] + ['number? number?] + ['fn? (fn [o] (if (and (fn? o) (not (:ismacro (meta o)))) true false))] + ['macro? (fn [o] (if (and (fn? o) (:ismacro (meta o))) true false))] + + ['pr-str (fn [& xs] (join " " (map #(pr-str % true) xs)))] + ['str (fn [& xs] (join "" (map #(pr-str % false) xs)))] + ['prn (fn [& xs] (println (join " " (map #(pr-str % true) xs))))] + ['println (fn [& xs] (println (join " " (map #(pr-str % false) xs))))] + ['readline readline/readline] + ['read-string reader/read-string] + ['slurp slurp] + ['< <] + ['<= <=] + ['> >] + ['>= >=] + ['+ +] + ['- -] + ['* *] + ['/ /] + ['time-ms time-ms] + + ['list list] + ['list? seq?] + ['vector vector] + ['vector? vector?] + ['hash-map hash-map] + ['map? map?] + ['assoc assoc] + ['dissoc dissoc] + ['get get] + ['contains? contains?] + ['keys (fn [hm] (let [ks (keys hm)] (if (nil? ks) '() ks)))] + ['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))] + + ['sequential? sequential?] + ['vec vec] + ['cons cons] + ['concat #(apply list (apply concat %&))] + ['nth nth] + ['first first] + ['rest rest] + ['empty? empty?] + ['count count] + ['apply apply] + ['map #(apply list (map %1 %2))] + + ['conj conj] + ['seq (fn [obj] (seq (if (string? obj) (map str obj) obj)))] + + ['with-meta mal_with_meta] + ['meta mal_meta] + ['atom atom] + ['atom? atom?] + ['deref deref] + ['reset! reset!] + ['swap! swap!]]) diff --git a/impls/clojure/src/mal/env.cljc b/impls/clojure/src/mal/env.cljc new file mode 100644 index 0000000000..9595a1c560 --- /dev/null +++ b/impls/clojure/src/mal/env.cljc @@ -0,0 +1,36 @@ +(ns mal.env) + +(defn env [& [outer binds exprs]] + ;;(prn "env" binds exprs) + ;; (when (not= (count binds) (count exprs)) + ;; (throw (Exception. "Arity mistmatch in env call"))) + (atom + (loop [env {:outer outer} + b binds + e exprs] + (cond + (= nil b) + env + + (= '& (first b)) + (assoc env (nth b 1) e) + + :else + (recur (assoc env (first b) (first e)) (next b) (rest e)))))) + +(defn env-find [env k] + (cond + (contains? @env k) env + (:outer @env) (env-find (:outer @env) k) + :else nil)) + +(defn env-get [env k] + (let [e (env-find env k)] + (when-not e + (throw (#?(:clj Exception. + :cljs js/Error.) (str "'" k "' not found")))) + (get @e k))) + +(defn env-set [env k v] + (swap! env assoc k v) + v) diff --git a/impls/clojure/src/mal/node_readline.js b/impls/clojure/src/mal/node_readline.js new file mode 100644 index 0000000000..6042eaa0af --- /dev/null +++ b/impls/clojure/src/mal/node_readline.js @@ -0,0 +1,46 @@ +// IMPORTANT: choose one +var RL_LIB = "libreadline"; // NOTE: libreadline is GPL +//var RL_LIB = "libedit"; + +var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); + +var rlwrap = {}; // namespace for this module in web context + +var ffi = require('ffi-napi'), + fs = require('fs'); + +var rllib = ffi.Library(RL_LIB, { + 'readline': [ 'string', [ 'string' ] ], + 'add_history': [ 'int', [ 'string' ] ]}); + +var rl_history_loaded = false; + +exports.readline = rlwrap.readline = function(prompt) { + prompt = typeof prompt !== 'undefined' ? prompt : "user> "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i s (S/replace "\\" "\\\\") + (S/replace "\"" "\\\"") + (S/replace "\n" "\\n"))) + +(defn pr-str + ([obj] (pr-str obj true)) + ([obj print-readably] + (let [_r print-readably] + (cond + (= nil obj) "nil" + (string? obj) (if _r (str "\"" (escape obj) "\"") obj) + + (list? obj) (str "(" (S/join " " (map #(pr-str % _r) obj)) ")") + (vector? obj) (str "[" (S/join " " (map #(pr-str % _r) obj)) "]") + (map? obj) (str "{" (S/join " " (map (fn [[k v]] + (str (pr-str k _r) " " + (pr-str v _r))) obj)) "}") + (atom? obj) (str "(atom " (pr-str @obj _r) ")") + :else (str obj))))) + diff --git a/impls/clojure/src/mal/reader.cljc b/impls/clojure/src/mal/reader.cljc new file mode 100644 index 0000000000..76ecf49652 --- /dev/null +++ b/impls/clojure/src/mal/reader.cljc @@ -0,0 +1,81 @@ +(ns mal.reader + (:refer-clojure :exclude [read-string]) + (:require [clojure.string :as S])) + +(defn throw-str [s] + (throw #?(:cljs (js/Error. s) + :clj (Exception. s)))) + +(defn rdr [tokens] + {:tokens (vec tokens) :position (atom 0)}) + +(defn rdr-peek [rdr] + (get (vec (:tokens rdr)) @(:position rdr))) + +(defn rdr-next [rdr] + (get (vec (:tokens rdr)) (dec (swap! (:position rdr) inc)))) + +(def tok-re #"[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:[\\].|[^\\\"])*\"?|;.*|[^\s\[\]{}()'\"`@,;]+)") +(def int-re #"^-?[0-9]+$") +(def str-re #"^\"((?:[\\].|[^\\\"])*)\"$") +(def badstr-re #"^\"") + +(defn tokenize [s] + (filter #(not= \; (first %)) + (map second (re-seq tok-re s)))) + +(defn unescape [s] + (-> s (S/replace "\\\\" "\u029e") + (S/replace "\\\"" "\"") + (S/replace "\\n" "\n") + (S/replace "\u029e" "\\"))) + +(defn read-atom [rdr] + (let [token (rdr-next rdr)] + (cond + (re-seq int-re token) #?(:cljs (js/parseInt token) + :clj (Integer/parseInt token)) + (re-seq str-re token) (unescape (second (re-find str-re token))) + (re-seq badstr-re token) (throw-str (str "expected '\"', got EOF")) + (= \: (get token 0)) (keyword (subs token 1)) + (= "nil" token) nil + (= "true" token) true + (= "false" token) false + :else (symbol token)))) + +(declare read-form) + +(defn read-seq [rdr start end] + (assert (= start (rdr-next rdr))) ;; pull off start + (loop [lst []] + (let [token (rdr-peek rdr)] + (cond + (= token end) (do (rdr-next rdr) lst) + (not token) (throw-str (str "expected '" end "', got EOF")) + :else (recur (conj lst (read-form rdr))))))) + +(defn read-form [rdr] + (let [tok (rdr-peek rdr)] + (cond + (= "'" tok) (do (rdr-next rdr) (list 'quote (read-form rdr))) + (= "`" tok) (do (rdr-next rdr) (list 'quasiquote (read-form rdr))) + (= "~" tok) (do (rdr-next rdr) (list 'unquote (read-form rdr))) + (= "~@" tok) (do (rdr-next rdr) (list 'splice-unquote (read-form rdr))) + + (= "^" tok) (do (rdr-next rdr) (let [m (read-form rdr)] + (list 'with-meta (read-form rdr) m))) + (= "@" tok) (do (rdr-next rdr) (list 'deref (read-form rdr))) + + (= ")" tok) (throw-str "unexpected ')'") + (= "(" tok) (apply list (read-seq rdr "(" ")")) + + (= "]" tok) (throw-str "unexpected ']'") + (= "[" tok) (vec (read-seq rdr "[" "]")) + + (= "}" tok) (throw-str "unexpected '}'") + (= "{" tok) (apply hash-map (read-seq rdr "{" "}")) + + :else (read-atom rdr)))) + +(defn read-string [s] + (read-form (rdr (tokenize s)))) diff --git a/clojure/src/readline.clj b/impls/clojure/src/mal/readline.clj similarity index 80% rename from clojure/src/readline.clj rename to impls/clojure/src/mal/readline.clj index a510e13b57..c5a4cab8ae 100644 --- a/clojure/src/readline.clj +++ b/impls/clojure/src/mal/readline.clj @@ -1,5 +1,6 @@ -(ns readline +(ns mal.readline (:require [clojure.string :refer [split]] + [clojure.java.io :refer [file]] [net.n01se.clojure-jna :as jna])) (defonce history-loaded (atom nil)) @@ -29,9 +30,11 @@ (defn readline [prompt & [lib]] (when (not @history-loaded) (reset! history-loaded true) - (load-history HISTORY-FILE)) + (when (.canRead (file HISTORY-FILE)) + (load-history HISTORY-FILE))) (let [line (readline-call prompt)] (when line (add-history line) - (spit HISTORY-FILE (str line "\n") :append true)) + (when (.canWrite (file HISTORY-FILE)) + (spit HISTORY-FILE (str line "\n") :append true))) line)) diff --git a/impls/clojure/src/mal/readline.cljs b/impls/clojure/src/mal/readline.cljs new file mode 100644 index 0000000000..ea21874541 --- /dev/null +++ b/impls/clojure/src/mal/readline.cljs @@ -0,0 +1,3 @@ +(ns mal.readline) + +(def readline (.-readline (js/require "../src/mal/node_readline.js"))) diff --git a/impls/clojure/src/mal/step0_repl.cljc b/impls/clojure/src/mal/step0_repl.cljc new file mode 100644 index 0000000000..94c9b26187 --- /dev/null +++ b/impls/clojure/src/mal/step0_repl.cljc @@ -0,0 +1,28 @@ +(ns mal.step0-repl + (:require [mal.readline :as readline]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + strng) + +;; eval +(defn EVAL [ast env] + ast) + +;; print +(defn PRINT [exp] + exp) + +;; repl +(defn rep [strng] (PRINT (EVAL (READ strng), {}))) +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (println (rep line))) + (recur)))) + +(defn -main [& args] + (repl-loop)) diff --git a/impls/clojure/src/mal/step1_read_print.cljc b/impls/clojure/src/mal/step1_read_print.cljc new file mode 100644 index 0000000000..2b95bffbdb --- /dev/null +++ b/impls/clojure/src/mal/step1_read_print.cljc @@ -0,0 +1,36 @@ +(ns mal.step1-read-print + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(defn EVAL [ast env] + ast) + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(defn rep + [strng] + (PRINT (EVAL (READ strng) {}))) + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (repl-loop)) diff --git a/impls/clojure/src/mal/step2_eval.cljc b/impls/clojure/src/mal/step2_eval.cljc new file mode 100644 index 0000000000..fde4a12f96 --- /dev/null +++ b/impls/clojure/src/mal/step2_eval.cljc @@ -0,0 +1,64 @@ +(ns mal.step2-eval + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(defn EVAL [ast env] + + ;; (println "EVAL:" (printer/pr-str ast) (keys @env)) + ;; (flush) + + (cond + (symbol? ast) (or (get env ast) + (throw (#?(:clj Error. + :cljs js/Error.) (str ast " not found")))) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (if (empty? ast) + ast + (let [el (map #(EVAL % env) ast) + f (first el) + args (rest el)] + (apply f args))) + + :else ;; not a list, map, symbol or vector + ast)) + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env {'+ + + '- - + '* * + '/ /}) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (repl-loop)) diff --git a/impls/clojure/src/mal/step3_env.cljc b/impls/clojure/src/mal/step3_env.cljc new file mode 100644 index 0000000000..f716cf6768 --- /dev/null +++ b/impls/clojure/src/mal/step3_env.cljc @@ -0,0 +1,83 @@ +(ns mal.step3-env + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(defn EVAL [ast env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + ;; apply + (let [el (map #(EVAL % env) ast) + f (first el) + args (rest el)] + (apply f args)))) + + :else ;; not a list, map, symbol or vector + ast)) + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +(env/env-set repl-env '+ +) +(env/env-set repl-env '- -) +(env/env-set repl-env '* *) +(env/env-set repl-env '/ /) + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (repl-loop)) diff --git a/impls/clojure/src/mal/step4_if_fn_do.cljc b/impls/clojure/src/mal/step4_if_fn_do.cljc new file mode 100644 index 0000000000..21fc8fa140 --- /dev/null +++ b/impls/clojure/src/mal/step4_if_fn_do.cljc @@ -0,0 +1,100 @@ +(ns mal.step4-if-fn-do + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env] + [mal.core :as core]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(defn EVAL [ast env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (EVAL a2 let-env)) + + 'do + (last (doall (map #(EVAL % env) (rest ast)))) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (EVAL a3 env) + nil) + (EVAL a2 env))) + + 'fn* + (fn [& args] + (EVAL a2 (env/env env a1 (or args '())))) + + ;; apply + (let [el (map #(EVAL % env) ast) + f (first el) + args (rest el)] + (apply f args)))) + + :else ;; not a list, map, symbol or vector + ast)) + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (repl-loop)) diff --git a/impls/clojure/src/mal/step5_tco.cljc b/impls/clojure/src/mal/step5_tco.cljc new file mode 100644 index 0000000000..0b836e8bb3 --- /dev/null +++ b/impls/clojure/src/mal/step5_tco.cljc @@ -0,0 +1,111 @@ +(ns mal.step5-tco + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env] + [mal.core :as core]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(defn EVAL [ast env] + (loop [ast ast + env env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'do + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (with-meta + (fn [& args] + (EVAL a2 (env/env env a1 (or args '())))) + {:expression a2 + :environment env + :parameters a1}) + + ;; apply + (let [el (map #(EVAL % env) ast) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args))))) + + :else ;; not a list, map, symbol or vector + ast))) + + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (repl-loop)) diff --git a/impls/clojure/src/mal/step6_file.cljc b/impls/clojure/src/mal/step6_file.cljc new file mode 100644 index 0000000000..bbd581eb4b --- /dev/null +++ b/impls/clojure/src/mal/step6_file.cljc @@ -0,0 +1,117 @@ +(ns mal.step6-file + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env] + [mal.core :as core]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(defn EVAL [ast env] + (loop [ast ast + env env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'do + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (with-meta + (fn [& args] + (EVAL a2 (env/env env a1 (or args '())))) + {:expression a2 + :environment env + :parameters a1}) + + ;; apply + (let [el (map #(EVAL % env) ast) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args))))) + + :else ;; not a list, map, symbol or vector + ast))) + + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) +(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) +(env/env-set repl-env '*ARGV* ()) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (env/env-set repl-env '*ARGV* (rest args)) + (if args + (rep (str "(load-file \"" (first args) "\")")) + (repl-loop))) diff --git a/impls/clojure/src/mal/step7_quote.cljc b/impls/clojure/src/mal/step7_quote.cljc new file mode 100644 index 0000000000..df510b65b2 --- /dev/null +++ b/impls/clojure/src/mal/step7_quote.cljc @@ -0,0 +1,142 @@ +(ns mal.step7-quote + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env] + [mal.core :as core]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) +(defn quasiquote [ast] + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'quote + a1 + + 'quasiquote + (recur (quasiquote a1) env) + + 'do + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (with-meta + (fn [& args] + (EVAL a2 (env/env env a1 (or args '())))) + {:expression a2 + :environment env + :parameters a1}) + + ;; apply + (let [el (map #(EVAL % env) ast) + f (first el) + args (rest el) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args))))) + + :else ;; not a list, map, symbol or vector + ast))) + + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) +(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) +(env/env-set repl-env '*ARGV* ()) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (env/env-set repl-env '*ARGV* (rest args)) + (if args + (rep (str "(load-file \"" (first args) "\")")) + (repl-loop))) diff --git a/impls/clojure/src/mal/step8_macros.cljc b/impls/clojure/src/mal/step8_macros.cljc new file mode 100644 index 0000000000..7d09216ec4 --- /dev/null +++ b/impls/clojure/src/mal/step8_macros.cljc @@ -0,0 +1,157 @@ +(ns mal.step8-macros + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env] + [mal.core :as core]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) +(defn quasiquote [ast] + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'quote + a1 + + 'quasiquote + (recur (quasiquote a1) env) + + 'defmacro! + (let [func (EVAL a2 env) + ;; Preserve unadorned function to workaround + ;; ClojureScript function-with-meta arity limit + mac (with-meta func {:orig (:orig (meta func)) + :ismacro true})] + (env/env-set env a1 mac)) + + 'do + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (let [func (fn [& args] + (EVAL a2 (env/env env a1 (or args '()))))] + (with-meta + func + ;; Preserve unadorned function to workaround + ;; ClojureScript function-with-meta arity limit + {:orig func + :expression a2 + :environment env + :parameters a1})) + + ;; apply + (let [f (EVAL a0 env) + unevaluated_args (rest ast)] + (if (:ismacro (meta f)) + (recur (apply (:orig (meta f)) unevaluated_args) env) + (let [args (map #(EVAL % env) unevaluated_args) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) +(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) +(env/env-set repl-env '*ARGV* ()) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (env/env-set repl-env '*ARGV* (rest args)) + (if args + (rep (str "(load-file \"" (first args) "\")")) + (repl-loop))) diff --git a/impls/clojure/src/mal/step9_try.cljc b/impls/clojure/src/mal/step9_try.cljc new file mode 100644 index 0000000000..1915b427fb --- /dev/null +++ b/impls/clojure/src/mal/step9_try.cljc @@ -0,0 +1,177 @@ +(ns mal.step9-try + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env] + [mal.core :as core]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) +(defn quasiquote [ast] + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'quote + a1 + + 'quasiquote + (recur (quasiquote a1) env) + + 'defmacro! + (let [func (EVAL a2 env) + ;; Preserve unadorned function to workaround + ;; ClojureScript function-with-meta arity limit + mac (with-meta func {:orig (:orig (meta func)) + :ismacro true})] + (env/env-set env a1 mac)) + + 'try* + (if (= 'catch* (nth a2 0)) + (try + (EVAL a1 env) + (catch #?(:clj clojure.lang.ExceptionInfo + :cljs ExceptionInfo) ei + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(:data (ex-data ei))]))) + (catch #?(:clj Throwable :cljs :default) t + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [#?(:clj (or (.getMessage t) + (.toString t)) + :cljs (.-message t))])))) + (EVAL a1 env)) + + 'do + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (let [func (fn [& args] + (EVAL a2 (env/env env a1 (or args '()))))] + (with-meta + func + ;; Preserve unadorned function to workaround + ;; ClojureScript function-with-meta arity limit + {:orig func + :expression a2 + :environment env + :parameters a1})) + + ;; apply + (let [f (EVAL a0 env) + unevaluated_args (rest ast)] + (if (:ismacro (meta f)) + (recur (apply (:orig (meta f)) unevaluated_args) env) + (let [args (map #(EVAL % env) unevaluated_args) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) +(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) +(env/env-set repl-env '*ARGV* ()) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:cljs (catch ExceptionInfo e + (println "Error:" (or (:data (ex-data e)) + (.-stack e))))) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (env/env-set repl-env '*ARGV* (rest args)) + (if args + (rep (str "(load-file \"" (first args) "\")")) + (repl-loop))) diff --git a/impls/clojure/src/mal/stepA_mal.cljc b/impls/clojure/src/mal/stepA_mal.cljc new file mode 100644 index 0000000000..6d13886af3 --- /dev/null +++ b/impls/clojure/src/mal/stepA_mal.cljc @@ -0,0 +1,189 @@ +(ns mal.stepA-mal + (:require [mal.readline :as readline] + #?(:clj [clojure.repl]) + [mal.reader :as reader] + [mal.printer :as printer] + [mal.env :as env] + [mal.core :as core]) + #?(:clj (:gen-class))) + +;; read +(defn READ [& [strng]] + (reader/read-string strng)) + +;; eval +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) +(defn quasiquote [ast] + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) + +(defn EVAL [ast env] + (loop [ast ast + env env] + + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) + + (cond + (symbol? ast) (env/env-get env ast) + + (vector? ast) (vec (map #(EVAL % env) ast)) + + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) + ;; apply list + ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] + (condp = a0 + nil + ast + + 'def! + (env/env-set env a1 (EVAL a2 env)) + + 'let* + (let [let-env (env/env env)] + (doseq [[b e] (partition 2 a1)] + (env/env-set let-env b (EVAL e let-env))) + (recur a2 let-env)) + + 'quote + a1 + + 'quasiquote + (recur (quasiquote a1) env) + + 'defmacro! + (let [func (EVAL a2 env) + ;; Preserve unadorned function to workaround + ;; ClojureScript function-with-meta arity limit + mac (with-meta func {:orig (:orig (meta func)) + :ismacro true})] + (env/env-set env a1 mac)) + + 'clj* + #?(:clj (eval (reader/read-string a1)) + :cljs (throw (ex-info "clj* unsupported in ClojureScript mode" {}))) + + 'js* + #?(:clj (throw (ex-info "js* unsupported in Clojure mode" {})) + :cljs (js->clj (js/eval a1))) + + 'try* + (if (= 'catch* (nth a2 0)) + (try + (EVAL a1 env) + (catch #?(:clj clojure.lang.ExceptionInfo + :cljs ExceptionInfo) ei + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(:data (ex-data ei))]))) + (catch #?(:clj Throwable :cljs :default) t + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [#?(:clj (or (.getMessage t) + (.toString t)) + :cljs (.-message t))])))) + (EVAL a1 env)) + + 'do + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) + (recur (last ast) env)) + + 'if + (let [cond (EVAL a1 env)] + (if (or (= cond nil) (= cond false)) + (if (> (count ast) 2) + (recur a3 env) + nil) + (recur a2 env))) + + 'fn* + (let [func (fn [& args] + (EVAL a2 (env/env env a1 (or args '()))))] + (with-meta + func + ;; Preserve unadorned function to workaround + ;; ClojureScript function-with-meta arity limit + {:orig func + :expression a2 + :environment env + :parameters a1})) + + ;; apply + (let [f (EVAL a0 env) + unevaluated_args (rest ast)] + (if (:ismacro (meta f)) + (recur (apply (:orig (meta f)) unevaluated_args) env) + (let [args (map #(EVAL % env) unevaluated_args) + {:keys [expression environment parameters]} (meta f)] + (if expression + (recur expression (env/env environment parameters args)) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + + +;; print +(defn PRINT [exp] (printer/pr-str exp)) + +;; repl +(def repl-env (env/env)) +(defn rep + [strng] + (PRINT (EVAL (READ strng) repl-env))) + +;; core.clj: defined using Clojure +(doseq [[k v] core/core_ns] (env/env-set repl-env k v)) +(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) +(env/env-set repl-env '*ARGV* ()) + +;; core.mal: defined using the language itself +#?(:clj (rep "(def! *host-language* \"clojure\")") + :cljs (rep "(def! *host-language* \"clojurescript\")")) +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +;; repl loop +(defn repl-loop [] + (let [line (readline/readline "user> ")] + (when line + (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment + (try + (println (rep line)) + #?(:cljs (catch ExceptionInfo e + (println "Error:" (or (:data (ex-data e)) + (.-stack e))))) + #?(:clj (catch Throwable e (clojure.repl/pst e)) + :cljs (catch js/Error e (println (.-stack e)))))) + (recur)))) + +(defn -main [& args] + (env/env-set repl-env '*ARGV* (rest args)) + (if args + (rep (str "(load-file \"" (first args) "\")")) + (do + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (repl-loop)))) diff --git a/impls/clojure/tests/step5_tco.mal b/impls/clojure/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/clojure/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/clojure/tests/stepA_mal.mal b/impls/clojure/tests/stepA_mal.mal new file mode 100644 index 0000000000..d77c8a24d3 --- /dev/null +++ b/impls/clojure/tests/stepA_mal.mal @@ -0,0 +1,22 @@ +;; Testing basic clojure/clojurescript interop + +(def! clj (= *host-language* "clojure")) +(def! cljs (= *host-language* "clojurescript")) + +(if clj (clj* "7") (js* "7")) +;=>7 + +(if clj (clj* "\"abc\"") (js* "\"abc\"")) +;=>"abc" + +(if clj (clj* "{\"abc\" 123}") {"abc" 123}) +;=>{"abc" 123} + +(if clj (clj* "(prn \"foo\")") (js* "console.log('\"foo\"')")) +;/"foo" +;=>nil + +(if clj (clj* "(apply list (for [x [1 2 3]] (+ 1 x)))") '(2 3 4)) +;=>(2 3 4) +(if cljs (js* "[1,2,3].map(function(x) {return 1+x})") [2 3 4]) +;=>[2 3 4] diff --git a/impls/coffee/Dockerfile b/impls/coffee/Dockerfile new file mode 100644 index 0000000000..27fb7d571e --- /dev/null +++ b/impls/coffee/Dockerfile @@ -0,0 +1,25 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install coffeescript +ENV NPM_CONFIG_CACHE /mal/.npm +RUN touch /.coffee_history && chmod go+w /.coffee_history diff --git a/impls/coffee/Makefile b/impls/coffee/Makefile new file mode 100644 index 0000000000..4036473196 --- /dev/null +++ b/impls/coffee/Makefile @@ -0,0 +1,30 @@ +SOURCES_BASE = node_readline.coffee types.coffee \ + reader.coffee printer.coffee +SOURCES_LISP = env.coffee core.coffee stepA_mal.coffee +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +STEPS = step0_repl.coffee step1_read_print.coffee \ + step2_eval.coffee step3_env.coffee step4_if_fn_do.coffee \ + step5_tco.coffee step6_file.coffee step7_quote.coffee \ + step8_macros.coffee step9_try.coffee stepA_mal.coffee + +all: node_modules dist + +node_modules: + npm install + +$(STEPS): node_modules + +dist: mal.coffee mal + +mal.coffee: $(SOURCES) + cat $+ | grep -v "= *require('./" > $@ + +mal: mal.coffee + echo "#!/usr/bin/env coffee" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.coffee mal + diff --git a/coffee/core.coffee b/impls/coffee/core.coffee similarity index 77% rename from coffee/core.coffee rename to impls/coffee/core.coffee index 8bb6958c5d..37b379c097 100644 --- a/coffee/core.coffee +++ b/impls/coffee/core.coffee @@ -1,4 +1,4 @@ -readline = require "../js/node_readline" +readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" @@ -17,6 +17,18 @@ conj = (seq, args...) -> types._vector(lst...) else throw new Error "conj called on " + types._obj_type(seq) +seq = (obj) -> + switch types._obj_type(obj) + when 'list' + if obj.length == 0 then null else obj + when 'vector' + if obj.length == 0 then null else obj[0..-1] + when 'string' + if obj.length == 0 then null else obj.split('') + when 'nil' + null + else throw new Error "seq: called on non-sequential " + types._obj_type(seq) + # Metadata functions with_meta = (obj,m) -> new_obj = types._clone(obj) @@ -26,14 +38,18 @@ with_meta = (obj,m) -> exports.ns = { '=': (a,b) -> types._equal_Q(a,b), - 'throw': (a) -> throw a, + 'throw': (a) -> throw {"object": a}, 'nil?': types._nil_Q, 'true?': types._true_Q, 'false?': types._false_Q, + 'string?': types._string_Q, 'symbol': types._symbol, 'symbol?': types._symbol_Q, 'keyword': types._keyword, 'keyword?': types._keyword_Q, + 'number?': (a) -> typeof a == 'number', + 'fn?': (a) -> typeof a == 'function' and not types._macro_Q(a), + 'macro?': types._macro_Q, 'pr-str': (a...) -> a.map((exp) -> _pr_str(exp,true)).join(" "), 'str': (a...) -> a.map((exp) -> _pr_str(exp,false)).join(""), @@ -51,7 +67,7 @@ exports.ns = { '*': (a,b) -> a*b, '/': (a,b) -> a/b, 'time-ms': () -> new Date().getTime(), - + 'list': (a...) -> a, 'list?': types._list_Q, 'vector': (a...) -> types._vector(a...), @@ -68,15 +84,18 @@ exports.ns = { 'sequential?': types._sequential_Q, 'cons': (a,b) -> [a].concat(b), 'concat': (a=[],b...) -> a.concat(b...), + 'vec': (a) -> types._vector a..., 'nth': (a,b) -> if a.length > b then a[b] else throw new Error "nth: index out of bounds", - 'first': (a) -> if a.length > 0 then a[0] else null, - 'rest': (a) -> a[1..], + 'first': (a) -> if a != null and a.length > 0 then a[0] else null, + 'rest': (a) -> if a == null then [] else a[1..], 'empty?': (a) -> a.length == 0, 'count': (a) -> if a == null then 0 else a.length, 'apply': (a,b...) -> a(b[0..-2].concat(b[b.length-1])...), 'map': (a,b) -> b.map((x) -> a(x)), + 'conj': conj, + 'seq': seq, 'with-meta': with_meta, 'meta': (a) -> a.__meta__ or null, diff --git a/impls/coffee/env.coffee b/impls/coffee/env.coffee new file mode 100644 index 0000000000..17af434c48 --- /dev/null +++ b/impls/coffee/env.coffee @@ -0,0 +1,27 @@ +types = require "./types.coffee" + +# Env +exports.Env = class Env + constructor: (@outer=null, @binds=[], @exprs=[]) -> + @data = {} + if @binds.length > 0 + for b,i in @binds + if types._symbol_Q(b) && b.name == "&" + @data[@binds[i+1].name] = @exprs[i..] + break + else + @data[b.name] = @exprs[i] + find: (key) -> + if key of @data then @ + else if @outer then @outer.find(key) + else null + set: (key, value) -> + if not types._symbol_Q(key) + throw new Error("env.set key must be symbol") + @data[key.name] = value + get: (key) -> + env = @find(key) + throw new Error("'" + key + "' not found") if !env + env.data[key] + +# vim: ts=2:sw=2 diff --git a/impls/coffee/node_readline.coffee b/impls/coffee/node_readline.coffee new file mode 100644 index 0000000000..9437d69e1d --- /dev/null +++ b/impls/coffee/node_readline.coffee @@ -0,0 +1,46 @@ +# IMPORTANT: choose one +RL_LIB = "libreadline.so.8" # NOTE: libreadline is GPL +#RL_LIB = "libedit.so.2" + +HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history') + +rlwrap = {} # namespace for this module in web context + +koffi = require('koffi') +fs = require('fs') + +rllib = null +try + rllib = koffi.load(RL_LIB) +catch e + console.error 'ERROR loading RL_LIB:', RL_LIB, e + throw e + +readlineFunc = rllib.func('char *readline(char *)') +addHistoryFunc = rllib.func('int add_history(char *)') + +rl_history_loaded = false + +exports.readline = rlwrap.readline = (prompt = 'user> ') -> + if !rl_history_loaded + rl_history_loaded = true + lines = [] + if fs.existsSync(HISTORY_FILE) + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n") + # Max of 2000 lines + lines = lines[Math.max(lines.length - 2000, 0)..] + for line in lines when line != "" + addHistoryFunc line + + line = readlineFunc prompt + if line + addHistoryFunc line + try + fs.appendFileSync HISTORY_FILE, line + "\n" + catch exc + # ignored + true + + line + +# vim: ts=2:sw=2 diff --git a/impls/coffee/package.json b/impls/coffee/package.json new file mode 100644 index 0000000000..763cfa1d05 --- /dev/null +++ b/impls/coffee/package.json @@ -0,0 +1,9 @@ +{ + "name": "mal", + "version": "0.0.1", + "description": "Make a Lisp (mal) language implemented in CoffeeScript", + "dependencies": { + "coffeescript": "^2.7.0", + "koffi": "^2.12.1" + } +} diff --git a/coffee/printer.coffee b/impls/coffee/printer.coffee similarity index 100% rename from coffee/printer.coffee rename to impls/coffee/printer.coffee diff --git a/coffee/reader.coffee b/impls/coffee/reader.coffee similarity index 90% rename from coffee/reader.coffee rename to impls/coffee/reader.coffee index 83d24d235d..e551bec651 100644 --- a/coffee/reader.coffee +++ b/impls/coffee/reader.coffee @@ -11,7 +11,7 @@ class Reader @ tokenize = (str) -> - re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/g + re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g results = [] while (match = re.exec(str)[1]) != "" continue if match[0] == ';' @@ -22,10 +22,11 @@ read_atom = (rdr) -> token = rdr.next() if token.match /^-?[0-9]+$/ then parseInt token,10 else if token.match /^-?[0-9][0-9.]*$/ then parseFloat token,10 - else if token[0] == '"' + else if token.match /^"(?:\\.|[^\\"])*"$/ token.slice(1, token.length-1) - .replace(/\\"/g, '"') - .replace(/\\n/g, "\n") + .replace(/\\(.)/g, (_, c) -> if c == 'n' then '\n' else c) + else if token[0] == '"' + throw new Error "expected '\"', got EOF" else if token[0] == ':' then types._keyword(token[1..]) else if token == "nil" then null else if token == "true" then true diff --git a/impls/coffee/run b/impls/coffee/run new file mode 100755 index 0000000000..84deffb471 --- /dev/null +++ b/impls/coffee/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec coffee $(dirname $0)/${STEP:-stepA_mal}.coffee "${@}" diff --git a/coffee/step0_repl.coffee b/impls/coffee/step0_repl.coffee similarity index 100% rename from coffee/step0_repl.coffee rename to impls/coffee/step0_repl.coffee diff --git a/impls/coffee/step1_read_print.coffee b/impls/coffee/step1_read_print.coffee new file mode 100644 index 0000000000..df5cf74855 --- /dev/null +++ b/impls/coffee/step1_read_print.coffee @@ -0,0 +1,29 @@ +readline = require "./node_readline.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" + +# read +READ = (str) -> reader.read_str str + +# eval +EVAL = (ast, env) -> ast + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +rep = (str) -> PRINT(EVAL(READ(str), {})) + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step2_eval.coffee b/impls/coffee/step2_eval.coffee new file mode 100644 index 0000000000..7cf6dfaebd --- /dev/null +++ b/impls/coffee/step2_eval.coffee @@ -0,0 +1,55 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" + +# read +READ = (str) -> reader.read_str str + +# eval +EVAL = (ast, env) -> + # console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env[ast.name] + else if types._list_Q(ast) then # exit this switch + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + if ast.length == 0 then return ast + + # apply list + [f, args...] = ast.map((a) -> EVAL(a, env)) + f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = {} +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +repl_env["+"] = (a,b) -> a+b +repl_env["-"] = (a,b) -> a-b +repl_env["*"] = (a,b) -> a*b +repl_env["/"] = (a,b) -> a/b + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step3_env.coffee b/impls/coffee/step3_env.coffee new file mode 100644 index 0000000000..5143da9c49 --- /dev/null +++ b/impls/coffee/step3_env.coffee @@ -0,0 +1,69 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env + +# read +READ = (str) -> reader.read_str str + +# eval +EVAL = (ast, env) -> + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + if ast.length == 0 then return ast + + # apply list + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + EVAL(a2, let_env) + else + [f, args...] = ast.map((a) -> EVAL(a, env)) + f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +repl_env.set types._symbol("+"), (a,b) -> a+b +repl_env.set types._symbol("-"), (a,b) -> a-b +repl_env.set types._symbol("*"), (a,b) -> a*b +repl_env.set types._symbol("/"), (a,b) -> a/b + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step4_if_fn_do.coffee b/impls/coffee/step4_if_fn_do.coffee new file mode 100644 index 0000000000..e49f15ff35 --- /dev/null +++ b/impls/coffee/step4_if_fn_do.coffee @@ -0,0 +1,82 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env +core = require("./core.coffee") + +# read +READ = (str) -> reader.read_str str + +# eval +EVAL = (ast, env) -> + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + if ast.length == 0 then return ast + + # apply list + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + EVAL(a2, let_env) + when "do" + el = ast[1..].map((a) -> EVAL(a, env)) + el[el.length-1] + when "if" + cond = EVAL(a1, env) + if cond == null or cond == false + if a3? then EVAL(a3, env) else null + else + EVAL(a2, env) + when "fn*" + (args...) -> EVAL(a2, new Env(env, a1, args)) + else + [f, args...] = ast.map((a) -> EVAL(a, env)) + f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +# core.coffee: defined using CoffeeScript +repl_env.set types._symbol(k), v for k,v of core.ns + +# core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step5_tco.coffee b/impls/coffee/step5_tco.coffee new file mode 100644 index 0000000000..3c354fa7c6 --- /dev/null +++ b/impls/coffee/step5_tco.coffee @@ -0,0 +1,88 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env +core = require("./core.coffee") + +# read +READ = (str) -> reader.read_str str + +# eval +EVAL = (ast, env) -> + loop + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + if ast.length == 0 then return ast + + # apply list + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + return env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + when "do" + ast[1..-2].map((a) -> EVAL(a, env)) + ast = ast[ast.length-1] + when "if" + cond = EVAL(a1, env) + if cond == null or cond == false + if a3? then ast = a3 else return null + else + ast = a2 + when "fn*" + return types._function(EVAL, a2, env, a1) + else + [f, args...] = ast.map((a) -> EVAL(a, env)) + if types._function_Q(f) + ast = f.__ast__ + env = f.__gen_env__(args) + else + return f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +# core.coffee: defined using CoffeeScript +repl_env.set types._symbol(k), v for k,v of core.ns + +# core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step6_file.coffee b/impls/coffee/step6_file.coffee new file mode 100644 index 0000000000..87226b6268 --- /dev/null +++ b/impls/coffee/step6_file.coffee @@ -0,0 +1,96 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env +core = require("./core.coffee") + +# read +READ = (str) -> reader.read_str str + +# eval +EVAL = (ast, env) -> + loop + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + if ast.length == 0 then return ast + + # apply list + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + return env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + when "do" + ast[1..-2].map((a) -> EVAL(a, env)) + ast = ast[ast.length-1] + when "if" + cond = EVAL(a1, env) + if cond == null or cond == false + if a3? then ast = a3 else return null + else + ast = a2 + when "fn*" + return types._function(EVAL, a2, env, a1) + else + [f, args...] = ast.map((a) -> EVAL(a, env)) + if types._function_Q(f) + ast = f.__ast__ + env = f.__gen_env__(args) + else + return f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +# core.coffee: defined using CoffeeScript +repl_env.set types._symbol(k), v for k,v of core.ns +repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) +repl_env.set types._symbol('*ARGV*'), [] + +# core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + +if process? && process.argv.length > 2 + repl_env.set types._symbol('*ARGV*'), process.argv[3..] + rep('(load-file "' + process.argv[2] + '")') + process.exit 0 + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step7_quote.coffee b/impls/coffee/step7_quote.coffee new file mode 100644 index 0000000000..352862b324 --- /dev/null +++ b/impls/coffee/step7_quote.coffee @@ -0,0 +1,116 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env +core = require("./core.coffee") + +# read +READ = (str) -> reader.read_str str + +# eval +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] + +quasiquote = (ast) -> + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast + + + +EVAL = (ast, env) -> + loop + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + if ast.length == 0 then return ast + + # apply list + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + return env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + when "quote" + return a1 + when "quasiquote" + ast = quasiquote(a1) + when "do" + ast[1..-2].map((a) -> EVAL(a, env)) + ast = ast[ast.length-1] + when "if" + cond = EVAL(a1, env) + if cond == null or cond == false + if a3? then ast = a3 else return null + else + ast = a2 + when "fn*" + return types._function(EVAL, a2, env, a1) + else + [f, args...] = ast.map((a) -> EVAL(a, env)) + if types._function_Q(f) + ast = f.__ast__ + env = f.__gen_env__(args) + else + return f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +# core.coffee: defined using CoffeeScript +repl_env.set types._symbol(k), v for k,v of core.ns +repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) +repl_env.set types._symbol('*ARGV*'), [] + +# core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + +if process? && process.argv.length > 2 + repl_env.set types._symbol('*ARGV*'), process.argv[3..] + rep('(load-file "' + process.argv[2] + '")') + process.exit 0 + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step8_macros.coffee b/impls/coffee/step8_macros.coffee new file mode 100644 index 0000000000..986aea9444 --- /dev/null +++ b/impls/coffee/step8_macros.coffee @@ -0,0 +1,124 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env +core = require("./core.coffee") + +# read +READ = (str) -> reader.read_str str + +# eval +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] + +quasiquote = (ast) -> + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast + +EVAL = (ast, env) -> + loop + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + # apply list + if ast.length == 0 then return ast + + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + return env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + when "quote" + return a1 + when "quasiquote" + ast = quasiquote(a1) + when "defmacro!" + f = EVAL(a2, env) + f = types._clone(f) + f.__ismacro__ = true + return env.set(a1, f) + when "do" + ast[1..-2].map((a) -> EVAL(a, env)) + ast = ast[ast.length-1] + when "if" + cond = EVAL(a1, env) + if cond == null or cond == false + if a3? then ast = a3 else return null + else + ast = a2 + when "fn*" + return types._function(EVAL, a2, env, a1) + else + f = EVAL(a0, env) + if f.__ismacro__ + ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) + continue + args = ast[1..].map((a) -> EVAL(a, env)) + if types._function_Q(f) + ast = f.__ast__ + env = f.__gen_env__(args) + else + return f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +# core.coffee: defined using CoffeeScript +repl_env.set types._symbol(k), v for k,v of core.ns +repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) +repl_env.set types._symbol('*ARGV*'), [] + +# core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +if process? && process.argv.length > 2 + repl_env.set types._symbol('*ARGV*'), process.argv[3..] + rep('(load-file "' + process.argv[2] + '")') + process.exit 0 + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? then console.log exc.stack + else console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/step9_try.coffee b/impls/coffee/step9_try.coffee new file mode 100644 index 0000000000..6658d7c2af --- /dev/null +++ b/impls/coffee/step9_try.coffee @@ -0,0 +1,137 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env +core = require("./core.coffee") + +# read +READ = (str) -> reader.read_str str + +# eval +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] + +quasiquote = (ast) -> + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast + +EVAL = (ast, env) -> + loop + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + # apply list + if ast.length == 0 then return ast + + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + return env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + when "quote" + return a1 + when "quasiquote" + ast = quasiquote(a1) + when "defmacro!" + f = EVAL(a2, env) + f = types._clone(f) + f.__ismacro__ = true + return env.set(a1, f) + when "try*" + try return EVAL(a1, env) + catch exc + if a2 && a2[0].name == "catch*" + if exc.object? then exc = exc.object + else exc = exc.message + return EVAL a2[2], new Env(env, [a2[1]], [exc]) + else + throw exc + when "do" + ast[1..-2].map((a) -> EVAL(a, env)) + ast = ast[ast.length-1] + when "if" + cond = EVAL(a1, env) + if cond == null or cond == false + if a3? then ast = a3 else return null + else + ast = a2 + when "fn*" + return types._function(EVAL, a2, env, a1) + else + f = EVAL(a0, env) + if f.__ismacro__ + ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) + continue + args = ast[1..].map((a) -> EVAL(a, env)) + if types._function_Q(f) + ast = f.__ast__ + env = f.__gen_env__(args) + else + return f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +# core.coffee: defined using CoffeeScript +repl_env.set types._symbol(k), v for k,v of core.ns +repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) +repl_env.set types._symbol('*ARGV*'), [] + +# core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +if process? && process.argv.length > 2 + repl_env.set types._symbol('*ARGV*'), process.argv[3..] + rep('(load-file "' + process.argv[2] + '")') + process.exit 0 + +# repl loop +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? + console.log exc.stack + else if exc.object? + console.log "Error:", printer._pr_str exc.object, true + else + console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/stepA_mal.coffee b/impls/coffee/stepA_mal.coffee new file mode 100644 index 0000000000..4b030ed417 --- /dev/null +++ b/impls/coffee/stepA_mal.coffee @@ -0,0 +1,145 @@ +readline = require "./node_readline.coffee" +types = require "./types.coffee" +reader = require "./reader.coffee" +printer = require "./printer.coffee" +Env = require("./env.coffee").Env +core = require("./core.coffee") + +# read +READ = (str) -> reader.read_str str + +# eval +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] + +quasiquote = (ast) -> + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast + +EVAL = (ast, env) -> + loop + dbgenv = env.find("DEBUG-EVAL") + if dbgenv + dbgeval = dbgenv.get("DEBUG-EVAL") + if dbgeval != null and dbgeval != false + console.log "EVAL:", printer._pr_str ast + + if types._symbol_Q(ast) then return env.get ast.name + else if types._list_Q(ast) then # exit this switch + else if types._vector_Q(ast) + return types._vector(ast.map((a) -> EVAL(a, env))...) + else if types._hash_map_Q(ast) + new_hm = {} + new_hm[k] = EVAL(v, env) for k,v of ast + return new_hm + else return ast + + # apply list + if ast.length == 0 then return ast + + [a0, a1, a2, a3] = ast + switch a0.name + when "def!" + return env.set(a1, EVAL(a2, env)) + when "let*" + let_env = new Env(env) + for k,i in a1 when i %% 2 == 0 + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env + when "quote" + return a1 + when "quasiquote" + ast = quasiquote(a1) + when "defmacro!" + f = EVAL(a2, env) + f = types._clone(f) + f.__ismacro__ = true + return env.set(a1, f) + when "try*" + try return EVAL(a1, env) + catch exc + if a2 && a2[0].name == "catch*" + if exc.object? then exc = exc.object + else exc = exc.message || exc.toString() + return EVAL a2[2], new Env(env, [a2[1]], [exc]) + else + throw exc + when "js*" + res = eval(a1.toString()) + return if typeof(res) == 'undefined' then null else res + when "." + el = ast[2..].map((a) -> EVAL(a, env)) + return eval(a1.toString())(el...) + when "do" + ast[1..-2].map((a) -> EVAL(a, env)) + ast = ast[ast.length-1] + when "if" + cond = EVAL(a1, env) + if cond == null or cond == false + if a3? then ast = a3 else return null + else + ast = a2 + when "fn*" + return types._function(EVAL, a2, env, a1) + else + f = EVAL(a0, env) + if f.__ismacro__ + ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) + continue + args = ast[1..].map((a) -> EVAL(a, env)) + if types._function_Q(f) + ast = f.__ast__ + env = f.__gen_env__(args) + else + return f(args...) + + +# print +PRINT = (exp) -> printer._pr_str exp, true + +# repl +repl_env = new Env() +rep = (str) -> PRINT(EVAL(READ(str), repl_env)) + +# core.coffee: defined using CoffeeScript +repl_env.set types._symbol(k), v for k,v of core.ns +repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) +repl_env.set types._symbol('*ARGV*'), [] + +# core.mal: defined using the language itself +rep("(def! *host-language* \"CoffeeScript\")") +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +if process? && process.argv.length > 2 + repl_env.set types._symbol('*ARGV*'), process.argv[3..] + rep('(load-file "' + process.argv[2] + '")') + process.exit 0 + +# repl loop +rep("(println (str \"Mal [\" *host-language* \"]\"))") +while (line = readline.readline("user> ")) != null + continue if line == "" + try + console.log rep line + catch exc + continue if exc instanceof reader.BlankException + if exc.stack? and exc.stack.length > 2000 + console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) + else if exc.stack? + console.log exc.stack + else if exc.object? + console.log "Error:", printer._pr_str exc.object, true + else + console.log exc + +# vim: ts=2:sw=2 diff --git a/impls/coffee/tests/step5_tco.mal b/impls/coffee/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/coffee/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/coffee/tests/stepA_mal.mal b/impls/coffee/tests/stepA_mal.mal new file mode 100644 index 0000000000..86699978dd --- /dev/null +++ b/impls/coffee/tests/stepA_mal.mal @@ -0,0 +1,24 @@ +;; Testing basic bash interop + +(js* "7") +;=>7 + +(js* "'7'") +;=>"7" + +(js* "[7,8,9]") +;=>(7 8 9) + +(js* "console.log('hello');") +;/hello +;=>nil + +(js* "foo=8;") +(js* "foo;") +;=>8 + +(js* "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") +;=>"XaY XbY XcY" + +(js* "[1,2,3].map(function(x){return 1+x})") +;=>(2 3 4) diff --git a/coffee/types.coffee b/impls/coffee/types.coffee similarity index 93% rename from coffee/types.coffee rename to impls/coffee/types.coffee index d7320644fd..5252281762 100644 --- a/coffee/types.coffee +++ b/impls/coffee/types.coffee @@ -38,9 +38,7 @@ E._equal_Q = _equal_Q = (a,b) -> bkeys = (key for key of b) return false if akeys.length != bkeys.length for akey,i in akeys - bkey = bkeys[i] - return false if akey != bkey - return false if !_equal_Q(a[akey], b[bkey]) + return false if !_equal_Q(a[akey], b[akey]) true else a == b @@ -63,6 +61,7 @@ E._clone = _clone = (obj) -> E._nil_Q = _nil_Q = (o) -> o == null E._true_Q = _true_Q = (o) -> o == true E._false_Q = _false_Q = (o) -> o == false +E._string_Q = _string_Q = (o) -> _obj_type(o) == 'string' # Symbols class Symbol @@ -71,7 +70,8 @@ E._symbol = (str) -> new Symbol str E._symbol_Q = _symbol_Q = (o) -> o instanceof Symbol # Keywords -E._keyword = _keyword = (str) -> "\u029e" + str +E._keyword = _keyword = (o) -> + _keyword_Q(o) && o || ("\u029e" + o) E._keyword_Q = _keyword_Q = (o) -> typeof o == 'string' && o[0] == "\u029e" @@ -83,6 +83,7 @@ E._function = (evalfn, ast, env, params) -> fn.__ismacro__ = false fn E._function_Q = _function_Q = (o) -> !!o.__ast__ +E._macro_Q = _macro_Q = (o) -> _function_Q(o) and o.__ismacro__ # Lists E._list_Q = _list_Q = (o) -> Array.isArray(o) && !o.__isvector__ diff --git a/impls/common-lisp/Dockerfile b/impls/common-lisp/Dockerfile new file mode 100644 index 0000000000..36854ea428 --- /dev/null +++ b/impls/common-lisp/Dockerfile @@ -0,0 +1,48 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install curl git libreadline-dev libedit-dev + +# Install sbcl +RUN apt-get -y install sbcl + +# Install cl-asdf (CLISP does not seem to come with it) +RUN apt-get -y install cl-launch cl-asdf cl-ppcre + +RUN cd /tmp && \ + git clone https://gitlab.common-lisp.net/xcvb/cl-launch.git && \ + cd cl-launch && \ + make install + +# Install wget needed to install quicklisp +RUN apt-get -y install wget + +# Install quicklisp +RUN HOME=/ && \ + cd /tmp && \ + wget https://beta.quicklisp.org/quicklisp.lisp && \ + sbcl --load quicklisp.lisp --quit --eval '(quicklisp-quickstart:install)' --eval '(ql-util:without-prompting (ql:add-to-init-file))' + +RUN chmod -R a+rwx /quicklisp +RUN chmod a+rwx /.sbclrc + +RUN mkdir -p /.cache +RUN chmod -R a+rwx /.cache diff --git a/impls/common-lisp/Makefile b/impls/common-lisp/Makefile new file mode 100644 index 0000000000..cdcf59f63a --- /dev/null +++ b/impls/common-lisp/Makefile @@ -0,0 +1,70 @@ +# Helper functions +define record_lisp + $(shell (test -f "hist/$(1)_impl" && grep -q $(2) "hist/$(1)_impl") || echo $(2) > "hist/$(1)_impl") +endef + +define steps + $(if $(MAKECMDGOALS),\ + $(if $(findstring all,$(MAKECMDGOALS)),\ + stepA_mal,\ + $(filter step%, $(MAKECMDGOALS))),\ + stepA_mal) +endef + +LISP ?= sbcl +ABCL ?= abcl +MKCL ?= mkcl + +BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ + step5_tco step6_file step7_quote step8_macros step9_try stepA_mal + +# TODO: In theory cl-launch should be able to build standalone executable using +# MKCL unfortunately the executable crashes on startup +STANDALONE_EXE = sbcl clisp ccl ecl cmucl + +ROOT_DIR := $(shell dirname $(realpath $(lastword $(MAKEFILE_LIST)))) + +# Record the Common Lisp implementation used for all steps built in this +# invocation This is used in the targets to rebuild the step if the +# implementation changes +$(foreach step, $(call steps), $(call record_lisp,$(patsubst step%,%,$(step)),$(LISP))) + +.PRECIOUS: hist/%_impl + +all : $(BINS) + +hist/%_impl: ; + +# CL_LAUNCH_VERSION is only defined while building it. We change to the +# directory of the CL_LAUNCH_FILE in --wrap script so that the script can find the dumped +# image even if invoked from some directory different from where it +# currently resides +step% : src/step%.lisp src/utils.lisp src/types.lisp src/env.lisp src/printer.lisp src/reader.lisp src/core.lisp hist/%_impl + +ifeq ($(LISP),clisp) + @echo "==============================================================" + @echo "WARNING: This build might fail since GNU Clisp does not have bundled version of asdf (yet)" + @echo "Please do something like below to make it work" + @echo "(mkdir -p ~/common-lisp/ && cd ~/common-lisp && git clone -b release https://gitlab.common-lisp.net/asdf/asdf.git && cd asdf && make)" + @echo "==============================================================" +endif + +ifneq ($(filter $(LISP),$(STANDALONE_EXE)),) + sbcl --eval '(load "~/quicklisp/setup.lisp")' --eval '(asdf:initialize-source-registry `(:source-registry (:tree "$(ROOT_DIR)") :inherit-configuration))' --eval '(ql:quickload :uiop)' --eval '(ql:quickload :cl-readline)' --eval '(ql:quickload :genhash)' --eval '(asdf:load-system "$@")' --eval '(asdf:operate :build-op "$@")' --eval "(save-lisp-and-die \"$@\" :executable t :toplevel #'(lambda () (mal:main)))" --quit +else ifeq ($(LISP),abcl) + echo -n '#!/bin/sh\ncd `dirname $$0` ; $(ABCL) --noinform --noinit --nosystem --load run-abcl.lisp -- $@ $$@' > $@ + chmod +x $@ +else ifeq ($(LISP),mkcl) + $(MKCL) -eval '(progn (require "asdf") (push *default-pathname-defaults* asdf:*central-registry*) (asdf:load-system "$@") (quit))' + echo -n '#!/bin/sh\ncd `dirname $$0` ; $(MKCL) -q -load run-mkcl.lisp -- $@ $$@' > $@ + chmod +x $@ +else ifeq ($(LISP),allegro) + cl-launch --wrap 'if [ -z "$$CL_LAUNCH_VERSION" ] ; then cd "$$(dirname $$CL_LAUNCH_FILE)" ; fi' --verbose --lisp $(LISP) --source-registry $(ROOT_DIR) --system $@ --dump images/$@.$(LISP).image -o $@ --entry 'mal:main' +else + @echo "Unsupported Lisp implementation $(LISP)" + @exit 1 +endif + +clean: + find . -maxdepth 1 -name 'step*' -executable -delete + rm -f *.lib *.fas[l] images/* hist/*_impl diff --git a/impls/common-lisp/README.org b/impls/common-lisp/README.org new file mode 100644 index 0000000000..b29f73a7fa --- /dev/null +++ b/impls/common-lisp/README.org @@ -0,0 +1,100 @@ +* Implementation of MAL in Common Lisp + +** Introduction + +This is a portable implementation of MAL in Common Lisp. It has been tested to +work with following Common Lisp implementations + +- Steel Bank Common Lisp [[http://sbcl.org/]] +- Clozure Common Lisp [[http://ccl.clozure.com/]] +- CMU Common Lisp [[https://www.cons.org/cmucl/]] +- GNU CLISP [[http://www.clisp.org/]] +- Embeddable Common Lisp [[https://common-lisp.net/project/ecl/]] +- ManKai Common Lisp https://common-lisp.net/project/mkcl/ +- Allegro CL [[http://franz.com/products/allegro-common-lisp/]] +- Armed Bear Common Lisp [[http://abcl.org/]] + +[[http://www.cliki.net/cl-launch][cl-launch]] to build executable/wrapper scripts for most of the above implementations. + +** Dependencies + +- cl-launch + For building command line executable scripts. See [[http://www.cliki.net/cl-launch][cl-launch]] + +- quicklisp + For installing dependencies. See [[https://www.quicklisp.org/beta/][quicklisp]] + +- readline + For readline integration. You can install it on Ubuntu using apt the package + is ~libreadline-dev~. If you wish to run the implementation using Allegro CL, + you will also have to install the 32 bit version of readline + (~lib32readline-dev~ on Ubuntu) + +- (Optional) asdf + This is needed if you want to run the implementation using GNU CLISP, since + GNU CLISP does not ship with ~asdf~ and ~cl-launch~ depends on it. You can + install it on Ubuntu using apt the package is ~cl-asdf~ + +** Running using different implementations + +By default the MAL is built using ~sbcl~, you can control this using ~LISP~ +environment variable. The variable should be set to the cl-launch "nickname" for +implementation. The nicknames that work currently are + +|------------------------+----------| +| Implementation | Nickname | +|------------------------+----------| +| Steel Bank Common Lisp | sbcl | +| Clozure Common Lisp | ccl | +| CMU Common Lisp | cmucl | +| GNU CLISP | clisp | +| Embeddable Common Lisp | ecl | +| ManKai Common Lisp | mkcl | +| Allegro CL | allegro | +| Armed Bear Common Lisp | abcl | +|------------------------+----------| + +For example to build with GNU CLISP, you need to do the following + +#+BEGIN_SRC sh + cd common-lisp ; LISP=clisp make +#+END_SRC + +You can control the implementation binary used for the build using environment +variables. For a given implementation nickname, the environment variable will +be the capitalization of the given nickname. + +|------------------------+-------------| +| Implementation | Binary Path | +|------------------------+-------------| +| Steel Bank Common Lisp | SBCL | +| Clozure Common Lisp | CCL | +| CMU Common Lisp | CMUCL | +| GNU CLISP | CLISP | +| Embeddable Common Lisp | ECL | +| ManKai Common Lisp | MKCL | +| Allegro CL | ALLEGRO | +| Armed Bear Common Lisp | ABCL | +|------------------------+-------------| + +For example to build MAL with Clozure CL installed in +~\~/.roswell/impls/x86-64/linux/ccl-bin/1.11/lx86cl64~, you need to do the +following + +#+BEGIN_SRC sh + cd common-lisp ; LISP=ccl CCL=~/.roswell/impls/x86-64/linux/ccl-bin/1.11/lx86cl64 make +#+END_SRC + +You can use the variables ~*cl-implementation*~ and ~*cl-version*~ can be used +to in MAL REPL to check the Common Lisp implementation and the version used for +building it. + +** Interop + +There is some basic interop in the form ~cl-eval~ which takes a string and +evaluates it as Common Lisp code, the result is returned in form of a MAL value, +as such you are limited to code that produces values that have MAL counterparts. + +** Known Issues + ABCL takes a long to boot as such it needs to be run with ~TEST_OPTS~ set to + ~--start-timeout 120~ diff --git a/impls/common-lisp/fake-readline.lisp b/impls/common-lisp/fake-readline.lisp new file mode 100644 index 0000000000..9895c6ed5b --- /dev/null +++ b/impls/common-lisp/fake-readline.lisp @@ -0,0 +1,18 @@ +;; For some reason MKCL fails to find libreadline.so as a result cl-readline +;; fails. To avoid conditionals in the code we fake the cl-readline interface +;; and use it in asdf definitions when running under MKCL +(defpackage :cl-readline + (:nicknames :rl) + (:use :common-lisp)) + +(in-package :cl-readline) + +(defun readline (&keys prompt already-prompted num-chars + erase-empty-line add-history novelty-check) + (declare (ignorable ignored)) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun register-function (&rest ignored) + (declare (ignorable ignored))) diff --git a/impls/common-lisp/hist/.keepdir b/impls/common-lisp/hist/.keepdir new file mode 100644 index 0000000000..e69de29bb2 diff --git a/impls/common-lisp/run b/impls/common-lisp/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/common-lisp/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/common-lisp/run-abcl.lisp b/impls/common-lisp/run-abcl.lisp new file mode 100644 index 0000000000..73b869a420 --- /dev/null +++ b/impls/common-lisp/run-abcl.lisp @@ -0,0 +1,10 @@ +(require 'asdf) +(push *default-pathname-defaults* asdf:*central-registry*) + +;; Suppress compilation output +(let ((*error-output* (make-broadcast-stream)) + (*standard-output* (make-broadcast-stream))) + (asdf:load-system (car ext:*command-line-argument-list*) :verbose nil)) + +(mal:main (cdr ext:*command-line-argument-list*)) +(cl-user::quit) diff --git a/impls/common-lisp/run-mkcl.lisp b/impls/common-lisp/run-mkcl.lisp new file mode 100644 index 0000000000..8d751a0814 --- /dev/null +++ b/impls/common-lisp/run-mkcl.lisp @@ -0,0 +1,21 @@ +(require 'asdf) +(push *default-pathname-defaults* asdf:*central-registry*) + +(defvar *raw-command-line-args* (loop + :for index + :from 1 + :below (mkcl:argc) + :collect (mkcl:argv index))) + +(defvar *command-line-args* (subseq *raw-command-line-args* + (min (1+ (position "--" *raw-command-line-args* :test #'string=)) + (length *raw-command-line-args*)))) + +;; Suppress compilation output +(let ((*error-output* (make-broadcast-stream)) + (*standard-output* (make-broadcast-stream))) + (format *standard-output* "~a" *command-line-args*) + (asdf:load-system (car *command-line-args*) :verbose nil)) + +(mal:main (cdr *command-line-args*)) +(quit) diff --git a/impls/common-lisp/src/core.lisp b/impls/common-lisp/src/core.lisp new file mode 100644 index 0000000000..283158f4fd --- /dev/null +++ b/impls/common-lisp/src/core.lisp @@ -0,0 +1,360 @@ +(defpackage :core + (:use :common-lisp + :utils + :types + :reader + :printer + :genhash + :alexandria) + (:export :ns)) + +(in-package :core) + +(define-condition index-error (mal-error) + ((size :initarg :size :reader index-error-size) + (index :initarg :index :reader index-error-index) + (sequence :initarg :sequence :reader index-error-sequence)) + (:report (lambda (condition stream) + (format stream + "Index out of range (~a), length is ~a but index given was ~a" + (printer:pr-str (index-error-sequence condition)) + (index-error-size condition) + (index-error-index condition))))) + +(defmacro wrap-boolean (form) + `(if ,form mal-true mal-false)) + +(defvar ns nil) + +(defmacro defmal (name arglist &rest body) + (let* ((symbol-name (if (stringp name) + name + ;; Since common lisp intern all the symbols in + ;; uppercase (by default) we need to convert the + ;; symbol to lowercase while introducing it in MAL + ;; environment + (string-downcase (symbol-name name)))) + (internal-name (format nil "MAL-~a" (string-upcase symbol-name)))) + `(push (cons (make-mal-symbol ,symbol-name) + (make-mal-builtin-fn (defun ,(intern internal-name) ,arglist ,@body))) + ns))) + +(defmal + (value1 value2) + (make-mal-number (+ (mal-data-value value1) (mal-data-value value2)))) + +(defmal - (value1 value2) + (make-mal-number (- (mal-data-value value1) (mal-data-value value2)))) + +(defmal * (value1 value2) + (make-mal-number (* (mal-data-value value1) (mal-data-value value2)))) + +(defmal / (value1 value2) + (make-mal-number (round (/ (mal-data-value value1) (mal-data-value value2))))) + +(defmal prn (&rest strings) + ;; Using write-line instead of (format *standard-output* ... ) since the later prints + ;; and extra newline at start in GNU CLISP, if environment variable PERL_RL is true + ;; or terminal is dumb + (write-line (format nil + "~{~a~^ ~}" + (mapcar (lambda (string) (printer:pr-str string t)) + strings))) + mal-nil) + +(defmal println (&rest strings) + ;; Using write-line instead of (format *standard-output* ... ) since the later prints + ;; and extra newline at start in GNU CLISP, if environment variable PERL_RL is true + ;; or terminal is dumb + (write-line (format nil + "~{~a~^ ~}" + (mapcar (lambda (string) (printer:pr-str string nil)) + strings))) + mal-nil) + +(defmal pr-str (&rest strings) + (make-mal-string (format nil + "~{~a~^ ~}" + (mapcar (lambda (string) (printer:pr-str string t)) + strings)))) + +(defmal str (&rest strings) + (make-mal-string (format nil + "~{~a~}" + (mapcar (lambda (string) (printer:pr-str string nil)) + strings)))) + +(defmal list (&rest values) + (make-mal-list values)) + +(defmal list? (value) + (wrap-boolean (mal-list-p value))) + +(defmal empty? (value) + (wrap-boolean (zerop (length (mal-data-value value))))) + +(defmal count (value) + (make-mal-number (length (mal-data-value value)))) + +(defmal = (value1 value2) + (wrap-boolean (mal-data-value= value1 value2))) + +(defmal < (value1 value2) + (wrap-boolean (< (mal-data-value value1) (mal-data-value value2)))) + +(defmal > (value1 value2) + (wrap-boolean (> (mal-data-value value1) (mal-data-value value2)))) + +(defmal <= (value1 value2) + (wrap-boolean (<= (mal-data-value value1) (mal-data-value value2)))) + +(defmal >= (value1 value2) + (wrap-boolean (>= (mal-data-value value1) (mal-data-value value2)))) + +(defmal read-string (value) + (reader:read-str (mal-data-value value))) + +(defmal slurp (filename) + (make-mal-string (read-file-string (mal-data-value filename)))) + +(defmal atom (value) + (make-mal-atom value)) + +(defmal atom? (value) + (wrap-boolean (mal-atom-p value))) + +(defmal deref (atom) + (mal-data-value atom)) + +(defmal reset! (atom value) + (setf (mal-data-value atom) value)) + +(defmal swap! (atom fn &rest args) + (setf (mal-data-value atom) + (apply (mal-data-value fn) + (append (list (mal-data-value atom)) args)))) + +(defmal vec (list) + (make-mal-vector (listify (mal-data-value list)))) + +(defmal cons (element list) + (make-mal-list (cons element (listify (mal-data-value list))))) + +(defmal concat (&rest lists) + (make-mal-list (apply #'concatenate 'list (mapcar #'mal-data-value lists)))) + +(defmal nth (sequence index) + (or (nth (mal-data-value index) + (listify (mal-data-value sequence))) + (error 'index-error + :size (length (mal-data-value sequence)) + :index (mal-data-value index) + :sequence sequence))) + +(defmal first (sequence) + (or (first (listify (mal-data-value sequence))) mal-nil)) + +(defmal rest (sequence) + (make-mal-list (rest (listify (mal-data-value sequence))))) + +(defmal throw (value) + (error 'mal-user-exception :data value)) + +(defmal apply (fn &rest values) + (let ((last (listify (mal-data-value (car (last values))))) + (butlast (butlast values))) + (apply (mal-data-value fn) (append butlast last)))) + +(defmal map (fn sequence) + (let ((applicants (listify (mal-data-value sequence)))) + (make-mal-list (mapcar (mal-data-value fn) applicants)))) + +(defmal nil? (value) + (wrap-boolean (mal-nil-p value))) + +(defmal true? (value) + (wrap-boolean (and (mal-boolean-p value) (mal-data-value value)))) + +(defmal false? (value) + (wrap-boolean (and (mal-boolean-p value) (not (mal-data-value value))))) + +(defmal number? (value) + (wrap-boolean (mal-number-p value))) + +(defmal symbol (string) + (make-mal-symbol (mal-data-value string))) + +(defmal symbol? (value) + (wrap-boolean (mal-symbol-p value))) + +(defmal keyword (keyword) + (if (mal-keyword-p keyword) + keyword + (make-mal-keyword (format nil ":~a" (mal-data-value keyword))))) + +(defmal keyword? (value) + (wrap-boolean (mal-keyword-p value))) + +(defmal vector (&rest elements) + (make-mal-vector (map 'vector #'identity elements))) + +(defmal vector? (value) + (wrap-boolean (mal-vector-p value))) + +(defmal fn? (value) + (wrap-boolean (or (mal-builtin-fn-p value) + (and (mal-fn-p value) + (not (cdr (assoc :is-macro (mal-data-attrs value)))))))) + +(defmal macro? (value) + (wrap-boolean (and (mal-fn-p value) + (cdr (assoc :is-macro (mal-data-attrs value)))))) + +(defmal hash-map (&rest elements) + (let ((hash-map (make-mal-value-hash-table))) + (loop for (key value) on elements + by #'cddr + do (setf (hashref key hash-map) value)) + (make-mal-hash-map hash-map))) + +(defmal map? (value) + (wrap-boolean (mal-hash-map-p value))) + +(defmal assoc (hash-map &rest elements) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-map (make-mal-value-hash-table))) + + (hashmap (lambda (key value) + (declare (ignorable value)) + (setf (hashref key new-hash-map) + (hashref key hash-map-value))) + hash-map-value) + + (loop for (key value) on elements + by #'cddr + do (setf (hashref key new-hash-map) value)) + + (make-mal-hash-map new-hash-map))) + +(defmal dissoc (hash-map &rest elements) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-map (make-mal-value-hash-table))) + + (hashmap (lambda (key value) + (declare (ignorable value)) + (when (not (member key elements :test #'mal-data-value=)) + (setf (hashref key new-hash-map) + (hashref key hash-map-value)))) + hash-map-value) + + (make-mal-hash-map new-hash-map))) + +(defmal get (hash-map key) + (or (and (mal-hash-map-p hash-map) (hashref key (mal-data-value hash-map))) + types:mal-nil)) + +(defmal contains? (hash-map key) + (if (genhash:hashref key (types:mal-data-value hash-map)) types:mal-true types:mal-false)) + +(defmal keys (hash-map) + (let ((hash-map-value (mal-data-value hash-map)) + keys) + + (hashmap (lambda (key value) + (declare (ignorable value)) + (push key keys)) + hash-map-value) + + (make-mal-list (nreverse keys)))) + +(defmal vals (hash-map) + (let ((hash-map-value (mal-data-value hash-map)) + values) + + (hashmap (lambda (key value) + (declare (ignorable key)) + (push value values)) + hash-map-value) + + (make-mal-list (nreverse values)))) + +(defmal sequential? (value) + (wrap-boolean (or (mal-vector-p value) (mal-list-p value)))) + +(defmal readline (prompt) + (format *standard-output* (mal-data-value prompt)) + (force-output *standard-output*) + (make-mal-string (read-line *standard-input* nil))) + +(defmal string? (value) + (wrap-boolean (mal-string-p value))) + +(defmal time-ms () + (make-mal-number (round (/ (get-internal-real-time) + (/ internal-time-units-per-second + 1000))))) + +(defmal conj (value &rest elements) + (cond ((mal-list-p value) + (make-mal-list (append (nreverse elements) + (mal-data-value value)))) + ((mal-vector-p value) + (make-mal-vector (concatenate 'vector + (mal-data-value value) + elements))) + (t (error 'mal-user-exception)))) + +(defmal seq (value) + (if (zerop (length (mal-data-value value))) + mal-nil + (cond ((mal-list-p value) value) + ((mal-vector-p value) + (make-mal-list (listify (mal-data-value value)))) + ((mal-string-p value) + (make-mal-list (mapcar (alexandria:compose #'make-mal-string #'string) + (coerce (mal-data-value value) 'list)))) + (t (error 'mal-user-exception))))) + +(defmal with-meta (value meta) + (funcall (switch-mal-type value + (types:string #'make-mal-string) + (types:symbol #'make-mal-symbol) + (types:list #'make-mal-list) + (types:vector #'make-mal-vector) + (types:hash-map #'make-mal-hash-map) + (types:fn #'make-mal-fn) + (types:builtin-fn #'make-mal-builtin-fn)) + (mal-data-value value) + :meta meta + :attrs (mal-data-attrs value))) + +(defmal meta (value) + (or (types:mal-data-meta value) types:mal-nil)) + +(defun wrap-value (value &optional booleanp listp) + (typecase value + (number (make-mal-number value)) + ;; This needs to be before symbol since nil is a symbol + (null (cond (booleanp mal-false) + (listp (make-mal-list value)) + (t mal-nil))) + ;; This needs to before symbol since t, nil are symbols + (boolean (if value mal-true mal-nil)) + (keyword (make-mal-keyword value)) + (symbol (make-mal-symbol (symbol-name value))) + (string (make-mal-string value)) + (list (make-mal-list (map 'list #'wrap-value value))) + (vector (make-mal-vector (map 'vector #'wrap-value value))) + (hash-table (make-mal-hash-map (let ((new-hash-table (make-mal-value-hash-table))) + (hashmap (lambda (key value) + (setf (hashref (wrap-value key) new-hash-table) + (wrap-value value))) + value) + new-hash-table))))) + +;; Since a nil in Common LISP may mean an empty list or boolean false or +;; simply nil, the caller can specify the preferred type while evaluating an +;; expression +(defmal cl-eval (code &optional booleanp listp) + (wrap-value (eval (read-from-string (mal-data-value code))) + (and booleanp (mal-data-value booleanp)) + (and listp (mal-data-value listp)))) diff --git a/impls/common-lisp/src/env.lisp b/impls/common-lisp/src/env.lisp new file mode 100644 index 0000000000..aea1c8b895 --- /dev/null +++ b/impls/common-lisp/src/env.lisp @@ -0,0 +1,61 @@ +(defpackage :env + (:use :common-lisp :types) + (:shadow :symbol) + (:export :undefined-symbol + :create-mal-env + :get-env + :set-env + :mal-env-bindings)) + +(in-package :env) + +(define-condition undefined-symbol (mal-runtime-exception) + ((symbol :initarg :symbol :reader symbol)) + (:report (lambda (condition stream) + (format stream + "'~a' not found" + (symbol condition))))) + +(define-condition arity-mismatch (mal-runtime-exception) + ((required :initarg :required :reader required) + (provided :initarg :provided :reader provided)) + (:report (lambda (condition stream) + (format stream + "Unexpected number of arguments provided, expected ~a, got ~a" + (required condition) + (provided condition))))) + +(defstruct mal-env + (bindings (make-hash-table :test 'equal) :read-only t) + (parent nil :read-only t)) + +(defun get-env (env symbol) + (or (gethash symbol (mal-env-bindings env)) + (let ((outer (mal-env-parent env))) + (if outer + (get-env outer symbol) + nil)))) + +(defun set-env (env symbol value) + (setf (gethash (mal-data-value symbol) (mal-env-bindings env)) value)) + +(defun create-mal-env (&key parent binds exprs) + (let ((env (make-mal-env :parent parent)) + (params-length (length binds)) + (arg-length (length exprs))) + + (flet ((arity-mismatch () + (error 'arity-mismatch + :required params-length + :provided arg-length))) + (loop + for key = (pop binds) + while key + do (if (string/= (mal-data-value key) "&") + (set-env env key (or (pop exprs) + (arity-mismatch))) + (progn (set-env env + (or (pop binds) (arity-mismatch)) + (make-mal-list exprs)) + (setq binds nil)))) + env))) diff --git a/impls/common-lisp/src/printer.lisp b/impls/common-lisp/src/printer.lisp new file mode 100644 index 0000000000..2187bca7a0 --- /dev/null +++ b/impls/common-lisp/src/printer.lisp @@ -0,0 +1,53 @@ +(defpackage :printer + (:use :common-lisp + :types) + (:import-from :genhash + :hashmap) + (:import-from :cl-ppcre + :regex-replace) + (:import-from :utils + :replace-all + :listify) + (:export :pr-str)) + +(in-package :printer) + +(defun pr-mal-sequence (start-delimiter sequence end-delimiter &optional (print-readably t)) + (format nil + "~a~{~a~^ ~}~a" + start-delimiter + (mapcar (lambda (value) + (pr-str value print-readably)) + (listify (mal-data-value sequence))) + end-delimiter)) + +(defun pr-mal-hash-map (hash-map &optional (print-readably t) &aux repr) + (hashmap (lambda (key value) + (push (pr-str value print-readably) repr) + (push (pr-str key print-readably) repr)) + (mal-data-value hash-map)) + (format nil "{~{~a ~a~^ ~}}" repr)) + +(defun pr-string (ast &optional (print-readably t)) + (if print-readably + (replace-all (prin1-to-string (mal-data-value ast)) + " +" + "\\n") + (mal-data-value ast))) + +(defun pr-str (ast &optional (print-readably t)) + (when ast + (switch-mal-type ast + (types:number (format nil "~d" (mal-data-value ast))) + (types:boolean (if (mal-data-value ast) "true" "false")) + (types:nil "nil") + (types:string (pr-string ast print-readably)) + (types:symbol (format nil "~a" (mal-data-value ast))) + (types:keyword (format nil "~a" (mal-data-value ast))) + (types:list (pr-mal-sequence "(" ast ")" print-readably)) + (types:vector (pr-mal-sequence "[" ast "]" print-readably)) + (types:hash-map (pr-mal-hash-map ast print-readably)) + (types:atom (format nil "(atom ~a)" (pr-str (mal-data-value ast)))) + (types:fn "#") + (types:builtin-fn "#")))) diff --git a/impls/common-lisp/src/reader.lisp b/impls/common-lisp/src/reader.lisp new file mode 100644 index 0000000000..cfcb5ae8dd --- /dev/null +++ b/impls/common-lisp/src/reader.lisp @@ -0,0 +1,187 @@ +(defpackage :reader + (:use :common-lisp + :types + :alexandria) + (:import-from :genhash + :hashref) + (:import-from :cl-ppcre + :create-scanner + :do-matches-as-strings + :scan) + (:import-from :utils + :replace-all) + (:export :read-str + :eof + :unexpected-token)) + +(in-package :reader) + +;; Possible errors that can be raised while reading a string +(define-condition unexpected-token (error) + ((expected :initarg :expected :reader expected-token) + (actual :initarg :actual :reader actual-token)) + (:report (lambda (condition stream) + (format stream + "Unexpected token (~a) encountered while reading, expected ~a" + (actual-token condition) + (expected-token condition)))) + (:documentation "Error raised when an unexpected token is encountered while reading.")) + +(define-condition eof (error) + ((context :initarg :context :reader context)) + (:report (lambda (condition stream) + (format stream + "EOF encountered while reading '~a'" + (context condition)))) + (:documentation "Error raised when EOF is encountered while reading.")) + +(defvar *tokenizer-re* (create-scanner "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") + "Regular expression to tokenize Lisp code") + +(defvar *number-re* (create-scanner "^(-|\\+)?[\\d]+$") + "Regular expression to match a number") + +(defvar *string-re* (create-scanner "^\"(?:\\\\.|[^\\\\\"])*\"$") + "Regular expression to match a string") + +(defvar *whitespace-chars* + '(#\Space #\Newline #\Backspace #\Tab + #\Linefeed #\Page #\Return #\Rubout #\,) + "Characters to treat as whitespace, these are trimmed in `tokenize'") + +(defun tokenize (string) + "Tokenize given string. + +This function extracts all tokens from the string using *tokenizer-re* +comments are ignored. + +Implementation notes: The regex scan generates some empty tokens, not really +sure why." + (let (tokens) + (do-matches-as-strings (match *tokenizer-re* string) + (let ((token (string-trim *whitespace-chars* match))) + (unless (or (zerop (length token)) + (char= (char token 0) #\;)) + (push token tokens)))) + (nreverse tokens))) + +;; Reader +(defstruct (token-reader) + (tokens nil)) + +(defun peek (reader) + "Returns the next token in the reader without advancing the token stream." + (car (token-reader-tokens reader))) + +(defun next (reader) + "Returns the next token and advances the token stream." + (pop (token-reader-tokens reader))) + +(defun consume (reader &optional (token nil token-provided-p)) + "Consume the next token and advance the token stream. + +If the optional argument token is provided the token stream is advanced only +if token being consumes matches it otherwise and unexpected token error is +raised" + (let ((actual-token (pop (token-reader-tokens reader)))) + (when (and token-provided-p + (not (equal actual-token token))) + (error 'unexpected-token :expected token :actual actual-token))) + reader) + +(defun parse-string (token) + ;; read-from-string doesn't handle \n + (if (and (> (length token) 1) + (scan *string-re* token)) + (let ((input (subseq token 1 (1- (length token))))) + (with-output-to-string (out) + (with-input-from-string (in input) + (loop while (peek-char nil in nil) + do (let ((char (read-char in))) + (if (eql char #\\ ) + (let ((char (read-char in))) + (if (eql char #\n) + (terpri out) + (princ char out))) + (princ char out))))))) + (error 'eof :context "string"))) + +(defun expand-quote (reader) + (let ((quote-sym (make-mal-symbol (switch ((next reader) :test #'string=) + ("'" "quote") + ("`" "quasiquote") + ("~" "unquote") + ("~@" "splice-unquote") + ("@" "deref"))))) + (make-mal-list (list quote-sym (read-form reader))))) + +(defun read-mal-sequence (reader &optional (type 'list) &aux forms) + (let ((context (string-downcase (symbol-name type))) + (delimiter (if (equal type 'list) ")" "]"))) + + ;; Consume the opening brace + (consume reader) + + (setf forms (loop + until (string= (peek reader) delimiter) + collect (read-form-or-eof reader context))) + + ;; Consume the closing brace + (consume reader) + + (apply type forms))) + +(defun read-hash-map (reader) + (let ((map (make-mal-value-hash-table)) + (context "hash-map")) + + ;; Consume the open brace + (consume reader) + + (loop + until (string= (peek reader) "}") + do (setf (hashref (read-form-or-eof reader context) map) + (read-form-or-eof reader context))) + + ;; Consume the closing brace + (consume reader) + + map)) + +(defun read-atom (reader) + (let ((token (next reader))) + (cond ((string= token "false") mal-false) + ((string= token "true") mal-true) + ((string= token "nil") mal-nil) + ((char= (char token 0) #\") (make-mal-string (parse-string token))) + ((char= (char token 0) #\:) (make-mal-keyword token)) + ((scan *number-re* token) (make-mal-number (read-from-string token))) + (t (make-mal-symbol token))))) + +(defun read-form-with-meta (reader) + (consume reader) + + (let ((meta (read-form-or-eof reader "object meta")) + (value (read-form-or-eof reader "object meta"))) + (make-mal-list (list (make-mal-symbol "with-meta") value meta)))) + +(defun read-form (reader) + (switch ((peek reader) :test #'equal) + (nil nil) + ("(" (make-mal-list (read-mal-sequence reader 'list))) + ("[" (make-mal-vector (read-mal-sequence reader 'vector))) + ("{" (make-mal-hash-map (read-hash-map reader))) + ("^" (read-form-with-meta reader)) + ("'" (expand-quote reader)) + ("`" (expand-quote reader)) + ("~" (expand-quote reader)) + ("~@" (expand-quote reader)) + ("@" (expand-quote reader)) + (t (read-atom reader)))) + +(defun read-form-or-eof (reader context) + (or (read-form reader) + (error 'eof :context context))) + +(defun read-str (string) + (read-form (make-token-reader :tokens (tokenize string)))) diff --git a/impls/common-lisp/src/step0_repl.lisp b/impls/common-lisp/src/step0_repl.lisp new file mode 100644 index 0000000000..17ba1619c7 --- /dev/null +++ b/impls/common-lisp/src/step0_repl.lisp @@ -0,0 +1,76 @@ +(defpackage :mal + (:use :common-lisp) + (:import-from :uiop + :getenv) + (:import-from :cl-readline + :readline) + (:export :main)) + +(in-package :mal) + +(defun mal-read (string) + string) + +(defun mal-eval (ast) + ast) + +(defun mal-print (expression) + expression) + +(defun rep (string) + (mal-print (mal-eval (mal-read string)))) + +(defvar *use-readline-p* nil) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun main (&optional (argv nil argv-provided-p)) + (declare (ignorable argv argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (uiop:getenv "PERL_RL") "false") + (string= (uiop:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + (loop do (let ((line (mal-readline "user> "))) + (if line (mal-writeline (rep line)) (return))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step1_read_print.lisp b/impls/common-lisp/src/step1_read_print.lisp new file mode 100644 index 0000000000..871ffbdb02 --- /dev/null +++ b/impls/common-lisp/src/step1_read_print.lisp @@ -0,0 +1,82 @@ +(defpackage :mal + (:use :common-lisp + :reader + :printer) + (:import-from :utils + :getenv) + (:import-from :cl-readline + :readline) + (:export :main)) + +(in-package :mal) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-eval (ast env) + (declare (ignorable env)) + ast) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) (make-hash-table :test #'equal))) + (reader:eof (condition) + (format nil "~a" condition)))) + +(defvar *use-readline-p* nil) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun main (&optional (argv nil argv-provided-p)) + (declare (ignorable argv argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + (loop do (let ((line (mal-readline "user> "))) + (if line (mal-writeline (rep line)) (return))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step2_eval.lisp b/impls/common-lisp/src/step2_eval.lisp new file mode 100644 index 0000000000..b82ef6968e --- /dev/null +++ b/impls/common-lisp/src/step2_eval.lisp @@ -0,0 +1,162 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(defvar *repl-env* (make-hash-table :test 'equal)) + +(setf (gethash "+" *repl-env*) + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (+ (mal-data-value value1) + (mal-data-value value2)))))) + +(setf (gethash "-" *repl-env*) + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (- (mal-data-value value1) + (mal-data-value value2)))))) + +(setf (gethash "*" *repl-env*) + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (* (mal-data-value value1) + (mal-data-value value2)))))) + +(setf (gethash "/" *repl-env*) + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (/ (mal-data-value value1) + (mal-data-value value2)))))) + +(defun lookup-env (symbol env) + (let ((key (mal-data-value symbol))) + (multiple-value-bind (value present-p) (gethash key env) + (if present-p + value + (error 'env:undefined-symbol + :symbol (format nil "~a" key)))))) + +(defun eval-sequence (type sequence env) + (map type + (lambda (ast) (mal-eval ast env)) + (mal-data-value sequence))) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun mal-eval (ast env) + ;; (write-line (format nil "EVAL: ~a" (pr-str ast))) + ;; (force-output *standard-output*) + (switch-mal-type ast + (types:symbol (lookup-env ast env)) + (types:list (eval-list ast env)) + (types:vector (make-mal-vector (eval-sequence 'vector ast env))) + (types:hash-map (eval-hash-map ast env )) + (types:any ast))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun eval-list (ast env) + (if (null (mal-data-value ast)) + ast + (let ((evaluated-list (eval-sequence 'list ast env))) + (apply (mal-data-value (car evaluated-list)) + (cdr evaluated-list))))) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (error (condition) + (format nil "~a" condition)))) + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of *repl-env* + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun main (&optional (argv nil argv-provided-p)) + (declare (ignorable argv argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (loop do (let ((line (mal-readline "user> "))) + (if line (mal-writeline (rep line)) (return))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step3_env.lisp b/impls/common-lisp/src/step3_env.lisp new file mode 100644 index 0000000000..17a7ccd991 --- /dev/null +++ b/impls/common-lisp/src/step3_env.lisp @@ -0,0 +1,191 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :genhash) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(defvar *repl-env* (env:create-mal-env)) + +(env:set-env *repl-env* + (make-mal-symbol "+") + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (+ (mal-data-value value1) + (mal-data-value value2)))))) + +(env:set-env *repl-env* + (make-mal-symbol "-") + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (- (mal-data-value value1) + (mal-data-value value2)))))) + +(env:set-env *repl-env* + (make-mal-symbol "*") + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (* (mal-data-value value1) + (mal-data-value value2)))))) + +(env:set-env *repl-env* + (make-mal-symbol "/") + (make-mal-builtin-fn (lambda (value1 value2) + (make-mal-number (/ (mal-data-value value1) + (mal-data-value value2)))))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) + +(defun eval-sequence (type sequence env) + (map type + (lambda (ast) (mal-eval ast env)) + (mal-data-value sequence))) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun mal-eval (ast env) + (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + (switch-mal-type ast + (types:symbol + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key))))) + (types:list (eval-list ast env)) + (types:vector (make-mal-vector (eval-sequence 'vector ast env))) + (types:hash-map (eval-hash-map ast env )) + (types:any ast))) + +(defun eval-let* (forms env) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + + (mal-eval (third forms) new-env))) + +(defun eval-list (ast env) + (let ((forms (mal-data-value ast))) + (cond + ((zerop (length forms)) ast) + ((mal-data-value= mal-def! (first forms)) + (env:set-env env (second forms) (mal-eval (third forms) env))) + ((mal-data-value= mal-let* (first forms)) + (eval-let* forms env)) + (t (let ((evaluated-list (eval-sequence 'list ast env))) + (apply (mal-data-value (car evaluated-list)) + (cdr evaluated-list))))))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (error (condition) + (format nil "~a" condition)))) + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun main (&optional (argv nil argv-provided-p)) + (declare (ignorable argv argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (loop do (let ((line (mal-readline "user> "))) + (if line (mal-writeline (rep line)) (return))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step4_if_fn_do.lisp b/impls/common-lisp/src/step4_if_fn_do.lisp new file mode 100644 index 0000000000..aa789bfec6 --- /dev/null +++ b/impls/common-lisp/src/step4_if_fn_do.lisp @@ -0,0 +1,195 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :core) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :listify + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(defvar *repl-env* (env:create-mal-env)) + +(dolist (binding core:ns) + (env:set-env *repl-env* (car binding) (cdr binding))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) +(defvar mal-do (make-mal-symbol "do")) +(defvar mal-if (make-mal-symbol "if")) +(defvar mal-fn* (make-mal-symbol "fn*")) + +(defun eval-sequence (type sequence env) + (map type + (lambda (ast) (mal-eval ast env)) + (mal-data-value sequence))) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun mal-eval (ast env) + (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + (switch-mal-type ast + (types:symbol + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key))))) + (types:list (eval-list ast env)) + (types:vector (make-mal-vector (eval-sequence 'vector ast env))) + (types:hash-map (eval-hash-map ast env)) + (types:any ast))) + +(defun eval-let* (forms env) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + + (mal-eval (third forms) new-env))) + +(defun eval-list (ast env) + (let ((forms (mal-data-value ast))) + (cond + ((zerop (length forms)) ast) + ((mal-data-value= mal-def! (first forms)) + (env:set-env env (second forms) (mal-eval (third forms) env))) + ((mal-data-value= mal-let* (first forms)) + (eval-let* forms env)) + ((mal-data-value= mal-do (first forms)) + (car (last (mapcar (lambda (form) (mal-eval form env)) + (cdr forms))))) + ((mal-data-value= mal-if (first forms)) + (let ((predicate (mal-eval (second forms) env))) + (mal-eval (if (or (mal-data-value= predicate mal-nil) + (mal-data-value= predicate mal-false)) + (or (fourth forms) mal-nil) + (third forms)) + env))) + ((mal-data-value= mal-fn* (first forms)) + (make-mal-fn (let ((arglist (second forms)) + (body (third forms))) + (lambda (&rest args) + (mal-eval body (env:create-mal-env :parent env + :binds (listify (mal-data-value arglist)) + :exprs args)))))) + (t (let* ((evaluated-list (eval-sequence 'list ast env)) + (function (car evaluated-list))) + ;; If first element is a mal function unwrap it + (apply (mal-data-value function) + (cdr evaluated-list))))))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (error (condition) + (format nil "~a" condition)))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun main (&optional (argv nil argv-provided-p)) + (declare (ignorable argv argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (loop do (let ((line (mal-readline "user> "))) + (if line (mal-writeline (rep line)) (return))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step5_tco.lisp b/impls/common-lisp/src/step5_tco.lisp new file mode 100644 index 0000000000..e2a5305d9f --- /dev/null +++ b/impls/common-lisp/src/step5_tco.lisp @@ -0,0 +1,210 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :core) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :listify + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(defvar *repl-env* (env:create-mal-env)) + +(dolist (binding core:ns) + (env:set-env *repl-env* (car binding) (cdr binding))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) +(defvar mal-do (make-mal-symbol "do")) +(defvar mal-if (make-mal-symbol "if")) +(defvar mal-fn* (make-mal-symbol "fn*")) + +(defun eval-sequence (type sequence env) + (map type + (lambda (ast) (mal-eval ast env)) + (mal-data-value sequence))) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-eval (ast env) + (loop + do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + do (switch-mal-type ast + (types:symbol + (return + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key)))))) + (types:vector (return (make-mal-vector (eval-sequence 'vector ast env)))) + (types:hash-map (return (eval-hash-map ast env))) + (types:list + (let ((forms (mal-data-value ast))) + (cond + ((null forms) + (return ast)) + + ((mal-data-value= mal-def! (first forms)) + (return (env:set-env env (second forms) (mal-eval (third forms) env)))) + + ((mal-data-value= mal-let* (first forms)) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + (setf ast (third forms) + env new-env))) + + ((mal-data-value= mal-do (first forms)) + (mapc (lambda (form) (mal-eval form env)) + (butlast (cdr forms))) + (setf ast (car (last forms)))) + + ((mal-data-value= mal-if (first forms)) + (let ((predicate (mal-eval (second forms) env))) + (setf ast (if (or (mal-data-value= predicate mal-nil) + (mal-data-value= predicate mal-false)) + (or (fourth forms) mal-nil) + (third forms))))) + + ((mal-data-value= mal-fn* (first forms)) + (return (let ((arglist (second forms)) + (body (third forms))) + (make-mal-fn (lambda (&rest args) + (mal-eval body (env:create-mal-env :parent env + :binds (listify (mal-data-value arglist)) + :exprs args))) + :attrs (list (cons :params arglist) + (cons :ast body) + (cons :env env)))))) + + (t (let* ((evaluated-list (eval-sequence 'list ast env)) + (function (car evaluated-list))) + ;; If first element is a mal function unwrap it + (if (not (mal-fn-p function)) + (return (apply (mal-data-value function) + (cdr evaluated-list))) + (let* ((attrs (mal-data-attrs function))) + (setf ast (cdr (assoc :ast attrs)) + env (env:create-mal-env :parent (cdr (assoc :env attrs)) + :binds (map 'list + #'identity + (mal-data-value (cdr (assoc :params attrs)))) + :exprs (cdr evaluated-list)))))))))) + (types:any (return ast))))) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (error (condition) + (format nil "~a" condition)))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun main (&optional (argv nil argv-provided-p)) + (declare (ignorable argv argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (loop do (let ((line (mal-readline "user> "))) + (if line (mal-writeline (rep line)) (return))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step6_file.lisp b/impls/common-lisp/src/step6_file.lisp new file mode 100644 index 0000000000..e605ee35d2 --- /dev/null +++ b/impls/common-lisp/src/step6_file.lisp @@ -0,0 +1,231 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :core) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :listify + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(defvar *repl-env* (env:create-mal-env)) + +(dolist (binding core:ns) + (env:set-env *repl-env* (car binding) (cdr binding))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) +(defvar mal-do (make-mal-symbol "do")) +(defvar mal-if (make-mal-symbol "if")) +(defvar mal-fn* (make-mal-symbol "fn*")) + +(defun eval-sequence (type sequence env) + (map type + (lambda (ast) (mal-eval ast env)) + (mal-data-value sequence))) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-eval (ast env) + (loop + do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + do (switch-mal-type ast + (types:symbol + (return + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key)))))) + (types:vector (return (make-mal-vector (eval-sequence 'vector ast env)))) + (types:hash-map (return (eval-hash-map ast env))) + (types:list + (let ((forms (mal-data-value ast))) + (cond + ((null forms) + (return ast)) + + ((mal-data-value= mal-def! (first forms)) + (return (env:set-env env (second forms) (mal-eval (third forms) env)))) + + ((mal-data-value= mal-let* (first forms)) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + (setf ast (third forms) + env new-env))) + + ((mal-data-value= mal-do (first forms)) + (mapc (lambda (form) (mal-eval form env)) + (butlast (cdr forms))) + (setf ast (car (last forms)))) + + ((mal-data-value= mal-if (first forms)) + (let ((predicate (mal-eval (second forms) env))) + (setf ast (if (or (mal-data-value= predicate mal-nil) + (mal-data-value= predicate mal-false)) + (or (fourth forms) mal-nil) + (third forms))))) + + ((mal-data-value= mal-fn* (first forms)) + (return (let ((arglist (second forms)) + (body (third forms))) + (make-mal-fn (lambda (&rest args) + (mal-eval body (env:create-mal-env :parent env + :binds (listify (mal-data-value arglist)) + :exprs args))) + :attrs (list (cons :params arglist) + (cons :ast body) + (cons :env env)))))) + + (t (let* ((evaluated-list (eval-sequence 'list ast env)) + (function (car evaluated-list))) + ;; If first element is a mal function unwrap it + (if (not (mal-fn-p function)) + (return (apply (mal-data-value function) + (cdr evaluated-list))) + (let* ((attrs (mal-data-attrs function))) + (setf ast (cdr (assoc :ast attrs)) + env (env:create-mal-env :parent (cdr (assoc :env attrs)) + :binds (map 'list + #'identity + (mal-data-value (cdr (assoc :params attrs)))) + :exprs (cdr evaluated-list)))))))))) + (types:any (return ast))))) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (error (condition) + (format nil "~a" condition)))) + +(env:set-env *repl-env* + (make-mal-symbol "eval") + (make-mal-builtin-fn (lambda (ast) + (mal-eval ast *repl-env*)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun repl () + (loop do (let ((line (mal-readline "user> "))) + (if line + (mal-writeline (rep line)) + (return))))) + +(defun run-file (file) + (rep (format nil "(load-file \"~a\")" file))) + +(defun main (&optional (argv nil argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (let ((args (if argv-provided-p + argv + (cdr (utils:raw-command-line-arguments))))) + (env:set-env *repl-env* + (make-mal-symbol "*ARGV*") + (make-mal-list (mapcar #'make-mal-string (cdr args)))) + (if (null args) + (repl) + (run-file (car args))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step7_quote.lisp b/impls/common-lisp/src/step7_quote.lisp new file mode 100644 index 0000000000..546488cfcd --- /dev/null +++ b/impls/common-lisp/src/step7_quote.lisp @@ -0,0 +1,263 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :core) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :listify + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(defvar *repl-env* (env:create-mal-env)) + +(dolist (binding core:ns) + (env:set-env *repl-env* (car binding) (cdr binding))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) +(defvar mal-do (make-mal-symbol "do")) +(defvar mal-if (make-mal-symbol "if")) +(defvar mal-fn* (make-mal-symbol "fn*")) +(defvar mal-quote (make-mal-symbol "quote")) +(defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-unquote (make-mal-symbol "unquote")) +(defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) +(defvar mal-cons (make-mal-symbol "cons")) +(defvar mal-concat (make-mal-symbol "concat")) + +(defun eval-sequence (type sequence env) + (map type + (lambda (ast) (mal-eval ast env)) + (mal-data-value sequence))) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) +(defun quasiquote (ast) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) + + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-eval (ast env) + (loop + do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + do (switch-mal-type ast + (types:symbol + (return + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key)))))) + (types:vector (return (make-mal-vector (eval-sequence 'vector ast env)))) + (types:hash-map (return (eval-hash-map ast env))) + (types:list + (let ((forms (mal-data-value ast))) + (cond + ((null forms) + (return ast)) + + ((mal-data-value= mal-quote (first forms)) + (return (second forms))) + + ((mal-data-value= mal-quasiquote (first forms)) + (setf ast (quasiquote (second forms)))) + + ((mal-data-value= mal-def! (first forms)) + (return (env:set-env env (second forms) (mal-eval (third forms) env)))) + + ((mal-data-value= mal-let* (first forms)) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + (setf ast (third forms) + env new-env))) + + ((mal-data-value= mal-do (first forms)) + (mapc (lambda (form) (mal-eval form env)) + (butlast (cdr forms))) + (setf ast (car (last forms)))) + + ((mal-data-value= mal-if (first forms)) + (let ((predicate (mal-eval (second forms) env))) + (setf ast (if (or (mal-data-value= predicate mal-nil) + (mal-data-value= predicate mal-false)) + (or (fourth forms) mal-nil) + (third forms))))) + + ((mal-data-value= mal-fn* (first forms)) + (return (let ((arglist (second forms)) + (body (third forms))) + (make-mal-fn (lambda (&rest args) + (mal-eval body (env:create-mal-env :parent env + :binds (listify (mal-data-value arglist)) + :exprs args))) + :attrs (list (cons :params arglist) + (cons :ast body) + (cons :env env)))))) + + (t (let* ((evaluated-list (eval-sequence 'list ast env)) + (function (car evaluated-list))) + ;; If first element is a mal function unwrap it + (if (not (mal-fn-p function)) + (return (apply (mal-data-value function) + (cdr evaluated-list))) + (let* ((attrs (mal-data-attrs function))) + (setf ast (cdr (assoc :ast attrs)) + env (env:create-mal-env :parent (cdr (assoc :env attrs)) + :binds (map 'list + #'identity + (mal-data-value (cdr (assoc :params attrs)))) + :exprs (cdr evaluated-list)))))))))) + (types:any (return ast))))) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (error (condition) + (format nil "~a" condition)))) + +(env:set-env *repl-env* + (make-mal-symbol "eval") + (make-mal-builtin-fn (lambda (ast) + (mal-eval ast *repl-env*)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun repl () + (loop do (let ((line (mal-readline "user> "))) + (if line + (mal-writeline (rep line)) + (return))))) + +(defun run-file (file) + (rep (format nil "(load-file \"~a\")" file))) + +(defun main (&optional (argv nil argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (let ((args (if argv-provided-p + argv + (cdr (utils:raw-command-line-arguments))))) + (env:set-env *repl-env* + (make-mal-symbol "*ARGV*") + (make-mal-list (mapcar #'make-mal-string (cdr args)))) + (if (null args) + (repl) + (run-file (car args))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step8_macros.lisp b/impls/common-lisp/src/step8_macros.lisp new file mode 100644 index 0000000000..8f6745da3e --- /dev/null +++ b/impls/common-lisp/src/step8_macros.lisp @@ -0,0 +1,294 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :core) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :listify + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(define-condition invalid-function (mal-runtime-exception) + ((form :initarg :form :reader form) + (context :initarg :context :reader context)) + (:report (lambda (condition stream) + (format stream + "Invalid function '~a' provided while ~a" + (printer:pr-str (form condition)) + (if (string= (context condition) "apply") + "applying" + "defining macro"))))) + + +(defvar *repl-env* (env:create-mal-env)) + +(dolist (binding core:ns) + (env:set-env *repl-env* (car binding) (cdr binding))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) +(defvar mal-do (make-mal-symbol "do")) +(defvar mal-if (make-mal-symbol "if")) +(defvar mal-fn* (make-mal-symbol "fn*")) +(defvar mal-quote (make-mal-symbol "quote")) +(defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-unquote (make-mal-symbol "unquote")) +(defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) +(defvar mal-cons (make-mal-symbol "cons")) +(defvar mal-concat (make-mal-symbol "concat")) +(defvar mal-defmacro! (make-mal-symbol "defmacro!")) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) +(defun quasiquote (ast) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-eval (ast env) + (loop + do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + do (switch-mal-type ast + (types:symbol + (return + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key)))))) + (types:vector + (return (make-mal-vector (map 'vector (lambda (x) (mal-eval x env)) + (mal-data-value ast))))) + (types:hash-map (return (eval-hash-map ast env))) + (types:list + (let ((forms (mal-data-value ast))) + (cond + ((null forms) + (return ast)) + + ((mal-data-value= mal-quote (first forms)) + (return (second forms))) + + ((mal-data-value= mal-quasiquote (first forms)) + (setf ast (quasiquote (second forms)))) + + ((mal-data-value= mal-def! (first forms)) + (return (env:set-env env (second forms) (mal-eval (third forms) env)))) + + ((mal-data-value= mal-defmacro! (first forms)) + (let ((value (mal-eval (third forms) env))) + (return (if (mal-fn-p value) + (env:set-env env + (second forms) + (progn + (setf (cdr (assoc :is-macro (mal-data-attrs value))) t) + value)) + (error 'invalid-function + :form value + :context "macro"))))) + + ((mal-data-value= mal-let* (first forms)) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + (setf ast (third forms) + env new-env))) + + ((mal-data-value= mal-do (first forms)) + (mapc (lambda (form) (mal-eval form env)) + (butlast (cdr forms))) + (setf ast (car (last forms)))) + + ((mal-data-value= mal-if (first forms)) + (let ((predicate (mal-eval (second forms) env))) + (setf ast (if (or (mal-data-value= predicate mal-nil) + (mal-data-value= predicate mal-false)) + (or (fourth forms) mal-nil) + (third forms))))) + + ((mal-data-value= mal-fn* (first forms)) + (return (let ((arglist (second forms)) + (body (third forms))) + (make-mal-fn (lambda (&rest args) + (mal-eval body (env:create-mal-env :parent env + :binds (listify (mal-data-value arglist)) + :exprs args))) + :attrs (list (cons :params arglist) + (cons :ast body) + (cons :env env) + (cons :is-macro nil)))))) + + (t (let ((function (mal-eval (car forms) env)) + (args (cdr forms))) + ;; If first element is a mal function unwrap it + (cond ((mal-fn-p function) + (let ((attrs (mal-data-attrs function))) + (if (cdr (assoc :is-macro attrs)) + (setf ast (apply (mal-data-value function) args)) + (setf ast (cdr (assoc :ast attrs)) + env (env:create-mal-env :parent (cdr (assoc :env attrs)) + :binds (map 'list + #'identity + (mal-data-value (cdr (assoc :params attrs)))) + :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) + ((mal-builtin-fn-p function) + (return (apply (mal-data-value function) + (map 'list (lambda (x) (mal-eval x env)) args)))) + (t (error 'invalid-function + :form function + :context "apply")))))))) + (types:any (return ast))))) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (mal-error (condition) + (format nil "~a" condition)) + (error (condition) + (format nil "Internal error: ~a" condition)))) + +(env:set-env *repl-env* + (make-mal-symbol "eval") + (make-mal-builtin-fn (lambda (ast) + (mal-eval ast *repl-env*)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun repl () + (loop do (let ((line (mal-readline "user> "))) + (if line + (mal-writeline (rep line)) + (return))))) + +(defun run-file (file) + (rep (format nil "(load-file \"~a\")" file))) + +(defun main (&optional (argv nil argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (let ((args (if argv-provided-p + argv + (cdr (utils:raw-command-line-arguments))))) + (env:set-env *repl-env* + (make-mal-symbol "*ARGV*") + (make-mal-list (mapcar #'make-mal-string (cdr args)))) + (if (null args) + (repl) + (run-file (car args))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/step9_try.lisp b/impls/common-lisp/src/step9_try.lisp new file mode 100644 index 0000000000..e0e667a024 --- /dev/null +++ b/impls/common-lisp/src/step9_try.lisp @@ -0,0 +1,318 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :core) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :listify + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(define-condition invalid-function (mal-runtime-exception) + ((form :initarg :form :reader form) + (context :initarg :context :reader context)) + (:report (lambda (condition stream) + (format stream + "Invalid function '~a' provided while ~a" + (printer:pr-str (form condition)) + (if (string= (context condition) "apply") + "applying" + "defining macro"))))) + + +(defvar *repl-env* (env:create-mal-env)) + +(dolist (binding core:ns) + (env:set-env *repl-env* (car binding) (cdr binding))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) +(defvar mal-do (make-mal-symbol "do")) +(defvar mal-if (make-mal-symbol "if")) +(defvar mal-fn* (make-mal-symbol "fn*")) +(defvar mal-quote (make-mal-symbol "quote")) +(defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-unquote (make-mal-symbol "unquote")) +(defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) +(defvar mal-cons (make-mal-symbol "cons")) +(defvar mal-concat (make-mal-symbol "concat")) +(defvar mal-defmacro! (make-mal-symbol "defmacro!")) +(defvar mal-try* (make-mal-symbol "try*")) +(defvar mal-catch* (make-mal-symbol "catch*")) +(defvar mal-throw (make-mal-symbol "throw")) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) +(defun quasiquote (ast) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-eval (ast env) + (loop + do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + do (switch-mal-type ast + (types:symbol + (return + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key)))))) + (types:vector + (return (make-mal-vector (map 'vector (lambda (x) (mal-eval x env)) + (mal-data-value ast))))) + (types:hash-map (return (eval-hash-map ast env))) + (types:list + (let ((forms (mal-data-value ast))) + (cond + ((null forms) + (return ast)) + + ((mal-data-value= mal-quote (first forms)) + (return (second forms))) + + ((mal-data-value= mal-quasiquote (first forms)) + (setf ast (quasiquote (second forms)))) + + ((mal-data-value= mal-def! (first forms)) + (return (env:set-env env (second forms) (mal-eval (third forms) env)))) + + ((mal-data-value= mal-defmacro! (first forms)) + (let ((value (mal-eval (third forms) env))) + (return (if (mal-fn-p value) + (env:set-env env + (second forms) + (progn + (setf (cdr (assoc :is-macro (mal-data-attrs value))) t) + value)) + (error 'invalid-function + :form value + :context "macro"))))) + + ((mal-data-value= mal-let* (first forms)) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + (setf ast (third forms) + env new-env))) + + ((mal-data-value= mal-do (first forms)) + (mapc (lambda (form) (mal-eval form env)) + (butlast (cdr forms))) + (setf ast (car (last forms)))) + + ((mal-data-value= mal-if (first forms)) + (let ((predicate (mal-eval (second forms) env))) + (setf ast (if (or (mal-data-value= predicate mal-nil) + (mal-data-value= predicate mal-false)) + (or (fourth forms) mal-nil) + (third forms))))) + + ((mal-data-value= mal-fn* (first forms)) + (return (let ((arglist (second forms)) + (body (third forms))) + (make-mal-fn (lambda (&rest args) + (mal-eval body (env:create-mal-env :parent env + :binds (listify (mal-data-value arglist)) + :exprs args))) + :attrs (list (cons :params arglist) + (cons :ast body) + (cons :env env) + (cons :is-macro nil)))))) + + ((mal-data-value= mal-try* (first forms)) + (if (not (third forms)) + (return (mal-eval (second forms) env)) + (handler-case + (return (mal-eval (second forms) env)) + (error (condition) + (let ((catch-forms (mal-data-value (third forms)))) + (when (mal-data-value= mal-catch* + (first catch-forms)) + (return (mal-eval (third catch-forms) + (env:create-mal-env :parent env + :binds (list (second catch-forms)) + :exprs (list (if (typep condition 'mal-user-exception) + (mal-exception-data condition) + (make-mal-string (format nil "~a" condition))))))))))))) + + (t (let ((function (mal-eval (car forms) env)) + (args (cdr forms))) + ;; If first element is a mal function unwrap it + (cond ((mal-fn-p function) + (let ((attrs (mal-data-attrs function))) + (if (cdr (assoc :is-macro attrs)) + (setf ast (apply (mal-data-value function) args)) + (setf ast (cdr (assoc :ast attrs)) + env (env:create-mal-env :parent (cdr (assoc :env attrs)) + :binds (map 'list + #'identity + (mal-data-value (cdr (assoc :params attrs)))) + :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) + ((mal-builtin-fn-p function) + (return (apply (mal-data-value function) + (map 'list (lambda (x) (mal-eval x env)) args)))) + (t (error 'invalid-function + :form function + :context "apply")))))))) + (types:any (return ast))))) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (mal-error (condition) + (format nil "Error: ~a" condition)) + (mal-runtime-exception (condition) + (format nil "Exception: ~a" condition)) + (mal-user-exception (condition) + (format nil "Exception: ~a" (pr-str (mal-exception-data condition)))) + (error (condition) + (format nil "Internal error: ~a" condition)))) + +(env:set-env *repl-env* + (make-mal-symbol "eval") + (make-mal-builtin-fn (lambda (ast) + (mal-eval ast *repl-env*)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun repl () + (loop do (let ((line (mal-readline "user> "))) + (if line + (mal-writeline (rep line)) + (return))))) + +(defun run-file (file) + (rep (format nil "(load-file \"~a\")" file))) + +(defun main (&optional (argv nil argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (uiop:getenv "PERL_RL") "false") + (string= (uiop:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + + (let ((args (if argv-provided-p + argv + (cdr (utils:raw-command-line-arguments))))) + (env:set-env *repl-env* + (make-mal-symbol "*ARGV*") + (make-mal-list (mapcar #'make-mal-string (cdr args)))) + (if (null args) + (repl) + (run-file (car args))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail. + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/stepA_mal.lisp b/impls/common-lisp/src/stepA_mal.lisp new file mode 100644 index 0000000000..38428694c6 --- /dev/null +++ b/impls/common-lisp/src/stepA_mal.lisp @@ -0,0 +1,326 @@ +(defpackage :mal + (:use :common-lisp + :types + :env + :reader + :printer + :core) + (:import-from :cl-readline + :readline + :register-function) + (:import-from :genhash + :hashref + :hashmap) + (:import-from :utils + :listify + :getenv + :common-prefix) + (:export :main)) + +(in-package :mal) + +(define-condition invalid-function (mal-runtime-exception) + ((form :initarg :form :reader form) + (context :initarg :context :reader context)) + (:report (lambda (condition stream) + (format stream + "Invalid function '~a' provided while ~a" + (printer:pr-str (form condition)) + (if (string= (context condition) "apply") + "applying" + "defining macro"))))) + +(defvar *repl-env* (env:create-mal-env)) + +(dolist (binding core:ns) + (env:set-env *repl-env* (car binding) (cdr binding))) + +(defvar mal-def! (make-mal-symbol "def!")) +(defvar mal-let* (make-mal-symbol "let*")) +(defvar mal-do (make-mal-symbol "do")) +(defvar mal-if (make-mal-symbol "if")) +(defvar mal-fn* (make-mal-symbol "fn*")) +(defvar mal-quote (make-mal-symbol "quote")) +(defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-unquote (make-mal-symbol "unquote")) +(defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) +(defvar mal-cons (make-mal-symbol "cons")) +(defvar mal-concat (make-mal-symbol "concat")) +(defvar mal-defmacro! (make-mal-symbol "defmacro!")) +(defvar mal-try* (make-mal-symbol "try*")) +(defvar mal-catch* (make-mal-symbol "catch*")) +(defvar mal-throw (make-mal-symbol "throw")) + +(defun eval-hash-map (hash-map env) + (let ((hash-map-value (mal-data-value hash-map)) + (new-hash-table (make-mal-value-hash-table))) + (genhash:hashmap (lambda (key value) + (setf (genhash:hashref key new-hash-table) + (mal-eval value env))) + hash-map-value) + (make-mal-hash-map new-hash-table))) + +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) +(defun quasiquote (ast) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) + +(defun mal-read (string) + (reader:read-str string)) + +(defun mal-eval (ast env) + (loop + do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) + (when (and debug-eval + (not (mal-data-value= debug-eval mal-false)) + (not (mal-data-value= debug-eval mal-false))) + (write-line (format nil "EVAL: ~a" (pr-str ast))) + (force-output *standard-output*))) + do (switch-mal-type ast + (types:symbol + (return + (let ((key (mal-data-value ast))) + (or (env:get-env env key) + (error 'undefined-symbol :symbol (format nil "~a" key)))))) + (types:vector + (return (make-mal-vector (map 'vector (lambda (x) (mal-eval x env)) + (mal-data-value ast))))) + (types:hash-map (return (eval-hash-map ast env))) + (types:list + (let ((forms (mal-data-value ast))) + (cond + ((null forms) + (return ast)) + + ((mal-data-value= mal-quote (first forms)) + (return (second forms))) + + ((mal-data-value= mal-quasiquote (first forms)) + (setf ast (quasiquote (second forms)))) + + ((mal-data-value= mal-def! (first forms)) + (return (env:set-env env (second forms) (mal-eval (third forms) env)))) + + ((mal-data-value= mal-defmacro! (first forms)) + (let ((value (mal-eval (third forms) env))) + (return (if (mal-fn-p value) + (env:set-env env + (second forms) + (progn + (setf (cdr (assoc :is-macro (mal-data-attrs value))) t) + value)) + (error 'invalid-function + :form value + :context "macro"))))) + + ((mal-data-value= mal-let* (first forms)) + (let ((new-env (env:create-mal-env :parent env)) + (bindings (utils:listify (mal-data-value (second forms))))) + + (mapcar (lambda (binding) + (env:set-env new-env + (car binding) + (mal-eval (or (cdr binding) + mal-nil) + new-env))) + (loop + for (symbol value) on bindings + by #'cddr + collect (cons symbol value))) + (setf ast (third forms) + env new-env))) + + ((mal-data-value= mal-do (first forms)) + (mapc (lambda (form) (mal-eval form env)) + (butlast (cdr forms))) + (setf ast (car (last forms)))) + + ((mal-data-value= mal-if (first forms)) + (let ((predicate (mal-eval (second forms) env))) + (setf ast (if (or (mal-data-value= predicate mal-nil) + (mal-data-value= predicate mal-false)) + (or (fourth forms) mal-nil) + (third forms))))) + + ((mal-data-value= mal-fn* (first forms)) + (return (let ((arglist (second forms)) + (body (third forms))) + (make-mal-fn (lambda (&rest args) + (mal-eval body (env:create-mal-env :parent env + :binds (listify (mal-data-value arglist)) + :exprs args))) + :attrs (list (cons :params arglist) + (cons :ast body) + (cons :env env) + (cons :is-macro nil)))))) + + ((mal-data-value= mal-try* (first forms)) + (if (not (third forms)) + (return (mal-eval (second forms) env)) + (handler-case + (return (mal-eval (second forms) env)) + (error (condition) + (let ((catch-forms (mal-data-value (third forms)))) + (when (mal-data-value= mal-catch* + (first catch-forms)) + (return (mal-eval (third catch-forms) + (env:create-mal-env :parent env + :binds (list (second catch-forms)) + :exprs (list (if (typep condition 'mal-user-exception) + (mal-exception-data condition) + (make-mal-string (format nil "~a" condition))))))))))))) + + (t (let ((function (mal-eval (car forms) env)) + (args (cdr forms))) + ;; If first element is a mal function unwrap it + (cond ((mal-fn-p function) + (let ((attrs (mal-data-attrs function))) + (if (cdr (assoc :is-macro attrs)) + (setf ast (apply (mal-data-value function) args)) + (setf ast (cdr (assoc :ast attrs)) + env (env:create-mal-env :parent (cdr (assoc :env attrs)) + :binds (map 'list + #'identity + (mal-data-value (cdr (assoc :params attrs)))) + :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) + ((mal-builtin-fn-p function) + (return (apply (mal-data-value function) + (map 'list (lambda (x) (mal-eval x env)) args)))) + (t (error 'invalid-function + :form function + :context "apply")))))))) + (types:any (return ast))))) + +(defun mal-print (expression) + (printer:pr-str expression)) + +(defun rep (string) + (handler-case + (mal-print (mal-eval (mal-read string) *repl-env*)) + (mal-error (condition) + (format nil "Error: ~a" condition)) + (mal-runtime-exception (condition) + (format nil "Exception: ~a" condition)) + (mal-user-exception (condition) + (format nil "Exception: ~a" (pr-str (mal-exception-data condition)))) + (error (condition) + (format nil "Internal error: ~a" condition)))) + +(env:set-env *repl-env* + (make-mal-symbol "eval") + (make-mal-builtin-fn (lambda (ast) + (mal-eval ast *repl-env*)))) + +(env:set-env *repl-env* + (make-mal-symbol "*cl-implementation*") + (make-mal-string (lisp-implementation-type))) + +(env:set-env *repl-env* + (make-mal-symbol "*cl-version*") + (make-mal-string (lisp-implementation-version))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +(rep "(def! *host-language* \"common-lisp\")") + +(defvar *use-readline-p* nil) + +(defun complete-toplevel-symbols (input &rest ignored) + (declare (ignorable ignored)) + + (let (candidates) + (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) + when (let ((pos (search input key))) (and pos (zerop pos))) + do (push key candidates)) + + (if (= 1 (length candidates)) + (cons (car candidates) candidates) + (cons (apply #'utils:common-prefix candidates) candidates)))) + +(defun raw-input (prompt) + (format *standard-output* prompt) + (force-output *standard-output*) + (read-line *standard-input* nil)) + +(defun mal-readline (prompt) + (if *use-readline-p* + (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) + (raw-input prompt))) + +(defun mal-writeline (string) + (when string + (write-line string) + (force-output *standard-output*))) + +(defun repl () + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (loop do (let ((line (mal-readline "user> "))) + (if line + (mal-writeline (rep line)) + (return))))) + +(defun run-file (file) + (rep (format nil "(load-file \"~a\")" file))) + +(defun main (&optional (argv nil argv-provided-p)) + + (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") + (string= (utils:getenv "TERM") "dumb")))) + + ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort + ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment + ;; variable which the test runner sets causing `read-line' on *standard-input* + ;; to fail with an empty stream error. The following reinitializes the + ;; standard streams + ;; + ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html + #+clisp (setf *standard-input* (ext:make-stream :input) + *standard-output* (ext:make-stream :output :buffered t) + *error-output* (ext:make-stream :error :buffered t)) + + ;; CCL fails with a error while registering completion function + ;; See also https://github.com/mrkkrp/cl-readline/issues/5 + #-ccl (rl:register-function :complete #'complete-toplevel-symbols) + + (let ((args (if argv-provided-p + argv + (cdr (utils:raw-command-line-arguments))))) + (env:set-env *repl-env* + (make-mal-symbol "*ARGV*") + (make-mal-list (mapcar #'make-mal-string (cdr args)))) + (if (null args) + (repl) + (run-file (car args))))) + +;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an +;;; image containing foreign libraries is restored. The extra messages cause the +;;; MAL testcases to fail + +#+cmucl (progn + (defvar *old-standard-output* *standard-output* + "Keep track of current value standard output, this is restored after image restore completes") + + (defun muffle-output () + (setf *standard-output* (make-broadcast-stream))) + + (defun restore-output () + (setf *standard-output* *old-standard-output*)) + + (pushnew #'muffle-output ext:*after-save-initializations*) + (setf ext:*after-save-initializations* + (append ext:*after-save-initializations* (list #'restore-output)))) diff --git a/impls/common-lisp/src/types.lisp b/impls/common-lisp/src/types.lisp new file mode 100644 index 0000000000..6709c5e855 --- /dev/null +++ b/impls/common-lisp/src/types.lisp @@ -0,0 +1,191 @@ +(defpackage :types + (:use :common-lisp + :genhash) + (:import-from :utils + :listify) + (:export :mal-data-value= + ;; Accessors + :mal-data-value + :mal-data-type + :mal-data-meta + :mal-data-attrs + ;; Mal values + :number + :make-mal-number + :mal-number-p + + :boolean + :mal-boolean-p + + :nil + :mal-nil-p + + :string + :make-mal-string + :mal-string-p + + :symbol + :make-mal-symbol + :mal-symbol-p + + :keyword + :make-mal-keyword + :mal-keyword-p + + :list + :make-mal-list + :mal-list-p + + :vector + :make-mal-vector + :mal-vector-p + + :hash-map + :make-mal-hash-map + :mal-hash-map-p + + :atom + :make-mal-atom + :mal-atom-p + + :builtin-fn + :make-mal-builtin-fn + :mal-builtin-fn-p + + :fn + :make-mal-fn + :mal-fn-p + + :any + :switch-mal-type + + ;; Singleton values + :mal-nil + :mal-true + :mal-false + + ;; Hashing mal values + :make-mal-value-hash-table + ;; Error types + :mal-exception + :mal-exception-data + ;; Exceptions raised by the runtime + :mal-runtime-exception + ;; Exception raised by user code + :mal-user-exception + ;; Error + :mal-error)) + +(in-package :types) + +(define-condition mal-error (error) nil) + +(define-condition mal-exception (error) nil) + +(define-condition mal-runtime-exception (mal-exception) nil) + +(define-condition mal-user-exception (mal-exception) + ((data :accessor mal-exception-data :initarg :data))) + +(defstruct mal-data + (value nil) + (type nil :read-only t) + meta + attrs) + +;; Create a constructor and predicate for given type +(defmacro define-mal-type (type) + (let ((constructor (intern (format nil "MAKE-MAL-~a" (symbol-name type)))) + (predicate (intern (format nil "MAL-~a-P" (symbol-name type))))) + `(progn (defun ,constructor (value &key meta attrs) + (make-mal-data :type ',type + :value value + :meta meta + :attrs attrs)) + + (defun ,predicate (value) + (when (typep value 'mal-data) + (eq (mal-data-type value) ',type)))))) + +(define-mal-type number) +(define-mal-type symbol) +(define-mal-type keyword) +(define-mal-type string) +(define-mal-type boolean) +(define-mal-type nil) + +(define-mal-type list) +(define-mal-type vector) +(define-mal-type hash-map) + +(define-mal-type atom) + +(define-mal-type fn) +(define-mal-type builtin-fn) + +(defvar mal-nil (make-mal-nil nil)) +(defvar mal-true (make-mal-boolean t)) +(defvar mal-false (make-mal-boolean nil)) + +;; Generic type +(defvar any) + +(defmacro switch-mal-type (ast &body forms) + `(let ((type (mal-data-type ,ast))) + (cond + ,@(mapcar (lambda (form) + (list (or (equal (car form) t) + (equal (car form) 'any) + (list 'equal (list 'quote (car form)) 'type)) + (cadr form))) + forms)))) + +(defun mal-sequence= (value1 value2) + (let ((sequence1 (listify (mal-data-value value1))) + (sequence2 (listify (mal-data-value value2)))) + + (when (= (length sequence1) (length sequence2)) + (every #'identity (loop for x in sequence1 + for y in sequence2 + collect (mal-data-value= x y)))))) + +(defun mal-hash-map= (value1 value2) + (let ((map1 (mal-data-value value1)) + (map2 (mal-data-value value2)) + (identical t)) + (when (= (generic-hash-table-count map1) + (generic-hash-table-count map2)) + (hashmap (lambda (key value) + (declare (ignorable value)) + (setf identical + (and identical (mal-data-value= (hashref key map1) + (hashref key map2))))) + map1) + identical))) + +(defun mal-data-value= (value1 value2) + (when (and (typep value1 'mal-data) + (typep value2 'mal-data)) + + (if (equal (mal-data-type value1) (mal-data-type value2)) + (switch-mal-type value1 + (list (mal-sequence= value1 value2)) + (vector (mal-sequence= value1 value2)) + (hash-map (mal-hash-map= value1 value2)) + (any (equal (mal-data-value value1) (mal-data-value value2)))) + (when (or (and (mal-list-p value1) (mal-vector-p value2)) + (and (mal-list-p value2) (mal-vector-p value1))) + (mal-sequence= value1 value2))))) + +(defun mal-sxhash (value) + (sxhash (mal-data-value value))) + +(defun make-mal-value-hash-table () + (unless (gethash 'mal-data-value-hash genhash::*hash-test-designator-map*) + ;; sxhash does not work well with compound types, use a custom + ;; hash function which hashes the underlying value instead + (let ((hash-function #'mal-sxhash)) + (register-test-designator 'mal-data-value-hash + hash-function + #'mal-data-value=))) + (make-generic-hash-table :test 'mal-data-value-hash)) diff --git a/impls/common-lisp/src/utils.lisp b/impls/common-lisp/src/utils.lisp new file mode 100644 index 0000000000..95eadf5dab --- /dev/null +++ b/impls/common-lisp/src/utils.lisp @@ -0,0 +1,42 @@ +(defpackage :utils + (:use :common-lisp + :uiop) + (:export :replace-all + :getenv + :read-file-string + :raw-command-line-arguments + :listify + :common-prefix)) + +(in-package :utils) + +(defun replace-all (string part replacement &key (test #'char=)) + "Returns a new string in which all the occurences of the part +is replaced with replacement." + (with-output-to-string (out) + (loop with part-length = (length part) + for old-pos = 0 then (+ pos part-length) + for pos = (search part string + :start2 old-pos + :test test) + do (write-string string out + :start old-pos + :end (or pos (length string))) + when pos do (write-string replacement out) + while pos))) + +(defun listify (sequence) + "Convert a sequence to a list" + (map 'list #'identity sequence)) + +(defun common-prefix (&rest strings) + (if (not strings) + "" + (let* ((char-lists (mapcar (lambda (string) (coerce string 'list)) strings)) + (char-tuples (apply #'mapcar #'list char-lists)) + (count 0)) + (loop for char-tuple in char-tuples + while (every (lambda (char) (equal char (car char-tuple))) char-tuple) + do (incf count)) + + (subseq (car strings) 0 count)))) diff --git a/impls/common-lisp/step0_repl.asd b/impls/common-lisp/step0_repl.asd new file mode 100644 index 0000000000..57f978b66a --- /dev/null +++ b/impls/common-lisp/step0_repl.asd @@ -0,0 +1,24 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step0_repl" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 0 of MAL in Common Lisp" + :serial t + :components ((:file "step0_repl")) + :depends-on (:uiop :cl-readline) + :pathname "src/") diff --git a/impls/common-lisp/step1_read_print.asd b/impls/common-lisp/step1_read_print.asd new file mode 100644 index 0000000000..814538c6db --- /dev/null +++ b/impls/common-lisp/step1_read_print.asd @@ -0,0 +1,32 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step1_read_print" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 1 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "reader") + (:file "printer") + (:file "step1_read_print")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step2_eval.asd b/impls/common-lisp/step2_eval.asd new file mode 100644 index 0000000000..f83e21e5fe --- /dev/null +++ b/impls/common-lisp/step2_eval.asd @@ -0,0 +1,33 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step2_eval" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 2 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "step2_eval")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step3_env.asd b/impls/common-lisp/step3_env.asd new file mode 100644 index 0000000000..804921a499 --- /dev/null +++ b/impls/common-lisp/step3_env.asd @@ -0,0 +1,33 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step3_env" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 3 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "step3_env")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step4_if_fn_do.asd b/impls/common-lisp/step4_if_fn_do.asd new file mode 100644 index 0000000000..a2a7f44c08 --- /dev/null +++ b/impls/common-lisp/step4_if_fn_do.asd @@ -0,0 +1,34 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step4_if_fn_do" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 4 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "core") + (:file "step4_if_fn_do")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step5_tco.asd b/impls/common-lisp/step5_tco.asd new file mode 100644 index 0000000000..aa684ab52f --- /dev/null +++ b/impls/common-lisp/step5_tco.asd @@ -0,0 +1,34 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step5_tco" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 5 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "core") + (:file "step5_tco")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step6_file.asd b/impls/common-lisp/step6_file.asd new file mode 100644 index 0000000000..594ad8969b --- /dev/null +++ b/impls/common-lisp/step6_file.asd @@ -0,0 +1,34 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step6_file" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 6 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "core") + (:file "step6_file")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step7_quote.asd b/impls/common-lisp/step7_quote.asd new file mode 100644 index 0000000000..cf0ca7bff5 --- /dev/null +++ b/impls/common-lisp/step7_quote.asd @@ -0,0 +1,34 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step7_quote" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 7 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "core") + (:file "step7_quote")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step8_macros.asd b/impls/common-lisp/step8_macros.asd new file mode 100644 index 0000000000..5d6fdc7912 --- /dev/null +++ b/impls/common-lisp/step8_macros.asd @@ -0,0 +1,34 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step8_macros" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 8 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "core") + (:file "step8_macros")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/step9_try.asd b/impls/common-lisp/step9_try.asd new file mode 100644 index 0000000000..2a07db6cf4 --- /dev/null +++ b/impls/common-lisp/step9_try.asd @@ -0,0 +1,34 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "step9_try" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of step 9 of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "core") + (:file "step9_try")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/stepA_mal.asd b/impls/common-lisp/stepA_mal.asd new file mode 100644 index 0000000000..d8dc2774b4 --- /dev/null +++ b/impls/common-lisp/stepA_mal.asd @@ -0,0 +1,34 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) + +(ql:quickload :uiop :silent t :verbose nil) +(ql:quickload :cl-ppcre :silent t) +(ql:quickload :genhash :silent t) +(ql:quickload :alexandria :silent t) + +#-mkcl (ql:quickload :cl-readline :silent t) +#+mkcl (load "fake-readline.lisp") + +(defpackage #:mal-asd + (:use :cl :asdf)) + +(in-package :mal-asd) + +(defsystem "stepA_mal" + :name "MAL" + :version "1.0" + :author "Iqbal Ansari" + :description "Implementation of MAL in Common Lisp" + :serial t + :components ((:file "utils") + (:file "types") + (:file "env") + (:file "reader") + (:file "printer") + (:file "core") + (:file "stepA_mal")) + :depends-on (:uiop :cl-readline :cl-ppcre :genhash) + :pathname "src/") diff --git a/impls/common-lisp/tests/stepA_mal.mal b/impls/common-lisp/tests/stepA_mal.mal new file mode 100644 index 0000000000..69fe1351a9 --- /dev/null +++ b/impls/common-lisp/tests/stepA_mal.mal @@ -0,0 +1,61 @@ +;; Testing clisp interop + +(cl-eval "42") +;=>42 + +(cl-eval "(+ 1 1)") +;=>2 + +(cl-eval "(setq foo 1 bar 2 baz 3)") + +(cl-eval "(list foo bar baz)") +;=>(1 2 3) + +(cl-eval "7") +;=>7 + +;; +;; Testing boolean flag +(cl-eval "(= 123 123)" true) +;=>true + +(cl-eval "(= 123 456)") +;=>nil + +(cl-eval "(= 123 456)" true) +;=>false + +;; +;; Testing list flag +(cl-eval "(last nil)" false true) +;=>() + +(cl-eval "nil" false true) +;=>() + +(cl-eval "nil") +;=>nil + +;; +;; Testing creation of Common Lisp Objects +(cl-eval "#(1 2)") +;=>[1 2] + +;;; Not testing with elements since order in hashtable cannot be guaranteed +(cl-eval "(make-hash-table)") +;=>{} + +(cl-eval "(defun redundant-identity (x) x)")) +;=>REDUNDANT-IDENTITY + +(cl-eval "(redundant-identity 2)")) +;=>2 + +(cl-eval "(defun range (max &key (min 0) (step 1)) (loop for n from min below max by step collect n))") +;=>RANGE + +(cl-eval "(range 10 :min 0 :step 1)") +;=>(0 1 2 3 4 5 6 7 8 9) + +(cl-eval "(mapcar #'1+ (range 10 :min 0 :step 1))") +;=>(1 2 3 4 5 6 7 8 9 10) diff --git a/impls/cpp/.gitignore b/impls/cpp/.gitignore new file mode 100644 index 0000000000..fd01e16664 --- /dev/null +++ b/impls/cpp/.gitignore @@ -0,0 +1,5 @@ +.deps +*.o +*.a +step0_repl +step1_read_print diff --git a/impls/cpp/Core.cpp b/impls/cpp/Core.cpp new file mode 100644 index 0000000000..9e91edcec1 --- /dev/null +++ b/impls/cpp/Core.cpp @@ -0,0 +1,559 @@ +#include "MAL.h" +#include "Environment.h" +#include "StaticList.h" +#include "Types.h" + +#include +#include +#include + +#define CHECK_ARGS_IS(expected) \ + checkArgsIs(name.c_str(), expected, \ + std::distance(argsBegin, argsEnd)) + +#define CHECK_ARGS_BETWEEN(min, max) \ + checkArgsBetween(name.c_str(), min, max, \ + std::distance(argsBegin, argsEnd)) + +#define CHECK_ARGS_AT_LEAST(expected) \ + checkArgsAtLeast(name.c_str(), expected, \ + std::distance(argsBegin, argsEnd)) + +static String printValues(malValueIter begin, malValueIter end, + const String& sep, bool readably); + +static StaticList handlers; + +#define ARG(type, name) type* name = VALUE_CAST(type, *argsBegin++) + +#define FUNCNAME(uniq) builtIn ## uniq +#define HRECNAME(uniq) handler ## uniq +#define BUILTIN_DEF(uniq, symbol) \ + static malBuiltIn::ApplyFunc FUNCNAME(uniq); \ + static StaticList::Node HRECNAME(uniq) \ + (handlers, new malBuiltIn(symbol, FUNCNAME(uniq))); \ + malValuePtr FUNCNAME(uniq)(const String& name, \ + malValueIter argsBegin, malValueIter argsEnd) + +#define BUILTIN(symbol) BUILTIN_DEF(__LINE__, symbol) + +#define BUILTIN_ISA(symbol, type) \ + BUILTIN(symbol) { \ + CHECK_ARGS_IS(1); \ + return mal::boolean(DYNAMIC_CAST(type, *argsBegin)); \ + } + +#define BUILTIN_IS(op, constant) \ + BUILTIN(op) { \ + CHECK_ARGS_IS(1); \ + return mal::boolean(*argsBegin == mal::constant()); \ + } + +#define BUILTIN_INTOP(op, checkDivByZero) \ + BUILTIN(#op) { \ + CHECK_ARGS_IS(2); \ + ARG(malInteger, lhs); \ + ARG(malInteger, rhs); \ + if (checkDivByZero) { \ + MAL_CHECK(rhs->value() != 0, "Division by zero"); \ + } \ + return mal::integer(lhs->value() op rhs->value()); \ + } + +BUILTIN_ISA("atom?", malAtom); +BUILTIN_ISA("keyword?", malKeyword); +BUILTIN_ISA("list?", malList); +BUILTIN_ISA("map?", malHash); +BUILTIN_ISA("number?", malInteger); +BUILTIN_ISA("sequential?", malSequence); +BUILTIN_ISA("string?", malString); +BUILTIN_ISA("symbol?", malSymbol); +BUILTIN_ISA("vector?", malVector); + +BUILTIN_INTOP(+, false); +BUILTIN_INTOP(/, true); +BUILTIN_INTOP(*, false); +BUILTIN_INTOP(%, true); + +BUILTIN_IS("true?", trueValue); +BUILTIN_IS("false?", falseValue); +BUILTIN_IS("nil?", nilValue); + +BUILTIN("-") +{ + int argCount = CHECK_ARGS_BETWEEN(1, 2); + ARG(malInteger, lhs); + if (argCount == 1) { + return mal::integer(- lhs->value()); + } + + ARG(malInteger, rhs); + return mal::integer(lhs->value() - rhs->value()); +} + +BUILTIN("<=") +{ + CHECK_ARGS_IS(2); + ARG(malInteger, lhs); + ARG(malInteger, rhs); + + return mal::boolean(lhs->value() <= rhs->value()); +} + +BUILTIN(">=") +{ + CHECK_ARGS_IS(2); + ARG(malInteger, lhs); + ARG(malInteger, rhs); + + return mal::boolean(lhs->value() >= rhs->value()); +} + +BUILTIN("<") +{ + CHECK_ARGS_IS(2); + ARG(malInteger, lhs); + ARG(malInteger, rhs); + + return mal::boolean(lhs->value() < rhs->value()); +} + +BUILTIN(">") +{ + CHECK_ARGS_IS(2); + ARG(malInteger, lhs); + ARG(malInteger, rhs); + + return mal::boolean(lhs->value() > rhs->value()); +} + +BUILTIN("=") +{ + CHECK_ARGS_IS(2); + const malValue* lhs = (*argsBegin++).ptr(); + const malValue* rhs = (*argsBegin++).ptr(); + + return mal::boolean(lhs->isEqualTo(rhs)); +} + +BUILTIN("apply") +{ + CHECK_ARGS_AT_LEAST(2); + malValuePtr op = *argsBegin++; // this gets checked in APPLY + + // Copy the first N-1 arguments in. + malValueVec args(argsBegin, argsEnd-1); + + // Then append the argument as a list. + const malSequence* lastArg = VALUE_CAST(malSequence, *(argsEnd-1)); + for (int i = 0; i < lastArg->count(); i++) { + args.push_back(lastArg->item(i)); + } + + return APPLY(op, args.begin(), args.end()); +} + +BUILTIN("assoc") +{ + CHECK_ARGS_AT_LEAST(1); + ARG(malHash, hash); + + return hash->assoc(argsBegin, argsEnd); +} + +BUILTIN("atom") +{ + CHECK_ARGS_IS(1); + + return mal::atom(*argsBegin); +} + +BUILTIN("concat") +{ + int count = 0; + for (auto it = argsBegin; it != argsEnd; ++it) { + const malSequence* seq = VALUE_CAST(malSequence, *it); + count += seq->count(); + } + + malValueVec* items = new malValueVec(count); + int offset = 0; + for (auto it = argsBegin; it != argsEnd; ++it) { + const malSequence* seq = STATIC_CAST(malSequence, *it); + std::copy(seq->begin(), seq->end(), items->begin() + offset); + offset += seq->count(); + } + + return mal::list(items); +} + +BUILTIN("conj") +{ + CHECK_ARGS_AT_LEAST(1); + ARG(malSequence, seq); + + return seq->conj(argsBegin, argsEnd); +} + +BUILTIN("cons") +{ + CHECK_ARGS_IS(2); + malValuePtr first = *argsBegin++; + ARG(malSequence, rest); + + malValueVec* items = new malValueVec(1 + rest->count()); + items->at(0) = first; + std::copy(rest->begin(), rest->end(), items->begin() + 1); + + return mal::list(items); +} + +BUILTIN("contains?") +{ + CHECK_ARGS_IS(2); + if (*argsBegin == mal::nilValue()) { + return *argsBegin; + } + ARG(malHash, hash); + return mal::boolean(hash->contains(*argsBegin)); +} + +BUILTIN("count") +{ + CHECK_ARGS_IS(1); + if (*argsBegin == mal::nilValue()) { + return mal::integer(0); + } + + ARG(malSequence, seq); + return mal::integer(seq->count()); +} + +BUILTIN("deref") +{ + CHECK_ARGS_IS(1); + ARG(malAtom, atom); + + return atom->deref(); +} + +BUILTIN("dissoc") +{ + CHECK_ARGS_AT_LEAST(1); + ARG(malHash, hash); + + return hash->dissoc(argsBegin, argsEnd); +} + +BUILTIN("empty?") +{ + CHECK_ARGS_IS(1); + ARG(malSequence, seq); + + return mal::boolean(seq->isEmpty()); +} + +BUILTIN("eval") +{ + CHECK_ARGS_IS(1); + return EVAL(*argsBegin, NULL); +} + +BUILTIN("first") +{ + CHECK_ARGS_IS(1); + if (*argsBegin == mal::nilValue()) { + return mal::nilValue(); + } + ARG(malSequence, seq); + return seq->first(); +} + +BUILTIN("fn?") +{ + CHECK_ARGS_IS(1); + malValuePtr arg = *argsBegin++; + + // Lambdas are functions, unless they're macros. + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, arg)) { + return mal::boolean(!lambda->isMacro()); + } + // Builtins are functions. + return mal::boolean(DYNAMIC_CAST(malBuiltIn, arg)); +} + +BUILTIN("get") +{ + CHECK_ARGS_IS(2); + if (*argsBegin == mal::nilValue()) { + return *argsBegin; + } + ARG(malHash, hash); + return hash->get(*argsBegin); +} + +BUILTIN("hash-map") +{ + return mal::hash(argsBegin, argsEnd, true); +} + +BUILTIN("keys") +{ + CHECK_ARGS_IS(1); + ARG(malHash, hash); + return hash->keys(); +} + +BUILTIN("keyword") +{ + CHECK_ARGS_IS(1); + const malValuePtr arg = *argsBegin++; + if (malKeyword* s = DYNAMIC_CAST(malKeyword, arg)) + return s; + if (const malString* s = DYNAMIC_CAST(malString, arg)) + return mal::keyword(":" + s->value()); + MAL_FAIL("keyword expects a keyword or string"); +} + +BUILTIN("list") +{ + return mal::list(argsBegin, argsEnd); +} + +BUILTIN("macro?") +{ + CHECK_ARGS_IS(1); + + // Macros are implemented as lambdas, with a special flag. + const malLambda* lambda = DYNAMIC_CAST(malLambda, *argsBegin); + return mal::boolean((lambda != NULL) && lambda->isMacro()); +} + +BUILTIN("map") +{ + CHECK_ARGS_IS(2); + malValuePtr op = *argsBegin++; // this gets checked in APPLY + ARG(malSequence, source); + + const int length = source->count(); + malValueVec* items = new malValueVec(length); + auto it = source->begin(); + for (int i = 0; i < length; i++) { + items->at(i) = APPLY(op, it+i, it+i+1); + } + + return mal::list(items); +} + +BUILTIN("meta") +{ + CHECK_ARGS_IS(1); + malValuePtr obj = *argsBegin++; + + return obj->meta(); +} + +BUILTIN("nth") +{ + CHECK_ARGS_IS(2); + ARG(malSequence, seq); + ARG(malInteger, index); + + int i = index->value(); + MAL_CHECK(i >= 0 && i < seq->count(), "Index out of range"); + + return seq->item(i); +} + +BUILTIN("pr-str") +{ + return mal::string(printValues(argsBegin, argsEnd, " ", true)); +} + +BUILTIN("println") +{ + std::cout << printValues(argsBegin, argsEnd, " ", false) << "\n"; + return mal::nilValue(); +} + +BUILTIN("prn") +{ + std::cout << printValues(argsBegin, argsEnd, " ", true) << "\n"; + return mal::nilValue(); +} + +BUILTIN("read-string") +{ + CHECK_ARGS_IS(1); + ARG(malString, str); + + return readStr(str->value()); +} + +BUILTIN("readline") +{ + CHECK_ARGS_IS(1); + ARG(malString, str); + + return readline(str->value()); +} + +BUILTIN("reset!") +{ + CHECK_ARGS_IS(2); + ARG(malAtom, atom); + return atom->reset(*argsBegin); +} + +BUILTIN("rest") +{ + CHECK_ARGS_IS(1); + if (*argsBegin == mal::nilValue()) { + return mal::list(new malValueVec(0)); + } + ARG(malSequence, seq); + return seq->rest(); +} + +BUILTIN("seq") +{ + CHECK_ARGS_IS(1); + malValuePtr arg = *argsBegin++; + if (arg == mal::nilValue()) { + return mal::nilValue(); + } + if (const malSequence* seq = DYNAMIC_CAST(malSequence, arg)) { + return seq->isEmpty() ? mal::nilValue() + : mal::list(seq->begin(), seq->end()); + } + if (const malString* strVal = DYNAMIC_CAST(malString, arg)) { + const String str = strVal->value(); + int length = str.length(); + if (length == 0) + return mal::nilValue(); + + malValueVec* items = new malValueVec(length); + for (int i = 0; i < length; i++) { + (*items)[i] = mal::string(str.substr(i, 1)); + } + return mal::list(items); + } + MAL_FAIL("%s is not a string or sequence", arg->print(true).c_str()); +} + + +BUILTIN("slurp") +{ + CHECK_ARGS_IS(1); + ARG(malString, filename); + + std::ios_base::openmode openmode = + std::ios::ate | std::ios::in | std::ios::binary; + std::ifstream file(filename->value().c_str(), openmode); + MAL_CHECK(!file.fail(), "Cannot open %s", filename->value().c_str()); + + String data; + data.reserve(file.tellg()); + file.seekg(0, std::ios::beg); + data.append(std::istreambuf_iterator(file.rdbuf()), + std::istreambuf_iterator()); + + return mal::string(data); +} + +BUILTIN("str") +{ + return mal::string(printValues(argsBegin, argsEnd, "", false)); +} + +BUILTIN("swap!") +{ + CHECK_ARGS_AT_LEAST(2); + ARG(malAtom, atom); + + malValuePtr op = *argsBegin++; // this gets checked in APPLY + + malValueVec args(1 + argsEnd - argsBegin); + args[0] = atom->deref(); + std::copy(argsBegin, argsEnd, args.begin() + 1); + + malValuePtr value = APPLY(op, args.begin(), args.end()); + return atom->reset(value); +} + +BUILTIN("symbol") +{ + CHECK_ARGS_IS(1); + ARG(malString, token); + return mal::symbol(token->value()); +} + +BUILTIN("throw") +{ + CHECK_ARGS_IS(1); + throw *argsBegin; +} + +BUILTIN("time-ms") +{ + CHECK_ARGS_IS(0); + + using namespace std::chrono; + milliseconds ms = duration_cast( + high_resolution_clock::now().time_since_epoch() + ); + + return mal::integer(ms.count()); +} + +BUILTIN("vals") +{ + CHECK_ARGS_IS(1); + ARG(malHash, hash); + return hash->values(); +} + +BUILTIN("vec") +{ + CHECK_ARGS_IS(1); + ARG(malSequence, s); + return mal::vector(s->begin(), s->end()); +} + +BUILTIN("vector") +{ + return mal::vector(argsBegin, argsEnd); +} + +BUILTIN("with-meta") +{ + CHECK_ARGS_IS(2); + malValuePtr obj = *argsBegin++; + malValuePtr meta = *argsBegin++; + return obj->withMeta(meta); +} + +void installCore(malEnvPtr env) { + for (auto it = handlers.begin(), end = handlers.end(); it != end; ++it) { + malBuiltIn* handler = *it; + env->set(handler->name(), handler); + } +} + +static String printValues(malValueIter begin, malValueIter end, + const String& sep, bool readably) +{ + String out; + + if (begin != end) { + out += (*begin)->print(readably); + ++begin; + } + + for ( ; begin != end; ++begin) { + out += sep; + out += (*begin)->print(readably); + } + + return out; +} diff --git a/impls/cpp/Debug.h b/impls/cpp/Debug.h new file mode 100644 index 0000000000..c2ee75c78c --- /dev/null +++ b/impls/cpp/Debug.h @@ -0,0 +1,45 @@ +#ifndef INCLUDE_DEBUG_H +#define INCLUDE_DEBUG_H + +#include +#include + +#define DEBUG_TRACE 1 +//#define DEBUG_OBJECT_LIFETIMES 1 +//#define DEBUG_ENV_LIFETIMES 1 + +#define DEBUG_TRACE_FILE stderr + +#define NOOP do { } while (false) +#define NOTRACE(...) NOOP + +#if DEBUG_TRACE + #define TRACE(...) fprintf(DEBUG_TRACE_FILE, __VA_ARGS__) +#else + #define TRACE NOTRACE +#endif + +#if DEBUG_OBJECT_LIFETIMES + #define TRACE_OBJECT TRACE +#else + #define TRACE_OBJECT NOTRACE +#endif + +#if DEBUG_ENV_LIFETIMES + #define TRACE_ENV TRACE +#else + #define TRACE_ENV NOTRACE +#endif + +#define _ASSERT(file, line, condition, ...) \ + if (!(condition)) { \ + printf("Assertion failed at %s(%d): ", file, line); \ + printf(__VA_ARGS__); \ + exit(1); \ + } else { } + + +#define ASSERT(condition, ...) \ + _ASSERT(__FILE__, __LINE__, condition, __VA_ARGS__) + +#endif // INCLUDE_DEBUG_H diff --git a/impls/cpp/Dockerfile b/impls/cpp/Dockerfile new file mode 100644 index 0000000000..8c0e3f7931 --- /dev/null +++ b/impls/cpp/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Install g++ for any C/C++ based implementations +RUN apt-get -y install g++ libreadline-dev diff --git a/impls/cpp/Environment.cpp b/impls/cpp/Environment.cpp new file mode 100644 index 0000000000..1ae8f3e562 --- /dev/null +++ b/impls/cpp/Environment.cpp @@ -0,0 +1,73 @@ +#include "Environment.h" +#include "Types.h" + +#include + +malEnv::malEnv(malEnvPtr outer) +: m_outer(outer) +{ + TRACE_ENV("Creating malEnv %p, outer=%p\n", this, m_outer.ptr()); +} + +malEnv::malEnv(malEnvPtr outer, const StringVec& bindings, + malValueIter argsBegin, malValueIter argsEnd) +: m_outer(outer) +{ + TRACE_ENV("Creating malEnv %p, outer=%p\n", this, m_outer.ptr()); + int n = bindings.size(); + auto it = argsBegin; + for (int i = 0; i < n; i++) { + if (bindings[i] == "&") { + MAL_CHECK(i == n - 2, "There must be one parameter after the &"); + + set(bindings[n-1], mal::list(it, argsEnd)); + return; + } + MAL_CHECK(it != argsEnd, "Not enough parameters"); + set(bindings[i], *it); + ++it; + } + MAL_CHECK(it == argsEnd, "Too many parameters"); +} + +malEnv::~malEnv() +{ + TRACE_ENV("Destroying malEnv %p, outer=%p\n", this, m_outer.ptr()); +} + +malEnvPtr malEnv::find(const String& symbol) +{ + for (malEnvPtr env = this; env; env = env->m_outer) { + if (env->m_map.find(symbol) != env->m_map.end()) { + return env; + } + } + return NULL; +} + +malValuePtr malEnv::get(const String& symbol) +{ + for (malEnvPtr env = this; env; env = env->m_outer) { + auto it = env->m_map.find(symbol); + if (it != env->m_map.end()) { + return it->second; + } + } + MAL_FAIL("'%s' not found", symbol.c_str()); +} + +malValuePtr malEnv::set(const String& symbol, malValuePtr value) +{ + m_map[symbol] = value; + return value; +} + +malEnvPtr malEnv::getRoot() +{ + // Work our way down the the global environment. + for (malEnvPtr env = this; ; env = env->m_outer) { + if (!env->m_outer) { + return env; + } + } +} diff --git a/impls/cpp/Environment.h b/impls/cpp/Environment.h new file mode 100644 index 0000000000..9753a22ead --- /dev/null +++ b/impls/cpp/Environment.h @@ -0,0 +1,29 @@ +#ifndef INCLUDE_ENVIRONMENT_H +#define INCLUDE_ENVIRONMENT_H + +#include "MAL.h" + +#include + +class malEnv : public RefCounted { +public: + malEnv(malEnvPtr outer = NULL); + malEnv(malEnvPtr outer, + const StringVec& bindings, + malValueIter argsBegin, + malValueIter argsEnd); + + ~malEnv(); + + malValuePtr get(const String& symbol); + malEnvPtr find(const String& symbol); + malValuePtr set(const String& symbol, malValuePtr value); + malEnvPtr getRoot(); + +private: + typedef std::map Map; + Map m_map; + malEnvPtr m_outer; +}; + +#endif // INCLUDE_ENVIRONMENT_H diff --git a/impls/cpp/MAL.h b/impls/cpp/MAL.h new file mode 100644 index 0000000000..c82b50cc09 --- /dev/null +++ b/impls/cpp/MAL.h @@ -0,0 +1,32 @@ +#ifndef INCLUDE_MAL_H +#define INCLUDE_MAL_H + +#include "Debug.h" +#include "RefCountedPtr.h" +#include "String.h" +#include "Validation.h" + +#include + +class malValue; +typedef RefCountedPtr malValuePtr; +typedef std::vector malValueVec; +typedef malValueVec::iterator malValueIter; + +class malEnv; +typedef RefCountedPtr malEnvPtr; + +// step*.cpp +extern malValuePtr APPLY(malValuePtr op, + malValueIter argsBegin, malValueIter argsEnd); +extern malValuePtr EVAL(malValuePtr ast, malEnvPtr env); +extern malValuePtr readline(const String& prompt); +extern String rep(const String& input, malEnvPtr env); + +// Core.cpp +extern void installCore(malEnvPtr env); + +// Reader.cpp +extern malValuePtr readStr(const String& input); + +#endif // INCLUDE_MAL_H diff --git a/impls/cpp/Makefile b/impls/cpp/Makefile new file mode 100644 index 0000000000..1c81812297 --- /dev/null +++ b/impls/cpp/Makefile @@ -0,0 +1,51 @@ +uname_S := $(shell sh -c 'uname -s 2>/dev/null || echo not') + +CXX=g++ +ifeq ($(uname_S),Darwin) + # Native build on yosemite. Requires: brew install readline + READLINE=/usr/local/opt/readline + INCPATHS=-I$(READLINE)/include + LIBPATHS=-L$(READLINE)/lib +endif + +LD=$(CXX) +AR=ar + +DEBUG=-ggdb +CXXFLAGS=-O3 -Wall $(DEBUG) $(INCPATHS) -std=c++11 +LDFLAGS=-O3 $(DEBUG) $(LIBPATHS) -L. -lreadline -lhistory + +LIBSOURCES=Core.cpp Environment.cpp Reader.cpp ReadLine.cpp String.cpp \ + Types.cpp Validation.cpp +LIBOBJS=$(LIBSOURCES:%.cpp=%.o) + +MAINS=$(wildcard step*.cpp) +TARGETS=$(MAINS:%.cpp=%) + +.PHONY: all clean + +.SUFFIXES: .cpp .o + +all: $(TARGETS) + +dist: mal + +mal: stepA_mal + cp $< $@ + +.deps: *.cpp *.h + $(CXX) $(CXXFLAGS) -MM *.cpp > .deps + +$(TARGETS): %: %.o libmal.a + $(LD) $^ -o $@ $(LDFLAGS) + +libmal.a: $(LIBOBJS) + $(AR) rcs $@ $^ + +.cpp.o: + $(CXX) $(CXXFLAGS) -c $< -o $@ + +clean: + rm -rf *.o $(TARGETS) libmal.a .deps mal + +-include .deps diff --git a/impls/cpp/README.md b/impls/cpp/README.md new file mode 100644 index 0000000000..5d0ddd37d7 --- /dev/null +++ b/impls/cpp/README.md @@ -0,0 +1,40 @@ +# Compilation notes + +## Mac OSX + +This C++ implementation was developed on Mac OS X Yosemite, and uses the +stock g++ compiler. + +The only other requirement is GNU Readline, which I got from homebrew. + + brew install readline + +You may need to edit the READLINE path in the Makefile. + +## Ubuntu 14.10/15.04 + +This should compile on Ubuntu 14.10 and 15.04 with the following packages + + apt-get install clang-3.5 libreadline-dev make + +## Docker + +For everyone else, there is a Dockerfile and associated docker.sh script which +can be used to make and run this implementation. + + * build the docker image + + ./docker build + + * make the MAL binaries: + + ./docker make + + * run one of the implementations: + + ./docker run ./stepA_mal + + * open a shell inside the docker container: + + ./docker run + diff --git a/impls/cpp/ReadLine.cpp b/impls/cpp/ReadLine.cpp new file mode 100644 index 0000000000..f4b76609b2 --- /dev/null +++ b/impls/cpp/ReadLine.cpp @@ -0,0 +1,35 @@ +#include "ReadLine.h" +#include "String.h" + +#include +#include +#include + +#include +#include +#include + +ReadLine::ReadLine(const String& historyFile) +: m_historyPath(copyAndFree(tilde_expand(historyFile.c_str()))) +{ + read_history(m_historyPath.c_str()); +} + +ReadLine::~ReadLine() +{ +} + +bool ReadLine::get(const String& prompt, String& out) +{ + char *line = readline(prompt.c_str()); + if (line == NULL) { + return false; + } + add_history(line); // Add input to in-memory history + append_history(1, m_historyPath.c_str()); + + out = line; + free(line); + + return true; +} diff --git a/impls/cpp/ReadLine.h b/impls/cpp/ReadLine.h new file mode 100644 index 0000000000..94327aad97 --- /dev/null +++ b/impls/cpp/ReadLine.h @@ -0,0 +1,17 @@ +#ifndef INCLUDE_READLINE_H +#define INCLUDE_READLINE_H + +#include "String.h" + +class ReadLine { +public: + ReadLine(const String& historyFile); + ~ReadLine(); + + bool get(const String& prompt, String& line); + +private: + String m_historyPath; +}; + +#endif // INCLUDE_READLINE_H diff --git a/impls/cpp/Reader.cpp b/impls/cpp/Reader.cpp new file mode 100644 index 0000000000..dbcb6c9c83 --- /dev/null +++ b/impls/cpp/Reader.cpp @@ -0,0 +1,228 @@ +#include "MAL.h" +#include "Types.h" + +#include + +typedef std::regex Regex; + +static const Regex intRegex("^[-+]?\\d+$"); +static const Regex closeRegex("[\\)\\]}]"); + +static const Regex whitespaceRegex("[\\s,]+|;.*"); +static const Regex tokenRegexes[] = { + Regex("~@"), + Regex("[\\[\\]{}()'`~^@]"), + Regex("\"(?:\\\\.|[^\\\\\"])*\""), + Regex("[^\\s\\[\\]{}('\"`,;)]+"), +}; + +class Tokeniser +{ +public: + Tokeniser(const String& input); + + String peek() const { + ASSERT(!eof(), "Tokeniser reading past EOF in peek\n"); + return m_token; + } + + String next() { + ASSERT(!eof(), "Tokeniser reading past EOF in next\n"); + String ret = peek(); + nextToken(); + return ret; + } + + bool eof() const { + return m_iter == m_end; + } + +private: + void skipWhitespace(); + void nextToken(); + + bool matchRegex(const Regex& regex); + + typedef String::const_iterator StringIter; + + String m_token; + StringIter m_iter; + StringIter m_end; +}; + +Tokeniser::Tokeniser(const String& input) +: m_iter(input.begin()) +, m_end(input.end()) +{ + nextToken(); +} + +bool Tokeniser::matchRegex(const Regex& regex) +{ + if (eof()) { + return false; + } + + std::smatch match; + auto flags = std::regex_constants::match_continuous; + if (!std::regex_search(m_iter, m_end, match, regex, flags)) { + return false; + } + + ASSERT(match.size() == 1, "Should only have one submatch, not %lu\n", + match.size()); + ASSERT(match.position(0) == 0, "Need to match first character\n"); + ASSERT(match.length(0) > 0, "Need to match a non-empty string\n"); + + // Don't advance m_iter now, do it after we've consumed the token in + // next(). If we do it now, we hit eof() when there's still one token left. + m_token = match.str(0); + + return true; +} + +void Tokeniser::nextToken() +{ + m_iter += m_token.size(); + + skipWhitespace(); + if (eof()) { + return; + } + + for (auto &it : tokenRegexes) { + if (matchRegex(it)) { + return; + } + } + + String mismatch(m_iter, m_end); + if (mismatch[0] == '"') { + MAL_CHECK(false, "expected '\"', got EOF"); + } + else { + MAL_CHECK(false, "unexpected '%s'", mismatch.c_str()); + } +} + +void Tokeniser::skipWhitespace() +{ + while (matchRegex(whitespaceRegex)) { + m_iter += m_token.size(); + } +} + +static malValuePtr readAtom(Tokeniser& tokeniser); +static malValuePtr readForm(Tokeniser& tokeniser); +static void readList(Tokeniser& tokeniser, malValueVec* items, + const String& end); +static malValuePtr processMacro(Tokeniser& tokeniser, const String& symbol); + +malValuePtr readStr(const String& input) +{ + Tokeniser tokeniser(input); + if (tokeniser.eof()) { + throw malEmptyInputException(); + } + return readForm(tokeniser); +} + +static malValuePtr readForm(Tokeniser& tokeniser) +{ + MAL_CHECK(!tokeniser.eof(), "expected form, got EOF"); + String token = tokeniser.peek(); + + MAL_CHECK(!std::regex_match(token, closeRegex), + "unexpected '%s'", token.c_str()); + + if (token == "(") { + tokeniser.next(); + std::unique_ptr items(new malValueVec); + readList(tokeniser, items.get(), ")"); + return mal::list(items.release()); + } + if (token == "[") { + tokeniser.next(); + std::unique_ptr items(new malValueVec); + readList(tokeniser, items.get(), "]"); + return mal::vector(items.release()); + } + if (token == "{") { + tokeniser.next(); + malValueVec items; + readList(tokeniser, &items, "}"); + return mal::hash(items.begin(), items.end(), false); + } + return readAtom(tokeniser); +} + +static malValuePtr readAtom(Tokeniser& tokeniser) +{ + struct ReaderMacro { + const char* token; + const char* symbol; + }; + ReaderMacro macroTable[] = { + { "@", "deref" }, + { "`", "quasiquote" }, + { "'", "quote" }, + { "~@", "splice-unquote" }, + { "~", "unquote" }, + }; + + struct Constant { + const char* token; + malValuePtr value; + }; + Constant constantTable[] = { + { "false", mal::falseValue() }, + { "nil", mal::nilValue() }, + { "true", mal::trueValue() }, + }; + + String token = tokeniser.next(); + if (token[0] == '"') { + return mal::string(unescape(token)); + } + if (token[0] == ':') { + return mal::keyword(token); + } + if (token == "^") { + malValuePtr meta = readForm(tokeniser); + malValuePtr value = readForm(tokeniser); + // Note that meta and value switch places + return mal::list(mal::symbol("with-meta"), value, meta); + } + for (auto &constant : constantTable) { + if (token == constant.token) { + return constant.value; + } + } + for (auto ¯o : macroTable) { + if (token == macro.token) { + return processMacro(tokeniser, macro.symbol); + } + } + if (std::regex_match(token, intRegex)) { + return mal::integer(token); + } + return mal::symbol(token); +} + +static void readList(Tokeniser& tokeniser, malValueVec* items, + const String& end) +{ + while (1) { + MAL_CHECK(!tokeniser.eof(), "expected '%s', got EOF", end.c_str()); + if (tokeniser.peek() == end) { + tokeniser.next(); + return; + } + items->push_back(readForm(tokeniser)); + } +} + +static malValuePtr processMacro(Tokeniser& tokeniser, const String& symbol) +{ + return mal::list(mal::symbol(symbol), readForm(tokeniser)); +} diff --git a/impls/cpp/RefCountedPtr.h b/impls/cpp/RefCountedPtr.h new file mode 100644 index 0000000000..04cb952dc1 --- /dev/null +++ b/impls/cpp/RefCountedPtr.h @@ -0,0 +1,77 @@ +#ifndef INCLUDE_REFCOUNTEDPTR_H +#define INCLUDE_REFCOUNTEDPTR_H + +#include "Debug.h" + +#include + +class RefCounted { +public: + RefCounted() : m_refCount(0) { } + virtual ~RefCounted() { } + + const RefCounted* acquire() const { m_refCount++; return this; } + int release() const { return --m_refCount; } + int refCount() const { return m_refCount; } + +private: + RefCounted(const RefCounted&); // no copy ctor + RefCounted& operator = (const RefCounted&); // no assignments + + mutable int m_refCount; +}; + +template +class RefCountedPtr { +public: + RefCountedPtr() : m_object(0) { } + + RefCountedPtr(T* object) : m_object(0) + { acquire(object); } + + RefCountedPtr(const RefCountedPtr& rhs) : m_object(0) + { acquire(rhs.m_object); } + + const RefCountedPtr& operator = (const RefCountedPtr& rhs) { + acquire(rhs.m_object); + return *this; + } + + bool operator == (const RefCountedPtr& rhs) const { + return m_object == rhs.m_object; + } + + bool operator != (const RefCountedPtr& rhs) const { + return m_object != rhs.m_object; + } + + operator bool () const { + return m_object != NULL; + } + + ~RefCountedPtr() { + release(); + } + + T* operator -> () const { return m_object; } + T* ptr() const { return m_object; } + +private: + void acquire(T* object) { + if (object != NULL) { + object->acquire(); + } + release(); + m_object = object; + } + + void release() { + if ((m_object != NULL) && (m_object->release() == 0)) { + delete m_object; + } + } + + T* m_object; +}; + +#endif // INCLUDE_REFCOUNTEDPTR_H diff --git a/impls/cpp/StaticList.h b/impls/cpp/StaticList.h new file mode 100644 index 0000000000..a02a51c3a8 --- /dev/null +++ b/impls/cpp/StaticList.h @@ -0,0 +1,50 @@ +#ifndef INCLUDE_STATICLIST_H +#define INCLUDE_STATICLIST_H + +template +class StaticList +{ +public: + StaticList() : m_head(NULL) { } + + class Iterator; + Iterator begin() { return Iterator(m_head); } + Iterator end() { return Iterator(NULL); } + + class Node { + public: + Node(StaticList& list, T item) + : m_item(item), m_next(list.m_head) { + list.m_head = this; + } + + private: + friend class Iterator; + T m_item; + Node* m_next; + }; + + class Iterator { + public: + Iterator& operator ++ () { + m_node = m_node->m_next; + return *this; + } + + T& operator * () { return m_node->m_item; } + bool operator != (const Iterator& that) { + return m_node != that.m_node; + } + + private: + friend class StaticList; + Iterator(Node* node) : m_node(node) { } + Node* m_node; + }; + +private: + friend class Node; + Node* m_head; +}; + +#endif // INCLUDE_STATICLIST_H diff --git a/impls/cpp/String.cpp b/impls/cpp/String.cpp new file mode 100644 index 0000000000..dcdce2b0c1 --- /dev/null +++ b/impls/cpp/String.cpp @@ -0,0 +1,88 @@ +#include "Debug.h" +#include "String.h" + +#include +#include +#include +#include + +// Adapted from: http://stackoverflow.com/questions/2342162 +String stringPrintf(const char* fmt, ...) { + int size = strlen(fmt); // make a guess + String str; + va_list ap; + while (1) { + str.resize(size); + va_start(ap, fmt); + int n = vsnprintf((char *)str.data(), size, fmt, ap); + va_end(ap); + if (n > -1 && n < size) { // Everything worked + str.resize(n); + return str; + } + if (n > -1) // Needed size returned + size = n + 1; // For null char + else + size *= 2; // Guess at a larger size (OS specific) + } + return str; +} + +String copyAndFree(char* mallocedString) +{ + String ret(mallocedString); + free(mallocedString); + return ret; +} + +String escape(const String& in) +{ + String out; + out.reserve(in.size() * 2 + 2); // each char may get escaped + two "'s + out += '"'; + for (auto it = in.begin(), end = in.end(); it != end; ++it) { + char c = *it; + switch (c) { + case '\\': out += "\\\\"; break; + case '\n': out += "\\n"; break; + case '"': out += "\\\""; break; + default: out += c; break; + }; + } + out += '"'; + out.shrink_to_fit(); + return out; +} + +static char unescape(char c) +{ + switch (c) { + case '\\': return '\\'; + case 'n': return '\n'; + case '"': return '"'; + default: return c; + } +} + +String unescape(const String& in) +{ + String out; + out.reserve(in.size()); // unescaped string will always be shorter + + // in will have double-quotes at either end, so move the iterators in + for (auto it = in.begin()+1, end = in.end()-1; it != end; ++it) { + char c = *it; + if (c == '\\') { + ++it; + if (it != end) { + out += unescape(*it); + } + } + else { + out += c; + } + } + out.shrink_to_fit(); + return out; +} + diff --git a/impls/cpp/String.h b/impls/cpp/String.h new file mode 100644 index 0000000000..bbedf9b33d --- /dev/null +++ b/impls/cpp/String.h @@ -0,0 +1,18 @@ +#ifndef INCLUDE_STRING_H +#define INCLUDE_STRING_H + +#include +#include + +typedef std::string String; +typedef std::vector StringVec; + +#define STRF stringPrintf +#define PLURAL(n) &("s"[(n)==1]) + +extern String stringPrintf(const char* fmt, ...); +extern String copyAndFree(char* mallocedString); +extern String escape(const String& s); +extern String unescape(const String& s); + +#endif // INCLUDE_STRING_H diff --git a/impls/cpp/Types.cpp b/impls/cpp/Types.cpp new file mode 100644 index 0000000000..daf47cf748 --- /dev/null +++ b/impls/cpp/Types.cpp @@ -0,0 +1,498 @@ +#include "Debug.h" +#include "Environment.h" +#include "Types.h" + +#include +#include +#include + +namespace mal { + malValuePtr atom(malValuePtr value) { + return malValuePtr(new malAtom(value)); + }; + + malValuePtr boolean(bool value) { + return value ? trueValue() : falseValue(); + } + + malValuePtr builtin(const String& name, malBuiltIn::ApplyFunc handler) { + return malValuePtr(new malBuiltIn(name, handler)); + }; + + malValuePtr falseValue() { + static malValuePtr c(new malConstant("false")); + return malValuePtr(c); + }; + + + malValuePtr hash(const malHash::Map& map) { + return malValuePtr(new malHash(map)); + } + + malValuePtr hash(malValueIter argsBegin, malValueIter argsEnd, + bool isEvaluated) { + return malValuePtr(new malHash(argsBegin, argsEnd, isEvaluated)); + } + + malValuePtr integer(int64_t value) { + return malValuePtr(new malInteger(value)); + }; + + malValuePtr integer(const String& token) { + return integer(std::stoi(token)); + }; + + malValuePtr keyword(const String& token) { + return malValuePtr(new malKeyword(token)); + }; + + malValuePtr lambda(const StringVec& bindings, + malValuePtr body, malEnvPtr env) { + return malValuePtr(new malLambda(bindings, body, env)); + } + + malValuePtr list(malValueVec* items) { + return malValuePtr(new malList(items)); + }; + + malValuePtr list(malValueIter begin, malValueIter end) { + return malValuePtr(new malList(begin, end)); + }; + + malValuePtr list(malValuePtr a) { + malValueVec* items = new malValueVec(1); + items->at(0) = a; + return malValuePtr(new malList(items)); + } + + malValuePtr list(malValuePtr a, malValuePtr b) { + malValueVec* items = new malValueVec(2); + items->at(0) = a; + items->at(1) = b; + return malValuePtr(new malList(items)); + } + + malValuePtr list(malValuePtr a, malValuePtr b, malValuePtr c) { + malValueVec* items = new malValueVec(3); + items->at(0) = a; + items->at(1) = b; + items->at(2) = c; + return malValuePtr(new malList(items)); + } + + malValuePtr macro(const malLambda& lambda) { + return malValuePtr(new malLambda(lambda, true)); + }; + + malValuePtr nilValue() { + static malValuePtr c(new malConstant("nil")); + return malValuePtr(c); + }; + + malValuePtr string(const String& token) { + return malValuePtr(new malString(token)); + } + + malValuePtr symbol(const String& token) { + return malValuePtr(new malSymbol(token)); + }; + + malValuePtr trueValue() { + static malValuePtr c(new malConstant("true")); + return malValuePtr(c); + }; + + malValuePtr vector(malValueVec* items) { + return malValuePtr(new malVector(items)); + }; + + malValuePtr vector(malValueIter begin, malValueIter end) { + return malValuePtr(new malVector(begin, end)); + }; +}; + +malValuePtr malBuiltIn::apply(malValueIter argsBegin, + malValueIter argsEnd) const +{ + return m_handler(m_name, argsBegin, argsEnd); +} + +static String makeHashKey(malValuePtr key) +{ + if (const malString* skey = DYNAMIC_CAST(malString, key)) { + return skey->print(true); + } + else if (const malKeyword* kkey = DYNAMIC_CAST(malKeyword, key)) { + return kkey->print(true); + } + MAL_FAIL("%s is not a string or keyword", key->print(true).c_str()); +} + +static malHash::Map addToMap(malHash::Map& map, + malValueIter argsBegin, malValueIter argsEnd) +{ + // This is intended to be called with pre-evaluated arguments. + for (auto it = argsBegin; it != argsEnd; ++it) { + String key = makeHashKey(*it++); + map[key] = *it; + } + + return map; +} + +static malHash::Map createMap(malValueIter argsBegin, malValueIter argsEnd) +{ + MAL_CHECK(std::distance(argsBegin, argsEnd) % 2 == 0, + "hash-map requires an even-sized list"); + + malHash::Map map; + return addToMap(map, argsBegin, argsEnd); +} + +malHash::malHash(malValueIter argsBegin, malValueIter argsEnd, bool isEvaluated) +: m_map(createMap(argsBegin, argsEnd)) +, m_isEvaluated(isEvaluated) +{ + +} + +malHash::malHash(const malHash::Map& map) +: m_map(map) +, m_isEvaluated(true) +{ + +} + +malValuePtr +malHash::assoc(malValueIter argsBegin, malValueIter argsEnd) const +{ + MAL_CHECK(std::distance(argsBegin, argsEnd) % 2 == 0, + "assoc requires an even-sized list"); + + malHash::Map map(m_map); + return mal::hash(addToMap(map, argsBegin, argsEnd)); +} + +bool malHash::contains(malValuePtr key) const +{ + auto it = m_map.find(makeHashKey(key)); + return it != m_map.end(); +} + +malValuePtr +malHash::dissoc(malValueIter argsBegin, malValueIter argsEnd) const +{ + malHash::Map map(m_map); + for (auto it = argsBegin; it != argsEnd; ++it) { + String key = makeHashKey(*it); + map.erase(key); + } + return mal::hash(map); +} + +malValuePtr malHash::eval(malEnvPtr env) +{ + if (m_isEvaluated) { + return malValuePtr(this); + } + + malHash::Map map; + for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) { + map[it->first] = EVAL(it->second, env); + } + return mal::hash(map); +} + +malValuePtr malHash::get(malValuePtr key) const +{ + auto it = m_map.find(makeHashKey(key)); + return it == m_map.end() ? mal::nilValue() : it->second; +} + +malValuePtr malHash::keys() const +{ + malValueVec* keys = new malValueVec(); + keys->reserve(m_map.size()); + for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) { + if (it->first[0] == '"') { + keys->push_back(mal::string(unescape(it->first))); + } + else { + keys->push_back(mal::keyword(it->first)); + } + } + return mal::list(keys); +} + +malValuePtr malHash::values() const +{ + malValueVec* keys = new malValueVec(); + keys->reserve(m_map.size()); + for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) { + keys->push_back(it->second); + } + return mal::list(keys); +} + +String malHash::print(bool readably) const +{ + String s = "{"; + + auto it = m_map.begin(), end = m_map.end(); + if (it != end) { + s += it->first + " " + it->second->print(readably); + ++it; + } + for ( ; it != end; ++it) { + s += " " + it->first + " " + it->second->print(readably); + } + + return s + "}"; +} + +bool malHash::doIsEqualTo(const malValue* rhs) const +{ + const malHash::Map& r_map = static_cast(rhs)->m_map; + if (m_map.size() != r_map.size()) { + return false; + } + + for (auto it0 = m_map.begin(), end0 = m_map.end(), it1 = r_map.begin(); + it0 != end0; ++it0, ++it1) { + + if (it0->first != it1->first) { + return false; + } + if (!it0->second->isEqualTo(it1->second.ptr())) { + return false; + } + } + return true; +} + +malLambda::malLambda(const StringVec& bindings, + malValuePtr body, malEnvPtr env) +: m_bindings(bindings) +, m_body(body) +, m_env(env) +, m_isMacro(false) +{ + +} + +malLambda::malLambda(const malLambda& that, malValuePtr meta) +: malApplicable(meta) +, m_bindings(that.m_bindings) +, m_body(that.m_body) +, m_env(that.m_env) +, m_isMacro(that.m_isMacro) +{ + +} + +malLambda::malLambda(const malLambda& that, bool isMacro) +: malApplicable(that.m_meta) +, m_bindings(that.m_bindings) +, m_body(that.m_body) +, m_env(that.m_env) +, m_isMacro(isMacro) +{ + +} + +malValuePtr malLambda::apply(malValueIter argsBegin, + malValueIter argsEnd) const +{ + return EVAL(m_body, makeEnv(argsBegin, argsEnd)); +} + +malValuePtr malLambda::doWithMeta(malValuePtr meta) const +{ + return new malLambda(*this, meta); +} + +malEnvPtr malLambda::makeEnv(malValueIter argsBegin, malValueIter argsEnd) const +{ + return malEnvPtr(new malEnv(m_env, m_bindings, argsBegin, argsEnd)); +} + +malValuePtr malList::conj(malValueIter argsBegin, + malValueIter argsEnd) const +{ + int oldItemCount = std::distance(begin(), end()); + int newItemCount = std::distance(argsBegin, argsEnd); + + malValueVec* items = new malValueVec(oldItemCount + newItemCount); + std::reverse_copy(argsBegin, argsEnd, items->begin()); + std::copy(begin(), end(), items->begin() + newItemCount); + + return mal::list(items); +} + +malValuePtr malList::eval(malEnvPtr env) +{ + // Note, this isn't actually called since the TCO updates, but + // is required for the earlier steps, so don't get rid of it. + if (count() == 0) { + return malValuePtr(this); + } + + std::unique_ptr items(evalItems(env)); + auto it = items->begin(); + malValuePtr op = *it; + return APPLY(op, ++it, items->end()); +} + +String malList::print(bool readably) const +{ + return '(' + malSequence::print(readably) + ')'; +} + +malValuePtr malValue::eval(malEnvPtr env) +{ + // Default case of eval is just to return the object itself. + return malValuePtr(this); +} + +bool malValue::isEqualTo(const malValue* rhs) const +{ + // Special-case. Vectors and Lists can be compared. + bool matchingTypes = (typeid(*this) == typeid(*rhs)) || + (dynamic_cast(this) && + dynamic_cast(rhs)); + + return matchingTypes && doIsEqualTo(rhs); +} + +bool malValue::isTrue() const +{ + return (this != mal::falseValue().ptr()) + && (this != mal::nilValue().ptr()); +} + +malValuePtr malValue::meta() const +{ + return m_meta.ptr() == NULL ? mal::nilValue() : m_meta; +} + +malValuePtr malValue::withMeta(malValuePtr meta) const +{ + return doWithMeta(meta); +} + +malSequence::malSequence(malValueVec* items) +: m_items(items) +{ + +} + +malSequence::malSequence(malValueIter begin, malValueIter end) +: m_items(new malValueVec(begin, end)) +{ + +} + +malSequence::malSequence(const malSequence& that, malValuePtr meta) +: malValue(meta) +, m_items(new malValueVec(*(that.m_items))) +{ + +} + +malSequence::~malSequence() +{ + delete m_items; +} + +bool malSequence::doIsEqualTo(const malValue* rhs) const +{ + const malSequence* rhsSeq = static_cast(rhs); + if (count() != rhsSeq->count()) { + return false; + } + + for (malValueIter it0 = m_items->begin(), + it1 = rhsSeq->begin(), + end = m_items->end(); it0 != end; ++it0, ++it1) { + + if (! (*it0)->isEqualTo((*it1).ptr())) { + return false; + } + } + return true; +} + +malValueVec* malSequence::evalItems(malEnvPtr env) const +{ + malValueVec* items = new malValueVec;; + items->reserve(count()); + for (auto it = m_items->begin(), end = m_items->end(); it != end; ++it) { + items->push_back(EVAL(*it, env)); + } + return items; +} + +malValuePtr malSequence::first() const +{ + return count() == 0 ? mal::nilValue() : item(0); +} + +String malSequence::print(bool readably) const +{ + String str; + auto end = m_items->cend(); + auto it = m_items->cbegin(); + if (it != end) { + str += (*it)->print(readably); + ++it; + } + for ( ; it != end; ++it) { + str += " "; + str += (*it)->print(readably); + } + return str; +} + +malValuePtr malSequence::rest() const +{ + malValueIter start = (count() > 0) ? begin() + 1 : end(); + return mal::list(start, end()); +} + +String malString::escapedValue() const +{ + return escape(value()); +} + +String malString::print(bool readably) const +{ + return readably ? escapedValue() : value(); +} + +malValuePtr malSymbol::eval(malEnvPtr env) +{ + return env->get(value()); +} + +malValuePtr malVector::conj(malValueIter argsBegin, + malValueIter argsEnd) const +{ + int oldItemCount = std::distance(begin(), end()); + int newItemCount = std::distance(argsBegin, argsEnd); + + malValueVec* items = new malValueVec(oldItemCount + newItemCount); + std::copy(begin(), end(), items->begin()); + std::copy(argsBegin, argsEnd, items->begin() + oldItemCount); + + return mal::vector(items); +} + +malValuePtr malVector::eval(malEnvPtr env) +{ + return mal::vector(evalItems(env)); +} + +String malVector::print(bool readably) const +{ + return '[' + malSequence::print(readably) + ']'; +} diff --git a/impls/cpp/Types.h b/impls/cpp/Types.h new file mode 100644 index 0000000000..f92887c0fa --- /dev/null +++ b/impls/cpp/Types.h @@ -0,0 +1,374 @@ +#ifndef INCLUDE_TYPES_H +#define INCLUDE_TYPES_H + +#include "MAL.h" + +#include +#include + +class malEmptyInputException : public std::exception { }; + +class malValue : public RefCounted { +public: + malValue() { + TRACE_OBJECT("Creating malValue %p\n", this); + } + malValue(malValuePtr meta) : m_meta(meta) { + TRACE_OBJECT("Creating malValue %p\n", this); + } + virtual ~malValue() { + TRACE_OBJECT("Destroying malValue %p\n", this); + } + + malValuePtr withMeta(malValuePtr meta) const; + virtual malValuePtr doWithMeta(malValuePtr meta) const = 0; + malValuePtr meta() const; + + bool isTrue() const; + + bool isEqualTo(const malValue* rhs) const; + + virtual malValuePtr eval(malEnvPtr env); + + virtual String print(bool readably) const = 0; + +protected: + virtual bool doIsEqualTo(const malValue* rhs) const = 0; + + malValuePtr m_meta; +}; + +template +T* value_cast(malValuePtr obj, const char* typeName) { + T* dest = dynamic_cast(obj.ptr()); + MAL_CHECK(dest != NULL, "%s is not a %s", + obj->print(true).c_str(), typeName); + return dest; +} + +#define VALUE_CAST(Type, Value) value_cast(Value, #Type) +#define DYNAMIC_CAST(Type, Value) (dynamic_cast((Value).ptr())) +#define STATIC_CAST(Type, Value) (static_cast((Value).ptr())) + +#define WITH_META(Type) \ + virtual malValuePtr doWithMeta(malValuePtr meta) const { \ + return new Type(*this, meta); \ + } \ + +class malConstant : public malValue { +public: + malConstant(String name) : m_name(name) { } + malConstant(const malConstant& that, malValuePtr meta) + : malValue(meta), m_name(that.m_name) { } + + virtual String print(bool readably) const { return m_name; } + + virtual bool doIsEqualTo(const malValue* rhs) const { + return this == rhs; // these are singletons + } + + WITH_META(malConstant); + +private: + const String m_name; +}; + +class malInteger : public malValue { +public: + malInteger(int64_t value) : m_value(value) { } + malInteger(const malInteger& that, malValuePtr meta) + : malValue(meta), m_value(that.m_value) { } + + virtual String print(bool readably) const { + return std::to_string(m_value); + } + + int64_t value() const { return m_value; } + + virtual bool doIsEqualTo(const malValue* rhs) const { + return m_value == static_cast(rhs)->m_value; + } + + WITH_META(malInteger); + +private: + const int64_t m_value; +}; + +class malStringBase : public malValue { +public: + malStringBase(const String& token) + : m_value(token) { } + malStringBase(const malStringBase& that, malValuePtr meta) + : malValue(meta), m_value(that.value()) { } + + virtual String print(bool readably) const { return m_value; } + + String value() const { return m_value; } + +private: + const String m_value; +}; + +class malString : public malStringBase { +public: + malString(const String& token) + : malStringBase(token) { } + malString(const malString& that, malValuePtr meta) + : malStringBase(that, meta) { } + + virtual String print(bool readably) const; + + String escapedValue() const; + + virtual bool doIsEqualTo(const malValue* rhs) const { + return value() == static_cast(rhs)->value(); + } + + WITH_META(malString); +}; + +class malKeyword : public malStringBase { +public: + malKeyword(const String& token) + : malStringBase(token) { } + malKeyword(const malKeyword& that, malValuePtr meta) + : malStringBase(that, meta) { } + + virtual bool doIsEqualTo(const malValue* rhs) const { + return value() == static_cast(rhs)->value(); + } + + WITH_META(malKeyword); +}; + +class malSymbol : public malStringBase { +public: + malSymbol(const String& token) + : malStringBase(token) { } + malSymbol(const malSymbol& that, malValuePtr meta) + : malStringBase(that, meta) { } + + virtual malValuePtr eval(malEnvPtr env); + + virtual bool doIsEqualTo(const malValue* rhs) const { + return value() == static_cast(rhs)->value(); + } + + WITH_META(malSymbol); +}; + +class malSequence : public malValue { +public: + malSequence(malValueVec* items); + malSequence(malValueIter begin, malValueIter end); + malSequence(const malSequence& that, malValuePtr meta); + virtual ~malSequence(); + + virtual String print(bool readably) const; + + malValueVec* evalItems(malEnvPtr env) const; + int count() const { return m_items->size(); } + bool isEmpty() const { return m_items->empty(); } + malValuePtr item(int index) const { return (*m_items)[index]; } + + malValueIter begin() const { return m_items->begin(); } + malValueIter end() const { return m_items->end(); } + + virtual bool doIsEqualTo(const malValue* rhs) const; + + virtual malValuePtr conj(malValueIter argsBegin, + malValueIter argsEnd) const = 0; + + malValuePtr first() const; + virtual malValuePtr rest() const; + +private: + malValueVec* const m_items; +}; + +class malList : public malSequence { +public: + malList(malValueVec* items) : malSequence(items) { } + malList(malValueIter begin, malValueIter end) + : malSequence(begin, end) { } + malList(const malList& that, malValuePtr meta) + : malSequence(that, meta) { } + + virtual String print(bool readably) const; + virtual malValuePtr eval(malEnvPtr env); + + virtual malValuePtr conj(malValueIter argsBegin, + malValueIter argsEnd) const; + + WITH_META(malList); +}; + +class malVector : public malSequence { +public: + malVector(malValueVec* items) : malSequence(items) { } + malVector(malValueIter begin, malValueIter end) + : malSequence(begin, end) { } + malVector(const malVector& that, malValuePtr meta) + : malSequence(that, meta) { } + + virtual malValuePtr eval(malEnvPtr env); + virtual String print(bool readably) const; + + virtual malValuePtr conj(malValueIter argsBegin, + malValueIter argsEnd) const; + + WITH_META(malVector); +}; + +class malApplicable : public malValue { +public: + malApplicable() { } + malApplicable(malValuePtr meta) : malValue(meta) { } + + virtual malValuePtr apply(malValueIter argsBegin, + malValueIter argsEnd) const = 0; +}; + +class malHash : public malValue { +public: + typedef std::map Map; + + malHash(malValueIter argsBegin, malValueIter argsEnd, bool isEvaluated); + malHash(const malHash::Map& map); + malHash(const malHash& that, malValuePtr meta) + : malValue(meta), m_map(that.m_map), m_isEvaluated(that.m_isEvaluated) { } + + malValuePtr assoc(malValueIter argsBegin, malValueIter argsEnd) const; + malValuePtr dissoc(malValueIter argsBegin, malValueIter argsEnd) const; + bool contains(malValuePtr key) const; + malValuePtr eval(malEnvPtr env); + malValuePtr get(malValuePtr key) const; + malValuePtr keys() const; + malValuePtr values() const; + + virtual String print(bool readably) const; + + virtual bool doIsEqualTo(const malValue* rhs) const; + + WITH_META(malHash); + +private: + const Map m_map; + const bool m_isEvaluated; +}; + +class malBuiltIn : public malApplicable { +public: + typedef malValuePtr (ApplyFunc)(const String& name, + malValueIter argsBegin, + malValueIter argsEnd); + + malBuiltIn(const String& name, ApplyFunc* handler) + : m_name(name), m_handler(handler) { } + + malBuiltIn(const malBuiltIn& that, malValuePtr meta) + : malApplicable(meta), m_name(that.m_name), m_handler(that.m_handler) { } + + virtual malValuePtr apply(malValueIter argsBegin, + malValueIter argsEnd) const; + + virtual String print(bool readably) const { + return STRF("#builtin-function(%s)", m_name.c_str()); + } + + virtual bool doIsEqualTo(const malValue* rhs) const { + return this == rhs; // these are singletons + } + + String name() const { return m_name; } + + WITH_META(malBuiltIn); + +private: + const String m_name; + ApplyFunc* m_handler; +}; + +class malLambda : public malApplicable { +public: + malLambda(const StringVec& bindings, malValuePtr body, malEnvPtr env); + malLambda(const malLambda& that, malValuePtr meta); + malLambda(const malLambda& that, bool isMacro); + + virtual malValuePtr apply(malValueIter argsBegin, + malValueIter argsEnd) const; + + malValuePtr getBody() const { return m_body; } + malEnvPtr makeEnv(malValueIter argsBegin, malValueIter argsEnd) const; + + virtual bool doIsEqualTo(const malValue* rhs) const { + return this == rhs; // do we need to do a deep inspection? + } + + virtual String print(bool readably) const { + return STRF("#user-%s(%p)", m_isMacro ? "macro" : "function", this); + } + + bool isMacro() const { return m_isMacro; } + + virtual malValuePtr doWithMeta(malValuePtr meta) const; + +private: + const StringVec m_bindings; + const malValuePtr m_body; + const malEnvPtr m_env; + const bool m_isMacro; +}; + +class malAtom : public malValue { +public: + malAtom(malValuePtr value) : m_value(value) { } + malAtom(const malAtom& that, malValuePtr meta) + : malValue(meta), m_value(that.m_value) { } + + virtual bool doIsEqualTo(const malValue* rhs) const { + return this->m_value->isEqualTo(rhs); + } + + virtual String print(bool readably) const { + return "(atom " + m_value->print(readably) + ")"; + }; + + malValuePtr deref() const { return m_value; } + + malValuePtr reset(malValuePtr value) { return m_value = value; } + + WITH_META(malAtom); + +private: + malValuePtr m_value; +}; + +namespace mal { + malValuePtr atom(malValuePtr value); + malValuePtr boolean(bool value); + malValuePtr builtin(const String& name, malBuiltIn::ApplyFunc handler); + malValuePtr falseValue(); + malValuePtr hash(malValueIter argsBegin, malValueIter argsEnd, + bool isEvaluated); + malValuePtr hash(const malHash::Map& map); + malValuePtr integer(int64_t value); + malValuePtr integer(const String& token); + malValuePtr keyword(const String& token); + malValuePtr lambda(const StringVec&, malValuePtr, malEnvPtr); + malValuePtr list(malValueVec* items); + malValuePtr list(malValueIter begin, malValueIter end); + malValuePtr list(malValuePtr a); + malValuePtr list(malValuePtr a, malValuePtr b); + malValuePtr list(malValuePtr a, malValuePtr b, malValuePtr c); + malValuePtr macro(const malLambda& lambda); + malValuePtr nilValue(); + malValuePtr string(const String& token); + malValuePtr symbol(const String& token); + malValuePtr trueValue(); + malValuePtr vector(malValueVec* items); + malValuePtr vector(malValueIter begin, malValueIter end); +}; + +#endif // INCLUDE_TYPES_H diff --git a/impls/cpp/Validation.cpp b/impls/cpp/Validation.cpp new file mode 100644 index 0000000000..5b03b0f8ae --- /dev/null +++ b/impls/cpp/Validation.cpp @@ -0,0 +1,33 @@ +#include "Validation.h" + +int checkArgsIs(const char* name, int expected, int got) +{ + MAL_CHECK(got == expected, + "\"%s\" expects %d arg%s, %d supplied", + name, expected, PLURAL(expected), got); + return got; +} + +int checkArgsBetween(const char* name, int min, int max, int got) +{ + MAL_CHECK((got >= min) && (got <= max), + "\"%s\" expects between %d and %d arg%s, %d supplied", + name, min, max, PLURAL(max), got); + return got; +} + +int checkArgsAtLeast(const char* name, int min, int got) +{ + MAL_CHECK(got >= min, + "\"%s\" expects at least %d arg%s, %d supplied", + name, min, PLURAL(min), got); + return got; +} + +int checkArgsEven(const char* name, int got) +{ + MAL_CHECK(got % 2 == 0, + "\"%s\" expects an even number of args, %d supplied", + name, got); + return got; +} diff --git a/impls/cpp/Validation.h b/impls/cpp/Validation.h new file mode 100644 index 0000000000..d65e0fb64d --- /dev/null +++ b/impls/cpp/Validation.h @@ -0,0 +1,16 @@ +#ifndef INCLUDE_VALIDATION_H +#define INCLUDE_VALIDATION_H + +#include "String.h" + +#define MAL_CHECK(condition, ...) \ + if (!(condition)) { throw STRF(__VA_ARGS__); } else { } + +#define MAL_FAIL(...) MAL_CHECK(false, __VA_ARGS__) + +extern int checkArgsIs(const char* name, int expected, int got); +extern int checkArgsBetween(const char* name, int min, int max, int got); +extern int checkArgsAtLeast(const char* name, int min, int got); +extern int checkArgsEven(const char* name, int got); + +#endif // INCLUDE_VALIDATION_H diff --git a/impls/cpp/docker.sh b/impls/cpp/docker.sh new file mode 100755 index 0000000000..2714989f4a --- /dev/null +++ b/impls/cpp/docker.sh @@ -0,0 +1,34 @@ +#!/usr/bin/env bash + +IMAGE_NAME=mal-cpp +CONTAINER_NAME=mal-cpp-running + +run() { + docker rm -f $CONTAINER_NAME > /dev/null 2>/dev/null + docker run -v $PWD:/mal -ti --name $CONTAINER_NAME $IMAGE_NAME "$@" +} + +case $1 in + + build) + docker build -t $IMAGE_NAME . + ;; + + run) + shift + run "$@" + ;; + + make) + shift + run make "$@" + ;; + + *) + echo "usage: $0 [build|run|make]" + exit 1 + + ;; + +esac + diff --git a/impls/cpp/run b/impls/cpp/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/cpp/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/cpp/step0_repl.cpp b/impls/cpp/step0_repl.cpp new file mode 100644 index 0000000000..6b9b29c8d6 --- /dev/null +++ b/impls/cpp/step0_repl.cpp @@ -0,0 +1,42 @@ +#include "String.h" +#include "ReadLine.h" + +#include +#include + +String READ(const String& input); +String EVAL(const String& ast); +String PRINT(const String& ast); +String rep(const String& input); + +static ReadLine s_readLine("~/.mal-history"); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + while (s_readLine.get(prompt, input)) { + std::cout << rep(input) << "\n"; + } + return 0; +} + +String rep(const String& input) +{ + return PRINT(EVAL(READ(input))); +} + +String READ(const String& input) +{ + return input; +} + +String EVAL(const String& ast) +{ + return ast; +} + +String PRINT(const String& ast) +{ + return ast; +} diff --git a/impls/cpp/step1_read_print.cpp b/impls/cpp/step1_read_print.cpp new file mode 100644 index 0000000000..9075c45295 --- /dev/null +++ b/impls/cpp/step1_read_print.cpp @@ -0,0 +1,66 @@ +#include "MAL.h" + +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); + +static ReadLine s_readLine("~/.mal-history"); + +static String rep(const String& input); +static malValuePtr EVAL(malValuePtr ast); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + while (s_readLine.get(prompt, input)) { + String out; + try { + out = rep(input); + } + catch (malEmptyInputException&) { + continue; // no output + } + catch (String& s) { + out = s; + }; + std::cout << out << "\n"; + } + return 0; +} + +static String rep(const String& input) +{ + return PRINT(EVAL(READ(input))); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +static malValuePtr EVAL(malValuePtr ast) +{ + return ast; +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +// These have been added after step 1 to keep the linker happy. +malValuePtr EVAL(malValuePtr ast, malEnvPtr) +{ + return ast; +} + +malValuePtr APPLY(malValuePtr ast, malValueIter, malValueIter) +{ + return ast; +} diff --git a/impls/cpp/step2_eval.cpp b/impls/cpp/step2_eval.cpp new file mode 100644 index 0000000000..9b64f5ea5c --- /dev/null +++ b/impls/cpp/step2_eval.cpp @@ -0,0 +1,120 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); + +static ReadLine s_readLine("~/.mal-history"); +static malBuiltIn::ApplyFunc + builtIn_add, builtIn_sub, builtIn_mul, builtIn_div; + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + malEnvPtr replEnv(new malEnv); + replEnv->set("+", mal::builtin("+", &builtIn_add)); + replEnv->set("-", mal::builtin("-", &builtIn_sub)); + replEnv->set("*", mal::builtin("+", &builtIn_mul)); + replEnv->set("/", mal::builtin("/", &builtIn_div)); + while (s_readLine.get(prompt, input)) { + String out; + try { + out = rep(input, replEnv); + } + catch (malEmptyInputException&) { + continue; // no output + } + catch (String& s) { + out = s; + }; + std::cout << out << "\n"; + } + return 0; +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + // std::cout << "EVAL: " << PRINT(ast) << "\n"; + + return ast->eval(env); +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +#define ARG(type, name) type* name = VALUE_CAST(type, *argsBegin++) + +#define CHECK_ARGS_IS(expected) \ + checkArgsIs(name.c_str(), expected, std::distance(argsBegin, argsEnd)) + +#define CHECK_ARGS_BETWEEN(min, max) \ + checkArgsBetween(name.c_str(), min, max, std::distance(argsBegin, argsEnd)) + + +static malValuePtr builtIn_add(const String& name, + malValueIter argsBegin, malValueIter argsEnd) +{ + CHECK_ARGS_IS(2); + ARG(malInteger, lhs); + ARG(malInteger, rhs); + return mal::integer(lhs->value() + rhs->value()); +} + +static malValuePtr builtIn_sub(const String& name, + malValueIter argsBegin, malValueIter argsEnd) +{ + int argCount = CHECK_ARGS_BETWEEN(1, 2); + ARG(malInteger, lhs); + if (argCount == 1) { + return mal::integer(- lhs->value()); + } + ARG(malInteger, rhs); + return mal::integer(lhs->value() - rhs->value()); +} + +static malValuePtr builtIn_mul(const String& name, + malValueIter argsBegin, malValueIter argsEnd) +{ + CHECK_ARGS_IS(2); + ARG(malInteger, lhs); + ARG(malInteger, rhs); + return mal::integer(lhs->value() * rhs->value()); +} + +static malValuePtr builtIn_div(const String& name, + malValueIter argsBegin, malValueIter argsEnd) +{ + CHECK_ARGS_IS(2); + ARG(malInteger, lhs); + ARG(malInteger, rhs); + MAL_CHECK(rhs->value() != 0, "Division by zero"); \ + return mal::integer(lhs->value() / rhs->value()); +} diff --git a/impls/cpp/step3_env.cpp b/impls/cpp/step3_env.cpp new file mode 100644 index 0000000000..fe76214a71 --- /dev/null +++ b/impls/cpp/step3_env.cpp @@ -0,0 +1,120 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + while (s_readLine.get(prompt, input)) { + String out; + try { + out = rep(input, replEnv); + } + catch (malEmptyInputException&) { + continue; // no output + } + catch (String& s) { + out = s; + }; + std::cout << out << "\n"; + } + return 0; +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + return EVAL(list->item(2), inner); + } + } + + // Now we're left with the case of a regular list to be evaluated. + std::unique_ptr items(list->evalItems(env)); + malValuePtr op = items->at(0); + return APPLY(op, items->begin()+1, items->end()); +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/step4_if_fn_do.cpp b/impls/cpp/step4_if_fn_do.cpp new file mode 100644 index 0000000000..cef3c4ed99 --- /dev/null +++ b/impls/cpp/step4_if_fn_do.cpp @@ -0,0 +1,172 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); +static void installFunctions(malEnvPtr env); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + installFunctions(replEnv); + while (s_readLine.get(prompt, input)) { + String out; + try { + out = rep(input, replEnv); + } + catch (malEmptyInputException&) { + continue; // no output + } + catch (String& s) { + out = s; + }; + std::cout << out << "\n"; + } + return 0; +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "do") { + checkArgsAtLeast("do", 1, argCount); + + for (int i = 1; i < argCount; i++) { + EVAL(list->item(i), env); + } + return EVAL(list->item(argCount), env); + } + + if (special == "fn*") { + checkArgsIs("fn*", 2, argCount); + + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + StringVec params; + for (int i = 0; i < bindings->count(); i++) { + const malSymbol* sym = + VALUE_CAST(malSymbol, bindings->item(i)); + params.push_back(sym->value()); + } + + return mal::lambda(params, list->item(2), env); + } + + if (special == "if") { + checkArgsBetween("if", 2, 3, argCount); + + bool isTrue = EVAL(list->item(1), env)->isTrue(); + if (!isTrue && (argCount == 2)) { + return mal::nilValue(); + } + return EVAL(list->item(isTrue ? 2 : 3), env); + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + return EVAL(list->item(2), inner); + } + } + + // Now we're left with the case of a regular list to be evaluated. + std::unique_ptr items(list->evalItems(env)); + malValuePtr op = items->at(0); + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + return EVAL(lambda->getBody(), + lambda->makeEnv(items->begin()+1, items->end())); + } + else { + return APPLY(op, items->begin()+1, items->end()); + } +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +static const char* malFunctionTable[] = { + "(def! not (fn* (cond) (if cond false true)))", +}; + +static void installFunctions(malEnvPtr env) { + for (auto &function : malFunctionTable) { + rep(function, env); + } +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/step5_tco.cpp b/impls/cpp/step5_tco.cpp new file mode 100644 index 0000000000..0766d53f02 --- /dev/null +++ b/impls/cpp/step5_tco.cpp @@ -0,0 +1,179 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); +static void installFunctions(malEnvPtr env); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + installFunctions(replEnv); + while (s_readLine.get(prompt, input)) { + String out; + try { + out = rep(input, replEnv); + } + catch (malEmptyInputException&) { + continue; // no output + } + catch (String& s) { + out = s; + }; + std::cout << out << "\n"; + } + return 0; +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "do") { + checkArgsAtLeast("do", 1, argCount); + + for (int i = 1; i < argCount; i++) { + EVAL(list->item(i), env); + } + ast = list->item(argCount); + continue; // TCO + } + + if (special == "fn*") { + checkArgsIs("fn*", 2, argCount); + + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + StringVec params; + for (int i = 0; i < bindings->count(); i++) { + const malSymbol* sym = + VALUE_CAST(malSymbol, bindings->item(i)); + params.push_back(sym->value()); + } + + return mal::lambda(params, list->item(2), env); + } + + if (special == "if") { + checkArgsBetween("if", 2, 3, argCount); + + bool isTrue = EVAL(list->item(1), env)->isTrue(); + if (!isTrue && (argCount == 2)) { + return mal::nilValue(); + } + ast = list->item(isTrue ? 2 : 3); + continue; // TCO + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + ast = list->item(2); + env = inner; + continue; // TCO + } + } + + // Now we're left with the case of a regular list to be evaluated. + std::unique_ptr items(list->evalItems(env)); + malValuePtr op = items->at(0); + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + ast = lambda->getBody(); + env = lambda->makeEnv(items->begin()+1, items->end()); + continue; // TCO + } + else { + return APPLY(op, items->begin()+1, items->end()); + } + } +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +static const char* malFunctionTable[] = { + "(def! not (fn* (cond) (if cond false true)))", +}; + +static void installFunctions(malEnvPtr env) { + for (auto &function : malFunctionTable) { + rep(function, env); + } +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/step6_file.cpp b/impls/cpp/step6_file.cpp new file mode 100644 index 0000000000..e0c15e6109 --- /dev/null +++ b/impls/cpp/step6_file.cpp @@ -0,0 +1,204 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); +static void installFunctions(malEnvPtr env); + +static void makeArgv(malEnvPtr env, int argc, char* argv[]); +static String safeRep(const String& input, malEnvPtr env); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + installFunctions(replEnv); + makeArgv(replEnv, argc - 2, argv + 2); + if (argc > 1) { + String filename = escape(argv[1]); + safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); + return 0; + } + while (s_readLine.get(prompt, input)) { + String out = safeRep(input, replEnv); + if (out.length() > 0) + std::cout << out << "\n"; + } + return 0; +} + +static String safeRep(const String& input, malEnvPtr env) +{ + try { + return rep(input, env); + } + catch (malEmptyInputException&) { + return String(); + } + catch (String& s) { + return s; + }; +} + +static void makeArgv(malEnvPtr env, int argc, char* argv[]) +{ + malValueVec* args = new malValueVec(); + for (int i = 0; i < argc; i++) { + args->push_back(mal::string(argv[i])); + } + env->set("*ARGV*", mal::list(args)); +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "do") { + checkArgsAtLeast("do", 1, argCount); + + for (int i = 1; i < argCount; i++) { + EVAL(list->item(i), env); + } + ast = list->item(argCount); + continue; // TCO + } + + if (special == "fn*") { + checkArgsIs("fn*", 2, argCount); + + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + StringVec params; + for (int i = 0; i < bindings->count(); i++) { + const malSymbol* sym = + VALUE_CAST(malSymbol, bindings->item(i)); + params.push_back(sym->value()); + } + + return mal::lambda(params, list->item(2), env); + } + + if (special == "if") { + checkArgsBetween("if", 2, 3, argCount); + + bool isTrue = EVAL(list->item(1), env)->isTrue(); + if (!isTrue && (argCount == 2)) { + return mal::nilValue(); + } + ast = list->item(isTrue ? 2 : 3); + continue; // TCO + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + ast = list->item(2); + env = inner; + continue; // TCO + } + } + + // Now we're left with the case of a regular list to be evaluated. + std::unique_ptr items(list->evalItems(env)); + malValuePtr op = items->at(0); + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + ast = lambda->getBody(); + env = lambda->makeEnv(items->begin()+1, items->end()); + continue; // TCO + } + else { + return APPLY(op, items->begin()+1, items->end()); + } + } +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +static const char* malFunctionTable[] = { + "(def! not (fn* (cond) (if cond false true)))", + "(def! load-file (fn* (filename) \ + (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", +}; + +static void installFunctions(malEnvPtr env) { + for (auto &function : malFunctionTable) { + rep(function, env); + } +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/step7_quote.cpp b/impls/cpp/step7_quote.cpp new file mode 100644 index 0000000000..1ced69952a --- /dev/null +++ b/impls/cpp/step7_quote.cpp @@ -0,0 +1,259 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); +static void installFunctions(malEnvPtr env); + +static void makeArgv(malEnvPtr env, int argc, char* argv[]); +static String safeRep(const String& input, malEnvPtr env); +static malValuePtr quasiquote(malValuePtr obj); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + installFunctions(replEnv); + makeArgv(replEnv, argc - 2, argv + 2); + if (argc > 1) { + String filename = escape(argv[1]); + safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); + return 0; + } + while (s_readLine.get(prompt, input)) { + String out = safeRep(input, replEnv); + if (out.length() > 0) + std::cout << out << "\n"; + } + return 0; +} + +static String safeRep(const String& input, malEnvPtr env) +{ + try { + return rep(input, env); + } + catch (malEmptyInputException&) { + return String(); + } + catch (String& s) { + return s; + }; +} + +static void makeArgv(malEnvPtr env, int argc, char* argv[]) +{ + malValueVec* args = new malValueVec(); + for (int i = 0; i < argc; i++) { + args->push_back(mal::string(argv[i])); + } + env->set("*ARGV*", mal::list(args)); +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "do") { + checkArgsAtLeast("do", 1, argCount); + + for (int i = 1; i < argCount; i++) { + EVAL(list->item(i), env); + } + ast = list->item(argCount); + continue; // TCO + } + + if (special == "fn*") { + checkArgsIs("fn*", 2, argCount); + + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + StringVec params; + for (int i = 0; i < bindings->count(); i++) { + const malSymbol* sym = + VALUE_CAST(malSymbol, bindings->item(i)); + params.push_back(sym->value()); + } + + return mal::lambda(params, list->item(2), env); + } + + if (special == "if") { + checkArgsBetween("if", 2, 3, argCount); + + bool isTrue = EVAL(list->item(1), env)->isTrue(); + if (!isTrue && (argCount == 2)) { + return mal::nilValue(); + } + ast = list->item(isTrue ? 2 : 3); + continue; // TCO + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + ast = list->item(2); + env = inner; + continue; // TCO + } + + if (special == "quasiquote") { + checkArgsIs("quasiquote", 1, argCount); + ast = quasiquote(list->item(1)); + continue; // TCO + } + + if (special == "quote") { + checkArgsIs("quote", 1, argCount); + return list->item(1); + } + } + + // Now we're left with the case of a regular list to be evaluated. + std::unique_ptr items(list->evalItems(env)); + malValuePtr op = items->at(0); + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + ast = lambda->getBody(); + env = lambda->makeEnv(items->begin()+1, items->end()); + continue; // TCO + } + else { + return APPLY(op, items->begin()+1, items->end()); + } + } +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +static bool isSymbol(malValuePtr obj, const String& text) +{ + const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); + return sym && (sym->value() == text); +} + +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) +{ + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); +} + +static malValuePtr quasiquote(malValuePtr obj) +{ + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) + return mal::list(mal::symbol("quote"), obj); + + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; + + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); + } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; +} + +static const char* malFunctionTable[] = { + "(def! not (fn* (cond) (if cond false true)))", + "(def! load-file (fn* (filename) \ + (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", +}; + +static void installFunctions(malEnvPtr env) { + for (auto &function : malFunctionTable) { + rep(function, env); + } +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/step8_macros.cpp b/impls/cpp/step8_macros.cpp new file mode 100644 index 0000000000..b8897adbd1 --- /dev/null +++ b/impls/cpp/step8_macros.cpp @@ -0,0 +1,275 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); +static void installFunctions(malEnvPtr env); +// Installs functions and macros implemented in MAL. + +static void makeArgv(malEnvPtr env, int argc, char* argv[]); +static String safeRep(const String& input, malEnvPtr env); +static malValuePtr quasiquote(malValuePtr obj); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + installFunctions(replEnv); + makeArgv(replEnv, argc - 2, argv + 2); + if (argc > 1) { + String filename = escape(argv[1]); + safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); + return 0; + } + while (s_readLine.get(prompt, input)) { + String out = safeRep(input, replEnv); + if (out.length() > 0) + std::cout << out << "\n"; + } + return 0; +} + +static String safeRep(const String& input, malEnvPtr env) +{ + try { + return rep(input, env); + } + catch (malEmptyInputException&) { + return String(); + } + catch (String& s) { + return s; + }; +} + +static void makeArgv(malEnvPtr env, int argc, char* argv[]) +{ + malValueVec* args = new malValueVec(); + for (int i = 0; i < argc; i++) { + args->push_back(mal::string(argv[i])); + } + env->set("*ARGV*", mal::list(args)); +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "defmacro!") { + checkArgsIs("defmacro!", 2, argCount); + + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + malValuePtr body = EVAL(list->item(2), env); + const malLambda* lambda = VALUE_CAST(malLambda, body); + return env->set(id->value(), mal::macro(*lambda)); + } + + if (special == "do") { + checkArgsAtLeast("do", 1, argCount); + + for (int i = 1; i < argCount; i++) { + EVAL(list->item(i), env); + } + ast = list->item(argCount); + continue; // TCO + } + + if (special == "fn*") { + checkArgsIs("fn*", 2, argCount); + + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + StringVec params; + for (int i = 0; i < bindings->count(); i++) { + const malSymbol* sym = + VALUE_CAST(malSymbol, bindings->item(i)); + params.push_back(sym->value()); + } + + return mal::lambda(params, list->item(2), env); + } + + if (special == "if") { + checkArgsBetween("if", 2, 3, argCount); + + bool isTrue = EVAL(list->item(1), env)->isTrue(); + if (!isTrue && (argCount == 2)) { + return mal::nilValue(); + } + ast = list->item(isTrue ? 2 : 3); + continue; // TCO + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + ast = list->item(2); + env = inner; + continue; // TCO + } + + if (special == "quasiquote") { + checkArgsIs("quasiquote", 1, argCount); + ast = quasiquote(list->item(1)); + continue; // TCO + } + + if (special == "quote") { + checkArgsIs("quote", 1, argCount); + return list->item(1); + } + } + + // Now we're left with the case of a regular list to be evaluated. + malValuePtr op = EVAL(list->item(0), env); + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + if (lambda->isMacro()) { + ast = lambda->apply(list->begin()+1, list->end()); + continue; // TCO + } + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + ast = lambda->getBody(); + env = lambda->makeEnv(items->begin(), items->end()); + continue; // TCO + } + else { + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); + } + } +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +static bool isSymbol(malValuePtr obj, const String& text) +{ + const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); + return sym && (sym->value() == text); +} + +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) +{ + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); +} + +static malValuePtr quasiquote(malValuePtr obj) +{ + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) + return mal::list(mal::symbol("quote"), obj); + + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; + + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); + } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; +} + +static const char* malFunctionTable[] = { + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + "(def! not (fn* (cond) (if cond false true)))", + "(def! load-file (fn* (filename) \ + (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", +}; + +static void installFunctions(malEnvPtr env) { + for (auto &function : malFunctionTable) { + rep(function, env); + } +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/step9_try.cpp b/impls/cpp/step9_try.cpp new file mode 100644 index 0000000000..c04ede8300 --- /dev/null +++ b/impls/cpp/step9_try.cpp @@ -0,0 +1,324 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); +static void installFunctions(malEnvPtr env); +// Installs functions and macros implemented in MAL. + +static void makeArgv(malEnvPtr env, int argc, char* argv[]); +static String safeRep(const String& input, malEnvPtr env); +static malValuePtr quasiquote(malValuePtr obj); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + installFunctions(replEnv); + makeArgv(replEnv, argc - 2, argv + 2); + if (argc > 1) { + String filename = escape(argv[1]); + safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); + return 0; + } + while (s_readLine.get(prompt, input)) { + String out = safeRep(input, replEnv); + if (out.length() > 0) + std::cout << out << "\n"; + } + return 0; +} + +static String safeRep(const String& input, malEnvPtr env) +{ + try { + return rep(input, env); + } + catch (malEmptyInputException&) { + return String(); + } + catch (malValuePtr& mv) { + return "Error: " + mv->print(true); + } + catch (String& s) { + return "Error: " + s; + }; +} + +static void makeArgv(malEnvPtr env, int argc, char* argv[]) +{ + malValueVec* args = new malValueVec(); + for (int i = 0; i < argc; i++) { + args->push_back(mal::string(argv[i])); + } + env->set("*ARGV*", mal::list(args)); +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "defmacro!") { + checkArgsIs("defmacro!", 2, argCount); + + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + malValuePtr body = EVAL(list->item(2), env); + const malLambda* lambda = VALUE_CAST(malLambda, body); + return env->set(id->value(), mal::macro(*lambda)); + } + + if (special == "do") { + checkArgsAtLeast("do", 1, argCount); + + for (int i = 1; i < argCount; i++) { + EVAL(list->item(i), env); + } + ast = list->item(argCount); + continue; // TCO + } + + if (special == "fn*") { + checkArgsIs("fn*", 2, argCount); + + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + StringVec params; + for (int i = 0; i < bindings->count(); i++) { + const malSymbol* sym = + VALUE_CAST(malSymbol, bindings->item(i)); + params.push_back(sym->value()); + } + + return mal::lambda(params, list->item(2), env); + } + + if (special == "if") { + checkArgsBetween("if", 2, 3, argCount); + + bool isTrue = EVAL(list->item(1), env)->isTrue(); + if (!isTrue && (argCount == 2)) { + return mal::nilValue(); + } + ast = list->item(isTrue ? 2 : 3); + continue; // TCO + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + ast = list->item(2); + env = inner; + continue; // TCO + } + + if (special == "quasiquote") { + checkArgsIs("quasiquote", 1, argCount); + ast = quasiquote(list->item(1)); + continue; // TCO + } + + if (special == "quote") { + checkArgsIs("quote", 1, argCount); + return list->item(1); + } + + if (special == "try*") { + malValuePtr tryBody = list->item(1); + + if (argCount == 1) { + ast = tryBody; + continue; // TCO + } + checkArgsIs("try*", 2, argCount); + const malList* catchBlock = VALUE_CAST(malList, list->item(2)); + + checkArgsIs("catch*", 2, catchBlock->count() - 1); + MAL_CHECK(VALUE_CAST(malSymbol, + catchBlock->item(0))->value() == "catch*", + "catch block must begin with catch*"); + + // We don't need excSym at this scope, but we want to check + // that the catch block is valid always, not just in case of + // an exception. + const malSymbol* excSym = + VALUE_CAST(malSymbol, catchBlock->item(1)); + + malValuePtr excVal; + + try { + return EVAL(tryBody, env); + } + catch(String& s) { + excVal = mal::string(s); + } + catch (malEmptyInputException&) { + // Not an error, continue as if we got nil + ast = mal::nilValue(); + } + catch(malValuePtr& o) { + excVal = o; + }; + + if (excVal) { + // we got some exception + env = malEnvPtr(new malEnv(env)); + env->set(excSym->value(), excVal); + ast = catchBlock->item(2); + } + continue; // TCO + } + } + + // Now we're left with the case of a regular list to be evaluated. + malValuePtr op = EVAL(list->item(0), env); + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + if (lambda->isMacro()) { + ast = lambda->apply(list->begin()+1, list->end()); + continue; // TCO + } + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + ast = lambda->getBody(); + env = lambda->makeEnv(items->begin(), items->end()); + continue; // TCO + } + else { + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); + } + } +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +static bool isSymbol(malValuePtr obj, const String& text) +{ + const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); + return sym && (sym->value() == text); +} + +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) +{ + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); +} + +static malValuePtr quasiquote(malValuePtr obj) +{ + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) + return mal::list(mal::symbol("quote"), obj); + + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; + + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); + } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; +} + +static const char* malFunctionTable[] = { + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + "(def! not (fn* (cond) (if cond false true)))", + "(def! load-file (fn* (filename) \ + (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", +}; + +static void installFunctions(malEnvPtr env) { + for (auto &function : malFunctionTable) { + rep(function, env); + } +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/stepA_mal.cpp b/impls/cpp/stepA_mal.cpp new file mode 100644 index 0000000000..1de24b5ed8 --- /dev/null +++ b/impls/cpp/stepA_mal.cpp @@ -0,0 +1,326 @@ +#include "MAL.h" + +#include "Environment.h" +#include "ReadLine.h" +#include "Types.h" + +#include +#include + +malValuePtr READ(const String& input); +String PRINT(malValuePtr ast); +static void installFunctions(malEnvPtr env); +// Installs functions, macros and constants implemented in MAL. + +static void makeArgv(malEnvPtr env, int argc, char* argv[]); +static String safeRep(const String& input, malEnvPtr env); +static malValuePtr quasiquote(malValuePtr obj); + +static ReadLine s_readLine("~/.mal-history"); + +static malEnvPtr replEnv(new malEnv); + +int main(int argc, char* argv[]) +{ + String prompt = "user> "; + String input; + installCore(replEnv); + installFunctions(replEnv); + makeArgv(replEnv, argc - 2, argv + 2); + if (argc > 1) { + String filename = escape(argv[1]); + safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); + return 0; + } + rep("(println (str \"Mal [\" *host-language* \"]\"))", replEnv); + while (s_readLine.get(prompt, input)) { + String out = safeRep(input, replEnv); + if (out.length() > 0) + std::cout << out << "\n"; + } + return 0; +} + +static String safeRep(const String& input, malEnvPtr env) +{ + try { + return rep(input, env); + } + catch (malEmptyInputException&) { + return String(); + } + catch (malValuePtr& mv) { + return "Error: " + mv->print(true); + } + catch (String& s) { + return "Error: " + s; + }; +} + +static void makeArgv(malEnvPtr env, int argc, char* argv[]) +{ + malValueVec* args = new malValueVec(); + for (int i = 0; i < argc; i++) { + args->push_back(mal::string(argv[i])); + } + env->set("*ARGV*", mal::list(args)); +} + +String rep(const String& input, malEnvPtr env) +{ + return PRINT(EVAL(READ(input), env)); +} + +malValuePtr READ(const String& input) +{ + return readStr(input); +} + +malValuePtr EVAL(malValuePtr ast, malEnvPtr env) +{ + if (!env) { + env = replEnv; + } + while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || (list->count() == 0)) { + return ast->eval(env); + } + + // From here on down we are evaluating a non-empty list. + // First handle the special forms. + if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { + String special = symbol->value(); + int argCount = list->count() - 1; + + if (special == "def!") { + checkArgsIs("def!", 2, argCount); + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + return env->set(id->value(), EVAL(list->item(2), env)); + } + + if (special == "defmacro!") { + checkArgsIs("defmacro!", 2, argCount); + + const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); + malValuePtr body = EVAL(list->item(2), env); + const malLambda* lambda = VALUE_CAST(malLambda, body); + return env->set(id->value(), mal::macro(*lambda)); + } + + if (special == "do") { + checkArgsAtLeast("do", 1, argCount); + + for (int i = 1; i < argCount; i++) { + EVAL(list->item(i), env); + } + ast = list->item(argCount); + continue; // TCO + } + + if (special == "fn*") { + checkArgsIs("fn*", 2, argCount); + + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + StringVec params; + for (int i = 0; i < bindings->count(); i++) { + const malSymbol* sym = + VALUE_CAST(malSymbol, bindings->item(i)); + params.push_back(sym->value()); + } + + return mal::lambda(params, list->item(2), env); + } + + if (special == "if") { + checkArgsBetween("if", 2, 3, argCount); + + bool isTrue = EVAL(list->item(1), env)->isTrue(); + if (!isTrue && (argCount == 2)) { + return mal::nilValue(); + } + ast = list->item(isTrue ? 2 : 3); + continue; // TCO + } + + if (special == "let*") { + checkArgsIs("let*", 2, argCount); + const malSequence* bindings = + VALUE_CAST(malSequence, list->item(1)); + int count = checkArgsEven("let*", bindings->count()); + malEnvPtr inner(new malEnv(env)); + for (int i = 0; i < count; i += 2) { + const malSymbol* var = + VALUE_CAST(malSymbol, bindings->item(i)); + inner->set(var->value(), EVAL(bindings->item(i+1), inner)); + } + ast = list->item(2); + env = inner; + continue; // TCO + } + + if (special == "quasiquote") { + checkArgsIs("quasiquote", 1, argCount); + ast = quasiquote(list->item(1)); + continue; // TCO + } + + if (special == "quote") { + checkArgsIs("quote", 1, argCount); + return list->item(1); + } + + if (special == "try*") { + malValuePtr tryBody = list->item(1); + + if (argCount == 1) { + ast = tryBody; + continue; // TCO + } + checkArgsIs("try*", 2, argCount); + const malList* catchBlock = VALUE_CAST(malList, list->item(2)); + + checkArgsIs("catch*", 2, catchBlock->count() - 1); + MAL_CHECK(VALUE_CAST(malSymbol, + catchBlock->item(0))->value() == "catch*", + "catch block must begin with catch*"); + + // We don't need excSym at this scope, but we want to check + // that the catch block is valid always, not just in case of + // an exception. + const malSymbol* excSym = + VALUE_CAST(malSymbol, catchBlock->item(1)); + + malValuePtr excVal; + + try { + return EVAL(tryBody, env); + } + catch(String& s) { + excVal = mal::string(s); + } + catch (malEmptyInputException&) { + // Not an error, continue as if we got nil + ast = mal::nilValue(); + } + catch(malValuePtr& o) { + excVal = o; + }; + + if (excVal) { + // we got some exception + env = malEnvPtr(new malEnv(env)); + env->set(excSym->value(), excVal); + ast = catchBlock->item(2); + } + continue; // TCO + } + } + + // Now we're left with the case of a regular list to be evaluated. + malValuePtr op = EVAL(list->item(0), env); + if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + if (lambda->isMacro()) { + ast = lambda->apply(list->begin()+1, list->end()); + continue; // TCO + } + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + ast = lambda->getBody(); + env = lambda->makeEnv(items->begin(), items->end()); + continue; // TCO + } + else { + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); + } + } +} + +String PRINT(malValuePtr ast) +{ + return ast->print(true); +} + +malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) +{ + const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); + MAL_CHECK(handler != NULL, + "\"%s\" is not applicable", op->print(true).c_str()); + + return handler->apply(argsBegin, argsEnd); +} + +static bool isSymbol(malValuePtr obj, const String& text) +{ + const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); + return sym && (sym->value() == text); +} + +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) +{ + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); +} + +static malValuePtr quasiquote(malValuePtr obj) +{ + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) + return mal::list(mal::symbol("quote"), obj); + + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; + + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); + } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; +} + +static const char* malFunctionTable[] = { + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + "(def! not (fn* (cond) (if cond false true)))", + "(def! load-file (fn* (filename) \ + (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", + "(def! *host-language* \"C++\")", +}; + +static void installFunctions(malEnvPtr env) { + for (auto &function : malFunctionTable) { + rep(function, env); + } +} + +// Added to keep the linker happy at step A +malValuePtr readline(const String& prompt) +{ + String input; + if (s_readLine.get(prompt, input)) { + return mal::string(input); + } + return mal::nilValue(); +} + diff --git a/impls/cpp/tests/step5_tco.mal b/impls/cpp/tests/step5_tco.mal new file mode 100644 index 0000000000..f48fa336da --- /dev/null +++ b/impls/cpp/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; C++: skipping non-TCO recursion +;; Reason: completes at 10,000, segfaults at 20,000 diff --git a/impls/crystal/Dockerfile b/impls/crystal/Dockerfile new file mode 100644 index 0000000000..c281e8cb18 --- /dev/null +++ b/impls/crystal/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ + ca-certificates crystal git libreadline-dev shards diff --git a/impls/crystal/Makefile b/impls/crystal/Makefile new file mode 100644 index 0000000000..43129aac5c --- /dev/null +++ b/impls/crystal/Makefile @@ -0,0 +1,9 @@ +STEPS = step0_repl step1_read_print step2_eval step3_env \ + step4_if_fn_do step5_tco step6_file step7_quote step8_macros \ + step9_try stepA_mal +all: $(STEPS) +$(STEPS): + shards build $@ --release +clean: + rm -rf .cache/crystal/ .cache/shards/ bin/ lib/ +.PHONY: all clean $(STEPS) diff --git a/impls/crystal/core.cr b/impls/crystal/core.cr new file mode 100644 index 0000000000..224e864981 --- /dev/null +++ b/impls/crystal/core.cr @@ -0,0 +1,464 @@ +require "time" + +require "readline" +require "./types" +require "./error" +require "./printer" +require "./reader" + +module Mal + macro calc_op(op) + -> (args : Array(Mal::Type)) { + x, y = args[0].unwrap, args[1].unwrap + eval_error "invalid arguments for binary operator {{op.id}}" unless x.is_a?(Int64) && y.is_a?(Int64) + Mal::Type.new(x {{op.id}} y) + } + end + + def self.list(args) + args.to_mal + end + + def self.list?(args) + args.first.unwrap.is_a? Mal::List + end + + def self.empty?(args) + a = args.first.unwrap + a.is_a?(Array) ? a.empty? : false + end + + def self.count(args) + a = args.first.unwrap + case a + when Array + a.size.to_i64 + when Nil + 0i64 + else + eval_error "invalid argument for function 'count'" + end + end + + def self.pr_str_(args) + args.map { |a| pr_str(a) }.join(" ") + end + + def self.str(args) + args.map { |a| pr_str(a, false) }.join + end + + def self.prn(args) + puts self.pr_str_(args) + nil + end + + def self.println(args) + puts args.map { |a| pr_str(a, false) }.join(" ") + nil + end + + def self.read_string(args) + head = args.first.unwrap + eval_error "argument of read-str must be string" unless head.is_a? String + read_str head + end + + def self.slurp(args) + head = args.first.unwrap + eval_error "argument of slurp must be string" unless head.is_a? String + begin + File.read head + rescue + nil + end + end + + def self.cons(args) + head, tail = args[0].as(Mal::Type), args[1].unwrap + eval_error "2nd arg of cons must be list" unless tail.is_a? Array + ([head] + tail).to_mal + end + + def self.concat(args) + args.each_with_object(Mal::List.new) do |arg, list| + a = arg.unwrap + eval_error "arguments of concat must be list" unless a.is_a?(Array) + a.each { |e| list << e } + end + end + + def self.vec(args) + arg = args.first.unwrap + arg.is_a? Array || eval_error "argument of vec must be a sequence" + arg.to_mal(Mal::Vector) + end + + def self.nth(args) + a0, a1 = args[0].unwrap, args[1].unwrap + eval_error "1st argument of nth must be list or vector" unless a0.is_a? Array + eval_error "2nd argument of nth must be integer" unless a1.is_a? Int64 + a0[a1] + end + + def self.first(args) + a0 = args[0].unwrap + + return nil if a0.nil? + eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array + a0.empty? ? nil : a0.first + end + + def self.rest(args) + a0 = args[0].unwrap + + return Mal::List.new if a0.nil? + eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array + return Mal::List.new if a0.empty? + a0[1..-1].to_mal + end + + def self.apply(args) + eval_error "apply must take at least 2 arguments" unless args.size >= 2 + + head = args.first.unwrap + last = args.last.unwrap + + eval_error "last argument of apply must be list or vector" unless last.is_a? Array + + case head + when Mal::Closure + head.fn.call(args[1..-2] + last) + when Mal::Func + head.call(args[1..-2] + last) + else + eval_error "1st argument of apply must be function or closure" + end + end + + def self.map(args) + func = args.first.unwrap + list = args[1].unwrap + + eval_error "2nd argument of map must be list or vector" unless list.is_a? Array + + f = case func + when Mal::Closure then func.fn + when Mal::Func then func + else eval_error "1st argument of map must be function" + end + + list.each_with_object(Mal::List.new) do |elem, mapped| + mapped << f.call([elem]) + end + end + + def self.nil_value?(args) + args.first.unwrap.nil? + end + + def self.true?(args) + a = args.first.unwrap + a.is_a?(Bool) && a + end + + def self.false?(args) + a = args.first.unwrap + a.is_a?(Bool) && !a + end + + def self.symbol?(args) + args.first.unwrap.is_a?(Mal::Symbol) + end + + def self.symbol(args) + head = args.first.unwrap + eval_error "1st argument of symbol function must be string" unless head.is_a? String + Mal::Symbol.new head + end + + def self.string?(args) + head = args.first.unwrap + head.is_a?(String) && (head.empty? || head[0] != '\u029e') + end + + def self.keyword(args) + head = args.first.unwrap + eval_error "1st argument of symbol function must be string" unless head.is_a? String + if ! head.empty? && head[0] == '\u029e' + return head + end + "\u029e" + head + end + + def self.keyword?(args) + head = args.first.unwrap + head.is_a?(String) && !head.empty? && head[0] == '\u029e' + end + + def self.number?(args) + args.first.unwrap.is_a?(Int64) + end + + def self.fn?(args) + return false if args.first.macro? + head = args.first.unwrap + head.is_a?(Mal::Func) || head.is_a?(Mal::Closure) + end + + def self.macro?(args) + args.first.macro? + end + + def self.vector(args) + args.to_mal(Mal::Vector) + end + + def self.vector?(args) + args.first.unwrap.is_a? Mal::Vector + end + + def self.hash_map(args) + eval_error "hash-map must take even number of arguments" unless args.size.even? + map = Mal::HashMap.new + args.each_slice(2) do |kv| + k = kv[0].unwrap + eval_error "key must be string" unless k.is_a? String + map[k] = kv[1] + end + map + end + + def self.map?(args) + args.first.unwrap.is_a? Mal::HashMap + end + + def self.assoc(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + eval_error "assoc must take a list and even number of arguments" unless (args.size - 1).even? + + map = Mal::HashMap.new + head.each { |k, v| map[k] = v } + + args[1..-1].each_slice(2) do |kv| + k = kv[0].unwrap + eval_error "key must be string" unless k.is_a? String + map[k] = kv[1] + end + + map + end + + def self.dissoc(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + + map = Mal::HashMap.new + head.each { |k, v| map[k] = v } + + args[1..-1].each do |arg| + key = arg.unwrap + eval_error "key must be string" unless key.is_a? String + map.delete key + end + + map + end + + def self.get(args) + a0, a1 = args[0].unwrap, args[1].unwrap + return nil unless a0.is_a? Mal::HashMap + eval_error "2nd argument of get must be string" unless a1.is_a? String + + # a0[a1]? isn't available because type ofa0[a1] is infered NoReturn + a0.has_key?(a1) ? a0[a1] : nil + end + + def self.contains?(args) + a0, a1 = args[0].unwrap, args[1].unwrap + eval_error "1st argument of get must be hashmap" unless a0.is_a? Mal::HashMap + eval_error "2nd argument of get must be string" unless a1.is_a? String + a0.has_key? a1 + end + + def self.keys(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + head.keys.each_with_object(Mal::List.new) { |e, l| l << Mal::Type.new(e) } + end + + def self.vals(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + head.values.to_mal + end + + def self.sequential?(args) + args.first.unwrap.is_a? Array + end + + def self.readline(args) + head = args.first.unwrap + eval_error "1st argument of readline must be string" unless head.is_a? String + Readline.readline(head, true) + end + + def self.meta(args) + m = args.first.meta + m.nil? ? nil : m + end + + def self.with_meta(args) + t = args.first.dup + t.meta = args[1] + t + end + + def self.atom(args) + Mal::Atom.new args.first + end + + def self.atom?(args) + args.first.unwrap.is_a? Mal::Atom + end + + def self.deref(args) + head = args.first.unwrap + eval_error "1st argument of deref must be atom" unless head.is_a? Mal::Atom + head.val + end + + def self.reset!(args) + head = args.first.unwrap + eval_error "1st argument of reset! must be atom" unless head.is_a? Mal::Atom + head.val = args[1] + end + + def self.swap!(args) + atom = args.first.unwrap + eval_error "1st argument of swap! must be atom" unless atom.is_a? Mal::Atom + + a = [atom.val] + args[2..-1] + + func = args[1].unwrap + case func + when Mal::Func + atom.val = func.call a + when Mal::Closure + atom.val = func.fn.call a + else + eval_error "2nd argumetn of swap! must be function" + end + end + + def self.conj(args) + seq = args.first.unwrap + case seq + when Mal::List + (args[1..-1].reverse + seq).to_mal + when Mal::Vector + (seq + args[1..-1]).to_mal(Mal::Vector) + else + eval_error "1st argument of conj must be list or vector" + end + end + + def self.seq(args) + obj = args.first.unwrap + case obj + when nil + nil + when Mal::List + return nil if obj.empty? + obj + when Mal::Vector + return nil if obj.empty? + obj.to_mal + when String + return nil if obj.empty? + obj.split("").each_with_object(Mal::List.new) { |e, l| l << Mal::Type.new(e) } + else + eval_error "argument of seq must be list or vector or string or nil" + end + end + + def self.time_ms(args) + Time.utc.to_unix_ms + end + + # Note: + # Simply using ->self.some_func doesn't work + macro func(name) + -> (args : Array(Mal::Type)) { Mal::Type.new self.{{name.id}}(args) } + end + + macro rel_op(op) + -> (args : Array(Mal::Type)) { Mal::Type.new (args[0] {{op.id}} args[1]) } + end + + NS = { + "+" => calc_op(:+), + "-" => calc_op(:-), + "*" => calc_op(:*), + "/" => calc_op(://), + "list" => func(:list), + "list?" => func(:list?), + "empty?" => func(:empty?), + "count" => func(:count), + "=" => rel_op(:==), + "<" => rel_op(:<), + ">" => rel_op(:>), + "<=" => rel_op(:<=), + ">=" => rel_op(:>=), + "pr-str" => func(:pr_str_), + "str" => func(:str), + "prn" => func(:prn), + "println" => func(:println), + "read-string" => func(:read_string), + "slurp" => func(:slurp), + "cons" => func(:cons), + "concat" => func(:concat), + "vec" => func(:vec), + "nth" => func(:nth), + "first" => func(:first), + "rest" => func(:rest), + "throw" => ->(args : Array(Mal::Type)) { raise Mal::RuntimeException.new args[0] }, + "apply" => func(:apply), + "map" => func(:map), + "nil?" => func(:nil_value?), + "true?" => func(:true?), + "false?" => func(:false?), + "symbol?" => func(:symbol?), + "symbol" => func(:symbol), + "string?" => func(:string?), + "keyword" => func(:keyword), + "keyword?" => func(:keyword?), + "number?" => func(:number?), + "fn?" => func(:fn?), + "macro?" => func(:macro?), + "vector" => func(:vector), + "vector?" => func(:vector?), + "hash-map" => func(:hash_map), + "map?" => func(:map?), + "assoc" => func(:assoc), + "dissoc" => func(:dissoc), + "get" => func(:get), + "contains?" => func(:contains?), + "keys" => func(:keys), + "vals" => func(:vals), + "sequential?" => func(:sequential?), + "readline" => func(:readline), + "meta" => func(:meta), + "with-meta" => func(:with_meta), + "atom" => func(:atom), + "atom?" => func(:atom?), + "deref" => func(:deref), + "deref" => func(:deref), + "reset!" => func(:reset!), + "swap!" => func(:swap!), + "conj" => func(:conj), + "seq" => func(:seq), + "time-ms" => func(:time_ms), + } of String => Mal::Func +end diff --git a/impls/crystal/env.cr b/impls/crystal/env.cr new file mode 100644 index 0000000000..4bb83d7cda --- /dev/null +++ b/impls/crystal/env.cr @@ -0,0 +1,61 @@ +require "./types" +require "./error" + +module Mal + class Env + property data + + def initialize(@outer : Env?) + @data = {} of String => Mal::Type + end + + def initialize(@outer : Env, binds, exprs : Array(Mal::Type)) + @data = {} of String => Mal::Type + + eval_error "binds must be list or vector" unless binds.is_a? Array + + # Note: + # Array#zip() can't be used because overload resolution failed + (0...binds.size).each do |idx| + sym = binds[idx].unwrap + eval_error "bind name must be symbol" unless sym.is_a? Mal::Symbol + + if sym.str == "&" + eval_error "missing variable parameter name" if binds.size == idx + next_param = binds[idx + 1].unwrap + eval_error "bind name must be symbol" unless next_param.is_a? Mal::Symbol + var_args = Mal::List.new + exprs[idx..-1].each { |e| var_args << e } if idx < exprs.size + @data[next_param.str] = Mal::Type.new var_args + break + end + + @data[sym.str] = exprs[idx] + end + end + + def dump + puts "ENV BEGIN".colorize.red + @data.each do |k, v| + puts " #{k} -> #{print(v)}".colorize.red + end + puts "ENV END".colorize.red + end + + def set(key, value) + @data[key] = value + end + + def get(key) + return @data[key] if @data.has_key? key + + o = @outer + if o + o.get key + else + nil + end + end + + end +end diff --git a/impls/crystal/error.cr b/impls/crystal/error.cr new file mode 100644 index 0000000000..fb8f56c623 --- /dev/null +++ b/impls/crystal/error.cr @@ -0,0 +1,25 @@ +require "./types" + +module Mal + class ParseException < Exception + end + + class EvalException < Exception + end + + class RuntimeException < Exception + getter :thrown + + def initialize(@thrown : Type) + super() + end + end +end + +def eval_error(msg) + raise Mal::EvalException.new msg +end + +def parse_error(msg) + raise Mal::ParseException.new msg +end diff --git a/impls/crystal/printer.cr b/impls/crystal/printer.cr new file mode 100644 index 0000000000..b6aeaab4fd --- /dev/null +++ b/impls/crystal/printer.cr @@ -0,0 +1,34 @@ +require "./types" + +def pr_str(value, print_readably = true) + case value + when Nil then "nil" + when Bool then value.to_s + when Int64 then value.to_s + when Mal::List then "(#{value.map { |v| pr_str(v, print_readably).as(String) }.join(" ")})" + when Mal::Vector then "[#{value.map { |v| pr_str(v, print_readably).as(String) }.join(" ")}]" + when Mal::Symbol then value.str.to_s + when Mal::Func then "" + when Mal::Closure then "" + when Mal::HashMap + # step1_read_print.cr requires specifying type + "{#{value.map { |k, v| "#{pr_str(k, print_readably)} #{pr_str(v, print_readably)}".as(String) }.join(" ")}}" + when String + case + when value.empty? + print_readably ? value.inspect : value + when value[0] == '\u029e' + ":#{value[1..-1]}" + else + print_readably ? value.inspect : value + end + when Mal::Atom + "(atom #{pr_str(value.val, print_readably)})" + else + raise "invalid MalType: #{value.to_s}" + end +end + +def pr_str(t : Mal::Type, print_readably = true) + pr_str(t.unwrap, print_readably) + (t.macro? ? " (macro)" : "") +end diff --git a/impls/crystal/reader.cr b/impls/crystal/reader.cr new file mode 100644 index 0000000000..dd7d62f56e --- /dev/null +++ b/impls/crystal/reader.cr @@ -0,0 +1,139 @@ +require "./types" +require "./error" + +class Reader + def initialize(@tokens : Array(String)) + @pos = 0 + end + + def current_token + @tokens[@pos] rescue nil + end + + def peek + t = current_token + + if t && t[0] == ';' + @pos += 1 + peek + else + t + end + end + + def next + peek + ensure + @pos += 1 + end + + def read_sequence(init, open, close) + token = self.next + parse_error "expected '#{open}', got EOF" unless token + parse_error "expected '#{open}', got #{token}" unless token[0] == open + + loop do + token = peek + parse_error "expected '#{close}', got EOF" unless token + break if token[0] == close + + init << read_form + peek + end + + self.next + init + end + + def read_list + Mal::Type.new read_sequence(Mal::List.new, '(', ')') + end + + def read_vector + Mal::Type.new read_sequence(Mal::Vector.new, '[', ']') + end + + def read_hashmap + types = read_sequence([] of Mal::Type, '{', '}') + + parse_error "odd number of elements for hash-map: #{types.size}" if types.size.odd? + map = Mal::HashMap.new + + types.each_slice(2) do |kv| + k, v = kv[0].unwrap, kv[1] + case k + when String + map[k] = v + else + parse_error("key of hash-map must be string or keyword") + end + end + + Mal::Type.new map + end + + def read_atom + token = self.next + parse_error "expected Atom but got EOF" unless token + + Mal::Type.new case + when token =~ /^-?\d+$/ then token.to_i64 + when token == "true" then true + when token == "false" then false + when token == "nil" then nil + when token =~ /^"(?:\\.|[^\\"])*"$/ + token[1..-2].gsub(/\\(.)/, {"\\\"" => "\"", + "\\n" => "\n", + "\\\\" => "\\"}) + when token[0] == '"' then parse_error "expected '\"', got EOF" + when token[0] == ':' then "\u029e#{token[1..-1]}" + else Mal::Symbol.new token + end + end + + def list_of(symname) + Mal::List.new << gen_type(Mal::Symbol, symname) << read_form + end + + def read_form + token = peek + + parse_error "unexpected EOF" unless token + parse_error "unexpected comment" if token[0] == ';' + + Mal::Type.new case token + when "(" then read_list + when ")" then parse_error "unexpected ')'" + when "[" then read_vector + when "]" then parse_error "unexpected ']'" + when "{" then read_hashmap + when "}" then parse_error "unexpected '}'" + when "'" then self.next; list_of("quote") + when "`" then self.next; list_of("quasiquote") + when "~" then self.next; list_of("unquote") + when "~@" then self.next; list_of("splice-unquote") + when "@" then self.next; list_of("deref") + when "^" + self.next + meta = read_form + list_of("with-meta") << meta + else read_atom + end + end +end + +def tokenize(str) + regex = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ + str.scan(regex).map { |m| m[1] }.reject(&.empty?) +end + +def read_str(str) + r = Reader.new(tokenize(str)) + begin + r.read_form + ensure + unless r.peek.nil? + raise Mal::ParseException.new "expected EOF, got #{r.peek.to_s}" + end + end +end diff --git a/impls/crystal/run b/impls/crystal/run new file mode 100755 index 0000000000..a42a7e149d --- /dev/null +++ b/impls/crystal/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/bin/${STEP:-stepA_mal} "${@}" diff --git a/impls/crystal/shard.yml b/impls/crystal/shard.yml new file mode 100644 index 0000000000..9eb8820c59 --- /dev/null +++ b/impls/crystal/shard.yml @@ -0,0 +1,28 @@ +name: make-a-lisp +version: 0.1.0 +targets: + step0_repl: + main: step0_repl.cr + step1_read_print: + main: step1_read_print.cr + step2_eval: + main: step2_eval.cr + step3_env: + main: step3_env.cr + step4_if_fn_do: + main: step4_if_fn_do.cr + step5_tco: + main: step5_tco.cr + step6_file: + main: step6_file.cr + step7_quote: + main: step7_quote.cr + step8_macros: + main: step8_macros.cr + step9_try: + main: step9_try.cr + stepA_mal: + main: stepA_mal.cr +dependencies: + readline: + github: crystal-lang/crystal-readline diff --git a/impls/crystal/step0_repl.cr b/impls/crystal/step0_repl.cr new file mode 100755 index 0000000000..a9c67d68f2 --- /dev/null +++ b/impls/crystal/step0_repl.cr @@ -0,0 +1,26 @@ +#! /usr/bin/env crystal run + +require "readline" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def read(x) + x +end + +def eval(x) + x +end + +def print(x) + x +end + +def rep(x) + read(eval(print(x))) +end + +while line = Readline.readline("user> ") + puts rep(line) +end diff --git a/impls/crystal/step1_read_print.cr b/impls/crystal/step1_read_print.cr new file mode 100755 index 0000000000..4d7195895e --- /dev/null +++ b/impls/crystal/step1_read_print.cr @@ -0,0 +1,38 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def read(str) + read_str str + end + + def eval(x) + x + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str))) + end +end + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step2_eval.cr b/impls/crystal/step2_eval.cr new file mode 100755 index 0000000000..f8713571cd --- /dev/null +++ b/impls/crystal/step2_eval.cr @@ -0,0 +1,88 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def eval_error(msg) + raise Mal::EvalException.new msg +end + +def num_func(func) + ->(args : Array(Mal::Type)) { + x, y = args[0].unwrap, args[1].unwrap + eval_error "invalid arguments" unless x.is_a?(Int64) && y.is_a?(Int64) + Mal::Type.new func.call(x, y) + } +end + +REPL_ENV = { + "+" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x + y })), + "-" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x - y })), + "*" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x * y })), + "/" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x // y })), +} of String => Mal::Type + +module Mal + extend self + + def read(str) + read_str str + end + + def eval(ast, env) + # puts "EVAL: #{print(ast)}" + + val = ast.unwrap + + case val + when Mal::Symbol + eval_error "'#{val.str}' not found" unless env.has_key? val.str + return env[val.str] + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + f = eval(list.first, env).unwrap + case f + when Mal::Func + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + + else + return Mal::Type.new val + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step3_env.cr b/impls/crystal/step3_env.cr new file mode 100755 index 0000000000..a17d79779f --- /dev/null +++ b/impls/crystal/step3_env.cr @@ -0,0 +1,118 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def eval_error(msg) + raise Mal::EvalException.new msg +end + +def num_func(func) + ->(args : Array(Mal::Type)) { + x, y = args[0].unwrap, args[1].unwrap + eval_error "invalid arguments" unless x.is_a?(Int64) && y.is_a?(Int64) + Mal::Type.new func.call(x, y) + } +end + +REPL_ENV = Mal::Env.new nil +REPL_ENV.set("+", Mal::Type.new num_func(->(x : Int64, y : Int64) { x + y })) +REPL_ENV.set("-", Mal::Type.new num_func(->(x : Int64, y : Int64) { x - y })) +REPL_ENV.set("*", Mal::Type.new num_func(->(x : Int64, y : Int64) { x * y })) +REPL_ENV.set("/", Mal::Type.new num_func(->(x : Int64, y : Int64) { x // y })) + +module Mal + extend self + + def read(str) + read_str str + end + + def eval(ast, env) + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + return eval(list[2], new_env) + else + f = eval(list.first, env).unwrap + case f + when Mal::Func + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step4_if_fn_do.cr b/impls/crystal/step4_if_fn_do.cr new file mode 100755 index 0000000000..fb33c8911d --- /dev/null +++ b/impls/crystal/step4_if_fn_do.cr @@ -0,0 +1,135 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def func_of(env, binds, body) + ->(args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + }.as(Mal::Func) + end + + def read(str) + read_str str + end + + def eval(ast, env) + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + return eval(list[2], new_env) + when "do" + if list.empty? + return Mal::Type.new(nil) + end + return list[1..-1].map { |n| eval(n, env) }.last + when "if" + if eval(list[1], env).unwrap + return eval(list[2], env) + elsif list.size >= 4 + return eval(list[3], env) + else + return Mal::Type.new(nil) + end + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + else + f = eval(list.first, env).unwrap + case f + when Mal::Closure + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return eval(f.ast, Mal::Env.new(f.env, f.params, args)) + when Mal::Func + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +REPL_ENV = Mal::Env.new nil +Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } +Mal.rep "(def! not (fn* (a) (if a false true)))" + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step5_tco.cr b/impls/crystal/step5_tco.cr new file mode 100755 index 0000000000..508ed0b176 --- /dev/null +++ b/impls/crystal/step5_tco.cr @@ -0,0 +1,144 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def func_of(env, binds, body) + ->(args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + }.as(Mal::Func) + end + + def read(str) + read_str str + end + + def eval(ast, env) + while true + + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + list[1..-2].map { |n| eval(n, env) } + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + else + f = eval(list.first, env).unwrap + case f + when Mal::Closure + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + ast = f.ast + env = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +REPL_ENV = Mal::Env.new nil +Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } +Mal.rep "(def! not (fn* (a) (if a false true)))" + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step6_file.cr b/impls/crystal/step6_file.cr new file mode 100755 index 0000000000..a7a95e170c --- /dev/null +++ b/impls/crystal/step6_file.cr @@ -0,0 +1,163 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def func_of(env, binds, body) + ->(args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + }.as(Mal::Func) + end + + def read(str) + read_str str + end + + def eval(ast, env) + while true + + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + list[1..-2].map { |n| eval(n, env) } + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + else + f = eval(list.first, env).unwrap + case f + when Mal::Closure + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + ast = f.ast + env = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +REPL_ENV = Mal::Env.new nil +Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } +REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) +Mal.rep "(def! not (fn* (a) (if a false true)))" +Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +argv = Mal::List.new +REPL_ENV.set("*ARGV*", Mal::Type.new argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + argv << Mal::Type.new(a) + end + end + + begin + Mal.rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step7_quote.cr b/impls/crystal/step7_quote.cr new file mode 100755 index 0000000000..b935061fa2 --- /dev/null +++ b/impls/crystal/step7_quote.cr @@ -0,0 +1,214 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def func_of(env, binds, body) + ->(args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + }.as(Mal::Func) + end + + def read(str) + read_str str + end + + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc + end + + def quasiquote(ast) + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + else + ast + end + end + + def eval(ast, env) + while true + + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + list[1..-2].map { |n| eval(n, env) } + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + return Mal::Type.new list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + else + f = eval(list.first, env).unwrap + case f + when Mal::Closure + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + ast = f.ast + env = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +REPL_ENV = Mal::Env.new nil +Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } +REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) +Mal.rep "(def! not (fn* (a) (if a false true)))" +Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +argv = Mal::List.new +REPL_ENV.set("*ARGV*", Mal::Type.new argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + argv << Mal::Type.new(a) + end + end + + begin + Mal.rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step8_macros.cr b/impls/crystal/step8_macros.cr new file mode 100755 index 0000000000..2c7ac4e755 --- /dev/null +++ b/impls/crystal/step8_macros.cr @@ -0,0 +1,232 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def func_of(env, binds, body) + ->(args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + }.as(Mal::Func) + end + + def read(str) + read_str str + end + + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc + end + + def quasiquote(ast) + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + else + ast + end + end + + def eval(ast, env) + while true + + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + list[1..-2].map { |n| eval(n, env) } + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + return Mal::Type.new list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + when "defmacro!" + eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + mac = eval(list[2], env).dup + mac.is_macro = true + return Mal::Type.new env.set(a1.str, mac) + else + evaluated_first = eval(list.first, env) + f = evaluated_first.unwrap + case f + when Mal::Closure + if evaluated_first.macro? + ast = f.fn.call(list[1..-1]) + next # TCO + end + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + ast = f.ast + env = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + if evaluated_first.macro? + ast = f.call(list[1..-1]) + next # TCO + end + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +REPL_ENV = Mal::Env.new nil +Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } +REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) +Mal.rep "(def! not (fn* (a) (if a false true)))" +Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + +argv = Mal::List.new +REPL_ENV.set("*ARGV*", Mal::Type.new argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + argv << Mal::Type.new(a) + end + end + + begin + Mal.rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/step9_try.cr b/impls/crystal/step9_try.cr new file mode 100755 index 0000000000..984158b28f --- /dev/null +++ b/impls/crystal/step9_try.cr @@ -0,0 +1,249 @@ +#! /usr/bin/env crystal run + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def func_of(env, binds, body) + ->(args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + }.as(Mal::Func) + end + + def read(str) + read_str str + end + + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc + end + + def quasiquote(ast) + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + else + ast + end + end + + def eval(ast, env) + while true + + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + list[1..-2].map { |n| eval(n, env) } + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + return Mal::Type.new list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + when "defmacro!" + eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + mac = eval(list[2], env).dup + mac.is_macro = true + return Mal::Type.new env.set(a1.str, mac) + when "try*" + catch_list = list.size >= 3 ? list[2].unwrap : Mal::Type.new(nil) + return eval(list[1], env) unless catch_list.is_a? Mal::List + + catch_head = catch_list.first.unwrap + return eval(list[1], env) unless catch_head.is_a? Mal::Symbol + return eval(list[1], env) unless catch_head.str == "catch*" + + begin + return eval(list[1], env) + rescue e : Mal::RuntimeException + new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) + return Mal::Type.new eval(catch_list[2], new_env) + rescue e + new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) + return Mal::Type.new eval(catch_list[2], new_env) + end + else + evaluated_first = eval(list.first, env) + f = evaluated_first.unwrap + case f + when Mal::Closure + if evaluated_first.macro? + ast = f.fn.call(list[1..-1]) + next # TCO + end + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + ast = f.ast + env = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + if evaluated_first.macro? + ast = f.call(list[1..-1]) + next # TCO + end + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +REPL_ENV = Mal::Env.new nil +Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } +REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) +Mal.rep "(def! not (fn* (a) (if a false true)))" +Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + +argv = Mal::List.new +REPL_ENV.set("*ARGV*", Mal::Type.new argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + argv << Mal::Type.new(a) + end + end + + begin + Mal.rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/stepA_mal.cr b/impls/crystal/stepA_mal.cr new file mode 100755 index 0000000000..2857c89d13 --- /dev/null +++ b/impls/crystal/stepA_mal.cr @@ -0,0 +1,258 @@ +#! /usr/bin/env crystal run + +require "colorize" + +require "readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +module Mal + extend self + + def func_of(env, binds, body) + ->(args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + }.as(Mal::Func) + end + + def read(str) + read_str str + end + + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc + end + + def quasiquote(ast) + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + else + ast + end + end + + def debug(ast) + puts print(ast).colorize.red + end + + def eval(ast, env) + while true + + puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") + + val = ast.unwrap + + case val + when Mal::Symbol + e = env.get(val.str) + eval_error "'#{val.str}' not found" unless e + return e + when Mal::Vector + new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } + return Mal::Type.new new_vec + when Mal::HashMap + new_map = Mal::HashMap.new + val.each { |k, v| new_map[k] = eval(v, env) } + return Mal::Type.new new_map + when Mal::List + list = val + return ast if list.empty? + + head = list.first.unwrap + if head.is_a? Mal::Symbol + a0sym = head.str + else + a0sym = "" + end + case a0sym + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + return Mal::Type.new env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + list[1..-2].map { |n| eval(n, env) } + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + return Mal::Type.new list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + when "defmacro!" + eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + mac = eval(list[2], env).dup + mac.is_macro = true + return Mal::Type.new env.set(a1.str, mac) + when "try*" + catch_list = list.size >= 3 ? list[2].unwrap : Mal::Type.new(nil) + return eval(list[1], env) unless catch_list.is_a? Mal::List + + catch_head = catch_list.first.unwrap + return eval(list[1], env) unless catch_head.is_a? Mal::Symbol + return eval(list[1], env) unless catch_head.str == "catch*" + + begin + return eval(list[1], env) + rescue e : Mal::RuntimeException + new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) + return Mal::Type.new eval(catch_list[2], new_env) + rescue e + new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) + return Mal::Type.new eval(catch_list[2], new_env) + end + else + evaluated_first = eval(list.first, env) + f = evaluated_first.unwrap + case f + when Mal::Closure + if evaluated_first.macro? + ast = f.fn.call(list[1..-1]) + next # TCO + end + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + ast = f.ast + env = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + if evaluated_first.macro? + ast = f.call(list[1..-1]) + next # TCO + end + args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end + end + else + return Mal::Type.new val + end + end + end + + def print(result) + pr_str(result, true) + end + + def rep(str) + print(eval(read(str), REPL_ENV)) + end +end + +REPL_ENV = Mal::Env.new nil +Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } +REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) +Mal.rep "(def! not (fn* (a) (if a false true)))" +Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +Mal.rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +Mal.rep("(def! *host-language* \"crystal\")") + +argv = Mal::List.new +REPL_ENV.set("*ARGV*", Mal::Type.new argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + argv << Mal::Type.new(a) + end + end + + begin + Mal.rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +Mal.rep("(println (str \"Mal [\" *host-language* \"]\"))") + +while line = Readline.readline("user> ", true) + begin + puts Mal.rep(line) + rescue e : Mal::RuntimeException + STDERR.puts "Error: #{pr_str(e.thrown, true)}" + rescue e + STDERR.puts "Error: #{e}" + end +end diff --git a/impls/crystal/tests/step5_tco.mal b/impls/crystal/tests/step5_tco.mal new file mode 100644 index 0000000000..1fd025b6a0 --- /dev/null +++ b/impls/crystal/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Crystal: skipping non-TCO recursion +;; Reason: completes at 1,000,000 diff --git a/impls/crystal/types.cr b/impls/crystal/types.cr new file mode 100644 index 0000000000..a65a9f1a43 --- /dev/null +++ b/impls/crystal/types.cr @@ -0,0 +1,114 @@ +require "./printer" + +module Mal + class Type + alias Func = (Array(Type) -> Type) + + # It is (now) probably possible to only store is_macro for Closures. + property :is_macro, :meta + + def initialize(@val : ValueType) + @is_macro = false + @meta = nil.as(Type | Nil) + end + + def initialize(other : Type) + @val = other.unwrap + @is_macro = other.is_macro + @meta = other.meta + end + + def unwrap + @val + end + + def macro? + @is_macro + end + + def to_s + pr_str(self) + end + + def dup + Type.new(@val).tap do |t| + t.is_macro = @is_macro + t.meta = @meta + end + end + + def ==(other : Type) + @val == other.unwrap + end + + macro rel_op(*ops) + {% for op in ops %} + def {{op.id}}(other : Mal::Type) + l, r = @val, other.unwrap + {% for t in [Int64, String] %} + if l.is_a?({{t}}) && r.is_a?({{t}}) + return (l) {{op.id}} (r) + end + {% end %} + if l.is_a?(Symbol) && r.is_a?(Symbol) + return l.str {{op.id}} r.str + end + false + end + {% end %} + end + + rel_op :<, :>, :<=, :>= + end + + class Symbol + property :str + + def initialize(@str : String) + end + + def ==(other : Symbol) + @str == other.str + end + end + + class List < Array(Type) + end + + class Vector < Array(Type) + end + + class HashMap < Hash(String, Type) + end + + class Atom + property :val + + def initialize(@val : Type) + end + + def ==(rhs : Atom) + @val == rhs.val + end + end + + class Closure + property :ast, :params, :env, :fn + + def initialize(@ast : Type, @params : Array(Mal::Type) | List | Vector, @env : Env, @fn : Func) + end + end + + alias Type::ValueType = Nil | Bool | Int64 | String | Symbol | List | Vector | HashMap | Func | Closure | Atom + alias Func = Type::Func +end + +macro gen_type(t, *args) + Mal::Type.new {{t.id}}.new({{*args}}) +end + +class Array + def to_mal(t = Mal::List) + each_with_object(t.new) { |e, l| l << e } + end +end diff --git a/impls/cs/Dockerfile b/impls/cs/Dockerfile new file mode 100644 index 0000000000..2d9e7bf88d --- /dev/null +++ b/impls/cs/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Deps for Mono-based languages (C#, VB.Net) +RUN apt-get -y install tzdata mono-runtime mono-mcs mono-vbnc mono-devel diff --git a/impls/cs/Makefile b/impls/cs/Makefile new file mode 100644 index 0000000000..52529a915b --- /dev/null +++ b/impls/cs/Makefile @@ -0,0 +1,43 @@ +##################### + +DEBUG = + +SOURCES_BASE = readline.cs types.cs reader.cs printer.cs +SOURCES_LISP = env.cs core.cs stepA_mal.cs +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +OTHER_SOURCES = getline.cs + +##################### + +SRCS = step0_repl.cs step1_read_print.cs step2_eval.cs step3_env.cs \ + step4_if_fn_do.cs step5_tco.cs step6_file.cs step7_quote.cs \ + step8_macros.cs step9_try.cs stepA_mal.cs + +LIB_SRCS = $(filter-out step%,$(OTHER_SOURCES) $(SOURCES)) + +FLAGS = $(if $(strip $(DEBUG)),-debug+,) + +##################### + +all: $(patsubst %.cs,%.exe,$(SRCS)) + +dist: mal.exe mal + +mal.exe: $(patsubst %.cs,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) + cp $< $@ + +# NOTE/WARNING: static linking triggers mono libraries LGPL +# distribution requirements. +# http://www.mono-project.com/archived/guiderunning_mono_applications/ +mal: $(patsubst %.cs,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) mal.dll + mkbundle --static -o $@ $+ --deps + +mal.dll: $(LIB_SRCS) + mcs $(FLAGS) -target:library $+ -out:$@ + +%.exe: %.cs mal.dll + mcs $(FLAGS) -r:mal.dll $< + +clean: + rm -f mal *.dll *.exe *.mdb diff --git a/cs/core.cs b/impls/cs/core.cs similarity index 82% rename from cs/core.cs rename to impls/cs/core.cs index 3e40681b3d..16eb0564c2 100644 --- a/cs/core.cs +++ b/impls/cs/core.cs @@ -35,19 +35,45 @@ public class core { static MalFunc symbol_Q = new MalFunc( a => a[0] is MalSymbol ? True : False); - static MalFunc keyword = new MalFunc( - a => new MalString("\u029e" + ((MalString)a[0]).getValue())); + static MalFunc string_Q = new MalFunc( + a => { + if (a[0] is MalString) { + var s = ((MalString)a[0]).getValue(); + return (s.Length == 0 || s[0] != '\u029e') ? True : False; + } else { + return False; + } + } ); - static MalFunc keyword_Q = new MalFunc( + static MalFunc keyword = new MalFunc( a => { if (a[0] is MalString && ((MalString)a[0]).getValue()[0] == '\u029e') { - return True; + return a[0]; + } else { + return new MalString("\u029e" + ((MalString)a[0]).getValue()); + } + } ); + + static MalFunc keyword_Q = new MalFunc( + a => { + if (a[0] is MalString) { + var s = ((MalString)a[0]).getValue(); + return (s.Length > 0 && s[0] == '\u029e') ? True : False; } else { return False; } } ); + static MalFunc number_Q = new MalFunc( + a => a[0] is MalInt ? True : False); + + static MalFunc function_Q = new MalFunc( + a => a[0] is MalFunc && !((MalFunc)a[0]).isMacro() ? True : False); + + static MalFunc macro_Q = new MalFunc( + a => a[0] is MalFunc && ((MalFunc)a[0]).isMacro() ? True : False); + // Number functions static MalFunc time_ms = new MalFunc( @@ -183,10 +209,10 @@ public class core { }); static MalFunc first = new MalFunc( - a => ((MalList)a[0])[0]); + a => a[0] == Nil ? Nil : ((MalList)a[0])[0]); static MalFunc rest = new MalFunc( - a => ((MalList)a[0]).rest()); + a => a[0] == Nil ? new MalList() : ((MalList)a[0]).rest()); static MalFunc empty_Q = new MalFunc( a => ((MalList)a[0]).size() == 0 ? True : False); @@ -217,6 +243,32 @@ public class core { }); + static MalFunc seq = new MalFunc( + a => { + if (a[0] == Nil) { + return Nil; + } else if (a[0] is MalVector) { + return (((MalVector)a[0]).size() == 0) + ? (MalVal)Nil + : new MalList(((MalVector)a[0]).getValue()); + } else if (a[0] is MalList) { + return (((MalList)a[0]).size() == 0) + ? Nil + : a[0]; + } else if (a[0] is MalString) { + var s = ((MalString)a[0]).getValue(); + if (s.Length == 0) { + return Nil; + } + var chars_list = new List(); + foreach (var c in s) { + chars_list.Add(new MalString(c.ToString())); + } + return new MalList(chars_list); + } + return Nil; + }); + // General list related functions static MalFunc apply = new MalFunc( a => { @@ -279,8 +331,12 @@ public class core { {"false?", false_Q}, {"symbol", new MalFunc(a => new MalSymbol((MalString)a[0]))}, {"symbol?", symbol_Q}, + {"string?", string_Q}, {"keyword", keyword}, {"keyword?", keyword_Q}, + {"number?", number_Q}, + {"fn?", function_Q}, + {"macro?", macro_Q}, {"pr-str", pr_str}, {"str", str}, @@ -315,12 +371,14 @@ public class core { {"sequential?", sequential_Q}, {"cons", cons}, {"concat", concat}, + {"vec", new MalFunc(a => new MalVector(((MalList)a[0]).getValue()))}, {"nth", nth}, {"first", first}, {"rest", rest}, {"empty?", empty_Q}, {"count", count}, {"conj", conj}, + {"seq", seq}, {"apply", apply}, {"map", map}, diff --git a/impls/cs/env.cs b/impls/cs/env.cs new file mode 100644 index 0000000000..c4ef84fa8b --- /dev/null +++ b/impls/cs/env.cs @@ -0,0 +1,45 @@ +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalSymbol = Mal.types.MalSymbol; +using MalList = Mal.types.MalList; + +namespace Mal { + public class env { + public class Env { + Env outer = null; + Dictionary data = new Dictionary(); + + public Env(Env outer) { + this.outer = outer; + } + public Env(Env outer, MalList binds, MalList exprs) { + this.outer = outer; + for (int i=0; i + /// Invoked when the user requests auto-completion using the tab character + /// + /// + /// The result is null for no values found, an array with a single + /// string, in that case the string should be the text to be inserted + /// for example if the word at pos is "T", the result for a completion + /// of "ToString" should be "oString", not "ToString". + /// + /// When there are multiple results, the result should be the full + /// text + /// + public AutoCompleteHandler AutoCompleteEvent; + + static Handler [] handlers; + + public LineEditor (string name) : this (name, 10) { } + + public LineEditor (string name, int histsize) + { + handlers = new Handler [] { + new Handler (ConsoleKey.Home, CmdHome), + new Handler (ConsoleKey.End, CmdEnd), + new Handler (ConsoleKey.LeftArrow, CmdLeft), + new Handler (ConsoleKey.RightArrow, CmdRight), + new Handler (ConsoleKey.UpArrow, CmdHistoryPrev), + new Handler (ConsoleKey.DownArrow, CmdHistoryNext), + new Handler (ConsoleKey.Enter, CmdDone), + new Handler (ConsoleKey.Backspace, CmdBackspace), + new Handler (ConsoleKey.Delete, CmdDeleteChar), + new Handler (ConsoleKey.Tab, CmdTabOrComplete), + + // Emacs keys + Handler.Control ('A', CmdHome), + Handler.Control ('E', CmdEnd), + Handler.Control ('B', CmdLeft), + Handler.Control ('F', CmdRight), + Handler.Control ('P', CmdHistoryPrev), + Handler.Control ('N', CmdHistoryNext), + Handler.Control ('K', CmdKillToEOF), + Handler.Control ('Y', CmdYank), + Handler.Control ('D', CmdDeleteChar), + Handler.Control ('L', CmdRefresh), + Handler.Control ('R', CmdReverseSearch), + Handler.Control ('G', delegate {} ), + Handler.Alt ('B', ConsoleKey.B, CmdBackwardWord), + Handler.Alt ('F', ConsoleKey.F, CmdForwardWord), + + Handler.Alt ('D', ConsoleKey.D, CmdDeleteWord), + Handler.Alt ((char) 8, ConsoleKey.Backspace, CmdDeleteBackword), + + // DEBUG + //Handler.Control ('T', CmdDebug), + + // quote + Handler.Control ('Q', delegate { HandleChar (Console.ReadKey (true).KeyChar); }) + }; + + rendered_text = new StringBuilder (); + text = new StringBuilder (); + + history = new History (name, histsize); + + //if (File.Exists ("log"))File.Delete ("log"); + //log = File.CreateText ("log"); + } + + void CmdDebug () + { + history.Dump (); + Console.WriteLine (); + Render (); + } + + void Render () + { + Console.Write (shown_prompt); + Console.Write (rendered_text); + + int max = System.Math.Max (rendered_text.Length + shown_prompt.Length, max_rendered); + + for (int i = rendered_text.Length + shown_prompt.Length; i < max_rendered; i++) + Console.Write (' '); + max_rendered = shown_prompt.Length + rendered_text.Length; + + // Write one more to ensure that we always wrap around properly if we are at the + // end of a line. + Console.Write (' '); + + UpdateHomeRow (max); + } + + void UpdateHomeRow (int screenpos) + { + int lines = 1 + (screenpos / Console.WindowWidth); + + home_row = Console.CursorTop - (lines - 1); + if (home_row < 0) + home_row = 0; + } + + + void RenderFrom (int pos) + { + int rpos = TextToRenderPos (pos); + int i; + + for (i = rpos; i < rendered_text.Length; i++) + Console.Write (rendered_text [i]); + + if ((shown_prompt.Length + rendered_text.Length) > max_rendered) + max_rendered = shown_prompt.Length + rendered_text.Length; + else { + int max_extra = max_rendered - shown_prompt.Length; + for (; i < max_extra; i++) + Console.Write (' '); + } + } + + void ComputeRendered () + { + rendered_text.Length = 0; + + for (int i = 0; i < text.Length; i++){ + int c = (int) text [i]; + if (c < 26){ + if (c == '\t') + rendered_text.Append (" "); + else { + rendered_text.Append ('^'); + rendered_text.Append ((char) (c + (int) 'A' - 1)); + } + } else + rendered_text.Append ((char)c); + } + } + + int TextToRenderPos (int pos) + { + int p = 0; + + for (int i = 0; i < pos; i++){ + int c; + + c = (int) text [i]; + + if (c < 26){ + if (c == 9) + p += 4; + else + p += 2; + } else + p++; + } + + return p; + } + + int TextToScreenPos (int pos) + { + return shown_prompt.Length + TextToRenderPos (pos); + } + + string Prompt { + get { return prompt; } + set { prompt = value; } + } + + int LineCount { + get { + return (shown_prompt.Length + rendered_text.Length)/Console.WindowWidth; + } + } + + void ForceCursor (int newpos) + { + cursor = newpos; + + int actual_pos = shown_prompt.Length + TextToRenderPos (cursor); + int row = home_row + (actual_pos/Console.WindowWidth); + int col = actual_pos % Console.WindowWidth; + + if (row >= Console.BufferHeight) + row = Console.BufferHeight-1; + Console.SetCursorPosition (col, row); + + //log.WriteLine ("Going to cursor={0} row={1} col={2} actual={3} prompt={4} ttr={5} old={6}", newpos, row, col, actual_pos, prompt.Length, TextToRenderPos (cursor), cursor); + //log.Flush (); + } + + void UpdateCursor (int newpos) + { + if (cursor == newpos) + return; + + ForceCursor (newpos); + } + + void InsertChar (char c) + { + int prev_lines = LineCount; + text = text.Insert (cursor, c); + ComputeRendered (); + if (prev_lines != LineCount){ + + Console.SetCursorPosition (0, home_row); + Render (); + ForceCursor (++cursor); + } else { + RenderFrom (cursor); + ForceCursor (++cursor); + UpdateHomeRow (TextToScreenPos (cursor)); + } + } + + // + // Commands + // + void CmdDone () + { + done = true; + } + + void CmdTabOrComplete () + { + bool complete = false; + + if (AutoCompleteEvent != null){ + if (TabAtStartCompletes) + complete = true; + else { + for (int i = 0; i < cursor; i++){ + if (!Char.IsWhiteSpace (text [i])){ + complete = true; + break; + } + } + } + + if (complete){ + Completion completion = AutoCompleteEvent (text.ToString (), cursor); + string [] completions = completion.Result; + if (completions == null) + return; + + int ncompletions = completions.Length; + if (ncompletions == 0) + return; + + if (completions.Length == 1){ + InsertTextAtCursor (completions [0]); + } else { + int last = -1; + + for (int p = 0; p < completions [0].Length; p++){ + char c = completions [0][p]; + + + for (int i = 1; i < ncompletions; i++){ + if (completions [i].Length < p) + goto mismatch; + + if (completions [i][p] != c){ + goto mismatch; + } + } + last = p; + } + mismatch: + if (last != -1){ + InsertTextAtCursor (completions [0].Substring (0, last+1)); + } + Console.WriteLine (); + foreach (string s in completions){ + Console.Write (completion.Prefix); + Console.Write (s); + Console.Write (' '); + } + Console.WriteLine (); + Render (); + ForceCursor (cursor); + } + } else + HandleChar ('\t'); + } else + HandleChar ('t'); + } + + void CmdHome () + { + UpdateCursor (0); + } + + void CmdEnd () + { + UpdateCursor (text.Length); + } + + void CmdLeft () + { + if (cursor == 0) + return; + + UpdateCursor (cursor-1); + } + + void CmdBackwardWord () + { + int p = WordBackward (cursor); + if (p == -1) + return; + UpdateCursor (p); + } + + void CmdForwardWord () + { + int p = WordForward (cursor); + if (p == -1) + return; + UpdateCursor (p); + } + + void CmdRight () + { + if (cursor == text.Length) + return; + + UpdateCursor (cursor+1); + } + + void RenderAfter (int p) + { + ForceCursor (p); + RenderFrom (p); + ForceCursor (cursor); + } + + void CmdBackspace () + { + if (cursor == 0) + return; + + text.Remove (--cursor, 1); + ComputeRendered (); + RenderAfter (cursor); + } + + void CmdDeleteChar () + { + // If there is no input, this behaves like EOF + if (text.Length == 0){ + done = true; + text = null; + Console.WriteLine (); + return; + } + + if (cursor == text.Length) + return; + text.Remove (cursor, 1); + ComputeRendered (); + RenderAfter (cursor); + } + + int WordForward (int p) + { + if (p >= text.Length) + return -1; + + int i = p; + if (Char.IsPunctuation (text [p]) || Char.IsSymbol (text [p]) || Char.IsWhiteSpace (text[p])){ + for (; i < text.Length; i++){ + if (Char.IsLetterOrDigit (text [i])) + break; + } + for (; i < text.Length; i++){ + if (!Char.IsLetterOrDigit (text [i])) + break; + } + } else { + for (; i < text.Length; i++){ + if (!Char.IsLetterOrDigit (text [i])) + break; + } + } + if (i != p) + return i; + return -1; + } + + int WordBackward (int p) + { + if (p == 0) + return -1; + + int i = p-1; + if (i == 0) + return 0; + + if (Char.IsPunctuation (text [i]) || Char.IsSymbol (text [i]) || Char.IsWhiteSpace (text[i])){ + for (; i >= 0; i--){ + if (Char.IsLetterOrDigit (text [i])) + break; + } + for (; i >= 0; i--){ + if (!Char.IsLetterOrDigit (text[i])) + break; + } + } else { + for (; i >= 0; i--){ + if (!Char.IsLetterOrDigit (text [i])) + break; + } + } + i++; + + if (i != p) + return i; + + return -1; + } + + void CmdDeleteWord () + { + int pos = WordForward (cursor); + + if (pos == -1) + return; + + string k = text.ToString (cursor, pos-cursor); + + if (last_handler == CmdDeleteWord) + kill_buffer = kill_buffer + k; + else + kill_buffer = k; + + text.Remove (cursor, pos-cursor); + ComputeRendered (); + RenderAfter (cursor); + } + + void CmdDeleteBackword () + { + int pos = WordBackward (cursor); + if (pos == -1) + return; + + string k = text.ToString (pos, cursor-pos); + + if (last_handler == CmdDeleteBackword) + kill_buffer = k + kill_buffer; + else + kill_buffer = k; + + text.Remove (pos, cursor-pos); + ComputeRendered (); + RenderAfter (pos); + } + + // + // Adds the current line to the history if needed + // + void HistoryUpdateLine () + { + history.Update (text.ToString ()); + } + + void CmdHistoryPrev () + { + if (!history.PreviousAvailable ()) + return; + + HistoryUpdateLine (); + + SetText (history.Previous ()); + } + + void CmdHistoryNext () + { + if (!history.NextAvailable()) + return; + + history.Update (text.ToString ()); + SetText (history.Next ()); + + } + + void CmdKillToEOF () + { + kill_buffer = text.ToString (cursor, text.Length-cursor); + text.Length = cursor; + ComputeRendered (); + RenderAfter (cursor); + } + + void CmdYank () + { + InsertTextAtCursor (kill_buffer); + } + + void InsertTextAtCursor (string str) + { + int prev_lines = LineCount; + text.Insert (cursor, str); + ComputeRendered (); + if (prev_lines != LineCount){ + Console.SetCursorPosition (0, home_row); + Render (); + cursor += str.Length; + ForceCursor (cursor); + } else { + RenderFrom (cursor); + cursor += str.Length; + ForceCursor (cursor); + UpdateHomeRow (TextToScreenPos (cursor)); + } + } + + void SetSearchPrompt (string s) + { + SetPrompt ("(reverse-i-search)`" + s + "': "); + } + + void ReverseSearch () + { + int p; + + if (cursor == text.Length){ + // The cursor is at the end of the string + + p = text.ToString ().LastIndexOf (search); + if (p != -1){ + match_at = p; + cursor = p; + ForceCursor (cursor); + return; + } + } else { + // The cursor is somewhere in the middle of the string + int start = (cursor == match_at) ? cursor - 1 : cursor; + if (start != -1){ + p = text.ToString ().LastIndexOf (search, start); + if (p != -1){ + match_at = p; + cursor = p; + ForceCursor (cursor); + return; + } + } + } + + // Need to search backwards in history + HistoryUpdateLine (); + string s = history.SearchBackward (search); + if (s != null){ + match_at = -1; + SetText (s); + ReverseSearch (); + } + } + + void CmdReverseSearch () + { + if (searching == 0){ + match_at = -1; + last_search = search; + searching = -1; + search = ""; + SetSearchPrompt (""); + } else { + if (search == ""){ + if (last_search != "" && last_search != null){ + search = last_search; + SetSearchPrompt (search); + + ReverseSearch (); + } + return; + } + ReverseSearch (); + } + } + + void SearchAppend (char c) + { + search = search + c; + SetSearchPrompt (search); + + // + // If the new typed data still matches the current text, stay here + // + if (cursor < text.Length){ + string r = text.ToString (cursor, text.Length - cursor); + if (r.StartsWith (search)) + return; + } + + ReverseSearch (); + } + + void CmdRefresh () + { + Console.Clear (); + max_rendered = 0; + Render (); + ForceCursor (cursor); + } + + void InterruptEdit (object sender, ConsoleCancelEventArgs a) + { + // Do not abort our program: + a.Cancel = true; + + // Interrupt the editor + edit_thread.Abort(); + } + + void HandleChar (char c) + { + if (searching != 0) + SearchAppend (c); + else + InsertChar (c); + } + + void EditLoop () + { + ConsoleKeyInfo cki; + + while (!done){ + ConsoleModifiers mod; + + cki = Console.ReadKey (true); + if (cki.Key == ConsoleKey.Escape){ + cki = Console.ReadKey (true); + + mod = ConsoleModifiers.Alt; + } else + mod = cki.Modifiers; + + bool handled = false; + + foreach (Handler handler in handlers){ + ConsoleKeyInfo t = handler.CKI; + + if (t.Key == cki.Key && t.Modifiers == mod){ + handled = true; + handler.KeyHandler (); + last_handler = handler.KeyHandler; + break; + } else if (t.KeyChar == cki.KeyChar && t.Key == ConsoleKey.Zoom){ + handled = true; + handler.KeyHandler (); + last_handler = handler.KeyHandler; + break; + } + } + if (handled){ + if (searching != 0){ + if (last_handler != CmdReverseSearch){ + searching = 0; + SetPrompt (prompt); + } + } + continue; + } + + if (cki.KeyChar != (char) 0) + HandleChar (cki.KeyChar); + } + } + + void InitText (string initial) + { + text = new StringBuilder (initial); + ComputeRendered (); + cursor = text.Length; + Render (); + ForceCursor (cursor); + } + + void SetText (string newtext) + { + Console.SetCursorPosition (0, home_row); + InitText (newtext); + } + + void SetPrompt (string newprompt) + { + shown_prompt = newprompt; + Console.SetCursorPosition (0, home_row); + Render (); + ForceCursor (cursor); + } + + public string Edit (string prompt, string initial) + { + edit_thread = Thread.CurrentThread; + searching = 0; + Console.CancelKeyPress += InterruptEdit; + + done = false; + history.CursorToEnd (); + max_rendered = 0; + + Prompt = prompt; + shown_prompt = prompt; + InitText (initial); + history.Append (initial); + + do { + try { + EditLoop (); + } catch (ThreadAbortException){ + searching = 0; + Thread.ResetAbort (); + Console.WriteLine (); + SetPrompt (prompt); + SetText (""); + } + } while (!done); + Console.WriteLine (); + + Console.CancelKeyPress -= InterruptEdit; + + if (text == null){ + history.Close (); + return null; + } + + string result = text.ToString (); + if (result != "") + history.Accept (result); + else + history.RemoveLast (); + + return result; + } + + public void SaveHistory () + { + if (history != null) { + history.Close (); + } + } + + public bool TabAtStartCompletes { get; set; } + + // + // Emulates the bash-like behavior, where edits done to the + // history are recorded + // + class History { + string [] history; + int head, tail; + int cursor, count; + string histfile; + + public History (string app, int size) + { + if (size < 1) + throw new ArgumentException ("size"); + + if (app != null){ + string dir = Environment.GetFolderPath (Environment.SpecialFolder.Personal); + //Console.WriteLine (dir); +// if (!Directory.Exists (dir)){ +// try { +// Directory.CreateDirectory (dir); +// } catch { +// app = null; +// } +// } +// if (app != null) +// histfile = Path.Combine (dir, app) + ".history"; + histfile = Path.Combine (dir, ".mal-history"); + } + + history = new string [size]; + head = tail = cursor = 0; + + if (File.Exists (histfile)){ + using (StreamReader sr = File.OpenText (histfile)){ + string line; + + while ((line = sr.ReadLine ()) != null){ + if (line != "") + Append (line); + } + } + } + } + + public void Close () + { + if (histfile == null) + return; + + try { + using (StreamWriter sw = File.CreateText (histfile)){ + int start = (count == history.Length) ? head : tail; + for (int i = start; i < start+count; i++){ + int p = i % history.Length; + sw.WriteLine (history [p]); + } + } + } catch { + // ignore + } + } + + // + // Appends a value to the history + // + public void Append (string s) + { + //Console.WriteLine ("APPENDING {0} head={1} tail={2}", s, head, tail); + history [head] = s; + head = (head+1) % history.Length; + if (head == tail) + tail = (tail+1 % history.Length); + if (count != history.Length) + count++; + //Console.WriteLine ("DONE: head={1} tail={2}", s, head, tail); + } + + // + // Updates the current cursor location with the string, + // to support editing of history items. For the current + // line to participate, an Append must be done before. + // + public void Update (string s) + { + history [cursor] = s; + } + + public void RemoveLast () + { + head = head-1; + if (head < 0) + head = history.Length-1; + } + + public void Accept (string s) + { + int t = head-1; + if (t < 0) + t = history.Length-1; + + history [t] = s; + } + + public bool PreviousAvailable () + { + //Console.WriteLine ("h={0} t={1} cursor={2}", head, tail, cursor); + if (count == 0) + return false; + int next = cursor-1; + if (next < 0) + next = count-1; + + if (next == head) + return false; + + return true; + } + + public bool NextAvailable () + { + if (count == 0) + return false; + int next = (cursor + 1) % history.Length; + if (next == head) + return false; + return true; + } + + + // + // Returns: a string with the previous line contents, or + // nul if there is no data in the history to move to. + // + public string Previous () + { + if (!PreviousAvailable ()) + return null; + + cursor--; + if (cursor < 0) + cursor = history.Length - 1; + + return history [cursor]; + } + + public string Next () + { + if (!NextAvailable ()) + return null; + + cursor = (cursor + 1) % history.Length; + return history [cursor]; + } + + public void CursorToEnd () + { + if (head == tail) + return; + + cursor = head; + } + + public void Dump () + { + Console.WriteLine ("Head={0} Tail={1} Cursor={2} count={3}", head, tail, cursor, count); + for (int i = 0; i < history.Length;i++){ + Console.WriteLine (" {0} {1}: {2}", i == cursor ? "==>" : " ", i, history[i]); + } + //log.Flush (); + } + + public string SearchBackward (string term) + { + for (int i = 0; i < count; i++){ + int slot = cursor-i-1; + if (slot < 0) + slot = history.Length+slot; + if (slot >= history.Length) + slot = 0; + if (history [slot] != null && history [slot].IndexOf (term) != -1){ + cursor = slot; + return history [slot]; + } + } + + return null; + } + + } + } + +#if DEMO + class Demo { + static void Main () + { + LineEditor le = new LineEditor ("foo"); + string s; + + while ((s = le.Edit ("shell> ", "")) != null){ + Console.WriteLine ("----> [{0}]", s); + } + } + } +#endif +} diff --git a/cs/interop.cs b/impls/cs/interop.cs similarity index 100% rename from cs/interop.cs rename to impls/cs/interop.cs diff --git a/cs/printer.cs b/impls/cs/printer.cs similarity index 100% rename from cs/printer.cs rename to impls/cs/printer.cs diff --git a/cs/reader.cs b/impls/cs/reader.cs similarity index 91% rename from cs/reader.cs rename to impls/cs/reader.cs index 10973aaa68..7e0d6b5c35 100644 --- a/cs/reader.cs +++ b/impls/cs/reader.cs @@ -39,7 +39,7 @@ public string next() { public static List tokenize(string str) { List tokens = new List(); - string pattern = @"[\s ,]*(~@|[\[\]{}()'`~@]|""(?:[\\].|[^\\""])*""|;.*|[^\s \[\]{}()'""`~@,;]*)"; + string pattern = @"[\s ,]*(~@|[\[\]{}()'`~@]|""(?:[\\].|[^\\""])*""?|;.*|[^\s \[\]{}()'""`~@,;]*)"; Regex regex = new Regex(pattern); foreach (Match match in regex.Matches(str)) { string token = match.Groups[1].Value; @@ -53,7 +53,7 @@ public static List tokenize(string str) { public static MalVal read_atom(Reader rdr) { string token = rdr.next(); - string pattern = @"(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^("".*"")$|:(.*)|(^[^""]*$)"; + string pattern = @"(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|(^""(?:[\\].|[^\\""])*""$)|(^"".*$)|:(.*)|(^[^""]*$)"; Regex regex = new Regex(pattern); Match match = regex.Match(token); //Console.WriteLine("token: ^" + token + "$"); @@ -71,13 +71,17 @@ public static MalVal read_atom(Reader rdr) { } else if (match.Groups[6].Value != String.Empty) { string str = match.Groups[6].Value; str = str.Substring(1, str.Length-2) - .Replace("\\\"", "\"") - .Replace("\\n", "\n"); + .Replace("\\\\", "\u029e") + .Replace("\\\"", "\"") + .Replace("\\n", "\n") + .Replace("\u029e", "\\"); return new Mal.types.MalString(str); } else if (match.Groups[7].Value != String.Empty) { - return new Mal.types.MalString("\u029e" + match.Groups[7].Value); + throw new ParseError("expected '\"', got EOF"); } else if (match.Groups[8].Value != String.Empty) { - return new Mal.types.MalSymbol(match.Groups[8].Value); + return new Mal.types.MalString("\u029e" + match.Groups[8].Value); + } else if (match.Groups[9].Value != String.Empty) { + return new Mal.types.MalSymbol(match.Groups[9].Value); } else { throw new ParseError("unrecognized '" + match.Groups[0] + "'"); } diff --git a/cs/readline.cs b/impls/cs/readline.cs similarity index 100% rename from cs/readline.cs rename to impls/cs/readline.cs diff --git a/impls/cs/run b/impls/cs/run new file mode 100755 index 0000000000..5c5642646f --- /dev/null +++ b/impls/cs/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" diff --git a/cs/step0_repl.cs b/impls/cs/step0_repl.cs similarity index 77% rename from cs/step0_repl.cs rename to impls/cs/step0_repl.cs index 616e154678..68cac94482 100644 --- a/cs/step0_repl.cs +++ b/impls/cs/step0_repl.cs @@ -25,13 +25,17 @@ static string RE(string env, string str) { } static void Main(string[] args) { - string prompt = "user> "; + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + } + // repl loop while (true) { string line; try { - line = Mal.readline.Readline(prompt); + line = Mal.readline.Readline("user> "); if (line == null) { break; } + if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; diff --git a/cs/step1_read_print.cs b/impls/cs/step1_read_print.cs similarity index 100% rename from cs/step1_read_print.cs rename to impls/cs/step1_read_print.cs diff --git a/cs/step2_eval.cs b/impls/cs/step2_eval.cs similarity index 76% rename from cs/step2_eval.cs rename to impls/cs/step2_eval.cs index 8c68336482..415ac7be50 100644 --- a/cs/step2_eval.cs +++ b/impls/cs/step2_eval.cs @@ -19,49 +19,44 @@ static MalVal READ(string str) { } // eval - static MalVal eval_ast(MalVal ast, Dictionary env) { - if (ast is MalSymbol) { - MalSymbol sym = (MalSymbol)ast; + static MalVal EVAL(MalVal orig_ast, Dictionary env) { + MalVal a0; + // Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + MalSymbol sym = (MalSymbol)orig_ast; return (MalVal)env[sym.getName()]; - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast is MalHashMap) { + } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Dictionary env) { - MalVal a0; - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + } else if (!(orig_ast is MalList)) { + return orig_ast; } // apply list - MalList ast = (MalList)orig_ast; + MalList ast = (MalList) orig_ast; + if (ast.size() == 0) { return ast; } a0 = ast[0]; if (!(a0 is MalSymbol)) { throw new Mal.types.MalError("attempt to apply on non-symbol '" + Mal.printer._pr_str(a0,true) + "'"); } - var el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; - return f.apply(el.rest()); - + MalFunc f = (MalFunc)EVAL(ast[0], env); + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } + return f.apply(arguments); } // print diff --git a/cs/step3_env.cs b/impls/cs/step3_env.cs similarity index 75% rename from cs/step3_env.cs rename to impls/cs/step3_env.cs index 6c4f2fe193..f6a7f11626 100644 --- a/cs/step3_env.cs +++ b/impls/cs/step3_env.cs @@ -20,39 +20,38 @@ static MalVal READ(string str) { } // eval - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast is MalHashMap) { + } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + } else if (!(orig_ast is MalList)) { + return orig_ast; } // apply list - MalList ast = (MalList)orig_ast; + MalList ast = (MalList) orig_ast; + if (ast.size() == 0) { return ast; } a0 = ast[0]; if (!(a0 is MalSymbol)) { @@ -80,9 +79,12 @@ static MalVal EVAL(MalVal orig_ast, Env env) { } return EVAL(a2, let_env); default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; - return f.apply(el.rest()); + MalFunc f = (MalFunc)EVAL(ast[0], env); + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } + return f.apply(arguments); } } diff --git a/impls/cs/step4_if_fn_do.cs b/impls/cs/step4_if_fn_do.cs new file mode 100644 index 0000000000..285509baa5 --- /dev/null +++ b/impls/cs/step4_if_fn_do.cs @@ -0,0 +1,161 @@ +using System; +using System.IO; +using System.Collections; +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalSymbol = Mal.types.MalSymbol; +using MalInt = Mal.types.MalInt; +using MalList = Mal.types.MalList; +using MalVector = Mal.types.MalVector; +using MalHashMap = Mal.types.MalHashMap; +using MalFunc = Mal.types.MalFunc; +using Env = Mal.env.Env; + +namespace Mal { + class step4_if_fn_do { + // read + static MalVal READ(string str) { + return reader.read_str(str); + } + + // eval + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); + foreach (MalVal mv in old_lst.getValue()) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast is MalHashMap) { + var new_dict = new Dictionary(); + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { + new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); + } + return new MalHashMap(new_dict); + } else if (!(orig_ast is MalList)) { + return orig_ast; + } + + // apply list + MalList ast = (MalList) orig_ast; + + if (ast.size() == 0) { return ast; } + a0 = ast[0]; + + String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + + switch (a0sym) { + case "def!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + env.set((MalSymbol)a1, res); + return res; + case "let*": + a1 = ast[1]; + a2 = ast[2]; + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1)[i]; + val = ((MalList)a1)[i+1]; + let_env.set(key, EVAL(val, let_env)); + } + return EVAL(a2, let_env); + case "do": + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } + return EVAL(ast[ast.size()-1], env); + case "if": + a1 = ast[1]; + MalVal cond = EVAL(a1, env); + if (cond == Mal.types.Nil || cond == Mal.types.False) { + // eval false slot form + if (ast.size() > 3) { + return EVAL(ast[3], env); + } else { + return Mal.types.Nil; + } + } else { + // eval true slot form + a2 = ast[2]; + return EVAL(a2, env); + } + case "fn*": + MalList a1f = (MalList)ast[1]; + MalVal a2f = ast[2]; + Env cur_env = env; + return new MalFunc( + args => EVAL(a2f, new Env(cur_env, a1f, args)) ); + default: + MalFunc f = (MalFunc)EVAL(ast[0], env); + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } + return f.apply(arguments); + } + } + + // print + static string PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + static void Main(string[] args) { + var repl_env = new Mal.env.Env(null); + Func RE = (string str) => EVAL(READ(str), repl_env); + + // core.cs: defined using C# + foreach (var entry in core.ns) { + repl_env.set(new MalSymbol(entry.Key), entry.Value); + } + + // core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))"); + + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + } + + // repl loop + while (true) { + string line; + try { + line = Mal.readline.Readline("user> "); + if (line == null) { break; } + if (line == "") { continue; } + } catch (IOException e) { + Console.WriteLine("IOException: " + e.Message); + break; + } + try { + Console.WriteLine(PRINT(RE(line))); + } catch (Mal.types.MalContinue) { + continue; + } catch (Exception e) { + Console.WriteLine("Error: " + e.Message); + Console.WriteLine(e.StackTrace); + continue; + } + } + } + } +} diff --git a/cs/step5_tco.cs b/impls/cs/step5_tco.cs similarity index 77% rename from cs/step5_tco.cs rename to impls/cs/step5_tco.cs index 55d414aaa8..2350e6f375 100644 --- a/cs/step5_tco.cs +++ b/impls/cs/step5_tco.cs @@ -20,42 +20,39 @@ static MalVal READ(string str) { } // eval - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + while (true) { + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast is MalHashMap) { + } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + } else if (!(orig_ast is MalList)) { + return orig_ast; } // apply list - MalList ast = (MalList)orig_ast; + MalList ast = (MalList) orig_ast; + if (ast.size() == 0) { return ast; } a0 = ast[0]; @@ -84,7 +81,9 @@ static MalVal EVAL(MalVal orig_ast, Env env) { env = let_env; break; case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } orig_ast = ast[ast.size()-1]; break; case "if": @@ -109,14 +108,17 @@ static MalVal EVAL(MalVal orig_ast, Env env) { return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; + MalFunc f = (MalFunc)EVAL(ast[0], env); + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; - env = f.genEnv(el.rest()); + env = f.genEnv(arguments); } else { - return f.apply(el.rest()); + return f.apply(arguments); } break; } diff --git a/cs/step6_file.cs b/impls/cs/step6_file.cs similarity index 77% rename from cs/step6_file.cs rename to impls/cs/step6_file.cs index a84e87c9e4..f7f741c809 100644 --- a/cs/step6_file.cs +++ b/impls/cs/step6_file.cs @@ -21,42 +21,39 @@ static MalVal READ(string str) { } // eval - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + while (true) { + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast is MalHashMap) { + } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + } else if (!(orig_ast is MalList)) { + return orig_ast; } // apply list - MalList ast = (MalList)orig_ast; + MalList ast = (MalList) orig_ast; + if (ast.size() == 0) { return ast; } a0 = ast[0]; @@ -85,7 +82,9 @@ static MalVal EVAL(MalVal orig_ast, Env env) { env = let_env; break; case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } orig_ast = ast[ast.size()-1]; break; case "if": @@ -110,14 +109,17 @@ static MalVal EVAL(MalVal orig_ast, Env env) { return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; + MalFunc f = (MalFunc)EVAL(ast[0], env); + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; - env = f.genEnv(el.rest()); + env = f.genEnv(arguments); } else { - return f.apply(el.rest()); + return f.apply(arguments); } break; } @@ -141,20 +143,20 @@ static void Main(string[] args) { } repl_env.set(new MalSymbol("eval"), new MalFunc( a => EVAL(a[0], repl_env))); - int fileIdx = 1; + int fileIdx = 0; if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; - fileIdx = 2; + fileIdx = 1; } MalList _argv = new MalList(); - for (int i=fileIdx; i < args.Length; i++) { + for (int i=fileIdx+1; i < args.Length; i++) { _argv.conj_BANG(new MalString(args[i])); } repl_env.set(new MalSymbol("*ARGV*"), _argv); // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))"); - RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (args.Length > fileIdx) { RE("(load-file \"" + args[fileIdx] + "\")"); diff --git a/impls/cs/step7_quote.cs b/impls/cs/step7_quote.cs new file mode 100644 index 0000000000..4e1c46d9fb --- /dev/null +++ b/impls/cs/step7_quote.cs @@ -0,0 +1,232 @@ +using System; +using System.IO; +using System.Collections; +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalString = Mal.types.MalString; +using MalSymbol = Mal.types.MalSymbol; +using MalInt = Mal.types.MalInt; +using MalList = Mal.types.MalList; +using MalVector = Mal.types.MalVector; +using MalHashMap = Mal.types.MalHashMap; +using MalFunc = Mal.types.MalFunc; +using Env = Mal.env.Env; + +namespace Mal { + class step7_quote { + // read + static MalVal READ(string str) { + return reader.read_str(str); + } + + // eval + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; + } + + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } + public static MalVal quasiquote(MalVal ast) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList(new MalSymbol("quote"), ast); + } else { + return ast; + } + } + + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + while (true) { + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); + foreach (MalVal mv in old_lst.getValue()) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast is MalHashMap) { + var new_dict = new Dictionary(); + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { + new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); + } + return new MalHashMap(new_dict); + } else if (!(orig_ast is MalList)) { + return orig_ast; + } + + // apply list + MalList ast = (MalList) orig_ast; + + if (ast.size() == 0) { return ast; } + a0 = ast[0]; + + String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + + switch (a0sym) { + case "def!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + env.set((MalSymbol)a1, res); + return res; + case "let*": + a1 = ast[1]; + a2 = ast[2]; + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1)[i]; + val = ((MalList)a1)[i+1]; + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast[1]; + case "quasiquote": + orig_ast = quasiquote(ast[1]); + break; + case "do": + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } + orig_ast = ast[ast.size()-1]; + break; + case "if": + a1 = ast[1]; + MalVal cond = EVAL(a1, env); + if (cond == Mal.types.Nil || cond == Mal.types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast[3]; + } else { + return Mal.types.Nil; + } + } else { + // eval true slot form + orig_ast = ast[2]; + } + break; + case "fn*": + MalList a1f = (MalList)ast[1]; + MalVal a2f = ast[2]; + Env cur_env = env; + return new MalFunc(a2f, env, a1f, + args => EVAL(a2f, new Env(cur_env, a1f, args)) ); + default: + MalFunc f = (MalFunc)EVAL(ast[0], env); + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(arguments); + } else { + return f.apply(arguments); + } + break; + } + + } + } + + // print + static string PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + static void Main(string[] args) { + var repl_env = new Mal.env.Env(null); + Func RE = (string str) => EVAL(READ(str), repl_env); + + // core.cs: defined using C# + foreach (var entry in core.ns) { + repl_env.set(new MalSymbol(entry.Key), entry.Value); + } + repl_env.set(new MalSymbol("eval"), new MalFunc( + a => EVAL(a[0], repl_env))); + int fileIdx = 0; + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + fileIdx = 1; + } + MalList _argv = new MalList(); + for (int i=fileIdx+1; i < args.Length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set(new MalSymbol("*ARGV*"), _argv); + + // core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))"); + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + + if (args.Length > fileIdx) { + RE("(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + while (true) { + string line; + try { + line = Mal.readline.Readline("user> "); + if (line == null) { break; } + if (line == "") { continue; } + } catch (IOException e) { + Console.WriteLine("IOException: " + e.Message); + break; + } + try { + Console.WriteLine(PRINT(RE(line))); + } catch (Mal.types.MalContinue) { + continue; + } catch (Exception e) { + Console.WriteLine("Error: " + e.Message); + Console.WriteLine(e.StackTrace); + continue; + } + } + } + } +} diff --git a/impls/cs/step8_macros.cs b/impls/cs/step8_macros.cs new file mode 100644 index 0000000000..a9650e1c2c --- /dev/null +++ b/impls/cs/step8_macros.cs @@ -0,0 +1,245 @@ +using System; +using System.IO; +using System.Collections; +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalString = Mal.types.MalString; +using MalSymbol = Mal.types.MalSymbol; +using MalInt = Mal.types.MalInt; +using MalList = Mal.types.MalList; +using MalVector = Mal.types.MalVector; +using MalHashMap = Mal.types.MalHashMap; +using MalFunc = Mal.types.MalFunc; +using Env = Mal.env.Env; + +namespace Mal { + class step8_macros { + // read + static MalVal READ(string str) { + return reader.read_str(str); + } + + // eval + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; + } + + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } + public static MalVal quasiquote(MalVal ast) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList(new MalSymbol("quote"), ast); + } else { + return ast; + } + } + + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + while (true) { + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); + foreach (MalVal mv in old_lst.getValue()) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast is MalHashMap) { + var new_dict = new Dictionary(); + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { + new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); + } + return new MalHashMap(new_dict); + } else if (!(orig_ast is MalList)) { + return orig_ast; + } + + // apply list + MalList ast = (MalList) orig_ast; + + if (ast.size() == 0) { return ast; } + a0 = ast[0]; + + String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + + switch (a0sym) { + case "def!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + env.set((MalSymbol)a1, res); + return res; + case "let*": + a1 = ast[1]; + a2 = ast[2]; + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1)[i]; + val = ((MalList)a1)[i+1]; + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast[1]; + case "quasiquote": + orig_ast = quasiquote(ast[1]); + break; + case "defmacro!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + res = res.copy(); + ((MalFunc)res).setMacro(); + env.set(((MalSymbol)a1), res); + return res; + case "do": + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } + orig_ast = ast[ast.size()-1]; + break; + case "if": + a1 = ast[1]; + MalVal cond = EVAL(a1, env); + if (cond == Mal.types.Nil || cond == Mal.types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast[3]; + } else { + return Mal.types.Nil; + } + } else { + // eval true slot form + orig_ast = ast[2]; + } + break; + case "fn*": + MalList a1f = (MalList)ast[1]; + MalVal a2f = ast[2]; + Env cur_env = env; + return new MalFunc(a2f, env, a1f, + args => EVAL(a2f, new Env(cur_env, a1f, args)) ); + default: + MalFunc f = (MalFunc)EVAL(ast[0], env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + break; + } + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(arguments); + } else { + return f.apply(arguments); + } + break; + } + + } + } + + // print + static string PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + static void Main(string[] args) { + var repl_env = new Mal.env.Env(null); + Func RE = (string str) => EVAL(READ(str), repl_env); + + // core.cs: defined using C# + foreach (var entry in core.ns) { + repl_env.set(new MalSymbol(entry.Key), entry.Value); + } + repl_env.set(new MalSymbol("eval"), new MalFunc( + a => EVAL(a[0], repl_env))); + int fileIdx = 0; + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + fileIdx = 1; + } + MalList _argv = new MalList(); + for (int i=fileIdx+1; i < args.Length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set(new MalSymbol("*ARGV*"), _argv); + + // core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))"); + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + if (args.Length > fileIdx) { + RE("(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + while (true) { + string line; + try { + line = Mal.readline.Readline("user> "); + if (line == null) { break; } + if (line == "") { continue; } + } catch (IOException e) { + Console.WriteLine("IOException: " + e.Message); + break; + } + try { + Console.WriteLine(PRINT(RE(line))); + } catch (Mal.types.MalContinue) { + continue; + } catch (Exception e) { + Console.WriteLine("Error: " + e.Message); + Console.WriteLine(e.StackTrace); + continue; + } + } + } + } +} diff --git a/impls/cs/step9_try.cs b/impls/cs/step9_try.cs new file mode 100644 index 0000000000..6fd01817c9 --- /dev/null +++ b/impls/cs/step9_try.cs @@ -0,0 +1,270 @@ +using System; +using System.IO; +using System.Collections; +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalString = Mal.types.MalString; +using MalSymbol = Mal.types.MalSymbol; +using MalInt = Mal.types.MalInt; +using MalList = Mal.types.MalList; +using MalVector = Mal.types.MalVector; +using MalHashMap = Mal.types.MalHashMap; +using MalFunc = Mal.types.MalFunc; +using Env = Mal.env.Env; + +namespace Mal { + class step9_try { + // read + static MalVal READ(string str) { + return reader.read_str(str); + } + + // eval + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; + } + + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } + public static MalVal quasiquote(MalVal ast) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList(new MalSymbol("quote"), ast); + } else { + return ast; + } + } + + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + while (true) { + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); + foreach (MalVal mv in old_lst.getValue()) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast is MalHashMap) { + var new_dict = new Dictionary(); + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { + new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); + } + return new MalHashMap(new_dict); + } else if (!(orig_ast is MalList)) { + return orig_ast; + } + + // apply list + MalList ast = (MalList) orig_ast; + + if (ast.size() == 0) { return ast; } + a0 = ast[0]; + + String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + + switch (a0sym) { + case "def!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + env.set((MalSymbol)a1, res); + return res; + case "let*": + a1 = ast[1]; + a2 = ast[2]; + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1)[i]; + val = ((MalList)a1)[i+1]; + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast[1]; + case "quasiquote": + orig_ast = quasiquote(ast[1]); + break; + case "defmacro!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + res = res.copy(); + ((MalFunc)res).setMacro(); + env.set(((MalSymbol)a1), res); + return res; + case "try*": + try { + return EVAL(ast[1], env); + } catch (Exception e) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast[2]; + MalVal a20 = ((MalList)a2)[0]; + if (((MalSymbol)a20).getName() == "catch*") { + if (e is Mal.types.MalException) { + exc = ((Mal.types.MalException)e).getValue(); + } else { + exc = new MalString(e.Message); + } + return EVAL(((MalList)a2)[2], + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw e; + } + case "do": + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } + orig_ast = ast[ast.size()-1]; + break; + case "if": + a1 = ast[1]; + MalVal cond = EVAL(a1, env); + if (cond == Mal.types.Nil || cond == Mal.types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast[3]; + } else { + return Mal.types.Nil; + } + } else { + // eval true slot form + orig_ast = ast[2]; + } + break; + case "fn*": + MalList a1f = (MalList)ast[1]; + MalVal a2f = ast[2]; + Env cur_env = env; + return new MalFunc(a2f, env, a1f, + args => EVAL(a2f, new Env(cur_env, a1f, args)) ); + default: + MalFunc f = (MalFunc)EVAL(ast[0], env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + break; + } + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(arguments); + } else { + return f.apply(arguments); + } + break; + } + + } + } + + // print + static string PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + static void Main(string[] args) { + var repl_env = new Mal.env.Env(null); + Func RE = (string str) => EVAL(READ(str), repl_env); + + // core.cs: defined using C# + foreach (var entry in core.ns) { + repl_env.set(new MalSymbol(entry.Key), entry.Value); + } + repl_env.set(new MalSymbol("eval"), new MalFunc( + a => EVAL(a[0], repl_env))); + int fileIdx = 0; + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + fileIdx = 1; + } + MalList _argv = new MalList(); + for (int i=fileIdx+1; i < args.Length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set(new MalSymbol("*ARGV*"), _argv); + + // core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))"); + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + if (args.Length > fileIdx) { + RE("(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + while (true) { + string line; + try { + line = Mal.readline.Readline("user> "); + if (line == null) { break; } + if (line == "") { continue; } + } catch (IOException e) { + Console.WriteLine("IOException: " + e.Message); + break; + } + try { + Console.WriteLine(PRINT(RE(line))); + } catch (Mal.types.MalContinue) { + continue; + } catch (Mal.types.MalException e) { + Console.WriteLine("Error: " + + printer._pr_str(e.getValue(), false)); + continue; + } catch (Exception e) { + Console.WriteLine("Error: " + e.Message); + Console.WriteLine(e.StackTrace); + continue; + } + } + } + } +} diff --git a/impls/cs/stepA_mal.cs b/impls/cs/stepA_mal.cs new file mode 100644 index 0000000000..76a7504417 --- /dev/null +++ b/impls/cs/stepA_mal.cs @@ -0,0 +1,272 @@ +using System; +using System.IO; +using System.Collections; +using System.Collections.Generic; +using Mal; +using MalVal = Mal.types.MalVal; +using MalString = Mal.types.MalString; +using MalSymbol = Mal.types.MalSymbol; +using MalInt = Mal.types.MalInt; +using MalList = Mal.types.MalList; +using MalVector = Mal.types.MalVector; +using MalHashMap = Mal.types.MalHashMap; +using MalFunc = Mal.types.MalFunc; +using Env = Mal.env.Env; + +namespace Mal { + class stepA_mal { + // read + static MalVal READ(string str) { + return reader.read_str(str); + } + + // eval + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; + } + + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } + public static MalVal quasiquote(MalVal ast) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList(new MalSymbol("quote"), ast); + } else { + return ast; + } + } + + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; + while (true) { + MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != Mal.types.Nil + && dbgeval != Mal.types.False) + Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + if (orig_ast is MalSymbol) { + string key = ((MalSymbol)orig_ast).getName(); + res = env.get(key); + if (res == null) + throw new Mal.types.MalException("'" + key + "' not found"); + return res; + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); + foreach (MalVal mv in old_lst.getValue()) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast is MalHashMap) { + var new_dict = new Dictionary(); + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { + new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); + } + return new MalHashMap(new_dict); + } else if (!(orig_ast is MalList)) { + return orig_ast; + } + + // apply list + MalList ast = (MalList) orig_ast; + + if (ast.size() == 0) { return ast; } + a0 = ast[0]; + + String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + + switch (a0sym) { + case "def!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + env.set((MalSymbol)a1, res); + return res; + case "let*": + a1 = ast[1]; + a2 = ast[2]; + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1)[i]; + val = ((MalList)a1)[i+1]; + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast[1]; + case "quasiquote": + orig_ast = quasiquote(ast[1]); + break; + case "defmacro!": + a1 = ast[1]; + a2 = ast[2]; + res = EVAL(a2, env); + res = res.copy(); + ((MalFunc)res).setMacro(); + env.set(((MalSymbol)a1), res); + return res; + case "try*": + try { + return EVAL(ast[1], env); + } catch (Exception e) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast[2]; + MalVal a20 = ((MalList)a2)[0]; + if (((MalSymbol)a20).getName() == "catch*") { + if (e is Mal.types.MalException) { + exc = ((Mal.types.MalException)e).getValue(); + } else { + exc = new MalString(e.Message); + } + return EVAL(((MalList)a2)[2], + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw e; + } + case "do": + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } + orig_ast = ast[ast.size()-1]; + break; + case "if": + a1 = ast[1]; + MalVal cond = EVAL(a1, env); + if (cond == Mal.types.Nil || cond == Mal.types.False) { + // eval false slot form + if (ast.size() > 3) { + orig_ast = ast[3]; + } else { + return Mal.types.Nil; + } + } else { + // eval true slot form + orig_ast = ast[2]; + } + break; + case "fn*": + MalList a1f = (MalList)ast[1]; + MalVal a2f = ast[2]; + Env cur_env = env; + return new MalFunc(a2f, env, a1f, + args => EVAL(a2f, new Env(cur_env, a1f, args)) ); + default: + MalFunc f = (MalFunc)EVAL(ast[0], env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + break; + } + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } + MalVal fnast = f.getAst(); + if (fnast != null) { + orig_ast = fnast; + env = f.genEnv(arguments); + } else { + return f.apply(arguments); + } + break; + } + + } + } + + // print + static string PRINT(MalVal exp) { + return printer._pr_str(exp, true); + } + + // repl + static void Main(string[] args) { + var repl_env = new Mal.env.Env(null); + Func RE = (string str) => EVAL(READ(str), repl_env); + + // core.cs: defined using C# + foreach (var entry in core.ns) { + repl_env.set(new MalSymbol(entry.Key), entry.Value); + } + repl_env.set(new MalSymbol("eval"), new MalFunc( + a => EVAL(a[0], repl_env))); + int fileIdx = 0; + if (args.Length > 0 && args[0] == "--raw") { + Mal.readline.mode = Mal.readline.Mode.Raw; + fileIdx = 1; + } + MalList _argv = new MalList(); + for (int i=fileIdx+1; i < args.Length; i++) { + _argv.conj_BANG(new MalString(args[i])); + } + repl_env.set(new MalSymbol("*ARGV*"), _argv); + + // core.mal: defined using the language itself + RE("(def! *host-language* \"c#\")"); + RE("(def! not (fn* (a) (if a false true)))"); + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + if (args.Length > fileIdx) { + RE("(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + RE("(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + string line; + try { + line = Mal.readline.Readline("user> "); + if (line == null) { break; } + if (line == "") { continue; } + } catch (IOException e) { + Console.WriteLine("IOException: " + e.Message); + break; + } + try { + Console.WriteLine(PRINT(RE(line))); + } catch (Mal.types.MalContinue) { + continue; + } catch (Mal.types.MalException e) { + Console.WriteLine("Error: " + + printer._pr_str(e.getValue(), false)); + continue; + } catch (Exception e) { + Console.WriteLine("Error: " + e.Message); + Console.WriteLine(e.StackTrace); + continue; + } + } + } + } +} diff --git a/impls/cs/tests/step5_tco.mal b/impls/cs/tests/step5_tco.mal new file mode 100644 index 0000000000..4fec62e2fc --- /dev/null +++ b/impls/cs/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; C#: skipping non-TCO recursion +;; Reason: unrecoverable stack overflow at 10,000 diff --git a/cs/types.cs b/impls/cs/types.cs similarity index 95% rename from cs/types.cs rename to impls/cs/types.cs index b96a9f4eb6..21088fd08e 100644 --- a/cs/types.cs +++ b/impls/cs/types.cs @@ -5,7 +5,7 @@ namespace Mal { public class types { // - // Exceptiosn/Errors + // Exceptions/Errors // public class MalThrowable : Exception { public MalThrowable() : base() { } @@ -58,6 +58,19 @@ public static bool _equal_Q(MalVal a, MalVal b) { } } return true; + } else if (a is MalHashMap) { + var akeys = ((MalHashMap)a).getValue().Keys; + var bkeys = ((MalHashMap)b).getValue().Keys; + if (akeys.Count != bkeys.Count) { + return false; + } + foreach (var k in akeys) { + if (!_equal_Q(((MalHashMap)a).getValue()[k], + ((MalHashMap)b).getValue()[k])) { + return false; + } + } + return true; } else { return a == b; } diff --git a/impls/d/Dockerfile b/impls/d/Dockerfile new file mode 100644 index 0000000000..a7b7113b4c --- /dev/null +++ b/impls/d/Dockerfile @@ -0,0 +1,31 @@ +FROM ubuntu:bionic +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install gcc gdc ldc gpg wget + +RUN wget https://dlang.org/install.sh -q -O install.sh && \ + bash install.sh -p /usr/local/dlang && \ + chmod 755 /usr/local/dlang/dmd* && \ + ln -sf /usr/local/dlang/dmd-*/linux/bin64/dmd /usr/bin/dmd + +ENV HOME /mal diff --git a/impls/d/Makefile b/impls/d/Makefile new file mode 100644 index 0000000000..7872d8920e --- /dev/null +++ b/impls/d/Makefile @@ -0,0 +1,54 @@ +d_MODE ?= gdc + +D ?= $(d_MODE) + +ifeq ($(D),gdc) +CFLAGS += -g -O2 -Wall +LDFLAGS += -lreadline +OF = -o $@ +else ifeq ($(D),ldc2) +CFLAGS += -g -O2 +LDFLAGS += -L-lreadline +OF = -of $@ +else ifeq ($(D),dmd) +CFLAGS += -g -O +LDFLAGS += -L-lreadline +OF = -of=$@ +else + @echo "Unsupported D implementation $(D)" + @exit 1 +endif + +##################### + +EARLY_SRCS = step0_repl.d step1_read_print.d step2_eval.d +LATE_SRCS = step3_env.d step4_if_fn_do.d step5_tco.d step6_file.d \ + step7_quote.d step8_macros.d step9_try.d stepA_mal.d +SRCS = $(EARLY_SRCS) $(LATE_SRCS) +OBJS = $(SRCS:%.d=%.o) +BINS = $(OBJS:%.o=%) +EARLY_OBJS = types.o readline.o reader.o printer.o env.o +OTHER_OBJS = $(EARLY_OBJS) mal_core.o +EARLY_STEPS_BINS = $(EARLY_SRCS:%.d=%) +LATE_STEPS_BINS = $(LATE_SRCS:%.d=%) + +##################### + +all: $(BINS) + +dist: mal + +mal: $(word $(words $(BINS)),$(BINS)) + cp $< $@ + +$(OBJS) $(OTHER_OBJS): %.o: %.d + $(D) $(CFLAGS) -c $(@:%.o=%.d) $(OF) + +$(EARLY_STEPS_BINS): $(EARLY_OBJS) +$(LATE_STEPS_BINS): $(OTHER_OBJS) + +$(BINS): %: %.o + $(D) $+ $(OF) $(LDFLAGS) + +clean: + rm -f $(OBJS) $(BINS) $(OTHER_OBJS) mal diff --git a/impls/d/env.d b/impls/d/env.d new file mode 100644 index 0000000000..b7faa8cc3a --- /dev/null +++ b/impls/d/env.d @@ -0,0 +1,44 @@ +import types; + +class Env { + Env outer; + MalType[string] data; + + this(Env outer_v, MalType[] binds = [], MalType[] exprs = []) + { + outer = outer_v; + foreach (i, MalType b; binds) + { + auto arg_name = verify_cast!MalSymbol(b); + if (arg_name.name == "&") + { + auto rest_arg_name = verify_cast!MalSymbol(binds[i + 1]); + auto rest_exprs = new MalList(exprs[i..$]); + set(rest_arg_name.name, rest_exprs); + break; + } + else + { + set(arg_name.name, exprs[i]); + } + } + } + + MalType set(string key, MalType val) + { + data[key] = val; + return val; + } + + MalType get(string key) + { + auto val = (key in data); + if (val !is null) { + return data[key]; + } else if (outer is null) { + return null; + } else { + return outer.get(key); + } + } +} diff --git a/impls/d/main.di b/impls/d/main.di new file mode 100644 index 0000000000..15aac77083 --- /dev/null +++ b/impls/d/main.di @@ -0,0 +1,4 @@ +import types : MalType; +import env : Env; + +MalType EVAL(MalType ast, Env env); diff --git a/impls/d/mal_core.d b/impls/d/mal_core.d new file mode 100644 index 0000000000..86d681b33c --- /dev/null +++ b/impls/d/mal_core.d @@ -0,0 +1,427 @@ +import core.time; +import std.algorithm; +import std.array; +import std.datetime; +import std.file; +import std.stdio; +import env; +import main; +import reader; +import readline; +import types; +import printer; + +static MalType mal_equal(MalType[] a ...) +{ + verify_args_count(a, 2); + return bool_to_mal(a[0] == a[1]); +} + +static MalType mal_throw(MalType[] a ...) +{ + verify_args_count(a, 1); + throw new MalException(a[0]); +} + +static MalType mal_symbol(MalType[] a ...) +{ + verify_args_count(a, 1); + auto s = verify_cast!MalString(a[0]); + return new MalSymbol(s.val); +} + +static MalType mal_string_q(MalType[] a ...) +{ + verify_args_count(a, 1); + auto s = cast(MalString) a[0]; + if (s is null) return mal_false; + return bool_to_mal(!s.is_keyword()); +} + +static MalType mal_keyword(MalType[] a ...) +{ + verify_args_count(a, 1); + auto s = verify_cast!MalString(a[0]); + if (s.is_keyword()) return s; + return new MalString("\u029e" ~ s.val); +} + +static MalType mal_keyword_q(MalType[] a ...) +{ + verify_args_count(a, 1); + auto s = cast(MalString) a[0]; + if (s is null) return mal_false; + return bool_to_mal(s.is_keyword()); +} + +static MalType mal_fn_q(MalType[] a ...) +{ + verify_args_count(a, 1); + auto builtinfn = cast(MalBuiltinFunc) a[0]; + if (builtinfn !is null) return mal_true; + auto malfunc = cast(MalFunc) a[0]; + if (malfunc !is null) return bool_to_mal(!malfunc.is_macro); + return mal_false; +} + +static MalType mal_macro_q(MalType[] a ...) +{ + verify_args_count(a, 1); + auto malfunc = cast(MalFunc) a[0]; + if (malfunc !is null) return bool_to_mal(malfunc.is_macro); + return mal_false; +} + +static MalType mal_pr_str(MalType[] a ...) +{ + auto items_strs = a.map!(e => pr_str(e, true)); + return new MalString(array(items_strs).join(" ")); +} + +static MalType mal_str(MalType[] a ...) +{ + auto items_strs = a.map!(e => pr_str(e, false)); + return new MalString(array(items_strs).join("")); +} + +static MalType mal_prn(MalType[] a ...) +{ + auto items_strs = a.map!(e => pr_str(e, true)); + writeln(array(items_strs).join(" ")); + return mal_nil; +} + +static MalType mal_println(MalType[] a ...) +{ + auto items_strs = a.map!(e => pr_str(e, false)); + writeln(array(items_strs).join(" ")); + return mal_nil; +} + +static MalType mal_read_string(MalType[] a ...) +{ + verify_args_count(a, 1); + auto s = verify_cast!MalString(a[0]); + return read_str(s.val); +} + +static MalType mal_readline(MalType[] a ...) +{ + verify_args_count(a, 1); + auto s = verify_cast!MalString(a[0]); + auto line = _readline(s.val); + return line is null ? mal_nil : new MalString(line); +} + +static MalType mal_slurp(MalType[] a ...) +{ + verify_args_count(a, 1); + auto filename = verify_cast!MalString(a[0]).val; + auto content = cast(string) std.file.read(filename); + return new MalString(content); +} + +alias TwoIntFunc = MalType function(long x, long y); + +MalType binary_int_op(TwoIntFunc f, MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return f(i0.val, i1.val); +} + +static MalType mal_time_ms(MalType[] a ...) +{ + immutable epoch = SysTime(unixTimeToStdTime(0)); + immutable hnsecs_since_epoch = Clock.currTime(UTC()) - epoch; + immutable ms = hnsecs_since_epoch.total!"msecs"(); + return new MalInteger(ms); +} + +static bool is_nil(MalType v) +{ + return cast(MalNil)(v) !is null; +} + +static MalType mal_assoc(MalType[] a ...) +{ + verify_min_args_count(a, 1); + auto hm = verify_cast!MalHashmap(a[0]); + auto new_hm = new MalHashmap(hm.data.dup); + new_hm.put_kv_list(a[1..$]); + return new_hm; +} + +static MalType mal_dissoc(MalType[] a ...) +{ + verify_min_args_count(a, 1); + auto hm = verify_cast!MalHashmap(a[0]); + auto new_hm = new MalHashmap(hm.data.dup); + foreach (k; a[1..$]) + { + new_hm.remove(k); + } + return new_hm; +} + +static MalType mal_get(MalType[] a ...) +{ + verify_args_count(a, 2); + if (is_nil(a[0])) return mal_nil; + auto hm = verify_cast!MalHashmap(a[0]); + return hm.get(a[1]); +} + +static MalType mal_contains_q(MalType[] a ...) +{ + verify_args_count(a, 2); + if (is_nil(a[0])) return mal_false; + auto hm = verify_cast!MalHashmap(a[0]); + return bool_to_mal(hm.contains(a[1])); +} + +static MalType mal_keys(MalType[] a ...) +{ + verify_args_count(a, 1); + auto hm = verify_cast!MalHashmap(a[0]); + auto keys = hm.data.keys.map!(s => cast(MalType)(new MalString(s))); + return new MalList(array(keys)); +} + +static MalType mal_vals(MalType[] a ...) +{ + verify_args_count(a, 1); + auto hm = verify_cast!MalHashmap(a[0]); + return new MalList(hm.data.values); +} + +static MalType mal_cons(MalType[] a ...) +{ + verify_args_count(a, 2); + auto lst = verify_cast!MalSequential(a[1]); + return new MalList([a[0]] ~ lst.elements); +} + +static MalType mal_concat(MalType[] a ...) +{ + MalType[] res; + foreach (e; a) + { + auto lst = verify_cast!MalSequential(e); + res ~= lst.elements; + } + return new MalList(res); +} + +static MalType mal_vec(MalType[] a ...) +{ + verify_args_count(a, 1); + return new MalVector(verify_cast!MalSequential(a[0]).elements); +} + +static MalType mal_nth(MalType[] a ...) +{ + verify_args_count(a, 2); + if (is_nil(a[0])) + { + throw new Exception("nth: index out of range"); + } + auto seq = verify_cast!MalSequential(a[0]); + auto index = verify_cast!MalInteger(a[1]).val; + if (index >= seq.elements.length) + { + throw new Exception("nth: index out of range"); + } + return seq.elements[index]; +} + +static MalType mal_first(MalType[] a ...) +{ + verify_args_count(a, 1); + if (is_nil(a[0])) return mal_nil; + auto seq = verify_cast!MalSequential(a[0]); + if (seq.elements.length == 0) return mal_nil; + return seq.elements[0]; +} + +static MalType mal_rest(MalType[] a ...) +{ + verify_args_count(a, 1); + if (is_nil(a[0])) return new MalList([]); + auto seq = verify_cast!MalSequential(a[0]); + if (seq.elements.length == 0) return new MalList([]); + return new MalList(seq.elements[1..$]); +} + + +static MalType mal_empty_q(MalType[] a ...) +{ + verify_args_count(a, 1); + if (is_nil(a[0])) + { + return mal_true; + } + auto s = verify_cast!MalSequential(a[0]); + return bool_to_mal(s.elements.length == 0); +} + +static MalType mal_count(MalType[] a ...) +{ + verify_args_count(a, 1); + if (is_nil(a[0])) + { + return new MalInteger(0); + } + auto s = verify_cast!MalSequential(a[0]); + return new MalInteger(cast(int)(s.elements.length)); +} + +static MalType mal_apply(MalType[] a ...) +{ + verify_min_args_count(a, 2); + auto last_seq_elems = verify_cast!MalSequential(a[$-1]).elements; + auto funcargs = a.length == 2 ? last_seq_elems : (a[1..$-1] ~ last_seq_elems); + + auto builtinfn = cast(MalBuiltinFunc) a[0]; + if (builtinfn !is null) + { + return builtinfn.fn(funcargs); + } + + auto malfunc = verify_cast!MalFunc(a[0]); + auto callenv = new Env(malfunc.def_env, malfunc.arg_names, funcargs); + + return EVAL(malfunc.func_body, callenv); +} + +static MalType mal_map(MalType[] a ...) +{ + verify_args_count(a, 2); + auto seq = verify_cast!MalSequential(a[1]); + auto mapped_items = seq.elements.map!(e => mal_apply(a[0], new MalList([e]))); + return new MalList(array(mapped_items)); +} + +static MalType mal_conj(MalType[] a ...) +{ + verify_min_args_count(a, 1); + auto seq = verify_cast!MalSequential(a[0]); + return reduce!((s,e) => s.conj(e))(seq, a[1..$]); +} + +static MalType mal_seq(MalType[] a ...) +{ + verify_args_count(a, 1); + auto seqobj = cast(HasSeq) a[0]; + if (seqobj is null) return mal_nil; + return seqobj.seq(); +} + +static MalType mal_meta(MalType[] a ...) +{ + verify_args_count(a, 1); + auto metaobj = cast(MalMeta) a[0]; + if (metaobj is null) return mal_nil; + return metaobj.meta(); +} + +static MalType mal_with_meta(return MalType[] a ...) +{ + verify_args_count(a, 2); + if (auto metaobj = cast(MalMeta) a[0]) + return metaobj.with_meta(a[1]); + return a[0]; +} + +static MalType mal_reset_bang(return MalType[] a ...) +{ + verify_args_count(a, 2); + verify_cast!MalAtom(a[0]).val = a[1]; + return a[1]; +} + +static MalType mal_swap_bang(MalType[] a ...) +{ + verify_min_args_count(a, 2); + auto atom = verify_cast!MalAtom(a[0]); + auto args = [atom.val] ~ a[2..$]; + auto newval = mal_apply([a[1], new MalList(args)]); + return mal_reset_bang([atom, newval]); +} + +BuiltinStaticFuncType[string] core_ns; + +static this() +{ + core_ns = [ + "=": &mal_equal, + "throw": &mal_throw, + + "nil?": (a ...) => mal_type_q!MalNil(a), + "true?": (a ...) => mal_type_q!MalTrue(a), + "false?": (a ...) => mal_type_q!MalFalse(a), + "symbol": &mal_symbol, + "symbol?": (a ...) => mal_type_q!MalSymbol(a), + "string?": &mal_string_q, + "keyword": &mal_keyword, + "keyword?": &mal_keyword_q, + "number?": (a ...) => mal_type_q!MalInteger(a), + "fn?": &mal_fn_q, + "macro?": &mal_macro_q, + + "pr-str": &mal_pr_str, + "str": &mal_str, + "prn": &mal_prn, + "println": &mal_println, + "read-string": &mal_read_string, + "readline": &mal_readline, + "slurp": &mal_slurp, + + "<": (a ...) => binary_int_op((x,y) => bool_to_mal(x < y), a), + "<=": (a ...) => binary_int_op((x,y) => bool_to_mal(x <= y), a), + ">": (a ...) => binary_int_op((x,y) => bool_to_mal(x > y), a), + ">=": (a ...) => binary_int_op((x,y) => bool_to_mal(x >= y), a), + "+": (a ...) => binary_int_op((x,y) => new MalInteger(x + y), a), + "-": (a ...) => binary_int_op((x,y) => new MalInteger(x - y), a), + "*": (a ...) => binary_int_op((x,y) => new MalInteger(x * y), a), + "/": (a ...) => binary_int_op((x,y) => new MalInteger(x / y), a), + "time-ms": &mal_time_ms, + + "list": (a ...) => new MalList(a), + "list?": (a ...) => mal_type_q!MalList(a), + "vector": (a ...) => new MalVector(a), + "vector?": (a ...) => mal_type_q!MalVector(a), + "hash-map": (a ...) => new MalHashmap(a), + "map?": (a ...) => mal_type_q!MalHashmap(a), + "assoc": &mal_assoc, + "dissoc": &mal_dissoc, + "get": &mal_get, + "contains?": &mal_contains_q, + "keys": &mal_keys, + "vals": &mal_vals, + + "sequential?": (a ...) => mal_type_q!MalSequential(a), + "cons": &mal_cons, + "concat": &mal_concat, + "vec": &mal_vec, + "nth": &mal_nth, + "first": &mal_first, + "rest": &mal_rest, + "empty?": &mal_empty_q, + "count": &mal_count, + "apply": &mal_apply, + "map": &mal_map, + + "conj": &mal_conj, + "seq": &mal_seq, + + "meta": &mal_meta, + "with-meta": &mal_with_meta, + "atom": (a ...) => new MalAtom(verify_args_count(a, 1)[0]), + "atom?": (a ...) => mal_type_q!MalAtom(a), + "deref": (a ...) => verify_cast!MalAtom(verify_args_count(a, 1)[0]).val, + "reset!": &mal_reset_bang, + "swap!": &mal_swap_bang + ]; +} diff --git a/impls/d/printer.d b/impls/d/printer.d new file mode 100644 index 0000000000..ed2da24b7d --- /dev/null +++ b/impls/d/printer.d @@ -0,0 +1,6 @@ +import types; + +string pr_str(MalType obj, bool readable = true) +{ + return obj.print(readable); +} diff --git a/impls/d/reader.d b/impls/d/reader.d new file mode 100644 index 0000000000..c2ffe2c69a --- /dev/null +++ b/impls/d/reader.d @@ -0,0 +1,191 @@ +import std.array; +import std.regex; +import std.stdio; +import types; + +MalSymbol sym_quote; +MalSymbol sym_quasiquote; +MalSymbol sym_unquote; +MalSymbol sym_splice_unquote; +MalSymbol sym_deref; +MalSymbol sym_with_meta; + +static this() +{ + sym_quote = new MalSymbol("quote"); + sym_quasiquote = new MalSymbol("quasiquote"); + sym_unquote = new MalSymbol("unquote"); + sym_splice_unquote = new MalSymbol("splice-unquote"); + sym_deref = new MalSymbol("deref"); + sym_with_meta = new MalSymbol("with-meta"); +} + +class Reader +{ + int pos = 0; + const string[] tokens; + + this(string[] the_tokens) + { + tokens = the_tokens.dup; + } + + string peek() + { + if (pos >= tokens.length) return null; + return tokens[pos]; + } + + string next() + { + auto token = peek(); + pos++; + return token; + } +} + +auto tokenize_ctr = ctRegex!(r"[\s,]*(~@|[\[\]{}()'`~^@]|" ~ `"` ~ `(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"` ~ r"`,;)]*)"); + +string[] tokenize(string str) +{ + string[] tokens; + foreach(c; matchAll(str, tokenize_ctr)) + { + auto token = c[1]; + if (token.length == 0) continue; + if (token[0] == ';') continue; + tokens ~= token; + } + return tokens; +} + +MalString parse_string(string token) +{ + // TODO: this could be done with replaceAll + // https://dlang.org/library/std/regex/replace_all.html + string unescaped = + token[1..$-1] // Remove surrounding quotes + .replace("\\\\", "\u029e") + .replace("\\n", "\n") + .replace("\\\"", "\"") + .replace("\u029e", "\\"); + return new MalString(unescaped); +} + +auto integer_ctr = ctRegex!(r"^-?[0-9]+$"); +auto string_ctr = ctRegex!(`^"(?:\\.|[^\\"])*"$`); + +MalType read_atom(Reader reader) +{ + auto token = reader.next(); + switch (token) + { + case "nil": return mal_nil; + case "false": return mal_false; + case "true": return mal_true; + default: + switch (token[0]) { + case ':': + return new MalString("\u029e" ~ token[1..$]); + case '"': + auto captures = matchFirst(token, string_ctr); + if (captures.empty()) + { + throw new Exception("expected '\"', got EOF"); + } + return parse_string(token); + default: + auto captures = matchFirst(token, integer_ctr); + if (!captures.empty()) + { + return new MalInteger(token); + } + + return new MalSymbol(token); + } + } +} + +MalType[] read_items(Reader reader, string start, string end) +{ + auto open_paren = reader.next(); + if (open_paren != start) throw new Exception("expected '" ~ start ~ "', got EOF"); + + string token; + MalType[] res; + while ((token = reader.peek()) != end) + { + if (token is null) + { + throw new Exception("expected '" ~ end ~ "', got EOF"); + } + res ~= read_form(reader); + } + reader.next(); // consume the ')' + return res; +} + +MalList read_list(Reader reader) +{ + return new MalList(read_items(reader, "(", ")")); +} + +MalVector read_vector(Reader reader) +{ + return new MalVector(read_items(reader, "[", "]")); +} + +MalHashmap read_hashmap(Reader reader) +{ + return new MalHashmap(read_items(reader, "{", "}")); +} + +MalList read_quote_shortcut(Reader reader, MalSymbol sym) +{ + reader.next(); // consume the special quote char + return new MalList([sym, read_form(reader)]); +} + +MalType read_form(Reader reader) +{ + auto token = reader.peek(); + if (token is null) return new MalNil(); + switch(token) + { + case "'": + return read_quote_shortcut(reader, sym_quote); + case "`": + return read_quote_shortcut(reader, sym_quasiquote); + case "~": + return read_quote_shortcut(reader, sym_unquote); + case "~@": + return read_quote_shortcut(reader, sym_splice_unquote); + case "@": + return read_quote_shortcut(reader, sym_deref); + case "^": + reader.next(); // consume the caret char + auto meta = read_form(reader); + return new MalList([sym_with_meta, read_form(reader), meta]); + case "(": + return read_list(reader); + case ")": + throw new Exception("unexpected ')'"); + case "[": + return read_vector(reader); + case "]": + throw new Exception("unexpected ']'"); + case "{": + return read_hashmap(reader); + case "}": + throw new Exception("unexpected '}'"); + default: + return read_atom(reader); + } +} + +MalType read_str(string str) +{ + auto tokens = tokenize(str); + auto reader = new Reader(tokens); + return read_form(reader); +} diff --git a/impls/d/readline.d b/impls/d/readline.d new file mode 100644 index 0000000000..37a5e73321 --- /dev/null +++ b/impls/d/readline.d @@ -0,0 +1,60 @@ +import std.string; +import std.path; +import std.file; + +import core.stdc.string; +import core.stdc.stdlib; + +// readline/readline.h +extern (C) char* readline(const char* prompt); + +// readline/history.h +extern (C) void using_history(); +extern (C) void add_history(const char *line); +extern (C) int read_history(const char *filename); +extern (C) int append_history(int nelement, const char *filename); + +bool history_loaded = false; +const string history_file = "~/.mal-history"; + +void load_history() +{ + if (history_loaded) return; + using_history(); + string hf = expandTilde(history_file); + std.file.append(hf, ""); // Create the file if needed + read_history(toStringz(hf)); + history_loaded = true; +} + +void append_to_history() +{ + string hf = expandTilde(history_file); + append_history(1, toStringz(hf)); +} + +// Convert from C-string to D-string (making a copy) +pure string fromCstr(char* cstr) +{ + auto len = core.stdc.string.strlen(cstr); + if (len == 0) return ""; + string line = cstr[0..len].dup; + return line; +} + +string _readline(in string prompt) +{ + load_history(); + + auto cstr = readline(toStringz(prompt)); + if (cstr is null) return null; + scope(exit) { core.stdc.stdlib.free(cstr); } + + if (cstr[0] != '\0') + { + add_history(cstr); // Add input to in-memory history + append_to_history(); // Flush new line of history to disk + } + + return fromCstr(cstr); +} diff --git a/impls/d/run b/impls/d/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/d/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/d/step0_repl.d b/impls/d/step0_repl.d new file mode 100644 index 0000000000..475dcca2a1 --- /dev/null +++ b/impls/d/step0_repl.d @@ -0,0 +1,35 @@ +import std.stdio; +import std.string; +import readline; + +string READ(string str) +{ + return str; +} + +string EVAL(string ast) +{ + return ast; +} + +string PRINT(string ast) +{ + return ast; +} + +string rep(string str) +{ + return PRINT(EVAL(READ(str))); +} + +void main() +{ + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + writeln(rep(line)); + } + writeln(""); +} diff --git a/impls/d/step1_read_print.d b/impls/d/step1_read_print.d new file mode 100644 index 0000000000..1f73ec9399 --- /dev/null +++ b/impls/d/step1_read_print.d @@ -0,0 +1,45 @@ +import std.stdio; +import std.string; +import readline; +import reader; +import printer; +import types; + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast) +{ + return ast; +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +string rep(string str) +{ + return PRINT(EVAL(READ(str))); +} + +void main() +{ + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step2_eval.d b/impls/d/step2_eval.d new file mode 100644 index 0000000000..eb80ce16cd --- /dev/null +++ b/impls/d/step2_eval.d @@ -0,0 +1,125 @@ +import std.algorithm; +import std.array; +import std.stdio; +import std.string; +import readline; +import reader; +import printer; +import types; + +alias Env = MalType[string]; + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + if (auto dbgeval = ("DEBUG-EVAL" in env)) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + auto v = (sym.name in env); + if (v is null) throw new Exception("'" ~ sym.name ~ "' not found"); + return *v; + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + // todo: indent right + else if (auto ast_list = cast(MalList)ast) + { + if (ast_list.elements.length == 0) + { + return ast; + } + auto fobj = verify_cast!MalBuiltinFunc(EVAL(ast_list.elements[0], env)); + auto args = array(ast_list.elements[1..$].map!(e => EVAL(e, env))); + return fobj.fn(args); + } + else + { + return ast; + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +static MalType mal_add(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val + i1.val); +} + +static MalType mal_sub(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val - i1.val); +} + +static MalType mal_mul(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val * i1.val); +} + +static MalType mal_div(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val / i1.val); +} + +void main() +{ + Env repl_env; + repl_env["+"] = new MalBuiltinFunc(&mal_add, "+"); + repl_env["-"] = new MalBuiltinFunc(&mal_sub, "-"); + repl_env["*"] = new MalBuiltinFunc(&mal_mul, "*"); + repl_env["/"] = new MalBuiltinFunc(&mal_div, "/"); + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step3_env.d b/impls/d/step3_env.d new file mode 100644 index 0000000000..722a5dbc82 --- /dev/null +++ b/impls/d/step3_env.d @@ -0,0 +1,149 @@ +module main; + +import std.algorithm; +import std.array; +import std.range; +import std.stdio; +import std.string; +import env; +import readline; +import reader; +import printer; +import types; + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + // todo: indent right + else if (auto ast_list = cast(MalList)ast) + { + if (ast_list.elements.length == 0) + { + return ast; + } + + auto a0_sym = verify_cast!MalSymbol(ast_list.elements[0]); + switch (a0_sym.name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(ast_list.elements[1]); + return env.set(a1.name, EVAL(ast_list.elements[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(ast_list.elements[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + return EVAL(ast_list.elements[2], let_env); + + default: + auto fobj = verify_cast!MalBuiltinFunc(EVAL(ast_list.elements[0], env)); + auto args = array(ast_list.elements[1..$].map!(e => EVAL(e, env))); + return fobj.fn(args); + } + } + else + { + return ast; + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +static MalType mal_add(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val + i1.val); +} + +static MalType mal_sub(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val - i1.val); +} + +static MalType mal_mul(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val * i1.val); +} + +static MalType mal_div(MalType[] a ...) +{ + verify_args_count(a, 2); + MalInteger i0 = verify_cast!MalInteger(a[0]); + MalInteger i1 = verify_cast!MalInteger(a[1]); + return new MalInteger(i0.val / i1.val); +} + +void main() +{ + auto repl_env = new Env(null); + repl_env.set("+", new MalBuiltinFunc(&mal_add, "+")); + repl_env.set("-", new MalBuiltinFunc(&mal_sub, "-")); + repl_env.set("*", new MalBuiltinFunc(&mal_mul, "*")); + repl_env.set("/", new MalBuiltinFunc(&mal_div, "/")); + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step4_if_fn_do.d b/impls/d/step4_if_fn_do.d new file mode 100644 index 0000000000..255f71578a --- /dev/null +++ b/impls/d/step4_if_fn_do.d @@ -0,0 +1,159 @@ +module main; + +import std.algorithm; +import std.array; +import std.range; +import std.stdio; +import std.string; +import env; +import mal_core; +import readline; +import reader; +import printer; +import types; + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + // todo: indent right + else if (auto ast_list = cast(MalList)ast) + { + auto aste = ast_list.elements; + if (aste.length == 0) + { + return ast; + } + auto a0_sym = cast(MalSymbol) aste[0]; + auto sym_name = a0_sym is null ? "" : a0_sym.name; + switch (sym_name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(aste[1]); + return env.set(a1.name, EVAL(aste[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(aste[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + return EVAL(aste[2], let_env); + + case "do": + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + return EVAL(aste[$-1], env); + + case "if": + auto cond = EVAL(aste[1], env); + if (cond.is_truthy()) + return EVAL(aste[2], env); + else + if (aste.length > 3) + return EVAL(aste[3], env); + else + return mal_nil; + + case "fn*": + auto args_list = verify_cast!MalSequential(aste[1]); + return new MalFunc(args_list.elements, aste[2], env); + + default: + auto first = EVAL(aste[0], env); + auto rest = array(aste[1..$].map!(e => EVAL(e, env))); + if (auto funcobj = cast(MalFunc)first) + { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + return EVAL(funcobj.func_body, callenv); + } + else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) + { + return builtinfuncobj.fn(rest); + } + else + { + throw new Exception("Expected a function"); + } + } + } + else + { + return ast; + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +MalType re(string str, Env env) +{ + return EVAL(READ(str), env); +} + +string rep(string str, Env env) +{ + return PRINT(re(str, env)); +} + +void main() +{ + auto repl_env = new Env(null); + foreach (string sym_name, BuiltinStaticFuncType f; core_ns) + { + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); + } + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step5_tco.d b/impls/d/step5_tco.d new file mode 100644 index 0000000000..315f73d0dd --- /dev/null +++ b/impls/d/step5_tco.d @@ -0,0 +1,174 @@ +module main; + +import std.algorithm; +import std.array; +import std.range; +import std.stdio; +import std.string; +import env; +import mal_core; +import readline; +import reader; +import printer; +import types; + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + for (;;) + { + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + else if (auto ast_list = cast(MalList)ast) + { + auto aste = ast_list.elements; + if (aste.length == 0) + { + return ast; + } + auto a0_sym = cast(MalSymbol) aste[0]; + auto sym_name = a0_sym is null ? "" : a0_sym.name; + switch (sym_name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(aste[1]); + return env.set(a1.name, EVAL(aste[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(aste[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + ast = aste[2]; + env = let_env; + continue; // TCO + + case "do": + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + ast = aste[$-1]; + continue; // TCO + + case "if": + auto cond = EVAL(aste[1], env); + if (cond.is_truthy()) + { + ast = aste[2]; + continue; // TCO + } + else + if (aste.length > 3) + { + ast = aste[3]; + continue; // TCO + } + else + { + return mal_nil; + } + + case "fn*": + auto args_list = verify_cast!MalSequential(aste[1]); + return new MalFunc(args_list.elements, aste[2], env); + + default: + auto first = EVAL(aste[0], env); + auto rest = array(aste[1..$].map!(e => EVAL(e, env))); + if (auto funcobj = cast(MalFunc)first) + { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = funcobj.func_body; + env = callenv; + continue; // TCO + } + else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) + { + return builtinfuncobj.fn(rest); + } + else + { + throw new Exception("Expected a function"); + } + } + } + else + { + return ast; + } + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +MalType re(string str, Env env) +{ + return EVAL(READ(str), env); +} + +string rep(string str, Env env) +{ + return PRINT(re(str, env)); +} + +void main() +{ + auto repl_env = new Env(null); + foreach (string sym_name, BuiltinStaticFuncType f; core_ns) + { + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); + } + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step6_file.d b/impls/d/step6_file.d new file mode 100644 index 0000000000..38a712581b --- /dev/null +++ b/impls/d/step6_file.d @@ -0,0 +1,203 @@ +module main; + +import std.algorithm; +import std.array; +import std.range; +import std.stdio; +import std.string; +import core.stdc.stdlib; +import env; +import mal_core; +import readline; +import reader; +import printer; +import types; + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + for (;;) + { + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + else if (auto ast_list = cast(MalList)ast) + { + auto aste = ast_list.elements; + if (aste.length == 0) + { + return ast; + } + auto a0_sym = cast(MalSymbol) aste[0]; + auto sym_name = a0_sym is null ? "" : a0_sym.name; + switch (sym_name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(aste[1]); + return env.set(a1.name, EVAL(aste[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(aste[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + ast = aste[2]; + env = let_env; + continue; // TCO + + case "do": + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + ast = aste[$-1]; + continue; // TCO + + case "if": + auto cond = EVAL(aste[1], env); + if (cond.is_truthy()) + { + ast = aste[2]; + continue; // TCO + } + else + if (aste.length > 3) + { + ast = aste[3]; + continue; // TCO + } + else + { + return mal_nil; + } + + case "fn*": + auto args_list = verify_cast!MalSequential(aste[1]); + return new MalFunc(args_list.elements, aste[2], env); + + default: + auto first = EVAL(aste[0], env); + auto rest = array(aste[1..$].map!(e => EVAL(e, env))); + if (auto funcobj = cast(MalFunc)first) + { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = funcobj.func_body; + env = callenv; + continue; // TCO + } + else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) + { + return builtinfuncobj.fn(rest); + } + else + { + throw new Exception("Expected a function"); + } + } + } + else + { + return ast; + } + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +MalType re(string str, Env env) +{ + return EVAL(READ(str), env); +} + +string rep(string str, Env env) +{ + return PRINT(re(str, env)); +} + +static MalList create_argv_list(string[] args) +{ + if (args.length <= 2) return new MalList([]); + return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); +} + +void main(string[] args) +{ + Env repl_env = new Env(null); + foreach (string sym_name, BuiltinStaticFuncType f; core_ns) + { + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); + } + + BuiltinFuncType eval_func = (a ...) { + verify_args_count(a, 1); + return EVAL(a[0], repl_env); + }; + repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); + repl_env.set("*ARGV*", create_argv_list(args)); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + + if (args.length > 1) + { + try + { + rep("(load-file \"" ~ args[1] ~ "\")", repl_env); + return; + } + catch (Exception e) + { + writeln("Error: ", e.msg); + exit(1); + } + } + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step7_quote.d b/impls/d/step7_quote.d new file mode 100644 index 0000000000..f9217c2542 --- /dev/null +++ b/impls/d/step7_quote.d @@ -0,0 +1,242 @@ +module main; + +import std.algorithm; +import std.array; +import std.range; +import std.stdio; +import std.string; +import core.stdc.stdlib; +import env; +import mal_core; +import readline; +import reader; +import printer; +import types; + +bool starts_with(MalType ast, MalSymbol sym) +{ + auto lst = cast(MalList) ast; + if (lst is null) return false; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; +} + +MalType quasiquote(MalType ast) +{ + if (cast(MalSymbol)ast || cast(MalHashmap)ast) + return new MalList([sym_quote, ast]); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + + auto aste = ast_seq.elements; + if (starts_with(ast, sym_unquote)) + return aste[1]; + + MalType res = new MalList([]); + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; +} + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + for (;;) + { + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + else if (auto ast_list = cast(MalList)ast) + { + auto aste = ast_list.elements; + if (aste.length == 0) + { + return ast; + } + auto a0_sym = cast(MalSymbol) aste[0]; + auto sym_name = a0_sym is null ? "" : a0_sym.name; + switch (sym_name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(aste[1]); + return env.set(a1.name, EVAL(aste[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(aste[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + ast = aste[2]; + env = let_env; + continue; // TCO + + case "quote": + return aste[1]; + + case "quasiquote": + ast = quasiquote(aste[1]); + continue; // TCO + + case "do": + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + ast = aste[$-1]; + continue; // TCO + + case "if": + auto cond = EVAL(aste[1], env); + if (cond.is_truthy()) + { + ast = aste[2]; + continue; // TCO + } + else + if (aste.length > 3) + { + ast = aste[3]; + continue; // TCO + } + else + { + return mal_nil; + } + + case "fn*": + auto args_list = verify_cast!MalSequential(aste[1]); + return new MalFunc(args_list.elements, aste[2], env); + + default: + auto first = EVAL(aste[0], env); + auto rest = array(aste[1..$].map!(e => EVAL(e, env))); + if (auto funcobj = cast(MalFunc)first) + { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = funcobj.func_body; + env = callenv; + continue; // TCO + } + else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) + { + return builtinfuncobj.fn(rest); + } + else + { + throw new Exception("Expected a function"); + } + } + } + else + { + return ast; + } + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +MalType re(string str, Env env) +{ + return EVAL(READ(str), env); +} + +string rep(string str, Env env) +{ + return PRINT(re(str, env)); +} + +static MalList create_argv_list(string[] args) +{ + if (args.length <= 2) return new MalList([]); + return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); +} + +void main(string[] args) +{ + Env repl_env = new Env(null); + foreach (string sym_name, BuiltinStaticFuncType f; core_ns) + { + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); + } + + BuiltinFuncType eval_func = (a ...) { + verify_args_count(a, 1); + return EVAL(a[0], repl_env); + }; + repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); + repl_env.set("*ARGV*", create_argv_list(args)); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + + if (args.length > 1) + { + try + { + rep("(load-file \"" ~ args[1] ~ "\")", repl_env); + return; + } + catch (Exception e) + { + writeln("Error: ", e.msg); + exit(1); + } + } + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step8_macros.d b/impls/d/step8_macros.d new file mode 100644 index 0000000000..9faf41aed7 --- /dev/null +++ b/impls/d/step8_macros.d @@ -0,0 +1,257 @@ +module main; + +import std.algorithm; +import std.array; +import std.range; +import std.stdio; +import std.string; +import core.stdc.stdlib; +import env; +import mal_core; +import readline; +import reader; +import printer; +import types; + +bool starts_with(MalType ast, MalSymbol sym) +{ + auto lst = cast(MalList) ast; + if (lst is null) return false; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; +} + +MalType quasiquote(MalType ast) +{ + if (cast(MalSymbol)ast || cast(MalHashmap)ast) + return new MalList([sym_quote, ast]); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + + auto aste = ast_seq.elements; + if (starts_with(ast, sym_unquote)) + return aste[1]; + + MalType res = new MalList([]); + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; +} + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + for (;;) + { + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + else if (auto ast_list = cast(MalList)ast) + { + auto aste = ast_list.elements; + if (aste.length == 0) + { + return ast; + } + auto a0_sym = cast(MalSymbol) aste[0]; + auto sym_name = a0_sym is null ? "" : a0_sym.name; + switch (sym_name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(aste[1]); + return env.set(a1.name, EVAL(aste[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(aste[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + ast = aste[2]; + env = let_env; + continue; // TCO + + case "quote": + return aste[1]; + + case "quasiquote": + ast = quasiquote(aste[1]); + continue; // TCO + + case "defmacro!": + auto a1 = verify_cast!MalSymbol(aste[1]); + auto mac = verify_cast!MalFunc(EVAL(aste[2], env)); + mac = new MalFunc(mac.arg_names, mac.func_body, mac.def_env); + mac.is_macro = true; + return env.set(a1.name, mac); + + case "do": + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + ast = aste[$-1]; + continue; // TCO + + case "if": + auto cond = EVAL(aste[1], env); + if (cond.is_truthy()) + { + ast = aste[2]; + continue; // TCO + } + else + if (aste.length > 3) + { + ast = aste[3]; + continue; // TCO + } + else + { + return mal_nil; + } + + case "fn*": + auto args_list = verify_cast!MalSequential(aste[1]); + return new MalFunc(args_list.elements, aste[2], env); + + default: + auto first = EVAL(aste[0], env); + auto rest = aste[1..$]; + if (auto funcobj = cast(MalFunc)first) + { + if (funcobj.is_macro) { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = EVAL(funcobj.func_body, callenv); + continue; // TCO + } + rest = array(rest.map!(e => EVAL(e, env))); + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = funcobj.func_body; + env = callenv; + continue; // TCO + } + else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) + { + rest = array(rest.map!(e => EVAL(e, env))); + return builtinfuncobj.fn(rest); + } + else + { + throw new Exception("Expected a function"); + } + } + } + else + { + return ast; + } + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +MalType re(string str, Env env) +{ + return EVAL(READ(str), env); +} + +string rep(string str, Env env) +{ + return PRINT(re(str, env)); +} + +static MalList create_argv_list(string[] args) +{ + if (args.length <= 2) return new MalList([]); + return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); +} + +void main(string[] args) +{ + Env repl_env = new Env(null); + foreach (string sym_name, BuiltinStaticFuncType f; core_ns) + { + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); + } + + BuiltinFuncType eval_func = (a ...) { + verify_args_count(a, 1); + return EVAL(a[0], repl_env); + }; + repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); + repl_env.set("*ARGV*", create_argv_list(args)); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + if (args.length > 1) + { + try + { + rep("(load-file \"" ~ args[1] ~ "\")", repl_env); + return; + } + catch (Exception e) + { + writeln("Error: ", e.msg); + exit(1); + } + } + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/step9_try.d b/impls/d/step9_try.d new file mode 100644 index 0000000000..be38cfb754 --- /dev/null +++ b/impls/d/step9_try.d @@ -0,0 +1,290 @@ +module main; + +import std.algorithm; +import std.array; +import std.range; +import std.stdio; +import std.string; +import core.stdc.stdlib; +import env; +import mal_core; +import readline; +import reader; +import printer; +import types; + +bool starts_with(MalType ast, MalSymbol sym) +{ + auto lst = cast(MalList) ast; + if (lst is null) return false; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; +} + +MalType quasiquote(MalType ast) +{ + if (cast(MalSymbol)ast || cast(MalHashmap)ast) + return new MalList([sym_quote, ast]); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + + auto aste = ast_seq.elements; + if (starts_with(ast, sym_unquote)) + return aste[1]; + + MalType res = new MalList([]); + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; +} + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + for (;;) + { + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + else if (auto ast_list = cast(MalList)ast) + { + auto aste = ast_list.elements; + if (aste.length == 0) + { + return ast; + } + auto a0_sym = cast(MalSymbol) aste[0]; + auto sym_name = a0_sym is null ? "" : a0_sym.name; + switch (sym_name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(aste[1]); + return env.set(a1.name, EVAL(aste[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(aste[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + ast = aste[2]; + env = let_env; + continue; // TCO + + case "quote": + return aste[1]; + + case "quasiquote": + ast = quasiquote(aste[1]); + continue; // TCO + + case "defmacro!": + auto a1 = verify_cast!MalSymbol(aste[1]); + auto mac = verify_cast!MalFunc(EVAL(aste[2], env)); + mac = new MalFunc(mac.arg_names, mac.func_body, mac.def_env); + mac.is_macro = true; + return env.set(a1.name, mac); + + case "try*": + if (aste.length < 2) return mal_nil; + if (aste.length < 3) + { + ast = aste[1]; + continue; // TCO + } + MalType exc; + try + { + // d seems to do erroneous tco all by itself without this + // little distraction + pr_str(aste[1]); + return EVAL(aste[1], env); + } + catch (MalException e) + { + exc = e.data; + } + catch (Exception e) + { + exc = new MalString(e.msg); + } + auto catch_clause = verify_cast!MalList(aste[2]); + auto catch_env = new Env(env, [catch_clause.elements[1]], [exc]); + ast = catch_clause.elements[2]; + env = catch_env; + continue; // TCO + + case "do": + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + ast = aste[$-1]; + continue; // TCO + + case "if": + auto cond = EVAL(aste[1], env); + if (cond.is_truthy()) + { + ast = aste[2]; + continue; // TCO + } + else + if (aste.length > 3) + { + ast = aste[3]; + continue; // TCO + } + else + { + return mal_nil; + } + + case "fn*": + auto args_list = verify_cast!MalSequential(aste[1]); + return new MalFunc(args_list.elements, aste[2], env); + + default: + auto first = EVAL(aste[0], env); + auto rest = aste[1..$]; + if (auto funcobj = cast(MalFunc)first) + { + if (funcobj.is_macro) { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = EVAL(funcobj.func_body, callenv); + continue; // TCO + } + rest = array(rest.map!(e => EVAL(e, env))); + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = funcobj.func_body; + env = callenv; + continue; // TCO + } + else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) + { + rest = array(rest.map!(e => EVAL(e, env))); + return builtinfuncobj.fn(rest); + } + else + { + throw new Exception("Expected a function"); + } + } + } + else + { + return ast; + } + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +MalType re(string str, Env env) +{ + return EVAL(READ(str), env); +} + +string rep(string str, Env env) +{ + return PRINT(re(str, env)); +} + +static MalList create_argv_list(string[] args) +{ + if (args.length <= 2) return new MalList([]); + return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); +} + +void main(string[] args) +{ + Env repl_env = new Env(null); + foreach (string sym_name, BuiltinStaticFuncType f; core_ns) + { + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); + } + + BuiltinFuncType eval_func = (a ...) { + verify_args_count(a, 1); + return EVAL(a[0], repl_env); + }; + repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); + repl_env.set("*ARGV*", create_argv_list(args)); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + if (args.length > 1) + { + try + { + rep("(load-file \"" ~ args[1] ~ "\")", repl_env); + return; + } + catch (Exception e) + { + writeln("Error: ", e.msg); + exit(1); + } + } + + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (MalException e) + { + writeln("Error: ", pr_str(e.data)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/stepA_mal.d b/impls/d/stepA_mal.d new file mode 100644 index 0000000000..d354718bb2 --- /dev/null +++ b/impls/d/stepA_mal.d @@ -0,0 +1,293 @@ +module main; + +import std.algorithm; +import std.compiler; +import std.array; +import std.range; +import std.stdio; +import std.string; +import core.stdc.stdlib; +import env; +import mal_core; +import readline; +import reader; +import printer; +import types; + +bool starts_with(MalType ast, MalSymbol sym) +{ + auto lst = cast(MalList) ast; + if (lst is null) return false; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; +} + +MalType quasiquote(MalType ast) +{ + if (cast(MalSymbol)ast || cast(MalHashmap)ast) + return new MalList([sym_quote, ast]); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + + auto aste = ast_seq.elements; + if (starts_with(ast, sym_unquote)) + return aste[1]; + + MalType res = new MalList([]); + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; +} + +MalType READ(string str) +{ + return read_str(str); +} + +MalType EVAL(MalType ast, Env env) +{ + for (;;) + { + if (auto dbgeval = env.get("DEBUG-EVAL")) + if (dbgeval.is_truthy()) + writeln("EVAL: ", pr_str(ast)); + + if (auto sym = cast(MalSymbol)ast) + { + if (auto val = env.get(sym.name)) + return val; + else + throw new Exception("'" ~ sym.name ~ "' not found"); + } + else if (auto lst = cast(MalVector)ast) + { + auto el = array(lst.elements.map!(e => EVAL(e, env))); + return new MalVector(el); + } + else if (auto hm = cast(MalHashmap)ast) + { + typeof(hm.data) new_data; + foreach (string k, MalType v; hm.data) + { + new_data[k] = EVAL(v, env); + } + return new MalHashmap(new_data); + } + else if (auto ast_list = cast(MalList)ast) + { + auto aste = ast_list.elements; + if (aste.length == 0) + { + return ast; + } + auto a0_sym = cast(MalSymbol) aste[0]; + auto sym_name = a0_sym is null ? "" : a0_sym.name; + switch (sym_name) + { + case "def!": + auto a1 = verify_cast!MalSymbol(aste[1]); + return env.set(a1.name, EVAL(aste[2], env)); + + case "let*": + auto a1 = verify_cast!MalSequential(aste[1]); + auto let_env = new Env(env); + foreach (kv; chunks(a1.elements, 2)) + { + if (kv.length < 2) throw new Exception("let* requires even number of elements"); + auto var_name = verify_cast!MalSymbol(kv[0]); + let_env.set(var_name.name, EVAL(kv[1], let_env)); + } + ast = aste[2]; + env = let_env; + continue; // TCO + + case "quote": + return aste[1]; + + case "quasiquote": + ast = quasiquote(aste[1]); + continue; // TCO + + case "defmacro!": + auto a1 = verify_cast!MalSymbol(aste[1]); + auto mac = verify_cast!MalFunc(EVAL(aste[2], env)); + mac = new MalFunc(mac.arg_names, mac.func_body, mac.def_env); + mac.is_macro = true; + return env.set(a1.name, mac); + + case "try*": + if (aste.length < 2) return mal_nil; + if (aste.length < 3) + { + ast = aste[1]; + continue; // TCO + } + MalType exc; + try + { + // d seems to do erroneous tco all by itself without this + // little distraction + pr_str(aste[1]); + return EVAL(aste[1], env); + } + catch (MalException e) + { + exc = e.data; + } + catch (Exception e) + { + exc = new MalString(e.msg); + } + auto catch_clause = verify_cast!MalList(aste[2]); + auto catch_env = new Env(env, [catch_clause.elements[1]], [exc]); + ast = catch_clause.elements[2]; + env = catch_env; + continue; // TCO + + case "do": + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } + ast = aste[$-1]; + continue; // TCO + + case "if": + auto cond = EVAL(aste[1], env); + if (cond.is_truthy()) + { + ast = aste[2]; + continue; // TCO + } + else + if (aste.length > 3) + { + ast = aste[3]; + continue; // TCO + } + else + { + return mal_nil; + } + + case "fn*": + auto args_list = verify_cast!MalSequential(aste[1]); + return new MalFunc(args_list.elements, aste[2], env); + + default: + auto first = EVAL(aste[0], env); + auto rest = aste[1..$]; + if (auto funcobj = cast(MalFunc)first) + { + if (funcobj.is_macro) { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = EVAL(funcobj.func_body, callenv); + continue; // TCO + } + rest = array(rest.map!(e => EVAL(e, env))); + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = funcobj.func_body; + env = callenv; + continue; // TCO + } + else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) + { + rest = array(rest.map!(e => EVAL(e, env))); + return builtinfuncobj.fn(rest); + } + else + { + throw new Exception("Expected a function"); + } + } + } + else + { + return ast; + } + } +} + +string PRINT(MalType ast) +{ + return pr_str(ast); +} + +MalType re(string str, Env env) +{ + return EVAL(READ(str), env); +} + +string rep(string str, Env env) +{ + return PRINT(re(str, env)); +} + +static MalList create_argv_list(string[] args) +{ + if (args.length <= 2) return new MalList([]); + return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); +} + +void main(string[] args) +{ + Env repl_env = new Env(null); + foreach (string sym_name, BuiltinStaticFuncType f; core_ns) + { + repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); + } + + BuiltinFuncType eval_func = (a ...) { + verify_args_count(a, 1); + return EVAL(a[0], repl_env); + }; + repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); + repl_env.set("*ARGV*", create_argv_list(args)); + + // core.mal: defined using the language itself + re("(def! *host-language* \"" ~ std.compiler.name ~ "\")", repl_env); + re("(def! not (fn* (a) (if a false true)))", repl_env); + re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + if (args.length > 1) + { + try + { + rep("(load-file \"" ~ args[1] ~ "\")", repl_env); + return; + } + catch (Exception e) + { + writeln("Error: ", e.msg); + exit(1); + } + } + + re("(println (str \"Mal [\" *host-language* \"]\"))", repl_env); + for (;;) + { + string line = _readline("user> "); + if (line is null) break; + if (line.length == 0) continue; + try + { + writeln(rep(line, repl_env)); + } + catch (MalException e) + { + writeln("Error: ", pr_str(e.data)); + } + catch (Exception e) + { + writeln("Error: ", e.msg); + } + } + writeln(""); +} diff --git a/impls/d/tests/step5_tco.mal b/impls/d/tests/step5_tco.mal new file mode 100644 index 0000000000..de8bbcb6b9 --- /dev/null +++ b/impls/d/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; D: skipping non-TCO recursion +;; Reason: completes at 10,000, segfaults at 40,000 diff --git a/impls/d/types.d b/impls/d/types.d new file mode 100644 index 0000000000..b140eb7fe3 --- /dev/null +++ b/impls/d/types.d @@ -0,0 +1,454 @@ +import std.algorithm; +import std.array; +import std.conv; +import std.functional; +import std.range; +import env; + +abstract class MalType +{ + string print(bool readable) const; + bool is_truthy() const { return true; } +} + +interface MalMeta +{ + MalType meta(); + MalType with_meta(MalType new_meta); +} + +interface HasSeq +{ + MalType seq(); +} + +class MalNil : MalType, HasSeq +{ + override string print(bool readable) const { return "nil"; } + override bool is_truthy() const { return false; } + override bool opEquals(Object o) { return (cast(MalNil)(o) !is null); } + override MalType seq() { return this; } +} + +class MalFalse : MalType +{ + override string print(bool readable) const { return "false"; } + override bool is_truthy() const { return false; } + override bool opEquals(Object o) { return (cast(MalFalse)(o) !is null); } +} + +class MalTrue : MalType +{ + override string print(bool readable) const { return "true"; } + override bool opEquals(Object o) { return (cast(MalTrue)(o) !is null); } +} + +MalNil mal_nil; +MalFalse mal_false; +MalTrue mal_true; + +static this() +{ + mal_nil = new MalNil; + mal_false = new MalFalse; + mal_true = new MalTrue; +} + +MalType bool_to_mal(in bool b) +{ + return b ? mal_true : mal_false; +} + +class MalSymbol : MalType +{ + const string name; + this(in string token) { name = token; } + override string print(bool readable) const { return name; } + + override size_t toHash() + { + return typeid(name).getHash(&name); + } + + override int opCmp(Object other) + { + MalSymbol o = cast(MalSymbol) other; + return cmp(name, o.name); + } + + override bool opEquals(Object other) + { + auto o = cast(MalSymbol) other; + return (o !is null && name == o.name); + } +} + +class MalInteger : MalType +{ + const long val; + this(string token) { val = to!long(token); } + this(long v) { val = v; } + override string print(bool readable) const { return to!string(val); } + + override bool opEquals(Object o) + { + auto oint = cast(MalInteger)(o); + return (oint !is null && val == oint.val); + } +} + +class MalString : MalType, HasSeq +{ + const string val; + this(in string token) { val = token; } + override string print(bool readable) const + { + if (is_keyword()) return ":" ~ val[2..$]; + if (readable) + { + string escaped = val.replace("\\", "\\\\") + .replace("\"", "\\\"") + .replace("\n", "\\n"); + return "\"" ~ escaped ~ "\""; + } + else + { + return val; + } + } + + bool is_keyword() const + { + return val.length > 1 && val[0..2] == "\u029e"; + } + + override bool opEquals(Object o) + { + auto ostr = cast(MalString)(o); + return (ostr !is null && val == ostr.val); + } + + override MalType seq() { + if (is_keyword() || val.length == 0) return mal_nil; + auto chars = val.map!(c => cast(MalType)(new MalString(to!string(c)))); + return new MalList(array(chars)); + } +} + +abstract class MalSequential : MalType, HasSeq, MalMeta +{ + MalType[] elements; + MalType meta_val; + + this(MalType[] lst) { + elements = lst; + meta_val = mal_nil; + } + + override bool opEquals(Object o) + { + auto oseq = cast(MalSequential)(o); + return (oseq !is null && elements == oseq.elements); + } + + MalSequential conj(MalType element); + + MalType seq() { + if (elements.length == 0) return mal_nil; + return new MalList(elements); + } +} + +class MalList : MalSequential, MalMeta +{ + this(MalType[] lst) { super(lst); } + this(MalList that, MalType new_meta) + { + super(that.elements); + meta_val = new_meta; + } + + override string print(bool readable) const + { + auto items_strs = elements.map!(e => e.print(readable)); + return "(" ~ array(items_strs).join(" ") ~ ")"; + } + + override MalSequential conj(MalType element) + { + return new MalList([element] ~ elements); + } + + override MalType meta() { return meta_val; } + override MalType with_meta(MalType new_meta) + { + return new MalList(this, new_meta); + } +} + +class MalVector : MalSequential, MalMeta +{ + this(MalType[] lst) { super(lst); } + this(MalVector that, MalType new_meta) + { + super(that.elements); + meta_val = new_meta; + } + + override string print(bool readable) const + { + auto items_strs = elements.map!(e => e.print(readable)); + return "[" ~ array(items_strs).join(" ") ~ "]"; + } + + override MalSequential conj(MalType element) + { + return new MalVector(elements ~ [element]); + } + + override MalType meta() { return meta_val; } + override MalType with_meta(MalType new_meta) + { + return new MalVector(this, new_meta); + } +} + +class MalHashmap : MalType, MalMeta +{ + MalType[string] data; + MalType meta_val; + + this(MalType[string] map) + { + data = map; + meta_val = mal_nil; + } + this(MalType[] lst) + { + put_kv_list(lst); + meta_val = mal_nil; + } + this(MalHashmap that, MalType new_meta) + { + data = that.data; + meta_val = new_meta; + } + + bool contains(in MalType key) + { + auto valp = (make_hash_key(key) in data); + return valp !is null; + } + + MalType get(in MalType key) + { + auto valp = (make_hash_key(key) in data); + return valp is null ? mal_nil : *valp; + } + + void remove(in MalType key) + { + data.remove(make_hash_key(key)); + } + + void put(in MalType key, MalType val) + { + data[make_hash_key(key)] = val; + } + + void put_kv_list(MalType[] lst) + { + foreach (kv; chunks(lst, 2)) + { + if (kv.length < 2) throw new Exception("requires even number of elements"); + put(kv[0], kv[1]); + } + } + + private string make_hash_key(in MalType key) + { + return verify_cast!MalString(key).val; + } + + override string print(bool readable) const + { + string[] parts; + foreach (k, v; data) + { + parts ~= (new MalString(k)).print(readable); + parts ~= v.print(readable); + } + return "{" ~ parts.join(" ") ~ "}"; + } + + override bool opEquals(Object o) + { + auto ohm = cast(MalHashmap)(o); + return (ohm !is null && data == ohm.data); + } + + override MalType meta() { return meta_val; } + override MalType with_meta(MalType new_meta) + { + return new MalHashmap(this, new_meta); + } +} + +alias BuiltinStaticFuncType = MalType function(MalType[] a ...); +alias BuiltinFuncType = MalType delegate(MalType[] a ...); + +class MalBuiltinFunc : MalType, MalMeta +{ + const BuiltinFuncType fn; + const string name; + MalType meta_val; + + this(in BuiltinFuncType fn_v, in string name_v) + { + fn = fn_v; + name = name_v; + meta_val = mal_nil; + } + + this(in BuiltinStaticFuncType static_fn_v, in string name_v) + { + fn = toDelegate(static_fn_v); + name = name_v; + meta_val = mal_nil; + } + + this(MalBuiltinFunc that, MalType new_meta) + { + fn = that.fn; + name = that.name; + meta_val = new_meta; + } + + override string print(bool readable) const + { + return ""; + } + + override MalType meta() { return meta_val; } + + override MalType with_meta(MalType new_meta) + { + return new MalBuiltinFunc(this, new_meta); + } +} + +class MalFunc : MalType, MalMeta +{ + MalType[] arg_names; + MalType func_body; + Env def_env; + bool is_macro; + MalType meta_val; + + this(MalType[] arg_names_v, MalType func_body_v, Env def_env_v) + { + arg_names = arg_names_v; + func_body = func_body_v; + def_env = def_env_v; + is_macro = false; + meta_val = mal_nil; + } + + this(MalFunc that, MalType new_meta) + { + arg_names = that.arg_names; + func_body = that.func_body; + def_env = that.def_env; + is_macro = that.is_macro; + meta_val = new_meta; + } + + override string print(bool readable) const + { + return " e.print(true))).join(",") ~ ">"; + } + + override MalType meta() { return meta_val; } + + override MalType with_meta(MalType new_meta) + { + return new MalFunc(this, new_meta); + } +} + +class MalAtom : MalType, MalMeta +{ + MalType val; + MalType meta_val; + + this(MalType v) + { + val = v; + meta_val = mal_nil; + } + + this(MalAtom that, MalType new_meta) + { + val = that.val; + meta_val = new_meta; + } + + override string print(bool readable) const + { + return "(atom " ~ val.print(readable) ~ ")"; + } + + override bool opEquals(Object other) + { + auto o = cast(MalAtom) other; + return (o !is null && val == o.val); + } + + override MalType meta() { return meta_val; } + + override MalType with_meta(MalType new_meta) + { + return new MalAtom(this, new_meta); + } +} + +class MalException : Exception +{ + MalType data; + + this(MalType val) + { + super("MalException"); + data = val; + } +} + +T verify_cast(T)(in MalType v) +{ + if (T res = cast(T) v) return res; + throw new Exception("Expected " ~ typeid(T).name); +} + +MalType mal_type_q(T)(in MalType[] a) +{ + verify_args_count(a, 1); + T res = cast(T) a[0]; + return bool_to_mal(res !is null); +} + +inout(MalType[]) verify_args_count(inout MalType[] args, in int expected_length) +{ + if (args.length != expected_length) + { + throw new Exception("Expected " ~ to!string(expected_length) ~ " arguments"); + } + return args; +} + +void verify_min_args_count(in MalType[] args, in int min_expected_length) +{ + if (args.length < min_expected_length) + { + throw new Exception("Expected at least " ~ to!string(min_expected_length) ~ " arguments"); + } +} diff --git a/impls/dart/.analysis_options b/impls/dart/.analysis_options new file mode 100644 index 0000000000..4a23f8bf57 --- /dev/null +++ b/impls/dart/.analysis_options @@ -0,0 +1,7 @@ +analyzer: + strong-mode: true + exclude: + - step2_eval.dart + - step3_env.dart + - step4_if_fn_do.dart + - step5_tco.dart diff --git a/impls/dart/.packages b/impls/dart/.packages new file mode 100644 index 0000000000..92024203bd --- /dev/null +++ b/impls/dart/.packages @@ -0,0 +1,2 @@ +# Generated by pub on 2016-08-20 13:39:08.695546. +mal:lib/ diff --git a/impls/dart/Dockerfile b/impls/dart/Dockerfile new file mode 100644 index 0000000000..0b3602f377 --- /dev/null +++ b/impls/dart/Dockerfile @@ -0,0 +1,29 @@ +FROM ubuntu:vivid +MAINTAINER Harry Terkelsen + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install apt-transport-https +RUN curl https://dl-ssl.google.com/linux/linux_signing_key.pub | apt-key add - +RUN curl https://storage.googleapis.com/download.dartlang.org/linux/debian/dart_stable.list > /etc/apt/sources.list.d/dart_stable.list +RUN apt-get -y update + +RUN apt-get -y install dart diff --git a/impls/dart/Makefile b/impls/dart/Makefile new file mode 100644 index 0000000000..b3c660f49d --- /dev/null +++ b/impls/dart/Makefile @@ -0,0 +1,5 @@ +all: + @true + + +clean: diff --git a/impls/dart/core.dart b/impls/dart/core.dart new file mode 100644 index 0000000000..e5620f4691 --- /dev/null +++ b/impls/dart/core.dart @@ -0,0 +1,303 @@ +import 'dart:io'; + +import 'printer.dart'; +import 'reader.dart' as reader; +import 'types.dart'; + +Map ns = { + '+': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value + b.value); + }), + '-': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value - b.value); + }), + '*': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value * b.value); + }), + '/': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value ~/ b.value); + }), + 'list': + new MalBuiltin((List args) => new MalList(args.toList())), + 'list?': new MalBuiltin( + (List args) => new MalBool(args.single is MalList)), + 'empty?': new MalBuiltin((List args) { + var a = args.single as MalIterable; + return new MalBool(a.elements.isEmpty); + }), + 'count': new MalBuiltin((List args) { + var a = args.first as MalIterable; + return new MalInt(a.elements.length); + }), + '=': new MalBuiltin((List args) { + var a = args[0]; + var b = args[1]; + return new MalBool(a == b); + }), + '<': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalBool(a.value < b.value); + }), + '<=': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalBool(a.value <= b.value); + }), + '>': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalBool(a.value > b.value); + }), + '>=': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalBool(a.value >= b.value); + }), + 'pr-str': new MalBuiltin((List args) { + return new MalString( + args.map((a) => pr_str(a, print_readably: true)).join(' ')); + }), + 'str': new MalBuiltin((List args) { + return new MalString( + args.map((a) => pr_str(a, print_readably: false)).join()); + }), + 'prn': new MalBuiltin((List args) { + print(args.map((a) => pr_str(a, print_readably: true)).join(' ')); + return new MalNil(); + }), + 'println': new MalBuiltin((List args) { + print(args.map((a) => pr_str(a, print_readably: false)).join(' ')); + return new MalNil(); + }), + 'read-string': new MalBuiltin((List args) { + var code = args.single as MalString; + return reader.read_str(code.value); + }), + 'slurp': new MalBuiltin((List args) { + var fileName = args.single as MalString; + var file = new File(fileName.value); + return new MalString(file.readAsStringSync()); + }), + 'atom': new MalBuiltin((List args) { + var value = args.single; + return new MalAtom(value); + }), + 'atom?': new MalBuiltin((List args) { + var value = args.single; + return new MalBool(value is MalAtom); + }), + 'deref': new MalBuiltin((List args) { + var atom = args.single as MalAtom; + return atom.value; + }), + 'reset!': new MalBuiltin((List args) { + var atom = args[0] as MalAtom; + var newValue = args[1]; + atom.value = newValue; + return newValue; + }), + 'swap!': new MalBuiltin((List args) { + var atom = args[0] as MalAtom; + var func = args[1] as MalCallable; + var fnArgs = [atom.value]..addAll(args.sublist(2)); + var result = func.call(fnArgs); + atom.value = result; + return result; + }), + 'cons': new MalBuiltin((List args) { + var x = args[0]; + var xs = args[1] as MalIterable; + return new MalList([x]..addAll(xs)); + }), + 'concat': new MalBuiltin((List args) { + var results = []; + for (MalIterable element in args) { + results.addAll(element); + } + return new MalList(results); + }), + 'vec': new MalBuiltin((List args) { + if (args.length == 1) { + if (args[0] is MalVector) return args[0]; + if (args[0] is MalList) return new MalVector((args[0] as MalList).elements); + } + throw new MalException(new MalString("vec: wrong arguments")); + }), + 'nth': new MalBuiltin((List args) { + var indexable = args[0] as MalIterable; + var index = args[1] as MalInt; + try { + return indexable[index.value]; + } on RangeError catch (e) { + throw new MalException(new MalString(e.toString())); + } + }), + 'first': new MalBuiltin((List args) { + var list = args.first as MalIterable; + if (list.isEmpty) return new MalNil(); + return list.first; + }), + 'rest': new MalBuiltin((List args) { + var list = args.first as MalIterable; + if (list.isEmpty) return new MalList([]); + return new MalList(list.sublist(1)); + }), + 'throw': new MalBuiltin((List args) { + throw new MalException(args.first); + }), + 'nil?': new MalBuiltin((List args) { + return new MalBool(args.first is MalNil); + }), + 'true?': new MalBuiltin((List args) { + return new MalBool(args.first is MalBool && (args.first as MalBool).value); + }), + 'false?': new MalBuiltin((List args) { + return new MalBool(args.first is MalBool && !(args.first as MalBool).value); + }), + 'symbol': new MalBuiltin((List args) { + return new MalSymbol((args.first as MalString).value); + }), + 'symbol?': new MalBuiltin((List args) { + return new MalBool(args.first is MalSymbol); + }), + 'keyword': new MalBuiltin((List args) { + if (args.first is MalKeyword) return args.first; + return new MalKeyword((args.first as MalString).value); + }), + 'keyword?': new MalBuiltin((List args) { + return new MalBool(args.first is MalKeyword); + }), + 'number?': new MalBuiltin((List args) { + return new MalBool(args.first is MalInt); + }), + 'fn?': new MalBuiltin((List args) { + return new MalBool(args.first is MalCallable && !(args.first.isMacro)); + }), + 'macro?': new MalBuiltin((List args) { + return new MalBool(args.first is MalCallable && args.first.isMacro); + }), + 'vector': new MalBuiltin((List args) { + return new MalVector(args); + }), + 'vector?': new MalBuiltin((List args) { + return new MalBool(args.first is MalVector); + }), + 'hash-map': new MalBuiltin((List args) { + return new MalHashMap.fromSequence(args); + }), + 'map?': new MalBuiltin((List args) { + return new MalBool(args.first is MalHashMap); + }), + 'assoc': new MalBuiltin((List args) { + var map = args.first as MalHashMap; + var assoc = new MalHashMap.fromSequence(args.skip(1).toList()); + var newMap = new Map.from(map.value); + newMap.addAll(assoc.value); + return new MalHashMap(newMap); + }), + 'dissoc': new MalBuiltin((List args) { + var map = args.first as MalHashMap; + var newMap = new Map.from(map.value); + for (var key in args.skip(1)) { + newMap.remove(key); + } + return new MalHashMap(newMap); + }), + 'get': new MalBuiltin((List args) { + if (args[0] is MalNil) return new MalNil(); + var map = args[0] as MalHashMap; + var key = args[1]; + return map.value[key] ?? new MalNil(); + }), + 'contains?': new MalBuiltin((List args) { + var map = args[0] as MalHashMap; + var key = args[1]; + return new MalBool(map.value.containsKey(key)); + }), + 'keys': new MalBuiltin((List args) { + return new MalList((args.first as MalHashMap).value.keys.toList()); + }), + 'vals': new MalBuiltin((List args) { + return new MalList((args.first as MalHashMap).value.values.toList()); + }), + 'sequential?': new MalBuiltin((List args) { + return new MalBool(args.first is MalList || args.first is MalVector); + }), + 'readline': new MalBuiltin((List args) { + var message = args.first as MalString; + stdout.write(message.value); + var input = stdin.readLineSync(); + if (input == null) return new MalNil(); + return new MalString(input); + }), + 'time-ms': new MalBuiltin((List args) { + assert(args.isEmpty); + return new MalInt(new DateTime.now().millisecondsSinceEpoch); + }), + 'conj': new MalBuiltin((List args) { + var collection = args.first; + var elements = args.sublist(1); + if (collection is MalList) { + return new MalList( + elements.reversed.toList()..addAll(collection.elements)); + } + if (collection is MalVector) { + return new MalVector(collection.elements.toList()..addAll(elements)); + } + throw new MalException(new MalString('"conj" takes a list or vector')); + }), + 'string?': new MalBuiltin((List args) { + return new MalBool(args.first is MalString); + }), + 'seq': new MalBuiltin((List args) { + var arg = args.first; + if (arg is MalIterable && arg.isEmpty) return new MalNil(); + if (arg is MalString && arg.value.isEmpty) return new MalNil(); + + if (arg is MalNil || arg is MalList) return arg; + if (arg is MalVector) return new MalList(arg.elements.toList()); + if (arg is MalString) { + var chars = []; + for (var i = 0; i < arg.value.length; i++) { + chars.add(new MalString(arg.value[i])); + } + return new MalList(chars); + } + throw new MalException(new MalString('bad argument to "seq"')); + }), + 'map': new MalBuiltin((List args) { + var fn = args[0] as MalCallable; + var list = args[1] as MalIterable; + var newList = []; + for (var element in list) { + newList.add(fn.call([element])); + } + return new MalList(newList); + }), + 'apply': new MalBuiltin((List args) { + var func = args.first as MalCallable; + var argList = args.last as MalIterable; + var newArgs = args.sublist(1, args.length - 1); + newArgs.addAll(argList); + return func.call(newArgs); + }), + 'meta': new MalBuiltin((List args) { + var arg = args.first; + return arg.meta ?? new MalNil(); + }), + 'with-meta': new MalBuiltin((List args) { + var evaled = args.first; + var evaledWithMeta = evaled.clone(); + evaledWithMeta.meta = args[1]; + return evaledWithMeta; + }), +}; diff --git a/impls/dart/env.dart b/impls/dart/env.dart new file mode 100644 index 0000000000..75f54c47e5 --- /dev/null +++ b/impls/dart/env.dart @@ -0,0 +1,47 @@ +import 'types.dart'; + +class Env { + final Env outer; + + final data = {}; + + Env([this.outer, List binds, List exprs]) { + if (binds == null) { + assert(exprs == null); + } else { + assert(exprs != null && + (binds.length == exprs.length || binds.contains(new MalSymbol('&')))); + for (var i = 0; i < binds.length; i++) { + if (binds[i].value == '&') { + set(binds[i + 1].value, new MalList(exprs.sublist(i))); + break; + } + set(binds[i].value, exprs[i]); + } + } + } + + void set(String key, MalType value) { + data[key] = value; + } + + MalType get(String key) { + var value = data[key]; + if (value != null) { + return value; + } + if (outer != null) { + return outer.get(key); + } + return null; + } +} + +class NotFoundException implements Exception { + /// The name of the symbol that was not found. + final String value; + + NotFoundException(this.value); + + String toString() => "'$value' not found"; +} diff --git a/impls/dart/printer.dart b/impls/dart/printer.dart new file mode 100644 index 0000000000..472d9b7f0b --- /dev/null +++ b/impls/dart/printer.dart @@ -0,0 +1,47 @@ +import 'types.dart'; + +String pr_str(MalType data, {bool print_readably: true}) { + if (data is MalSymbol) { + return data.value; + } else if (data is MalInt) { + return '${data.value}'; + } else if (data is MalList) { + var printedElements = + data.elements.map((e) => pr_str(e, print_readably: print_readably)); + return '(${printedElements.join(" ")})'; + } else if (data is MalVector) { + var printedElements = + data.elements.map((e) => pr_str(e, print_readably: print_readably)); + return '[${printedElements.join(" ")}]'; + } else if (data is MalHashMap) { + var printedElements = []; + data.value.forEach((key, value) { + printedElements.add(pr_str(key, print_readably: print_readably)); + printedElements.add(pr_str(value, print_readably: print_readably)); + }); + return '{${printedElements.join(" ")}}'; + } else if (data is MalString) { + if (print_readably) { + var readableValue = data.value + .replaceAll('\\', r'\\') + .replaceAll('\n', r'\n') + .replaceAll('\"', r'\"'); + return '"$readableValue"'; + } else { + return '${data.value}'; + } + } else if (data is MalKeyword) { + return ':${data.value}'; + } else if (data is MalBool) { + return '${data.value}'; + } else if (data is MalNil) { + return 'nil'; + } else if (data is MalBuiltin) { + return '#'; + } else if (data is MalClosure) { + return '#'; + } else if (data is MalAtom) { + return "(atom ${pr_str(data.value, print_readably: print_readably)})"; + } + throw new ArgumentError("Unrecognized type: ${data.runtimeType}"); +} diff --git a/impls/dart/pubspec.lock b/impls/dart/pubspec.lock new file mode 100644 index 0000000000..655fcfbf0a --- /dev/null +++ b/impls/dart/pubspec.lock @@ -0,0 +1,4 @@ +# Generated by pub +# See http://pub.dartlang.org/doc/glossary.html#lockfile +packages: {} +sdk: any diff --git a/impls/dart/pubspec.yaml b/impls/dart/pubspec.yaml new file mode 100644 index 0000000000..4b09f91b79 --- /dev/null +++ b/impls/dart/pubspec.yaml @@ -0,0 +1,3 @@ +name: mal +author: Harry Terkelsen +version: 0.0.1 diff --git a/impls/dart/reader.dart b/impls/dart/reader.dart new file mode 100644 index 0000000000..b746f70d28 --- /dev/null +++ b/impls/dart/reader.dart @@ -0,0 +1,149 @@ +import 'types.dart'; + +final malRegExp = new RegExp( + r"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)"""); +final strRegExp = new RegExp( + r"""^"(?:\\.|[^\\"])*"$"""); + +class Reader { + final List tokens; + int _position = 0; + + Reader(this.tokens); + + String next() { + var token = peek(); + _position++; + return token; + } + + String peek() { + if (_position >= tokens.length) return null; + return tokens[_position]; + } +} + +class ParseException implements Exception { + final String message; + + ParseException(this.message); +} + +class NoInputException implements Exception {} + +MalType read_str(String code) { + var tokens = tokenizer(code); + if (tokens.isEmpty) { + throw new NoInputException(); + } + var reader = new Reader(tokens); + return read_form(reader); +} + +List tokenizer(String code) { + var matches = malRegExp.allMatches(code); + return matches + .map((m) => m.group(1)) + .where((token) => token.isNotEmpty && !token.startsWith(';')) + .toList(); +} + +MalType read_form(Reader reader) { + const macros = const { + "'": 'quote', + '`': 'quasiquote', + '~': 'unquote', + '~@': 'splice-unquote', + '@': 'deref', + '^': 'with-meta', + }; + const sequenceStarters = const {'(': ')', '[': ']', '{': '}'}; + var token = reader.peek(); + if (sequenceStarters.containsKey(token)) { + var elements = read_sequence(reader, token, sequenceStarters[token]); + if (token == '(') { + return new MalList(elements); + } + if (token == '[') { + return new MalVector(elements); + } + + if (token == '{') { + return new MalHashMap.fromSequence(elements); + } + + throw new StateError("Impossible!"); + } else if (macros.containsKey(token)) { + var macro = new MalSymbol(macros[token]); + reader.next(); + var form = read_form(reader); + if (token == '^') { + var meta = read_form(reader); + return new MalList([macro, meta, form]); + } else { + return new MalList([macro, form]); + } + } else { + return read_atom(reader); + } +} + +List read_sequence(Reader reader, String open, String close) { + // Consume opening token + var actualOpen = reader.next(); + assert(actualOpen == open); + + var elements = []; + for (var token = reader.peek();; token = reader.peek()) { + if (token == null) { + throw new ParseException("expected '$close', got EOF"); + } + if (token == close) break; + elements.add(read_form(reader)); + } + + var actualClose = reader.next(); + assert(actualClose == close); + + return elements; +} + +MalType read_atom(Reader reader) { + var token = reader.next(); + + var intAtom = int.parse(token, onError: (_) => null); + if (intAtom != null) { + return new MalInt(intAtom); + } + + if (strRegExp.matchAsPrefix(token) != null) { + var sanitizedToken = token + // remove surrounding quotes + .substring(1, token.length - 1) + .replaceAllMapped(new RegExp("\\\\(.)"), + (Match m) => m[1] == 'n' ? '\n' : m[1]); + return new MalString(sanitizedToken); + } + + if (token[0] == '"') { + throw new ParseException("expected '\"', got EOF"); + } + + if (token[0] == ':') { + return new MalKeyword(token.substring(1)); + } + + if (token == 'nil') { + return new MalNil(); + } + + if (token == 'true') { + return new MalBool(true); + } + + if (token == 'false') { + return new MalBool(false); + } + + return new MalSymbol(token); +} diff --git a/impls/dart/run b/impls/dart/run new file mode 100755 index 0000000000..6f3ab8bca3 --- /dev/null +++ b/impls/dart/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec dart --checked $(dirname $0)/${STEP:-stepA_mal}.dart "${@}" diff --git a/impls/dart/step0_repl.dart b/impls/dart/step0_repl.dart new file mode 100644 index 0000000000..3eb3414a71 --- /dev/null +++ b/impls/dart/step0_repl.dart @@ -0,0 +1,20 @@ +import 'dart:io'; + +String READ(String x) => x; + +String EVAL(String x) => x; + +String PRINT(String x) => x; + +String rep(String x) => PRINT(EVAL(READ(x))); + +const prompt = 'user> '; +main() { + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output = rep(input); + stdout.writeln(output); + } +} diff --git a/impls/dart/step1_read_print.dart b/impls/dart/step1_read_print.dart new file mode 100644 index 0000000000..5269bf2295 --- /dev/null +++ b/impls/dart/step1_read_print.dart @@ -0,0 +1,34 @@ +import 'dart:io'; + +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType x) => x; + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x))); +} + +const prompt = 'user> '; +main() { + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step2_eval.dart b/impls/dart/step2_eval.dart new file mode 100644 index 0000000000..b8efdb14d5 --- /dev/null +++ b/impls/dart/step2_eval.dart @@ -0,0 +1,98 @@ +import 'dart:io'; + +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Map replEnv = { + '+': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value + b.value); + }), + '-': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value - b.value); + }), + '*': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value * b.value); + }), + '/': new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value ~/ b.value); + }) +}; + +MalType READ(String x) => reader.read_str(x); + +class NotFoundException implements Exception { + /// The name of the symbol that was not found. + final String value; + + NotFoundException(this.value); +} + +MalType EVAL(MalType ast, Map env) { + // stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + + if (ast is MalSymbol) { + var result = env[ast.value]; + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + var forms = (ast as MalList).elements; + if (forms.isEmpty) { + return ast; + } else { + MalBuiltin f = EVAL(forms.first, env); + List args = forms.sublist(1).map((x) => EVAL(x, env)).toList(); + return f.call(args); + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main() { + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step3_env.dart b/impls/dart/step3_env.dart new file mode 100644 index 0000000000..f08f9c728e --- /dev/null +++ b/impls/dart/step3_env.dart @@ -0,0 +1,125 @@ +import 'dart:io'; + +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv() { + replEnv.set('+', new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value + b.value); + })); + replEnv.set('-', new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value - b.value); + })); + replEnv.set('*', new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value * b.value); + })); + replEnv.set('/', new MalBuiltin((List args) { + var a = args[0] as MalInt; + var b = args[1] as MalInt; + return new MalInt(a.value ~/ b.value); + })); +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).elements.isEmpty) { + return ast; + } else { + var list = ast as MalList; + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + return EVAL(args[1], newEnv); + } + } + MalBuiltin f = EVAL(list.elements.first, env); + List args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + return f.call(args); + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main() { + setupEnv(); + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step4_if_fn_do.dart b/impls/dart/step4_if_fn_do.dart new file mode 100644 index 0000000000..1ba094eed1 --- /dev/null +++ b/impls/dart/step4_if_fn_do.dart @@ -0,0 +1,142 @@ +import 'dart:io'; + +import 'core.dart'; +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv() { + ns.forEach((sym, fun) => replEnv.set(sym, fun)); + + rep('(def! not (fn* (a) (if a false true)))'); +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).elements.isEmpty) { + return ast; + } else { + var list = ast as MalList; + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + return EVAL(args[1], newEnv); + } else if (symbol.value == "do") { + return args.map((e) => EVAL(e, env)).toList().last; + } else if (symbol.value == "if") { + var condition = EVAL(args[0], env); + if (condition is MalNil || + condition is MalBool && condition.value == false) { + // False side of branch + if (args.length < 3) { + return new MalNil(); + } + return EVAL(args[2], env); + } else { + // True side of branch + return EVAL(args[1], env); + } + } else if (symbol.value == "fn*") { + var params = (args[0] as MalIterable) + .elements + .map((e) => e as MalSymbol) + .toList(); + return new MalClosure( + params, + args[1], + env, + (List funcArgs) => + EVAL(args[1], new Env(env, params, funcArgs))); + } + } + var f = EVAL(list.elements.first, env); + var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + if (f is MalCallable) { + return f.call(args); + } else { + throw 'bad!'; + } + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main() { + setupEnv(); + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on MalException catch (e) { + stdout.writeln("Error: ${printer.pr_str(e.value)}"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step5_tco.dart b/impls/dart/step5_tco.dart new file mode 100644 index 0000000000..2b3088ba23 --- /dev/null +++ b/impls/dart/step5_tco.dart @@ -0,0 +1,157 @@ +import 'dart:io'; + +import 'core.dart'; +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv() { + ns.forEach((sym, fun) => replEnv.set(sym, fun)); + + rep('(def! not (fn* (a) (if a false true)))'); +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + while (true) { + + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).elements.isEmpty) { + return ast; + } else { + var list = ast as MalList; + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + ast = args[1]; + env = newEnv; + continue; + } else if (symbol.value == "do") { + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } + ast = args.last; + continue; + } else if (symbol.value == "if") { + var condition = EVAL(args[0], env); + if (condition is MalNil || + condition is MalBool && condition.value == false) { + // False side of branch + if (args.length < 3) { + return new MalNil(); + } + ast = args[2]; + continue; + } else { + // True side of branch + ast = args[1]; + continue; + } + } else if (symbol.value == "fn*") { + var params = (args[0] as MalIterable) + .elements + .map((e) => e as MalSymbol) + .toList(); + return new MalClosure( + params, + args[1], + env, + (List funcArgs) => + EVAL(args[1], new Env(env, params, funcArgs))); + } + } + var f = EVAL(list.elements.first, env); + var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + if (f is MalBuiltin) { + return f.call(args); + } else if (f is MalClosure) { + ast = f.ast; + env = new Env(f.env, f.params, args); + continue; + } else { + throw 'bad!'; + } + } + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main() { + setupEnv(); + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on MalException catch (e) { + stdout.writeln("Error: ${printer.pr_str(e.value)}"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step6_file.dart b/impls/dart/step6_file.dart new file mode 100644 index 0000000000..156443186e --- /dev/null +++ b/impls/dart/step6_file.dart @@ -0,0 +1,170 @@ +import 'dart:io'; + +import 'core.dart'; +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv(List argv) { + // TODO(het): use replEnv#set once generalized tearoffs are implemented + ns.forEach((sym, fun) => replEnv.set(sym, fun)); + + replEnv.set('eval', + new MalBuiltin((List args) => EVAL(args.single, replEnv))); + + replEnv.set('*ARGV*', + new MalList(argv.map((s) => new MalString(s)).toList())); + + rep('(def! not (fn* (a) (if a false true)))'); + rep("(def! load-file " + "(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + while (true) { + + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).elements.isEmpty) { + return ast; + } else { + var list = ast as MalList; + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + ast = args[1]; + env = newEnv; + continue; + } else if (symbol.value == "do") { + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } + ast = args.last; + continue; + } else if (symbol.value == "if") { + var condition = EVAL(args[0], env); + if (condition is MalNil || + condition is MalBool && condition.value == false) { + // False side of branch + if (args.length < 3) { + return new MalNil(); + } + ast = args[2]; + continue; + } else { + // True side of branch + ast = args[1]; + continue; + } + } else if (symbol.value == "fn*") { + var params = (args[0] as MalIterable) + .elements + .map((e) => e as MalSymbol) + .toList(); + return new MalClosure( + params, + args[1], + env, + (List funcArgs) => + EVAL(args[1], new Env(env, params, funcArgs))); + } + } + var f = EVAL(list.elements.first, env); + var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + if (f is MalBuiltin) { + return f.call(args); + } else if (f is MalClosure) { + ast = f.ast; + env = new Env(f.env, f.params, args); + continue; + } else { + throw 'bad!'; + } + } + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main(List args) { + setupEnv(args.isEmpty ? const [] : args.sublist(1)); + if (args.isNotEmpty) { + rep("(load-file \"${args.first}\")"); + return; + } + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on MalException catch (e) { + stdout.writeln("Error: ${printer.pr_str(e.value)}"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step7_quote.dart b/impls/dart/step7_quote.dart new file mode 100644 index 0000000000..10cc424310 --- /dev/null +++ b/impls/dart/step7_quote.dart @@ -0,0 +1,205 @@ +import 'dart:io'; + +import 'core.dart'; +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv(List argv) { + // TODO(het): use replEnv#set once generalized tearoffs are implemented + ns.forEach((sym, fun) => replEnv.set(sym, fun)); + + replEnv.set('eval', + new MalBuiltin((List args) => EVAL(args.single, replEnv))); + + replEnv.set('*ARGV*', + new MalList(argv.map((s) => new MalString(s)).toList())); + + rep('(def! not (fn* (a) (if a false true)))'); + rep("(def! load-file " + "(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +} + +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} + +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList([new MalSymbol("quote"), ast]); + } else { + return ast; + } +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + while (true) { + + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).elements.isEmpty) { + return ast; + } else { + var list = ast as MalList; + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + ast = args[1]; + env = newEnv; + continue; + } else if (symbol.value == "do") { + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } + ast = args.last; + continue; + } else if (symbol.value == "if") { + var condition = EVAL(args[0], env); + if (condition is MalNil || + condition is MalBool && condition.value == false) { + // False side of branch + if (args.length < 3) { + return new MalNil(); + } + ast = args[2]; + continue; + } else { + // True side of branch + ast = args[1]; + continue; + } + } else if (symbol.value == "fn*") { + var params = (args[0] as MalIterable) + .elements + .map((e) => e as MalSymbol) + .toList(); + return new MalClosure( + params, + args[1], + env, + (List funcArgs) => + EVAL(args[1], new Env(env, params, funcArgs))); + } else if (symbol.value == "quote") { + return args.single; + } else if (symbol.value == "quasiquote") { + ast = quasiquote(args.first); + continue; + } + } + var f = EVAL(list.elements.first, env); + var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + if (f is MalBuiltin) { + return f.call(args); + } else if (f is MalClosure) { + ast = f.ast; + env = new Env(f.env, f.params, args); + continue; + } else { + throw 'bad!'; + } + } + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main(List args) { + setupEnv(args.isEmpty ? const [] : args.sublist(1)); + if (args.isNotEmpty) { + rep("(load-file \"${args.first}\")"); + return; + } + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on MalException catch (e) { + stdout.writeln("Error: ${printer.pr_str(e.value)}"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step8_macros.dart b/impls/dart/step8_macros.dart new file mode 100644 index 0000000000..ad884411d1 --- /dev/null +++ b/impls/dart/step8_macros.dart @@ -0,0 +1,220 @@ +import 'dart:io'; + +import 'core.dart'; +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv(List argv) { + ns.forEach((sym, fun) => replEnv.set(sym, fun)); + + replEnv.set('eval', + new MalBuiltin((List args) => EVAL(args.single, replEnv))); + + replEnv.set('*ARGV*', + new MalList(argv.map((s) => new MalString(s)).toList())); + + rep('(def! not (fn* (a) (if a false true)))'); + rep("(def! load-file " + " (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + rep("(defmacro! cond " + " (fn* (& xs) (if (> (count xs) 0) " + " (list 'if (first xs) " + " (if (> (count xs) 1) " + " (nth xs 1) " + " (throw \"odd number of forms to cond\")) " + " (cons 'cond (rest (rest xs)))))))"); +} + +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} + +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList([new MalSymbol("quote"), ast]); + } else { + return ast; + } +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + while (true) { + + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).isEmpty) return ast; + + var list = ast as MalList; + + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "defmacro!") { + MalSymbol key = args.first; + MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); + macro.isMacro = true; + env.set(key.value, macro); + return macro; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + ast = args[1]; + env = newEnv; + continue; + } else if (symbol.value == "do") { + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } + ast = args.last; + continue; + } else if (symbol.value == "if") { + var condition = EVAL(args[0], env); + if (condition is MalNil || + condition is MalBool && condition.value == false) { + // False side of branch + if (args.length < 3) { + return new MalNil(); + } + ast = args[2]; + continue; + } else { + // True side of branch + ast = args[1]; + continue; + } + } else if (symbol.value == "fn*") { + var params = (args[0] as MalIterable) + .elements + .map((e) => e as MalSymbol) + .toList(); + return new MalClosure( + params, + args[1], + env, + (List funcArgs) => + EVAL(args[1], new Env(env, params, funcArgs))); + } else if (symbol.value == "quote") { + return args.single; + } else if (symbol.value == "quasiquote") { + ast = quasiquote(args.first); + continue; + } + } + var f = EVAL(list.elements.first, env); + if (f is MalCallable && f.isMacro) { + ast = f.call(list.elements.sublist(1)); + continue; + } + var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + if (f is MalBuiltin) { + return f.call(args); + } else if (f is MalClosure) { + ast = f.ast; + env = new Env(f.env, f.params, args); + continue; + } else { + throw 'bad!'; + } + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main(List args) { + setupEnv(args.isEmpty ? const [] : args.sublist(1)); + if (args.isNotEmpty) { + rep("(load-file \"${args.first}\")"); + return; + } + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on MalException catch (e) { + stdout.writeln("Error: ${printer.pr_str(e.value)}"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/step9_try.dart b/impls/dart/step9_try.dart new file mode 100644 index 0000000000..a71814d863 --- /dev/null +++ b/impls/dart/step9_try.dart @@ -0,0 +1,245 @@ +import 'dart:io'; + +import 'core.dart'; +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv(List argv) { + ns.forEach((sym, fun) => replEnv.set(sym, fun)); + + replEnv.set('eval', + new MalBuiltin((List args) => EVAL(args.single, replEnv))); + + replEnv.set('*ARGV*', + new MalList(argv.map((s) => new MalString(s)).toList())); + + rep('(def! not (fn* (a) (if a false true)))'); + rep("(def! load-file " + " (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + rep("(defmacro! cond " + " (fn* (& xs) (if (> (count xs) 0) " + " (list 'if (first xs) " + " (if (> (count xs) 1) " + " (nth xs 1) " + " (throw \"odd number of forms to cond\")) " + " (cons 'cond (rest (rest xs)))))))"); +} + +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} + +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList([new MalSymbol("quote"), ast]); + } else { + return ast; + } +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + while (true) { + + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).isEmpty) return ast; + + var list = ast as MalList; + + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "defmacro!") { + MalSymbol key = args.first; + MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); + macro.isMacro = true; + env.set(key.value, macro); + return macro; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + ast = args[1]; + env = newEnv; + continue; + } else if (symbol.value == "do") { + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } + ast = args.last; + continue; + } else if (symbol.value == "if") { + var condition = EVAL(args[0], env); + if (condition is MalNil || + condition is MalBool && condition.value == false) { + // False side of branch + if (args.length < 3) { + return new MalNil(); + } + ast = args[2]; + continue; + } else { + // True side of branch + ast = args[1]; + continue; + } + } else if (symbol.value == "fn*") { + var params = (args[0] as MalIterable) + .elements + .map((e) => e as MalSymbol) + .toList(); + return new MalClosure( + params, + args[1], + env, + (List funcArgs) => + EVAL(args[1], new Env(env, params, funcArgs))); + } else if (symbol.value == "quote") { + return args.single; + } else if (symbol.value == "quasiquote") { + ast = quasiquote(args.first); + continue; + } else if (symbol.value == 'try*') { + var body = args.first; + if (args.length < 2) { + ast = EVAL(body, env); + continue; + } + var catchClause = args[1] as MalList; + try { + return EVAL(body, env); + } catch (e) { + assert((catchClause.first as MalSymbol).value == 'catch*'); + var exceptionSymbol = catchClause[1] as MalSymbol; + var catchBody = catchClause[2]; + MalType exceptionValue; + if (e is MalException) { + exceptionValue = e.value; + } else if (e is reader.ParseException) { + exceptionValue = new MalString(e.message); + } else { + exceptionValue = new MalString(e.toString()); + } + var newEnv = new Env(env, [exceptionSymbol], [exceptionValue]); + ast = EVAL(catchBody, newEnv); + } + continue; + } + } + var f = EVAL(list.elements.first, env); + if (f is MalCallable && f.isMacro) { + ast = f.call(list.elements.sublist(1)); + continue; + } + var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + if (f is MalBuiltin) { + return f.call(args); + } else if (f is MalClosure) { + ast = f.ast; + env = new Env(f.env, f.params, args); + continue; + } else { + throw 'bad!'; + } + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main(List args) { + setupEnv(args.isEmpty ? const [] : args.sublist(1)); + if (args.isNotEmpty) { + rep("(load-file \"${args.first}\")"); + return; + } + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on MalException catch (e) { + stdout.writeln("Error: ${printer.pr_str(e.value)}"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/stepA_mal.dart b/impls/dart/stepA_mal.dart new file mode 100644 index 0000000000..5702f2a424 --- /dev/null +++ b/impls/dart/stepA_mal.dart @@ -0,0 +1,248 @@ +import 'dart:io'; + +import 'core.dart'; +import 'env.dart'; +import 'printer.dart' as printer; +import 'reader.dart' as reader; +import 'types.dart'; + +final Env replEnv = new Env(); + +void setupEnv(List argv) { + ns.forEach((sym, fun) => replEnv.set(sym, fun)); + + replEnv.set('eval', + new MalBuiltin((List args) => EVAL(args.single, replEnv))); + + replEnv.set('*ARGV*', + new MalList(argv.map((s) => new MalString(s)).toList())); + + replEnv.set('*host-language*', new MalString('dart')); + + rep('(def! not (fn* (a) (if a false true)))'); + rep("(def! load-file " + " (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + rep("(defmacro! cond " + " (fn* (& xs) (if (> (count xs) 0) " + " (list 'if (first xs) " + " (if (> (count xs) 1) " + " (nth xs 1) " + " (throw \"odd number of forms to cond\")) " + " (cons 'cond (rest (rest xs)))))))"); +} + +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} + +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { + return new MalList([new MalSymbol("quote"), ast]); + } else { + return ast; + } +} + +MalType READ(String x) => reader.read_str(x); + +MalType EVAL(MalType ast, Env env) { + while (true) { + + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && !(dbgeval is MalNil) + && !(dbgeval is MalBool && dbgeval.value == false)) { + stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + } + + if (ast is MalSymbol) { + var result = env.get(ast.value); + if (result == null) { + throw new NotFoundException(ast.value); + } + return result; + } else if (ast is MalList) { + // Exit this switch. + } else if (ast is MalVector) { + return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); + } else if (ast is MalHashMap) { + var newMap = new Map.from(ast.value); + for (var key in newMap.keys) { + newMap[key] = EVAL(newMap[key], env); + } + return new MalHashMap(newMap); + } else { + return ast; + } + // ast is a list. todo: indent left. + if ((ast as MalList).isEmpty) return ast; + + var list = ast as MalList; + + if (list.elements.first is MalSymbol) { + var symbol = list.elements.first as MalSymbol; + var args = list.elements.sublist(1); + if (symbol.value == "def!") { + MalSymbol key = args.first; + MalType value = EVAL(args[1], env); + env.set(key.value, value); + return value; + } else if (symbol.value == "defmacro!") { + MalSymbol key = args.first; + MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); + macro.isMacro = true; + env.set(key.value, macro); + return macro; + } else if (symbol.value == "let*") { + // TODO(het): If elements.length is not even, give helpful error + Iterable> pairs(List elements) sync* { + for (var i = 0; i < elements.length; i += 2) { + yield [elements[i], elements[i + 1]]; + } + } + + var newEnv = new Env(env); + MalIterable bindings = args.first; + for (var pair in pairs(bindings.elements)) { + MalSymbol key = pair[0]; + MalType value = EVAL(pair[1], newEnv); + newEnv.set(key.value, value); + } + ast = args[1]; + env = newEnv; + continue; + } else if (symbol.value == "do") { + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } + ast = args.last; + continue; + } else if (symbol.value == "if") { + var condition = EVAL(args[0], env); + if (condition is MalNil || + condition is MalBool && condition.value == false) { + // False side of branch + if (args.length < 3) { + return new MalNil(); + } + ast = args[2]; + continue; + } else { + // True side of branch + ast = args[1]; + continue; + } + } else if (symbol.value == "fn*") { + var params = (args[0] as MalIterable) + .elements + .map((e) => e as MalSymbol) + .toList(); + return new MalClosure( + params, + args[1], + env, + (List funcArgs) => + EVAL(args[1], new Env(env, params, funcArgs))); + } else if (symbol.value == "quote") { + return args.single; + } else if (symbol.value == "quasiquote") { + ast = quasiquote(args.first); + continue; + } else if (symbol.value == 'try*') { + var body = args.first; + if (args.length < 2) { + ast = EVAL(body, env); + continue; + } + var catchClause = args[1] as MalList; + try { + return EVAL(body, env); + } catch (e) { + assert((catchClause.first as MalSymbol).value == 'catch*'); + var exceptionSymbol = catchClause[1] as MalSymbol; + var catchBody = catchClause[2]; + MalType exceptionValue; + if (e is MalException) { + exceptionValue = e.value; + } else if (e is reader.ParseException) { + exceptionValue = new MalString(e.message); + } else { + exceptionValue = new MalString(e.toString()); + } + var newEnv = new Env(env, [exceptionSymbol], [exceptionValue]); + ast = EVAL(catchBody, newEnv); + } + continue; + } + } + var f = EVAL(list.elements.first, env); + if (f is MalCallable && f.isMacro) { + ast = f.call(list.elements.sublist(1)); + continue; + } + var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); + if (f is MalBuiltin) { + return f.call(args); + } else if (f is MalClosure) { + ast = f.ast; + env = new Env(f.env, f.params, args); + continue; + } else { + throw 'bad!'; + } + } +} + +String PRINT(MalType x) => printer.pr_str(x); + +String rep(String x) { + return PRINT(EVAL(READ(x), replEnv)); +} + +const prompt = 'user> '; +main(List args) { + setupEnv(args.isEmpty ? const [] : args.sublist(1)); + if (args.isNotEmpty) { + rep("(load-file \"${args.first}\")"); + return; + } + rep("(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + stdout.write(prompt); + var input = stdin.readLineSync(); + if (input == null) return; + var output; + try { + output = rep(input); + } on reader.ParseException catch (e) { + stdout.writeln("Error: '${e.message}'"); + continue; + } on NotFoundException catch (e) { + stdout.writeln("Error: '${e.value}' not found"); + continue; + } on MalException catch (e) { + stdout.writeln("Error: ${printer.pr_str(e.value)}"); + continue; + } on reader.NoInputException { + continue; + } + stdout.writeln(output); + } +} diff --git a/impls/dart/types.dart b/impls/dart/types.dart new file mode 100644 index 0000000000..5d757b0acb --- /dev/null +++ b/impls/dart/types.dart @@ -0,0 +1,270 @@ +import 'dart:collection'; +import 'env.dart'; + +abstract class MalType { + bool get isMacro => false; + MalType meta; + + MalType clone(); +} + +abstract class MalIterable extends MalType + with ListMixin + implements List { + final List elements; + + MalIterable(this.elements); + + MalType operator [](int index) => elements[index]; + void operator []=(int index, MalType value) { + elements[index] = value; + } + + int get length => elements.length; + void set length(int newLength) { + elements.length = newLength; + } + + bool operator ==(other) { + if (other is! MalIterable) return false; + + // apparently (= (list) nil) should be false... + if (other is MalNil) return false; + + if (elements.length != other.elements.length) return false; + for (var i = 0; i < elements.length; i++) { + if (elements[i] != other.elements[i]) return false; + } + return true; + } + + @override + MalIterable clone(); +} + +class MalList extends MalIterable { + MalList(List elements) : super(elements); + + @override + MalList clone() { + return new MalList(elements.toList()); + } +} + +class MalVector extends MalIterable { + MalVector(List elements) : super(elements); + + @override + MalVector clone() { + return new MalVector(elements.toList()); + } +} + +class MalHashMap extends MalType { + final Map value; + + MalHashMap(this.value); + + MalHashMap.fromSequence(List elements) + : value = _mapFromSequence(elements); + + static Map _mapFromSequence(List elements) { + var result = {}; + + var readingKey = true; + MalType pendingKey; + for (var malType in elements) { + if (readingKey) { + if (malType is MalString || malType is MalKeyword) { + pendingKey = malType; + } else { + throw new ArgumentError('hash-map keys must be strings or keywords'); + } + } else { + result[pendingKey] = malType; + } + readingKey = !readingKey; + } + + return result; + } + + bool operator ==(other) { + if (other is! MalHashMap) return false; + var otherMap = (other as MalHashMap).value; + if (otherMap.length != value.length) return false; + for (var key in value.keys) { + if (!otherMap.containsKey(key)) return false; + if (value[key] != otherMap[key]) return false; + } + return true; + } + + @override + MalHashMap clone() { + return new MalHashMap(new Map.from(value)); + } +} + +class MalInt extends MalType { + final int value; + + MalInt(this.value); + + bool operator ==(other) { + if (other is! MalInt) return false; + return other.value == value; + } + + @override + MalInt clone() { + return new MalInt(value); + } +} + +class MalSymbol extends MalType { + final String value; + + MalSymbol(this.value); + + int get hashCode => value.hashCode; + + bool operator ==(other) { + if (other is! MalSymbol) return false; + return value == other.value; + } + + @override + MalSymbol clone() { + return new MalSymbol(value); + } +} + +class MalKeyword extends MalType { + final String value; + + MalKeyword(this.value); + + int get hashCode => value.hashCode; + + bool operator ==(other) { + if (other is! MalKeyword) return false; + return value == other.value; + } + + @override + MalKeyword clone() { + return new MalKeyword(value); + } +} + +class MalString extends MalType { + final String value; + + MalString(this.value); + + int get hashCode => value.hashCode; + + bool operator ==(other) { + if (other is! MalString) return false; + return other.value == value; + } + + @override + MalString clone() { + return new MalString(value); + } +} + +class MalBool extends MalType { + final bool value; + + MalBool(this.value); + + bool operator ==(other) { + if (other is! MalBool) return false; + return other.value == value; + } + + @override + MalBool clone() { + return new MalBool(value); + } +} + +class MalNil extends MalIterable { + MalNil() : super(const []); + + bool operator ==(other) => other is MalNil; + + @override + MalNil clone() { + return new MalNil(); + } +} + +class MalAtom extends MalType { + MalType value; + + MalAtom(this.value); + + @override + MalAtom clone() { + return new MalAtom(value); + } +} + +abstract class MalCallable extends MalType { + MalType call(List args); + + bool get isMacro => false; +} + +typedef MalType BuiltinFunc(List args); + +class MalBuiltin extends MalCallable { + final BuiltinFunc func; + + MalBuiltin(this.func); + + MalType call(List args) { + return func(args); + } + + @override + MalBuiltin clone() { + return new MalBuiltin(func); + } +} + +typedef MalType EvalFun(MalType ast, Env env); + +class MalClosure extends MalCallable { + final List params; + final MalType ast; + final Env env; + final Function func; + + @override + bool isMacro = false; + + MalClosure(this.params, this.ast, this.env, this.func); + + MalType call(List args) { + return func(args); + } + + @override + MalClosure clone() { + var closure = + new MalClosure(this.params.toList(), this.ast, this.env, this.func); + closure.isMacro = this.isMacro; + return closure; + } +} + +class MalException implements Exception { + final MalType value; + + MalException(this.value); +} diff --git a/impls/elisp/Dockerfile b/impls/elisp/Dockerfile new file mode 100644 index 0000000000..e9b8ba0c21 --- /dev/null +++ b/impls/elisp/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install emacs-nox diff --git a/impls/elisp/Makefile b/impls/elisp/Makefile new file mode 100644 index 0000000000..18ed09c8f5 --- /dev/null +++ b/impls/elisp/Makefile @@ -0,0 +1,9 @@ +all: + emacs -Q --batch -L . --eval '(byte-recompile-directory "." 0)' + +# For debugging, it is sometimes useful to attempt a run without byte compation. +nocompile: clean + exec emacs -Q --batch -L . --eval "(setq text-quoting-style 'straight)" --load stepA_mal.el + +clean: + rm -f *.elc *~ mal/*.elc mal/*~ diff --git a/impls/elisp/mal/core.el b/impls/elisp/mal/core.el new file mode 100644 index 0000000000..da16eb3ab2 --- /dev/null +++ b/impls/elisp/mal/core.el @@ -0,0 +1,261 @@ +(require 'seq) +(require 'mal/types) + +(defun mal-boolean (value) (if value mal-true mal-false)) + +(defun mal-= (a b) + (let (va vb) + (cond + ((or (setq va (mal-seq-value a)) (mal-list-p a)) + (and (or (setq vb (mal-seq-value b)) (mal-list-p b)) + (mal-seq-= va vb))) + ((setq va (mal-number-value a)) (equal va (mal-number-value b))) + ((setq va (mal-string-value a)) (equal va (mal-string-value b))) + ((setq va (mal-symbol-value a)) (eq va (mal-symbol-value b))) + ((setq va (mal-keyword-value a)) (equal va (mal-keyword-value b))) + ((setq va (mal-map-value a)) (and (setq vb (mal-map-value b)) + (mal-map-= va vb))) + (t (eq a b))))) + +(defun mal-seq-= (a b) + (let* ((len (seq-length a)) + (res (= len (seq-length b)))) + (while (and res (< 0 len)) + (setq len (1- len)) + (unless (mal-= (seq-elt a len) (seq-elt b len)) + (setq res nil))) + res)) + +(defun mal-map-= (a b) + (when (= (hash-table-count a) + (hash-table-count b)) + (catch 'return + (maphash (lambda (key a-value) + (let ((b-value (gethash key b))) + (unless (and b-value + (mal-= a-value b-value)) + (throw 'return nil)))) + a) + ;; if we made it this far, the maps are equal + t))) + +(define-hash-table-test 'mal-= 'mal-= 'sxhash) + +(defun mal-conj (seq &rest args) + (let (value) + (cond + ((setq value (mal-vector-value seq)) + (mal-vector (vconcat value args))) + ((setq value (mal-list-value seq)) + (mal-list (append (reverse args) value))) + ((mal-list-p seq) + (mal-list (reverse args))) + (t (error "seq: bad type"))))) + +(defun elisp-to-mal (arg) + (cond + ((not arg) + mal-nil) + ((eq arg t) + mal-true) + ((numberp arg) + (mal-number arg)) + ((stringp arg) + (mal-string arg)) + ((keywordp arg) + (mal-keyword (symbol-name arg))) + ((symbolp arg) + (mal-symbol arg)) + ((consp arg) + (mal-list (mapcar 'elisp-to-mal arg))) + ((vectorp arg) + (mal-vector (vconcat (mapcar 'elisp-to-mal arg)))) + ((hash-table-p arg) + (let ((output (make-hash-table :test 'mal-=))) + (maphash + (lambda (key value) + (puthash (elisp-to-mal key) (elisp-to-mal value) output)) + arg) + (mal-map output))) + (t + ;; represent anything else as printed arg + (mal-string (format "%S" arg))))) + +(defconst core-ns + '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) + (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) + (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) + (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))) + + (< . (lambda (a b) (mal-boolean (< (mal-number-value a) (mal-number-value b))))) + (<= . (lambda (a b) (mal-boolean (<= (mal-number-value a) (mal-number-value b))))) + (> . (lambda (a b) (mal-boolean (> (mal-number-value a) (mal-number-value b))))) + (>= . (lambda (a b) (mal-boolean (>= (mal-number-value a) (mal-number-value b))))) + + (= . (lambda (a b) (mal-boolean (mal-= a b)))) + + (list . (lambda (&rest args) (mal-list args))) + (list? . (lambda (mal-object) (mal-boolean (mal-list-p mal-object)))) + (empty? . (lambda (seq) (mal-boolean (seq-empty-p (mal-seq-value seq))))) + (count . (lambda (seq) (mal-number (length (mal-seq-value seq))))) + + (pr-str . (lambda (&rest args) (mal-string (pr-join args t " ")))) + (str . (lambda (&rest args) (mal-string (pr-join args nil "")))) + (prn . (lambda (&rest args) + (println (pr-join args t " ")) + mal-nil)) + (println . (lambda (&rest args) + (println (pr-join args nil " ")) + mal-nil)) + + (read-string . (lambda (input) (read-str (mal-string-value input)))) + (slurp . (lambda (file) + (with-temp-buffer + (insert-file-contents-literally (mal-string-value file)) + (mal-string (buffer-string))))) + + (atom . mal-atom) + (atom? . (lambda (mal-object) (mal-boolean (mal-atom-value mal-object)))) + (deref . mal-atom-value) + (reset! . (lambda (atom value) + (mal-reset atom value) + value)) + (swap! . (lambda (atom fn &rest args) + (let ((value (apply (or (mal-func-value fn) + (mal-fn-core-value fn)) + (mal-atom-value atom) + args))) + (mal-reset atom value) + value))) + + (vec . (lambda (seq) + (if (mal-vector-value seq) + seq + (mal-vector (seq-into (mal-list-value seq) 'vector))))) + (cons . (lambda (arg seq) + (let ((value (mal-vector-value seq))) + (mal-list (cons arg (if value + (seq-into value 'list) + (mal-list-value seq))))))) + (concat . (lambda (&rest lists) + (mal-list (seq-mapcat 'mal-seq-value lists 'list)))) + + (nth . (lambda (seq index) + (let ((list (mal-seq-value seq)) + (i (mal-number-value index))) + ;; seq-elt returns nil for a list and a bad index + (or (seq-elt (mal-seq-value seq) (mal-number-value index)) + (error "Args out of range: %s, %d" (pr-str seq t) i))))) + + (first . (lambda (seq) + (let ((value (mal-seq-value seq))) + (if (seq-empty-p value) + mal-nil + (seq-first value))))) + (rest . (lambda (seq) + (let ((value(mal-vector-value seq))) + (mal-list (cdr (if value + (seq-into value 'list) + (mal-list-value seq))))))) + + (throw . (lambda (mal-object) (signal 'mal-custom (list mal-object)))) + + (apply . (lambda (fn &rest args) + (let ((butlast (butlast args)) + (last (mal-seq-value (car (last args)))) + (fn* (or (mal-func-value fn) + (mal-fn-core-value fn) + (mal-macro-value fn)))) + (apply fn* (seq-concatenate 'list butlast last))))) + (map . (lambda (fn seq) + (mal-list (mapcar (or (mal-func-value fn) (mal-fn-core-value fn)) + (mal-seq-value seq))))) + + (nil? . (lambda (arg) (mal-boolean (eq mal-nil arg)))) + (true? . (lambda (arg) (mal-boolean (eq mal-true arg)))) + (false? . (lambda (arg) (mal-boolean (eq mal-false arg)))) + + (number? . (lambda (arg) (mal-boolean (mal-number-value arg)))) + (symbol? . (lambda (arg) (mal-boolean (mal-symbol-value arg)))) + (keyword? . (lambda (arg) (mal-boolean (mal-keyword-value arg)))) + (string? . (lambda (arg) (mal-boolean (mal-string-value arg)))) + (vector? . (lambda (arg) (mal-boolean (mal-vector-value arg)))) + (map? . (lambda (arg) (mal-boolean (mal-map-value arg)))) + + (symbol . (lambda (string) (mal-symbol (intern (mal-string-value string))))) + (keyword . (lambda (x) + (let ((value (mal-string-value x))) + (if value + (mal-keyword (concat ":" value)) + x)))) + + (vector . (lambda (&rest args) (mal-vector (seq-into args 'vector)))) + (hash-map . (lambda (&rest args) + (let ((map (make-hash-table :test 'mal-=))) + (while args + (puthash (pop args) (pop args) map)) + (mal-map map)))) + + (sequential? . (lambda (mal-object) + (mal-boolean (or (mal-list-p mal-object) + (mal-vector-value mal-object))))) + (fn? . (lambda (arg) (mal-boolean (or (mal-fn-core-value arg) + (mal-func-value arg))))) + (macro? . (lambda (arg) (mal-boolean (mal-macro-value arg)))) + + (get . (lambda (map key) + (or (let ((value (mal-map-value map))) + (when value + (gethash key value))) + mal-nil))) + (contains? . (lambda (map key) + (mal-boolean (gethash key (mal-map-value map))))) + (assoc . (lambda (map &rest args) + (let ((map* (copy-hash-table (mal-map-value map)))) + (while args + (puthash (pop args) (pop args) map*)) + (mal-map map*)))) + (dissoc . (lambda (map &rest args) + (let ((map* (copy-hash-table (mal-map-value map)))) + (dolist (k args) + (remhash k map*)) + (mal-map map*)))) + (keys . (lambda (map) (let (keys) + (maphash (lambda (key _value) (push key keys)) + (mal-map-value map)) + (mal-list keys)))) + (vals . (lambda (map) (let (vals) + (maphash (lambda (_key value) (push value vals)) + (mal-map-value map)) + (mal-list vals)))) + + (readline . (lambda (prompt) + (or (mal-string (readln (mal-string-value prompt))) + mal-nil))) + + (meta . mal-meta) + (with-meta . with-meta) + + (time-ms . (lambda () (mal-number (floor (* (float-time) 1000))))) + + (conj . mal-conj) + (seq . (lambda (mal-object) + (let (value) + (or + (cond + ((setq value (mal-list-value mal-object)) + mal-object) + ((and (setq value (mal-vector-value mal-object)) + (not (seq-empty-p value))) + (mal-list (seq-into value 'list))) + ((and (setq value (mal-string-value mal-object)) + (not (seq-empty-p value))) + (mal-list (mapcar (lambda (item) (mal-string (char-to-string item))) + value)))) + mal-nil)))) + + (elisp-eval . (lambda (string) + (elisp-to-mal (eval (read (mal-string-value string)))))) + )) + +(provide 'mal/core) diff --git a/impls/elisp/mal/env.el b/impls/elisp/mal/env.el new file mode 100644 index 0000000000..4500e37a25 --- /dev/null +++ b/impls/elisp/mal/env.el @@ -0,0 +1,27 @@ +(require 'mal/types) + +;; An env is represented by an elisp list of hash-tables. In other words +;; * car: a hash-table +;; * cdr: the outer environment or () +;; Keys are elisp symbols. + +(defun mal-env (&optional outer binds exprs) + (let ((env (cons (make-hash-table :test 'eq) outer)) + key) + (while (setq key (pop binds)) + (if (eq key '&) + (mal-env-set env (pop binds) (mal-list exprs)) + (mal-env-set env key (pop exprs)))) + env)) + +(defun mal-env-set (env key value) + (let ((data (car env))) + (puthash key value data))) + +(defun mal-env-get (env key) + (let (value) + (while (and (not (setq value (gethash key (pop env)))) + env)) + value)) + +(provide 'mal/env) diff --git a/impls/elisp/mal/printer.el b/impls/elisp/mal/printer.el new file mode 100644 index 0000000000..46d2f97c11 --- /dev/null +++ b/impls/elisp/mal/printer.el @@ -0,0 +1,60 @@ +(require 'mal/types) + +(defun pr-str (form print-readably) + (let (value) + (cond + ((eq mal-nil form) + "nil") + ((eq mal-true form) + "true") + ((eq mal-false form) + "false") + ((setq value (mal-number-value form)) + (number-to-string value)) + ((setq value (mal-string-value form)) + (if print-readably + (let ((print-escape-newlines t)) + (prin1-to-string value)) + value)) + ((setq value (mal-symbol-value form)) + (symbol-name value)) + ((setq value (mal-keyword-value form)) + value) + ((setq value (mal-list-value form)) + (pr-list value print-readably)) + ((mal-list-p form) + "()") + ((setq value (mal-vector-value form)) + (pr-vector value print-readably)) + ((setq value (mal-map-value form)) + (pr-map value print-readably)) + ((or (mal-fn-core-value form) (mal-func-value form)) + "#") + ((mal-macro-value form) + "#") + ((setq value (mal-atom-value form)) + (format "(atom %s)" (pr-str value print-readably))) + (t (error "pr-str: unknown type: %s" form))))) + +(defun pr-list (form print-readably) + (let ((items (pr-join form print-readably " "))) + (concat "(" items ")"))) + +(defun pr-vector (form print-readably) + (let ((items (pr-join form print-readably " "))) + (concat "[" items "]"))) + +(defun pr-map (form print-readably) + (let (pairs) + (maphash + (lambda (key value) + (push value pairs) + (push key pairs)) + form) + (let ((items (pr-join pairs print-readably " "))) + (concat "{" items "}")))) + +(defun pr-join (forms print-readably separator) + (mapconcat (lambda (item) (pr-str item print-readably)) forms separator)) + +(provide 'mal/printer) diff --git a/impls/elisp/mal/reader.el b/impls/elisp/mal/reader.el new file mode 100644 index 0000000000..8253cd98f1 --- /dev/null +++ b/impls/elisp/mal/reader.el @@ -0,0 +1,158 @@ +(require 'mal/types) + +;; HACK: `text-quoting-style' prettifies quotes in error messages on +;; Emacs 25, but no longer does from 26 upwards... +(when (= emacs-major-version 25) + (setq text-quoting-style 'grave)) + +(defvar reader--tokens nil) + +(defun peek () + (car reader--tokens)) + +(defun next () + (pop reader--tokens)) + +(defun read-str (input) + (setq reader--tokens (tokenizer input)) + (read-form)) + +(defun tokenizer (input) + (let (output) + (with-temp-buffer + (insert input) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at token-re) + (let ((token (match-string 1))) + (if (= (length token) 0) + (let ((remainder (buffer-substring (point) (point-max)))) + (push remainder output) + (goto-char (point-max))) + (when (not (string-match-p comment-re token)) + (push token output)) + (goto-char (match-end 1)))))) + (nreverse output)))) + +(defun read-form () + (pcase (peek) + ("'" + (read-quote)) + ("`" + (read-quasiquote)) + ("~" + (read-unquote)) + ("~@" + (read-splice-unquote)) + ("@" + (read-deref)) + ("^" + (read-with-meta)) + ("(" + (read-list)) + ("[" + (read-vector)) + ("{" + (read-map)) + (_ + ;; assume anything else is an atom + (read-atom)))) + +(defun read-simple-reader-macro (symbol) + (next) ; pop reader macro token + ;; turn form into (symbol form) + (mal-list (list (mal-symbol symbol) (read-form)))) + +(defun read-quote () + (read-simple-reader-macro 'quote)) + +(defun read-quasiquote () + (read-simple-reader-macro 'quasiquote)) + +(defun read-unquote () + (read-simple-reader-macro 'unquote)) + +(defun read-splice-unquote () + (read-simple-reader-macro 'splice-unquote)) + +(defun read-deref () + (read-simple-reader-macro 'deref)) + +(defun read-with-meta () + (next) ; pop with-meta token + (let ((meta (read-form))) + (mal-list (list (mal-symbol 'with-meta) (read-form) meta)))) + +(defun read-list () + (next) ; pop list start + (let (output end-of-list) + (while (not end-of-list) + (let ((token (peek))) + (cond + ((string= token ")") + (next) ; pop list end + (setq end-of-list t)) + ((not token) + (signal 'unterminated-sequence '(list))) + (t + (push (read-form) output))))) + (mal-list (nreverse output)))) + +(defun read-vector () + (next) ; pop vector start + (let (output end-of-vector) + (while (not end-of-vector) + (let ((token (peek))) + (cond + ((string= token "]") + (next) ; pop vector end + (setq end-of-vector t)) + ((not token) + (signal 'unterminated-sequence '(vector))) + (t + (push (read-form) output))))) + (mal-vector (vconcat (nreverse output))))) + +;; HACK overriden by core.el in later steps +(define-hash-table-test 'mal-= 'equal 'sxhash) + +(defun read-map () + (next) ; pop map start + (let ((output (make-hash-table :test 'mal-=)) + end-of-map) + (while (not end-of-map) + (let ((token (peek))) + (cond + ((string= token "}") + (next) ; pop map end + (setq end-of-map t)) + ((not token) + (signal 'unterminated-sequence '(map))) + (t + (puthash (read-form) (read-form) output))))) + (mal-map output))) + +(defun read-atom () + (let ((token (next))) + (if token + (cond + ((string= token "nil") + mal-nil) + ((string= token "true") + mal-true) + ((string= token "false") + mal-false) + ((string-match number-re token) + (mal-number (string-to-number token))) + ((= (aref token 0) ?\") + (if (string-match string-re token) + (mal-string (read token)) + (signal 'unterminated-sequence '(string)))) + ((= (aref token 0) ?:) + (mal-keyword token)) + (t + ;; assume anything else is a symbol + (mal-symbol (intern token)))) + (signal 'end-of-token-stream nil)))) + +(provide 'mal/reader) diff --git a/impls/elisp/mal/types.el b/impls/elisp/mal/types.el new file mode 100644 index 0000000000..deba03a46c --- /dev/null +++ b/impls/elisp/mal/types.el @@ -0,0 +1,154 @@ +;; Structural pattern matching is ideal, but too slow for MAL. + +;; So we use a mal-foo-value getter that returns nil in case of bad +;; type (or if a list is empty, unfortunately). + +(defmacro mal-object (name) + (let ((constructor (intern (format "mal-%s" name))) + (accessor (intern (format "mal-%s-value" name)))) + `(progn + (defsubst ,constructor (value) + (record ',name value)) + (defun ,accessor (arg) + (and (recordp arg) + (eq (aref arg 0) ',name) + (aref arg 1)))))) + +(defconst mal-nil #&8"n") +(defconst mal-false #&8"f") +(defconst mal-true #&8"t") + +(defsubst mal-number (elisp-number) elisp-number) +(defsubst mal-number-value (obj) (and (numberp obj) obj)) + +(defsubst mal-symbol (elisp-symbol) elisp-symbol) +;; A nil result means either 'not a symbol' or 'the nil symbol'. +(defsubst mal-symbol-value (obj) (and (symbolp obj)obj)) + +(defsubst mal-string (elisp-string) elisp-string) +(defsubst mal-string-value (obj) (and (stringp obj) obj)) + +;; In elisp, keywords are symbols. Using them would cause confusion, +;; or at least make mal-symbol-value more complex, for little benefit. +;; The wrapped value is an elisp string including the initial colon. +(mal-object keyword) + +;; Use the native type when possible, but #s(type value meta ...) for +;; the empty list or when metadata is present. + +(defsubst mal-vector (elisp-vector) elisp-vector) +(defun mal-vector-value (obj) + (if (vectorp obj) + obj + (and (recordp obj) (eq (aref obj 0) 'vector) (aref obj 1)))) + +(defsubst mal-map (elisp-hash-table) elisp-hash-table) +(defun mal-map-value (obj) + (if (hash-table-p obj) + obj + (and (recordp obj) (eq (aref obj 0) 'map) (aref obj 1)))) + +(defconst mal-empty-list #s(list nil)) +(defsubst mal-list (elisp-list) (or elisp-list mal-empty-list)) +;; A nil result means either 'not a list' or 'empty list'. +(defun mal-list-value (obj) + (if (listp obj) obj + (and (recordp obj) (eq (aref obj 0) 'list) (aref obj 1)))) +(defun mal-list-p (obj) + (or (listp obj) + (and (recordp obj) (eq (aref obj 0) 'list)))) + +;; A nil result means either 'not a list' or 'empty list'. +(defun mal-seq-value (arg) (or (mal-vector-value arg) (mal-list-value arg))) + +(mal-object atom) +(defun mal-reset (atom value) (setf (aref atom 1) value)) + +(mal-object fn-core) +(mal-object macro) + +;; Function created by fn*. +(defsubst mal-func (value body params env) + (record 'func value body params env)) +(defun mal-func-value ( obj) + (and (recordp obj) (eq (aref obj 0) 'func) (aref obj 1))) +(defsubst mal-func-body (obj) (aref obj 2)) +(defsubst mal-func-params (obj) (aref obj 3)) +(defsubst mal-func-env (obj) (aref obj 4)) + +(defun with-meta (obj meta) + (cond + ((vectorp obj) (record 'vector obj meta)) + ((hash-table-p obj) (record 'map obj meta)) + ((listp obj) (record 'list obj meta)) + ((< (length obj) 4) (record (aref obj 0) (aref obj 1) meta)) + (t (record (aref obj 0) (aref obj 1) + (aref obj 2) (aref obj 3) + (aref obj 4) meta)))) + +(defun mal-meta (obj) + (if (and (recordp obj) (member (length obj) '(3 6))) + (aref obj (1- (length obj))) + mal-nil)) + +;;; regex + +(defvar token-re + (rx (* (any white ?,)) ;; leading whitespace + (group + (or + "~@" ;; special 2-char token + (any "[]{}()'`~^@") ;; special 1-char tokens + (and ?\" (* (or (and ?\\ anything) + (not (any "\\\"")))) + ?\") ;; string with escapes + (and ?\; (* not-newline)) ;; comment + (* (not (any white "[]{}()'\"`,;"))) ;; catch-all + )))) + +(defvar whitespace-re + (rx bos (* (any white ?,)) eos)) + +(defvar comment-re + (rx bos ?\; (* anything))) + +(defvar sequence-end-re + (rx bos (any ")]}") eos)) + +(defvar number-re + (rx bos (? (any "+-")) (+ (char digit)) eos)) + +(defvar string-re + (rx bos ?\" (* (or (and ?\\ anything) + (not (any "\\\"")))) + ?\" eos)) + +;;; errors + +(when (not (fboundp 'define-error)) + (defun define-error (name message &optional parent) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such an error +is signaled without being caught by a `condition-case'. +PARENT is either a signal or a list of signals from which it inherits. +Defaults to `error'." + (unless parent (setq parent 'error)) + (let ((conditions + (if (consp parent) + (apply #'nconc + (mapcar (lambda (parent) + (cons parent + (or (get parent 'error-conditions) + (error "Unknown signal `%s'" parent)))) + parent)) + (cons parent (get parent 'error-conditions))))) + (put name 'error-conditions + (delete-dups (copy-sequence (cons name conditions)))) + (when message (put name 'error-message message))))) + +(define-error 'mal "MAL error") +(define-error 'unterminated-sequence "Unexpected end of input during token sequence" 'mal) +(define-error 'end-of-token-stream "End of token stream" 'mal) +(define-error 'mal-custom "Custom error" 'mal) + +(provide 'mal/types) diff --git a/impls/elisp/run b/impls/elisp/run new file mode 100755 index 0000000000..cb0387403c --- /dev/null +++ b/impls/elisp/run @@ -0,0 +1,3 @@ +#!/bin/sh +dir=$(dirname $0) +exec emacs -Q --batch -L $dir --eval "(setq text-quoting-style 'straight)" --load $dir/${STEP:-stepA_mal}.elc "${@}" diff --git a/impls/elisp/step0_repl.el b/impls/elisp/step0_repl.el new file mode 100644 index 0000000000..c8cadfcf9c --- /dev/null +++ b/impls/elisp/step0_repl.el @@ -0,0 +1,30 @@ +(defun READ (input) + input) + +(defun EVAL (input) + input) + +(defun PRINT (input) + input) + +(defun rep (input) + (PRINT (EVAL (READ input)))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defun main () + (let (input) + (while (setq input (readln "user> ")) + (println (rep input))) + ;; print final newline + (terpri))) + +(main) diff --git a/impls/elisp/step1_read_print.el b/impls/elisp/step1_read_print.el new file mode 100644 index 0000000000..a3f93ed67f --- /dev/null +++ b/impls/elisp/step1_read_print.el @@ -0,0 +1,55 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/reader) +(require 'mal/printer) + + +(defun READ (input) + (read-str input)) + +(defun EVAL (input) + input) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input) + (PRINT (EVAL (READ input)))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input)))) + ;; print final newline + (terpri))) + +(main) diff --git a/impls/elisp/step2_eval.el b/impls/elisp/step2_eval.el new file mode 100644 index 0000000000..b069f71705 --- /dev/null +++ b/impls/elisp/step2_eval.el @@ -0,0 +1,88 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/reader) +(require 'mal/printer) + + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (a) + + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cond + + ((setq a (mal-list-value ast)) + (let ((fn* (mal-fn-core-value (EVAL (car a) env))) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) + (apply fn* args))) + ((setq a (mal-symbol-value ast)) + (or (gethash a env) (error "'%s' not found" a))) + ((setq a (mal-vector-value ast)) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (mal-map map))) + (t + ;; return as is + ast)))) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (make-hash-table :test 'eq)) + + (dolist (binding + '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) + (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) + (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) + (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))))) + (let ((symbol (car binding)) + (fn (cdr binding))) + (puthash symbol (mal-fn-core fn) repl-env))) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) + +(main) diff --git a/impls/elisp/step3_env.el b/impls/elisp/step3_env.el new file mode 100644 index 0000000000..91d7f79114 --- /dev/null +++ b/impls/elisp/step3_env.el @@ -0,0 +1,111 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) + + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (a) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (mal-env-set env identifier value))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (EVAL form env*))) + (t + ;; not a special form + (let ((fn* (mal-fn-core-value (EVAL (car a) env))) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) + (apply fn* args))))) + ((setq a (mal-symbol-value ast)) + (or (mal-env-get env a) (error "'%s' not found" a))) + ((setq a (mal-vector-value ast)) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (mal-map map))) + (t + ;; return as is + ast)))) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding + '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) + (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) + (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) + (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))))) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) + +(main) diff --git a/impls/elisp/step4_if_fn_do.el b/impls/elisp/step4_if_fn_do.el new file mode 100644 index 0000000000..0dce5e9b2c --- /dev/null +++ b/impls/elisp/step4_if_fn_do.el @@ -0,0 +1,138 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) +(require 'mal/core) + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (a) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (mal-env-set env identifier value))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (EVAL form env*))) + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (EVAL (car a) env)) + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (EVAL (cadddr a) env) + mal-nil) + (EVAL (caddr a) env)))) + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (EVAL (mal-func-body fn) + (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)))) + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (apply fn* (mapcar (lambda (x) (EVAL x env)) args))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (or (mal-env-get env a) (error "'%s' not found" a))) + ((setq a (mal-vector-value ast)) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (mal-map map))) + (t + ;; return as is + ast)))) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) + +(main) diff --git a/impls/elisp/step5_tco.el b/impls/elisp/step5_tco.el new file mode 100644 index 0000000000..b2b121acda --- /dev/null +++ b/impls/elisp/step5_tco.el @@ -0,0 +1,146 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) +(require 'mal/core) + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (return a) + (while (not return) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (setq return (mal-map map)))) + (t + ;; return as is + (setq return ast)))) + + ;; End of the TCO loop + return)) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) + +(main) diff --git a/impls/elisp/step6_file.el b/impls/elisp/step6_file.el new file mode 100644 index 0000000000..9ba8b9c3c3 --- /dev/null +++ b/impls/elisp/step6_file.el @@ -0,0 +1,154 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) +(require 'mal/core) + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (return a) + (while (not return) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (setq return (mal-map map)))) + (t + ;; return as is + (setq return ast)))) + + ;; End of the TCO loop + return)) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + + (if argv + (with-error-handling + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) + +(main) diff --git a/impls/elisp/step7_quote.el b/impls/elisp/step7_quote.el new file mode 100644 index 0000000000..9bf20f7a11 --- /dev/null +++ b/impls/elisp/step7_quote.el @@ -0,0 +1,182 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) +(require 'mal/core) + +(defun qq-reducer (elt acc) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) + +(defun quasiquote (ast) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (return a) + (while (not return) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (quote + (setq return (cadr a))) + (quasiquote + (setq ast (quasiquote (cadr a)))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (setq return (mal-map map)))) + (t + ;; return as is + (setq return ast)))) + + ;; End of the TCO loop + return)) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + + (if argv + (with-error-handling + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) + +(main) diff --git a/impls/elisp/step8_macros.el b/impls/elisp/step8_macros.el new file mode 100644 index 0000000000..7d63ef624e --- /dev/null +++ b/impls/elisp/step8_macros.el @@ -0,0 +1,191 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) +(require 'mal/core) + +(defun qq-reducer (elt acc) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) + +(defun quasiquote (ast) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (return a) + (while (not return) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (quote + (setq return (cadr a))) + (quasiquote + (setq ast (quasiquote (cadr a)))) ; TCO + (defmacro! + (let ((identifier (mal-symbol-value (cadr a))) + (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) + (setq return (mal-env-set env identifier value)))) + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((setq fn* (mal-macro-value fn)) + (setq ast (apply fn* args))) ; TCO + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (setq return (mal-map map)))) + (t + ;; return as is + (setq return ast)))) + + ;; End of the TCO loop + return)) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first + xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to + cond\")) (cons 'cond (rest (rest xs)))))))" repl-env) + + (if argv + (with-error-handling + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) + +(main) diff --git a/impls/elisp/step9_try.el b/impls/elisp/step9_try.el new file mode 100644 index 0000000000..2677282d1d --- /dev/null +++ b/impls/elisp/step9_try.el @@ -0,0 +1,209 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) +(require 'mal/core) + +(defun qq-reducer (elt acc) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) + +(defun quasiquote (ast) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (return a) + (while (not return) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (quote + (setq return (cadr a))) + (quasiquote + (setq ast (quasiquote (cadr a)))) ; TCO + (defmacro! + (let ((identifier (mal-symbol-value (cadr a))) + (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) + (setq return (mal-env-set env identifier value)))) + (try* + (if (cddr a) + (condition-case err + (setq return (EVAL (cadr a) env)) + (error + (let* ((a2* (mal-list-value (caddr a))) + (identifier (mal-symbol-value (cadr a2*))) + (form (caddr a2*)) + (err* (if (eq (car err) 'mal-custom) + ;; throw + (cadr err) + ;; normal error + (mal-string (error-message-string err)))) + (env* (mal-env env))) + (mal-env-set env* identifier err*) + (setq env env* + ast form)))) ; TCO + (setq ast (cadr a)))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((setq fn* (mal-macro-value fn)) + (setq ast (apply fn* args))) ; TCO + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (setq return (mal-map map)))) + (t + ;; return as is + (setq return ast)))) + + ;; End of the TCO loop + return)) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first + xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to + cond\")) (cons 'cond (rest (rest xs)))))))" repl-env) + + (if argv + (with-error-handling + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) + +(main) diff --git a/impls/elisp/stepA_mal.el b/impls/elisp/stepA_mal.el new file mode 100644 index 0000000000..534471f530 --- /dev/null +++ b/impls/elisp/stepA_mal.el @@ -0,0 +1,211 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'mal/types) +(require 'mal/env) +(require 'mal/reader) +(require 'mal/printer) +(require 'mal/core) + +(defun qq-reducer (elt acc) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) + +(defun quasiquote (ast) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) + +(defun READ (input) + (read-str input)) + +(defun EVAL (ast env) + (let (return a) + (while (not return) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (quote + (setq return (cadr a))) + (quasiquote + (setq ast (quasiquote (cadr a)))) ; TCO + (defmacro! + (let ((identifier (mal-symbol-value (cadr a))) + (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) + (setq return (mal-env-set env identifier value)))) + (try* + (if (cddr a) + (condition-case err + (setq return (EVAL (cadr a) env)) + (error + (let* ((a2* (mal-list-value (caddr a))) + (identifier (mal-symbol-value (cadr a2*))) + (form (caddr a2*)) + (err* (if (eq (car err) 'mal-custom) + ;; throw + (cadr err) + ;; normal error + (mal-string (error-message-string err)))) + (env* (mal-env env))) + (mal-env-set env* identifier err*) + (setq env env* + ast form)))) ; TCO + (setq ast (cadr a)))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((setq fn* (mal-macro-value fn)) + (setq ast (apply fn* args))) ; TCO + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) + map) + (setq return (mal-map map)))) + (t + ;; return as is + (setq return ast)))) + + ;; End of the TCO loop + return)) + +(defun PRINT (input) + (pr-str input t)) + +(defun rep (input repl-env) + (PRINT (EVAL (READ input) repl-env))) + +(defun readln (prompt) + ;; C-d throws an error + (ignore-errors (read-from-minibuffer prompt))) + +(defun println (format-string &rest args) + (princ (if args + (apply 'format format-string args) + format-string)) + (terpri)) + +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + +(defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + (mal-env-set repl-env '*host-language* (mal-string "elisp")) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first + xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to + cond\")) (cons 'cond (rest (rest xs)))))))" repl-env) + + (if argv + (with-error-handling + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (rep "(println (str \"Mal [\" *host-language* \"]\"))" repl-env) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) + +(main) diff --git a/impls/elisp/tests/step5_tco.mal b/impls/elisp/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/elisp/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/elisp/tests/stepA_mal.mal b/impls/elisp/tests/stepA_mal.mal new file mode 100644 index 0000000000..ec8c701f3c --- /dev/null +++ b/impls/elisp/tests/stepA_mal.mal @@ -0,0 +1,21 @@ +;; Testing basic elisp interop + +(elisp-eval "42") +;=>42 + +(elisp-eval "(+ 1 1)") +;=>2 + +(elisp-eval "[foo bar baz]") +;=>[foo bar baz] + +(elisp-eval "(mapcar '1+ (number-sequence 0 2))") +;=>(1 2 3) + +(elisp-eval "(progn (princ \"Hello World!\n\") nil)") +;/Hello World! +;=>nil + +(elisp-eval "(setq emacs-version-re (rx (+ digit) \".\" digit))") +(elisp-eval "(and (string-match-p emacs-version-re emacs-version) t)") +;=>true diff --git a/impls/elixir/Dockerfile b/impls/elixir/Dockerfile new file mode 100644 index 0000000000..df27ab7797 --- /dev/null +++ b/impls/elixir/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Elixir +RUN apt-get install -y elixir diff --git a/impls/elixir/Makefile b/impls/elixir/Makefile new file mode 100644 index 0000000000..7bae647688 --- /dev/null +++ b/impls/elixir/Makefile @@ -0,0 +1,17 @@ +SOURCES_BASE = lib/mal/types.ex lib/mal/reader.ex lib/mal/printer.ex +SOURCES_LISP = lib/mal/env.ex lib/mal/core.ex lib/mix/tasks/stepA_mal.ex +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + mix compile + +dist: mal + +mal: $(SOURCES) + mix escript.build + +clean: + mix clean + rm -f mal + +.PHONY: clean diff --git a/impls/elixir/lib/mal.ex b/impls/elixir/lib/mal.ex new file mode 100644 index 0000000000..5ad079b2ed --- /dev/null +++ b/impls/elixir/lib/mal.ex @@ -0,0 +1,2 @@ +defmodule Mal do +end diff --git a/impls/elixir/lib/mal/atom.ex b/impls/elixir/lib/mal/atom.ex new file mode 100644 index 0000000000..c8a7e2bcf3 --- /dev/null +++ b/impls/elixir/lib/mal/atom.ex @@ -0,0 +1,25 @@ +defmodule Mal.Atom do + alias Mal.Function + + def new(value) do + {:ok, pid} = Agent.start_link(fn -> value end) + pid + end + + def deref({:atom, pid}) do + Agent.get(pid, fn value -> value end) + end + + def reset!({:atom, pid}, new_value) do + Agent.update(pid, fn _ -> new_value end) + new_value + end + + def swap!({:atom, pid}, %Function{value: func}, args) do + Agent.get_and_update(pid, fn state -> + func_args = [state | args] + new = func.(func_args) + {new, new} + end) + end +end diff --git a/impls/elixir/lib/mal/core.ex b/impls/elixir/lib/mal/core.ex new file mode 100644 index 0000000000..f8074c6de0 --- /dev/null +++ b/impls/elixir/lib/mal/core.ex @@ -0,0 +1,249 @@ +defmodule Mal.Core do + import Mal.Types + alias Mal.Function + + def namespace do + raw = %{ + "+" => fn [a, b] -> a + b end, + "-" => fn [a, b] -> a - b end, + "*" => fn [a, b] -> a * b end, + "/" => fn [a, b] -> div(a, b) end, + ">" => fn [a, b] -> a > b end, + "<" => fn [a, b] -> a < b end, + "<=" => fn [a, b] -> a <= b end, + ">=" => fn [a, b] -> a >= b end, + "concat" => &concat/1, + "=" => &equal/1, + "list?" => &list?/1, + "empty?" => &empty?/1, + "count" => &count/1, + "pr-str" => &pr_str/1, + "str" => &str/1, + "prn" => &prn/1, + "println" => &println/1, + "slurp" => &slurp/1, + "nth" => &nth/1, + "first" => &first/1, + "rest" => &rest/1, + "map" => &map/1, + "apply" => &apply/1, + "keyword" => &keyword/1, + "symbol?" => &symbol?/1, + "cons" => &cons/1, + "vec" => &vec/1, + "vector?" => &vector?/1, + "assoc" => &assoc/1, + "dissoc" => &dissoc/1, + "get" => &get/1, + "map?" => &map?/1, + "list" => &list/1, + "vector" => &vector/1, + "hash-map" => &hash_map/1, + "meta" => &meta/1, + "with-meta" => &with_meta/1, + "atom" => &atom/1, + "atom?" => &atom?/1, + "deref" => &deref/1, + "reset!" => &reset!/1, + "swap!" => &swap!/1, + "conj" => &conj/1, + "seq" => &seq/1, + "fn?" => &fn?/1, + "macro?" => ¯o?/1, + "time-ms" => fn _ -> :erlang.system_time(:milli_seconds) end, + "readline" => fn [prompt] -> readline(prompt) end, + "sequential?" => fn arg -> vector?(arg) or list?(arg) end, + "keyword?" => fn [type] -> is_atom(type) end, + "nil?" => fn [type] -> type == nil end, + "true?" => fn [type] -> type == true end, + "false?" => fn [type] -> type == false end, + "string?" => fn [obj] -> String.valid?(obj) end, + "number?" => fn [obj] -> is_number(obj) end, + "symbol" => fn [name] -> {:symbol, name} end, + "read-string" => fn [input] -> Mal.Reader.read_str(input) end, + "throw" => fn [arg] -> throw({:error, arg}) end, + "contains?" => fn [{:map, map, _}, key] -> Map.has_key?(map, key) end, + "keys" => fn [{:map, map, _}] -> Map.keys(map) |> list end, + "vals" => fn [{:map, map, _}] -> Map.values(map) |> list end + } + + convert(raw) + end + + defp convert(map) do + for {name, func} <- map, into: %{} do + {name, %Function{value: func}} + end + end + + def readline(prompt) do + IO.write(:stdio, prompt) + IO.read(:stdio, :line) + |> String.trim("\n") + end + + defp convert_vector({type, ast, meta}) when type == :map do + new_ast = Enum.map(ast, fn {key, value} -> + {key, convert_vector(value)} + end) + {:map, new_ast, meta} + end + defp convert_vector({type, ast, meta}) when type in [:list, :vector] do + new_ast = Enum.map(ast, &convert_vector/1) + {:list, new_ast, meta} + end + defp convert_vector(other), do: other + + defp equal([a, b]) do + convert_vector(a) == convert_vector(b) + end + + defp empty?([{_type, [], _meta}]), do: true + defp empty?(_), do: false + + defp count([{_type, ast, _meta}]), do: length(ast) + defp count(_), do: 0 + + defp pr_str(args) do + args + |> Enum.map(&Mal.Printer.print_str/1) + |> Enum.join(" ") + end + + defp str(args) do + args + |> Enum.map(&(Mal.Printer.print_str(&1, false))) + |> Enum.join("") + end + + defp prn(args) do + args + |> pr_str + |> IO.puts + nil + end + + defp println(args) do + args + |> Enum.map(&(Mal.Printer.print_str(&1, false))) + |> Enum.join(" ") + |> IO.puts + nil + end + + defp slurp([file_name]) do + case File.read(file_name) do + {:ok, content} -> content + {:error, :enoent} -> throw({:error, "can't find file #{file_name}"}) + {:error, :eisdir} -> throw({:error, "can't read directory #{file_name}"}) + {:error, :eaccess} -> throw({:error, "missing permissions #{file_name}"}) + {:error, reason} -> throw({:error, "can't read file #{file_name}, #{reason}"}) + end + end + + defp nth([{_type, ast, _meta}, index]) do + case Enum.at(ast, index, :error) do + :error -> throw({:error, "index out of bounds"}) + any -> any + end + end + + defp first([{_type, [head | _tail], _}]), do: head + defp first(_), do: nil + + defp rest([{_type, [_head | tail], _}]), do: list(tail) + defp rest([{_type, [], _}]), do: list([]) + defp rest([nil]), do: list([]) + + defp map([%Function{value: function}, ast]), do: do_map(function, ast) + defp map([function, ast]), do: do_map(function, ast) + + defp do_map(function, {_type, ast, _meta}) do + ast + |> Enum.map(fn arg -> function.([arg]) end) + |> list + end + + defp apply([%Function{value: function} | tail]), do: do_apply(function, tail) + defp apply([function | tail]), do: do_apply(function, tail) + + defp do_apply(function, tail) do + [{_type, ast, _meta} | reversed_args] = Enum.reverse(tail) + args = Enum.reverse(reversed_args) + func_args = Enum.concat(args, ast) + function.(func_args) + end + + defp keyword([atom]) when is_atom(atom), do: atom + defp keyword([atom]), do: String.to_atom(atom) + + defp cons([prepend, {_type, ast, meta}]), do: {:list, [prepend | ast], meta} + + defp concat(args) do + args + |> Enum.map(fn tuple -> elem(tuple, 1) end) + |> Enum.concat + |> list + end + + defp vec([{:list, xs, _}]), do: vector(xs) + defp vec([{:vector, xs, _}]), do: vector(xs) + defp vec([_]), do: throw({:error, "vec: arg type"}) + defp vec(_), do: throw({:error, "vec: arg count"}) + + defp assoc([{:map, hash_map, meta} | pairs]) do + {:map, merge, _} = hash_map(pairs) + {:map, Map.merge(hash_map, merge), meta} + end + + defp dissoc([{:map, hash_map, meta} | keys]) do + {:map, Map.drop(hash_map, keys), meta} + end + + defp get([{:map, map, _}, key]), do: Map.get(map, key, nil) + defp get(_), do: nil + + defp meta([{_type, _ast, meta}]), do: meta + defp meta([%Function{meta: meta}]), do: meta + defp meta(_), do: nil + + defp with_meta([{type, ast, _old_meta}, meta]), do: {type, ast, meta} + defp with_meta([%Function{} = func, meta]), do: %{func | meta: meta} + defp with_meta(_), do: nil + + defp deref(args) do + apply(&Mal.Atom.deref/1, args) + end + + defp reset!(args) do + apply(&Mal.Atom.reset!/2, args) + end + + defp swap!([atom, function | args]) do + Mal.Atom.swap!(atom, function, args) + end + + defp conj([{:list, ast, meta} | args]) do + new_list = Enum.reverse(args) ++ ast + {:list, new_list, meta} + end + + defp conj([{:vector, ast, meta} | args]) do + {:vector, ast ++ args, meta} + end + + defp seq([nil]), do: nil + defp seq([{:list, [], _meta}]), do: nil + defp seq([{:list, ast, meta}]), do: {:list, ast, meta} + defp seq([{:vector, [], _meta}]), do: nil + defp seq([{:vector, ast, meta}]), do: {:list, ast, meta} + defp seq([""]), do: nil + defp seq([s]), do: {:list, String.split(s, "", trim: true), nil} + defp seq(_), do: nil + + defp fn?([%Function{macro: false}]), do: true + defp fn?(_), do: false + + defp macro?([%Function{macro: true}]), do: true + defp macro?(_), do: false +end diff --git a/impls/elixir/lib/mal/env.ex b/impls/elixir/lib/mal/env.ex new file mode 100644 index 0000000000..c7ccc4a1a0 --- /dev/null +++ b/impls/elixir/lib/mal/env.ex @@ -0,0 +1,60 @@ +defmodule Mal.Env do + import Mal.Types + + def new(outer \\ nil, binds \\ [], exprs \\ []) + def new(outer, binds, exprs) do + {:ok, pid} = Agent.start_link(fn -> + %{outer: outer, env: %{}} + end) + + set_bindings(pid, binds, exprs) + end + + defp set_bindings(pid, [], []), do: pid + defp set_bindings(pid, ["&", key], exprs) do + set(pid, key, list(exprs)) + pid + end + + defp set_bindings(pid, [key | binds], [value | exprs]) do + set(pid, key, value) + set_bindings(pid, binds, exprs) + end + + def set(pid, key, value) do + Agent.update(pid, fn map -> + %{map | :env => Map.put(map.env, key, value)} + end) + end + + def merge(pid, env_values) do + Agent.update(pid, fn map -> + %{map | :env => Map.merge(map.env, env_values)} + end) + end + + def find(pid, key) do + Agent.get(pid, fn map -> + case Map.has_key?(map.env, key) do + true -> pid + false -> map.outer && find(map.outer, key) + end + end) + end + + def retrieve_key(pid, key) do + Agent.get(pid, fn map -> + case Map.fetch(map.env, key) do + {:ok, value} -> {:ok, value} + :error -> :not_found + end + end) + end + + def get(pid, key) do + case find(pid, key) do + nil -> :not_found + env -> retrieve_key(env, key) + end + end +end diff --git a/impls/elixir/lib/mal/printer.ex b/impls/elixir/lib/mal/printer.ex new file mode 100644 index 0000000000..8651b3232a --- /dev/null +++ b/impls/elixir/lib/mal/printer.ex @@ -0,0 +1,50 @@ +defmodule Mal.Printer do + alias Mal.Function + + def print_str(mal, print_readably \\ true) + def print_str(mal, _) when is_atom(mal), do: inspect(mal) + def print_str(mal, _) when is_integer(mal), do: Integer.to_string(mal) + def print_str(mal, _) when is_function(mal), do: inspect(mal) + def print_str(%Function{value: mal, macro: true}, _), do: "#Macro<#{inspect(mal)}" + def print_str(%Function{value: mal}, _), do: inspect(mal) + def print_str({:symbol, value}, _), do: value + def print_str({:exception, exception}, print_readably) do + print_str(exception, print_readably) + end + def print_str(mal, false) when is_bitstring(mal), do: mal + def print_str(mal, true) when is_bitstring(mal), do: inspect(mal) + + def print_str({:atom, _pid} = atom, print_readably) do + output = atom + |> Mal.Atom.deref + |> print_str(print_readably) + + "(atom #{output})" + end + + def print_str({:map, mal, _}, print_readably) do + evaluate_pair = fn {key, value} -> + "#{print_str(key, print_readably)} #{print_str(value, print_readably)}" + end + + output = mal + |> Enum.map(evaluate_pair) + |> Enum.join(" ") + + "{#{output}}" + end + + def print_str({:vector, vector, _}, print_readably) do + "[#{print_list(vector, print_readably)}]" + end + + def print_str({:list, mal, _}, print_readably) do + "(#{print_list(mal, print_readably)})" + end + + defp print_list(list, print_readably) do + list + |> Enum.map(fn(x) -> print_str(x, print_readably) end) + |> Enum.join(" ") + end +end diff --git a/impls/elixir/lib/mal/reader.ex b/impls/elixir/lib/mal/reader.ex new file mode 100644 index 0000000000..07f3719c9a --- /dev/null +++ b/impls/elixir/lib/mal/reader.ex @@ -0,0 +1,101 @@ +defmodule Mal.Reader do + import Mal.Types + + def read_str(input) do + case tokenize(input) do + [] -> nil + tokens -> tokens + |> read_form + |> elem(0) + end + end + + def tokenize(input) do + regex = ~r/[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ + Regex.scan(regex, input, capture: :all_but_first) + |> List.flatten + |> List.delete_at(-1) # Remove the last match, which is an empty string + |> Enum.filter(fn token -> not String.starts_with?(token, ";") end) + end + + defp read_form([next | rest] = tokens) do + case next do + "(" -> read_list(tokens) + "[" -> read_vector(tokens) + "{" -> read_hash_map(tokens) + "'" -> create_quote("quote", rest) + "`" -> create_quote("quasiquote", rest) + "~" -> create_quote("unquote", rest) + "~@" -> create_quote("splice-unquote", rest) + "@" -> create_quote("deref", rest) + "^" -> create_meta(rest) + ")" -> throw({:error, "unexpected )"}) + "]" -> throw({:error, "unexpected ]"}) + "}" -> throw({:error, "unexpected }"}) + _ -> + token = read_atom(next) + {token, rest} + end + end + + defp create_meta(tokens) do + {meta, meta_rest} = read_form(tokens) + {token, rest_tokens} = read_form(meta_rest) + new_token = list([{:symbol, "with-meta"}, token, meta]) + {new_token, rest_tokens} + end + + defp create_quote(quote_type, tokens) do + {token, rest_tokens} = read_form(tokens) + new_token = list([{:symbol, quote_type}, token]) + {new_token, rest_tokens} + end + + defp read_list([_ | tokens]) do + {ast, rest} = do_read_sequence(tokens, [], "(", ")") + {list(ast), rest} + end + + defp read_vector([_ | tokens]) do + {ast, rest} = do_read_sequence(tokens, [], "[", "]") + {vector(ast), rest} + end + + defp read_hash_map([_ | tokens]) do + {map, rest} = do_read_sequence(tokens, [], "{", "}") + {hash_map(map), rest} + end + + defp do_read_sequence([], _acc, _start_sep, end_sep), do: throw({:error, "expected #{end_sep}, got EOF"}) + defp do_read_sequence([head | tail] = tokens, acc, start_sep, end_sep) do + cond do + String.starts_with?(head, end_sep) -> + {Enum.reverse(acc), tail} + true -> + {token, rest} = read_form(tokens) + do_read_sequence(rest, [token | acc], start_sep, end_sep) + end + end + + defp read_atom("nil"), do: nil + defp read_atom("true"), do: true + defp read_atom("false"), do: false + defp read_atom(":" <> rest), do: String.to_atom(rest) + defp read_atom(token) do + cond do + String.match?(token, ~r/^"(?:\\.|[^\\"])*"$/) -> + token + |> Code.string_to_quoted + |> elem(1) + + String.starts_with?(token, "\"") -> + throw({:error, "expected '\"', got EOF"}) + + integer?(token) -> + Integer.parse(token) + |> elem(0) + + true -> {:symbol, token} + end + end +end diff --git a/impls/elixir/lib/mal/types.ex b/impls/elixir/lib/mal/types.ex new file mode 100644 index 0000000000..6443c0b613 --- /dev/null +++ b/impls/elixir/lib/mal/types.ex @@ -0,0 +1,42 @@ +defmodule Mal.Types do + def integer?(input) do + Regex.match?(~r/^-?[0-9]+$/, input) + end + + def hash_map(ast) do + map = ast + |> Enum.chunk(2) + |> Enum.map(&List.to_tuple/1) + |> Enum.into(%{}) + + {:map, map, nil} + end + + def map?([{:map, _ast, _meta}]), do: true + def map?(_), do: false + + def list(ast), do: {:list, ast, nil} + + def list?([{:list, _, _}]), do: true + def list?(_), do: false + + def vector(ast), do: {:vector, ast, nil} + + def vector?([{:vector, _ast, _meta}]), do: true + def vector?(_), do: false + + def symbol?([{:symbol, _}]), do: true + def symbol?(_), do: false + + def atom([value]) do + pid = Mal.Atom.new(value) + {:atom, pid} + end + + def atom?([{:atom, _}]), do: true + def atom?(_), do: false +end + +defmodule Mal.Function do + defstruct value: nil, macro: false, meta: nil +end diff --git a/impls/elixir/lib/mix/tasks/step0_repl.ex b/impls/elixir/lib/mix/tasks/step0_repl.ex new file mode 100644 index 0000000000..4cd3efec2a --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step0_repl.ex @@ -0,0 +1,30 @@ +defmodule Mix.Tasks.Step0Repl do + def run(_), do: loop() + + defp loop do + Mal.Core.readline("user> ") + |> read_eval_print + |> IO.puts + + loop() + end + + defp read(input) do + input + end + + defp eval(input) do + input + end + + defp print(input) do + input + end + + defp read_eval_print(:eof), do: exit(:normal) + defp read_eval_print(line) do + read(line) + |> eval + |> print + end +end diff --git a/impls/elixir/lib/mix/tasks/step1_read_print.ex b/impls/elixir/lib/mix/tasks/step1_read_print.ex new file mode 100644 index 0000000000..9569e68fb6 --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step1_read_print.ex @@ -0,0 +1,30 @@ +defmodule Mix.Tasks.Step1ReadPrint do + def run(_), do: loop() + + defp loop do + Mal.Core.readline("user> ") + |> read_eval_print + |> IO.puts + + loop() + end + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval(ast), do: ast + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof), do: exit(:normal) + defp read_eval_print(line) do + read(line) + |> eval + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step2_eval.ex b/impls/elixir/lib/mix/tasks/step2_eval.ex new file mode 100644 index 0000000000..b4cb23a284 --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step2_eval.ex @@ -0,0 +1,74 @@ +defmodule Mix.Tasks.Step2Eval do + @repl_env %{ + "+" => &+/2, + "-" => &-/2, + "*" => &*/2, + "/" => &div/2 + } + + def run(_), do: loop() + + defp loop do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print + |> IO.puts + + loop() + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Map.fetch(env, symbol) do + {:ok, value} -> value + :error -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval(ast, env) do + # IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + eval_ast(ast, env) + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + args = Enum.map(args, fn elem -> eval(elem, env) end) + apply(func, args) + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof), do: exit(:normal) + defp read_eval_print(line) do + read(line) + |> eval(@repl_env) + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step3_env.ex b/impls/elixir/lib/mix/tasks/step3_env.ex new file mode 100644 index 0000000000..786861f399 --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step3_env.ex @@ -0,0 +1,104 @@ +defmodule Mix.Tasks.Step3Env do + @initial_env %{ + "+" => &+/2, + "-" => &-/2, + "*" => &*/2, + "/" => &div/2 + } + + def run(_) do + env = Mal.Env.new() + Mal.Env.merge(env, @initial_env) + loop(env) + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + args = Enum.map(args, fn elem -> eval(elem, env) end) + apply(func, args) + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex b/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex new file mode 100644 index 0000000000..c0c5232b1a --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step4_if_fn_do.ex @@ -0,0 +1,144 @@ +defmodule Mix.Tasks.Step4IfFnDo do + import Mal.Types + alias Mal.Function + + def run(_) do + env = Mal.Env.new() + Mal.Env.merge(env, Mal.Core.namespace) + bootstrap(env) + loop(env) + end + + defp bootstrap(env) do + # not: + read_eval_print(""" + (def! not + (fn* (a) (if a false true))) + """, env) + + Mal.Env.set(env, "eval", %Function{value: fn [ast] -> + eval(ast, env) + end}) + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do + result = eval(condition, env) + if result == nil or result == false do + case if_false do + [] -> nil + [body] -> eval(body, env) + end + else + eval(if_true, env) + end + end + + defp eval_list([{:symbol, "do"} | ast], env, _) do + ast + |> List.delete_at(-1) + |> Enum.map(fn elem -> eval(elem, env) end) + eval(List.last(ast), env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) + when list_type == :list or list_type == :vector do + param_symbols = for {:symbol, symbol} <- params, do: symbol + + closure = fn args -> + inner = Mal.Env.new(env, param_symbols, args) + eval(body, inner) + end + + %Function{value: closure} + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + args = Enum.map(args, fn elem -> eval(elem, env) end) + func.value.(args) + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step5_tco.ex b/impls/elixir/lib/mix/tasks/step5_tco.ex new file mode 100644 index 0000000000..8ad7d9be33 --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step5_tco.ex @@ -0,0 +1,147 @@ +defmodule Mix.Tasks.Step5Tco do + import Mal.Types + alias Mal.Function + + def run(_) do + env = Mal.Env.new() + Mal.Env.merge(env, Mal.Core.namespace) + bootstrap(env) + loop(env) + end + + defp bootstrap(env) do + # not: + read_eval_print(""" + (def! not + (fn* (a) (if a false true))) + """, env) + + Mal.Env.set(env, "eval", %Function{value: fn [ast] -> + eval(ast, env) + end}) + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do + result = eval(condition, env) + if result == nil or result == false do + case if_false do + [] -> nil + [body] -> eval(body, env) + end + else + eval(if_true, env) + end + end + + defp eval_list([{:symbol, "do"} | ast], env, _) do + ast + |> List.delete_at(-1) + |> Enum.map(fn elem -> eval(elem, env) end) + eval(List.last(ast), env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) + when list_type == :list or list_type == :vector do + param_symbols = for {:symbol, symbol} <- params, do: symbol + + closure = fn args -> + inner = Mal.Env.new(env, param_symbols, args) + eval(body, inner) + end + + %Function{value: closure} + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + args = Enum.map(args, fn elem -> eval(elem, env) end) + case func do + %Function{value: closure} -> closure.(args) + _ -> func.(args) + end + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step6_file.ex b/impls/elixir/lib/mix/tasks/step6_file.ex new file mode 100644 index 0000000000..0503ea32ac --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step6_file.ex @@ -0,0 +1,167 @@ +defmodule Mix.Tasks.Step6File do + import Mal.Types + alias Mal.Function + + def run(args) do + env = Mal.Env.new() + Mal.Env.merge(env, Mal.Core.namespace) + bootstrap(args, env) + loop(env) + end + + defp load_file(file_name, env) do + read_eval_print(""" + (load-file "#{file_name}") + """, env) + exit(:normal) + end + + defp bootstrap(args, env) do + # not: + read_eval_print(""" + (def! not + (fn* (a) (if a false true))) + """, env) + + # load-file: + read_eval_print(""" + (def! load-file + (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + """, env) + + Mal.Env.set(env, "eval", %Function{value: fn [ast] -> + eval(ast, env) + end}) + + case args do + [file_name | rest] -> + Mal.Env.set(env, "*ARGV*", list(rest)) + load_file(file_name, env) + + [] -> + Mal.Env.set(env, "*ARGV*", list([])) + end + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do + result = eval(condition, env) + if result == nil or result == false do + case if_false do + [] -> nil + [body] -> eval(body, env) + end + else + eval(if_true, env) + end + end + + defp eval_list([{:symbol, "do"} | ast], env, _) do + ast + |> List.delete_at(-1) + |> Enum.map(fn elem -> eval(elem, env) end) + eval(List.last(ast), env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) + when list_type == :list or list_type == :vector do + param_symbols = for {:symbol, symbol} <- params, do: symbol + + closure = fn args -> + inner = Mal.Env.new(env, param_symbols, args) + eval(body, inner) + end + + %Function{value: closure} + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + args = Enum.map(args, fn elem -> eval(elem, env) end) + func.value.(args) + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step7_quote.ex b/impls/elixir/lib/mix/tasks/step7_quote.ex new file mode 100644 index 0000000000..75a31abad8 --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step7_quote.ex @@ -0,0 +1,189 @@ +defmodule Mix.Tasks.Step7Quote do + import Mal.Types + alias Mal.Function + + def run(args) do + env = Mal.Env.new() + Mal.Env.merge(env, Mal.Core.namespace) + bootstrap(args, env) + loop(env) + end + + defp load_file(file_name, env) do + read_eval_print(""" + (load-file "#{file_name}") + """, env) + exit(:normal) + end + + defp bootstrap(args, env) do + # not: + read_eval_print(""" + (def! not + (fn* (a) (if a false true))) + """, env) + + # load-file: + read_eval_print(""" + (def! load-file + (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + """, env) + + Mal.Env.set(env, "eval", %Function{value: fn [ast] -> + eval(ast, env) + end}) + + case args do + [file_name | rest] -> + Mal.Env.set(env, "*ARGV*", list(rest)) + load_file(file_name, env) + + [] -> + Mal.Env.set(env, "*ARGV*", list([])) + end + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast + + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) + + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do + result = eval(condition, env) + if result == nil or result == false do + case if_false do + [] -> nil + [body] -> eval(body, env) + end + else + eval(if_true, env) + end + end + + defp eval_list([{:symbol, "do"} | ast], env, _) do + ast + |> List.delete_at(-1) + |> Enum.map(fn elem -> eval(elem, env) end) + eval(List.last(ast), env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) + when list_type == :list or list_type == :vector do + param_symbols = for {:symbol, symbol} <- params, do: symbol + + closure = fn args -> + inner = Mal.Env.new(env, param_symbols, args) + eval(body, inner) + end + + %Function{value: closure} + end + + defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do + ast |> quasiquote + |> eval(env) + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + args = Enum.map(args, fn elem -> eval(elem, env) end) + func.value.(args) + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step8_macros.ex b/impls/elixir/lib/mix/tasks/step8_macros.ex new file mode 100644 index 0000000000..1cb777d71b --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step8_macros.ex @@ -0,0 +1,209 @@ +defmodule Mix.Tasks.Step8Macros do + import Mal.Types + alias Mal.Function + + def run(args) do + env = Mal.Env.new() + Mal.Env.merge(env, Mal.Core.namespace) + bootstrap(args, env) + loop(env) + end + + defp load_file(file_name, env) do + read_eval_print(""" + (load-file "#{file_name}") + """, env) + exit(:normal) + end + + defp bootstrap(args, env) do + # not: + read_eval_print(""" + (def! not + (fn* (a) (if a false true))) + """, env) + + # load-file: + read_eval_print(""" + (def! load-file + (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + """, env) + + # cond + read_eval_print(""" + (defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw \"odd number of forms to cond\")) + (cons 'cond (rest (rest xs)))))))" + """, env) + + Mal.Env.set(env, "eval", %Function{value: fn [ast] -> + eval(ast, env) + end}) + + case args do + [file_name | rest] -> + Mal.Env.set(env, "*ARGV*", list(rest)) + load_file(file_name, env) + + [] -> + Mal.Env.set(env, "*ARGV*", list([])) + end + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast + + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) + + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do + result = eval(condition, env) + if result == nil or result == false do + case if_false do + [] -> nil + [body] -> eval(body, env) + end + else + eval(if_true, env) + end + end + + defp eval_list([{:symbol, "do"} | ast], env, _) do + ast + |> List.delete_at(-1) + |> Enum.map(fn elem -> eval(elem, env) end) + eval(List.last(ast), env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "defmacro!"}, {:symbol, key}, function], env, _) do + macro = %{eval(function, env) | macro: true} + Mal.Env.set(env, key, macro) + macro + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) + when list_type == :list or list_type == :vector do + param_symbols = for {:symbol, symbol} <- params, do: symbol + + closure = fn args -> + inner = Mal.Env.new(env, param_symbols, args) + eval(body, inner) + end + + %Function{value: closure} + end + + defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do + ast |> quasiquote + |> eval(env) + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + case func do + %Function{macro: true} -> func.value.(args) |> eval(env) + _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) + end + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, message} -> IO.puts("Error: #{message}") + end +end diff --git a/impls/elixir/lib/mix/tasks/step9_try.ex b/impls/elixir/lib/mix/tasks/step9_try.ex new file mode 100644 index 0000000000..d72d2b632d --- /dev/null +++ b/impls/elixir/lib/mix/tasks/step9_try.ex @@ -0,0 +1,236 @@ +defmodule Mix.Tasks.Step9Try do + import Mal.Types + alias Mal.Function + + def run(args) do + env = Mal.Env.new() + Mal.Env.merge(env, Mal.Core.namespace) + bootstrap(args, env) + loop(env) + end + + defp load_file(file_name, env) do + read_eval_print(""" + (load-file "#{file_name}") + """, env) + exit(:normal) + end + + defp bootstrap(args, env) do + # not: + read_eval_print(""" + (def! not + (fn* (a) (if a false true))) + """, env) + + # load-file: + read_eval_print(""" + (def! load-file + (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + """, env) + + # cond + read_eval_print(""" + (defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw \"odd number of forms to cond\")) + (cons 'cond (rest (rest xs)))))))" + """, env) + + Mal.Env.set(env, "eval", %Function{value: fn [ast] -> + eval(ast, env) + end}) + + case args do + [file_name | rest] -> + Mal.Env.set(env, "*ARGV*", list(rest)) + load_file(file_name, env) + + [] -> + Mal.Env.set(env, "*ARGV*", list([])) + end + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast + + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) + + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do + result = eval(condition, env) + if result == nil or result == false do + case if_false do + [] -> nil + [body] -> eval(body, env) + end + else + eval(if_true, env) + end + end + + defp eval_list([{:symbol, "do"} | ast], env, _) do + ast + |> List.delete_at(-1) + |> Enum.map(fn elem -> eval(elem, env) end) + eval(List.last(ast), env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "defmacro!"}, {:symbol, key}, function], env, _) do + macro = %{eval(function, env) | macro: true} + Mal.Env.set(env, key, macro) + macro + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) + when list_type == :list or list_type == :vector do + param_symbols = for {:symbol, symbol} <- params, do: symbol + + closure = fn args -> + inner = Mal.Env.new(env, param_symbols, args) + eval(body, inner) + end + + %Function{value: closure} + end + + defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do + ast |> quasiquote + |> eval(env) + end + + # (try* A (catch* B C)) + defp eval_list([{:symbol, "try*"}, try_form, {:list, catch_list, _meta}], env, _) do + eval_try(try_form, catch_list, env) + end + defp eval_list([{:symbol, "try*"}, try_form], env, _) do + eval(try_form, env) + end + defp eval_list([{:symbol, "try*"}, _try_form, _], _env, _) do + throw({:error, "try* requires a list as the second parameter"}) + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + case func do + %Function{macro: true} -> func.value.(args) |> eval(env) + _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) + end + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp eval_try(try_form, + [{:symbol, "catch*"}, {:symbol, exception}, catch_form], env) do + try do + eval(try_form, env) + catch + {:error, message}-> + catch_env = Mal.Env.new(env) + Mal.Env.set(catch_env, exception, {:exception, message}) + eval(catch_form, catch_env) + end + end + defp eval_try(_try_form, _catch_list, _env) do + throw({:error, "catch* requires two arguments"}) + end + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, exception} -> + IO.puts("Error: #{Mal.Printer.print_str(exception)}") + end +end diff --git a/impls/elixir/lib/mix/tasks/stepA_mal.ex b/impls/elixir/lib/mix/tasks/stepA_mal.ex new file mode 100644 index 0000000000..f85cd2444a --- /dev/null +++ b/impls/elixir/lib/mix/tasks/stepA_mal.ex @@ -0,0 +1,245 @@ +defmodule Mix.Tasks.StepAMal do + import Mal.Types + alias Mal.Function + + # for escript execution + def main(args) do + run(args) + end + + def run(args) do + env = Mal.Env.new() + Mal.Env.merge(env, Mal.Core.namespace) + bootstrap(args, env) + loop(env) + end + + defp load_file(file_name, env) do + read_eval_print(""" + (load-file "#{file_name}") + """, env) + exit(:normal) + end + + defp bootstrap(args, env) do + # *host-language* + read_eval_print("(def! *host-language* \"Elixir\")", env) + + # not: + read_eval_print(""" + (def! not + (fn* (a) (if a false true))) + """, env) + + # load-file: + read_eval_print(""" + (def! load-file + (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + """, env) + + # cond + read_eval_print(""" + (defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw \"odd number of forms to cond\")) + (cons 'cond (rest (rest xs)))))))" + """, env) + + Mal.Env.set(env, "eval", %Function{value: fn [ast] -> + eval(ast, env) + end}) + + case args do + [file_name | rest] -> + Mal.Env.set(env, "*ARGV*", list(rest)) + load_file(file_name, env) + + [] -> + Mal.Env.set(env, "*ARGV*", list([])) + read_eval_print("(println (str \"Mal [\" *host-language* \"]\"))", env) + end + end + + defp loop(env) do + IO.write(:stdio, "user> ") + IO.read(:stdio, :line) + |> read_eval_print(env) + |> IO.puts + + loop(env) + end + + defp eval_ast({:list, ast, meta}, env) when is_list(ast) do + eval_list(ast, env, meta) + end + + defp eval_ast({:map, ast, meta}, env) do + map = for {key, value} <- ast, into: %{} do + {key, eval(value, env)} + end + + {:map, map, meta} + end + + defp eval_ast({:vector, ast, meta}, env) do + {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + end + + defp eval_ast({:symbol, symbol}, env) do + case Mal.Env.get(env, symbol) do + {:ok, value} -> value + :not_found -> throw({:error, "'#{symbol}' not found"}) + end + end + + defp eval_ast(ast, _env), do: ast + + defp read(input) do + Mal.Reader.read_str(input) + end + + defp eval_bindings([], env), do: env + defp eval_bindings([{:symbol, key}, binding | tail], env) do + evaluated = eval(binding, env) + Mal.Env.set(env, key, evaluated) + eval_bindings(tail, env) + end + defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) + + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast + + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) + + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) + + defp eval(ast, env) do + case Mal.Env.get(env, "DEBUG-EVAL") do + :not_found -> :ok + {:ok, nil} -> :ok + {:ok, false} -> :ok + _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + end + eval_ast(ast, env) + end + + defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do + result = eval(condition, env) + if result == nil or result == false do + case if_false do + [] -> nil + [body] -> eval(body, env) + end + else + eval(if_true, env) + end + end + + defp eval_list([{:symbol, "do"} | ast], env, _) do + ast + |> List.delete_at(-1) + |> Enum.map(fn elem -> eval(elem, env) end) + eval(List.last(ast), env) + end + + defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do + evaluated = eval(value, env) + Mal.Env.set(env, key, evaluated) + evaluated + end + + defp eval_list([{:symbol, "defmacro!"}, {:symbol, key}, function], env, _) do + macro = %{eval(function, env) | macro: true} + Mal.Env.set(env, key, macro) + macro + end + + defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) + when list_type == :list or list_type == :vector do + let_env = Mal.Env.new(env) + eval_bindings(bindings, let_env) + eval(body, let_env) + end + + defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) + when list_type == :list or list_type == :vector do + param_symbols = for {:symbol, symbol} <- params, do: symbol + + closure = fn args -> + inner = Mal.Env.new(env, param_symbols, args) + eval(body, inner) + end + + %Function{value: closure} + end + + defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do + ast |> quasiquote + |> eval(env) + end + + # (try* A (catch* B C)) + defp eval_list([{:symbol, "try*"}, try_form, {:list, catch_list, _meta}], env, _) do + eval_try(try_form, catch_list, env) + end + defp eval_list([{:symbol, "try*"}, try_form], env, _) do + eval(try_form, env) + end + defp eval_list([{:symbol, "try*"}, _try_form, _], _env, _) do + throw({:error, "try* requires a list as the second parameter"}) + end + + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + case func do + %Function{macro: true} -> func.value.(args) |> eval(env) + _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) + end + end + + defp eval_list([], _env, meta), do: {:list, [], meta} + + defp eval_try(try_form, + [{:symbol, "catch*"}, {:symbol, exception}, catch_form], env) do + try do + eval(try_form, env) + catch + {:error, message}-> + catch_env = Mal.Env.new(env) + Mal.Env.set(catch_env, exception, {:exception, message}) + eval(catch_form, catch_env) + end + end + defp eval_try(_try_form, _catch_list, _env) do + throw({:error, "catch* requires two arguments"}) + end + + defp print(value) do + Mal.Printer.print_str(value) + end + + defp read_eval_print(:eof, _env), do: exit(:normal) + defp read_eval_print(line, env) do + read(line) + |> eval(env) + |> print + catch + {:error, exception} -> + IO.puts("Error: #{Mal.Printer.print_str(exception)}") + end +end diff --git a/impls/elixir/mix.exs b/impls/elixir/mix.exs new file mode 100644 index 0000000000..5d768f6e0a --- /dev/null +++ b/impls/elixir/mix.exs @@ -0,0 +1,38 @@ +defmodule Mal.Mixfile do + use Mix.Project + + def project do + [app: :mal, + version: "0.0.1", + elixir: "~> 1.5", + build_embedded: Mix.env == :prod, + start_permanent: Mix.env == :prod, + deps: deps(), + default_task: "stepA_mal", + escript: escript()] + end + + def escript do + [main_module: Mix.Tasks.StepAMal] + end + + # Configuration for the OTP application + # + # Type `mix help compile.app` for more information + def application do + [applications: [:logger]] + end + + # Dependencies can be Hex packages: + # + # {:mydep, "~> 0.3.0"} + # + # Or git/path repositories: + # + # {:mydep, git: "https://github.com/elixir-lang/mydep.git", tag: "0.1.0"} + # + # Type `mix help deps` for more examples and options + defp deps do + [] + end +end diff --git a/impls/elixir/run b/impls/elixir/run new file mode 100755 index 0000000000..bfd505014b --- /dev/null +++ b/impls/elixir/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +cd $(dirname $0) +exec mix ${STEP:-stepA_mal} "${@}" diff --git a/impls/elixir/tests/step5_tco.mal b/impls/elixir/tests/step5_tco.mal new file mode 100644 index 0000000000..6b1ba58860 --- /dev/null +++ b/impls/elixir/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Elixir: skipping non-TCO recursion +;; Reason: Elixir has TCO, test always completes. diff --git a/impls/elm/.dockerignore b/impls/elm/.dockerignore new file mode 100644 index 0000000000..3c3629e647 --- /dev/null +++ b/impls/elm/.dockerignore @@ -0,0 +1 @@ +node_modules diff --git a/impls/elm/Dockerfile b/impls/elm/Dockerfile new file mode 100644 index 0000000000..c1d2d6eb06 --- /dev/null +++ b/impls/elm/Dockerfile @@ -0,0 +1,25 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm + +ENV HOME /mal +ENV NPM_CONFIG_CACHE /mal/.npm diff --git a/impls/elm/Makefile b/impls/elm/Makefile new file mode 100644 index 0000000000..f52164ec06 --- /dev/null +++ b/impls/elm/Makefile @@ -0,0 +1,36 @@ +SOURCES = src/Step0_repl.elm src/Step1_read_print.elm src/Step2_eval.elm \ + src/Step3_env.elm src/Step4_if_fn_do.elm src/Step5_tco.elm src/Step6_file.elm \ + src/Step7_quote.elm src/Step8_macros.elm src/Step9_try.elm src/StepA_mal.elm + +BINS = $(SOURCES:src/Step%.elm=step%.js) + +ELM = node_modules/.bin/elm + +all: node_modules $(BINS) + +node_modules: + npm install + +step%.js: src/Step%.elm node_modules + $(ELM) make $< --output $@ + +STEP0_SOURCES = src/IO.elm +STEP1_SOURCES = $(STEP0_SOURCES) src/Reader.elm src/Printer.elm src/Utils.elm src/Types.elm src/Env.elm +STEP2_SOURCES = $(STEP1_SOURCES) +STEP3_SOURCES = $(STEP2_SOURCES) +STEP4_SOURCES = $(STEP3_SOURCES) src/Core.elm src/Eval.elm + +step0_repl.js: $(STEP0_SOURCES) +step1_read_print.js: $(STEP1_SOURCES) +step2_eval.js: $(STEP2_SOURCES) +step3_env.js: $(STEP3_SOURCES) +step4_if_fn_do.js: $(STEP4_SOURCES) +step5_tco.js: $(STEP4_SOURCES) +step6_file.js: $(STEP4_SOURCES) +step7_quote.js: $(STEP4_SOURCES) +step8_macros.js: $(STEP4_SOURCES) +step9_try.js: $(STEP4_SOURCES) +stepA_mal.js: $(STEP4_SOURCES) + +clean: + rm -f $(BINS) diff --git a/impls/elm/bootstrap.js b/impls/elm/bootstrap.js new file mode 100644 index 0000000000..53c2f60cb0 --- /dev/null +++ b/impls/elm/bootstrap.js @@ -0,0 +1,36 @@ +var readline = require('./node_readline'); +var fs = require('fs'); + +// The first two arguments are: 'node' and 'bootstrap.js' +// The third argument is the name of the Elm module to load. +var args = process.argv.slice(2); +var mod = require('./' + args[0]); + +var app = mod.Elm['S' + args[0].slice(1)].init({ + flags: { + args: args.slice(1) + } +}); + +// Hook up the writeLine and readLine ports of the app. +app.ports.writeLine.subscribe(function(line) { + console.log(line); + app.ports.input.send({"tag": "lineWritten"}); +}); + +app.ports.readLine.subscribe(function(prompt) { + var line = readline.readline(prompt); + app.ports.input.send({"tag": "lineRead", "line": line}); +}); + +// Read the contents of a file. +if ('readFile' in app.ports) { + app.ports.readFile.subscribe(function(filename) { + try { + var contents = fs.readFileSync(filename, 'utf8'); + app.ports.input.send({"tag": "fileRead", "contents": contents}); + } catch (e) { + app.ports.input.send({"tag": "exception", "message": e.message}); + } + }); +} diff --git a/impls/elm/elm.json b/impls/elm/elm.json new file mode 100644 index 0000000000..d3cc54e049 --- /dev/null +++ b/impls/elm/elm.json @@ -0,0 +1,21 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/core": "1.0.5", + "elm/json": "1.1.3", + "elm/parser": "1.1.0", + "elm/regex": "1.0.0", + "elm/time": "1.0.0" + }, + "indirect": {} + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/impls/elm/node_readline.js b/impls/elm/node_readline.js new file mode 100644 index 0000000000..2fb1e82263 --- /dev/null +++ b/impls/elm/node_readline.js @@ -0,0 +1,53 @@ +// IMPORTANT: choose one +var RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL +//var RL_LIB = "libedit.so.2"; + +var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); + +var rlwrap = {}; // namespace for this module in web context + +var koffi = require('koffi'), + fs = require('fs'); + +var rllib = null; +try { + rllib = koffi.load(RL_LIB); +} catch (e) { + console.error('ERROR loading RL_LIB:', RL_LIB, e); + throw e; +} +var readlineFunc = rllib.func('char *readline(char *)'); +var addHistoryFunc = rllib.func('int add_history(char *)'); + +var rl_history_loaded = false; + +exports.readline = rlwrap.readline = function(prompt) { + prompt = typeof prompt !== 'undefined' ? prompt : "user> "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i> MalFunction + + binaryOp fn retType args = + case args of + [ MalInt x, MalInt y ] -> + Eval.succeed (retType (fn x y)) + + _ -> + Eval.fail "unsupported arguments" + + {- list -} + core_list = + Eval.succeed << MalList Nothing + + {- list? -} + isList args = + case args of + [ MalList _ _ ] -> + Eval.succeed (MalBool True) + + _ -> + Eval.succeed (MalBool False) + + {- empty? -} + isEmpty args = + case args of + [ MalList _ list ] -> + Eval.succeed <| MalBool (List.isEmpty list) + + [ MalVector _ vec ] -> + Eval.succeed <| MalBool (Array.isEmpty vec) + + _ -> + Eval.fail "unsupported arguments" + + {- count -} + count args = + case args of + [ MalNil ] -> + Eval.succeed (MalInt 0) + + [ MalList _ list ] -> + Eval.succeed <| MalInt (List.length list) + + [ MalVector _ vec ] -> + Eval.succeed <| MalInt (Array.length vec) + + _ -> + Eval.fail "unsupported arguments" + + equalLists a b = + case ( a, b ) of + ( [], [] ) -> + True + + ( x :: xs, y :: ys ) -> + if deepEquals (x, y) then + equalLists xs ys + + else + False + + _ -> + False + + compareListTo list other = + case other of + MalList _ otherList -> + equalLists list otherList + + MalVector _ vec -> + equalLists list (Array.toList vec) + + _ -> + False + + equalMaps a b = + if Dict.keys a /= Dict.keys b then + False + + else + zip (Dict.values a) (Dict.values b) + |> List.map deepEquals + |> List.all identity + + deepEquals c = + case c of + ( MalList _ list, MalList _ otherList ) -> + equalLists list otherList + + ( MalList _ list, MalVector _ vec ) -> + equalLists list (Array.toList vec) + + ( MalList _ _, _ ) -> + False + + ( MalVector _ vec, MalList _ list ) -> + equalLists (Array.toList vec) list + + ( MalVector _ vec, MalVector _ otherVec ) -> + equalLists (Array.toList vec) (Array.toList otherVec) + + ( MalVector _ _, _ ) -> + False + + ( MalMap _ map, MalMap _ otherMap ) -> + equalMaps map otherMap + + ( MalMap _ _, _ ) -> + False + + ( _, MalMap _ _ ) -> + False + + (a, b) -> + a == b + + {- = -} + equals args = + case args of + [ a, b ] -> + Eval.succeed <| MalBool (deepEquals (a, b)) + + _ -> + Eval.fail "unsupported arguments" + + {- pr-str -} + prStr args = + Eval.withEnv + (\env -> + args + |> List.map (printString env True) + |> String.join " " + |> MalString + |> Eval.succeed + ) + + {- str -} + core_str args = + Eval.withEnv + (\env -> + args + |> List.map (printString env False) + |> String.join "" + |> MalString + |> Eval.succeed + ) + + {- helper function to write a string to stdout -} + writeLine str = + Eval.io (IO.writeLine str) + (\msg -> + case msg of + LineWritten -> + Eval.succeed MalNil + + _ -> + Eval.fail "wrong IO, expected LineWritten" + ) + + prn args = + Eval.withEnv + (\env -> + args + |> List.map (printString env True) + |> String.join " " + |> writeLine + ) + + println args = + Eval.withEnv + (\env -> + args + |> List.map (printString env False) + |> String.join " " + |> writeLine + ) + + printEnv args = + case args of + [] -> + Eval.withEnv (Printer.printEnv >> writeLine) + + _ -> + Eval.fail "unsupported arguments" + + readString args = + case args of + [ MalString str ] -> + case Reader.readString str of + Ok ast -> + Eval.succeed ast + + Err msg -> + Eval.fail msg + + _ -> + Eval.fail "unsupported arguments" + + slurp args = + case args of + [ MalString filename ] -> + Eval.io (IO.readFile filename) + (\msg -> + case msg of + FileRead contents -> + Eval.succeed <| MalString contents + + Exception errMsg -> + Eval.fail errMsg + + _ -> + Eval.fail "wrong IO, expected FileRead" + ) + + _ -> + Eval.fail "unsupported arguments" + + atom args = + case args of + [ value ] -> + Eval.withEnv + (\env -> + case Env.newAtom value env of + ( newEnv, atomId ) -> + Eval.setEnv newEnv + |> Eval.map (\_ -> MalAtom atomId) + ) + + _ -> + Eval.fail "unsupported arguments" + + isAtom args = + case args of + [ MalAtom _ ] -> + Eval.succeed <| MalBool True + + _ -> + Eval.succeed <| MalBool False + + deref args = + case args of + [ MalAtom atomId ] -> + Eval.withEnv (Env.getAtom atomId >> Eval.succeed) + + _ -> + Eval.fail "unsupported arguments" + + reset args = + case args of + [ MalAtom atomId, value ] -> + Eval.modifyEnv (Env.setAtom atomId value) + |> Eval.map (always value) + + _ -> + Eval.fail "unsupported arguments" + + {- helper function for calling a core or user function -} + callFn func args = + case func of + CoreFunc _ fn -> + fn args + + UserFunc { eagerFn } -> + eagerFn args + + swap args = + case args of + (MalAtom atomId) :: (MalFunction func) :: moreArgs -> + Eval.withEnv + (\env -> + let + value = + Env.getAtom atomId env + in + callFn func (value :: moreArgs) + ) + |> Eval.andThen + (\res -> + Eval.modifyEnv (Env.setAtom atomId res) + |> Eval.map (always res) + ) + + _ -> + Eval.fail "unsupported arguments" + + gc args = + Eval.withEnv (Env.gc MalNil >> Printer.printEnv >> writeLine) + + setDebug enabled = + Eval.modifyEnv + (\env -> + { env | debug = enabled } + ) + |> Eval.andThen (\_ -> Eval.succeed MalNil) + + debug args = + case args of + [ MalBool value ] -> + setDebug value + + _ -> + Eval.withEnv + (\env -> + Eval.succeed (MalBool env.debug) + ) + + typeof args = + case args of + [ MalInt _ ] -> + Eval.succeed <| MalSymbol "int" + + [ MalBool _ ] -> + Eval.succeed <| MalSymbol "bool" + + [ MalString _ ] -> + Eval.succeed <| MalSymbol "string" + + [ MalKeyword _ ] -> + Eval.succeed <| MalSymbol "keyword" + + [ MalSymbol _ ] -> + Eval.succeed <| MalSymbol "symbol" + + [ MalNil ] -> + Eval.succeed <| MalSymbol "nil" + + [ MalList _ _ ] -> + Eval.succeed <| MalSymbol "vector" + + [ MalVector _ _ ] -> + Eval.succeed <| MalSymbol "vector" + + [ MalMap _ _ ] -> + Eval.succeed <| MalSymbol "vector" + + [ MalFunction _ ] -> + Eval.succeed <| MalSymbol "function" + + [ MalAtom _ ] -> + Eval.succeed <| MalSymbol "atom" + + _ -> + Eval.fail "unsupported arguments" + + cons args = + case args of + [ e, MalList _ list ] -> + Eval.succeed <| MalList Nothing (e :: list) + + [ e, MalVector _ vec ] -> + Eval.succeed <| MalList Nothing (e :: (Array.toList vec)) + + _ -> + Eval.fail "unsupported arguments" + + concat args = + let + go arg acc = + case arg of + MalList _ list -> + Eval.succeed (acc ++ list) + + MalVector _ vec -> + Eval.succeed (acc ++ Array.toList vec) + + _ -> + Eval.fail "unsupported arguments" + in + List.foldl (go >> Eval.andThen) (Eval.succeed []) args + |> Eval.map (MalList Nothing) + + core_vec args = + case args of + [MalVector _ xs] -> Eval.succeed <| MalVector Nothing xs + [MalList _ xs] -> Eval.succeed <| MalVector Nothing <| Array.fromList xs + [_] -> Eval.fail "vec: arg type" + _ -> Eval.fail "vec: arg count" + + nth args = + let + get list index = + if index < 0 then + Nothing + + else if index == 0 then + List.head list + + else + case list of + [] -> + Nothing + + _ :: rest -> + get rest (index - 1) + + make res = + case res of + Just value -> + Eval.succeed value + + Nothing -> + Eval.fail "index out of bounds" + in + case args of + [ MalList _ list, MalInt index ] -> + make <| get list index + + [ MalVector _ vec, MalInt index ] -> + make <| Array.get index vec + + _ -> + Eval.fail "unsupported arguments" + + first args = + let + make = + Eval.succeed << Maybe.withDefault MalNil + in + case args of + [ MalNil ] -> + Eval.succeed MalNil + + [ MalList _ list ] -> + make <| List.head list + + [ MalVector _ vec ] -> + make <| Array.get 0 vec + + _ -> + Eval.fail "unsupported arguments" + + core_rest args = + case args of + [ MalNil ] -> + Eval.succeed <| MalList Nothing [] + + [ MalList _ [] ] -> + Eval.succeed <| MalList Nothing [] + + [ MalList _ (head :: tail) ] -> + Eval.succeed <| MalList Nothing tail + + [ MalVector _ vec ] -> + Array.toList vec + |> List.tail + |> Maybe.withDefault [] + |> MalList Nothing + |> Eval.succeed + + _ -> + Eval.fail "unsupported arguments" + + throw args = + case args of + ex :: _ -> + Eval.throw ex + + _ -> + Eval.fail "undefined exception" + + apply args = + case args of + (MalFunction func) :: rest -> + case List.reverse rest of + (MalList _ last) :: middle -> + callFn func ((List.reverse middle) ++ last) + + (MalVector _ last) :: middle -> + callFn func + ((List.reverse middle) + ++ (Array.toList last) + ) + + _ -> + Eval.fail "apply expected the last argument to be a list or vector" + + _ -> + Eval.fail "unsupported arguments" + + core_map args = + let + go func list acc = + case list of + [] -> + Eval.succeed <| MalList Nothing <| List.reverse acc + + inv :: rest -> + callFn func [ inv ] + |> Eval.andThen + (\outv -> + Eval.pushRef outv (go func rest (outv :: acc)) + ) + in + case args of + [ MalFunction func, MalList _ list ] -> + Eval.withStack (go func list []) + + [ MalFunction func, MalVector _ vec ] -> + go func (Array.toList vec) [] + + _ -> + Eval.fail "unsupported arguments" + + isNil args = + Eval.succeed <| + MalBool <| + case args of + MalNil :: _ -> + True + + _ -> + False + + isTrue args = + Eval.succeed <| + MalBool <| + case args of + (MalBool True) :: _ -> + True + + _ -> + False + + isFalse args = + Eval.succeed <| + MalBool <| + case args of + (MalBool False) :: _ -> + True + + _ -> + False + + isNumber args = + Eval.succeed <| + MalBool <| + case args of + (MalInt _) :: _ -> + True + + _ -> + False + + isSymbol args = + Eval.succeed <| + MalBool <| + case args of + (MalSymbol _) :: _ -> + True + + _ -> + False + + isKeyword args = + Eval.succeed <| + MalBool <| + case args of + (MalKeyword _) :: _ -> + True + + _ -> + False + + isVector args = + Eval.succeed <| + MalBool <| + case args of + (MalVector _ _) :: _ -> + True + + _ -> + False + + isMap args = + Eval.succeed <| + MalBool <| + case args of + (MalMap _ _) :: _ -> + True + + _ -> + False + + isString args = + Eval.succeed <| + MalBool <| + case args of + (MalString _) :: _ -> + True + + _ -> + False + + isSequential args = + Eval.succeed <| + MalBool <| + case args of + (MalList _ _) :: _ -> + True + + (MalVector _ _) :: _ -> + True + + _ -> + False + + isFn args = + Eval.succeed <| + MalBool <| + case args of + (MalFunction (CoreFunc _ _)) :: _ -> + True + (MalFunction (UserFunc fn)) :: _ -> + not fn.isMacro + + _ -> + False + + isMacro args = + Eval.succeed <| + MalBool <| + case args of + (MalFunction (UserFunc fn)) :: _ -> + fn.isMacro + + _ -> + False + + symbol args = + case args of + [ MalString str ] -> + Eval.succeed <| MalSymbol str + + _ -> + Eval.fail "unsupported arguments" + + core_keyword args = + case args of + [ MalString str ] -> + Eval.succeed <| MalKeyword str + + [ (MalKeyword _) as kw ] -> + Eval.succeed kw + + _ -> + Eval.fail "unsupported arguments" + + vector args = + Eval.succeed <| MalVector Nothing <| Array.fromList args + + parseKey key = + case key of + MalString str -> + Ok str + + MalKeyword keyword -> + Ok <| String.cons keywordPrefix keyword + + _ -> + Err "map key must be a symbol or keyword" + + buildMap list acc = + case list of + [] -> + Eval.succeed <| MalMap Nothing acc + + key :: value :: rest -> + parseKey key + |> Eval.fromResult + |> Eval.andThen + (\k -> + buildMap rest (Dict.insert k value acc) + ) + + _ -> + Eval.fail "expected an even number of key-value pairs" + + hashMap args = + buildMap args Dict.empty + + assoc args = + case args of + (MalMap _ dict) :: rest -> + buildMap rest dict + + _ -> + Eval.fail "unsupported arguments" + + dissoc args = + let + go keys acc = + case keys of + [] -> + Eval.succeed <| MalMap Nothing acc + + key :: rest -> + parseKey key + |> Eval.fromResult + |> Eval.andThen + (\k -> + go rest (Dict.remove k acc) + ) + in + case args of + (MalMap _ dict) :: keys -> + go keys dict + + _ -> + Eval.fail "unsupported arguments" + + core_get args = + case args of + [ MalNil, key ] -> + Eval.succeed MalNil + + [ MalMap _ dict, key ] -> + parseKey key + |> Eval.fromResult + |> Eval.map + (\k -> + Dict.get k dict + |> Maybe.withDefault MalNil + ) + + _ -> + Eval.fail "unsupported arguments" + + contains args = + case args of + [ MalMap _ dict, key ] -> + parseKey key + |> Eval.fromResult + |> Eval.map (\k -> Dict.member k dict) + |> Eval.map MalBool + + _ -> + Eval.fail "unsupported arguments" + + unparseKey key = + case String.uncons key of + Just ( prefix, rest ) -> + if prefix == keywordPrefix then + MalKeyword rest + + else + MalString key + + _ -> + MalString key + + core_keys args = + case args of + [ MalMap _ dict ] -> + Dict.keys dict + |> List.map unparseKey + |> MalList Nothing + |> Eval.succeed + + _ -> + Eval.fail "unsupported arguments" + + vals args = + case args of + [ MalMap _ dict ] -> + Dict.values dict + |> MalList Nothing + |> Eval.succeed + + _ -> + Eval.fail "unsupported arguments" + + readLine args = + case args of + [ MalString prompt ] -> + Eval.io (IO.readLine prompt) + (\msg -> + case msg of + LineRead (Just line) -> + Eval.succeed (MalString line) + + LineRead Nothing -> + Eval.succeed MalNil + + _ -> + Eval.fail "wrong IO, expected LineRead" + ) + + _ -> + Eval.fail "unsupported arguments" + + withMeta args = + case args of + [ MalFunction (UserFunc func), meta ] -> + Eval.succeed <| MalFunction <| UserFunc { func | meta = Just meta } + + [ MalList _ xs, meta ] -> + Eval.succeed <| MalList (Just meta) xs + + [ MalVector _ xs, meta ] -> + Eval.succeed <| MalVector (Just meta) xs + + [ MalMap _ map, meta ] -> + Eval.succeed <| MalMap (Just meta) map + + [ MalFunction (CoreFunc _ f), meta ] -> + Eval.succeed <| MalFunction (CoreFunc (Just meta) f) + + _ -> + Eval.fail "with-meta expected a user function and a map" + + core_meta args = + case args of + [ MalFunction (UserFunc { meta }) ] -> + Eval.succeed (Maybe.withDefault MalNil meta) + + [ MalFunction (CoreFunc meta f) ] -> + Eval.succeed (Maybe.withDefault MalNil meta) + + [ MalList meta _ ] -> + Eval.succeed (Maybe.withDefault MalNil meta) + + [ MalVector meta _ ] -> + Eval.succeed (Maybe.withDefault MalNil meta) + + [ MalMap meta _ ] -> + Eval.succeed (Maybe.withDefault MalNil meta) + + _ -> + Eval.succeed MalNil + + conj args = + case args of + (MalList _ list) :: rest -> + Eval.succeed <| + MalList Nothing <| + List.reverse rest + ++ list + + (MalVector _ vec) :: rest -> + Eval.succeed <| + MalVector Nothing <| + Array.append + vec + (Array.fromList rest) + + _ -> + Eval.fail "unsupported arguments" + + seq args = + case args of + [ MalNil ] -> + Eval.succeed MalNil + + [ MalList _ [] ] -> + Eval.succeed MalNil + + [ MalString "" ] -> + Eval.succeed MalNil + + [ MalList _ xs ] -> + Eval.succeed (MalList Nothing xs) + + [ MalVector _ vec ] -> + Eval.succeed <| + if Array.isEmpty vec then + MalNil + + else + MalList Nothing <| Array.toList vec + + [ MalString str ] -> + Eval.succeed <| + MalList Nothing <| + (String.toList str + |> List.map String.fromChar + |> List.map MalString + ) + + _ -> + Eval.fail "unsupported arguments" + + requestTime = + Task.perform (GotTime >> Ok >> Input) Time.now + + timeMs args = + case args of + [] -> + Eval.io requestTime + (\msg -> + case msg of + GotTime time -> + Time.posixToMillis time + |> MalInt + |> Eval.succeed + + _ -> + Eval.fail "wrong IO, expected GotTime" + ) + + _ -> + Eval.fail "time-ms takes no arguments" + in + Env.global + |> Env.set "+" (makeFn <| binaryOp (+) MalInt) + |> Env.set "-" (makeFn <| binaryOp (-) MalInt) + |> Env.set "*" (makeFn <| binaryOp (*) MalInt) + |> Env.set "/" (makeFn <| binaryOp (//) MalInt) + |> Env.set "<" (makeFn <| binaryOp (<) MalBool) + |> Env.set ">" (makeFn <| binaryOp (>) MalBool) + |> Env.set "<=" (makeFn <| binaryOp (<=) MalBool) + |> Env.set ">=" (makeFn <| binaryOp (>=) MalBool) + |> Env.set "list" (makeFn core_list) + |> Env.set "list?" (makeFn isList) + |> Env.set "empty?" (makeFn isEmpty) + |> Env.set "count" (makeFn count) + |> Env.set "=" (makeFn equals) + |> Env.set "pr-str" (makeFn prStr) + |> Env.set "str" (makeFn core_str) + |> Env.set "prn" (makeFn prn) + |> Env.set "println" (makeFn println) + |> Env.set "pr-env" (makeFn printEnv) + |> Env.set "read-string" (makeFn readString) + |> Env.set "slurp" (makeFn slurp) + |> Env.set "atom" (makeFn atom) + |> Env.set "atom?" (makeFn isAtom) + |> Env.set "deref" (makeFn deref) + |> Env.set "reset!" (makeFn reset) + |> Env.set "swap!" (makeFn swap) + |> Env.set "gc" (makeFn gc) + |> Env.set "debug!" (makeFn debug) + |> Env.set "typeof" (makeFn typeof) + |> Env.set "cons" (makeFn cons) + |> Env.set "concat" (makeFn concat) + |> Env.set "vec" (makeFn core_vec) + |> Env.set "nth" (makeFn nth) + |> Env.set "first" (makeFn first) + |> Env.set "rest" (makeFn core_rest) + |> Env.set "throw" (makeFn throw) + |> Env.set "apply" (makeFn apply) + |> Env.set "map" (makeFn core_map) + |> Env.set "nil?" (makeFn isNil) + |> Env.set "true?" (makeFn isTrue) + |> Env.set "false?" (makeFn isFalse) + |> Env.set "number?" (makeFn isNumber) + |> Env.set "symbol?" (makeFn isSymbol) + |> Env.set "keyword?" (makeFn isKeyword) + |> Env.set "vector?" (makeFn isVector) + |> Env.set "map?" (makeFn isMap) + |> Env.set "string?" (makeFn isString) + |> Env.set "sequential?" (makeFn isSequential) + |> Env.set "fn?" (makeFn isFn) + |> Env.set "macro?" (makeFn isMacro) + |> Env.set "symbol" (makeFn symbol) + |> Env.set "keyword" (makeFn core_keyword) + |> Env.set "vector" (makeFn vector) + |> Env.set "hash-map" (makeFn hashMap) + |> Env.set "assoc" (makeFn assoc) + |> Env.set "dissoc" (makeFn dissoc) + |> Env.set "get" (makeFn core_get) + |> Env.set "contains?" (makeFn contains) + |> Env.set "keys" (makeFn core_keys) + |> Env.set "vals" (makeFn vals) + |> Env.set "readline" (makeFn readLine) + |> Env.set "with-meta" (makeFn withMeta) + |> Env.set "meta" (makeFn core_meta) + |> Env.set "conj" (makeFn conj) + |> Env.set "seq" (makeFn seq) + |> Env.set "time-ms" (makeFn timeMs) diff --git a/impls/elm/src/Env.elm b/impls/elm/src/Env.elm new file mode 100644 index 0000000000..6edd412417 --- /dev/null +++ b/impls/elm/src/Env.elm @@ -0,0 +1,428 @@ +module Env exposing + ( debug + , enter + , gc + , get + , getAtom + , global + , globalFrameId + , leave + , newAtom + , pop + , push + , pushRef + , ref + , restoreRefs + , set + , setAtom + ) + +import Array +import Dict +import Set +import Types exposing (Env, Frame, MalExpr(..), MalFunction(..)) +import Utils exposing (flip) + + +debug : Env -> String -> a -> a +debug env msg value = + if env.debug then + Debug.log msg value + + else + value + + +globalFrameId : Int +globalFrameId = + 0 + + +defaultGcInterval : Int +defaultGcInterval = + 10 + + +global : Env +global = + { frames = Dict.singleton globalFrameId (emptyFrame Nothing Nothing) + , nextFrameId = globalFrameId + 1 + , currentFrameId = globalFrameId + , atoms = Dict.empty + , nextAtomId = 0 + , debug = False + , gcInterval = defaultGcInterval + , gcCounter = 0 + , stack = [] + , keepFrames = [] + } + + +getFrame : Env -> Int -> Frame +getFrame env frameId = + case Dict.get frameId env.frames of + Just frame -> + frame + + Nothing -> + Debug.todo <| "frame #" ++ String.fromInt frameId ++ " not found" + + +emptyFrame : Maybe Int -> Maybe Int -> Frame +emptyFrame outerId exitId = + { outerId = outerId + , exitId = exitId + , data = Dict.empty + , refCnt = 1 + } + + +set : String -> MalExpr -> Env -> Env +set name expr env = + let + frameId = + env.currentFrameId + + updateFrame = + Maybe.map + (\frame -> + { frame | data = Dict.insert name expr frame.data } + ) + + newFrames = + Dict.update frameId updateFrame env.frames + in + { env | frames = newFrames } + + +get : String -> Env -> Result String MalExpr +get name env = + let + go frameId = + let + frame = + getFrame env frameId + in + case Dict.get name frame.data of + Just value -> + Ok value + + Nothing -> + frame.outerId + |> Maybe.map go + |> Maybe.withDefault (Err <| "'" ++ name ++ "' not found") + in + go env.currentFrameId + + +newAtom : MalExpr -> Env -> ( Env, Int ) +newAtom value env = + let + atomId = + env.nextAtomId + + newEnv = + { env + | atoms = Dict.insert atomId value env.atoms + , nextAtomId = atomId + 1 + } + in + ( newEnv, atomId ) + + +getAtom : Int -> Env -> MalExpr +getAtom atomId env = + case Dict.get atomId env.atoms of + Just value -> + value + + Nothing -> + Debug.todo <| "atom " ++ String.fromInt atomId ++ " not found" + + +setAtom : Int -> MalExpr -> Env -> Env +setAtom atomId value env = + { env + | atoms = Dict.insert atomId value env.atoms + } + + +push : Env -> Env +push env = + let + frameId = + env.nextFrameId + + newFrame = + emptyFrame (Just env.currentFrameId) Nothing + + bogus = + debug env "push" frameId + in + { env + | currentFrameId = frameId + , frames = Dict.insert frameId newFrame env.frames + , nextFrameId = env.nextFrameId + 1 + } + + +pop : Env -> Env +pop env = + let + frameId = + env.currentFrameId + + frame = + getFrame env frameId + + bogus = + debug env "pop" frameId + in + case frame.outerId of + Just outerId -> + { env + | currentFrameId = outerId + , frames = Dict.update frameId free env.frames + } + + _ -> + Debug.todo "tried to pop global frame" + + +setBinds : List ( String, MalExpr ) -> Frame -> Frame +setBinds binds frame = + case binds of + [] -> + frame + + ( name, expr ) :: rest -> + setBinds rest + { frame | data = Dict.insert name expr frame.data } + + +{-| Enter a new frame with a set of binds +-} +enter : Int -> List ( String, MalExpr ) -> Env -> Env +enter outerId binds env = + let + frameId = + debug env "enter #" env.nextFrameId + + exitId = + env.currentFrameId + + newFrame = + setBinds binds (emptyFrame (Just outerId) (Just exitId)) + in + { env + | currentFrameId = frameId + , frames = Dict.insert frameId newFrame env.frames + , nextFrameId = env.nextFrameId + 1 + } + + +leave : Env -> Env +leave env = + let + frameId = + debug env "leave #" env.currentFrameId + + frame = + getFrame env frameId + + exitId = + case frame.exitId of + Just exitId2 -> + exitId2 + + Nothing -> + Debug.todo <| + "frame #" + ++ String.fromInt frameId + ++ " doesn't have an exitId" + in + { env + | currentFrameId = exitId + , frames = + env.frames + |> Dict.insert frameId { frame | exitId = Nothing } + |> Dict.update frameId free + } + + +{-| Increase refCnt for the current frame, +and all it's parent frames. +-} +ref : Env -> Env +ref originalEnv = + let + go frameId env = + let + frame = + getFrame env frameId + + newFrame = + { frame | refCnt = frame.refCnt + 1 } + + newEnv = + { env | frames = Dict.insert frameId newFrame env.frames } + in + case frame.outerId of + Just outerId -> + go outerId newEnv + + Nothing -> + newEnv + + newEnv2 = + go originalEnv.currentFrameId originalEnv + in + { newEnv2 | gcCounter = newEnv2.gcCounter + 1 } + + +free : Maybe Frame -> Maybe Frame +free = + Maybe.andThen + (\frame -> + if frame.refCnt == 1 then + Nothing + + else + Just { frame | refCnt = frame.refCnt - 1 } + ) + + +pushRef : MalExpr -> Env -> Env +pushRef ref_arg env = + { env | stack = ref_arg :: env.stack } + + +restoreRefs : List MalExpr -> Env -> Env +restoreRefs refs env = + { env | stack = refs } + + +{-| Given an Env see which frames are not reachable from the +global frame, or from the current expression. + +Return a new Env with the unreachable frames removed. + +-} +gc : MalExpr -> Env -> Env +gc expr env = + let + countList acc = + List.foldl countExpr acc + + countFrame { data } acc = + data |> Dict.values |> countList acc + + recur frameId acc = + if not (Set.member frameId acc) then + let + frame = + getFrame env frameId + + newAcc = + Set.insert frameId acc + in + countFrame frame newAcc + + else + acc + + countBound bound acc = + bound + |> List.map Tuple.second + |> countList acc + + countExpr expr_arg acc = + case expr_arg of + MalFunction (UserFunc { frameId }) -> + recur frameId acc + + MalApply { frameId, bound } -> + recur frameId acc + |> countBound bound + + MalList _ list -> + countList acc list + + MalVector _ vec -> + countList acc (Array.toList vec) + + MalMap _ map -> + countList acc (Dict.values map) + + MalAtom atomId -> + let + value = + getAtom atomId env + in + countExpr value acc + + _ -> + acc + + initSet = + Set.fromList + ([ globalFrameId, env.currentFrameId ] + ++ env.keepFrames + ) + + countFrames frames acc = + Set.toList frames + |> List.map (getFrame env) + |> List.foldl countFrame acc + + expand frameId frame fn acc = + case fn frame of + Nothing -> + acc + + Just parentId -> + Set.insert parentId acc + + expandBoth frameId = + let + frame = + getFrame env frameId + in + expand frameId frame .outerId + >> expand frameId frame .exitId + + expandParents frames = + Set.foldl expandBoth frames frames + + loop acc = + let + newAcc = + expandParents acc + + newParents = + Set.diff newAcc acc + in + if Set.isEmpty newParents then + newAcc + + else + loop <| countFrames newParents newAcc + + makeNewEnv newFrames = + { env + | frames = newFrames + , gcCounter = 0 + } + + keepFilter keep frameId _ = + Set.member frameId keep + + filterFrames frames keep = + Dict.filter (keepFilter keep) frames + in + countFrames initSet initSet + |> countExpr expr + |> flip countList env.stack + |> loop + |> filterFrames env.frames + |> makeNewEnv diff --git a/impls/elm/src/Eval.elm b/impls/elm/src/Eval.elm new file mode 100644 index 0000000000..5db9b1bdfa --- /dev/null +++ b/impls/elm/src/Eval.elm @@ -0,0 +1,240 @@ +module Eval exposing (..) + +import Env +import IO exposing (IO) +import Types exposing (..) + + +apply : Eval a -> Env -> EvalContext a +apply f env = + f env + + +run : Env -> Eval a -> EvalContext a +run env e = + apply e env + + +withEnv : (Env -> Eval a) -> Eval a +withEnv f env = + apply (f env) env + + +setEnv : Env -> Eval () +setEnv env _ = + apply (succeed ()) env + + +modifyEnv : (Env -> Env) -> Eval () +modifyEnv f env = + apply (succeed ()) (f env) + + +succeed : a -> Eval a +succeed res env = + ( env, EvalOk res ) + + +io : Cmd Msg -> (IO -> Eval a) -> Eval a +io cmd cont env = + ( env, EvalIO cmd cont ) + + +map : (a -> b) -> Eval a -> Eval b +map f e env0 = + case apply e env0 of + ( env, EvalOk res ) -> + ( env, EvalOk (f res) ) + + ( env, EvalErr msg ) -> + ( env, EvalErr msg ) + + ( env, EvalIO cmd cont ) -> + ( env, EvalIO cmd (cont >> map f) ) + + +{-| Chain two Eval's together. The function f takes the result from +the left eval and generates a new Eval. +-} +andThen : (a -> Eval b) -> Eval a -> Eval b +andThen f e env0 = + case apply e env0 of + ( env, EvalOk res ) -> + apply (f res) env + + ( env, EvalErr msg ) -> + ( env, EvalErr msg ) + + ( env, EvalIO cmd cont ) -> + ( env, EvalIO cmd (cont >> andThen f) ) + + +{-| Apply a transformation to the Env, for a Ok and a Err. +-} +finally : (Env -> Env) -> Eval a -> Eval a +finally f e env0 = + case apply e env0 of + ( env, EvalOk res ) -> + ( f env, EvalOk res ) + + ( env, EvalErr msg ) -> + ( f env, EvalErr msg ) + + ( env, EvalIO cmd cont ) -> + ( env, EvalIO cmd (cont >> finally f) ) + + +gcPass : Eval MalExpr -> Eval MalExpr +gcPass e env0 = + let + go env t expr = + if env.gcCounter >= env.gcInterval then + --Debug.log + -- ("before GC: " + -- ++ (printEnv env) + -- ) + -- "" + -- |> always ( Env.gc env, t expr ) + ( Env.gc expr env, t expr ) + + else + ( env, t expr ) + in + case apply e env0 of + ( env, EvalOk res ) -> + go env EvalOk res + + ( env, EvalErr msg ) -> + go env EvalErr msg + + ( env, EvalIO cmd cont ) -> + ( env, EvalIO cmd (cont >> gcPass) ) + + +catchError : (MalExpr -> Eval a) -> Eval a -> Eval a +catchError f e env0 = + case apply e env0 of + ( env, EvalOk res ) -> + ( env, EvalOk res ) + + ( env, EvalErr msg ) -> + apply (f msg) env + + ( env, EvalIO cmd cont ) -> + ( env, EvalIO cmd (cont >> catchError f) ) + + +fail : String -> Eval a +fail msg env = + ( env, EvalErr <| MalString msg ) + + +throw : MalExpr -> Eval a +throw ex env = + ( env, EvalErr ex ) + + +{-| Apply f to expr repeatedly. +Continues iterating if f returns (Left eval). +Stops if f returns (Right expr). + +Tail call optimized. + +-} +runLoop : (MalExpr -> Env -> Either (Eval MalExpr) MalExpr) -> MalExpr -> Eval MalExpr +runLoop f expr0 env0 = + case f expr0 env0 of + Left e -> + case apply e env0 of + ( env, EvalOk expr ) -> + runLoop f expr env + + ( env, EvalErr msg ) -> + ( env, EvalErr msg ) + + ( env, EvalIO cmd cont ) -> + ( env, EvalIO cmd (cont >> andThen (runLoop f)) ) + + Right expr -> + ( env0, EvalOk expr ) + + +fromResult : Result String a -> Eval a +fromResult res = + case res of + Ok val -> + succeed val + + Err msg -> + fail msg + + +{-| Chain the left and right Eval but ignore the right's result. +-} +ignore : Eval b -> Eval a -> Eval a +ignore right left = + left + |> andThen + (\res -> + right + |> andThen (\_ -> succeed res) + ) + + +withStack : Eval a -> Eval a +withStack e = + withEnv + (\env -> + e + |> ignore + (modifyEnv + (Env.restoreRefs env.stack) + ) + ) + + +pushRef : MalExpr -> Eval a -> Eval a +pushRef ref e = + modifyEnv (Env.pushRef ref) + |> andThen (always e) + + +inGlobal : Eval a -> Eval a +inGlobal body = + let + enter env = + setEnv + { env + | keepFrames = env.currentFrameId :: env.keepFrames + , currentFrameId = Env.globalFrameId + } + + leave oldEnv newEnv = + { newEnv + | keepFrames = oldEnv.keepFrames + , currentFrameId = oldEnv.currentFrameId + } + in + withEnv + (\env -> + if env.currentFrameId /= Env.globalFrameId then + enter env + |> andThen (always body) + |> finally (leave env) + + else + body + ) + + +runSimple : Eval a -> Result MalExpr a +runSimple e = + case run Env.global e of + ( _, EvalOk res ) -> + Ok res + + ( _, EvalErr msg ) -> + Err msg + + _ -> + Debug.todo "can't happen" diff --git a/impls/elm/src/IO.elm b/impls/elm/src/IO.elm new file mode 100644 index 0000000000..e565728318 --- /dev/null +++ b/impls/elm/src/IO.elm @@ -0,0 +1,70 @@ +port module IO exposing + ( IO(..) + , decodeIO + , input + , readFile + , readLine + , writeLine + ) + +import Json.Decode exposing (..) +import Time exposing (Posix) + + +{-| Output a string to stdout +-} +port writeLine : String -> Cmd msg + + +{-| Read a line from the stdin +-} +port readLine : String -> Cmd msg + + +{-| Read the contents of a file +-} +port readFile : String -> Cmd msg + + +{-| Received a response for a command. +-} +port input : (Value -> msg) -> Sub msg + + +type IO + = LineRead (Maybe String) + | LineWritten + | FileRead String + | Exception String + | GotTime Posix + + +decodeIO : Decoder IO +decodeIO = + field "tag" string + |> andThen decodeTag + + +decodeTag : String -> Decoder IO +decodeTag tag = + case tag of + "lineRead" -> + field "line" (nullable string) + |> map LineRead + + "lineWritten" -> + succeed LineWritten + + "fileRead" -> + field "contents" string + |> map FileRead + + "exception" -> + field "message" string + |> map Exception + + _ -> + fail <| + "Trying to decode IO, but tag " + ++ tag + ++ " is not supported." diff --git a/impls/elm/src/Printer.elm b/impls/elm/src/Printer.elm new file mode 100644 index 0000000000..1094cea406 --- /dev/null +++ b/impls/elm/src/Printer.elm @@ -0,0 +1,154 @@ +module Printer exposing (..) + +import Array exposing (Array) +import Dict exposing (Dict) +import Env +import Types exposing (Env, MalExpr(..), MalFunction(..), keywordPrefix) +import Utils exposing (encodeString, wrap) + + +printStr : Bool -> MalExpr -> String +printStr = + printString Env.global + + +printString : Env -> Bool -> MalExpr -> String +printString env readably ast = + case ast of + MalNil -> + "nil" + + MalBool True -> + "true" + + MalBool False -> + "false" + + MalInt int -> + String.fromInt int + + MalString str -> + printRawString env readably str + + MalSymbol sym -> + sym + + MalKeyword kw -> + ":" ++ kw + + MalList _ list -> + printList env readably list + + MalVector _ vec -> + printVector env readably vec + + MalMap _ map -> + printMap env readably map + + MalFunction _ -> + "#" + + MalAtom atomId -> + let + value = + Env.getAtom atomId env + in + "(atom " ++ printString env True value ++ ")" + + MalApply _ -> + "#" + + +printBound : Env -> Bool -> List ( String, MalExpr ) -> String +printBound env readably = + let + printEntry ( name, value ) = + name ++ "=" ++ printString env readably value + in + List.map printEntry + >> String.join " " + >> wrap "(" ")" + + +printRawString : Env -> Bool -> String -> String +printRawString env readably str = + if readably then + encodeString str + + else + str + + +printList : Env -> Bool -> List MalExpr -> String +printList env readably = + List.map (printString env readably) + >> String.join " " + >> wrap "(" ")" + + +printVector : Env -> Bool -> Array MalExpr -> String +printVector env readably = + Array.map (printString env readably) + >> Array.toList + >> String.join " " + >> wrap "[" "]" + + +printMap : Env -> Bool -> Dict String MalExpr -> String +printMap env readably = + let + -- Strip off the keyword prefix if it is there. + printKey k = + case String.uncons k of + Just ( prefix, rest ) -> + if prefix == keywordPrefix then + ":" ++ rest + + else + printRawString env readably k + + _ -> + printRawString env readably k + + printEntry ( k, v ) = + printKey k ++ " " ++ printString env readably v + in + Dict.toList + >> List.map printEntry + >> String.join " " + >> wrap "{" "}" + + +printEnv : Env -> String +printEnv env = + let + printOuterId = + Maybe.map String.fromInt >> Maybe.withDefault "nil" + + printHeader frameId { outerId, exitId, refCnt } = + "#" + ++ String.fromInt frameId + ++ " outer=" + ++ printOuterId outerId + ++ " exit=" + ++ printOuterId exitId + ++ " refCnt=" + ++ String.fromInt refCnt + + printFrame frameId frame = + String.join "\n" + (printHeader frameId frame + :: Dict.foldr printDatum [] frame.data + ) + + printFrameAcc k v acc = + printFrame k v :: acc + + printDatum k v acc = + (k ++ " = " ++ printString env False v) :: acc + in + "--- Environment ---\n" + ++ "Current frame: #" + ++ String.fromInt env.currentFrameId + ++ "\n\n" + ++ String.join "\n\n" (Dict.foldr printFrameAcc [] env.frames) diff --git a/impls/elm/src/Reader.elm b/impls/elm/src/Reader.elm new file mode 100644 index 0000000000..32f5439e34 --- /dev/null +++ b/impls/elm/src/Reader.elm @@ -0,0 +1,247 @@ +module Reader exposing (..) + +import Array +import Dict +import Parser exposing (DeadEnd, Parser, lazy, (|.), (|=)) +import Types exposing (MalExpr(..), keywordPrefix) +import Utils exposing (decodeString, makeCall) + + +comment : Parser () +comment = + Parser.lineComment ";" + + +ws : Parser () +ws = + let + isSpaceChar : Char -> Bool + isSpaceChar c = List.member c [' ', '\n', '\r', ','] + in + Parser.succeed () + |. Parser.sequence + { start = "" + , separator = "" + , end = "" + , spaces = Parser.chompWhile isSpaceChar + , item = comment + , trailing = Parser.Optional + } + + +int : Parser MalExpr +int = + -- Parser.map MalInt Parser.int fails with elm/parser 1.1.0 + let + isDigit : Char -> Bool + isDigit c = '0' <= c && c <= '9' + toInt s = case String.toInt s of + Just r -> MalInt r + Nothing -> Debug.todo "should not happen" + in + Parser.map toInt <| Parser.getChompedString <| + Parser.chompIf isDigit + |. Parser.chompWhile isDigit + + +symbolString : Parser String +symbolString = + let + isSymbolChar : Char -> Bool + isSymbolChar c = + not (List.member c [' ', '\n', '\r', ',', '\\', '[', ']', + '{', '}', '(', '\'', '"', '`', ';', ')']) + in + Parser.getChompedString <| + Parser.chompIf isSymbolChar + |. Parser.chompWhile isSymbolChar + + +symbolOrConst : Parser MalExpr +symbolOrConst = + let + make sym = + case sym of + "nil" -> + MalNil + + "true" -> + MalBool True + + "false" -> + MalBool False + + _ -> + MalSymbol sym + in + Parser.map make symbolString + + +keywordString : Parser String +keywordString = + Parser.succeed identity + |. Parser.token ":" + |= symbolString + + +keyword : Parser MalExpr +keyword = + Parser.map MalKeyword keywordString + + +list : Parser MalExpr +list = + Parser.map (MalList Nothing) <| Parser.sequence + { start = "(" + , separator = "" + , end = ")" + , spaces = ws + , item = form + , trailing = Parser.Optional + } + + +vector : Parser MalExpr +vector = + Parser.map (MalVector Nothing << Array.fromList) <| Parser.sequence + { start = "[" + , separator = "" + , end = "]" + , spaces = ws + , item = form + , trailing = Parser.Optional + } + + +mapKey : Parser String +mapKey = + Parser.oneOf + [ Parser.map (String.cons keywordPrefix) keywordString + , Parser.map decodeString strString + ] + + +mapEntry : Parser ( String, MalExpr ) +mapEntry = + Parser.succeed Tuple.pair |= mapKey |= form + + +map : Parser MalExpr +map = + Parser.map (MalMap Nothing << Dict.fromList) <| Parser.sequence + { start = "{" + , separator = "" + , end = "}" + , spaces = ws + , item = mapEntry + , trailing = Parser.Optional + } + + +atom : Parser MalExpr +atom = + Parser.oneOf + [ Parser.succeed identity + |. Parser.token "-" + |= Parser.oneOf + [ Parser.map (MalInt << negate) Parser.int + , Parser.map (MalSymbol << (++) "-") symbolString + , Parser.succeed (MalSymbol "-") + ] + , int + , keyword + , symbolOrConst + , str + ] + + +form : Parser MalExpr +form = + lazy <| + \() -> + let + parsers = + [ list + , vector + , map + , simpleMacro "'" "quote" + , simpleMacro "`" "quasiquote" + , simpleMacro "~@" "splice-unquote" + , simpleMacro "~" "unquote" + , simpleMacro "@" "deref" + , withMeta + , atom + ] + in + Parser.succeed identity |. ws |= Parser.oneOf parsers + + +simpleMacro : String -> String -> Parser MalExpr +simpleMacro token symbol = + Parser.succeed (makeCall symbol << List.singleton) + |. Parser.token token + |= form + + +withMeta : Parser MalExpr +withMeta = + let + make meta expr = + makeCall "with-meta" [ expr, meta ] + in + Parser.succeed make + |. Parser.token "^" + |= form + |= form + + +readString : String -> Result String MalExpr +readString str2 = + case Parser.run (form |. ws |. Parser.end) str2 of + Ok ast -> + Ok ast + + Err deadEnds -> + -- Should become Err <| Parser.deadEndsToString deadEnds + -- once the function is implemented. + Err <| formatError deadEnds + + +formatError : List DeadEnd -> String +formatError = + let + format1 deadEnd = + Debug.toString deadEnd.problem + ++ " at " + ++ String.fromInt deadEnd.row + ++ ":" + ++ String.fromInt deadEnd.col + in + (++) "end of input\n" << String.join "\n" << List.map format1 + + +str : Parser MalExpr +str = + Parser.map (MalString << decodeString) strString + + +strString : Parser String +strString = + let + isStringNormalChar : Char -> Bool + isStringNormalChar c = not <| List.member c ['"', '\\'] + in + Parser.getChompedString <| + Parser.sequence + { start = "\"" + , separator = "" + , end = "\"" + , spaces = Parser.succeed () + , item = Parser.oneOf + [ Parser.chompIf isStringNormalChar + |. Parser.chompWhile isStringNormalChar + , Parser.token "\\" + |. Parser.chompIf (\_ -> True) + ] + , trailing = Parser.Forbidden + } diff --git a/impls/elm/src/Step0_repl.elm b/impls/elm/src/Step0_repl.elm new file mode 100644 index 0000000000..8763f090a6 --- /dev/null +++ b/impls/elm/src/Step0_repl.elm @@ -0,0 +1,81 @@ +module Step0_repl exposing (..) + +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Flags = + { args : List String + } + + +type alias Model = + { args : List String + } + + +type Msg + = Input (Result String IO) + + +init : Flags -> ( Model, Cmd Msg ) +init flags = + ( flags, readLine prompt ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Input (Ok (LineRead (Just line))) -> + ( model, writeLine (rep line) ) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + ( model, Cmd.none ) + + Input (Ok _) -> + ( model, Cmd.none ) + + Input (Err msg2) -> + Debug.log msg2 ( model, Cmd.none ) + + +prompt : String +prompt = + "user> " + + +read : String -> String +read ast = + ast + + +eval : String -> String +eval ast = + ast + + +print : String -> String +print ast = + ast + + +rep : String -> String +rep = + read >> eval >> print diff --git a/impls/elm/src/Step1_read_print.elm b/impls/elm/src/Step1_read_print.elm new file mode 100644 index 0000000000..57fdc733ab --- /dev/null +++ b/impls/elm/src/Step1_read_print.elm @@ -0,0 +1,97 @@ +module Step1_read_print exposing (..) + +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printStr) +import Reader exposing (readString) +import Types exposing (MalExpr(..)) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Flags = + { args : List String + } + + +type alias Model = + { args : List String + } + + +type Msg + = Input (Result String IO) + + +init : Flags -> ( Model, Cmd Msg ) +init flags = + ( flags, readLine prompt ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Input (Ok (LineRead (Just line))) -> + ( model, writeLine (rep line) ) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +eval : MalExpr -> MalExpr +eval ast = + ast + + +print : MalExpr -> String +print = + printStr True + + +{-| Read-Eval-Print +-} +rep : String -> String +rep = + let + formatResult result = + case result of + Ok optStr -> + optStr + + Err msg -> + msg + in + readString + >> Result.map (eval >> print) + >> formatResult diff --git a/impls/elm/src/Step2_eval.elm b/impls/elm/src/Step2_eval.elm new file mode 100644 index 0000000000..c4685ebade --- /dev/null +++ b/impls/elm/src/Step2_eval.elm @@ -0,0 +1,231 @@ +module Step2_eval exposing (..) + +import Array +import Dict exposing (Dict) +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printStr) +import Reader exposing (readString) +import Tuple exposing (mapFirst, second) +import Types exposing (..) +import Utils exposing (maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Flags = + { args : List String + } + + +type alias ReplEnv = + Dict String MalExpr + + +type alias Model = + { args : List String + , env : ReplEnv + } + + +type Msg + = Input (Result String IO) + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + ( { args = args, env = initReplEnv }, readLine prompt ) + + +initReplEnv : ReplEnv +initReplEnv = + let + makeFn = + CoreFunc Nothing >> MalFunction + + binaryOp fn args = + case args of + [ MalInt x, MalInt y ] -> + Eval.succeed <| MalInt (fn x y) + + _ -> + Eval.fail "unsupported arguments" + in + Dict.fromList + [ ( "+", makeFn <| binaryOp (+) ) + , ( "-", makeFn <| binaryOp (-) ) + , ( "*", makeFn <| binaryOp (*) ) + , ( "/", makeFn <| binaryOp (//) ) + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Input (Ok (LineRead (Just line))) -> + let ( result, newEnv) = rep model.env line + in ( { model | env = newEnv }, writeLine (makeOutput result) ) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +makeOutput : Result String String -> String +makeOutput result = + case result of + Ok str -> + str + + Err msg -> + "Error: " ++ msg + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +eval : ReplEnv -> MalExpr -> ( Result String MalExpr, ReplEnv ) +eval env ast = + -- let + -- _ = Debug.log ("EVAL: " ++ printStr env True ast) () + -- -- The output ends with an ugly ": ()", but that does not hurt. + -- in + case ast of + MalList _ [] -> + ( Ok ast, env ) + + MalList _ list -> + case evalList env list [] of + ( Ok newList, newEnv ) -> + case newList of + [] -> + ( Err "can't happen", newEnv ) + + (MalFunction (CoreFunc _ fn)) :: args -> + case Eval.runSimple (fn args) of + Ok res -> + ( Ok res, newEnv ) + + Err msg -> + ( Err (print msg), newEnv ) + + fn :: _ -> + ( Err ((print fn) ++ " is not a function"), newEnv ) + + ( Err msg, newEnv ) -> + ( Err msg, newEnv ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + case Dict.get sym env of + Just val -> + ( Ok val, env ) + + Nothing -> + ( Err ("symbol '" ++ sym ++ "' not found"), env ) + + MalVector _ vec -> + evalList env (Array.toList vec) [] + |> mapFirst (Result.map (Array.fromList >> MalVector Nothing)) + + MalMap _ map -> + evalList env (Dict.values map) [] + |> mapFirst + (Result.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + ) + + _ -> + ( Ok ast, env ) + + +evalList : ReplEnv -> List MalExpr -> List MalExpr -> ( Result String (List MalExpr), ReplEnv ) +evalList env list acc = + case list of + [] -> + ( Ok (List.reverse acc), env ) + + x :: rest -> + case eval env x of + ( Ok val, newEnv ) -> + evalList newEnv rest (val :: acc) + + ( Err msg, newEnv ) -> + ( Err msg, newEnv ) + + +{-| Try to map a list with a fn that can return a Err. + +Maps the list from left to right. As soon as a error +occurs it will not process any more elements and return +the error. + +-} +tryMapList : (a -> Result e b) -> List a -> Result e (List b) +tryMapList fn list = + let + go x = + Result.andThen + (\acc -> + case fn x of + Ok val -> + Ok (val :: acc) + + Err msg -> + Err msg + ) + in + List.foldl go (Ok []) list + |> Result.map List.reverse + + +print : MalExpr -> String +print = + printStr True + + +{-| Read-Eval-Print +-} +rep : ReplEnv -> String -> ( Result String String, ReplEnv ) +rep env input = + let + evalPrint = + eval env >> mapFirst (Result.map print) + in + case readString input of + Err msg -> + ( Err msg, env ) + + Ok ast -> + evalPrint ast diff --git a/impls/elm/src/Step3_env.elm b/impls/elm/src/Step3_env.elm new file mode 100644 index 0000000000..a1028e8ff7 --- /dev/null +++ b/impls/elm/src/Step3_env.elm @@ -0,0 +1,295 @@ +module Step3_env exposing (..) + +import Array +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Tuple exposing (mapFirst, mapSecond, second) +import Types exposing (..) +import Utils exposing (maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Flags = + { args : List String + } + + +type alias Model = + { args : List String + , env : Env + } + + +type Msg + = Input (Result String IO) + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + ( { args = args, env = initReplEnv }, readLine prompt ) + + +initReplEnv : Env +initReplEnv = + let + makeFn = + CoreFunc Nothing >> MalFunction + + binaryOp fn args = + case args of + [ MalInt x, MalInt y ] -> + Eval.succeed <| MalInt (fn x y) + + _ -> + Eval.fail "unsupported arguments" + in + Env.global + |> Env.set "+" (makeFn <| binaryOp (+)) + |> Env.set "-" (makeFn <| binaryOp (-)) + |> Env.set "*" (makeFn <| binaryOp (*)) + |> Env.set "/" (makeFn <| binaryOp (//)) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Input (Ok (LineRead (Just line))) -> + let ( result, newEnv) = rep model.env line + in ( { model | env = newEnv }, writeLine (makeOutput result) ) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +makeOutput : Result String String -> String +makeOutput result = + case result of + Ok str -> + str + + Err msg -> + "Error: " ++ msg + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +eval : Env -> MalExpr -> ( Result String MalExpr, Env ) +eval env ast = + let + _ = case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + in + case ast of + MalList _ [] -> + ( Ok ast, env ) + + MalList _ ((MalSymbol "def!") :: args) -> + evalDef env args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet env args + + MalList _ list -> + case evalList env list [] of + ( Ok newList, newEnv ) -> + case newList of + [] -> + ( Err "can't happen", newEnv ) + + (MalFunction (CoreFunc _ fn)) :: args -> + case Eval.runSimple (fn args) of + Ok res -> + ( Ok res, newEnv ) + + Err msg -> + ( Err (print msg), newEnv ) + + fn :: _ -> + ( Err ((print fn) ++ " is not a function"), newEnv ) + + ( Err msg, newEnv ) -> + ( Err msg, newEnv ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + case Env.get sym env of + Ok val -> + ( Ok val, env ) + + Err msg -> + ( Err msg, env ) + + MalVector _ vec -> + evalList env (Array.toList vec) [] + |> mapFirst (Result.map (Array.fromList >> MalVector Nothing)) + + MalMap _ map -> + evalList env (Dict.values map) [] + |> mapFirst + (Result.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + ) + + _ -> + ( Ok ast, env ) + + +evalList : Env -> List MalExpr -> List MalExpr -> ( Result String (List MalExpr), Env ) +evalList env list acc = + case list of + [] -> + ( Ok (List.reverse acc), env ) + + x :: rest -> + case eval env x of + ( Ok val, newEnv ) -> + evalList newEnv rest (val :: acc) + + ( Err msg, newEnv ) -> + ( Err msg, newEnv ) + + +evalDef : Env -> List MalExpr -> ( Result String MalExpr, Env ) +evalDef env args = + case args of + [ MalSymbol name, uneValue ] -> + case eval env uneValue of + ( Ok value, newEnv ) -> + ( Ok value, Env.set name value newEnv ) + + err -> + err + + _ -> + ( Err "def! expected two args: name and value", env ) + + +evalLet : Env -> List MalExpr -> ( Result String MalExpr, Env ) +evalLet env args = + let + evalBinds env2 binds = + case binds of + (MalSymbol name) :: expr :: rest -> + case eval env2 expr of + ( Ok value, newEnv ) -> + let + newEnv2 = + Env.set name value env2 + in + if List.isEmpty rest then + Ok newEnv2 + else + evalBinds newEnv2 rest + + ( Err msg, _ ) -> + Err msg + + _ -> + Err "let* expected an even number of binds (symbol expr ..)" + + go binds body = + case evalBinds (Env.push env) binds of + Ok newEnv -> + eval newEnv body + |> mapSecond (\_ -> Env.pop newEnv) + + Err msg -> + ( Err msg, env ) + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + ( Err "let* expected two args: binds and a body", env ) + + +{-| Try to map a list with a fn that can return a Err. + +Maps the list from left to right. As soon as a error +occurs it will not process any more elements and return +the error. + +-} +tryMapList : (a -> Result e b) -> List a -> Result e (List b) +tryMapList fn list = + let + go x = + Result.andThen + (\acc -> + case fn x of + Ok val -> + Ok (val :: acc) + + Err msg -> + Err msg + ) + in + List.foldl go (Ok []) list + |> Result.map List.reverse + + +print : MalExpr -> String +print = + printString Env.global True + + +{-| Read-Eval-Print +-} +rep : Env -> String -> ( Result String String, Env ) +rep env input = + let + evalPrint = + eval env >> mapFirst (Result.map print) + in + case readString input of + Err msg -> + ( Err msg, env ) + + Ok ast -> + evalPrint ast diff --git a/impls/elm/src/Step4_if_fn_do.elm b/impls/elm/src/Step4_if_fn_do.elm new file mode 100644 index 0000000000..7b31229312 --- /dev/null +++ b/impls/elm/src/Step4_if_fn_do.elm @@ -0,0 +1,487 @@ +module Step4_if_fn_do exposing (..) + +import Array +import Core +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Flags = + { args : List String + } + + +type Model + = InitIO Env (IO -> Eval MalExpr) + | InitError + | ReplActive Env + | ReplIO Env (IO -> Eval MalExpr) + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + let + initEnv = + Core.ns + + evalMalInit = + malInit + |> List.map rep + |> List.foldl + (\b a -> a |> Eval.andThen (\_ -> b)) + (Eval.succeed MalNil) + in + runInit initEnv evalMalInit + + +malInit : List String +malInit = + [ """(def! not + (fn* (a) + (if a false true)))""" + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case model of + InitError -> + -- ignore all + ( model, Cmd.none ) + + InitIO env cont -> + case msg of + Input (Ok io) -> + runInit env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ReplActive env -> + case msg of + Input (Ok (LineRead (Just line))) -> + run env (rep line) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + -- Ctrl+D = The End. + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 + + ReplIO env cont -> + case msg of + Input (Ok io) -> + run env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +runInit : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runInit env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + -- Init went okay, start REPL. + ( ReplActive env, readLine prompt ) + + ( env, EvalErr msg ) -> + -- Init failed, don't start REPL. + ( InitError, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + -- IO in init. + ( InitIO env cont, cmd ) + + +run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +run env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( ReplActive env, writeLine (print env expr) ) + + ( env, EvalErr msg ) -> + ( ReplActive env, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ReplIO env cont, cmd ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +eval : MalExpr -> Eval MalExpr +eval ast = + Eval.withEnv (\env -> Eval.succeed <| + case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + ) |> Eval.andThen (\_ -> + case ast of + MalList _ [] -> + Eval.succeed ast + + MalList _ ((MalSymbol "def!") :: args) -> + evalDef args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet args + + MalList _ ((MalSymbol "do") :: args) -> + evalDo args + + MalList _ ((MalSymbol "if") :: args) -> + evalIf args + + MalList _ ((MalSymbol "fn*") :: args) -> + evalFn args + + MalList _ list -> + evalList list + |> Eval.andThen + (\newList -> + case newList of + [] -> + Eval.fail "can't happen" + + (MalFunction (CoreFunc _ fn)) :: args -> + fn args + + (MalFunction (UserFunc { eagerFn })) :: args -> + eagerFn args + + fn :: _ -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + Eval.withEnv + (\env -> + case Env.get sym env of + Ok val -> + Eval.succeed val + + Err msg -> + Eval.fail msg + ) + + MalVector _ vec -> + evalList (Array.toList vec) + |> Eval.map (Array.fromList >> MalVector Nothing) + + MalMap _ map -> + evalList (Dict.values map) + |> Eval.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + + _ -> + Eval.succeed ast + ) + + +evalList : List MalExpr -> Eval (List MalExpr) +evalList list = + let + go lst acc = + case lst of + [] -> + Eval.succeed (List.reverse acc) + + x :: rest -> + eval x + |> Eval.andThen + (\val -> + go rest (val :: acc) + ) + in + go list [] + + +evalDef : List MalExpr -> Eval MalExpr +evalDef args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen (\_ -> Eval.succeed value) + ) + + _ -> + Eval.fail "def! expected two args: name and value" + + +evalLet : List MalExpr -> Eval MalExpr +evalLet args = + let + evalBinds binds = + case binds of + (MalSymbol name) :: expr :: rest -> + eval expr + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen + (\_ -> + if List.isEmpty rest then + Eval.succeed () + + else + evalBinds rest + ) + ) + + _ -> + Eval.fail "let* expected an even number of binds (symbol expr ..)" + + go binds body = + Eval.modifyEnv Env.push + |> Eval.andThen (\_ -> evalBinds binds) + |> Eval.andThen (\_ -> eval body) + |> Eval.andThen + (\res -> + Eval.modifyEnv Env.pop + |> Eval.map (\_ -> res) + ) + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "let* expected two args: binds and a body" + + +evalDo : List MalExpr -> Eval MalExpr +evalDo args = + let + returnLast list = + case last list of + Just value -> + Eval.succeed value + + Nothing -> + Eval.fail "do expected at least one arg" + in + evalList args + |> Eval.andThen returnLast + + +evalIf : List MalExpr -> Eval MalExpr +evalIf args = + let + isTruthy expr = + expr /= MalNil && expr /= MalBool False + + go condition trueExpr falseExpr = + eval condition + |> Eval.andThen + (\cond -> + eval + (if isTruthy cond then + trueExpr + + else + falseExpr + ) + ) + in + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil + + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr + + _ -> + Eval.fail "if expected at least two args" + + +evalFn : List MalExpr -> Eval MalExpr +evalFn parms = + let + {- Extract symbols from the binds list and verify their uniqueness -} + extractSymbols acc list = + case list of + [] -> + Ok (List.reverse acc) + + (MalSymbol name) :: rest -> + if List.member name acc then + Err "all binds must have unique names" + + else + extractSymbols (name :: acc) rest + + _ -> + Err "all binds in fn* must be a symbol" + + parseBinds list = + case List.reverse list of + var :: "&" :: rest -> + Ok <| bindVarArgs (List.reverse rest) var + + _ -> + if List.member "&" list then + Err "varargs separator '&' is used incorrectly" + + else + Ok <| bindArgs list + + extractAndParse = + extractSymbols [] >> Result.andThen parseBinds + + bindArgs binds args = + let + numBinds = + List.length binds + in + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args + + bindVarArgs binds var args = + let + minArgs = + List.length binds + + varArgs = + MalList Nothing (List.drop minArgs args) + in + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] + + makeFn frameId binder body = + MalFunction <| + let + fn args = + case binder args of + Ok bound -> + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (always (eval body)) + |> Eval.finally Env.leave + ) + + Err msg -> + Eval.fail msg + in + UserFunc + { frameId = frameId + , lazyFn = fn + , eagerFn = fn + , isMacro = False + , meta = Nothing + } + + go bindsList body = + case extractAndParse bindsList of + Ok binder -> + Eval.modifyEnv Env.ref + -- reference the current frame. + |> Eval.andThen + (\_ -> + Eval.withEnv + (\env -> + Eval.succeed + (makeFn env.currentFrameId binder body) + ) + ) + + Err msg -> + Eval.fail msg + in + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "fn* expected two args: binds list and body" + + +print : Env -> MalExpr -> String +print env = + printString env True + + +printError : Env -> MalExpr -> String +printError env expr = + "Error: " ++ printString env False expr + + +{-| Read-Eval-Print. + +Doesn't actually run the Eval but returns the monad. + +-} +rep : String -> Eval MalExpr +rep input = + case readString input of + Err msg -> + Eval.fail msg + + Ok ast -> + eval ast diff --git a/impls/elm/src/Step5_tco.elm b/impls/elm/src/Step5_tco.elm new file mode 100644 index 0000000000..62f0a22795 --- /dev/null +++ b/impls/elm/src/Step5_tco.elm @@ -0,0 +1,522 @@ +module Step5_tco exposing (..) + +import Array +import Core +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Flags = + { args : List String + } + + +type Model + = InitIO Env (IO -> Eval MalExpr) + | InitError + | ReplActive Env + | ReplIO Env (IO -> Eval MalExpr) + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + let + initEnv = + Core.ns + + evalMalInit = + malInit + |> List.map rep + |> List.foldl + (\b a -> a |> Eval.andThen (\_ -> b)) + (Eval.succeed MalNil) + in + runInit initEnv evalMalInit + + +malInit : List String +malInit = + [ """(def! not + (fn* (a) + (if a false true)))""" + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case model of + InitError -> + -- ignore all + ( model, Cmd.none ) + + InitIO env cont -> + case msg of + Input (Ok io) -> + runInit env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ReplActive env -> + case msg of + Input (Ok (LineRead (Just line))) -> + run env (rep line) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + -- Ctrl+D = The End. + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 + + ReplIO env cont -> + case msg of + Input (Ok io) -> + run env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +runInit : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runInit env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + -- Init went okay, start REPL. + ( ReplActive env, readLine prompt ) + + ( env, EvalErr msg ) -> + -- Init failed, don't start REPL. + ( InitError, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + -- IO in init. + ( InitIO env cont, cmd ) + + +run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +run env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( ReplActive env, writeLine (print env expr) ) + + ( env, EvalErr msg ) -> + ( ReplActive env, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ReplIO env cont, cmd ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +debug : String -> (Env -> a) -> Eval b -> Eval b +debug msg f e = + Eval.withEnv + (\env -> + Env.debug env msg (f env) + |> always e + ) + + +eval : MalExpr -> Eval MalExpr +eval ast = + let + apply expr env = + case expr of + MalApply app -> + Left + (debug "evalApply" + (\env2 -> printString env2 True expr) + (evalApply app) + ) + + _ -> + Right expr + in + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) + + +evalApply : ApplyRec -> Eval MalExpr +evalApply { frameId, bound, body } = + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.leave + |> Eval.gcPass + ) + + +evalNoApply : MalExpr -> Eval MalExpr +evalNoApply ast = + Eval.withEnv (\env -> Eval.succeed <| + case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + ) |> Eval.andThen (\_ -> + case ast of + MalList _ [] -> + Eval.succeed ast + + MalList _ ((MalSymbol "def!") :: args) -> + evalDef args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet args + + MalList _ ((MalSymbol "do") :: args) -> + evalDo args + + MalList _ ((MalSymbol "if") :: args) -> + evalIf args + + MalList _ ((MalSymbol "fn*") :: args) -> + evalFn args + + MalList _ list -> + evalList list + |> Eval.andThen + (\newList -> + case newList of + [] -> + Eval.fail "can't happen" + + (MalFunction (CoreFunc _ fn)) :: args -> + fn args + + (MalFunction (UserFunc { lazyFn })) :: args -> + lazyFn args + + fn :: _ -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + Eval.withEnv + (\env -> + case Env.get sym env of + Ok val -> + Eval.succeed val + + Err msg -> + Eval.fail msg + ) + + MalVector _ vec -> + evalList (Array.toList vec) + |> Eval.map (Array.fromList >> MalVector Nothing) + + MalMap _ map -> + evalList (Dict.values map) + |> Eval.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + + _ -> + Eval.succeed ast + ) + + +evalList : List MalExpr -> Eval (List MalExpr) +evalList list = + let + go lst acc = + case lst of + [] -> + Eval.succeed (List.reverse acc) + + x :: rest -> + eval x + |> Eval.andThen + (\val -> + go rest (val :: acc) + ) + in + go list [] + + +evalDef : List MalExpr -> Eval MalExpr +evalDef args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen (\_ -> Eval.succeed value) + ) + + _ -> + Eval.fail "def! expected two args: name and value" + + +evalLet : List MalExpr -> Eval MalExpr +evalLet args = + let + evalBinds binds = + case binds of + (MalSymbol name) :: expr :: rest -> + eval expr + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen + (\_ -> + if List.isEmpty rest then + Eval.succeed () + + else + evalBinds rest + ) + ) + + _ -> + Eval.fail "let* expected an even number of binds (symbol expr ..)" + + go binds body = + Eval.modifyEnv Env.push + |> Eval.andThen (\_ -> evalBinds binds) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.andThen + (\res -> + Eval.modifyEnv Env.pop + |> Eval.map (\_ -> res) + ) + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "let* expected two args: binds and a body" + + +evalDo : List MalExpr -> Eval MalExpr +evalDo args = + case List.reverse args of + last :: rest -> + evalList (List.reverse rest) + |> Eval.andThen (\_ -> evalNoApply last) + + [] -> + Eval.fail "do expected at least one arg" + + +evalIf : List MalExpr -> Eval MalExpr +evalIf args = + let + isTruthy expr = + expr /= MalNil && expr /= MalBool False + + go condition trueExpr falseExpr = + eval condition + |> Eval.andThen + (\cond -> + evalNoApply + (if isTruthy cond then + trueExpr + + else + falseExpr + ) + ) + in + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil + + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr + + _ -> + Eval.fail "if expected at least two args" + + +evalFn : List MalExpr -> Eval MalExpr +evalFn parms = + let + {- Extract symbols from the binds list and verify their uniqueness -} + extractSymbols acc list = + case list of + [] -> + Ok (List.reverse acc) + + (MalSymbol name) :: rest -> + if List.member name acc then + Err "all binds must have unique names" + + else + extractSymbols (name :: acc) rest + + _ -> + Err "all binds in fn* must be a symbol" + + parseBinds list = + case List.reverse list of + var :: "&" :: rest -> + Ok <| bindVarArgs (List.reverse rest) var + + _ -> + if List.member "&" list then + Err "varargs separator '&' is used incorrectly" + + else + Ok <| bindArgs list + + extractAndParse = + extractSymbols [] >> Result.andThen parseBinds + + bindArgs binds args = + let + numBinds = + List.length binds + in + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args + + bindVarArgs binds var args = + let + minArgs = + List.length binds + + varArgs = + MalList Nothing (List.drop minArgs args) + in + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] + + makeFn frameId binder body = + MalFunction <| + let + lazyFn args = + case binder args of + Ok bound -> + Eval.succeed <| + MalApply + { frameId = frameId + , bound = bound + , body = body + } + + Err msg -> + Eval.fail msg + in + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } + + go bindsList body = + case extractAndParse bindsList of + Ok binder -> + Eval.modifyEnv Env.ref + -- reference the current frame. + |> Eval.andThen + (\_ -> + Eval.withEnv + (\env -> + Eval.succeed + (makeFn env.currentFrameId binder body) + ) + ) + + Err msg -> + Eval.fail msg + in + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "fn* expected two args: binds list and body" + + +print : Env -> MalExpr -> String +print env = + printString env True + + +printError : Env -> MalExpr -> String +printError env expr = + "Error: " ++ printString env False expr + + +{-| Read-Eval-Print. + +Doesn't actually run the Eval but returns the monad. + +-} +rep : String -> Eval MalExpr +rep input = + case readString input of + Err msg -> + Eval.fail msg + + Ok ast -> + eval ast diff --git a/impls/elm/src/Step6_file.elm b/impls/elm/src/Step6_file.elm new file mode 100644 index 0000000000..e4df50b520 --- /dev/null +++ b/impls/elm/src/Step6_file.elm @@ -0,0 +1,592 @@ +module Step6_file exposing (..) + +import Array +import Core +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Args = + List String + + +type alias Flags = + { args : Args + } + + +type Model + = InitIO Args Env (IO -> Eval MalExpr) + | ScriptIO Env (IO -> Eval MalExpr) + | ReplActive Env + | ReplIO Env (IO -> Eval MalExpr) + | Stopped + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + let + makeFn = + CoreFunc Nothing >> MalFunction + + initEnv = + Core.ns + |> Env.set "eval" (makeFn malEval) + |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) + + evalMalInit = + malInit + |> List.map rep + |> List.foldl + (\b a -> a |> Eval.andThen (\_ -> b)) + (Eval.succeed MalNil) + in + runInit args initEnv evalMalInit + + +malInit : List String +malInit = + [ """(def! not + (fn* (a) + (if a false true)))""" + , """(def! load-file + (fn* (f) + (eval (read-string + (str "(do " (slurp f) "\nnil)")))))""" + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case model of + Stopped -> + ( model, Cmd.none ) + + InitIO args env cont -> + case msg of + Input (Ok io) -> + runInit args env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ScriptIO env cont -> + case msg of + Input (Ok io) -> + runScriptLoop env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ReplActive env -> + case msg of + Input (Ok (LineRead (Just line))) -> + run env (rep line) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + -- Ctrl+D = The End. + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 + + ReplIO env cont -> + case msg of + Input (Ok io) -> + run env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runInit args env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + -- Init went okay. + case args of + -- If we got no args: start REPL. + [] -> + ( ReplActive env, readLine prompt ) + + -- Run the script in the first argument. + -- Put the rest of the arguments as *ARGV*. + filename :: argv -> + runScript filename argv env + + ( env, EvalErr msg ) -> + -- Init failed, don't start REPL. + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + -- IO in init. + ( InitIO args env cont, cmd ) + + +runScript : String -> List String -> Env -> ( Model, Cmd Msg ) +runScript filename argv env = + let + malArgv = + MalList Nothing (List.map MalString argv) + + newEnv = + env |> Env.set "*ARGV*" malArgv + + program = + MalList Nothing + [ MalSymbol "load-file" + , MalString filename + ] + in + runScriptLoop newEnv (eval program) + + +runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runScriptLoop env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( Stopped, Cmd.none ) + + ( env, EvalErr msg ) -> + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ScriptIO env cont, cmd ) + + +run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +run env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( ReplActive env, writeLine (print env expr) ) + + ( env, EvalErr msg ) -> + ( ReplActive env, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ReplIO env cont, cmd ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +debug : String -> (Env -> a) -> Eval b -> Eval b +debug msg f e = + Eval.withEnv + (\env -> + Env.debug env msg (f env) + |> always e + ) + + +eval : MalExpr -> Eval MalExpr +eval ast = + let + apply expr env = + case expr of + MalApply app -> + Left + (debug "evalApply" + (\env2 -> printString env2 True expr) + (evalApply app) + ) + + _ -> + Right expr + in + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) + + +malEval : List MalExpr -> Eval MalExpr +malEval args = + case args of + [ expr ] -> + Eval.inGlobal (eval expr) + + _ -> + Eval.fail "unsupported arguments" + + +evalApply : ApplyRec -> Eval MalExpr +evalApply { frameId, bound, body } = + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.leave + |> Eval.gcPass + ) + + +evalNoApply : MalExpr -> Eval MalExpr +evalNoApply ast = + Eval.withEnv (\env -> Eval.succeed <| + case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + ) |> Eval.andThen (\_ -> + case ast of + MalList _ [] -> + Eval.succeed ast + + MalList _ ((MalSymbol "def!") :: args) -> + evalDef args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet args + + MalList _ ((MalSymbol "do") :: args) -> + evalDo args + + MalList _ ((MalSymbol "if") :: args) -> + evalIf args + + MalList _ ((MalSymbol "fn*") :: args) -> + evalFn args + + MalList _ list -> + evalList list + |> Eval.andThen + (\newList -> + case newList of + [] -> + Eval.fail "can't happen" + + (MalFunction (CoreFunc _ fn)) :: args -> + fn args + + (MalFunction (UserFunc { lazyFn })) :: args -> + lazyFn args + + fn :: _ -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + Eval.withEnv + (\env -> + case Env.get sym env of + Ok val -> + Eval.succeed val + + Err msg -> + Eval.fail msg + ) + + MalVector _ vec -> + evalList (Array.toList vec) + |> Eval.map (Array.fromList >> MalVector Nothing) + + MalMap _ map -> + evalList (Dict.values map) + |> Eval.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + + _ -> + Eval.succeed ast + ) + + +evalList : List MalExpr -> Eval (List MalExpr) +evalList list = + let + go lst acc = + case lst of + [] -> + Eval.succeed (List.reverse acc) + + x :: rest -> + eval x + |> Eval.andThen + (\val -> + go rest (val :: acc) + ) + in + go list [] + + +evalDef : List MalExpr -> Eval MalExpr +evalDef args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen (\_ -> Eval.succeed value) + ) + + _ -> + Eval.fail "def! expected two args: name and value" + + +evalLet : List MalExpr -> Eval MalExpr +evalLet args = + let + evalBinds binds = + case binds of + (MalSymbol name) :: expr :: rest -> + eval expr + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen + (\_ -> + if List.isEmpty rest then + Eval.succeed () + + else + evalBinds rest + ) + ) + + _ -> + Eval.fail "let* expected an even number of binds (symbol expr ..)" + + go binds body = + Eval.modifyEnv Env.push + |> Eval.andThen (\_ -> evalBinds binds) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.andThen + (\res -> + Eval.modifyEnv Env.pop + |> Eval.map (\_ -> res) + ) + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "let* expected two args: binds and a body" + + +evalDo : List MalExpr -> Eval MalExpr +evalDo args = + case List.reverse args of + last :: rest -> + evalList (List.reverse rest) + |> Eval.andThen (\_ -> evalNoApply last) + + [] -> + Eval.fail "do expected at least one arg" + + +evalIf : List MalExpr -> Eval MalExpr +evalIf args = + let + isTruthy expr = + expr /= MalNil && expr /= MalBool False + + go condition trueExpr falseExpr = + eval condition + |> Eval.andThen + (\cond -> + evalNoApply + (if isTruthy cond then + trueExpr + + else + falseExpr + ) + ) + in + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil + + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr + + _ -> + Eval.fail "if expected at least two args" + + +evalFn : List MalExpr -> Eval MalExpr +evalFn parms = + let + {- Extract symbols from the binds list and verify their uniqueness -} + extractSymbols acc list = + case list of + [] -> + Ok (List.reverse acc) + + (MalSymbol name) :: rest -> + if List.member name acc then + Err "all binds must have unique names" + + else + extractSymbols (name :: acc) rest + + _ -> + Err "all binds in fn* must be a symbol" + + parseBinds list = + case List.reverse list of + var :: "&" :: rest -> + Ok <| bindVarArgs (List.reverse rest) var + + _ -> + if List.member "&" list then + Err "varargs separator '&' is used incorrectly" + + else + Ok <| bindArgs list + + extractAndParse = + extractSymbols [] >> Result.andThen parseBinds + + bindArgs binds args = + let + numBinds = + List.length binds + in + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args + + bindVarArgs binds var args = + let + minArgs = + List.length binds + + varArgs = + MalList Nothing (List.drop minArgs args) + in + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] + + makeFn frameId binder body = + MalFunction <| + let + lazyFn args = + case binder args of + Ok bound -> + Eval.succeed <| + MalApply + { frameId = frameId + , bound = bound + , body = body + } + + Err msg -> + Eval.fail msg + in + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } + + go bindsList body = + case extractAndParse bindsList of + Ok binder -> + Eval.modifyEnv Env.ref + -- reference the current frame. + |> Eval.andThen + (\_ -> + Eval.withEnv + (\env -> + Eval.succeed + (makeFn env.currentFrameId binder body) + ) + ) + + Err msg -> + Eval.fail msg + in + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "fn* expected two args: binds list and body" + + +print : Env -> MalExpr -> String +print env = + printString env True + + +printError : Env -> MalExpr -> String +printError env expr = + "Error: " ++ printString env False expr + + +{-| Read-Eval-Print. + +Doesn't actually run the Eval but returns the monad. + +-} +rep : String -> Eval MalExpr +rep input = + case readString input of + Err msg -> + Eval.fail msg + + Ok ast -> + eval ast diff --git a/impls/elm/src/Step7_quote.elm b/impls/elm/src/Step7_quote.elm new file mode 100644 index 0000000000..bebcd0cc38 --- /dev/null +++ b/impls/elm/src/Step7_quote.elm @@ -0,0 +1,629 @@ +module Step7_quote exposing (..) + +import Array +import Core +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Args = + List String + + +type alias Flags = + { args : Args + } + + +type Model + = InitIO Args Env (IO -> Eval MalExpr) + | ScriptIO Env (IO -> Eval MalExpr) + | ReplActive Env + | ReplIO Env (IO -> Eval MalExpr) + | Stopped + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + let + makeFn = + CoreFunc Nothing >> MalFunction + + initEnv = + Core.ns + |> Env.set "eval" (makeFn malEval) + |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) + + evalMalInit = + malInit + |> List.map rep + |> List.foldl + (\b a -> a |> Eval.andThen (\_ -> b)) + (Eval.succeed MalNil) + in + runInit args initEnv evalMalInit + + +malInit : List String +malInit = + [ """(def! not + (fn* (a) + (if a false true)))""" + , """(def! load-file + (fn* (f) + (eval (read-string + (str "(do " (slurp f) "\nnil)")))))""" + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case model of + Stopped -> + ( model, Cmd.none ) + + InitIO args env cont -> + case msg of + Input (Ok io) -> + runInit args env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ScriptIO env cont -> + case msg of + Input (Ok io) -> + runScriptLoop env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ReplActive env -> + case msg of + Input (Ok (LineRead (Just line))) -> + run env (rep line) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + -- Ctrl+D = The End. + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 + + ReplIO env cont -> + case msg of + Input (Ok io) -> + run env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runInit args env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + -- Init went okay. + case args of + -- If we got no args: start REPL. + [] -> + ( ReplActive env, readLine prompt ) + + -- Run the script in the first argument. + -- Put the rest of the arguments as *ARGV*. + filename :: argv -> + runScript filename argv env + + ( env, EvalErr msg ) -> + -- Init failed, don't start REPL. + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + -- IO in init. + ( InitIO args env cont, cmd ) + + +runScript : String -> List String -> Env -> ( Model, Cmd Msg ) +runScript filename argv env = + let + malArgv = + MalList Nothing (List.map MalString argv) + + newEnv = + env |> Env.set "*ARGV*" malArgv + + program = + MalList Nothing + [ MalSymbol "load-file" + , MalString filename + ] + in + runScriptLoop newEnv (eval program) + + +runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runScriptLoop env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( Stopped, Cmd.none ) + + ( env, EvalErr msg ) -> + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ScriptIO env cont, cmd ) + + +run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +run env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( ReplActive env, writeLine (print env expr) ) + + ( env, EvalErr msg ) -> + ( ReplActive env, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ReplIO env cont, cmd ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +debug : String -> (Env -> a) -> Eval b -> Eval b +debug msg f e = + Eval.withEnv + (\env -> + Env.debug env msg (f env) + |> always e + ) + + +eval : MalExpr -> Eval MalExpr +eval ast = + let + apply expr env = + case expr of + MalApply app -> + Left + (debug "evalApply" + (\env2 -> printString env2 True expr) + (evalApply app) + ) + + _ -> + Right expr + in + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) + + +malEval : List MalExpr -> Eval MalExpr +malEval args = + case args of + [ expr ] -> + Eval.inGlobal (eval expr) + + _ -> + Eval.fail "unsupported arguments" + + +evalApply : ApplyRec -> Eval MalExpr +evalApply { frameId, bound, body } = + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.leave + |> Eval.gcPass + ) + + +evalNoApply : MalExpr -> Eval MalExpr +evalNoApply ast = + Eval.withEnv (\env -> Eval.succeed <| + case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + ) |> Eval.andThen (\_ -> + case ast of + MalList _ [] -> + Eval.succeed ast + + MalList _ ((MalSymbol "def!") :: args) -> + evalDef args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet args + + MalList _ ((MalSymbol "do") :: args) -> + evalDo args + + MalList _ ((MalSymbol "if") :: args) -> + evalIf args + + MalList _ ((MalSymbol "fn*") :: args) -> + evalFn args + + MalList _ ((MalSymbol "quote") :: args) -> + evalQuote args + + MalList _ ((MalSymbol "quasiquote") :: args) -> + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) + + _ -> + Eval.fail "unsupported arguments" + + MalList _ list -> + evalList list + |> Eval.andThen + (\newList -> + case newList of + [] -> + Eval.fail "can't happen" + + (MalFunction (CoreFunc _ fn)) :: args -> + fn args + + (MalFunction (UserFunc { lazyFn })) :: args -> + lazyFn args + + fn :: _ -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + Eval.withEnv (Env.get sym >> Eval.fromResult) + + MalVector _ vec -> + evalList (Array.toList vec) + |> Eval.map (Array.fromList >> MalVector Nothing) + + MalMap _ map -> + evalList (Dict.values map) + |> Eval.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + + _ -> + Eval.succeed ast + ) + + +evalList : List MalExpr -> Eval (List MalExpr) +evalList list = + let + go lst acc = + case lst of + [] -> + Eval.succeed (List.reverse acc) + + x :: rest -> + eval x + |> Eval.andThen + (\val -> + go rest (val :: acc) + ) + in + go list [] + + +evalDef : List MalExpr -> Eval MalExpr +evalDef args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen (\_ -> Eval.succeed value) + ) + + _ -> + Eval.fail "def! expected two args: name and value" + + +evalLet : List MalExpr -> Eval MalExpr +evalLet args = + let + evalBinds binds = + case binds of + (MalSymbol name) :: expr :: rest -> + eval expr + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen + (\_ -> + if List.isEmpty rest then + Eval.succeed () + + else + evalBinds rest + ) + ) + + _ -> + Eval.fail "let* expected an even number of binds (symbol expr ..)" + + go binds body = + Eval.modifyEnv Env.push + |> Eval.andThen (\_ -> evalBinds binds) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.pop + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "let* expected two args: binds and a body" + + +evalDo : List MalExpr -> Eval MalExpr +evalDo args = + case List.reverse args of + last :: rest -> + evalList (List.reverse rest) + |> Eval.andThen (\_ -> evalNoApply last) + + [] -> + Eval.fail "do expected at least one arg" + + +evalIf : List MalExpr -> Eval MalExpr +evalIf args = + let + isTruthy expr = + expr /= MalNil && expr /= MalBool False + + go condition trueExpr falseExpr = + eval condition + |> Eval.andThen + (\cond -> + evalNoApply + (if isTruthy cond then + trueExpr + + else + falseExpr + ) + ) + in + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil + + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr + + _ -> + Eval.fail "if expected at least two args" + + +evalFn : List MalExpr -> Eval MalExpr +evalFn parms = + let + {- Extract symbols from the binds list and verify their uniqueness -} + extractSymbols acc list = + case list of + [] -> + Ok (List.reverse acc) + + (MalSymbol name) :: rest -> + if List.member name acc then + Err "all binds must have unique names" + + else + extractSymbols (name :: acc) rest + + _ -> + Err "all binds in fn* must be a symbol" + + parseBinds list = + case List.reverse list of + var :: "&" :: rest -> + Ok <| bindVarArgs (List.reverse rest) var + + _ -> + if List.member "&" list then + Err "varargs separator '&' is used incorrectly" + + else + Ok <| bindArgs list + + extractAndParse = + extractSymbols [] >> Result.andThen parseBinds + + bindArgs binds args = + let + numBinds = + List.length binds + in + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args + + bindVarArgs binds var args = + let + minArgs = + List.length binds + + varArgs = + MalList Nothing (List.drop minArgs args) + in + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] + + makeFn frameId binder body = + MalFunction <| + let + lazyFn = + binder + >> Eval.fromResult + >> Eval.map + (\bound -> + MalApply + { frameId = frameId + , bound = bound + , body = body + } + ) + in + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } + + go bindsList body = + extractAndParse bindsList + |> Eval.fromResult + -- reference the current frame. + |> Eval.ignore (Eval.modifyEnv Env.ref) + |> Eval.andThen + (\binder -> + Eval.withEnv + (\env -> + Eval.succeed + (makeFn env.currentFrameId binder body) + ) + ) + in + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "fn* expected two args: binds list and body" + + +evalQuote : List MalExpr -> Eval MalExpr +evalQuote args = + case args of + [ expr ] -> + Eval.succeed expr + + _ -> + Eval.fail "unsupported arguments" + + +evalQuasiQuote : MalExpr -> MalExpr +evalQuasiQuote expr = + let + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList _ [MalSymbol "splice-unquote", form]) -> + makeCall "concat" [ form, acc ] + _ -> + makeCall "cons" [ evalQuasiQuote elt, acc ] + in + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr + + +print : Env -> MalExpr -> String +print env = + printString env True + + +printError : Env -> MalExpr -> String +printError env expr = + "Error: " ++ printString env False expr + + +{-| Read-Eval-Print. + +Doesn't actually run the Eval but returns the monad. + +-} +rep : String -> Eval MalExpr +rep input = + case readString input of + Err msg -> + Eval.fail msg + + Ok ast -> + eval ast diff --git a/impls/elm/src/Step8_macros.elm b/impls/elm/src/Step8_macros.elm new file mode 100644 index 0000000000..b098f97095 --- /dev/null +++ b/impls/elm/src/Step8_macros.elm @@ -0,0 +1,664 @@ +module Step8_macros exposing (..) + +import Array +import Core +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Args = + List String + + +type alias Flags = + { args : Args + } + + +type Model + = InitIO Args Env (IO -> Eval MalExpr) + | ScriptIO Env (IO -> Eval MalExpr) + | ReplActive Env + | ReplIO Env (IO -> Eval MalExpr) + | Stopped + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + let + makeFn = + CoreFunc Nothing >> MalFunction + + initEnv = + Core.ns + |> Env.set "eval" (makeFn malEval) + |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) + + evalMalInit = + malInit + |> List.map rep + |> List.foldl + (\b a -> a |> Eval.andThen (\_ -> b)) + (Eval.succeed MalNil) + in + runInit args initEnv evalMalInit + + +malInit : List String +malInit = + [ """(def! not + (fn* (a) + (if a false true)))""" + , """(def! load-file + (fn* (f) + (eval (read-string + (str "(do " (slurp f) "\nnil)")))))""" + , """(defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""" + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case model of + Stopped -> + ( model, Cmd.none ) + + InitIO args env cont -> + case msg of + Input (Ok io) -> + runInit args env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ScriptIO env cont -> + case msg of + Input (Ok io) -> + runScriptLoop env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ReplActive env -> + case msg of + Input (Ok (LineRead (Just line))) -> + run env (rep line) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + -- Ctrl+D = The End. + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 + + ReplIO env cont -> + case msg of + Input (Ok io) -> + run env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runInit args env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + -- Init went okay. + case args of + -- If we got no args: start REPL. + [] -> + ( ReplActive env, readLine prompt ) + + -- Run the script in the first argument. + -- Put the rest of the arguments as *ARGV*. + filename :: argv -> + runScript filename argv env + + ( env, EvalErr msg ) -> + -- Init failed, don't start REPL. + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + -- IO in init. + ( InitIO args env cont, cmd ) + + +runScript : String -> List String -> Env -> ( Model, Cmd Msg ) +runScript filename argv env = + let + malArgv = + MalList Nothing (List.map MalString argv) + + newEnv = + env |> Env.set "*ARGV*" malArgv + + program = + MalList Nothing + [ MalSymbol "load-file" + , MalString filename + ] + in + runScriptLoop newEnv (eval program) + + +runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runScriptLoop env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( Stopped, Cmd.none ) + + ( env, EvalErr msg ) -> + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ScriptIO env cont, cmd ) + + +run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +run env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( ReplActive env, writeLine (print env expr) ) + + ( env, EvalErr msg ) -> + ( ReplActive env, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ReplIO env cont, cmd ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +debug : String -> (Env -> a) -> Eval b -> Eval b +debug msg f e = + Eval.withEnv + (\env -> + Env.debug env msg (f env) + |> always e + ) + + +eval : MalExpr -> Eval MalExpr +eval ast = + let + apply expr env = + case expr of + MalApply app -> + Left + (debug "evalApply" + (\env2 -> printString env2 True expr) + (evalApply app) + ) + + _ -> + Right expr + in + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) + + +malEval : List MalExpr -> Eval MalExpr +malEval args = + case args of + [ expr ] -> + Eval.inGlobal (eval expr) + + _ -> + Eval.fail "unsupported arguments" + + +evalApply : ApplyRec -> Eval MalExpr +evalApply { frameId, bound, body } = + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.leave + |> Eval.gcPass + ) + + +evalNoApply : MalExpr -> Eval MalExpr +evalNoApply ast = + Eval.withEnv (\env -> Eval.succeed <| + case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + ) |> Eval.andThen (\_ -> + case ast of + MalList _ ((MalSymbol "def!") :: args) -> + evalDef args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet args + + MalList _ ((MalSymbol "do") :: args) -> + evalDo args + + MalList _ ((MalSymbol "if") :: args) -> + evalIf args + + MalList _ ((MalSymbol "fn*") :: args) -> + evalFn args + + MalList _ ((MalSymbol "quote") :: args) -> + evalQuote args + + MalList _ ((MalSymbol "quasiquote") :: args) -> + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) + + _ -> + Eval.fail "unsupported arguments" + + MalList _ ((MalSymbol "defmacro!") :: args) -> + evalDefMacro args + + MalList _ (a0 :: rest) -> + eval a0 + |> Eval.andThen + (\f -> + case f of + MalFunction (CoreFunc _ fn) -> + let args = evalList rest in Eval.andThen + fn args + + MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> + if isMacro then + Eval.andThen evalNoApply (eagerFn rest) + + else + let args = evalList rest in Eval.andThen + lazyFn args + + fn -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + Eval.withEnv (Env.get sym >> Eval.fromResult) + + MalVector _ vec -> + evalList (Array.toList vec) + |> Eval.map (Array.fromList >> MalVector Nothing) + + MalMap _ map -> + evalList (Dict.values map) + |> Eval.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + + _ -> + Eval.succeed ast + ) + + +evalList : List MalExpr -> Eval (List MalExpr) +evalList list = + let + go lst acc = + case lst of + [] -> + Eval.succeed (List.reverse acc) + + x :: rest -> + eval x + |> Eval.andThen + (\val -> + go rest (val :: acc) + ) + in + go list [] + + +evalDef : List MalExpr -> Eval MalExpr +evalDef args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen (\_ -> Eval.succeed value) + ) + + _ -> + Eval.fail "def! expected two args: name and value" + + +evalDefMacro : List MalExpr -> Eval MalExpr +evalDefMacro args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + case value of + MalFunction (UserFunc fn) -> + let + macroFn = + MalFunction (UserFunc { fn | isMacro = True }) + in + Eval.modifyEnv (Env.set name macroFn) + |> Eval.andThen (\_ -> Eval.succeed macroFn) + + _ -> + Eval.fail "defmacro! is only supported on a user function" + ) + + _ -> + Eval.fail "defmacro! expected two args: name and value" + + +evalLet : List MalExpr -> Eval MalExpr +evalLet args = + let + evalBinds binds = + case binds of + (MalSymbol name) :: expr :: rest -> + eval expr + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen + (\_ -> + if List.isEmpty rest then + Eval.succeed () + + else + evalBinds rest + ) + ) + + _ -> + Eval.fail "let* expected an even number of binds (symbol expr ..)" + + go binds body = + Eval.modifyEnv Env.push + |> Eval.andThen (\_ -> evalBinds binds) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.pop + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "let* expected two args: binds and a body" + + +evalDo : List MalExpr -> Eval MalExpr +evalDo args = + case List.reverse args of + last :: rest -> + evalList (List.reverse rest) + |> Eval.andThen (\_ -> evalNoApply last) + + [] -> + Eval.fail "do expected at least one arg" + + +evalIf : List MalExpr -> Eval MalExpr +evalIf args = + let + isTruthy expr = + expr /= MalNil && expr /= MalBool False + + go condition trueExpr falseExpr = + eval condition + |> Eval.andThen + (\cond -> + evalNoApply + (if isTruthy cond then + trueExpr + + else + falseExpr + ) + ) + in + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil + + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr + + _ -> + Eval.fail "if expected at least two args" + + +evalFn : List MalExpr -> Eval MalExpr +evalFn parms = + let + {- Extract symbols from the binds list and verify their uniqueness -} + extractSymbols acc list = + case list of + [] -> + Ok (List.reverse acc) + + (MalSymbol name) :: rest -> + if List.member name acc then + Err "all binds must have unique names" + + else + extractSymbols (name :: acc) rest + + _ -> + Err "all binds in fn* must be a symbol" + + parseBinds list = + case List.reverse list of + var :: "&" :: rest -> + Ok <| bindVarArgs (List.reverse rest) var + + _ -> + if List.member "&" list then + Err "varargs separator '&' is used incorrectly" + + else + Ok <| bindArgs list + + extractAndParse = + extractSymbols [] >> Result.andThen parseBinds + + bindArgs binds args = + let + numBinds = + List.length binds + in + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args + + bindVarArgs binds var args = + let + minArgs = + List.length binds + + varArgs = + MalList Nothing (List.drop minArgs args) + in + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] + + makeFn frameId binder body = + MalFunction <| + let + lazyFn = + binder + >> Eval.fromResult + >> Eval.map + (\bound -> + MalApply + { frameId = frameId + , bound = bound + , body = body + } + ) + in + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } + + go bindsList body = + extractAndParse bindsList + |> Eval.fromResult + -- reference the current frame. + |> Eval.ignore (Eval.modifyEnv Env.ref) + |> Eval.andThen + (\binder -> + Eval.withEnv + (\env -> + Eval.succeed + (makeFn env.currentFrameId binder body) + ) + ) + in + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "fn* expected two args: binds list and body" + + +evalQuote : List MalExpr -> Eval MalExpr +evalQuote args = + case args of + [ expr ] -> + Eval.succeed expr + + _ -> + Eval.fail "unsupported arguments" + + +evalQuasiQuote : MalExpr -> MalExpr +evalQuasiQuote expr = + let + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList _ [MalSymbol "splice-unquote", form]) -> + makeCall "concat" [ form, acc ] + _ -> + makeCall "cons" [ evalQuasiQuote elt, acc ] + in + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr + + +print : Env -> MalExpr -> String +print env = + printString env True + + +printError : Env -> MalExpr -> String +printError env expr = + "Error: " ++ printString env False expr + + +{-| Read-Eval-Print. + +Doesn't actually run the Eval but returns the monad. + +-} +rep : String -> Eval MalExpr +rep input = + case readString input of + Err msg -> + Eval.fail msg + + Ok ast -> + eval ast diff --git a/impls/elm/src/Step9_try.elm b/impls/elm/src/Step9_try.elm new file mode 100644 index 0000000000..da450ec9fb --- /dev/null +++ b/impls/elm/src/Step9_try.elm @@ -0,0 +1,690 @@ +module Step9_try exposing (..) + +import Array +import Core +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Args = + List String + + +type alias Flags = + { args : Args + } + + +type Model + = InitIO Args Env (IO -> Eval MalExpr) + | ScriptIO Env (IO -> Eval MalExpr) + | ReplActive Env + | ReplIO Env (IO -> Eval MalExpr) + | Stopped + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + let + makeFn = + CoreFunc Nothing >> MalFunction + + initEnv = + Core.ns + |> Env.set "eval" (makeFn malEval) + |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) + + evalMalInit = + malInit + |> List.map rep + |> List.foldl + (\b a -> a |> Eval.andThen (\_ -> b)) + (Eval.succeed MalNil) + in + runInit args initEnv evalMalInit + + +malInit : List String +malInit = + [ """(def! not + (fn* (a) + (if a false true)))""" + , """(def! load-file + (fn* (f) + (eval (read-string + (str "(do " (slurp f) "\nnil)")))))""" + , """(defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""" + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case model of + Stopped -> + ( model, Cmd.none ) + + InitIO args env cont -> + case msg of + Input (Ok io) -> + runInit args env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ScriptIO env cont -> + case msg of + Input (Ok io) -> + runScriptLoop env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ReplActive env -> + case msg of + Input (Ok (LineRead (Just line))) -> + run env (rep line) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + -- Ctrl+D = The End. + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 + + ReplIO env cont -> + case msg of + Input (Ok io) -> + run env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runInit args env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + -- Init went okay. + case args of + -- If we got no args: start REPL. + [] -> + ( ReplActive env, readLine prompt ) + + -- Run the script in the first argument. + -- Put the rest of the arguments as *ARGV*. + filename :: argv -> + runScript filename argv env + + ( env, EvalErr msg ) -> + -- Init failed, don't start REPL. + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + -- IO in init. + ( InitIO args env cont, cmd ) + + +runScript : String -> List String -> Env -> ( Model, Cmd Msg ) +runScript filename argv env = + let + malArgv = + MalList Nothing (List.map MalString argv) + + newEnv = + env |> Env.set "*ARGV*" malArgv + + program = + MalList Nothing + [ MalSymbol "load-file" + , MalString filename + ] + in + runScriptLoop newEnv (eval program) + + +runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runScriptLoop env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( Stopped, Cmd.none ) + + ( env, EvalErr msg ) -> + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ScriptIO env cont, cmd ) + + +run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +run env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( ReplActive env, writeLine (print env expr) ) + + ( env, EvalErr msg ) -> + ( ReplActive env, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ReplIO env cont, cmd ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +debug : String -> (Env -> a) -> Eval b -> Eval b +debug msg f e = + Eval.withEnv + (\env -> + Env.debug env msg (f env) + |> always e + ) + + +eval : MalExpr -> Eval MalExpr +eval ast = + let + apply expr env = + case expr of + MalApply app -> + Left + (debug "evalApply" + (\env2 -> printString env2 True expr) + (evalApply app) + ) + + _ -> + Right expr + in + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) + + +malEval : List MalExpr -> Eval MalExpr +malEval args = + case args of + [ expr ] -> + Eval.inGlobal (eval expr) + + _ -> + Eval.fail "unsupported arguments" + + +evalApply : ApplyRec -> Eval MalExpr +evalApply { frameId, bound, body } = + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.leave + |> Eval.gcPass + ) + + +evalNoApply : MalExpr -> Eval MalExpr +evalNoApply ast = + Eval.withEnv (\env -> Eval.succeed <| + case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + ) |> Eval.andThen (\_ -> + case ast of + MalList _ ((MalSymbol "def!") :: args) -> + evalDef args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet args + + MalList _ ((MalSymbol "do") :: args) -> + evalDo args + + MalList _ ((MalSymbol "if") :: args) -> + evalIf args + + MalList _ ((MalSymbol "fn*") :: args) -> + evalFn args + + MalList _ ((MalSymbol "quote") :: args) -> + evalQuote args + + MalList _ ((MalSymbol "quasiquote") :: args) -> + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) + + _ -> + Eval.fail "unsupported arguments" + + MalList _ ((MalSymbol "defmacro!") :: args) -> + evalDefMacro args + + MalList _ ((MalSymbol "try*") :: args) -> + evalTry args + + MalList _ (a0 :: rest) -> + eval a0 + |> Eval.andThen + (\f -> + case f of + MalFunction (CoreFunc _ fn) -> + let args = evalList rest in Eval.andThen + fn args + + MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> + if isMacro then + Eval.andThen evalNoApply (eagerFn rest) + + else + let args = evalList rest in Eval.andThen + lazyFn args + + fn -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + Eval.withEnv (Env.get sym >> Eval.fromResult) + + MalVector _ vec -> + evalList (Array.toList vec) + |> Eval.map (Array.fromList >> MalVector Nothing) + + MalMap _ map -> + evalList (Dict.values map) + |> Eval.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + + _ -> + Eval.succeed ast + ) + + +evalList : List MalExpr -> Eval (List MalExpr) +evalList list = + let + go lst acc = + case lst of + [] -> + Eval.succeed (List.reverse acc) + + x :: rest -> + eval x + |> Eval.andThen + (\val -> + go rest (val :: acc) + ) + in + go list [] + + +evalDef : List MalExpr -> Eval MalExpr +evalDef args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen (\_ -> Eval.succeed value) + ) + + _ -> + Eval.fail "def! expected two args: name and value" + + +evalDefMacro : List MalExpr -> Eval MalExpr +evalDefMacro args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + case value of + MalFunction (UserFunc fn) -> + let + macroFn = + MalFunction (UserFunc { fn | isMacro = True }) + in + Eval.modifyEnv (Env.set name macroFn) + |> Eval.andThen (\_ -> Eval.succeed macroFn) + + _ -> + Eval.fail "defmacro! is only supported on a user function" + ) + + _ -> + Eval.fail "defmacro! expected two args: name and value" + + +evalLet : List MalExpr -> Eval MalExpr +evalLet args = + let + evalBinds binds = + case binds of + (MalSymbol name) :: expr :: rest -> + eval expr + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen + (\_ -> + if List.isEmpty rest then + Eval.succeed () + + else + evalBinds rest + ) + ) + + _ -> + Eval.fail "let* expected an even number of binds (symbol expr ..)" + + go binds body = + Eval.modifyEnv Env.push + |> Eval.andThen (\_ -> evalBinds binds) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.pop + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "let* expected two args: binds and a body" + + +evalDo : List MalExpr -> Eval MalExpr +evalDo args = + case List.reverse args of + last :: rest -> + evalList (List.reverse rest) + |> Eval.andThen (\_ -> evalNoApply last) + + [] -> + Eval.fail "do expected at least one arg" + + +evalIf : List MalExpr -> Eval MalExpr +evalIf args = + let + isTruthy expr = + expr /= MalNil && expr /= MalBool False + + go condition trueExpr falseExpr = + eval condition + |> Eval.andThen + (\cond -> + evalNoApply + (if isTruthy cond then + trueExpr + + else + falseExpr + ) + ) + in + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil + + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr + + _ -> + Eval.fail "if expected at least two args" + + +evalFn : List MalExpr -> Eval MalExpr +evalFn parms = + let + {- Extract symbols from the binds list and verify their uniqueness -} + extractSymbols acc list = + case list of + [] -> + Ok (List.reverse acc) + + (MalSymbol name) :: rest -> + if List.member name acc then + Err "all binds must have unique names" + + else + extractSymbols (name :: acc) rest + + _ -> + Err "all binds in fn* must be a symbol" + + parseBinds list = + case List.reverse list of + var :: "&" :: rest -> + Ok <| bindVarArgs (List.reverse rest) var + + _ -> + if List.member "&" list then + Err "varargs separator '&' is used incorrectly" + + else + Ok <| bindArgs list + + extractAndParse = + extractSymbols [] >> Result.andThen parseBinds + + bindArgs binds args = + let + numBinds = + List.length binds + in + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args + + bindVarArgs binds var args = + let + minArgs = + List.length binds + + varArgs = + MalList Nothing (List.drop minArgs args) + in + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] + + makeFn frameId binder body = + MalFunction <| + let + lazyFn = + binder + >> Eval.fromResult + >> Eval.map + (\bound -> + MalApply + { frameId = frameId + , bound = bound + , body = body + } + ) + in + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } + + go bindsList body = + extractAndParse bindsList + |> Eval.fromResult + -- reference the current frame. + |> Eval.ignore (Eval.modifyEnv Env.ref) + |> Eval.andThen + (\binder -> + Eval.withEnv + (\env -> + Eval.succeed + (makeFn env.currentFrameId binder body) + ) + ) + in + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "fn* expected two args: binds list and body" + + +evalQuote : List MalExpr -> Eval MalExpr +evalQuote args = + case args of + [ expr ] -> + Eval.succeed expr + + _ -> + Eval.fail "unsupported arguments" + + +evalQuasiQuote : MalExpr -> MalExpr +evalQuasiQuote expr = + let + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList _ [MalSymbol "splice-unquote", form]) -> + makeCall "concat" [ form, acc ] + _ -> + makeCall "cons" [ evalQuasiQuote elt, acc ] + in + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr + + +evalTry : List MalExpr -> Eval MalExpr +evalTry args = + case args of + [ body ] -> + eval body + + [ body, MalList _ [ MalSymbol "catch*", MalSymbol sym, handler ] ] -> + eval body + |> Eval.catchError + (\ex -> + Eval.modifyEnv Env.push + |> Eval.andThen + (\_ -> + Eval.modifyEnv (Env.set sym ex) + ) + |> Eval.andThen (\_ -> eval handler) + |> Eval.finally Env.pop + ) + + _ -> + Eval.fail "try* expected a body a catch block" + + +print : Env -> MalExpr -> String +print env = + printString env True + + +printError : Env -> MalExpr -> String +printError env expr = + "Error: " ++ printString env False expr + + +{-| Read-Eval-Print. + +Doesn't actually run the Eval but returns the monad. + +-} +rep : String -> Eval MalExpr +rep input = + case readString input of + Err msg -> + Eval.fail msg + + Ok ast -> + eval ast diff --git a/impls/elm/src/StepA_mal.elm b/impls/elm/src/StepA_mal.elm new file mode 100644 index 0000000000..55f1379cc4 --- /dev/null +++ b/impls/elm/src/StepA_mal.elm @@ -0,0 +1,697 @@ +module StepA_mal exposing (..) + +import Array +import Core +import Dict exposing (Dict) +import Env +import Eval +import IO exposing (..) +import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) +import Printer exposing (printString) +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) + + +main : Program Flags Model Msg +main = + worker + { init = init + , update = update + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of + Err e -> Err (errorToString e) + Ok a -> Ok a + ) >> Input) + } + + +type alias Args = + List String + + +type alias Flags = + { args : Args + } + + +type Model + = InitIO Args Env (IO -> Eval MalExpr) + | ScriptIO Env (IO -> Eval MalExpr) + | ReplActive Env + | ReplIO Env (IO -> Eval MalExpr) + | Stopped + + +init : Flags -> ( Model, Cmd Msg ) +init { args } = + let + makeFn = + CoreFunc Nothing >> MalFunction + + initEnv = + Core.ns + |> Env.set "eval" (makeFn malEval) + |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) + |> Env.set "*host-language*" (MalString "elm") + + evalMalInit = + malInit + |> List.map rep + |> List.foldl + (\b a -> a |> Eval.andThen (\_ -> b)) + (Eval.succeed MalNil) + in + runInit args initEnv evalMalInit + + +malInit : List String +malInit = + [ """(def! not + (fn* (a) + (if a false true)))""" + , """(def! load-file + (fn* (f) + (eval (read-string + (str "(do " (slurp f) "\nnil)")))))""" + , """(defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""" + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case model of + Stopped -> + ( model, Cmd.none ) + + InitIO args env cont -> + case msg of + Input (Ok io) -> + runInit args env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ScriptIO env cont -> + case msg of + Input (Ok io) -> + runScriptLoop env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 + + ReplActive env -> + case msg of + Input (Ok (LineRead (Just line))) -> + run env (rep line) + + Input (Ok LineWritten) -> + ( model, readLine prompt ) + + Input (Ok (LineRead Nothing)) -> + -- Ctrl+D = The End. + ( model, Cmd.none ) + + Input (Ok io) -> + Debug.todo "unexpected IO received: " io + + Input (Err msg2) -> + Debug.todo msg2 + + ReplIO env cont -> + case msg of + Input (Ok io) -> + run env (cont io) + + Input (Err msg2) -> + Debug.todo msg2 ( model, Cmd.none ) + + +runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runInit args env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + -- Init went okay. + case args of + -- If we got no args: start REPL. + [] -> + ( ReplActive env, readLine prompt ) + + -- Run the script in the first argument. + -- Put the rest of the arguments as *ARGV*. + filename :: argv -> + runScript filename argv env + + ( env, EvalErr msg ) -> + -- Init failed, don't start REPL. + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + -- IO in init. + ( InitIO args env cont, cmd ) + + +runScript : String -> List String -> Env -> ( Model, Cmd Msg ) +runScript filename argv env = + let + malArgv = + MalList Nothing (List.map MalString argv) + + newEnv = + env |> Env.set "*ARGV*" malArgv + + program = + MalList Nothing + [ MalSymbol "load-file" + , MalString filename + ] + in + runScriptLoop newEnv (eval program) + + +runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +runScriptLoop env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( Stopped, Cmd.none ) + + ( env, EvalErr msg ) -> + ( Stopped, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ScriptIO env cont, cmd ) + + +run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) +run env0 expr0 = + case Eval.run env0 expr0 of + ( env, EvalOk expr ) -> + ( ReplActive env, writeLine (print env expr) ) + + ( env, EvalErr msg ) -> + ( ReplActive env, writeLine (printError env msg) ) + + ( env, EvalIO cmd cont ) -> + ( ReplIO env cont, cmd ) + + +prompt : String +prompt = + "user> " + + +read : String -> Result String MalExpr +read = + readString + + +debug : String -> (Env -> a) -> Eval b -> Eval b +debug msg f e = + Eval.withEnv + (\env -> + Env.debug env msg (f env) + |> always e + ) + + +eval : MalExpr -> Eval MalExpr +eval ast = + let + apply expr env = + case expr of + MalApply app -> + Left + (debug "evalApply" + (\env2 -> printString env2 True expr) + (evalApply app) + ) + + _ -> + Right expr + in + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) + |> Eval.gcPass + + +malEval : List MalExpr -> Eval MalExpr +malEval args = + case args of + [ expr ] -> + Eval.inGlobal (eval expr) + + _ -> + Eval.fail "unsupported arguments" + + +evalApply : ApplyRec -> Eval MalExpr +evalApply { frameId, bound, body } = + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.leave + |> Eval.gcPass + ) + + +evalNoApply : MalExpr -> Eval MalExpr +evalNoApply ast = + Eval.withEnv (\env -> Eval.succeed <| + case Env.get "DEBUG-EVAL" env of + Err _ -> () + Ok MalNil -> () + Ok (MalBool False) -> () + _ -> Debug.log ("EVAL: " ++ printString env True ast) () + -- The output ends with an ugly ": ()", but that does not hurt. + ) |> Eval.andThen (\_ -> + case ast of + MalList _ ((MalSymbol "def!") :: args) -> + evalDef args + + MalList _ ((MalSymbol "let*") :: args) -> + evalLet args + + MalList _ ((MalSymbol "do") :: args) -> + evalDo args + + MalList _ ((MalSymbol "if") :: args) -> + evalIf args + + MalList _ ((MalSymbol "fn*") :: args) -> + evalFn args + + MalList _ ((MalSymbol "quote") :: args) -> + evalQuote args + + MalList _ ((MalSymbol "quasiquote") :: args) -> + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) + + _ -> + Eval.fail "unsupported arguments" + + MalList _ ((MalSymbol "defmacro!") :: args) -> + evalDefMacro args + + MalList _ ((MalSymbol "try*") :: args) -> + evalTry args + + MalList _ (a0 :: rest) -> + eval a0 + |> Eval.andThen + (\f -> + case f of + MalFunction (CoreFunc _ fn) -> + let args = evalList rest in Eval.andThen + fn args + + MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> + if isMacro then + Eval.andThen evalNoApply (eagerFn rest) + + else + let args = evalList rest in Eval.andThen + lazyFn args + + fn -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) + + MalSymbol sym -> + -- Lookup symbol in env and return value or raise error if not found. + Eval.withEnv (Env.get sym >> Eval.fromResult) + + MalVector _ vec -> + evalList (Array.toList vec) + |> Eval.map (Array.fromList >> MalVector Nothing) + + MalMap _ map -> + evalList (Dict.values map) + |> Eval.map + (zip (Dict.keys map) + >> Dict.fromList + >> MalMap Nothing + ) + + _ -> + Eval.succeed ast + + ) |> Eval.andThen (\res -> + debug "evalNoApply" + (\env -> (printString env True ast) ++ " = " ++ (printString env True res)) + (Eval.succeed res) + ) + + +evalList : List MalExpr -> Eval (List MalExpr) +evalList list = + let + go lst acc = + case lst of + [] -> + Eval.succeed (List.reverse acc) + + x :: rest -> + eval x + |> Eval.andThen + (\val -> + Eval.pushRef val <| go rest (val :: acc) + ) + in + Eval.withStack <| go list [] + + +evalDef : List MalExpr -> Eval MalExpr +evalDef args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen (\_ -> Eval.succeed value) + ) + + _ -> + Eval.fail "def! expected two args: name and value" + + +evalDefMacro : List MalExpr -> Eval MalExpr +evalDefMacro args = + case args of + [ MalSymbol name, uneValue ] -> + eval uneValue + |> Eval.andThen + (\value -> + case value of + MalFunction (UserFunc fn) -> + let + macroFn = + MalFunction (UserFunc { fn | isMacro = True }) + in + Eval.modifyEnv (Env.set name macroFn) + |> Eval.andThen (\_ -> Eval.succeed macroFn) + + _ -> + Eval.fail "defmacro! is only supported on a user function" + ) + + _ -> + Eval.fail "defmacro! expected two args: name and value" + + +evalLet : List MalExpr -> Eval MalExpr +evalLet args = + let + evalBinds binds = + case binds of + (MalSymbol name) :: expr :: rest -> + eval expr + |> Eval.andThen + (\value -> + Eval.modifyEnv (Env.set name value) + |> Eval.andThen + (\_ -> + if List.isEmpty rest then + Eval.succeed () + + else + evalBinds rest + ) + ) + + _ -> + Eval.fail "let* expected an even number of binds (symbol expr ..)" + + go binds body = + Eval.modifyEnv Env.push + |> Eval.andThen (\_ -> evalBinds binds) + |> Eval.andThen (\_ -> evalNoApply body) + |> Eval.finally Env.pop + in + case args of + [ MalList _ binds, body ] -> + go binds body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "let* expected two args: binds and a body" + + +evalDo : List MalExpr -> Eval MalExpr +evalDo args = + case List.reverse args of + last :: rest -> + evalList (List.reverse rest) + |> Eval.andThen (\_ -> evalNoApply last) + + [] -> + Eval.fail "do expected at least one arg" + + +evalIf : List MalExpr -> Eval MalExpr +evalIf args = + let + isTruthy expr = + expr /= MalNil && expr /= MalBool False + + go condition trueExpr falseExpr = + eval condition + |> Eval.andThen + (\cond -> + evalNoApply + (if isTruthy cond then + trueExpr + + else + falseExpr + ) + ) + in + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil + + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr + + _ -> + Eval.fail "if expected at least two args" + + +evalFn : List MalExpr -> Eval MalExpr +evalFn parms = + let + {- Extract symbols from the binds list and verify their uniqueness -} + extractSymbols acc list = + case list of + [] -> + Ok (List.reverse acc) + + (MalSymbol name) :: rest -> + if List.member name acc then + Err "all binds must have unique names" + + else + extractSymbols (name :: acc) rest + + _ -> + Err "all binds in fn* must be a symbol" + + parseBinds list = + case List.reverse list of + var :: "&" :: rest -> + Ok <| bindVarArgs (List.reverse rest) var + + _ -> + if List.member "&" list then + Err "varargs separator '&' is used incorrectly" + + else + Ok <| bindArgs list + + extractAndParse = + extractSymbols [] >> Result.andThen parseBinds + + bindArgs binds args = + let + numBinds = + List.length binds + in + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args + + bindVarArgs binds var args = + let + minArgs = + List.length binds + + varArgs = + MalList Nothing (List.drop minArgs args) + in + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] + + makeFn frameId binder body = + MalFunction <| + let + lazyFn = + binder + >> Eval.fromResult + >> Eval.map + (\bound -> + MalApply + { frameId = frameId + , bound = bound + , body = body + } + ) + in + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } + + go bindsList body = + extractAndParse bindsList + |> Eval.fromResult + -- reference the current frame. + |> Eval.ignore (Eval.modifyEnv Env.ref) + |> Eval.andThen + (\binder -> + Eval.withEnv + (\env -> + Eval.succeed + (makeFn env.currentFrameId binder body) + ) + ) + in + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body + + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body + + _ -> + Eval.fail "fn* expected two args: binds list and body" + + +evalQuote : List MalExpr -> Eval MalExpr +evalQuote args = + case args of + [ expr ] -> + Eval.succeed expr + + _ -> + Eval.fail "unsupported arguments" + + +evalQuasiQuote : MalExpr -> MalExpr +evalQuasiQuote expr = + let + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList _ [MalSymbol "splice-unquote", form]) -> + makeCall "concat" [ form, acc ] + _ -> + makeCall "cons" [ evalQuasiQuote elt, acc ] + in + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr + + +evalTry : List MalExpr -> Eval MalExpr +evalTry args = + case args of + [ body ] -> + eval body + + [ body, MalList _ [ MalSymbol "catch*", MalSymbol sym, handler ] ] -> + eval body + |> Eval.catchError + (\ex -> + Eval.modifyEnv Env.push + |> Eval.andThen + (\_ -> + Eval.modifyEnv (Env.set sym ex) + ) + |> Eval.andThen (\_ -> eval handler) + |> Eval.finally Env.pop + ) + + _ -> + Eval.fail "try* expected a body a catch block" + + +print : Env -> MalExpr -> String +print env = + printString env True + + +printError : Env -> MalExpr -> String +printError env expr = + "Error: " ++ printString env False expr + + +{-| Read-Eval-Print. + +Doesn't actually run the Eval but returns the monad. + +-} +rep : String -> Eval MalExpr +rep input = + case readString input of + Err msg -> + Eval.fail msg + + Ok ast -> + eval ast diff --git a/impls/elm/src/Types.elm b/impls/elm/src/Types.elm new file mode 100644 index 0000000000..b4e281d463 --- /dev/null +++ b/impls/elm/src/Types.elm @@ -0,0 +1,107 @@ +module Types exposing (..) + +import Array exposing (Array) +import Dict exposing (Dict) +import IO exposing (IO) + + +type Either a b + = Left a + | Right b + + +type Msg + = Input (Result String IO) + + +type alias Frame = + { outerId : Maybe Int + , exitId : Maybe Int + , data : Dict String MalExpr + , refCnt : Int + } + + +type alias Env = + { frames : Dict Int Frame + , nextFrameId : Int + , currentFrameId : Int + , atoms : Dict Int MalExpr + , nextAtomId : Int + , debug : Bool + , gcInterval : Int + , gcCounter : Int + , stack : List MalExpr + , keepFrames : List Int + } + + +type alias EvalCont a = + IO -> Eval a + + +type EvalResult res + = EvalErr MalExpr + | EvalOk res + | EvalIO (Cmd Msg) (EvalCont res) + + +type alias EvalContext res = + ( Env, EvalResult res ) + + +type alias Eval res = + Env -> EvalContext res + + +type alias MalFn = + List MalExpr -> Eval MalExpr + + +type MalFunction + = CoreFunc (Maybe MalExpr) MalFn + | UserFunc + { frameId : Int + , lazyFn : MalFn + , eagerFn : MalFn + , isMacro : Bool + , meta : Maybe MalExpr + } + + +type alias ApplyRec = + { frameId : Int, bound : Bound, body : MalExpr } + + +type alias TcoFn = + () -> Eval MalExpr + + +type alias Bound = + List ( String, MalExpr ) + + +type MalExpr + = MalNil + | MalBool Bool + | MalInt Int + | MalString String + | MalKeyword String + | MalSymbol String + | MalList (Maybe MalExpr) (List MalExpr) + | MalVector (Maybe MalExpr) (Array MalExpr) + | MalMap (Maybe MalExpr) (Dict String MalExpr) + | MalFunction MalFunction + | MalApply ApplyRec + | MalAtom Int + + +{-| Keywords are prefixed by this char for usage in a MalMap. +Elm doesn't support user defined types as keys in a Dict. + +The unicode char is: '\\x029e' + +-} +keywordPrefix : Char +keywordPrefix = + 'Êž' diff --git a/impls/elm/src/Utils.elm b/impls/elm/src/Utils.elm new file mode 100644 index 0000000000..b6de08c474 --- /dev/null +++ b/impls/elm/src/Utils.elm @@ -0,0 +1,131 @@ +module Utils exposing + ( decodeString + , encodeString + , flip + , justValues + , last + , makeCall + , maybeToList + , wrap + , zip + ) + +import Regex +import Types exposing (MalExpr(..)) + + +decodeString : String -> String +decodeString = + let + unescape { match } = + case match of + "\\n" -> + "\n" + + "\\\"" -> + "\"" + + "\\\\" -> + "\\" + + other -> + other + in + String.slice 1 -1 + >> Regex.replace (regex "\\\\[\\\"\\\\n]") unescape + + + +-- helps replace all the encodes found into a string + + +regex : String -> Regex.Regex +regex str = + case Regex.fromString str of + Nothing -> Debug.todo "invalid regex" + Just r -> r + + +encodeString : String -> String +encodeString = + let + escape { match } = + case match of + "\n" -> + "\\n" + + "\"" -> + "\\\"" + + "\\" -> + "\\\\" + + other -> + other + in + wrap "\"" "\"" + << Regex.replace (regex "[\\n\\\"\\\\]") escape + + +makeCall : String -> List MalExpr -> MalExpr +makeCall symbol args = + MalList Nothing <| MalSymbol symbol :: args + + +wrap : String -> String -> String -> String +wrap prefix suffix str = + prefix ++ str ++ suffix + + +maybeToList : Maybe a -> List a +maybeToList m = + case m of + Just x -> + [ x ] + + Nothing -> + [] + + +zip : List a -> List b -> List ( a, b ) +zip a b = + case ( a, b ) of + ( [], _ ) -> + [] + + ( _, [] ) -> + [] + + ( x :: xs, y :: ys ) -> + ( x, y ) :: zip xs ys + + +last : List a -> Maybe a +last list = + case list of + [] -> + Nothing + + [ x ] -> + Just x + + x :: xs -> + last xs + + +justValues : List (Maybe a) -> List a +justValues list = + case list of + [] -> + [] + + (Just x) :: rest -> + x :: justValues rest + + Nothing :: rest -> + justValues rest + + +flip : (a -> b -> c) -> (b -> a -> c) +flip f b a = + f a b diff --git a/impls/erlang/Dockerfile b/impls/erlang/Dockerfile new file mode 100644 index 0000000000..0dd2a8648b --- /dev/null +++ b/impls/erlang/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install erlang rebar diff --git a/impls/erlang/Makefile b/impls/erlang/Makefile new file mode 100644 index 0000000000..5ad84cca76 --- /dev/null +++ b/impls/erlang/Makefile @@ -0,0 +1,37 @@ +##################### + +SOURCES_BASE = src/atom.erl src/printer.erl src/reader.erl +SOURCES_LISP = src/core.erl src/env.erl src/types.erl src/stepA_mal.erl +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +##################### + +SRCS = step0_repl.erl step1_read_print.erl step2_eval.erl step3_env.erl step4_if_fn_do.erl \ + step5_tco.erl step6_file.erl step7_quote.erl step8_macros.erl step9_try.erl stepA_mal.erl +BINS = $(SRCS:%.erl=%) + +##################### + +.PHONY: all dist clean + +all: $(BINS) + +dist: mal + +mal: $(SOURCES) + sed 's/stepA_mal/mal/' src/stepA_mal.erl > src/mal.erl + MAL_STEP=mal rebar compile escriptize + rm src/mal.erl + + +define dep_template +.PHONY: $(1) +$(1): src/$(1).erl + MAL_STEP=$(1) rebar compile escriptize +endef + +$(foreach b,$(BINS),$(eval $(call dep_template,$(b)))) + +clean: + rebar clean + rm -f mal diff --git a/impls/erlang/rebar.config b/impls/erlang/rebar.config new file mode 100644 index 0000000000..80e028cbac --- /dev/null +++ b/impls/erlang/rebar.config @@ -0,0 +1,22 @@ +%% +%% rebar configuration file (https://github.com/rebar/rebar) +%% + +{erl_opts, [debug_info, fail_on_warning]}. + +{clean_files, [ + "ebin", + "src/*.beam", + "mal", + "step0_repl", + "step1_read_print", + "step2_eval", + "step3_env", + "step4_if_fn_do", + "step5_tco", + "step6_file", + "step7_quote", + "step8_macros", + "step9_try", + "stepA_mal" +]}. diff --git a/impls/erlang/rebar.config.script b/impls/erlang/rebar.config.script new file mode 100644 index 0000000000..9ad75efe05 --- /dev/null +++ b/impls/erlang/rebar.config.script @@ -0,0 +1,11 @@ +%% +%% rebar dynamic configuration file +%% (https://github.com/rebar/rebar/wiki/Dynamic-configuration) +%% + +case os:getenv("MAL_STEP") of + false -> CONFIG; % env var not defined + [] -> CONFIG; % env var set to empty string + Step -> CONFIG ++ [{escript_name, Step}]; + mal -> CONFIG ++ [{escript_name, mal}] +end. diff --git a/impls/erlang/run b/impls/erlang/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/erlang/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/erlang/src/atom.erl b/impls/erlang/src/atom.erl new file mode 100644 index 0000000000..f322eeae31 --- /dev/null +++ b/impls/erlang/src/atom.erl @@ -0,0 +1,69 @@ +%%% +%%% Atom +%%% +%%% Atoms in MAL represent mutable data, which is not native to Erlang. The +%%% lightweight technique for representing mutable data in Erlang is with a +%%% lightweight process. +%%% + +-module(atom). +-behavior(gen_server). + +-export([new/1, deref/1, reset/2]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). + +-record(state, {atom}). + +%% +%% Public API +%% + +-spec new(Atom) -> Pid + when Atom :: term(), + Pid :: pid(). +new(Atom) -> + case gen_server:start(?MODULE, [Atom], []) of + {ok, Pid} -> Pid; + {error, Reason} -> error(Reason) + end. + +-spec deref(Pid) -> Value + when Pid :: pid(), + Value :: term(). +deref(Pid) -> + gen_server:call(Pid, deref). + +-spec reset(Pid, Value) -> ok + when Pid :: pid(), + Value :: term(). +reset(Pid, Value) -> + gen_server:call(Pid, {reset, Value}). + +%% +%% gen_server callbacks +%% + +init([]) -> + init([nil]); +init([Value]) -> + {ok, #state{atom=Value}}. + +handle_call(deref, _From, State) -> + {reply, State#state.atom, State}; +handle_call({reset, Value}, _From, _State) -> + {reply, Value, #state{atom=Value}}; +handle_call(terminate, _From, State) -> + {stop, normal, ok, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(Msg, State) -> + error_logger:info_msg("unexpected message: ~p~n", [Msg]), + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. diff --git a/impls/erlang/src/core.erl b/impls/erlang/src/core.erl new file mode 100644 index 0000000000..c074248ab2 --- /dev/null +++ b/impls/erlang/src/core.erl @@ -0,0 +1,403 @@ +%%% +%%% Core functions +%%% + +-module(core). +-compile(export_all). + +nil_p([Arg]) -> + Arg == nil; +nil_p(_) -> + {error, "nil? takes a single argument"}. + +true_p([Arg]) -> + Arg == true; +true_p(_) -> + {error, "true? takes a single argument"}. + +false_p([Arg]) -> + Arg == false; +false_p(_) -> + {error, "false? takes a single argument"}. + +number_p([{integer, _}]) -> + true; +number_p([_]) -> + false; +number_p(_) -> + {error, "number? takes a single argument"}. + +fn_p([{function, _, _}]) -> + true; +fn_p([{closure, _, _, _, _, _}]) -> + true; +fn_p([_]) -> + false; +fn_p(_) -> + {error, "fn? takes a single argument"}. + +macro_p([{macro, _, _, _, _}]) -> + true; +macro_p([_]) -> + false; +macro_p(_) -> + {error, "macro? takes a single argument"}. + +count([{Type, List, _Meta}]) when Type == list orelse Type == vector -> + {integer, length(List)}; +count([nil]) -> + {integer, 0}; +count([_]) -> + {error, "count called on non-sequence"}; +count([]) -> + {error, "count called with no arguments"}; +count(_) -> + {error, "count expects one list argument"}. + +empty_q([{Type, List, _Meta}]) when Type == list orelse Type == vector -> + length(List) == 0; +empty_q([_]) -> + {error, "empty? called on non-sequence"}; +empty_q([]) -> + {error, "empty? called with no arguments"}; +empty_q(_) -> + {error, "empty? expects one list argument"}. + +nth([{Type, List, _Meta}, {integer, Index}]) when Type == list orelse Type == vector -> + try lists:nth(Index+1, List) of + Result -> Result + catch + error:_Error -> + % raise rather than returning an {error} + error("nth: index out of range") + end; +nth([_]) -> + {error, "nth expects two arguments"}. + +first([{Type, [First|_Rest], _Meta}]) when Type == list orelse Type == vector -> + First; +first([{Type, [], _Meta}]) when Type == list orelse Type == vector -> + nil; +first([nil]) -> + nil; +first([_]) -> + {error, "first called on non-sequence"}; +first([]) -> + {error, "first called with no arguments"}; +first(_) -> + {error, "first expects one list argument"}. + +rest([{Type, [_First|Rest], _Meta}]) when Type == list orelse Type == vector -> + {list, Rest, nil}; +rest([{Type, [], _Meta}]) when Type == list orelse Type == vector -> + {list, [], nil}; +rest([nil]) -> + {list, [], nil}; +rest([_]) -> + {error, "rest called on non-sequence"}; +rest([]) -> + {error, "rest called with no arguments"}; +rest(_) -> + {error, "rest expects one list argument"}. + +seq([{list, [], _Meta}]) -> + nil; +seq([{list, List, _Meta}]) -> + {list, List, nil}; +seq([{vector, [], _Meta}]) -> + nil; +seq([{vector, List, _Meta}]) -> + {list, List, nil}; +seq([{string, []}]) -> + nil; +seq([{string, S}]) -> + {list, lists:map(fun(C) -> {string, [C]} end, S), nil}; +seq([nil]) -> + nil; +seq(_) -> + {error, "seq expects one list/vector/string/nil argument"}. + +equal_q(Args) -> + case Args of + [nil, nil] -> true; + [true, true] -> true; + [false, false] -> true; + [{integer, I}, {integer, J}] -> I == J; + [{string, S}, {string, T}] -> S == T; + [{keyword, K}, {keyword, J}] -> K == J; + [{symbol, S}, {symbol, T}] -> S == T; + [{list, L1, _M1}, {list, L2, _M2}] -> equal_seqs(L1, L2); + [{vector, L1, _M1}, {vector, L2, _M2}] -> equal_seqs(L1, L2); + [{list, L1, _M1}, {vector, L2, _M2}] -> equal_seqs(L1, L2); + [{vector, L1, _M1}, {list, L2, _M2}] -> equal_seqs(L1, L2); + [{map, M1, _M1}, {map, M2, _M2}] -> equal_maps(M1, M2); + [_A, _B] -> false; + _ -> {error, "equal? expects two arguments"} + end. + +equal_seqs([], []) -> + true; +equal_seqs([X|Xs], [Y|Ys]) -> + equal_q([X, Y]) andalso equal_seqs(Xs, Ys); +equal_seqs(_, _) -> + false. + +equal_maps(M1, M2) -> + maps:size(M1) == maps:size(M2) andalso equal_maps_for_keys(maps:keys(M1), M1, M2). + +equal_maps_for_keys([], _M1, _M2) -> + true; +equal_maps_for_keys([K|Ks], M1, M2) -> + equal_values_for_key(K, M1, M2) andalso equal_maps_for_keys(Ks, M1, M2). + +equal_values_for_key(K, M1, M2) -> + case [maps:find(K, M1), maps:find(K, M2)] of + [{ok, V1}, {ok, V2}] -> equal_q([V1, V2]); + _ -> false + end. + +int_op(F, [A0,A1]) -> + case A0 of + {integer, I0} -> + case A1 of + {integer, I1} -> + {integer, F(I0, I1)}; + _ -> {error, "second argument must be an integer"} + end; + _ -> {error, "first argument must be an integer"} + end; +int_op(_F, _L) -> + {error, "must have two arguments"}. + +int_add(Args) -> + int_op(fun(I, J) -> I + J end, Args). + +int_sub(Args) -> + int_op(fun(I, J) -> I - J end, Args). + +int_mul(Args) -> + int_op(fun(I, J) -> I * J end, Args). + +int_div(Args) -> + int_op(fun(I, J) -> I div J end, Args). + +bool_op(F, [A0,A1]) -> + case A0 of + {integer, I0} -> + case A1 of + {integer, I1} -> + % the true or false is our return value + F(I0, I1); + _ -> {error, "second argument must be an integer"} + end; + _ -> {error, "first argument must be an integer"} + end; +bool_op(_F, _L) -> + {error, "must have two arguments"}. + +bool_lt(Args) -> + bool_op(fun(I, J) -> I < J end, Args). + +bool_lte(Args) -> + bool_op(fun(I, J) -> I =< J end, Args). + +bool_gt(Args) -> + bool_op(fun(I, J) -> I > J end, Args). + +bool_gte(Args) -> + bool_op(fun(I, J) -> I >= J end, Args). + +pr_str(Args) -> + {string, printer:pr_list(Args, "", "", " ", true)}. + +str(Args) -> + {string, printer:pr_list(Args, "", "", "", false)}. + +prn(Args) -> + io:format("~s~n", [printer:pr_list(Args, "", "", " ", true)]), + nil. + +println(Args) -> + io:format("~s~n", [printer:pr_list(Args, "", "", " ", false)]), + nil. + +read_string([{string, Input}]) -> + case reader:read_str(Input) of + {ok, none} -> nil; + {ok, AST} -> AST; + {error, Reason} -> {error, Reason} + end; +read_string(_) -> + {error, "read-string expects a single string argument"}. + +slurp([{string, Filepath}]) -> + case file:read_file(Filepath) of + {ok, Binary} -> {string, binary_to_list(Binary)}; + {error, Reason} -> {error, Reason} + end; +slurp(_) -> + {error, "slurp called with non-string"}. + +cons([Elem, {Type, List, _Meta}]) when Type == list orelse Type == vector -> + {list, [Elem|List], nil}; +cons([_,_]) -> + {error, "second argument to cons must be a sequence"}; +cons(_) -> + {error, "cons expects two arguments"}. + +conj([{Type, _List, _Meta}]) when Type == list orelse Type == vector -> + {error, "conj expects additional arguments"}; +conj([{list, List, _Meta}|Args]) -> + {list, lists:foldl(fun(Elem, AccIn) -> [Elem|AccIn] end, List, Args), nil}; +conj([{vector, List, _Meta}|Args]) -> + % why is vector backward from list? + {vector, List ++ Args, nil}; +conj(_) -> + {error, "conj expects a list and one or more arguments"}. + +concat(Args) -> + PushAll = fun(Elem, AccIn) -> + case Elem of + {Type, List, _Meta} when Type == list orelse Type == vector -> + AccIn ++ List; + _ -> error("concat called with non-sequence") + end + end, + try lists:foldl(PushAll, [], Args) of + Result -> {list, Result, nil} + catch + error:Reason -> {error, Reason} + end. + +vec([{list, List, _Meta}]) -> {vector, List, nil}; +vec([{vector, List, _Meta}]) -> {vector, List, nil}; +vec([_]) -> {error, "vec: arg type"}; +vec(_) -> {error, "vec: arg count"}. + +mal_throw([Reason]) -> + throw(Reason); +mal_throw(_) -> + {error, "throw expects a list with one argument"}. + +map_f([{closure, Eval, Binds, Body, CE, _M1}, {Type, Args, _M2}]) when Type == list orelse Type == vector -> + Apply = fun(Arg) -> + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, [Arg]), + Eval(Body, NewEnv) + end, + {list, lists:map(Apply, Args), nil}; +map_f([{function, F, _M}, {Type, Args, _Meta}]) when Type == list orelse Type == vector -> + {list, [erlang:apply(F, [[Arg]]) || Arg <- Args], nil}; +map_f(_) -> + {error, "map expects a function and list argument"}. + +flatten_args(Args) -> + % Convert the apply arguments into a flat list, such that no element + % consists of {list,...} or {vector,...} (i.e. just [A, B, C, ...]). + Delist = fun(Elem) -> + case Elem of + {T, L, _M} when T == list orelse T == vector -> L; + _ -> Elem + end + end, + lists:flatten(lists:map(Delist, lists:flatten(Args))). + +apply_f([{closure, Eval, Binds, Body, CE, _M1}|Args]) -> + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, flatten_args(Args)), + Eval(Body, NewEnv); +apply_f([{macro, Eval, Binds, Body, CE}|Args]) -> + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, flatten_args(Args)), + Eval(Body, NewEnv); +apply_f([{function, F, _M}|Args]) -> + erlang:apply(F, [flatten_args(Args)]); +apply_f(_) -> + {error, "apply expects a function followed by arguments"}. + +readline([{string, Prompt}]) -> + case io:get_line(standard_io, Prompt) of + % When user presses Ctrl-d it seems like io:get_line/2 cannot be + % called again, and we seem unable to signal to MAL to terminate, + % so just error out. + eof -> exit(goodbye); + {error, Reason} -> {error, Reason}; + Line -> {string, string:strip(Line, both, $\n)} + end; +readline(_) -> + {error, "readline expects a string argument"}. + +time_ms(_) -> + {Mega, Sec, Micro} = os:timestamp(), + {integer, Mega * 1000000000 + Sec * 1000 + Micro div 1000}. + +ns() -> + Builtins = #{ + "*" => fun int_mul/1, + "+" => fun int_add/1, + "-" => fun int_sub/1, + "/" => fun int_div/1, + "<" => fun bool_lt/1, + "<=" => fun bool_lte/1, + "=" => fun equal_q/1, + ">" => fun bool_gt/1, + ">=" => fun bool_gte/1, + "apply" => fun apply_f/1, + "assoc" => fun types:assoc/1, + "atom" => fun types:atom/1, + "atom?" => fun types:atom_p/1, + "concat" => fun concat/1, + "conj" => fun conj/1, + "cons" => fun cons/1, + "contains?" => fun types:contains_p/1, + "count" => fun count/1, + "deref" => fun types:deref/1, + "dissoc" => fun types:dissoc/1, + "empty?" => fun empty_q/1, + "false?" => fun false_p/1, + "first" => fun first/1, + "fn?" => fun fn_p/1, + "get" => fun types:map_get/1, + "hash-map" => fun types:hash_map/1, + "keys" => fun types:map_keys/1, + "keyword" => fun types:keyword/1, + "keyword?" => fun types:keyword_p/1, + "list" => fun types:list/1, + "list?" => fun types:list_p/1, + "macro?" => fun macro_p/1, + "map" => fun map_f/1, + "map?" => fun types:map_p/1, + "meta" => fun types:meta/1, + "nil?" => fun nil_p/1, + "nth" => fun nth/1, + "number?" => fun number_p/1, + "pr-str" => fun pr_str/1, + "println" => fun println/1, + "prn" => fun prn/1, + "read-string" => fun read_string/1, + "readline" => fun readline/1, + "reset!" => fun types:reset/1, + "rest" => fun rest/1, + "seq" => fun seq/1, + "sequential?" => fun types:sequential_p/1, + "slurp" => fun slurp/1, + "str" => fun str/1, + "string?" => fun types:string_p/1, + "swap!" => fun types:swap/1, + "symbol" => fun types:symbol/1, + "symbol?" => fun types:symbol_p/1, + "throw" => fun mal_throw/1, + "time-ms" => fun time_ms/1, + "true?" => fun true_p/1, + "vals" => fun types:map_values/1, + "vec" => fun vec/1, + "vector" => fun types:vector/1, + "vector?" => fun types:vector_p/1, + "with-meta" => fun types:with_meta/1 + }, + Env = env:new(undefined), + SetEnv = fun(K, V) -> + env:set(Env, {symbol, K}, types:func(V)) + end, + maps:map(SetEnv, Builtins), + Env. diff --git a/impls/erlang/src/env.erl b/impls/erlang/src/env.erl new file mode 100644 index 0000000000..3f4c4d23e4 --- /dev/null +++ b/impls/erlang/src/env.erl @@ -0,0 +1,173 @@ +%%% +%%% Environment +%%% +%%% We need an "object" to represent the environment: something whose state can +%%% change over time, while keeping a single, unchanging reference to that +%%% object. This is done in Erlang using lightweight processes. Fortunately, OTP +%%% makes this easy. +%%% + +-module(env). +-behavior(gen_server). + +-export([new/1, bind/3, find/2, get/2, set/3, root/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). + +-record(state, {outer, data}). + +%% +%% Public API +%% + +-spec new(Outer) -> Pid + when Outer :: #state{}, + Pid :: pid(). +% @doc Pass 'undefined' for Outer if no parent environment. +new(Outer) -> + case gen_server:start(?MODULE, [Outer], []) of + {ok, Pid} -> Pid; + {error, Reason} -> error(Reason) + end. + +-spec bind(Pid, Names, Values) -> ok + when Pid :: pid(), + Names :: [term()], + Values :: [term()]. +bind(Pid, Names, Values) -> + gen_server:call(Pid, {bind, Names, Values}). + +-spec find(Pid1, Key) -> Pid2 + when Pid1 :: pid(), + Key :: {symbol, string()}, + Pid2 :: pid() | nil. +find(Pid, {symbol, Name}) -> + gen_server:call(Pid, {find_pid, Name}). + +-spec get(Pid, Key) -> Value + when Pid :: pid(), + Key :: {symbol, string()}, + Value :: term(). +get(Pid, {symbol, Name}) -> + case gen_server:call(Pid, {get, Name}) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end; +get(_Pid, _Key) -> + error("env:get/2 called with non-symbol key"). + +-spec set(Pid, Key, Value) -> ok + when Pid :: pid(), + Key :: {symbol, string()}, + Value :: term(). +set(Pid, {symbol, Name}, Value) -> + gen_server:call(Pid, {set, Name, Value}); +set(_Env, _Key, _Value) -> + error("env:set/3 called with non-symbol key"). + +-spec root(Pid1) -> Pid2 + when Pid1 :: pid(), + Pid2 :: pid(). +root(Pid) -> + gen_server:call(Pid, root). + +%% +%% gen_server callbacks +%% + +init([]) -> + init([undefined]); +init([Outer]) -> + {ok, #state{outer=Outer, data=#{}}}. + +handle_call({bind, Names, Values}, _From, State) -> + NewEnv = env_bind(State, Names, Values), + {reply, ok, NewEnv}; +handle_call({find_env, Name}, _From, State) -> + {reply, env_find(State, Name), State}; +handle_call({find_pid, Name}, _From, State) -> + {reply, pid_find(State, Name), State}; +handle_call({get, Name}, _From, State) -> + {reply, env_get(State, Name), State}; +handle_call({set, Name, Value}, _From, State) -> + {reply, ok, env_set(State, Name, Value)}; +handle_call(root, _From, State) -> + {reply, env_root(State), State}; +handle_call(terminate, _From, State) -> + {stop, normal, ok, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(Msg, State) -> + error_logger:info_msg("unexpected message: ~p~n", [Msg]), + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% +%% Internal functions +%% + +pid_find(Env, Name) -> + case maps:is_key(Name, Env#state.data) of + true -> self(); + false -> + case Env#state.outer of + undefined -> nil; + Outer -> gen_server:call(Outer, {find_pid, Name}) + end + end. + +env_find(Env, Name) -> + case maps:is_key(Name, Env#state.data) of + true -> Env; + false -> + case Env#state.outer of + undefined -> nil; + Outer -> gen_server:call(Outer, {find_env, Name}) + end + end. + +-spec env_bind(Env1, Names, Values) -> Env2 + when Env1 :: #state{}, + Names :: [term()], + Values :: [term()], + Env2 :: #state{}. +env_bind(Env, [], []) -> + Env; +env_bind(Env, [{symbol, "&"}, {symbol, Name}], Values) -> + env_set(Env, Name, {list, Values, nil}); +env_bind(Env, [{symbol, Name}|Ntail], [Value|Vtail]) -> + env_bind(env_set(Env, Name, Value), Ntail, Vtail). + +-spec env_get(Env, Key) -> {ok, Value} | {error, string()} + when Env :: #state{}, + Key :: {symbol, string()}, + Value :: term(). +env_get(Env, Name) -> + case env_find(Env, Name) of + nil -> {error, io_lib:format("'~s' not found", [Name])}; + E -> {ok, maps:get(Name, E#state.data)} + end. + +-spec env_set(Env1, Key, Value) -> Env2 + when Env1 :: #state{}, + Key :: {symbol, string()}, + Value :: term(), + Env2 :: #state{}. +env_set(Env, Name, Value) -> + Map = maps:put(Name, Value, Env#state.data), + #state{outer=Env#state.outer, data=Map}. + +-spec env_root(Env1) -> Env2 + when Env1 :: #state{}, + Env2 :: #state{}. +env_root(Env) -> + case Env#state.outer of + undefined -> self(); + Outer -> gen_server:call(Outer, root) + end. diff --git a/impls/erlang/src/mal.app.src b/impls/erlang/src/mal.app.src new file mode 100644 index 0000000000..11d54c1878 --- /dev/null +++ b/impls/erlang/src/mal.app.src @@ -0,0 +1,11 @@ +{application, mal, [ + {description, "Make-a-Lisp Erlang"}, + {vsn, "1"}, + {registered, []}, + {applications, [ + kernel, + stdlib + ]}, + {mod, {mal_app, []}}, + {env, []} +]}. diff --git a/impls/erlang/src/printer.erl b/impls/erlang/src/printer.erl new file mode 100644 index 0000000000..a43c397837 --- /dev/null +++ b/impls/erlang/src/printer.erl @@ -0,0 +1,59 @@ +%%% +%%% Printer +%%% + +-module(printer). + +-export([pr_str/2, pr_list/5]). + +-spec pr_str(term(), true|false) -> string(). +pr_str(Value, Readably) -> + case Value of + nil -> "nil"; + true -> "true"; + false -> "false"; + {atom, Atom} -> + AtomStr = pr_str(atom:deref(Atom), Readably), + io_lib:format("(atom ~s)", [AtomStr]); + {integer, Num} -> integer_to_list(Num); + {string, String} when Readably == true -> escape_str(String); + {string, String} when Readably == false -> String; + {keyword, Keyword} -> [$:|Keyword]; + {symbol, Symbol} -> Symbol; + {list, List, _Meta} -> pr_list(List, "(", ")", " ", Readably); + {vector, Vector, _Meta} -> pr_list(Vector, "[", "]", " ", Readably); + {map, Map, _Meta} -> pr_map(Map, Readably); + {closure, _Eval, Binds, Body, _Env, _Meta} -> + BindsStr = pr_str({list, Binds, nil}, Readably), + BodyStr = pr_str(Body, Readably), + io_lib:format("(fn* ~s ~s)", [BindsStr, BodyStr]); + {function, _Func, _Meta} -> "#"; + {macro, _Eval, _Binds, _Body, _Env} -> "#"; + {error, Reason} -> io_lib:format("error: ~s", [Reason]) + end. + +-spec pr_list([term()], string(), string(), string(), boolean()) -> string(). +pr_list(Seq, Start, End, Join, Readably) -> + Print = fun(Elem) -> + pr_str(Elem, Readably) + end, + L = string:join(lists:map(Print, Seq), Join), + Start ++ L ++ End. + +pr_map(Map, Readably) -> + AppendKV = fun({Key, Value}, AccIn) -> + AccIn ++ [Key, Value] + end, + Elements = lists:foldl(AppendKV, [], maps:to_list(Map)), + pr_list(Elements, "{", "}", " ", Readably). + +escape_str(String) -> + Escape = fun(C, AccIn) -> + case C of + $" -> [C, $\\|AccIn]; + $\\ -> [C, $\\|AccIn]; + $\n -> [$n, $\\|AccIn]; + _ -> [C|AccIn] + end + end, + "\"" ++ lists:reverse(lists:foldl(Escape, [], String)) ++ "\"". diff --git a/impls/erlang/src/reader.erl b/impls/erlang/src/reader.erl new file mode 100644 index 0000000000..97c7b41700 --- /dev/null +++ b/impls/erlang/src/reader.erl @@ -0,0 +1,263 @@ +%%% +%%% Reader +%%% + +-module(reader). + +-export([read_str/1, list_to_map/1]). + +-record(reader, { + tokens=[], % the input tokens remaining + tree % the subtree parsed by a read_* function +}). + +-spec read_str(string()) -> {ok, term()} | {error, term()}. +read_str(Input) -> + case tokenize(Input) of + {ok, []} -> {ok, none}; + {ok, Tokens} -> + case read_form(#reader{tokens=Tokens}) of + % extract the final result of parsing + {ok, Reader} -> {ok, Reader#reader.tree}; + {error, Reason} -> {error, Reason} + end; + {error, Reason} -> {error, Reason} + end. + +-spec read_form(#reader{}) -> {ok, #reader{}} | {error, term()}. +read_form(Reader) -> + Token = peek(Reader), + case Token of + close_list -> {error, "unexected ')'"}; + close_vector -> {error, "unexected ']'"}; + close_map -> {error, "unexected '}'"}; + open_list -> read_list(Reader); + open_vector -> read_vector(Reader); + open_map -> read_map(Reader); + quote -> read_quoted(Reader, Token); + quasiquote -> read_quoted(Reader, Token); + unquote -> read_quoted(Reader, Token); + 'splice-unquote' -> read_quoted(Reader, Token); + deref -> read_quoted(Reader, Token); + 'with-meta' -> read_meta(Reader); + _ -> read_atom(Reader) + end. + +read_list(Reader) -> + read_seq(Reader, $), open_list, close_list, list). + +read_vector(Reader) -> + % Erlang has no array/vector type, so just use list + read_seq(Reader, $], open_vector, close_vector, vector). + +read_map(Reader) -> + case read_seq(Reader, $}, open_map, close_map, map) of + {ok, Reader1} -> + {map, Map, Meta} = Reader1#reader.tree, + case list_to_map(Map) of + {error, Reason} -> {error, Reason}; + NewMap -> + Tokens = Reader1#reader.tokens, + {ok, #reader{tokens=Tokens, tree={map, NewMap, Meta}}} + end; + {error, Reason} -> {error, Reason} + end. + +read_seq(Reader, CloseChar, OpenDelim, CloseDelim, Type) -> + {First, Reader1} = next(Reader), + case First of + OpenDelim -> + case read_seq_tail(Reader1, CloseChar, CloseDelim, []) of + {ok, Reader2} -> + % prepend our type tag to the result + Result = {Type, Reader2#reader.tree, nil}, + Reader3 = #reader{tokens=Reader2#reader.tokens, tree=Result}, + {ok, Reader3}; + {error, Reason} -> {error, Reason} + end; + Bogey -> {error, io_lib:format("error in read_seq, expected ~p but got ~p", + [OpenDelim, Bogey])} + end. + +read_seq_tail(Reader, CloseChar, CloseDelim, AccIn) -> + Token = peek(Reader), + case Token of + [] -> {error, io_lib:format("expected '~c', got EOF", [CloseChar])}; + CloseDelim -> + {_Token, Reader1} = next(Reader), + Reader2 = #reader{tokens=Reader1#reader.tokens, tree=lists:reverse(AccIn)}, + {ok, Reader2}; + _ -> + case read_form(Reader) of + {ok, Reader3} -> + read_seq_tail(Reader3, CloseChar, CloseDelim, [Reader3#reader.tree|AccIn]); + {error, Reason} -> {error, Reason} + end + end. + +% Convert a list of key/value pairs into a map. The elements are not +% tuples; the keys are the odd numbered members, and the values are the +% even numbered members. Fails if list has an odd number of members. +list_to_map(L) -> + list_to_map(L, #{}). + +list_to_map([], AccIn) -> + AccIn; +list_to_map([_H], _AccIn) -> + {error, "odd number of hash-map keys/values"}; +list_to_map([K,V|T], AccIn) -> + list_to_map(T, maps:put(K, V, AccIn)). + +% Convert syntactic sugar into normalized form (e.g. ` => (quasiquote)). +read_quoted(Reader, Token) -> + % discard the quoted token + {_T, Reader1} = next(Reader), + case read_form(Reader1) of + {ok, Reader2} -> + Result = {list, [{symbol, atom_to_list(Token)}, Reader2#reader.tree], nil}, + {ok, #reader{tokens=Reader2#reader.tokens, tree=Result}}; + {error, Reason} -> {error, Reason} + end. + +read_meta(Reader) -> + % discard the meta token + {_T, Reader1} = next(Reader), + case read_form(Reader1) of + {ok, Reader2} -> + M = Reader2#reader.tree, + case read_form(Reader2) of + {ok, Reader3} -> + X = Reader3#reader.tree, + Result = {list, [{symbol, "with-meta"}, X, M], nil}, + {ok, #reader{tokens=Reader3#reader.tokens, tree=Result}}; + {error, Reason} -> {error, Reason} + end; + {error, Reason} -> {error, Reason} + end. + +read_atom(Reader) -> + {Token, Reader1} = next(Reader), + Result = case Token of + {integer, Value} -> {integer, list_to_integer(Value)}; + {string, _String} -> Token; + {keyword, _Keyword} -> Token; + {symbol, Symbol} -> + case Symbol of + "true" -> true; + "false" -> false; + "nil" -> nil; + _ -> Token + end + end, + {ok, #reader{tokens=Reader1#reader.tokens, tree=Result}}. + +peek(Reader) -> + case Reader#reader.tokens of + [] -> []; + [H|_T] -> H + end. + +next(Reader) -> + [H|NewTokens] = Reader#reader.tokens, + {H, #reader{tokens=NewTokens}}. + +-spec tokenize(string()) -> {ok, [term()]} | {error, term()}. +tokenize(Input) -> + tokenize(Input, []). + +-spec tokenize(string(), [term()]) -> {ok, [term()]} | {error, term()}. +tokenize(Input, Tokens) -> + case lex_single(Input) of + eof -> {ok, lists:reverse(Tokens)}; + {error, Reason} -> {error, Reason}; + {ignored, Rest} -> tokenize(Rest, Tokens); + {Token, Rest} -> tokenize(Rest, [Token|Tokens]) + end. + +lex_single([]) -> + eof; +lex_single([Char|Rest]) -> + case Char of + $( -> {open_list, Rest}; + $) -> {close_list, Rest}; + $[ -> {open_vector, Rest}; + $] -> {close_vector, Rest}; + ${ -> {open_map, Rest}; + $} -> {close_map, Rest}; + $" -> lex_string(Rest, []); + $; -> lex_comment(Rest); + $: -> lex_symbol(Rest, keyword); + $' -> {quote, Rest}; + $` -> {quasiquote, Rest}; + $~ -> lex_unquote(Rest); + $@ -> {deref, Rest}; + $^ -> {'with-meta', Rest}; + N when N >= $0, N =< $9 -> lex_number(Rest, [Char]); + S when S == $- -> lex_minus_word(Char, Rest); + S when S == 32; S == $,; S == $\r; S == $\n; S == $\t -> lex_spaces(Rest); + $\\ -> {error, io_lib:format("bare escape literal ~c~c", [Char, hd(Rest)])}; + $. -> {error, "bare dot (.) not supported"}; + _ -> lex_symbol([Char|Rest], symbol) + end. + +lex_comment([]) -> + {ignored, []}; +lex_comment([C|Rest]) when C == $\r; C == $\n -> + {ignored, Rest}; +lex_comment([_C|Rest]) -> + lex_comment(Rest). + +lex_spaces([C|Rest]) when C == 32; C == $,; C == $\r; C == $\n; C == $\t -> + lex_spaces(Rest); +lex_spaces(Rest) -> + {ignored, Rest}. + +lex_string([], _String) -> + {error, "expected '\"', got EOF"}; +lex_string([$\\,Escaped|Rest], String) -> + % unescape the string while building it + case Escaped of + [] -> {error, "end of string reached in escape"}; + $n -> lex_string(Rest, [$\n|String]); + _ -> lex_string(Rest, [Escaped|String]) + end; +lex_string([$"|Rest], String) -> + {{string, lists:reverse(String)}, Rest}; +lex_string([C|Rest], String) -> + lex_string(Rest, [C|String]). + +lex_number([N|Rest], Number) when N >= $0, N =< $9 -> + lex_number(Rest, [N|Number]); +lex_number(Rest, Number) -> + {{integer, lists:reverse(Number)}, Rest}. + +lex_minus_word(Minus, [N|Rest]) when N >= $0, N =< $9 -> + lex_number([N|Rest], [Minus]); +lex_minus_word(Minus, Rest) -> + lex_symbol([Minus|Rest], symbol). + +% Lex the remainder of either a keyword or a symbol. The Type is used as +% the tag for the returned tuple (e.g. the atoms keyword or symbol). +lex_symbol(Input, Type) -> + IsSymbol = fun(C) -> + is_letter(C) orelse is_digit(C) orelse is_symbol(C) + end, + Symbol = lists:takewhile(IsSymbol, Input), + case Symbol of + [] -> {error, io_lib:format("invalid symbol: ~10s", [Input])}; + _ -> {{Type, Symbol}, lists:sublist(Input, length(Symbol) + 1, length(Input))} + end. + +is_digit(C) -> + C >= $0 andalso C =< $9. + +is_letter(C) -> + C >= $a andalso C =< $z orelse C >= $A andalso C =< $Z. + +is_symbol(C) -> + lists:member(C, "!#$%&*+-/:<=>?@^_|\~"). + +lex_unquote([$@|Rest]) -> + {'splice-unquote', Rest}; +lex_unquote(Rest) -> + {unquote, Rest}. diff --git a/impls/erlang/src/step0_repl.erl b/impls/erlang/src/step0_repl.erl new file mode 100644 index 0000000000..54644cf924 --- /dev/null +++ b/impls/erlang/src/step0_repl.erl @@ -0,0 +1,30 @@ +%%% +%%% Step 0: REPL +%%% + +-module(step0_repl). + +-export([main/1]). + +main(_) -> + case io:get_line(standard_io, "user> ") of + eof -> + % break out of the loop + io:format("~n"), + ok; + {error, Reason} -> + io:format("Error reading input: ~p~n", [Reason]), + exit(ioerr); + Line -> + io:format("~s~n", [print(eval(read(string:strip(Line, both, $\n))))]), + main("") + end. + +read(String) -> + String. + +eval(String) -> + String. + +print(String) -> + String. diff --git a/impls/erlang/src/step1_read_print.erl b/impls/erlang/src/step1_read_print.erl new file mode 100644 index 0000000000..4d8c398ae8 --- /dev/null +++ b/impls/erlang/src/step1_read_print.erl @@ -0,0 +1,36 @@ +%%% +%%% Step 1: read/print +%%% + +-module(step1_read_print). + +-export([main/1]). + +main(_) -> + case io:get_line(standard_io, "user> ") of + eof -> + % break out of the loop + io:format("~n"), + ok; + {error, Reason} -> + io:format("Error reading input: ~s~n", [Reason]), + exit(ioerr); + Line -> + print(eval(read(string:strip(Line, both, $\n)))), + main("") + end. + +read(String) -> + case reader:read_str(String) of + {ok, Value} -> Value; + {error, Reason} -> io:format("error: ~s~n", [Reason]), nil + end. + +eval(Value) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [printer:pr_str(Value, true)]). diff --git a/impls/erlang/src/step2_eval.erl b/impls/erlang/src/step2_eval.erl new file mode 100644 index 0000000000..f51c925b2c --- /dev/null +++ b/impls/erlang/src/step2_eval.erl @@ -0,0 +1,70 @@ +%%% +%%% Step 2: eval +%%% + +-module(step2_eval). + +-export([main/1]). + +main(_) -> + Env = #{ + "+" => fun core:int_add/1, + "-" => fun core:int_sub/1, + "*" => fun core:int_mul/1, + "/" => fun core:int_div/1 + }, + loop(Env). + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> + % break out of the loop + io:format("~n"), + ok; + {error, Reason} -> + io:format("Error reading input: ~s~n", [Reason]), + exit(ioerr); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + AST = read(Input), + try eval(AST, Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true) + end. + +read(String) -> + case reader:read_str(String) of + {ok, Value} -> Value; + {error, Reason} -> io:format("error: ~s~n", [Reason]), nil + end. + +eval({list, [], _Meta}=AST, _Env) -> + AST; +eval({list, List, _Meta}, Env) -> + case lists:map(fun(Elem) -> eval(Elem, Env) end, List) of + [F|Args] -> erlang:apply(F, [Args]); + _ -> {error, "expected a list"} + end; +eval({symbol, Sym}, Env) -> + case maps:is_key(Sym, Env) of + true -> maps:get(Sym, Env); + false -> error(io_lib:format("'~s' not found", [Sym])) + end; +eval({vector, V, Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, V), Meta}; +eval({map, M, Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), Meta}; +eval(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). diff --git a/impls/erlang/src/step3_env.erl b/impls/erlang/src/step3_env.erl new file mode 100644 index 0000000000..1a01fa85ec --- /dev/null +++ b/impls/erlang/src/step3_env.erl @@ -0,0 +1,113 @@ +%%% +%%% Step 3: env +%%% + +-module(step3_env). + +-export([main/1]). + +main(_) -> + loop(core:ns()). + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + env:set(Env, {symbol, A1}, Result), + Result; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + % (let* (p (+ 2 3) q (+ 2 p)) (+ p q)) + % ;=>12 + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). diff --git a/impls/erlang/src/step4_if_fn_do.erl b/impls/erlang/src/step4_if_fn_do.erl new file mode 100644 index 0000000000..dc19319592 --- /dev/null +++ b/impls/erlang/src/step4_if_fn_do.erl @@ -0,0 +1,142 @@ +%%% +%%% Step 4: if, fn, do +%%% + +-module(step4_if_fn_do). + +-export([main/1]). + +main(_) -> + Env = core:ns(), + % define the not function using mal itself + eval(read("(def! not (fn* (a) (if a false true)))"), Env), + loop(Env). + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + env:set(Env, {symbol, A1}, Result), + Result; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), + eval(lists:last(Args), Env); +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> + case eval(Test, Env) of + Cond when Cond == false orelse Cond == nil -> + case Alternate of + [] -> nil; + [A] -> eval(A, Env); + _ -> error("if takes 2 or 3 arguments") + end; + _ -> eval(Consequent, Env) + end; +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> + error("if requires test and consequent"); +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> + error("fn* requires 2 arguments"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + % The args may be a single element or a list, so always make it + % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, lists:flatten([A])), + eval(Body, NewEnv); + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). diff --git a/impls/erlang/src/step5_tco.erl b/impls/erlang/src/step5_tco.erl new file mode 100644 index 0000000000..462628880d --- /dev/null +++ b/impls/erlang/src/step5_tco.erl @@ -0,0 +1,142 @@ +%%% +%%% Step 5: Tail call optimization +%%% + +-module(step5_tco). + +-export([main/1]). + +main(_) -> + Env = core:ns(), + % define the not function using mal itself + eval(read("(def! not (fn* (a) (if a false true)))"), Env), + loop(Env). + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + env:set(Env, {symbol, A1}, Result), + Result; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), + eval(lists:last(Args), Env); +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> + case eval(Test, Env) of + Cond when Cond == false orelse Cond == nil -> + case Alternate of + [] -> nil; + [A] -> eval(A, Env); + _ -> error("if takes 2 or 3 arguments") + end; + _ -> eval(Consequent, Env) + end; +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> + error("if requires test and consequent"); +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> + error("fn* requires 2 arguments"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + % The args may be a single element or a list, so always make it + % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, lists:flatten([A])), + eval(Body, NewEnv); + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). diff --git a/impls/erlang/src/step6_file.erl b/impls/erlang/src/step6_file.erl new file mode 100644 index 0000000000..94bc24c328 --- /dev/null +++ b/impls/erlang/src/step6_file.erl @@ -0,0 +1,158 @@ +%%% +%%% Step 6: File and evil +%%% + +-module(step6_file). + +-export([main/1]). + +main([File|Args]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), + rep("(load-file \"" ++ File ++ "\")", Env); +main([]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), + loop(Env). + +init() -> + Env = core:ns(), + % define the load-file and not functions using mal itself + eval(read("(def! not (fn* (a) (if a false true)))"), Env), + eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), + Env. + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + env:set(Env, {symbol, A1}, Result), + Result; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), + eval(lists:last(Args), Env); +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> + case eval(Test, Env) of + Cond when Cond == false orelse Cond == nil -> + case Alternate of + [] -> nil; + [A] -> eval(A, Env); + _ -> error("if takes 2 or 3 arguments") + end; + _ -> eval(Consequent, Env) + end; +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> + error("if requires test and consequent"); +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> + error("fn* requires 2 arguments"); +eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> + % Must use the root environment so the variables set within the parsed + % expression will be visible within the repl. + eval(eval(AST, Env), env:root(Env)); +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> + error("eval requires 1 argument"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + % The args may be a single element or a list, so always make it + % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, lists:flatten([A])), + eval(Body, NewEnv); + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). diff --git a/impls/erlang/src/step7_quote.erl b/impls/erlang/src/step7_quote.erl new file mode 100644 index 0000000000..82664c33b8 --- /dev/null +++ b/impls/erlang/src/step7_quote.erl @@ -0,0 +1,188 @@ +%%% +%%% Step 7: Quoting +%%% + +-module(step7_quote). + +-export([main/1]). + +main([File|Args]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), + rep("(load-file \"" ++ File ++ "\")", Env); +main([]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), + loop(Env). + +init() -> + Env = core:ns(), + % define the load-file and not functions using mal itself + eval(read("(def! not (fn* (a) (if a false true)))"), Env), + eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), + Env. + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + env:set(Env, {symbol, A1}, Result), + Result; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), + eval(lists:last(Args), Env); +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> + case eval(Test, Env) of + Cond when Cond == false orelse Cond == nil -> + case Alternate of + [] -> nil; + [A] -> eval(A, Env); + _ -> error("if takes 2 or 3 arguments") + end; + _ -> eval(Consequent, Env) + end; +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> + error("if requires test and consequent"); +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> + error("fn* requires 2 arguments"); +eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> + % Must use the root environment so the variables set within the parsed + % expression will be visible within the repl. + eval(eval(AST, Env), env:root(Env)); +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> + error("eval requires 1 argument"); +eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> + AST; +eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> + error("quote requires 1 argument"); +eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> + eval(quasiquote(AST), Env); +eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> + error("quasiquote requires 1 argument"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + % The args may be a single element or a list, so always make it + % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, lists:flatten([A])), + eval(Body, NewEnv); + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). + +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> + {error, "splice-unquote requires an argument"}; +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. diff --git a/impls/erlang/src/step8_macros.erl b/impls/erlang/src/step8_macros.erl new file mode 100644 index 0000000000..36cf6c4641 --- /dev/null +++ b/impls/erlang/src/step8_macros.erl @@ -0,0 +1,210 @@ +%%% +%%% Step 8: Macros +%%% + +-module(step8_macros). + +-export([main/1]). + +main([File|Args]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), + rep("(load-file \"" ++ File ++ "\")", Env); +main([]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), + loop(Env). + +init() -> + Env = core:ns(), + eval(read("(def! not (fn* (a) (if a false true)))"), Env), + eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), + eval(read("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), Env), + Env. + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + case Result of + {error, _R1} -> Result; + _ -> + env:set(Env, {symbol, A1}, Result), + Result + end; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), + eval(lists:last(Args), Env); +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> + case eval(Test, Env) of + Cond when Cond == false orelse Cond == nil -> + case Alternate of + [] -> nil; + [A] -> eval(A, Env); + _ -> error("if takes 2 or 3 arguments") + end; + _ -> eval(Consequent, Env) + end; +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> + error("if requires test and consequent"); +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> + error("fn* requires 2 arguments"); +eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> + % Must use the root environment so the variables set within the parsed + % expression will be visible within the repl. + eval(eval(AST, Env), env:root(Env)); +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> + error("eval requires 1 argument"); +eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> + AST; +eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> + error("quote requires 1 argument"); +eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> + eval(quasiquote(AST), Env); +eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> + error("quasiquote requires 1 argument"); +eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) -> + case eval(A2, Env) of + {closure, _Eval, Binds, Body, CE, _M1} -> + Result = {macro, fun eval/2, Binds, Body, CE}, + env:set(Env, {symbol, A1}, Result), + Result; + Result -> env:set(Env, {symbol, A1}, Result), Result + end, + Result; +eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> + error("defmacro! called with non-symbol"); +eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> + error("defmacro! requires exactly two arguments"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + % The args may be a single element or a list, so always make it + % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, lists:flatten([A])), + eval(Body, NewEnv); + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, _Eval, Binds, Body, ME} -> + NewEnv = env:new(ME), + env:bind(NewEnv, Binds, lists:flatten([Args])), + NewAst = eval(Body, NewEnv), + eval(NewAst, Env); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). + +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> + {error, "splice-unquote requires an argument"}; +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. diff --git a/impls/erlang/src/step9_try.erl b/impls/erlang/src/step9_try.erl new file mode 100644 index 0000000000..66c7d28c35 --- /dev/null +++ b/impls/erlang/src/step9_try.erl @@ -0,0 +1,228 @@ +%%% +%%% Step 9: Try +%%% + +-module(step9_try). + +-export([main/1]). + +main([File|Args]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), + rep("(load-file \"" ++ File ++ "\")", Env); +main([]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), + loop(Env). + +init() -> + Env = core:ns(), + eval(read("(def! not (fn* (a) (if a false true)))"), Env), + eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), + eval(read("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), Env), + Env. + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true); + throw:Reason -> printer:pr_str({error, printer:pr_str(Reason, true)}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + case Result of + {error, _R1} -> Result; + _ -> + env:set(Env, {symbol, A1}, Result), + Result + end; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), + eval(lists:last(Args), Env); +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> + case eval(Test, Env) of + Cond when Cond == false orelse Cond == nil -> + case Alternate of + [] -> nil; + [A] -> eval(A, Env); + _ -> error("if takes 2 or 3 arguments") + end; + _ -> eval(Consequent, Env) + end; +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> + error("if requires test and consequent"); +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> + error("fn* requires 2 arguments"); +eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> + % Must use the root environment so the variables set within the parsed + % expression will be visible within the repl. + eval(eval(AST, Env), env:root(Env)); +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> + error("eval requires 1 argument"); +eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> + AST; +eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> + error("quote requires 1 argument"); +eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> + eval(quasiquote(AST), Env); +eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> + error("quasiquote requires 1 argument"); +eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) -> + case eval(A2, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + Result = {macro, fun eval/2, Binds, Body, CE}, + env:set(Env, {symbol, A1}, Result), + Result; + Result -> env:set(Env, {symbol, A1}, Result), Result + end, + Result; +eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> + error("defmacro! called with non-symbol"); +eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> + error("defmacro! requires exactly two arguments"); +eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) -> + try eval(A, Env) of + Result -> Result + catch + error:Reason -> + NewEnv = env:new(Env), + env:bind(NewEnv, [B], [{string, Reason}]), + eval(C, NewEnv); + throw:Reason -> + NewEnv = env:new(Env), + env:bind(NewEnv, [B], [Reason]), + eval(C, NewEnv) + end; +eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) -> + eval(AST, Env); +eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) -> + error("try*/catch* must be of the form (try* A (catch* B C))"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + % The args may be a single element or a list, so always make it + % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, lists:flatten([A])), + eval(Body, NewEnv); + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, _Eval, Binds, Body, ME} -> + NewEnv = env:new(ME), + env:bind(NewEnv, Binds, lists:flatten([Args])), + NewAst = eval(Body, NewEnv), + eval(NewAst, Env); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). + +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> + {error, "splice-unquote requires an argument"}; +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. diff --git a/impls/erlang/src/stepA_mal.erl b/impls/erlang/src/stepA_mal.erl new file mode 100644 index 0000000000..a05427540e --- /dev/null +++ b/impls/erlang/src/stepA_mal.erl @@ -0,0 +1,230 @@ +%%% +%%% Step A: Mutation, Self-hosting and Interop +%%% + +-module(stepA_mal). + +-export([main/1]). + +main([File|Args]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), + rep("(load-file \"" ++ File ++ "\")", Env); +main([]) -> + Env = init(), + env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), + eval(read("(println (str \"Mal [\" *host-language* \"]\"))"), Env), + loop(Env). + +init() -> + Env = core:ns(), + eval(read("(def! *host-language* \"Erlang\")"), Env), + eval(read("(def! not (fn* (a) (if a false true)))"), Env), + eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), + eval(read("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), Env), + Env. + +loop(Env) -> + case io:get_line(standard_io, "user> ") of + eof -> io:format("~n"); + {error, Reason} -> exit(Reason); + Line -> + print(rep(string:strip(Line, both, $\n), Env)), + loop(Env) + end. + +rep(Input, Env) -> + try eval(read(Input), Env) of + none -> none; + Result -> printer:pr_str(Result, true) + catch + error:Reason -> printer:pr_str({error, Reason}, true); + throw:Reason -> printer:pr_str({error, printer:pr_str(Reason, true)}, true) + end. + +read(Input) -> + case reader:read_str(Input) of + {ok, Value} -> Value; + {error, Reason} -> error(Reason) + end. + +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> + AST; +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> + Result = eval(A2, Env), + case Result of + {error, _R1} -> Result; + _ -> + env:set(Env, {symbol, A1}, Result), + Result + end; +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> + error("def! called with non-symbol"); +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> + error("def! requires exactly two arguments"); +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> + NewEnv = env:new(Env), + let_star(NewEnv, A1), + eval(A2, NewEnv); +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> + error("let* requires exactly two arguments"); +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), + eval(lists:last(Args), Env); +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> + case eval(Test, Env) of + Cond when Cond == false orelse Cond == nil -> + case Alternate of + [] -> nil; + [A] -> eval(A, Env); + _ -> error("if takes 2 or 3 arguments") + end; + _ -> eval(Consequent, Env) + end; +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> + error("if requires test and consequent"); +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> + error("fn* requires 2 arguments"); +eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> + % Must use the root environment so the variables set within the parsed + % expression will be visible within the repl. + eval(eval(AST, Env), env:root(Env)); +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> + error("eval requires 1 argument"); +eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> + AST; +eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> + error("quote requires 1 argument"); +eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> + eval(quasiquote(AST), Env); +eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> + error("quasiquote requires 1 argument"); +eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) -> + case eval(A2, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + Result = {macro, fun eval/2, Binds, Body, CE}, + env:set(Env, {symbol, A1}, Result), + Result; + Result -> env:set(Env, {symbol, A1}, Result), Result + end, + Result; +eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> + error("defmacro! called with non-symbol"); +eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> + error("defmacro! requires exactly two arguments"); +eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) -> + try eval(A, Env) of + Result -> Result + catch + error:Reason -> + NewEnv = env:new(Env), + env:bind(NewEnv, [B], [{string, Reason}]), + eval(C, NewEnv); + throw:Reason -> + NewEnv = env:new(Env), + env:bind(NewEnv, [B], [Reason]), + eval(C, NewEnv) + end; +eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) -> + eval(AST, Env); +eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) -> + error("try*/catch* must be of the form (try* A (catch* B C))"); +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> + % The args may be a single element or a list, so always make it + % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + NewEnv = env:new(CE), + env:bind(NewEnv, Binds, lists:flatten([A])), + eval(Body, NewEnv); + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, _Eval, Binds, Body, ME} -> + NewEnv = env:new(ME), + env:bind(NewEnv, Binds, lists:flatten([Args])), + NewAst = eval(Body, NewEnv), + eval(NewAst, Env); + {error, Reason} -> {error, Reason} + end. + +eval_ast({symbol, _Sym}=Value, Env) -> + env:get(Env, Value); +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({map, M, _Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; +eval_ast(Value, _Env) -> + Value. + +print(none) -> + % if nothing meaningful was entered, print nothing at all + ok; +print(Value) -> + io:format("~s~n", [Value]). + +let_star(Env, Bindings) -> + Bind = fun({Name, Expr}) -> + case Name of + {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); + _ -> error("let* with non-symbol binding") + end + end, + case Bindings of + {Type, Binds, _Meta} when Type == list orelse Type == vector -> + case list_to_proplist(Binds) of + {error, Reason} -> error(Reason); + Props -> lists:foreach(Bind, Props) + end; + _ -> error("let* with non-list bindings") + end. + +list_to_proplist(L) -> + list_to_proplist(L, []). + +list_to_proplist([], AccIn) -> + lists:reverse(AccIn); +list_to_proplist([_H], _AccIn) -> + {error, "mismatch in let* name/value bindings"}; +list_to_proplist([K,V|T], AccIn) -> + list_to_proplist(T, [{K, V}|AccIn]). + +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> + {error, "splice-unquote requires an argument"}; +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. diff --git a/impls/erlang/src/types.erl b/impls/erlang/src/types.erl new file mode 100644 index 0000000000..0dcc902076 --- /dev/null +++ b/impls/erlang/src/types.erl @@ -0,0 +1,163 @@ +%%% +%%% Types and their functions +%%% + +-module(types). +-compile(export_all). + +list(Args) -> + {list, Args, nil}. + +list_p([Args]) -> + case Args of + {list, _L, _M} -> true; + _ -> false + end; +list_p([]) -> + {error, "list? called with no arguments"}; +list_p(_) -> + {error, "list? expects one list argument"}. + +func(Func) -> + {function, Func, nil}. + +symbol_p([{symbol, _S}]) -> + true; +symbol_p([_A]) -> + false; +symbol_p(_) -> + {error, "symbol? takes a single argument"}. + +symbol([{string, Name}]) -> + {symbol, Name}; +symbol(_) -> + {error, "symbol expects a single string argument"}. + +string_p([{string, _S}]) -> + true; +string_p([_A]) -> + false; +string_p(_) -> + {error, "string? takes a single argument"}. + +keyword_p([{keyword, _K}]) -> + true; +keyword_p([_A]) -> + false; +keyword_p(_) -> + {error, "keyword? takes a single argument"}. + +keyword([{string, Name}]) -> {keyword, Name}; +keyword([{keyword, Name}]) -> {keyword, Name}; +keyword([_]) -> {error, "keyword: expectst a keyword or string."}; +keyword(_) -> {error, "keyword: takes a single argument."}. + +vector_p([{vector, _V, _Meta}]) -> + true; +vector_p([_]) -> + false; +vector_p(_) -> + {error, "vector? takes a single argument"}. + +vector(Args) -> + {vector, Args, nil}. + +hash_map(Args) -> + {map, reader:list_to_map(Args), nil}. + +map_p([{map, _M, _Meta}]) -> + true; +map_p([_]) -> + false; +map_p(_) -> + {error, "map? takes a single argument"}. + +assoc([{map, Map, Meta}|Args]) -> + case reader:list_to_map(Args) of + {error, Reason} -> {error, Reason}; + Addend -> {map, maps:merge(Map, Addend), Meta} + end; +assoc(_) -> + {error, "assoc expects a map argument followed by pairs"}. + +dissoc([{map, Map, Meta}|Keys]) -> + {map, lists:foldl(fun(Key, AccIn) -> maps:remove(Key, AccIn) end, Map, Keys), Meta}; +dissoc(_) -> + {error, "dissoc expects a map argument followed by keys"}. + +map_get([{map, Map, _Meta}, Key]) -> + maps:get(Key, Map, nil); +map_get([_Thing1, _Thing2]) -> + nil; +map_get(_) -> + {error, "get expects a map argument followed by key"}. + +contains_p([{map, Map, _Meta}, Key]) -> + maps:is_key(Key, Map); +contains_p(_) -> + {error, "contains? expects a map argument followed by key"}. + +map_keys([{map, Map, _Meta}]) -> + {list, maps:keys(Map), nil}; +map_keys(_) -> + {error, "keys expects a map argument"}. + +map_values([{map, Map, _Meta}]) -> + {list, maps:values(Map), nil}; +map_values(_) -> + {error, "vals expects a map argument"}. + +sequential_p([{Type, _L, _M}]) when Type == list orelse Type == vector -> + true; +sequential_p([_]) -> + false; +sequential_p(_) -> + {error, "sequential? expects a single argument"}. + +atom([Atom]) -> + {atom, atom:new(Atom)}; +atom(_) -> + {error, "atom expects a single argument"}. + +atom_p([{atom, _A}]) -> + true; +atom_p([_]) -> + false; +atom_p(_) -> + {error, "atom? expects a single argument"}. + +deref([{atom, Atom}]) -> + atom:deref(Atom); +deref(_) -> + {error, "deref expects a single atom argument"}. + +reset([{atom, Atom}, Value]) -> + atom:reset(Atom, Value); +reset(_) -> + {error, "reset expects an atom and a value"}. + +swap([{atom, Atom}, {closure, Eval, Binds, Body, Env, _MC}|Args]) -> + NewEnv = env:new(Env), + Values = [atom:deref(Atom) | Args], + env:bind(NewEnv, Binds, Values), + atom:reset(Atom, Eval(Body, NewEnv)); +swap([{atom, Atom}, {function, F, _MF}|Args]) -> + atom:reset(Atom, erlang:apply(F, [[atom:deref(Atom) | Args]])); +swap(_) -> + {error, "atom expects an atom, function, and optional arguments"}. + +meta([{T, _List, Meta}]) when T == list orelse T == vector orelse T == map -> + Meta; +meta([{closure, _Eval, _Binds, _Body, _Env, Meta}]) -> + Meta; +meta([{function, _Func, Meta}]) -> + Meta; +meta(_) -> + {error, "meta expects a single collection or function argument"}. + +with_meta([{T, Seq, _M}, Meta]) when T == list orelse T == vector orelse T == map -> + {T, Seq, Meta}; +with_meta([{closure, Eval, Binds, Body, Env, _M}, Meta]) -> + {closure, Eval, Binds, Body, Env, Meta}; +with_meta([{function, Func, _Meta}, Meta]) -> + {function, Func, Meta}. diff --git a/impls/erlang/tests/step5_tco.mal b/impls/erlang/tests/step5_tco.mal new file mode 100644 index 0000000000..54b616b446 --- /dev/null +++ b/impls/erlang/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Erlang: skipping non-TCO recursion +;; Reason: Erlang has TCO, test always completes. diff --git a/impls/es6/Dockerfile b/impls/es6/Dockerfile new file mode 100644 index 0000000000..c189a1ac3f --- /dev/null +++ b/impls/es6/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm + +ENV NPM_CONFIG_CACHE /mal/.npm diff --git a/impls/es6/Makefile b/impls/es6/Makefile new file mode 100644 index 0000000000..15ffe6aa49 --- /dev/null +++ b/impls/es6/Makefile @@ -0,0 +1,29 @@ +SOURCES_BASE = node_readline.js types.mjs reader.mjs printer.mjs +SOURCES_LISP = env.mjs core.mjs stepA_mal.mjs +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +STEPS = step0_repl.mjs step1_read_print.mjs step2_eval.mjs step3_env.mjs \ + step4_if_fn_do.mjs step5_tco.mjs step6_file.mjs \ + step7_quote.mjs step8_macros.mjs step9_try.mjs stepA_mal.mjs + +all: node_modules + +dist: mal.js mal + +node_modules: + npm install + +$(STEPS): node_modules + +mal.js: $(SOURCES) + cat $+ | sed 's/^export //' | grep -v "^import " >> $@ + +mal: mal.js + echo "#!/usr/bin/env node" > $@ + cat $< >> $@ + chmod +x $@ + + +clean: + rm -f mal.js mal + rm -rf node_modules diff --git a/impls/es6/core.mjs b/impls/es6/core.mjs new file mode 100644 index 0000000000..aed5156f03 --- /dev/null +++ b/impls/es6/core.mjs @@ -0,0 +1,113 @@ +import { _equal_Q, _clone, _keyword, _keyword_Q } from './types.mjs' +import { _list_Q, Vector, _assoc_BANG, Atom } from './types.mjs' +import { pr_str } from './printer.mjs' +import rl from './node_readline.mjs' +const readline = rl.readline +import { read_str } from './reader.mjs' +import { readFileSync } from 'fs' + +function _error(e) { throw new Error(e) } + +// String functions +function slurp(f) { + if (typeof process !== 'undefined') { + return readFileSync(f, 'utf-8') + } else { + var req = new XMLHttpRequest() + req.open('GET', f, false) + req.send() + if (req.status !== 200) { + _error(`Failed to slurp file: ${f}`) + } + return req.responseText + } +} + +// Sequence functions +function seq(obj) { + if (_list_Q(obj)) { + return obj.length > 0 ? obj : null + } else if (obj instanceof Vector) { + return obj.length > 0 ? Array.from(obj.slice(0)) : null + } else if (typeof obj === "string" && !_keyword_Q(obj)) { + return obj.length > 0 ? obj.split('') : null + } else if (obj === null) { + return null + } else { + _error('seq: called on non-sequence') + } +} + +// core_ns is namespace of type functions +export const core_ns = new Map([ + ['=', _equal_Q], + ['throw', a => { throw a }], + + ['nil?', a => a === null], + ['true?', a => a === true], + ['false?', a => a === false], + ['number?', a => typeof a === 'number'], + ['string?', a => typeof a === "string" && !_keyword_Q(a)], + ['symbol', a => Symbol.for(a)], + ['symbol?', a => typeof a === 'symbol'], + ['keyword', _keyword], + ['keyword?', _keyword_Q], + ['fn?', a => typeof a === 'function' && !a.ismacro ], + ['macro?', a => typeof a === 'function' && !!a.ismacro ], + + ['pr-str', (...a) => a.map(e => pr_str(e,1)).join(' ')], + ['str', (...a) => a.map(e => pr_str(e,0)).join('')], + ['prn', (...a) => console.log(...a.map(e => pr_str(e,1))) || null], + ['println', (...a) => console.log(...a.map(e => pr_str(e,0))) || null], + ['read-string', read_str], + ['readline', readline], + ['slurp', slurp], + + ['<' , (a,b) => a' , (a,b) => a>b], + ['>=', (a,b) => a>=b], + ['+' , (a,b) => a+b], + ['-' , (a,b) => a-b], + ['*' , (a,b) => a*b], + ['/' , (a,b) => a/b], + ["time-ms", () => new Date().getTime()], + + ['list', (...a) => a], + ['list?', _list_Q], + ['vector', (...a) => Vector.from(a)], + ['vector?', a => a instanceof Vector], + ['hash-map', (...a) => _assoc_BANG(new Map(), ...a)], + ['map?', a => a instanceof Map], + ['assoc', (m,...a) => _assoc_BANG(_clone(m), ...a)], + ['dissoc', (m,...a) => { let n = _clone(m); a.forEach(k => n.delete(k)); + return n}], + ['get', (m,a) => m === null ? null : m.has(a) ? m.get(a) : null], + ['contains?', (m,a) => m.has(a)], + ['keys', a => Array.from(a.keys())], + ['vals', a => Array.from(a.values())], + + ['sequential?', a => Array.isArray(a)], + ['cons', (a,b) => [a].concat(b)], + ['concat', (...a) => a.reduce((x,y) => x.concat(y), [])], + ['vec', (a) => Vector.from(a)], + ['nth', (a,b) => b < a.length ? a[b] : _error('nth: index out of range')], + ['first', a => a !== null && a.length > 0 ? a[0] : null], + ['rest', a => a === null ? [] : Array.from(a.slice(1))], + ['empty?', a => a.length === 0], + ['count', a => a === null ? 0 : a.length], + ['apply', (f,...a) => f(...a.slice(0, -1).concat(a[a.length-1]))], + ['map', (f,a) => Array.from(a.map(x => f(x)))], + + ['conj', (s,...a) => _list_Q(s) ? a.reverse().concat(s) + : Vector.from(s.concat(a))], + ['seq', seq], + + ['meta', a => 'meta' in a ? a['meta'] : null], + ['with-meta', (a,b) => { let c = _clone(a); c.meta = b; return c }], + ['atom', a => new Atom(a)], + ['atom?', a => a instanceof Atom], + ['deref', atm => atm.val], + ['reset!', (atm,a) => atm.val = a], + ['swap!', (atm,f,...args) => atm.val = f(...[atm.val].concat(args))] + ]) diff --git a/impls/es6/env.mjs b/impls/es6/env.mjs new file mode 100644 index 0000000000..f0321286be --- /dev/null +++ b/impls/es6/env.mjs @@ -0,0 +1,17 @@ +export function new_env(outer={}, binds=[], exprs=[]) { + var e = Object.setPrototypeOf({}, outer) + // Bind symbols in binds to values in exprs + for (var i=0; i { + if (sym in env) { return env[sym] } + throw Error(`'${Symbol.keyFor(sym)}' not found`) +} +export const env_set = (env, sym, val) => env[sym] = val diff --git a/impls/es6/node_readline.mjs b/impls/es6/node_readline.mjs new file mode 100644 index 0000000000..5eb3808f0c --- /dev/null +++ b/impls/es6/node_readline.mjs @@ -0,0 +1,46 @@ +// IMPORTANT: choose one +const RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL +//const RL_LIB = "libedit.so.2"; + +import path from 'path'; +import fs from 'fs'; +const koffiCjs = await import('koffi'); +const koffi = koffiCjs.default || koffiCjs; + +const HISTORY_FILE = path.join(process.env.HOME, '.mal-history'); +const rllib = koffi.load(RL_LIB); +const readlineFunc = rllib.func('char *readline(char *)'); +const addHistoryFunc = rllib.func('int add_history(char *)'); + +var rl_history_loaded = false; + +function readline(prompt) { + prompt = prompt || "user> "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i pr_str(e,_r)).join(' ') + ")" + } else if (obj instanceof Vector) { + return "[" + obj.map(e => pr_str(e,_r)).join(' ') + "]" + } else if (obj instanceof Map) { + var ret = [] + for (let [k,v] of obj) { + ret.push(pr_str(k,_r), pr_str(v,_r)) + } + return "{" + ret.join(' ') + "}" + } else if (typeof obj === "string") { + if (_keyword_Q(obj)) { + return ':' + obj.slice(1) + } else if (_r) { + return '"' + obj.replace(/\\/g, "\\\\") + .replace(/"/g, '\\"') + .replace(/\n/g, "\\n") + '"' + } else { + return obj + } + } else if (typeof obj === 'symbol') { + return Symbol.keyFor(obj) + } else if (obj === null) { + return "nil" + } else if (obj instanceof Atom) { + return "(atom " + pr_str(obj.val,_r) + ")" + } else { + return obj.toString() + } +} diff --git a/impls/es6/reader.mjs b/impls/es6/reader.mjs new file mode 100644 index 0000000000..284b8fd1ac --- /dev/null +++ b/impls/es6/reader.mjs @@ -0,0 +1,120 @@ +import { _keyword, _assoc_BANG, Vector } from './types.mjs'; + +export class BlankException extends Error {} + +class Reader { + constructor(tokens) { + this.tokens = tokens + this.position = 0 + } + next() { return this.tokens[this.position++] } + peek() { return this.tokens[this.position] } +} + +function tokenize(str) { + const re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g + let match = null + let results = [] + while ((match = re.exec(str)[1]) != '') { + if (match[0] === ';') { continue } + results.push(match) + } + return results +} + +function read_atom (reader) { + const token = reader.next() + //console.log("read_atom:", token) + if (token.match(/^-?[0-9]+$/)) { + return parseInt(token,10) // integer + } else if (token.match(/^-?[0-9][0-9.]*$/)) { + return parseFloat(token,10) // float + } else if (token.match(/^"(?:\\.|[^\\"])*"$/)) { + return token.slice(1,token.length-1) + .replace(/\\(.)/g, (_, c) => c === "n" ? "\n" : c) + } else if (token[0] === "\"") { + throw new Error("expected '\"', got EOF"); + } else if (token[0] === ":") { + return _keyword(token.slice(1)) + } else if (token === "nil") { + return null + } else if (token === "true") { + return true + } else if (token === "false") { + return false + } else { + return Symbol.for(token) // symbol + } +} + +// read list of tokens +function read_list(reader, start, end) { + start = start || '(' + end = end || ')' + var ast = [] + var token = reader.next() + if (token !== start) { + throw new Error("expected '" + start + "'") + } + while ((token = reader.peek()) !== end) { + if (!token) { + throw new Error("expected '" + end + "', got EOF") + } + ast.push(read_form(reader)) + } + reader.next() + return ast +} + +// read vector of tokens +function read_vector(reader) { + return Vector.from(read_list(reader, '[', ']')); +} + +// read hash-map key/value pairs +function read_hash_map(reader) { + return _assoc_BANG(new Map(), ...read_list(reader, '{', '}')) +} + +function read_form(reader) { + var token = reader.peek() + switch (token) { + // reader macros/transforms + case ';': return null // Ignore comments + case '\'': reader.next() + return [Symbol.for('quote'), read_form(reader)] + case '`': reader.next() + return [Symbol.for('quasiquote'), read_form(reader)] + case '~': reader.next() + return [Symbol.for('unquote'), read_form(reader)] + case '~@': reader.next() + return [Symbol.for('splice-unquote'), read_form(reader)] + case '^': reader.next() + var meta = read_form(reader) + return [Symbol.for('with-meta'), read_form(reader), meta] + case '@': reader.next() + return [Symbol.for('deref'), read_form(reader)] + + // list + case ')': throw new Error("unexpected ')'") + case '(': return read_list(reader) + + // vector + case ']': throw new Error("unexpected ']'") + case '[': return read_vector(reader) + + // hash-map + case '}': throw new Error("unexpected '}'") + case '{': return read_hash_map(reader) + + // atom + default: return read_atom(reader) + } +} + +export function read_str(str) { + var tokens = tokenize(str) + if (tokens.length === 0) { throw new BlankException() } + return read_form(new Reader(tokens)) +} + diff --git a/impls/es6/run b/impls/es6/run new file mode 100755 index 0000000000..54e8932d5c --- /dev/null +++ b/impls/es6/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec node $(dirname $0)/${STEP:-stepA_mal}.mjs "${@}" diff --git a/impls/es6/step0_repl.mjs b/impls/es6/step0_repl.mjs new file mode 100644 index 0000000000..67080af1ac --- /dev/null +++ b/impls/es6/step0_repl.mjs @@ -0,0 +1,20 @@ +import rl from './node_readline.mjs' +const readline = rl.readline + +// read +const READ = str => str + +// eval +const EVAL = (ast, env) => ast + +// print +const PRINT = exp => exp + +// repl +const REP = str => PRINT(EVAL(READ(str), {})) + +while (true) { + let line = readline('user> ') + if (line == null) break + if (line) { console.log(REP(line)) } +} diff --git a/impls/es6/step1_read_print.mjs b/impls/es6/step1_read_print.mjs new file mode 100644 index 0000000000..5b1eaee693 --- /dev/null +++ b/impls/es6/step1_read_print.mjs @@ -0,0 +1,28 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' + +// read +const READ = str => read_str(str) + +// eval +const EVAL = (ast, env) => ast + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +const REP = str => PRINT(EVAL(READ(str), {})) + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step2_eval.mjs b/impls/es6/step2_eval.mjs new file mode 100644 index 0000000000..ea44e6cfbd --- /dev/null +++ b/impls/es6/step2_eval.mjs @@ -0,0 +1,56 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _list_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' + +// read +const READ = str => read_str(str) + +// eval +const EVAL = (ast, env) => { + // console.log('EVAL:', pr_str(ast, true)) + + if (typeof ast === 'symbol') { + if (ast in env) { + return env[ast] + } else { + throw Error(`'${Symbol.keyFor(ast)}' not found`) + } + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [f, ...args] =ast.map(x => EVAL(x, env)) + return f(...args) +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +var repl_env = {[Symbol.for('+')]: (a,b) => a+b, + [Symbol.for('-')]: (a,b) => a-b, + [Symbol.for('*')]: (a,b) => a*b, + [Symbol.for('/')]: (a,b) => a/b} +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step3_env.mjs b/impls/es6/step3_env.mjs new file mode 100644 index 0000000000..a9c0e60118 --- /dev/null +++ b/impls/es6/step3_env.mjs @@ -0,0 +1,73 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _list_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' + +// read +const READ = str => read_str(str) + +// eval +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + return EVAL(a2, let_env) + default: + const [f, ...args] = ast.map(x => EVAL(x, env)) + return f(...args) + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +env_set(repl_env, Symbol.for('+'), (a,b) => a+b) +env_set(repl_env, Symbol.for('-'), (a,b) => a-b) +env_set(repl_env, Symbol.for('*'), (a,b) => a*b) +env_set(repl_env, Symbol.for('/'), (a,b) => a/b) +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step4_if_fn_do.mjs b/impls/es6/step4_if_fn_do.mjs new file mode 100644 index 0000000000..d5d99da177 --- /dev/null +++ b/impls/es6/step4_if_fn_do.mjs @@ -0,0 +1,87 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _list_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' +import { core_ns } from './core.mjs' + +// read +const READ = str => read_str(str) + +// eval +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + return EVAL(a2, let_env) + case 'do': + return ast.slice(1).map(x => EVAL(x, env))[ast.length-2] + case 'if': + let cond = EVAL(a1, env) + if (cond === null || cond === false) { + return typeof a3 !== 'undefined' ? EVAL(a3, env) : null + } else { + return EVAL(a2, env) + } + case 'fn*': + return (...args) => EVAL(a2, new_env(env, a1, args)) + default: + const [f, ...args] = ast.map(x => EVAL(x, env)) + return f(...args) + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +// core.EXT: defined using ES6 +for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } + +// core.mal: defined using language itself +REP('(def! not (fn* (a) (if a false true)))') + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step5_tco.mjs b/impls/es6/step5_tco.mjs new file mode 100644 index 0000000000..d19c9ba225 --- /dev/null +++ b/impls/es6/step5_tco.mjs @@ -0,0 +1,101 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' +import { core_ns } from './core.mjs' + +// read +const READ = str => read_str(str) + +// eval +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + while (true) { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + env = let_env + ast = a2 + break // continue TCO loop + case 'do': + ast.slice(1, -1).map(x => EVAL(x, env)) + ast = ast[ast.length-1] + break // continue TCO loop + case 'if': + let cond = EVAL(a1, env) + if (cond === null || cond === false) { + ast = (typeof a3 !== 'undefined') ? a3 : null + } else { + ast = a2 + } + break // continue TCO loop + case 'fn*': + return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), + a2, env, a1) + default: + const [f, ...args] = ast.map(x => EVAL(x, env)) + if (_malfunc_Q(f)) { + env = new_env(f.env, f.params, args) + ast = f.ast + break // continue TCO loop + } else { + return f(...args) + } + } + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +// core.EXT: defined using ES6 +for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } + +// core.mal: defined using language itself +REP('(def! not (fn* (a) (if a false true)))') + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step6_file.mjs b/impls/es6/step6_file.mjs new file mode 100644 index 0000000000..9ee05259de --- /dev/null +++ b/impls/es6/step6_file.mjs @@ -0,0 +1,111 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' +import { core_ns } from './core.mjs' + +// read +const READ = str => read_str(str) + +// eval +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + while (true) { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + env = let_env + ast = a2 + break // continue TCO loop + case 'do': + ast.slice(1, -1).map(x => EVAL(x, env)) + ast = ast[ast.length-1] + break // continue TCO loop + case 'if': + let cond = EVAL(a1, env) + if (cond === null || cond === false) { + ast = (typeof a3 !== 'undefined') ? a3 : null + } else { + ast = a2 + } + break // continue TCO loop + case 'fn*': + return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), + a2, env, a1) + default: + const [f, ...args] = ast.map(x => EVAL(x, env)) + if (_malfunc_Q(f)) { + env = new_env(f.env, f.params, args) + ast = f.ast + break // continue TCO loop + } else { + return f(...args) + } + } + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +// core.EXT: defined using ES6 +for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } +env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) +env_set(repl_env, Symbol.for('*ARGV*'), []) + +// core.mal: defined using language itself +REP('(def! not (fn* (a) (if a false true)))') +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + +if (process.argv.length > 2) { + env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) + REP(`(load-file "${process.argv[2]}")`) + process.exit(0) +} + + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step7_quote.mjs b/impls/es6/step7_quote.mjs new file mode 100644 index 0000000000..03600c5426 --- /dev/null +++ b/impls/es6/step7_quote.mjs @@ -0,0 +1,140 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' +import { core_ns } from './core.mjs' + +// read +const READ = str => read_str(str) + +// eval +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] + } else { + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast + } +} + +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + while (true) { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + env = let_env + ast = a2 + break // continue TCO loop + case 'quote': + return a1 + case 'quasiquote': + ast = quasiquote(a1) + break // continue TCO loop + case 'do': + ast.slice(1, -1).map(x => EVAL(x, env)) + ast = ast[ast.length-1] + break // continue TCO loop + case 'if': + let cond = EVAL(a1, env) + if (cond === null || cond === false) { + ast = (typeof a3 !== 'undefined') ? a3 : null + } else { + ast = a2 + } + break // continue TCO loop + case 'fn*': + return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), + a2, env, a1) + default: + const [f, ...args] = ast.map(x => EVAL(x, env)) + if (_malfunc_Q(f)) { + env = new_env(f.env, f.params, args) + ast = f.ast + break // continue TCO loop + } else { + return f(...args) + } + } + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +// core.EXT: defined using ES6 +for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } +env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) +env_set(repl_env, Symbol.for('*ARGV*'), []) + +// core.mal: defined using language itself +REP('(def! not (fn* (a) (if a false true)))') +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + +if (process.argv.length > 2) { + env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) + REP(`(load-file "${process.argv[2]}")`) + process.exit(0) +} + + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step8_macros.mjs b/impls/es6/step8_macros.mjs new file mode 100644 index 0000000000..a8220a9aff --- /dev/null +++ b/impls/es6/step8_macros.mjs @@ -0,0 +1,150 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' +import { core_ns } from './core.mjs' + +// read +const READ = str => read_str(str) + +// eval +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] + } else { + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast + } +} + +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + while (true) { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + env = let_env + ast = a2 + break // continue TCO loop + case 'quote': + return a1 + case 'quasiquote': + ast = quasiquote(a1) + break // continue TCO loop + case 'defmacro!': + let func = _clone(EVAL(a2, env)) + func.ismacro = true + return env_set(env, a1, func) + case 'do': + ast.slice(1, -1).map(x => EVAL(x, env)) + ast = ast[ast.length-1] + break // continue TCO loop + case 'if': + let cond = EVAL(a1, env) + if (cond === null || cond === false) { + ast = (typeof a3 !== 'undefined') ? a3 : null + } else { + ast = a2 + } + break // continue TCO loop + case 'fn*': + return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), + a2, env, a1) + default: + const f = EVAL(a0, env) + if (f.ismacro) { + ast = f(...ast.slice(1)) + break // continue TCO loop + } + const args = ast.slice(1).map(x => EVAL(x, env)) + if (_malfunc_Q(f)) { + env = new_env(f.env, f.params, args) + ast = f.ast + break // continue TCO loop + } else { + return f(...args) + } + } + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +// core.EXT: defined using ES6 +for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } +env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) +env_set(repl_env, Symbol.for('*ARGV*'), []) + +// core.mal: defined using language itself +REP('(def! not (fn* (a) (if a false true)))') +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))') + +if (process.argv.length > 2) { + env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) + REP(`(load-file "${process.argv[2]}")`) + process.exit(0) +} + + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${exc}`) } + } +} diff --git a/impls/es6/step9_try.mjs b/impls/es6/step9_try.mjs new file mode 100644 index 0000000000..8ea2ae4222 --- /dev/null +++ b/impls/es6/step9_try.mjs @@ -0,0 +1,161 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' +import { core_ns } from './core.mjs' + +// read +const READ = str => read_str(str) + +// eval +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] + } else { + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast + } +} + +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + while (true) { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + env = let_env + ast = a2 + break // continue TCO loop + case 'quote': + return a1 + case 'quasiquote': + ast = quasiquote(a1) + break // continue TCO loop + case 'defmacro!': + let func = _clone(EVAL(a2, env)) + func.ismacro = true + return env_set(env, a1, func) + case 'try*': + try { + return EVAL(a1, env) + } catch (exc) { + if (a2 && a2[0] === Symbol.for('catch*')) { + if (exc instanceof Error) { exc = exc.message } + return EVAL(a2[2], new_env(env, [a2[1]], [exc])) + } else { + throw exc + } + } + case 'do': + ast.slice(1, -1).map(x => EVAL(x, env)) + ast = ast[ast.length-1] + break // continue TCO loop + case 'if': + let cond = EVAL(a1, env) + if (cond === null || cond === false) { + ast = (typeof a3 !== 'undefined') ? a3 : null + } else { + ast = a2 + } + break // continue TCO loop + case 'fn*': + return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), + a2, env, a1) + default: + const f = EVAL(a0, env) + if (f.ismacro) { + ast = f(...ast.slice(1)) + break // continue TCO loop + } + const args = ast.slice(1).map(x => EVAL(x, env)) + if (_malfunc_Q(f)) { + env = new_env(f.env, f.params, args) + ast = f.ast + break // continue TCO loop + } else { + return f(...args) + } + } + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +// core.EXT: defined using ES6 +for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } +env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) +env_set(repl_env, Symbol.for('*ARGV*'), []) + +// core.mal: defined using language itself +REP('(def! not (fn* (a) (if a false true)))') +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))') + +if (process.argv.length > 2) { + env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) + REP(`(load-file "${process.argv[2]}")`) + process.exit(0) +} + + +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${pr_str(exc, true)}`) } + } +} diff --git a/impls/es6/stepA_mal.mjs b/impls/es6/stepA_mal.mjs new file mode 100644 index 0000000000..58ed476f56 --- /dev/null +++ b/impls/es6/stepA_mal.mjs @@ -0,0 +1,162 @@ +import rl from './node_readline.mjs' +const readline = rl.readline +import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' +import { BlankException, read_str } from './reader.mjs' +import { pr_str } from './printer.mjs' +import { new_env, env_set, env_get } from './env.mjs' +import { core_ns } from './core.mjs' + +// read +const READ = str => read_str(str) + +// eval +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] + } else { + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast + } +} + +const dbgevalsym = Symbol.for("DEBUG-EVAL") + +const EVAL = (ast, env) => { + while (true) { + if (dbgevalsym in env) { + const dbgeval = env_get(env, dbgevalsym) + if (dbgeval !== null && dbgeval !== false) { + console.log('EVAL:', pr_str(ast, true)) + } + } + + if (typeof ast === 'symbol') { + return env_get(env, ast) + } else if (ast instanceof Vector) { + return ast.map(x => EVAL(x, env)) + } else if (ast instanceof Map) { + let new_hm = new Map() + ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) + return new_hm + } else if (!_list_Q(ast)) { + return ast + } + + if (ast.length === 0) { return ast } + + const [a0, a1, a2, a3] = ast + switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { + case 'def!': + return env_set(env, a1, EVAL(a2, env)) + case 'let*': + let let_env = new_env(env) + for (let i=0; i < a1.length; i+=2) { + env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) + } + env = let_env + ast = a2 + break // continue TCO loop + case 'quote': + return a1 + case 'quasiquote': + ast = quasiquote(a1) + break // continue TCO loop + case 'defmacro!': + let func = _clone(EVAL(a2, env)) + func.ismacro = true + return env_set(env, a1, func) + case 'try*': + try { + return EVAL(a1, env) + } catch (exc) { + if (a2 && a2[0] === Symbol.for('catch*')) { + if (exc instanceof Error) { exc = exc.message } + return EVAL(a2[2], new_env(env, [a2[1]], [exc])) + } else { + throw exc + } + } + case 'do': + ast.slice(1, -1).map(x => EVAL(x, env)) + ast = ast[ast.length-1] + break // continue TCO loop + case 'if': + let cond = EVAL(a1, env) + if (cond === null || cond === false) { + ast = (typeof a3 !== 'undefined') ? a3 : null + } else { + ast = a2 + } + break // continue TCO loop + case 'fn*': + return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), + a2, env, a1) + default: + const f = EVAL(a0, env) + if (f.ismacro) { + ast = f(...ast.slice(1)) + break // continue TCO loop + } + const args = ast.slice(1).map(x => EVAL(x, env)) + if (_malfunc_Q(f)) { + env = new_env(f.env, f.params, args) + ast = f.ast + break // continue TCO loop + } else { + return f(...args) + } + } + } +} + +// print +const PRINT = exp => pr_str(exp, true) + +// repl +let repl_env = new_env() +const REP = str => PRINT(EVAL(READ(str), repl_env)) + +// core.EXT: defined using ES6 +for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } +env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) +env_set(repl_env, Symbol.for('*ARGV*'), []) + +// core.mal: defined using language itself +REP('(def! *host-language* "ecmascript6")') +REP('(def! not (fn* (a) (if a false true)))') +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))') + +if (process.argv.length > 2) { + env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) + REP(`(load-file "${process.argv[2]}")`) + process.exit(0) +} + +REP('(println (str "Mal [" *host-language* "]"))') +while (true) { + let line = readline('user> ') + if (line == null) break + try { + if (line) { console.log(REP(line)) } + } catch (exc) { + if (exc instanceof BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn(`Error: ${pr_str(exc, true)}`) } + } +} diff --git a/impls/es6/tests/step5_tco.mal b/impls/es6/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/es6/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/es6/types.mjs b/impls/es6/types.mjs new file mode 100644 index 0000000000..d6198b6dce --- /dev/null +++ b/impls/es6/types.mjs @@ -0,0 +1,68 @@ +// General functions +export function _equal_Q (a, b) { + if (Array.isArray(a) && Array.isArray(b)) { + if (a.length !== b.length) { return false } + for (let i=0; i obj.apply(f, a) // new function instance + new_obj = Object.assign(f, obj) // copy original properties + } else { + throw Error('Unsupported type for clone') + } + if (typeof new_meta !== 'undefined') { new_obj.meta = new_meta } + return new_obj +} + +// Functions +export function _malfunc(f, ast, env, params, meta=null, ismacro=false) { + return Object.assign(f, {ast, env, params, meta, ismacro}) +} +export const _malfunc_Q = f => f.ast ? true : false + + +// Keywords +export const _keyword = obj => _keyword_Q(obj) ? obj : '\u029e' + obj +export const _keyword_Q = obj => typeof obj === 'string' && obj[0] === '\u029e' + +// Lists +export const _list_Q = obj => Array.isArray(obj) && !(obj instanceof Vector) + +// Vectors +export class Vector extends Array { } + +// Maps +export function _assoc_BANG(hm, ...args) { + if (args.length % 2 === 1) { + throw new Error('Odd number of assoc arguments') + } + for (let i=0; i + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install ca-certificates curl libgtkglext1-dev libreadline-dev + +RUN curl https://downloads.factorcode.org/releases/0.98/factor-linux-x86-64-0.98.tar.gz | tar -xzC/opt +ENV PATH /opt/factor:$PATH + +# Allow /mal/factor to create the $HOME/.cache directory. +ENV HOME /mal diff --git a/impls/factor/Makefile b/impls/factor/Makefile new file mode 100644 index 0000000000..e4cabeff1d --- /dev/null +++ b/impls/factor/Makefile @@ -0,0 +1,31 @@ +SOURCES_BASE = lib/types/types.factor lib/reader/reader.factor lib/printer/printer.factor +SOURCES_LISP = lib/env/env.factor lib/core/core.factor stepA_mal/stepA_mal.factor +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.factor mal + +# dependency order (env must come before types) +ORDERED_SOURCES = $(filter %env.factor,$(SOURCES)) $(filter-out %env.factor,$(SOURCES)) +mal.factor: $(ORDERED_SOURCES) + cat $+ | sed '/^USING:/,/;/ s/ *lib.[a-z]*//g' > $@ + +mal: mal.factor + echo '#!/usr/bin/env factor' > $@ + cat $< >> $@ + chmod +x $@ + +# TODO: standalone compiled app +#mal.factor: $(SOURCES) +# mkdir -p dist_tmp; \ +# FDIR=$$(dirname $$(readlink -f $$(which factor))); \ +# for f in $${FDIR}/*; do ln -sf $$f dist_tmp/; done; \ +# rm dist_tmp/factor; \ +# cp $${FDIR}/factor dist_tmp/factor; \ +# HOME=/mal FACTOR_ROOTS=. dist_tmp/factor dist.factor +# #cat $+ | sed 's///' >> $@ + +clean: + rm -f mal.factor diff --git a/impls/factor/lib/core/core-tests.factor b/impls/factor/lib/core/core-tests.factor new file mode 100644 index 0000000000..0e603c1faf --- /dev/null +++ b/impls/factor/lib/core/core-tests.factor @@ -0,0 +1,8 @@ +USING: assocs effects kernel sequences stack-checker tools.test ; +IN: lib.core + +{ t } [ + ns values [ + infer ( x -- * ) ( x -- x ) [ effect= ] bi-curry@ bi or + ] all? +] unit-test diff --git a/impls/factor/lib/core/core.factor b/impls/factor/lib/core/core.factor new file mode 100644 index 0000000000..1c0cf6671a --- /dev/null +++ b/impls/factor/lib/core/core.factor @@ -0,0 +1,86 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators +combinators.short-circuit fry grouping hash-sets hashtables io +io.encodings.utf8 io.files kernel lists lib.env lib.printer +lib.reader lib.types math namespaces quotations readline sequences sets +strings system vectors ; +IN: lib.core + +SYMBOL: mal-apply + +: pr-str-stack ( exprs readably? glue -- str ) + [ '[ _ (pr-str) ] map ] dip join ; + +CONSTANT: empty-env T{ malenv f f H{ } } + +CONSTANT: ns H{ + { "+" [ first2 + ] } + { "-" [ first2 - ] } + { "*" [ first2 * ] } + { "/" [ first2 / ] } + { "list" [ >array ] } + { "list?" [ first array? ] } + { "empty?" [ first empty? ] } + { "count" [ first dup nil? [ drop 0 ] [ length ] if ] } + { "=" [ first2 mal= ] } + { "<" [ first2 < ] } + { ">" [ first2 > ] } + { ">=" [ first2 >= ] } + { "<=" [ first2 <= ] } + { "pr-str" [ t " " pr-str-stack ] } + { "str" [ f "" pr-str-stack ] } + { "prn" [ t " " pr-str-stack print flush nil ] } + { "println" [ f " " pr-str-stack print flush nil ] } + { "read-string" [ first read-str ] } + { "slurp" [ first utf8 file-contents ] } + { "cons" [ first2 swap prefix { } like ] } + { "concat" [ concat { } like ] } + { "vec" [ first >vector ] } + { "nth" [ first2 swap nth ] } + { "first" [ first dup nil? [ drop nil ] [ [ nil ] [ first ] if-empty ] if ] } + { "rest" [ first dup nil? [ drop { } ] [ [ { } ] [ rest { } like ] if-empty ] if ] } + { "throw" [ first throw ] } + { "apply" [ unclip [ unclip-last append ] dip mal-apply get call( args fn -- maltype ) ] } + { "map" [ first2 swap '[ 1array _ mal-apply get call( args fn -- maltype ) ] map { } like ] } + { "nil?" [ first nil? ] } + { "true?" [ first t = ] } + { "false?" [ first f = ] } + { "symbol" [ first ] } + { "symbol?" [ first malsymbol? ] } + { "string?" [ first string? ] } + { "keyword" [ first dup string? [ ] when ] } + { "keyword?" [ first malkeyword? ] } + { "number?" [ first number? ] } + { "fn?" [ first { [ callable? ] [ { [ malfn? ] [ macro?>> not ] } 1&& ] } 1|| ] } + { "macro?" [ first { [ malfn? ] [ macro?>> ] } 1&& ] } + { "vector" [ >vector ] } + { "vector?" [ first vector? ] } + { "hash-map" [ 2 group parse-hashtable ] } + { "map?" [ first hashtable? ] } + { "assoc" [ unclip swap 2 group parse-hashtable assoc-union ] } + { "dissoc" [ unclip swap >hash-set '[ drop _ in? not ] assoc-filter ] } + { "get" [ first2 swap dup nil? [ nip ] [ ?at [ drop nil ] unless ] if ] } + { "contains?" [ first2 swap dup nil? [ nip ] [ at* nip ] if ] } + { "keys" [ first keys ] } + { "vals" [ first values ] } + { "sequential?" [ first { [ vector? ] [ array? ] } 1|| ] } + { "readline" [ first readline ] } + { "meta" [ first dup malfn? [ meta>> ] [ drop f ] if [ nil ] unless* ] } + { "with-meta" [ first2 over malfn? [ [ clone ] dip >>meta ] [ drop ] if ] } + { "atom" [ first ] } + { "atom?" [ first malatom? ] } + { "deref" [ first val>> ] } + { "reset!" [ first2 >>val val>> ] } + { "swap!" [ { [ first ] [ second ] [ 2 tail ] [ first val>> ] } cleave + prefix swap mal-apply get call( args fn -- maltype ) >>val val>> ] } + { "conj" [ unclip swap over array? [ reverse prepend ] [ append ] if ] } + { "seq" [ first { + { [ dup nil? ] [ drop nil ] } + { [ dup empty? ] [ drop nil ] } + { [ dup array? ] [ ] } + { [ dup vector? ] [ >array ] } + { [ dup string? ] [ [ 1string ] { } map-as ] } + } cond ] } + { "time-ms" [ drop nano-count 1,000,000 /i ] } +} diff --git a/impls/factor/lib/env/env-tests.factor b/impls/factor/lib/env/env-tests.factor new file mode 100644 index 0000000000..937c98ae82 --- /dev/null +++ b/impls/factor/lib/env/env-tests.factor @@ -0,0 +1,32 @@ +USING: assocs kernel lib.types tools.test ; +IN: lib.env + +{ "1" } [ + T{ malsymbol { name "foo" } } + T{ malenv + { outer T{ malenv f f H{ { "foo" "2" } } } } + { data H{ { "foo" "1" } } } + } env-get +] unit-test + +{ "2" } [ + T{ malsymbol { name "foo" } } + T{ malenv + { outer T{ malenv f f H{ { "foo" "2" } } } } + { data H{ { "bar" "1" } } } + } env-get +] unit-test + +{ "3" } [ + T{ malsymbol { name "foo" } } + T{ malenv { outer f } { data H{ } } } + [ [ "3" ] 2dip env-set ] [ env-get ] 2bi +] unit-test + +[ + T{ malsymbol { name "baz" } } + T{ malenv + { outer T{ malenv f f H{ { "foo" "2" } } } } + { data H{ { "bar" "1" } } } + } env-get +] must-fail diff --git a/impls/factor/lib/env/env.factor b/impls/factor/lib/env/env.factor new file mode 100644 index 0000000000..b1ca0e96c7 --- /dev/null +++ b/impls/factor/lib/env/env.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs formatting hashtables kernel math +sequences typed ; +IN: lib.env + +TUPLE: malenv +{ outer read-only } +{ data hashtable read-only } ; + +! set outer to f if top level env + +C: malenv + +: new-env ( outer -- malenv ) H{ } clone malenv boa ; + +TYPED: env-find ( key malenv: malenv -- value/f ? ) + 2dup [ name>> ] [ data>> ] bi* at* [ + [ 2drop ] 2dip + ] [ + drop outer>> [ env-find ] [ drop f f ] if* + ] if* ; + +TYPED: env-set ( value key malenv: malenv -- ) + [ name>> ] [ data>> ] bi* set-at ; + +: env-get ( key assoc -- value ) + dupd env-find [ + nip + ] [ + drop name>> "'%s' not found" sprintf throw + ] if ; diff --git a/impls/factor/lib/printer/printer-tests.factor b/impls/factor/lib/printer/printer-tests.factor new file mode 100644 index 0000000000..3ab2ce1ce8 --- /dev/null +++ b/impls/factor/lib/printer/printer-tests.factor @@ -0,0 +1,15 @@ +USING: lists lib.types tools.test ; +IN: lib.printer + +{ "(atom \"foo\")" } [ T{ malatom { val "foo" } } pr-str ] unit-test +{ "#" } [ T{ malfn } pr-str ] unit-test +{ ":foo" } [ T{ malkeyword { name "foo" } } pr-str ] unit-test +{ "foo" } [ T{ malsymbol { name "foo" } } pr-str ] unit-test +{ "14" } [ 14 pr-str ] unit-test +{ "\"\\\\foo\\\"\"" } [ "\\foo\"" pr-str ] unit-test +{ "(1 2 3 4)" } [ { 1 2 3 4 } pr-str ] unit-test +{ "[1 2 3 4]" } [ V{ 1 2 3 4 } pr-str ] unit-test +{ "{1 2}" } [ H{ { 1 2 } } pr-str ] unit-test +{ "true" } [ t pr-str ] unit-test +{ "false" } [ f pr-str ] unit-test +{ "nil" } [ +nil+ pr-str ] unit-test diff --git a/impls/factor/lib/printer/printer.factor b/impls/factor/lib/printer/printer.factor new file mode 100644 index 0000000000..0739f473ef --- /dev/null +++ b/impls/factor/lib/printer/printer.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs fry hashtables kernel lists +lib.types math math.parser sequences splitting strings summary +vectors ; +IN: lib.printer + +GENERIC#: (pr-str) 1 ( maltype readably? -- str ) +M: object (pr-str) drop summary ; +M: malatom (pr-str) [ val>> ] dip (pr-str) "(atom " ")" surround ; +M: malfn (pr-str) 2drop "#" ; +M: malkeyword (pr-str) drop name>> ":" prepend ; +M: malsymbol (pr-str) drop name>> ; +M: number (pr-str) drop number>string ; +M: string (pr-str) + [ + "\\" "\\\\" replace + "\"" "\\\"" replace + "\n" "\\n" replace + "\"" dup surround + ] when ; +M: array (pr-str) '[ _ (pr-str) ] map " " join "(" ")" surround ; +M: vector (pr-str) '[ _ (pr-str) ] map " " join "[" "]" surround ; +M: hashtable (pr-str) + [ unzip ] dip '[ [ _ (pr-str) ] bi@ " " glue ] 2map + " " join "{" "}" surround ; +M: t (pr-str) 2drop "true" ; +M: f (pr-str) 2drop "false" ; +M: +nil+ (pr-str) 2drop "nil" ; + +: pr-str ( maltype -- str ) + t (pr-str) ; diff --git a/impls/factor/lib/reader/reader-tests.factor b/impls/factor/lib/reader/reader-tests.factor new file mode 100644 index 0000000000..993a4c7789 --- /dev/null +++ b/impls/factor/lib/reader/reader-tests.factor @@ -0,0 +1,12 @@ +USING: lists lib.types tools.test ; +IN: lib.reader + +{ "foo" } [ "\"foo\"" read-atom ] unit-test +{ T{ malkeyword { name "foo" } } } [ ":foo" read-atom ] unit-test +{ f } [ "false" read-atom ] unit-test +{ t } [ "true" read-atom ] unit-test +{ +nil+ } [ "nil" read-atom ] unit-test +{ T{ malsymbol { name "foo" } } } [ "foo" read-atom ] unit-test +{ 14 } [ "14" read-atom ] unit-test +{ 1.5 } [ "1.5" read-atom ] unit-test +{ 2/3 } [ "2/3" read-atom ] unit-test diff --git a/impls/factor/lib/reader/reader.factor b/impls/factor/lib/reader/reader.factor new file mode 100644 index 0000000000..ae228bd86f --- /dev/null +++ b/impls/factor/lib/reader/reader.factor @@ -0,0 +1,80 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays combinators grouping hashtables kernel lists locals +make lib.types math.parser regexp sequences splitting strings ; +IN: lib.reader + +CONSTANT: token-regex R/ (~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)~^@]+)/ + +DEFER: read-form + +: (read-string) ( str -- maltype ) +! dup last CHAR: " = [ + dup R/ ^"(?:\\.|[^\\"])*"$/ matches? [ + rest but-last R/ \\./ [ + { + { [ dup >string "\\\\" = ] [ drop "\\" ] } + { [ dup >string "\\n" = ] [ drop "\n" ] } + { [ dup >string "\\\"" = ] [ drop "\"" ] } + [ ] + } cond + ] re-replace-with + ] [ + "expected '\"', got EOF" throw + ] if ; + +: (read-atom) ( str -- maltype ) + { + { [ dup first CHAR: " = ] [ (read-string) ] } + { [ dup first CHAR: : = ] [ rest ] } + { [ dup "false" = ] [ drop f ] } + { [ dup "true" = ] [ drop t ] } + { [ dup "nil" = ] [ drop nil ] } + [ ] + } cond ; + +: read-atom ( str -- maltype ) + dup string>number [ nip ] [ (read-atom) ] if* ; + +:: read-sequence ( seq closer exemplar -- seq maltype ) + seq [ + [ + [ "expected '" closer "', got EOF" append append throw ] + [ dup first closer = ] if-empty + ] [ + read-form , + ] until rest + ] exemplar make ; + +: read-list ( seq -- seq maltype ) + ")" { } read-sequence ; + +: read-vector ( seq -- seq maltype ) + "]" V{ } read-sequence ; + +: read-hashmap ( seq -- seq maltype ) + "}" V{ } read-sequence 2 group parse-hashtable ; + +: consume-next-into-list ( seq symname -- seq maltype ) + [ read-form ] dip swap 2array ; + +: read-form ( seq -- seq maltype ) + unclip { + { "(" [ read-list ] } + { "[" [ read-vector ] } + { "{" [ read-hashmap ] } + { "'" [ "quote" consume-next-into-list ] } + { "`" [ "quasiquote" consume-next-into-list ] } + { "~" [ "unquote" consume-next-into-list ] } + { "~@" [ "splice-unquote" consume-next-into-list ] } + { "^" [ read-form [ read-form ] dip 2array "with-meta" prefix ] } + { "@" [ "deref" consume-next-into-list ] } + [ read-atom ] + } case ; + +: tokenize ( str -- seq ) + token-regex all-matching-subseqs + [ first CHAR: ; = not ] filter ; + +: read-str ( str -- maltype ) + tokenize [ " " throw ] [ read-form nip ] if-empty ; diff --git a/impls/factor/lib/types/types.factor b/impls/factor/lib/types/types.factor new file mode 100644 index 0000000000..da00d8ba9e --- /dev/null +++ b/impls/factor/lib/types/types.factor @@ -0,0 +1,51 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs combinators.short-circuit hashtables +kernel locals lib.env sequences strings ; +IN: lib.types + +TUPLE: malsymbol { name string read-only } ; + +C: malsymbol + +: symeq? ( string other -- ? ) + dup malsymbol? [ name>> = ] [ 2drop f ] if ; + +TUPLE: malfn + { env malenv read-only } + { binds sequence read-only } + { exprs read-only } + { macro? boolean read-only } + { meta assoc } ; + +: malmacro ( fn -- fn ) + [ env>> ] [ binds>> ] [ exprs>> ] tri t f malfn boa ; + +: ( env binds exprs -- fn ) + f f malfn boa ; + +TUPLE: malatom { val } ; + +C: malatom + +TUPLE: malkeyword { name string read-only } ; + +C: malkeyword + +DEFER: mal= + +: mal-sequence= ( seq1 seq2 -- ? ) + 2dup [ length ] bi@ = + [ [ mal= ] 2all? ] [ 2drop f ] if ; + +:: mal-hashtable= ( h1 h2 -- ? ) + h1 assoc-size h2 assoc-size = [ + h1 [| k1 v1 | k1 h2 at* drop v1 mal= ] assoc-all? + ] [ f ] if ; + +: mal= ( obj1 obj2 -- ? ) + 2dup [ hashtable? ] bi@ and + [ mal-hashtable= ] [ + 2dup [ { [ ] [ sequence? ] [ string? not ] } 1&& ] bi@ and + [ mal-sequence= ] [ = ] if + ] if ; diff --git a/impls/factor/run b/impls/factor/run new file mode 100755 index 0000000000..bb6d41f1da --- /dev/null +++ b/impls/factor/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec factor $(dirname $0)/${STEP:-stepA_mal}/${STEP:-stepA_mal}.factor "${@}" diff --git a/impls/factor/step0_repl/deploy.factor b/impls/factor/step0_repl/deploy.factor new file mode 100644 index 0000000000..f69d2e4a74 --- /dev/null +++ b/impls/factor/step0_repl/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step0_repl" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step0_repl/step0_repl.factor b/impls/factor/step0_repl/step0_repl.factor new file mode 100755 index 0000000000..2eb4a1ddac --- /dev/null +++ b/impls/factor/step0_repl/step0_repl.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: io kernel readline sequences ; +IN: step0_repl + +: READ ( x -- x ) ; + +: EVAL ( x -- x ) ; + +: PRINT ( x -- x ) ; + +: REP ( x -- x ) READ EVAL PRINT ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +MAIN: REPL diff --git a/impls/factor/step1_read_print/deploy.factor b/impls/factor/step1_read_print/deploy.factor new file mode 100644 index 0000000000..37c763fa06 --- /dev/null +++ b/impls/factor/step1_read_print/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step1_read_print" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step1_read_print/step1_read_print.factor b/impls/factor/step1_read_print/step1_read_print.factor new file mode 100755 index 0000000000..3d23d9c31e --- /dev/null +++ b/impls/factor/step1_read_print/step1_read_print.factor @@ -0,0 +1,27 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: continuations io kernel lib.printer lib.reader readline +sequences ; +IN: step1_read_print + +: READ ( str -- maltype ) read-str ; + +: EVAL ( maltype -- maltype ) ; + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +MAIN: REPL diff --git a/impls/factor/step2_eval/deploy.factor b/impls/factor/step2_eval/deploy.factor new file mode 100644 index 0000000000..48cd2ad669 --- /dev/null +++ b/impls/factor/step2_eval/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step2_eval" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step2_eval/step2_eval.factor b/impls/factor/step2_eval/step2_eval.factor new file mode 100755 index 0000000000..b1b6fc1353 --- /dev/null +++ b/impls/factor/step2_eval/step2_eval.factor @@ -0,0 +1,54 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators combinators.short-circuit +continuations fry hashtables io kernel math lib.printer lib.reader lib.types +quotations readline sequences vectors ; +IN: step2_eval + +CONSTANT: repl-env H{ + { "+" [ + ] } + { "-" [ - ] } + { "*" [ * ] } + { "/" [ / ] } +} + +DEFER: EVAL + +: READ ( str -- maltype ) read-str ; + +: apply ( maltype env -- maltype ) + dup quotation? [ drop "not a fn" throw ] unless + with-datastack + first ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + '[ _ EVAL ] map + dup empty? [ unclip apply ] unless ; +M: malsymbol EVAL-switch + [ name>> ] dip ?at [ "no variable " prepend throw ] unless ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + ! "EVAL: " pick pr-str append print flush + EVAL-switch ; + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +MAIN: REPL diff --git a/impls/factor/step3_env/deploy.factor b/impls/factor/step3_env/deploy.factor new file mode 100644 index 0000000000..557d7fd368 --- /dev/null +++ b/impls/factor/step3_env/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step3_env" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step3_env/step3_env.factor b/impls/factor/step3_env/step3_env.factor new file mode 100755 index 0000000000..f441fe0330 --- /dev/null +++ b/impls/factor/step3_env/step3_env.factor @@ -0,0 +1,74 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators combinators.short-circuit +continuations fry grouping hashtables io kernel lists locals lib.env lib.printer +lib.reader lib.types math namespaces quotations readline sequences vectors ; +IN: step3_env + +CONSTANT: repl-bindings H{ + { "+" [ + ] } + { "-" [ - ] } + { "*" [ * ] } + { "/" [ / ] } +} + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep EVAL ; + +: READ ( str -- maltype ) read-str ; + +: apply ( maltype env -- maltype ) + dup quotation? [ drop "not a fn" throw ] unless + with-datastack + first ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + [ drop '[ _ EVAL ] map unclip apply ] + } case + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + f repl-bindings repl-env set + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +MAIN: REPL diff --git a/impls/factor/step4_if_fn_do/deploy.factor b/impls/factor/step4_if_fn_do/deploy.factor new file mode 100644 index 0000000000..f687916c39 --- /dev/null +++ b/impls/factor/step4_if_fn_do/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step4_if_fn_do" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step4_if_fn_do/step4_if_fn_do.factor b/impls/factor/step4_if_fn_do/step4_if_fn_do.factor new file mode 100755 index 0000000000..c9447b807a --- /dev/null +++ b/impls/factor/step4_if_fn_do/step4_if_fn_do.factor @@ -0,0 +1,94 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators combinators.short-circuit +continuations fry grouping hashtables io kernel lists locals lib.core lib.env +lib.printer lib.reader lib.types math namespaces quotations readline sequences +splitting vectors ; +IN: step4_if_fn_do + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep EVAL ; + +:: eval-if ( params env -- maltype ) + params first env EVAL { f +nil+ } index not [ + params second env EVAL + ] [ + params length 2 > [ params third env EVAL ] [ nil ] if + ] if ; + +:: eval-fn* ( params env -- maltype ) + env params first [ name>> ] map params second ; + +: args-split ( bindlist -- bindlist restbinding/f ) + { "&" } split1 ?first ; + +: make-bindings ( args bindlist restbinding/f -- bindingshash ) + swapd [ over length cut [ zip ] dip ] dip + [ swap 2array suffix ] [ drop ] if* >hashtable ; + +GENERIC: apply ( args fn -- maltype ) + +M: malfn apply + [ exprs>> nip ] + [ env>> nip ] + [ binds>> args-split make-bindings ] 2tri EVAL ; + +M: callable apply call( x -- y ) ; + +: READ ( str -- maltype ) read-str ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip '[ _ EVAL ] map last ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* ] } + [ drop '[ _ EVAL ] map unclip apply ] + } case + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +f ns repl-env set-global +"(def! not (fn* (a) (if a false true)))" REP drop + +MAIN: REPL diff --git a/impls/factor/step5_tco/deploy.factor b/impls/factor/step5_tco/deploy.factor new file mode 100644 index 0000000000..350969d6f9 --- /dev/null +++ b/impls/factor/step5_tco/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step5_tco" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step5_tco/step5_tco.factor b/impls/factor/step5_tco/step5_tco.factor new file mode 100755 index 0000000000..c7a3ab12bd --- /dev/null +++ b/impls/factor/step5_tco/step5_tco.factor @@ -0,0 +1,102 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators combinators.short-circuit +continuations fry grouping hashtables io kernel lists locals lib.core lib.env +lib.printer lib.reader lib.types math namespaces quotations readline sequences +splitting vectors ; +IN: step5_tco + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype env ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep ; + +:: eval-do ( exprs env -- lastform env/f ) + exprs [ + { } f + ] [ + unclip-last [ '[ env EVAL drop ] each ] dip env + ] if-empty ; + +:: eval-if ( params env -- maltype env/f ) + params first env EVAL { f +nil+ } index not [ + params second env + ] [ + params length 2 > [ params third env ] [ nil f ] if + ] if ; + +:: eval-fn* ( params env -- maltype ) + env params first [ name>> ] map params second ; + +: args-split ( bindlist -- bindlist restbinding/f ) + { "&" } split1 ?first ; + +: make-bindings ( args bindlist restbinding/f -- bindingshash ) + swapd [ over length cut [ zip ] dip ] dip + [ swap 2array suffix ] [ drop ] if* >hashtable ; + +GENERIC: apply ( args fn -- maltype newenv/f ) + +M: malfn apply + [ exprs>> nip ] + [ env>> nip ] + [ binds>> args-split make-bindings ] 2tri ; + +M: callable apply call( x -- y ) f ; + +: READ ( str -- maltype ) read-str ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! f ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip eval-do ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* f ] } + [ drop '[ _ EVAL ] map unclip apply ] + } case [ EVAL ] when* + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +f ns repl-env set-global + +"(def! not (fn* (a) (if a false true)))" REP drop + +MAIN: REPL diff --git a/impls/factor/step6_file/deploy.factor b/impls/factor/step6_file/deploy.factor new file mode 100644 index 0000000000..db7f1e5138 --- /dev/null +++ b/impls/factor/step6_file/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step6_file" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step6_file/step6_file.factor b/impls/factor/step6_file/step6_file.factor new file mode 100755 index 0000000000..d08691bce8 --- /dev/null +++ b/impls/factor/step6_file/step6_file.factor @@ -0,0 +1,116 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators combinators.short-circuit +command-line continuations fry grouping hashtables io kernel lists locals +lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations +readline sequences splitting vectors ; +IN: step6_file + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype env ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep ; + +:: eval-do ( exprs env -- lastform env/f ) + exprs [ + { } f + ] [ + unclip-last [ '[ env EVAL drop ] each ] dip env + ] if-empty ; + +:: eval-if ( params env -- maltype env/f ) + params first env EVAL { f +nil+ } index not [ + params second env + ] [ + params length 2 > [ params third env ] [ nil f ] if + ] if ; + +:: eval-fn* ( params env -- maltype ) + env params first [ name>> ] map params second ; + +: args-split ( bindlist -- bindlist restbinding/f ) + { "&" } split1 ?first ; + +: make-bindings ( args bindlist restbinding/f -- bindingshash ) + swapd [ over length cut [ zip ] dip ] dip + [ swap 2array suffix ] [ drop ] if* >hashtable ; + +GENERIC: apply ( args fn -- maltype newenv/f ) + +M: malfn apply + [ exprs>> nip ] + [ env>> nip ] + [ binds>> args-split make-bindings ] 2tri ; + +M: callable apply call( x -- y ) f ; + +: READ ( str -- maltype ) read-str ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! f ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip eval-do ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* f ] } + [ drop '[ _ EVAL ] map unclip apply ] + } case [ EVAL ] when* + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +[ apply [ EVAL ] when* ] mal-apply set-global + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +: main ( -- ) + command-line get + [ REPL ] + [ first "(load-file \"" "\")" surround REP drop ] + if-empty ; + +f ns clone +[ first repl-env get EVAL ] "eval" pick set-at +command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at + repl-env set-global + +" +(def! not (fn* (a) (if a false true))) +(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) +" string-lines harvest [ REP drop ] each + +MAIN: main diff --git a/impls/factor/step7_quote/deploy.factor b/impls/factor/step7_quote/deploy.factor new file mode 100644 index 0000000000..e8af580f9e --- /dev/null +++ b/impls/factor/step7_quote/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step7_quote" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step7_quote/step7_quote.factor b/impls/factor/step7_quote/step7_quote.factor new file mode 100755 index 0000000000..7cc1486a4c --- /dev/null +++ b/impls/factor/step7_quote/step7_quote.factor @@ -0,0 +1,150 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators +combinators.short-circuit command-line continuations fry +grouping hashtables io kernel lists locals lib.core lib.env +lib.printer lib.reader lib.types math namespaces quotations +readline sequences splitting vectors ; +IN: step7_quote + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype env ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep ; + +:: eval-do ( exprs env -- lastform env/f ) + exprs [ + { } f + ] [ + unclip-last [ '[ env EVAL drop ] each ] dip env + ] if-empty ; + +:: eval-if ( params env -- maltype env/f ) + params first env EVAL { f +nil+ } index not [ + params second env + ] [ + params length 2 > [ params third env ] [ nil f ] if + ] if ; + +:: eval-fn* ( params env -- maltype ) + env params first [ name>> ] map params second ; + +: args-split ( bindlist -- bindlist restbinding/f ) + { "&" } split1 ?first ; + +: make-bindings ( args bindlist restbinding/f -- bindingshash ) + swapd [ over length cut [ zip ] dip ] dip + [ swap 2array suffix ] [ drop ] if* >hashtable ; + +GENERIC: apply ( args fn -- maltype newenv/f ) + +M: malfn apply + [ exprs>> nip ] + [ env>> nip ] + [ binds>> args-split make-bindings ] 2tri ; + +M: callable apply call( x -- y ) f ; + +DEFER: quasiquote + +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; +M: object quasiquote ; + +: READ ( str -- maltype ) read-str ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! f ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip eval-do ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* f ] } + { "quote" [ drop second f ] } + { "quasiquote" [ [ second quasiquote ] dip ] } + [ drop '[ _ EVAL ] map unclip apply ] + } case [ EVAL ] when* + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +[ apply [ EVAL ] when* ] mal-apply set-global + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +: main ( -- ) + command-line get + [ REPL ] + [ first "(load-file \"" "\")" surround REP drop ] + if-empty ; + +f ns clone +[ first repl-env get EVAL ] "eval" pick set-at +command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at + repl-env set-global + +" +(def! not (fn* (a) (if a false true))) +(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) +" string-lines harvest [ REP drop ] each + +MAIN: main diff --git a/impls/factor/step8_macros/deploy.factor b/impls/factor/step8_macros/deploy.factor new file mode 100644 index 0000000000..e50cebbf5b --- /dev/null +++ b/impls/factor/step8_macros/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step8_macros" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step8_macros/step8_macros.factor b/impls/factor/step8_macros/step8_macros.factor new file mode 100755 index 0000000000..4ef43deb12 --- /dev/null +++ b/impls/factor/step8_macros/step8_macros.factor @@ -0,0 +1,165 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators +combinators.short-circuit command-line continuations fry +grouping hashtables io kernel lists locals lib.core lib.env +lib.printer lib.reader lib.types math namespaces quotations +readline sequences splitting vectors ; +IN: step8_macros + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +:: eval-defmacro! ( key value env -- maltype ) + value env EVAL malmacro [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype env ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep ; + +:: eval-do ( exprs env -- lastform env/f ) + exprs [ + { } f + ] [ + unclip-last [ '[ env EVAL drop ] each ] dip env + ] if-empty ; + +:: eval-if ( params env -- maltype env/f ) + params first env EVAL { f +nil+ } index not [ + params second env + ] [ + params length 2 > [ params third env ] [ nil f ] if + ] if ; + +:: eval-fn* ( params env -- maltype ) + env params first [ name>> ] map params second ; + +: args-split ( bindlist -- bindlist restbinding/f ) + { "&" } split1 ?first ; + +: make-bindings ( args bindlist restbinding/f -- bindingshash ) + swapd [ over length cut [ zip ] dip ] dip + [ swap 2array suffix ] [ drop ] if* >hashtable ; + +GENERIC: apply ( args fn -- maltype newenv/f ) + +M: malfn apply + [ exprs>> nip ] + [ env>> nip ] + [ binds>> args-split make-bindings ] 2tri ; + +M: callable apply call( x -- y ) f ; + +DEFER: quasiquote + +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; +M: object quasiquote ; + +: READ ( str -- maltype ) read-str ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! f ] } + { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip eval-do ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* f ] } + { "quote" [ drop second f ] } + { "quasiquote" [ [ second quasiquote ] dip ] } + [ drop swap ! env ast + unclip ! env rest first + pick EVAL ! env rest fn + dup { [ malfn? ] [ macro?>> ] } 1&& [ + apply ! env maltype newenv + EVAL swap + ] [ + [ swap '[ _ EVAL ] map ] dip ! args fn + apply + ] if + ] + } case [ EVAL ] when* + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +[ apply [ EVAL ] when* ] mal-apply set-global + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +: main ( -- ) + command-line get + [ REPL ] + [ first "(load-file \"" "\")" surround REP drop ] + if-empty ; + +f ns clone +[ first repl-env get EVAL ] "eval" pick set-at +command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at + repl-env set-global + +" +(def! not (fn* (a) (if a false true))) +(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs))))))) +" string-lines harvest [ REP drop ] each + +MAIN: main diff --git a/impls/factor/step9_try/deploy.factor b/impls/factor/step9_try/deploy.factor new file mode 100644 index 0000000000..03f485b13b --- /dev/null +++ b/impls/factor/step9_try/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "step9_try" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/step9_try/step9_try.factor b/impls/factor/step9_try/step9_try.factor new file mode 100755 index 0000000000..a6b391abf8 --- /dev/null +++ b/impls/factor/step9_try/step9_try.factor @@ -0,0 +1,177 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators +combinators.short-circuit command-line continuations fry +grouping hashtables io kernel lists locals lib.core lib.env +lib.printer lib.reader lib.types math namespaces quotations +readline sequences splitting vectors ; +IN: step9_try + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +:: eval-defmacro! ( key value env -- maltype ) + value env EVAL malmacro [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype env ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep ; + +:: eval-do ( exprs env -- lastform env/f ) + exprs [ + { } f + ] [ + unclip-last [ '[ env EVAL drop ] each ] dip env + ] if-empty ; + +:: eval-if ( params env -- maltype env/f ) + params first env EVAL { f +nil+ } index not [ + params second env + ] [ + params length 2 > [ params third env ] [ nil f ] if + ] if ; + +:: eval-fn* ( params env -- maltype ) + env params first [ name>> ] map params second ; + +:: eval-try* ( params env -- maltype ) + [ params first env EVAL ] + [ + params length 1 > [ + params second second env new-env [ env-set ] keep + params second third swap EVAL + ] [ + throw + ] if + ] recover ; + +: args-split ( bindlist -- bindlist restbinding/f ) + { "&" } split1 ?first ; + +: make-bindings ( args bindlist restbinding/f -- bindingshash ) + swapd [ over length cut [ zip ] dip ] dip + [ swap 2array suffix ] [ drop ] if* >hashtable ; + +GENERIC: apply ( args fn -- maltype newenv/f ) + +M: malfn apply + [ exprs>> nip ] + [ env>> nip ] + [ binds>> args-split make-bindings ] 2tri ; + +M: callable apply call( x -- y ) f ; + +DEFER: quasiquote + +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; +M: object quasiquote ; + +: READ ( str -- maltype ) read-str ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! f ] } + { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip eval-do ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* f ] } + { "quote" [ drop second f ] } + { "quasiquote" [ [ second quasiquote ] dip ] } + { "try*" [ [ rest ] dip eval-try* f ] } + [ drop swap ! env ast + unclip ! env rest first + pick EVAL ! env rest fn + dup { [ malfn? ] [ macro?>> ] } 1&& [ + apply ! env maltype newenv + EVAL swap + ] [ + [ swap '[ _ EVAL ] map ] dip ! args fn + apply + ] if + ] + } case [ EVAL ] when* + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +[ apply [ EVAL ] when* ] mal-apply set-global + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +: main ( -- ) + command-line get + [ REPL ] + [ first "(load-file \"" "\")" surround REP drop ] + if-empty ; + +f ns clone +[ first repl-env get EVAL ] "eval" pick set-at +command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at + repl-env set-global + +" +(def! not (fn* (a) (if a false true))) +(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs))))))) +" string-lines harvest [ REP drop ] each + +MAIN: main diff --git a/impls/factor/stepA_mal/deploy.factor b/impls/factor/stepA_mal/deploy.factor new file mode 100644 index 0000000000..4397858be3 --- /dev/null +++ b/impls/factor/stepA_mal/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "stepA_mal" } + { "stop-after-last-window?" t } + { deploy-unicode? f } + { deploy-console? t } + { deploy-io 3 } + { deploy-reflection 1 } + { deploy-ui? f } + { deploy-word-defs? f } + { deploy-threads? t } + { deploy-math? t } + { deploy-word-props? f } +} diff --git a/impls/factor/stepA_mal/stepA_mal.factor b/impls/factor/stepA_mal/stepA_mal.factor new file mode 100755 index 0000000000..517ff1988d --- /dev/null +++ b/impls/factor/stepA_mal/stepA_mal.factor @@ -0,0 +1,179 @@ +! Copyright (C) 2015 Jordan Lewis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators +combinators.short-circuit command-line continuations fry +grouping hashtables io kernel lists locals lib.core lib.env +lib.printer lib.reader lib.types math namespaces quotations +readline sequences splitting strings vectors ; +IN: stepA_mal + +SYMBOL: repl-env + +DEFER: EVAL + +:: eval-def! ( key value env -- maltype ) + value env EVAL [ key env env-set ] keep ; + +:: eval-defmacro! ( key value env -- maltype ) + value env EVAL malmacro [ key env env-set ] keep ; + +: eval-let* ( bindings body env -- maltype env ) + [ swap 2 group ] [ new-env ] bi* [ + dup '[ first2 _ EVAL swap _ env-set ] each + ] keep ; + +:: eval-do ( exprs env -- lastform env/f ) + exprs [ + { } f + ] [ + unclip-last [ '[ env EVAL drop ] each ] dip env + ] if-empty ; + +:: eval-if ( params env -- maltype env/f ) + params first env EVAL { f +nil+ } index not [ + params second env + ] [ + params length 2 > [ params third env ] [ nil f ] if + ] if ; + +:: eval-fn* ( params env -- maltype ) + env params first [ name>> ] map params second ; + +:: eval-try* ( params env -- maltype ) + [ params first env EVAL ] + [ + params length 1 > [ + params second second env new-env [ env-set ] keep + params second third swap EVAL + ] [ + throw + ] if + ] recover ; + +: args-split ( bindlist -- bindlist restbinding/f ) + { "&" } split1 ?first ; + +: make-bindings ( args bindlist restbinding/f -- bindingshash ) + swapd [ over length cut [ zip ] dip ] dip + [ swap 2array suffix ] [ drop ] if* >hashtable ; + +GENERIC: apply ( args fn -- maltype newenv/f ) + +M: malfn apply + [ exprs>> nip ] + [ env>> nip ] + [ binds>> args-split make-bindings ] 2tri ; + +M: callable apply call( x -- y ) f ; + +DEFER: quasiquote + +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; +M: object quasiquote ; + +: READ ( str -- maltype ) read-str ; + +GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ + over first dup malsymbol? [ name>> ] when { + { "def!" [ [ rest first2 ] dip eval-def! f ] } + { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip eval-do ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* f ] } + { "quote" [ drop second f ] } + { "quasiquote" [ [ second quasiquote ] dip ] } + { "try*" [ [ rest ] dip eval-try* f ] } + [ drop swap ! env ast + unclip ! env rest first + pick EVAL ! env rest fn + dup { [ malfn? ] [ macro?>> ] } 1&& [ + apply ! env maltype newenv + EVAL swap + ] [ + [ swap '[ _ EVAL ] map ] dip ! args fn + apply + ] if + ] + } case [ EVAL ] when* + ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; + +[ apply [ EVAL ] when* ] mal-apply set-global + +: PRINT ( maltype -- str ) pr-str ; + +: REP ( str -- str ) + [ + READ repl-env get EVAL PRINT + ] [ + nip pr-str "Error: " swap append + ] recover ; + +: REPL ( -- ) + "(println (str \"Mal [\" *host-language* \"]\"))" REP drop + [ + "user> " readline [ + [ REP print flush ] unless-empty + ] keep + ] loop ; + +: main ( -- ) + command-line get + [ REPL ] + [ first "(load-file \"" "\")" surround REP drop ] + if-empty ; + +f ns clone +[ first repl-env get EVAL ] "eval" pick set-at +command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at + repl-env set-global + +" +(def! *host-language* \"factor\") +(def! not (fn* (a) (if a false true))) +(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs))))))) +" string-lines harvest [ READ repl-env get EVAL drop ] each + +MAIN: main diff --git a/impls/factor/tests/step5_tco.mal b/impls/factor/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/factor/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/fantom/Dockerfile b/impls/fantom/Dockerfile new file mode 100644 index 0000000000..67e21b07d4 --- /dev/null +++ b/impls/fantom/Dockerfile @@ -0,0 +1,38 @@ +FROM ubuntu:bionic +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Java and Unzip +RUN apt-get -y install openjdk-8-jdk unzip + +# Fantom and JLine +RUN cd /tmp && curl -sfLO https://github.com/fantom-lang/fantom/releases/download/v1.0.75/fantom-1.0.75.zip \ + && unzip -q fantom-1.0.75.zip \ + && rm fantom-1.0.75.zip \ + && mv fantom-1.0.75 /opt/fantom \ + && cd /opt/fantom \ + && bash adm/unixsetup \ + && curl -sfL -o /opt/fantom/lib/java/jline.jar https://repo1.maven.org/maven2/jline/jline/2.14.6/jline-2.14.6.jar \ + && sed -i '/java.options/ s/^\/\/ *\(.*\)$/\1 -Djline.expandevents=false/' /opt/fantom/etc/sys/config.props + +ENV PATH /opt/fantom/bin:$PATH +ENV HOME /mal diff --git a/impls/fantom/Makefile b/impls/fantom/Makefile new file mode 100644 index 0000000000..2b95720ab0 --- /dev/null +++ b/impls/fantom/Makefile @@ -0,0 +1,18 @@ +all: dist + +dist: lib/fan/mal.pod + +lib/fan: + mkdir -p $@ + +lib/fan/mal.pod: lib/fan/stepA_mal.pod + cp -a $< $@ + +lib/fan/step%.pod: src/step%/build.fan src/step%/fan/*.fan lib/fan/mallib.pod + FAN_ENV=util::PathEnv FAN_ENV_PATH=. fan $< + +lib/fan/mallib.pod: src/mallib/build.fan src/mallib/fan/*.fan lib/fan + FAN_ENV=util::PathEnv FAN_ENV_PATH=. fan $< + +clean: + rm -rf lib diff --git a/impls/fantom/run b/impls/fantom/run new file mode 100755 index 0000000000..b0b70cf57b --- /dev/null +++ b/impls/fantom/run @@ -0,0 +1,4 @@ +#!/usr/bin/env bash +export FAN_ENV=util::PathEnv +export FAN_ENV_PATH="$(dirname $0)" +exec fan ${STEP:-stepA_mal} "$@" diff --git a/impls/fantom/src/mallib/build.fan b/impls/fantom/src/mallib/build.fan new file mode 100644 index 0000000000..275b9daf95 --- /dev/null +++ b/impls/fantom/src/mallib/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "mallib" + summary = "mal library pod" + depends = ["sys 1.0", "compiler 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/mallib/fan/core.fan b/impls/fantom/src/mallib/fan/core.fan new file mode 100644 index 0000000000..6ec77464f1 --- /dev/null +++ b/impls/fantom/src/mallib/fan/core.fan @@ -0,0 +1,118 @@ +class Core +{ + static private MalVal prn(MalVal[] a) + { + echo(a.join(" ") { it.toString(true) }) + return MalNil.INSTANCE + } + + static private MalVal println(MalVal[] a) + { + echo(a.join(" ") { it.toString(false) }) + return MalNil.INSTANCE + } + + static private MalVal readline(MalVal[] a) + { + line := Env.cur.prompt((a[0] as MalString).value) + return line == null ? MalNil.INSTANCE : MalString.make(line) + } + + static private MalVal concat(MalVal[] a) + { + return MalList(a.reduce(MalVal[,]) |MalVal[] r, MalSeq v -> MalVal[]| { r.addAll(v.value) }) + } + + static private MalVal apply(MalVal[] a) + { + f := a[0] as MalFunc + args := a[1..-2] + args.addAll(((MalSeq)a[-1]).value) + return f.call(args) + } + + static private MalVal swap_bang(MalVal[] a) + { + atom := a[0] as MalAtom + MalVal[] args := [atom.value] + args.addAll(a[2..-1]) + f := a[1] as MalFunc + return atom.set(f.call(args)) + } + + static Str:MalFunc ns() + { + return [ + "=": MalFunc { MalTypes.toMalBool(it[0] == it[1]) }, + "throw": MalFunc { throw MalException(it[0]) }, + + "nil?": MalFunc { MalTypes.toMalBool(it[0] is MalNil) }, + "true?": MalFunc { MalTypes.toMalBool(it[0] is MalTrue) }, + "false?": MalFunc { MalTypes.toMalBool(it[0] is MalFalse) }, + "string?": MalFunc { MalTypes.toMalBool(it[0] is MalString && !((MalString)it[0]).isKeyword) }, + "symbol": MalFunc { MalSymbol.makeFromVal(it[0]) }, + "symbol?": MalFunc { MalTypes.toMalBool(it[0] is MalSymbol) }, + "keyword": MalFunc { MalString.makeKeyword((it[0] as MalString).value) }, + "keyword?": MalFunc { MalTypes.toMalBool(it[0] is MalString && ((MalString)it[0]).isKeyword) }, + "number?": MalFunc { MalTypes.toMalBool(it[0] is MalInteger) }, + "fn?": MalFunc { MalTypes.toMalBool(it[0] is MalFunc && !((it[0] as MalUserFunc)?->isMacro ?: false)) }, + "macro?": MalFunc { MalTypes.toMalBool(it[0] is MalUserFunc && ((MalUserFunc)it[0]).isMacro) }, + + "pr-str": MalFunc { MalString.make(it.join(" ") |MalVal e -> Str| { e.toString(true) }) }, + "str": MalFunc { MalString.make(it.join("") |MalVal e -> Str| { e.toString(false) }) }, + "prn": MalFunc(#prn.func), + "println": MalFunc(#println.func), + "read-string": MalFunc { Reader.read_str((it[0] as MalString).value) }, + "readline": MalFunc(#readline.func), + "slurp": MalFunc { MalString.make(File((it[0] as MalString).value.toUri).readAllStr) }, + + "<": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value < (it[1] as MalInteger).value) }, + "<=": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value <= (it[1] as MalInteger).value) }, + ">": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value > (it[1] as MalInteger).value) }, + ">=": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value >= (it[1] as MalInteger).value) }, + "+": MalFunc { MalInteger((it[0] as MalInteger).value + (it[1] as MalInteger).value) }, + "-": MalFunc { MalInteger((it[0] as MalInteger).value - (it[1] as MalInteger).value) }, + "*": MalFunc { MalInteger((it[0] as MalInteger).value * (it[1] as MalInteger).value) }, + "/": MalFunc { MalInteger((it[0] as MalInteger).value / (it[1] as MalInteger).value) }, + "time-ms": MalFunc { MalInteger(DateTime.nowTicks / 1000000) }, + + "list": MalFunc { MalList(it) }, + "list?": MalFunc { MalTypes.toMalBool(it[0] is MalList) }, + "vector": MalFunc { MalVector(it) }, + "vector?": MalFunc { MalTypes.toMalBool(it[0] is MalVector) }, + "hash-map": MalFunc { MalHashMap.fromList(it) }, + "map?": MalFunc { MalTypes.toMalBool(it[0] is MalHashMap) }, + "assoc": MalFunc { (it[0] as MalHashMap).assoc(it[1..-1]) }, + "dissoc": MalFunc { (it[0] as MalHashMap).dissoc(it[1..-1]) }, + "get": MalFunc { it[0] is MalNil ? MalNil.INSTANCE : (it[0] as MalHashMap).get2((MalString)it[1], MalNil.INSTANCE) }, + "contains?": MalFunc { MalTypes.toMalBool((it[0] as MalHashMap).containsKey((MalString)it[1])) }, + "keys": MalFunc { MalList((it[0] as MalHashMap).keys) }, + "vals": MalFunc { MalList((it[0] as MalHashMap).vals) }, + + "sequential?": MalFunc { MalTypes.toMalBool(it[0] is MalSeq) }, + "cons": MalFunc { MalList([it[0]].addAll((it[1] as MalSeq).value)) }, + "concat": MalFunc(#concat.func), + "vec": MalFunc { MalVector((it[0] as MalSeq).value) }, + "nth": MalFunc { (it[0] as MalSeq).nth((it[1] as MalInteger).value) }, + "first": MalFunc { (it[0] as MalSeq)?.first ?: MalNil.INSTANCE }, + "rest": MalFunc { (it[0] as MalSeq)?.rest ?: MalList([,]) }, + "empty?": MalFunc { MalTypes.toMalBool((it[0] as MalSeq).isEmpty) }, + "count": MalFunc { MalInteger(it[0].count) }, + "apply": MalFunc(#apply.func), + "map": MalFunc { (it[1] as MalSeq).map(it[0]) }, + + "conj": MalFunc { (it[0] as MalSeq).conj(it[1..-1]) }, + "seq": MalFunc { it[0].seq }, + + "meta": MalFunc { it[0].meta() }, + "with-meta": MalFunc { it[0].with_meta(it[1]) }, + "atom": MalFunc { MalAtom(it[0]) }, + "atom?": MalFunc { MalTypes.toMalBool(it[0] is MalAtom) }, + "deref": MalFunc { (it[0] as MalAtom).value }, + "reset!": MalFunc { (it[0] as MalAtom).set(it[1]) }, + "swap!": MalFunc(#swap_bang.func), + + "fantom-eval": MalFunc { Interop.fantomEvaluate((it[0] as MalString).value) } + ] + } +} diff --git a/impls/fantom/src/mallib/fan/env.fan b/impls/fantom/src/mallib/fan/env.fan new file mode 100644 index 0000000000..b3d8d34c0d --- /dev/null +++ b/impls/fantom/src/mallib/fan/env.fan @@ -0,0 +1,34 @@ +class MalEnv +{ + private Str:MalVal data := [:] + private MalEnv? outer + + new make(MalEnv? outer := null, MalSeq? binds := null, MalSeq? exprs := null) + { + this.outer = outer + if (binds != null && exprs != null) + { + for (i := 0; i < binds.count; i++) + { + if ((binds[i] as MalSymbol).value == "&") + { + set(binds[i + 1], MalList(exprs[i..-1])) + break + } + else + set(binds[i], exprs[i]) + } + } + } + + MalVal set(MalSymbol key, MalVal value) + { + data[key.value] = value + return value + } + + MalVal? get(Str key) + { + return data.containsKey(key) ? data[key] : outer?.get(key) + } +} diff --git a/impls/fantom/src/mallib/fan/interop.fan b/impls/fantom/src/mallib/fan/interop.fan new file mode 100644 index 0000000000..3dd7ce5422 --- /dev/null +++ b/impls/fantom/src/mallib/fan/interop.fan @@ -0,0 +1,65 @@ +using compiler + +internal class Interop +{ + static Pod? compile(Str innerBody) + { + ci := CompilerInput + { + podName = "mal_fantom_interop_${DateTime.nowUnique}" + summary = "" + isScript = true + version = Version.defVal + log.level = LogLevel.silent + output = CompilerOutputMode.transientPod + mode = CompilerInputMode.str + srcStr = "class InteropDummyClass {\nstatic Obj? _evalfunc() {\n $innerBody \n}\n}" + srcStrLoc = Loc("mal_fantom_interop") + } + try + return Compiler(ci).compile.transientPod + catch (CompilerErr e) + return null + } + + static Obj? evaluate(Str line) + { + p := compile(line) + if (p == null) + p = compile("return $line") + if (p == null) + p = compile("$line\nreturn null") + if (p == null) + return null + method := p.types.first.method("_evalfunc") + try + return method.call() + catch (Err e) + return null + } + + static MalVal fantomToMal(Obj? obj) + { + if (obj == null) + return MalNil.INSTANCE + else if (obj is Bool) + return MalTypes.toMalBool((Bool)obj) + else if (obj is Int) + return MalInteger((Int)obj) + else if (obj is List) + return MalList((obj as List).map |Obj? e -> MalVal| { fantomToMal(e) }) + else if (obj is Map) + { + m := [Str:MalVal][:] + (obj as Map).each |v, k| { m.set(k.toStr, fantomToMal(v)) } + return MalHashMap.fromMap(m) + } + else + return MalString.make(obj.toStr) + } + + static MalVal fantomEvaluate(Str line) + { + return fantomToMal(evaluate(line)) + } +} diff --git a/impls/fantom/src/mallib/fan/reader.fan b/impls/fantom/src/mallib/fan/reader.fan new file mode 100644 index 0000000000..98de61c55e --- /dev/null +++ b/impls/fantom/src/mallib/fan/reader.fan @@ -0,0 +1,108 @@ +internal class TokenReader +{ + const Str[] tokens + private Int position := 0 + + new make(Str[] new_tokens) { tokens = new_tokens } + + Str? peek() + { + if (position >= tokens.size) return null + return tokens[position] + } + + Str next() { return tokens[position++] } +} + +class Reader +{ + private static Str[] tokenize(Str s) + { + r := Regex <|[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)|> + m := r.matcher(s) + tokens := Str[,] + while (m.find()) + { + token := m.group(1) + if (token.isEmpty || token[0] == ';') continue + tokens.add(m.group(1)) + } + return tokens + } + + private static Str unescape_str(Str s) + { + return s.replace("\\\\", "\u029e").replace("\\\"", "\"").replace("\\n", "\n").replace("\u029e", "\\") + } + + private static MalVal read_atom(TokenReader reader) + { + token := reader.next + intRegex := Regex <|^-?\d+$|> + strRegex := Regex <|^"(?:\\.|[^\\"])*"|> + strBadRegex := Regex <|^".*|> + if (token == "nil") return MalNil.INSTANCE + if (token == "true") return MalTrue.INSTANCE + if (token == "false") return MalFalse.INSTANCE + if (intRegex.matches(token)) return MalInteger(token.toInt) + if (strRegex.matches(token)) return MalString.make(unescape_str(token[1..-2])) + if (strBadRegex.matches(token)) throw Err("expected '\"', got EOF") + if (token[0] == '"') return MalString.make(unescape_str(token[1..-2])) + if (token[0] == ':') return MalString.makeKeyword(token[1..-1]) + return MalSymbol(token) + } + + private static MalVal[] read_seq(TokenReader reader, Str open, Str close) + { + reader.next + values := MalVal[,] + token := reader.peek + while (token != close) + { + if (token == null) throw Err("expected '$close', got EOF") + values.add(read_form(reader)) + token = reader.peek + } + if (token != close) throw Err("Missing '$close'") + reader.next + return values + } + + private static MalVal read_form(TokenReader reader) + { + switch (reader.peek) + { + case "\'": + reader.next + return MalList([MalSymbol("quote"), read_form(reader)]) + case "`": + reader.next + return MalList([MalSymbol("quasiquote"), read_form(reader)]) + case "~": + reader.next + return MalList([MalSymbol("unquote"), read_form(reader)]) + case "~@": + reader.next + return MalList([MalSymbol("splice-unquote"), read_form(reader)]) + case "^": + reader.next + meta := read_form(reader) + return MalList([MalSymbol("with-meta"), read_form(reader), meta]) + case "@": + reader.next + return MalList([MalSymbol("deref"), read_form(reader)]) + case "(": return MalList(read_seq(reader, "(", ")")) + case ")": throw Err("unexpected ')'") + case "[": return MalVector(read_seq(reader, "[", "]")) + case "]": throw Err("unexpected ']'") + case "{": return MalHashMap.fromList(read_seq(reader, "{", "}")) + case "}": throw Err("unexpected '}'") + default: return read_atom(reader) + } + } + + static MalVal read_str(Str s) + { + return read_form(TokenReader(tokenize(s))); + } +} diff --git a/impls/fantom/src/mallib/fan/types.fan b/impls/fantom/src/mallib/fan/types.fan new file mode 100644 index 0000000000..936070e99b --- /dev/null +++ b/impls/fantom/src/mallib/fan/types.fan @@ -0,0 +1,234 @@ +mixin MalVal +{ + virtual Str toString(Bool readable) { return toStr } + virtual Int count() { throw Err("count not implemented") } + virtual MalVal seq() { throw Err("seq not implemented") } + abstract MalVal meta() + abstract MalVal with_meta(MalVal newMeta) +} + +const mixin MalValNoMeta : MalVal +{ + override MalVal meta() { return MalNil.INSTANCE } + override MalVal with_meta(MalVal newMeta) { return this } +} + +const mixin MalFalseyVal +{ +} + +const class MalNil : MalValNoMeta, MalFalseyVal +{ + static const MalNil INSTANCE := MalNil() + override Bool equals(Obj? that) { return that is MalNil } + override Str toString(Bool readable) { return "nil" } + override Int count() { return 0 } + override MalVal seq() { return this } +} + +const class MalTrue : MalValNoMeta +{ + static const MalTrue INSTANCE := MalTrue() + override Bool equals(Obj? that) { return that is MalTrue } + override Str toString(Bool readable) { return "true" } +} + +const class MalFalse : MalValNoMeta, MalFalseyVal +{ + static const MalFalse INSTANCE := MalFalse() + override Bool equals(Obj? that) { return that is MalFalse } + override Str toString(Bool readable) { return "false" } +} + +const class MalInteger : MalValNoMeta +{ + const Int value + new make(Int v) { value = v } + override Bool equals(Obj? that) { return that is MalInteger && (that as MalInteger).value == value } + override Str toString(Bool readable) { return value.toStr } +} + +abstract class MalValBase : MalVal +{ + private MalVal? metaVal := null + override Str toString(Bool readable) { return toStr } + override Int count() { throw Err("count not implemented") } + override MalVal seq() { throw Err("seq not implemented") } + abstract This dup() + override MalVal meta() { return metaVal ?: MalNil.INSTANCE } + override MalVal with_meta(MalVal newMeta) + { + v := dup + v.metaVal = newMeta + return v + } +} + +class MalSymbol : MalValBase +{ + const Str value + new make(Str v) { value = v } + new makeFromVal(MalVal v) + { + if (v is MalSymbol) return v + value = (v as MalString).value + } + override Bool equals(Obj? that) { return that is MalSymbol && (that as MalSymbol).value == value } + override Str toString(Bool readable) { return value } + override This dup() { return make(value) } +} + +class MalString : MalValBase +{ + const Str value + new make(Str v) { value = v } + new makeKeyword(Str v) { value = v[0] == '\u029e' ? v : "\u029e$v" } + override Bool equals(Obj? that) { return that is MalString && (that as MalString).value == value } + override Str toString(Bool readable) + { + if (isKeyword) return ":${value[1..-1]}" + if (readable) + return "\"${escapeStr(value)}\"" + else + return value + } + Bool isKeyword() { return !value.isEmpty && value[0] == '\u029e' } + static Str escapeStr(Str s) + { + return s.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") + } + override MalVal seq() + { + if (value.size == 0) return MalNil.INSTANCE + return MalList(value.chars.map |Int c -> MalString| { MalString.make(Str.fromChars([c])) }) + } + override This dup() { return make(value) } +} + +abstract class MalSeq : MalValBase +{ + MalVal[] value { protected set } + new make(MalVal[] v) { value = v.ro } + override Bool equals(Obj? that) { return that is MalSeq && (that as MalSeq).value == value } + Bool isEmpty() { return value.isEmpty } + override Int count() { return value.size } + @Operator MalVal get(Int index) { return value[index] } + @Operator MalVal[] getRange(Range range) { return value[range] } + protected Str serialize(Bool readable) { return value.join(" ") { it.toString(readable) } } + abstract MalSeq drop(Int n) + MalVal nth(Int index) { return index < count ? get(index) : throw Err("nth: index out of range") } + MalVal first() { return isEmpty ? MalNil.INSTANCE : value[0] } + MalList rest() { return MalList(isEmpty ? [,] : value[1..-1]) } + MalList map(MalFunc f) { return MalList(value.map |MalVal v -> MalVal| { f.call([v]) } ) } + abstract MalSeq conj(MalVal[] args) +} + +class MalList : MalSeq +{ + new make(MalVal[] v) : super.make(v) {} + override Str toString(Bool readable) { return "(${serialize(readable)})" } + override MalList drop(Int n) { return make(value[n..-1]) } + override MalVal seq() { return isEmpty ? MalNil.INSTANCE : this } + override MalList conj(MalVal[] args) { return MalList(value.rw.insertAll(0, args.reverse)) } + override This dup() { return make(value) } +} + +class MalVector : MalSeq +{ + new make(MalVal[] v) : super.make(v) {} + override Str toString(Bool readable) { return "[${serialize(readable)}]" } + override MalVector drop(Int n) { return make(value[n..-1]) } + override MalVal seq() { return isEmpty ? MalNil.INSTANCE : MalList(value) } + override MalVector conj(MalVal[] args) { return MalVector(value.rw.addAll(args)) } + override This dup() { return make(value) } +} + +class MalHashMap : MalValBase +{ + Str:MalVal value { private set } + new fromList(MalVal[] lst) { + m := [Str:MalVal][:] + for (i := 0; i < lst.size; i += 2) + m.add((lst[i] as MalString).value, (MalVal)lst[i + 1]) + value = m.ro + } + new fromMap(Str:MalVal m) { value = m.ro } + override Bool equals(Obj? that) { return that is MalHashMap && (that as MalHashMap).value == value } + override Str toString(Bool readable) + { + elements := Str[,] + value.each(|MalVal v, Str k| { elements.add(MalString.make(k).toString(readable)); elements.add(v.toString(readable)) }) + s := elements.join(" ") + return "{$s}" + } + override Int count() { return value.size } + @Operator MalVal get(Str key) { return value[key] } + MalVal get2(MalString key, MalVal? def := null) { return value.get(key.value, def) } + Bool containsKey(MalString key) { return value.containsKey(key.value) } + MalVal[] keys() { return value.keys.map |Str k -> MalVal| { MalString.make(k) } } + MalVal[] vals() { return value.vals } + MalHashMap assoc(MalVal[] args) + { + newValue := value.dup + for (i := 0; i < args.size; i += 2) + newValue.set((args[i] as MalString).value, args[i + 1]) + return fromMap(newValue) + } + MalHashMap dissoc(MalVal[] args) + { + newValue := value.dup + args.each { newValue.remove((it as MalString).value) } + return fromMap(newValue) + } + override This dup() { return fromMap(value) } +} + +class MalFunc : MalValBase +{ + protected |MalVal[] a -> MalVal| f + new make(|MalVal[] a -> MalVal| func) { f = func } + MalVal call(MalVal[] a) { return f(a) } + override Str toString(Bool readable) { return "" } + override This dup() { return make(f) } +} + +class MalUserFunc : MalFunc +{ + MalVal ast { private set } + private MalEnv env + private MalSeq params + Bool isMacro := false + new make(MalVal ast, MalEnv env, MalSeq params, |MalVal[] a -> MalVal| func, Bool isMacro := false) : super.make(func) + { + this.ast = ast + this.env = env + this.params = params + this.isMacro = isMacro + } + MalEnv genEnv(MalSeq args) { return MalEnv(env, params, args) } + override Str toString(Bool readable) { return "" } + override This dup() { return make(ast, env, params, f, isMacro) } +} + +class MalAtom : MalValBase +{ + MalVal value + new make(MalVal v) { value = v } + override Str toString(Bool readable) { return "(atom ${value.toString(readable)})" } + override Bool equals(Obj? that) { return that is MalAtom && (that as MalAtom).value == value } + MalVal set(MalVal v) { value = v; return value } + override This dup() { return make(value) } +} + +class MalTypes +{ + static MalVal toMalBool(Bool cond) { return cond ? MalTrue.INSTANCE : MalFalse.INSTANCE } + static Bool isPair(MalVal a) { return a is MalSeq && !(a as MalSeq).isEmpty } +} + +const class MalException : Err +{ + const Str serializedValue + new make(MalVal v) : super.make("Mal exception") { serializedValue = v.toString(true) } + MalVal getValue() { return Reader.read_str(serializedValue) } +} diff --git a/impls/fantom/src/step0_repl/build.fan b/impls/fantom/src/step0_repl/build.fan new file mode 100644 index 0000000000..e16a2a3f8c --- /dev/null +++ b/impls/fantom/src/step0_repl/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step0_repl" + summary = "mal step0_repl pod" + depends = ["sys 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step0_repl/fan/main.fan b/impls/fantom/src/step0_repl/fan/main.fan new file mode 100644 index 0000000000..efccdebd02 --- /dev/null +++ b/impls/fantom/src/step0_repl/fan/main.fan @@ -0,0 +1,32 @@ +class Main +{ + static Str READ(Str s) + { + return s + } + + static Str EVAL(Str ast, Str env) + { + return ast + } + + static Str PRINT(Str exp) + { + return exp + } + + static Str REP(Str s, Str env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main() + { + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + echo(REP(line, "")) + } + } +} diff --git a/impls/fantom/src/step1_read_print/build.fan b/impls/fantom/src/step1_read_print/build.fan new file mode 100644 index 0000000000..3bb399898f --- /dev/null +++ b/impls/fantom/src/step1_read_print/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step1_read_print" + summary = "mal step1_read_print pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step1_read_print/fan/main.fan b/impls/fantom/src/step1_read_print/fan/main.fan new file mode 100644 index 0000000000..5e6f27d95a --- /dev/null +++ b/impls/fantom/src/step1_read_print/fan/main.fan @@ -0,0 +1,37 @@ +using mallib + +class Main +{ + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static MalVal EVAL(MalVal ast, Str env) + { + return ast + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, Str env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main() + { + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, "")) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step2_eval/build.fan b/impls/fantom/src/step2_eval/build.fan new file mode 100644 index 0000000000..792a7f722e --- /dev/null +++ b/impls/fantom/src/step2_eval/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step2_eval" + summary = "mal step2_eval pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step2_eval/fan/main.fan b/impls/fantom/src/step2_eval/fan/main.fan new file mode 100644 index 0000000000..f7cd34d5c6 --- /dev/null +++ b/impls/fantom/src/step2_eval/fan/main.fan @@ -0,0 +1,66 @@ +using mallib + +class Main +{ + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static MalVal EVAL(MalVal ast, Str:MalVal env) + { + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env[varName] ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + + f := EVAL(astList[0], env) + args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } + + malfunc := f as MalFunc + return malfunc.call(args) + + default: + return ast + } + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, Str:MalVal env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main() + { + repl_env := [ + "+": MalFunc { MalInteger((it[0] as MalInteger).value + (it[1] as MalInteger).value) }, + "-": MalFunc { MalInteger((it[0] as MalInteger).value - (it[1] as MalInteger).value) }, + "*": MalFunc { MalInteger((it[0] as MalInteger).value * (it[1] as MalInteger).value) }, + "/": MalFunc { MalInteger((it[0] as MalInteger).value / (it[1] as MalInteger).value) } + ] + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step3_env/build.fan b/impls/fantom/src/step3_env/build.fan new file mode 100644 index 0000000000..598092fb24 --- /dev/null +++ b/impls/fantom/src/step3_env/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step3_env" + summary = "mal step3_env pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step3_env/fan/main.fan b/impls/fantom/src/step3_env/fan/main.fan new file mode 100644 index 0000000000..e15936c846 --- /dev/null +++ b/impls/fantom/src/step3_env/fan/main.fan @@ -0,0 +1,85 @@ +using mallib + +class Main +{ + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + return EVAL(astList[2], let_env) + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } + + malfunc := f as MalFunc + return malfunc.call(args) + + } + default: + return ast + } + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main() + { + repl_env := MalEnv() + repl_env.set(MalSymbol("+"), MalFunc { MalInteger((it[0] as MalInteger).value + (it[1] as MalInteger).value) }) + repl_env.set(MalSymbol("-"), MalFunc { MalInteger((it[0] as MalInteger).value - (it[1] as MalInteger).value) }) + repl_env.set(MalSymbol("*"), MalFunc { MalInteger((it[0] as MalInteger).value * (it[1] as MalInteger).value) }) + repl_env.set(MalSymbol("/"), MalFunc { MalInteger((it[0] as MalInteger).value / (it[1] as MalInteger).value) }) + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step4_if_fn_do/build.fan b/impls/fantom/src/step4_if_fn_do/build.fan new file mode 100644 index 0000000000..7cf25b342b --- /dev/null +++ b/impls/fantom/src/step4_if_fn_do/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step4_if_fn_do" + summary = "mal step4_if_fn_do pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step4_if_fn_do/fan/main.fan b/impls/fantom/src/step4_if_fn_do/fan/main.fan new file mode 100644 index 0000000000..e5cdb14442 --- /dev/null +++ b/impls/fantom/src/step4_if_fn_do/fan/main.fan @@ -0,0 +1,102 @@ +using mallib + +class Main +{ + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + return EVAL(astList[2], let_env) + case "do": + for (i:=1; i 3 ? EVAL(astList[3], env) : MalNil.INSTANCE + else + return EVAL(astList[2], env) + case "fn*": + return MalFunc { EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(it))) } + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } + switch (f.typeof) + { + case MalFunc#: + malfunc := f as MalFunc + return malfunc.call(args) + default: + throw Err("Unknown type") + } + } + default: + return ast + } + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main() + { + repl_env := MalEnv() + // core.fan: defined using Fantom + Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step5_tco/build.fan b/impls/fantom/src/step5_tco/build.fan new file mode 100644 index 0000000000..d96402c8ba --- /dev/null +++ b/impls/fantom/src/step5_tco/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step5_tco" + summary = "mal step5_tco pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step5_tco/fan/main.fan b/impls/fantom/src/step5_tco/fan/main.fan new file mode 100644 index 0000000000..e5c402b86d --- /dev/null +++ b/impls/fantom/src/step5_tco/fan/main.fan @@ -0,0 +1,119 @@ +using mallib + +class Main +{ + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + while (true) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + env = let_env + ast = astList[2] + // TCO + case "do": + for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE + else + ast = astList[2] + // TCO + case "fn*": + f := |MalVal[] a -> MalVal| + { + return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) + } + return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } + switch (f.typeof) + { + case MalUserFunc#: + user_fn := f as MalUserFunc + ast = user_fn.ast + env = user_fn.genEnv(MalList(args)) + // TCO + case MalFunc#: + malfunc := f as MalFunc + return malfunc.call(args) + default: + throw Err("Unknown type") + } + } + default: + return ast + } + } + return MalNil.INSTANCE // never reached + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main() + { + repl_env := MalEnv() + // core.fan: defined using Fantom + Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step6_file/build.fan b/impls/fantom/src/step6_file/build.fan new file mode 100644 index 0000000000..93e255f5f1 --- /dev/null +++ b/impls/fantom/src/step6_file/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step6_file" + summary = "mal step6_file pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step6_file/fan/main.fan b/impls/fantom/src/step6_file/fan/main.fan new file mode 100644 index 0000000000..5a0ecc74bd --- /dev/null +++ b/impls/fantom/src/step6_file/fan/main.fan @@ -0,0 +1,128 @@ +using mallib + +class Main +{ + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + while (true) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + env = let_env + ast = astList[2] + // TCO + case "do": + for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE + else + ast = astList[2] + // TCO + case "fn*": + f := |MalVal[] a -> MalVal| + { + return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) + } + return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } + switch (f.typeof) + { + case MalUserFunc#: + user_fn := f as MalUserFunc + ast = user_fn.ast + env = user_fn.genEnv(MalList(args)) + // TCO + case MalFunc#: + malfunc := f as MalFunc + return malfunc.call(args) + default: + throw Err("Unknown type") + } + } + default: + return ast + } + } + return MalNil.INSTANCE // never reached + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main(Str[] args) + { + repl_env := MalEnv() + // core.fan: defined using Fantom + Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } + repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) + repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + + if (!args.isEmpty) + { + REP("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step7_quote/build.fan b/impls/fantom/src/step7_quote/build.fan new file mode 100644 index 0000000000..a32dfca1f9 --- /dev/null +++ b/impls/fantom/src/step7_quote/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step7_quote" + summary = "mal step7_quote pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step7_quote/fan/main.fan b/impls/fantom/src/step7_quote/fan/main.fan new file mode 100644 index 0000000000..e13c33efc8 --- /dev/null +++ b/impls/fantom/src/step7_quote/fan/main.fan @@ -0,0 +1,172 @@ +using mallib + +class Main +{ + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + + static MalVal quasiquote(MalVal ast) + { + switch (ast.typeof) + { + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast + } + } + + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + while (true) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + env = let_env + ast = astList[2] + // TCO + case "quote": + return astList[1] + case "quasiquote": + ast = quasiquote(astList[1]) + // TCO + case "do": + for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE + else + ast = astList[2] + // TCO + case "fn*": + f := |MalVal[] a -> MalVal| + { + return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) + } + return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } + switch (f.typeof) + { + case MalUserFunc#: + user_fn := f as MalUserFunc + ast = user_fn.ast + env = user_fn.genEnv(MalList(args)) + // TCO + case MalFunc#: + malfunc := f as MalFunc + return malfunc.call(args) + default: + throw Err("Unknown type") + } + } + default: + return ast + } + } + return MalNil.INSTANCE // never reached + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main(Str[] args) + { + repl_env := MalEnv() + // core.fan: defined using Fantom + Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } + repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) + repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + + if (!args.isEmpty) + { + REP("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step8_macros/build.fan b/impls/fantom/src/step8_macros/build.fan new file mode 100644 index 0000000000..d6333c9854 --- /dev/null +++ b/impls/fantom/src/step8_macros/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step8_macros" + summary = "mal step8_macros pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step8_macros/fan/main.fan b/impls/fantom/src/step8_macros/fan/main.fan new file mode 100644 index 0000000000..6a9d9b9e08 --- /dev/null +++ b/impls/fantom/src/step8_macros/fan/main.fan @@ -0,0 +1,183 @@ +using mallib + +class Main +{ + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + + static MalVal quasiquote(MalVal ast) + { + switch (ast.typeof) + { + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast + } + } + + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + while (true) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + env = let_env + ast = astList[2] + // TCO + case "quote": + return astList[1] + case "quasiquote": + ast = quasiquote(astList[1]) + // TCO + case "defmacro!": + f := (EVAL(astList[2], env) as MalUserFunc).dup + f.isMacro = true + return env.set(astList[1], f) + case "do": + for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE + else + ast = astList[2] + // TCO + case "fn*": + f := |MalVal[] a -> MalVal| + { + return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) + } + return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1] + switch (f.typeof) + { + case MalUserFunc#: + user_fn := f as MalUserFunc + if (user_fn.isMacro) { + ast = user_fn.call(args) + continue // TCO + } + args = args.map |MalVal v -> MalVal| { EVAL(v, env) } + ast = user_fn.ast + env = user_fn.genEnv(MalList(args)) + // TCO + case MalFunc#: + malfunc := f as MalFunc + args = args.map |MalVal v -> MalVal| { EVAL(v, env) } + return malfunc.call(args) + default: + throw Err("Unknown type") + } + } + default: + return ast + } + } + return MalNil.INSTANCE // never reached + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main(Str[] args) + { + repl_env := MalEnv() + // core.fan: defined using Fantom + Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } + repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) + repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if (!args.isEmpty) + { + REP("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/step9_try/build.fan b/impls/fantom/src/step9_try/build.fan new file mode 100644 index 0000000000..8d3b048052 --- /dev/null +++ b/impls/fantom/src/step9_try/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "step9_try" + summary = "mal step9_try pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/step9_try/fan/main.fan b/impls/fantom/src/step9_try/fan/main.fan new file mode 100644 index 0000000000..4818a8cc78 --- /dev/null +++ b/impls/fantom/src/step9_try/fan/main.fan @@ -0,0 +1,197 @@ +using mallib + +class Main +{ + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + + static MalVal quasiquote(MalVal ast) + { + switch (ast.typeof) + { + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast + } + } + + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + while (true) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + env = let_env + ast = astList[2] + // TCO + case "quote": + return astList[1] + case "quasiquote": + ast = quasiquote(astList[1]) + // TCO + case "defmacro!": + f := (EVAL(astList[2], env) as MalUserFunc).dup + f.isMacro = true + return env.set(astList[1], f) + case "try*": + if (astList.count < 3) + return EVAL(astList[1], env) + MalVal exc := MalNil.INSTANCE + try + return EVAL(astList[1], env) + catch (MalException e) + exc = e.getValue + catch (Err e) + exc = MalString.make(e.msg) + catchClause := astList[2] as MalList + return EVAL(catchClause[2], MalEnv(env, MalList([catchClause[1]]), MalList([exc]))) + case "do": + for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE + else + ast = astList[2] + // TCO + case "fn*": + f := |MalVal[] a -> MalVal| + { + return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) + } + return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1] + switch (f.typeof) + { + case MalUserFunc#: + user_fn := f as MalUserFunc + if (user_fn.isMacro) { + ast = user_fn.call(args) + continue // TCO + } + args = args.map |MalVal v -> MalVal| { EVAL(v, env) } + ast = user_fn.ast + env = user_fn.genEnv(MalList(args)) + // TCO + case MalFunc#: + malfunc := f as MalFunc + args = args.map |MalVal v -> MalVal| { EVAL(v, env) } + return malfunc.call(args) + default: + throw Err("Unknown type") + } + } + default: + return ast + } + } + return MalNil.INSTANCE // never reached + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main(Str[] args) + { + repl_env := MalEnv() + // core.fan: defined using Fantom + Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } + repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) + repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if (!args.isEmpty) + { + REP("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (MalException e) + echo("Error: ${e.serializedValue}") + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/src/stepA_mal/build.fan b/impls/fantom/src/stepA_mal/build.fan new file mode 100644 index 0000000000..a4c40d7f57 --- /dev/null +++ b/impls/fantom/src/stepA_mal/build.fan @@ -0,0 +1,11 @@ +class Build : build::BuildPod +{ + new make() + { + podName = "stepA_mal" + summary = "mal stepA_mal pod" + depends = ["sys 1.0", "mallib 1.0"] + srcDirs = [`fan/`] + outPodDir = `lib/fan/` + } +} diff --git a/impls/fantom/src/stepA_mal/fan/main.fan b/impls/fantom/src/stepA_mal/fan/main.fan new file mode 100644 index 0000000000..bb0baa48f6 --- /dev/null +++ b/impls/fantom/src/stepA_mal/fan/main.fan @@ -0,0 +1,199 @@ +using mallib + +class Main +{ + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + + static MalVal quasiquote(MalVal ast) + { + switch (ast.typeof) + { + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast + } + } + + static MalVal READ(Str s) + { + return Reader.read_str(s) + } + + static Void debug_eval(MalVal ast, MalEnv env) + { + value := env.get("DEBUG-EVAL") + if ((value != null) && !(value is MalFalseyVal)) + echo("EVAL: ${PRINT(ast)}") + } + + static MalVal EVAL(MalVal ast, MalEnv env) + { + while (true) + { + debug_eval(ast, env) + switch (ast.typeof) + { + case MalSymbol#: + varName := (ast as MalSymbol).value + return env.get(varName) ?: throw Err("'$varName' not found") + case MalVector#: + newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalVector(newElements) + case MalHashMap#: + newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } + return MalHashMap.fromMap(newElements) + case MalList#: + astList := ast as MalList + if (astList.isEmpty) return ast + switch ((astList[0] as MalSymbol)?.value) + { + case "def!": + value := EVAL(astList[2], env) + return env.set(astList[1], value) + case "let*": + let_env := MalEnv(env) + varList := astList[1] as MalSeq + for (i := 0; i < varList.count; i += 2) + let_env.set(varList[i], EVAL(varList[i + 1], let_env)) + env = let_env + ast = astList[2] + // TCO + case "quote": + return astList[1] + case "quasiquote": + ast = quasiquote(astList[1]) + // TCO + case "defmacro!": + f := (EVAL(astList[2], env) as MalUserFunc).dup + f.isMacro = true + return env.set(astList[1], f) + case "try*": + if (astList.count < 3) + return EVAL(astList[1], env) + MalVal exc := MalNil.INSTANCE + try + return EVAL(astList[1], env) + catch (MalException e) + exc = e.getValue + catch (Err e) + exc = MalString.make(e.msg) + catchClause := astList[2] as MalList + return EVAL(catchClause[2], MalEnv(env, MalList([catchClause[1]]), MalList([exc]))) + case "do": + for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE + else + ast = astList[2] + // TCO + case "fn*": + f := |MalVal[] a -> MalVal| + { + return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) + } + return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) + default: + f := EVAL(astList[0], env) + args := astList.value[1..-1] + switch (f.typeof) + { + case MalUserFunc#: + user_fn := f as MalUserFunc + if (user_fn.isMacro) { + ast = user_fn.call(args) + continue // TCO + } + args = args.map |MalVal v -> MalVal| { EVAL(v, env) } + ast = user_fn.ast + env = user_fn.genEnv(MalList(args)) + // TCO + case MalFunc#: + malfunc := f as MalFunc + args = args.map |MalVal v -> MalVal| { EVAL(v, env) } + return malfunc.call(args) + default: + throw Err("Unknown type") + } + } + default: + return ast + } + } + return MalNil.INSTANCE // never reached + } + + static Str PRINT(MalVal exp) + { + return exp.toString(true) + } + + static Str REP(Str s, MalEnv env) + { + return PRINT(EVAL(READ(s), env)) + } + + static Void main(Str[] args) + { + repl_env := MalEnv() + // core.fan: defined using Fantom + Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } + repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) + repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) + + // core.mal: defined using the language itself + REP("(def! *host-language* \"fantom\")", repl_env) + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if (!args.isEmpty) + { + REP("(load-file \"${args[0]}\")", repl_env) + return + } + + REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) + while (true) { + line := Env.cur.prompt("user> ") + if (line == null) break + if (line.isSpace) continue + try + echo(REP(line, repl_env)) + catch (MalException e) + echo("Error: ${e.serializedValue}") + catch (Err e) + echo("Error: $e.msg") + } + } +} diff --git a/impls/fantom/tests/step5_tco.mal b/impls/fantom/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/fantom/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/fantom/tests/stepA_mal.mal b/impls/fantom/tests/stepA_mal.mal new file mode 100644 index 0000000000..6867ab0e4d --- /dev/null +++ b/impls/fantom/tests/stepA_mal.mal @@ -0,0 +1,38 @@ +;; Testing basic fantom interop + +(fantom-eval "7") +;=>7 + +(fantom-eval "return 3 * 9") +;=>27 + +(fantom-eval "\"7\"") +;=>"7" + +(fantom-eval "\"abcd\".upper") +;=>"ABCD" + +(fantom-eval "[7,8,9]") +;=>(7 8 9) + +(= () (fantom-eval "[,]")) +;=>true + +(fantom-eval "[\"abc\": 789]") +;=>{"abc" 789} + +(= {} (fantom-eval "[:]")) +;=>true + +(fantom-eval "echo(\"hello\")") +;/hello +;=>nil + +(fantom-eval "[\"a\",\"b\",\"c\"].join(\" \") { \"X${it}Y\" }") +;=>"XaY XbY XcY" + +(fantom-eval "[1,2,3].map { 1 + it }") +;=>(2 3 4) + +(fantom-eval "Env.cur.runtime") +;=>"java" diff --git a/impls/fennel/Dockerfile b/impls/fennel/Dockerfile new file mode 100644 index 0000000000..7ad459e49f --- /dev/null +++ b/impls/fennel/Dockerfile @@ -0,0 +1,52 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +ENV DEBIAN_FRONTEND=noninteractive + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# fennel + +RUN apt-get -y install gcc wget unzip libpcre3-dev + +# lua +RUN \ +wget http://www.lua.org/ftp/lua-5.4.1.tar.gz && \ +tar -zxf lua-5.4.1.tar.gz && \ +cd lua-5.4.1 && \ +make linux test && \ +make install + +# luarocks +RUN \ +wget https://luarocks.org/releases/luarocks-3.3.1.tar.gz && \ +tar zxpf luarocks-3.3.1.tar.gz && \ +cd luarocks-3.3.1 && \ +./configure && \ +make && \ +make install + +# fennel, lpeg +RUN luarocks install fennel +RUN luarocks install lpeg + +# luarocks .cache directory is relative to HOME +ENV HOME /mal \ No newline at end of file diff --git a/impls/fennel/Makefile b/impls/fennel/Makefile new file mode 100644 index 0000000000..8a7cbb717e --- /dev/null +++ b/impls/fennel/Makefile @@ -0,0 +1,2 @@ +all: + true diff --git a/impls/fennel/core.fnl b/impls/fennel/core.fnl new file mode 100644 index 0000000000..c46b67865c --- /dev/null +++ b/impls/fennel/core.fnl @@ -0,0 +1,815 @@ +(local t (require :types)) +(local u (require :utils)) +(local printer (require :printer)) +(local reader (require :reader)) +(local fennel (require :fennel)) + +(local mal-list + (t.make-fn + (fn [asts] + (t.make-list asts)))) + +(local mal-list? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "list? takes 1 argument"))) + (t.make-boolean (t.list?* (. asts 1)))))) + +(local mal-empty? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "empty? takes 1 argument"))) + (let [arg-ast (. asts 1)] + (if (t.nil?* arg-ast) + t.mal-true + (t.make-boolean (t.empty?* arg-ast))))))) + +(local mal-count + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "count takes 1 argument"))) + (let [arg-ast (. asts 1)] + (if (t.nil?* arg-ast) + (t.make-number 0) + (t.make-number (length (t.get-value arg-ast)))))))) + +(local mal-= + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "= takes 2 arguments"))) + (let [ast-1 (. asts 1) + ast-2 (. asts 2)] + (if (t.equals?* ast-1 ast-2) + t.mal-true + t.mal-false))))) + +(local mal-pr-str + (t.make-fn + (fn [asts] + (local buf []) + (when (> (length asts) 0) + (each [i ast (ipairs asts)] + (table.insert buf (printer.pr_str ast true)) + (table.insert buf " ")) + ;; remove extra space at end + (table.remove buf)) + (t.make-string (table.concat buf))))) + +(local mal-str + (t.make-fn + (fn [asts] + (local buf []) + (when (> (length asts) 0) + (each [i ast (ipairs asts)] + (table.insert buf (printer.pr_str ast false)))) + (t.make-string (table.concat buf))))) + +(local mal-prn + (t.make-fn + (fn [asts] + (local buf []) + (when (> (length asts) 0) + (each [i ast (ipairs asts)] + (table.insert buf (printer.pr_str ast true)) + (table.insert buf " ")) + ;; remove extra space at end + (table.remove buf)) + (print (table.concat buf)) + t.mal-nil))) + +(local mal-println + (t.make-fn + (fn [asts] + (local buf []) + (when (> (length asts) 0) + (each [i ast (ipairs asts)] + (table.insert buf (printer.pr_str ast false)) + (table.insert buf " ")) + ;; remove extra space at end + (table.remove buf)) + (print (table.concat buf)) + t.mal-nil))) + +(local mal-read-string + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "read-string takes 1 argument"))) + (let [res (reader.read_str (t.get-value (. asts 1)))] + (if res + res + (u.throw* (t.make-string "No code content"))))))) + +(local mal-slurp + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "slurp takes 1 argument"))) + (let [a-str (t.get-value (. asts 1))] + ;; XXX: error handling? + (with-open [f (io.open a-str)] + ;; XXX: escaping? + (t.make-string (f:read "*a"))))))) + +(local mal-atom + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "atom takes 1 argument"))) + (t.make-atom (. asts 1))))) + +(local mal-atom? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "atom? takes 1 argument"))) + (if (t.atom?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-deref + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "deref takes 1 argument"))) + (let [ast (. asts 1)] + (t.deref* ast))))) + +(local mal-reset! + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "reset! takes 2 arguments"))) + (let [atom-ast (. asts 1) + val-ast (. asts 2)] + (t.reset!* atom-ast val-ast))))) + +(local mal-swap! + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "swap! takes at least 2 arguments"))) + (let [atom-ast (. asts 1) + fn-ast (. asts 2) + args-asts (u.slice asts 3 -1) + args-tbl [(t.deref* atom-ast) (table.unpack args-asts)]] + (t.reset!* atom-ast + ((t.get-value fn-ast) args-tbl)))))) + +(local mal-cons + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "cons takes 2 arguments"))) + (let [head-ast (. asts 1) + tail-ast (. asts 2)] + (t.make-list [head-ast + (table.unpack (t.get-value tail-ast))]))))) + +(local mal-concat + (t.make-fn + (fn [asts] + (local acc []) + (for [i 1 (length asts)] + (each [j elt (ipairs (t.get-value (. asts i)))] + (table.insert acc elt))) + (t.make-list acc)))) + +(local mal-vec + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "vec takes 1 argument"))) + (let [ast (. asts 1)] + (if (t.vector?* ast) + ast + ;; + (t.list?* ast) + (t.make-vector (t.get-value ast)) + ;; + (t.nil?* ast) + (t.make-vector []) + ;; + (u.throw* (t.make-string "vec takes a vector, list, or nil"))))))) + +(local mal-nth + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "nth takes 2 arguments"))) + (let [elts (t.get-value (. asts 1)) + i (t.get-value (. asts 2))] + (if (< i (length elts)) + (. elts (+ i 1)) + (u.throw* (t.make-string (.. "Index out of range: " i)))))))) + +(local mal-first + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "first takes 1 argument"))) + (let [coll-or-nil-ast (. asts 1)] + (if (or (t.nil?* coll-or-nil-ast) + (t.empty?* coll-or-nil-ast)) + t.mal-nil + (. (t.get-value coll-or-nil-ast) 1)))))) + +(local mal-rest + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "rest takes 1 argument"))) + (let [coll-or-nil-ast (. asts 1)] + (if (or (t.nil?* coll-or-nil-ast) + (t.empty?* coll-or-nil-ast)) + (t.make-list []) + (t.make-list (u.slice (t.get-value coll-or-nil-ast) 2 -1))))))) + +(local mal-throw + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "throw takes 1 argument"))) + (u.throw* (. asts 1))))) + +;; (apply F A B [C D]) is equivalent to (F A B C D) +(local mal-apply + (t.make-fn + (fn [asts] + (let [n-asts (length asts)] + (when (< n-asts 1) + (u.throw* (t.make-string "apply takes at least 1 argument"))) + (let [the-fn (t.get-value (. asts 1))] ; e.g. F + (if (= n-asts 1) + (the-fn []) + (= n-asts 2) + (the-fn [(table.unpack (t.get-value (. asts 2)))]) + (let [args-asts (u.slice asts 2 -2) ; e.g. [A B] + last-asts (t.get-value (u.last asts)) ; e.g. [C D] + fn-args-tbl []] + (each [i elt (ipairs args-asts)] + (table.insert fn-args-tbl elt)) + (each [i elt (ipairs last-asts)] + (table.insert fn-args-tbl elt)) + (the-fn fn-args-tbl)))))))) + +(local mal-map + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "map takes at least 2 arguments"))) + (let [the-fn (t.get-value (. asts 1)) + coll (t.get-value (. asts 2))] + (t.make-list (u.map #(the-fn [$]) coll)))))) + +(local mal-nil? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "nil? takes 1 argument"))) + (if (t.nil?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-true? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "true? takes 1 argument"))) + (if (t.true?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-false? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "false? takes 1 argument"))) + (if (t.false?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-symbol? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "symbol? takes 1 argument"))) + (if (t.symbol?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-symbol + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "symbol takes 1 argument"))) + ;; XXX: check that type is string? + (t.make-symbol (t.get-value (. asts 1)))))) + +(local mal-keyword + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "keyword takes 1 argument"))) + (let [arg-ast (. asts 1)] + (if (t.keyword?* arg-ast) + arg-ast + ;; + (t.string?* arg-ast) + (t.make-keyword (.. ":" (t.get-value arg-ast))) + ;; + (u.throw* (t.make-string "Expected string"))))))) + +(local mal-keyword? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "keyword? takes 1 argument"))) + (if (t.keyword?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-vector + (t.make-fn + (fn [asts] + (t.make-vector asts)))) + +(local mal-vector? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "vector? takes 1 argument"))) + (if (t.vector?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-sequential? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "sequential? takes 1 argument"))) + (if (or (t.list?* (. asts 1)) + (t.vector?* (. asts 1))) + t.mal-true + t.mal-false)))) + +(local mal-map? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "map? takes 1 argument"))) + (if (t.hash-map?* (. asts 1)) + t.mal-true + t.mal-false)))) + +(local mal-hash-map + (t.make-fn + (fn [asts] + (when (= 1 (% (length asts) 2)) + (u.throw* (t.make-string + "hash-map takes an even number of arguments"))) + (t.make-hash-map asts)))) + +(local mal-assoc + (t.make-fn + (fn [asts] + (when (< (length asts) 3) + (u.throw* (t.make-string "assoc takes at least 3 arguments"))) + (let [head-ast (. asts 1)] + (when (not (or (t.hash-map?* head-ast) + (t.nil?* head-ast))) + (u.throw* (t.make-string + "assoc first argument should be a hash-map or nil"))) + (if (t.nil?* head-ast) + t.mal-nil + (let [item-tbl [] + kv-asts (u.slice asts 2 -1) + hash-items (t.get-value head-ast)] + (for [i 1 (/ (length hash-items) 2)] + (let [key (. hash-items (- (* 2 i) 1))] + (var idx 1) + (var found false) + (while (and (not found) + (<= idx (length kv-asts))) + (if (t.equals?* key (. kv-asts idx)) + (set found true) + (set idx (+ idx 2)))) + (if (not found) + (do + (table.insert item-tbl key) + (table.insert item-tbl (. hash-items (* 2 i)))) + (do + (table.insert item-tbl key) + (table.insert item-tbl (. kv-asts (+ idx 1))) + (table.remove kv-asts (+ idx 1)) + (table.remove kv-asts idx))))) + (each [i elt (ipairs kv-asts)] + (table.insert item-tbl elt)) + (t.make-hash-map item-tbl))))))) + +(local mal-dissoc + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "dissoc takes at least 2 arguments"))) + (let [head-ast (. asts 1)] + (when (not (or (t.hash-map?* head-ast) + (t.nil?* head-ast))) + (u.throw* (t.make-string + "dissoc first argument should be a hash-map or nil"))) + (if (t.nil?* head-ast) + t.mal-nil + (let [item-tbl [] + key-asts (u.slice asts 2 -1) + hash-items (t.get-value head-ast)] + (for [i 1 (/ (length hash-items) 2)] + (let [key (. hash-items (- (* 2 i) 1))] + (var idx 1) + (var found false) + (while (and (not found) + (<= idx (length key-asts))) + (if (t.equals?* key (. key-asts idx)) + (set found true) + (set idx (+ idx 1)))) + (when (not found) + (table.insert item-tbl key) + (table.insert item-tbl (. hash-items (* 2 i)))))) + (t.make-hash-map item-tbl))))))) + +(local mal-get + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "get takes 2 arguments"))) + (let [head-ast (. asts 1)] + (when (not (or (t.hash-map?* head-ast) + (t.nil?* head-ast))) + (u.throw* (t.make-string + "get first argument should be a hash-map or nil"))) + (if (t.nil?* head-ast) + t.mal-nil + (let [hash-items (t.get-value head-ast) + key-ast (. asts 2)] + (var idx 1) + (var found false) + (while (and (not found) + (<= idx (length hash-items))) + (if (t.equals?* key-ast (. hash-items idx)) + (set found true) + (set idx (+ idx 1)))) + (if found + (. hash-items (+ idx 1)) + t.mal-nil))))))) + +(local mal-contains? + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "contains? takes 2 arguments"))) + (let [head-ast (. asts 1)] + (when (not (or (t.hash-map?* head-ast) + (t.nil?* head-ast))) + (u.throw* (t.make-string + "contains? first argument should be a hash-map or nil"))) + (if (t.nil?* head-ast) + t.mal-nil + (let [hash-items (t.get-value head-ast) + key-ast (. asts 2)] + (var idx 1) + (var found false) + (while (and (not found) + (<= idx (length hash-items))) + (if (t.equals?* key-ast (. hash-items idx)) + (set found true) + (set idx (+ idx 1)))) + (if found + t.mal-true + t.mal-false))))))) + +(local mal-keys + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "keys takes 1 argument"))) + (let [head-ast (. asts 1)] + (when (not (or (t.hash-map?* head-ast) + (t.nil?* head-ast))) + (u.throw* (t.make-string + "keys first argument should be a hash-map or nil"))) + (if (t.nil?* head-ast) + t.mal-nil + (let [item-tbl [] + hash-items (t.get-value head-ast)] + (for [i 1 (/ (length hash-items) 2)] + (let [key (. hash-items (- (* 2 i) 1))] + (table.insert item-tbl key))) + (t.make-list item-tbl))))))) + +(local mal-vals + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "vals takes 1 argument"))) + (let [head-ast (. asts 1)] + (when (not (or (t.hash-map?* head-ast) + (t.nil?* head-ast))) + (u.throw* (t.make-string + "vals first argument should be a hash-map or nil"))) + (if (t.nil?* head-ast) + t.mal-nil + (let [item-tbl [] + hash-items (t.get-value head-ast)] + (for [i 1 (/ (length hash-items) 2)] + (let [value (. hash-items (* 2 i))] + (table.insert item-tbl value))) + (t.make-list item-tbl))))))) + +(local mal-readline + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "vals takes 1 argument"))) + (let [prompt (t.get-value (. asts 1))] + (io.write prompt) + (io.flush) + (let [input (io.read) + trimmed (string.match input "^%s*(.-)%s*$")] + (if (> (length trimmed) 0) + (t.make-string trimmed) + t.mal-nil)))))) + +(local mal-meta + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "meta takes 1 argument"))) + (let [head-ast (. asts 1)] + (if (or (t.list?* head-ast) + (t.vector?* head-ast) + (t.hash-map?* head-ast) + (t.fn?* head-ast)) + (t.get-md head-ast) + t.mal-nil))))) + +(local mal-with-meta + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "with-meta takes 2 arguments"))) + (let [target-ast (. asts 1) + meta-ast (. asts 2)] + (if (t.list?* target-ast) + (t.make-list (t.get-value target-ast) meta-ast) + ;; + (t.vector?* target-ast) + (t.make-vector (t.get-value target-ast) meta-ast) + ;; + (t.hash-map?* target-ast) + (t.make-hash-map (t.get-value target-ast) meta-ast) + ;; + (t.fn?* target-ast) + (t.clone-with-meta target-ast meta-ast) + ;; + (u.throw* + (t.make-string "Expected list, vector, hash-map, or fn"))))))) + +(local mal-string? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "string? takes 1 argument"))) + (t.make-boolean (t.string?* (. asts 1)))))) + +(local mal-number? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "number? takes 1 argument"))) + (t.make-boolean (t.number?* (. asts 1)))))) + +(local mal-fn? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "fn? takes 1 argument"))) + (let [target-ast (. asts 1)] + (if (and (t.fn?* target-ast) + (not (t.get-is-macro target-ast))) + t.mal-true + t.mal-false))))) + +(local mal-macro? + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "macro? requires 1 argument"))) + (let [the-ast (. asts 1)] + (if (t.macro?* the-ast) + t.mal-true + t.mal-false))))) + +(local mal-conj + (t.make-fn + (fn [asts] + (when (< (length asts) 2) + (u.throw* (t.make-string "conj takes at least 2 arguments"))) + (let [coll-ast (. asts 1) + item-asts (u.slice asts 2 -1)] + (if (t.nil?* coll-ast) + (t.make-list (u.reverse item-asts)) + ;; + (t.list?* coll-ast) + (t.make-list (u.concat-two (u.reverse item-asts) + (t.get-value coll-ast))) + ;; + (t.vector?* coll-ast) + (t.make-vector (u.concat-two (t.get-value coll-ast) + item-asts)) + ;; + (u.throw* (t.make-string "Expected list, vector, or nil"))))))) + +(local mal-seq + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "seq takes 1 argument"))) + (let [arg-ast (. asts 1)] + (if (t.list?* arg-ast) + (if (t.empty?* arg-ast) + t.mal-nil + arg-ast) + ;; + (t.vector?* arg-ast) + (if (t.empty?* arg-ast) + t.mal-nil + (t.make-list (t.get-value arg-ast))) + ;; + (t.string?* arg-ast) + (let [a-str (t.get-value arg-ast) + str-len (length a-str)] + (if (= str-len 0) + t.mal-nil + (do + (local str-tbl []) + (for [i 1 (length a-str)] + (table.insert str-tbl + (t.make-string (string.sub a-str i i)))) + (t.make-list str-tbl)))) + ;; + (t.nil?* arg-ast) + arg-ast + ;; + (u.throw* + (t.make-string "Expected list, vector, string, or nil"))))))) + +(local mal-time-ms + (t.make-fn + (fn [asts] + (t.make-number + (math.floor (* 1000000 (os.clock))))))) + +(fn fennel-eval* + [fennel-val] + (if (= "nil" (type fennel-val)) + t.mal-nil + (= "boolean" (type fennel-val)) + (t.make-boolean fennel-val) + (= "string" (type fennel-val)) + (t.make-string fennel-val) + (= "number" (type fennel-val)) + (t.make-number fennel-val) + (= "table" (type fennel-val)) + (t.make-list (u.map fennel-eval* fennel-val)) + (u.throw* + (t.make-string (.. "Unsupported type: " (type fennel-val)))))) + +(local mal-fennel-eval + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* (t.make-string "fennel-eval takes 1 argument"))) + (let [head-ast (. asts 1)] + (when (not (t.string?* head-ast)) + (u.throw* (t.make-string + "fennel-eval first argument should be a string"))) + (let [(ok? result) (pcall fennel.eval (t.get-value head-ast))] + (if ok? + (fennel-eval* result) + (u.throw* + (t.make-string (.. "Eval failed: " result))))))))) + +{"+" (t.make-fn (fn [asts] + (var total 0) + (each [i val (ipairs asts)] + (set total + (+ total (t.get-value val)))) + (t.make-number total))) + "-" (t.make-fn (fn [asts] + (var total 0) + (let [n-args (length asts)] + (if (= 0 n-args) + (t.make-number 0) + (= 1 n-args) + (t.make-number (- 0 (t.get-value (. asts 1)))) + (do + (set total (t.get-value (. asts 1))) + (for [idx 2 n-args] + (let [cur (t.get-value (. asts idx))] + (set total + (- total cur)))) + (t.make-number total)))))) + "*" (t.make-fn (fn [asts] + (var total 1) + (each [i val (ipairs asts)] + (set total + (* total (t.get-value val)))) + (t.make-number total))) + "/" (t.make-fn (fn [asts] + (var total 1) + (let [n-args (length asts)] + (if (= 0 n-args) + (t.make-number 1) + (= 1 n-args) + (t.make-number (/ 1 (t.get-value (. asts 1)))) + (do + (set total (t.get-value (. asts 1))) + (for [idx 2 n-args] + (let [cur (t.get-value (. asts idx))] + (set total + (/ total cur)))) + (t.make-number total)))))) + "list" mal-list + "list?" mal-list? + "empty?" mal-empty? + "count" mal-count + "=" mal-= + "<" (t.make-fn (fn [asts] + (let [val-1 (t.get-value (. asts 1)) + val-2 (t.get-value (. asts 2))] + (t.make-boolean (< val-1 val-2))))) + "<=" (t.make-fn (fn [asts] + (let [val-1 (t.get-value (. asts 1)) + val-2 (t.get-value (. asts 2))] + (t.make-boolean (<= val-1 val-2))))) + ">" (t.make-fn (fn [asts] + (let [val-1 (t.get-value (. asts 1)) + val-2 (t.get-value (. asts 2))] + (t.make-boolean (> val-1 val-2))))) + ">=" (t.make-fn (fn [asts] + (let [val-1 (t.get-value (. asts 1)) + val-2 (t.get-value (. asts 2))] + (t.make-boolean (>= val-1 val-2))))) + "pr-str" mal-pr-str + "str" mal-str + "prn" mal-prn + "println" mal-println + "read-string" mal-read-string + "slurp" mal-slurp + "atom" mal-atom + "atom?" mal-atom? + "deref" mal-deref + "reset!" mal-reset! + "swap!" mal-swap! + "cons" mal-cons + "concat" mal-concat + "vec" mal-vec + "nth" mal-nth + "first" mal-first + "rest" mal-rest + "throw" mal-throw + "apply" mal-apply + "map" mal-map + "nil?" mal-nil? + "true?" mal-true? + "false?" mal-false? + "symbol?" mal-symbol? + "symbol" mal-symbol + "keyword" mal-keyword + "keyword?" mal-keyword? + "vector" mal-vector + "vector?" mal-vector? + "sequential?" mal-sequential? + "map?" mal-map? + "hash-map" mal-hash-map + "assoc" mal-assoc + "dissoc" mal-dissoc + "get" mal-get + "contains?" mal-contains? + "keys" mal-keys + "vals" mal-vals + "readline" mal-readline + "meta" mal-meta + "with-meta" mal-with-meta + "string?" mal-string? + "number?" mal-number? + "fn?" mal-fn? + "macro?" mal-macro? + "conj" mal-conj + "seq" mal-seq + "time-ms" mal-time-ms + "fennel-eval" mal-fennel-eval +} diff --git a/impls/fennel/env.fnl b/impls/fennel/env.fnl new file mode 100644 index 0000000000..e3f601110c --- /dev/null +++ b/impls/fennel/env.fnl @@ -0,0 +1,79 @@ +(local t (require :types)) +(local u (require :utils)) + +(fn make-env + [outer binds exprs] + (local tbl {}) + (when binds + (local n-binds (length binds)) + (var found-amp false) + (var i 1) + (while (and (not found-amp) + (<= i n-binds)) + (local c-bind (. binds i)) + (if (= (t.get-value c-bind) "&") + (set found-amp true) + (set i (+ i 1)))) + (if (not found-amp) + (for [j 1 n-binds] + (tset tbl + (t.get-value (. binds j)) + (. exprs j))) + (do ; houston, there was an ampersand + (for [j 1 (- i 1)] ; things before & + (tset tbl + (t.get-value (. binds j)) + (. exprs j))) + (tset tbl ; after &, put things in a list + (t.get-value (. binds (+ i 1))) + (t.make-list (u.slice exprs i -1)))))) + {:outer outer + :data tbl}) + +(fn env-set + [env sym-ast val-ast] + (tset (. env :data) + (t.get-value sym-ast) + val-ast) + env) + +(fn env-get + [env key] + (or (. env :data key) + (let [outer (. env :outer)] + (when outer + (env-get outer key))))) + +(comment + + (local test-env (make-env {})) + + (env-set test-env + (t.make-symbol "fun") + (t.make-number 1)) + + (env-get test-env (t.make-symbol "fun")) + + (local test-env-2 (make-env nil)) + + (env-set test-env-2 + (t.make-symbol "smile") + (t.make-keyword ":yay")) + + (env-get test-env-2 (t.make-symbol "smile")) + + (local test-env-3 (make-env nil)) + + (env-set test-env-3 + (t.make-symbol "+") + (fn [ast-1 ast-2] + (t.make-number (+ (t.get-value ast-1) + (t.get-value ast-2))))) + + (env-get test-env-3 (t.make-symbol "+")) + + ) + +{:make-env make-env + :env-set env-set + :env-get env-get} diff --git a/impls/fennel/printer.fnl b/impls/fennel/printer.fnl new file mode 100644 index 0000000000..604ab9eaa1 --- /dev/null +++ b/impls/fennel/printer.fnl @@ -0,0 +1,92 @@ +(local t (require :types)) + +(fn escape + [a-str] + (pick-values 1 + (-> a-str + (string.gsub "\\" "\\\\") + (string.gsub "\"" "\\\"") + (string.gsub "\n" "\\n")))) + +(fn code* + [ast buf print_readably] + (let [value (t.get-value ast)] + (if (t.nil?* ast) + (table.insert buf value) + ;; + (t.boolean?* ast) + (table.insert buf (if value "true" "false")) + ;; + (t.number?* ast) + (table.insert buf (tostring value)) + ;; + (t.keyword?* ast) + (table.insert buf value) + ;; + (t.symbol?* ast) + (table.insert buf value) + ;; + (t.string?* ast) + (if print_readably + (do + (table.insert buf "\"") + (table.insert buf (escape value)) + (table.insert buf "\"")) + (table.insert buf value)) + ;; + (t.list?* ast) + (do + (table.insert buf "(") + (var remove false) + (each [idx elt (ipairs value)] + (code* elt buf print_readably) + (table.insert buf " ") + (set remove true)) + (when remove + (table.remove buf)) + (table.insert buf ")")) + ;; + (t.vector?* ast) + (do + (table.insert buf "[") + (var remove false) + (each [idx elt (ipairs value)] + (code* elt buf print_readably) + (table.insert buf " ") + (set remove true)) + (when remove + (table.remove buf)) + (table.insert buf "]")) + ;; + (t.hash-map?* ast) + (do + (table.insert buf "{") + (var remove false) + (each [idx elt (ipairs value)] + (code* elt buf print_readably) + (table.insert buf " ") + (set remove true)) + (when remove + (table.remove buf)) + (table.insert buf "}")) + ;; + (t.atom?* ast) + (do + (table.insert buf "(atom ") + (code* (t.get-value ast) buf print_readably) + (table.insert buf ")"))) + buf)) + +(fn pr_str + [ast print_readably] + (let [buf []] + (code* ast buf print_readably) + (table.concat buf))) + +(comment + + (pr_str (t.make-number 1) false) + + ) + +{:pr_str pr_str} diff --git a/impls/fennel/reader.fnl b/impls/fennel/reader.fnl new file mode 100644 index 0000000000..07fdc03aba --- /dev/null +++ b/impls/fennel/reader.fnl @@ -0,0 +1,200 @@ +(local t (require :types)) +(local u (require :utils)) + +(local lpeg (require :lpeg)) + +(local P lpeg.P) + +(local S lpeg.S) + +(local C lpeg.C) + +(local V lpeg.V) + +(local Cmt lpeg.Cmt) + +(fn unescape + [a-str] + (pick-values 1 + (-> a-str + (string.gsub "\\\\" "\u{029e}") ;; temporarily hide + (string.gsub "\\\"" "\"") + (string.gsub "\\n" "\n") + (string.gsub "\u{029e}" "\\")))) ;; now replace + +(local grammar + {1 "main" + "main" (^ (V "input") 1) + "input" (+ (V "gap") (V "form")) + "gap" (+ (V "ws") (V "comment")) + "ws" (^ (S " \f\n\r\t,") 1) + "comment" (* ";" + (^ (- (P 1) (S "\r\n")) + 0)) + "form" (+ (V "boolean") (V "nil") + (V "number") (V "keyword") (V "symbol") (V "string") + (V "list") (V "vector") (V "hash-map") + (V "deref") (V "quasiquote") (V "quote") + (V "splice-unquote") + (V "unquote") + (V "with-meta")) + "name-char" (- (P 1) + (S " \f\n\r\t,[]{}()'`~^@\";")) + "nil" (Cmt (C (* (P "nil") + (- (V "name-char")))) + (fn [s i a] + (values i t.mal-nil))) + "boolean" (Cmt (C (* (+ (P "false") (P "true")) + (- (V "name-char")))) + (fn [s i a] + (values i (if (= a "true") + t.mal-true + t.mal-false)))) + "number" (Cmt (C (^ (- (P 1) + (S " \f\n\r\t,[]{}()'`~^@\";")) + 1)) + (fn [s i a] + (let [result (tonumber a)] + (if result + (values i (t.make-number result)) + nil)))) + "keyword" (Cmt (C (* ":" + (^ (V "name-char") 0))) + (fn [s i a] + (values i (t.make-keyword a)))) + "symbol" (Cmt (^ (V "name-char") 1) + (fn [s i a] + (values i (t.make-symbol a)))) + "string" (* (P "\"") + (Cmt (C (* (^ (- (P 1) + (S "\"\\")) + 0) + (^ (* (P "\\") + (P 1) + (^ (- (P 1) + (S "\"\\")) + 0)) + 0))) + (fn [s i a] + (values i (t.make-string (unescape a))))) + (+ (P "\"") + (P (fn [s i] + (error "unbalanced \""))))) + "list" (* (P "(") + (Cmt (C (^ (V "input") 0)) + (fn [s i a ...] + (values i (t.make-list [...])))) + (+ (P ")") + (P (fn [s i] + (error "unbalanced )"))))) + "vector" (* (P "[") + (Cmt (C (^ (V "input") 0)) + (fn [s i a ...] + (values i (t.make-vector [...])))) + (+ (P "]") + (P (fn [s i] + (error "unbalanced ]"))))) + "hash-map" (* (P "{") + (Cmt (C (^ (V "input") 0)) + (fn [s i a ...] + (values i (t.make-hash-map [...])))) + (+ (P "}") + (P (fn [s i] + (error "unbalanced }"))))) + "deref" (Cmt (C (* (P "@") + (V "form"))) + (fn [s i ...] + (let [content [(t.make-symbol "deref")]] + (table.insert content (. [...] 2)) + (values i (t.make-list content))))) + "quasiquote" (Cmt (C (* (P "`") + (V "form"))) + (fn [s i ...] + (let [content [(t.make-symbol "quasiquote")]] + (table.insert content (. [...] 2)) + (values i (t.make-list content))))) + "quote" (Cmt (C (* (P "'") + (V "form"))) + (fn [s i ...] + (let [content [(t.make-symbol "quote")]] + (table.insert content (. [...] 2)) + (values i (t.make-list content))))) + "splice-unquote" (Cmt (C (* (P "~@") + (V "form"))) + (fn [s i ...] + (let [content [(t.make-symbol "splice-unquote")]] + (table.insert content (. [...] 2)) + (values i (t.make-list content))))) + "unquote" (Cmt (C (* (P "~") + (V "form"))) + (fn [s i ...] + (let [content [(t.make-symbol "unquote")]] + (table.insert content (. [...] 2)) + (values i (t.make-list content))))) + "with-meta" (Cmt (C (* (P "^") + (V "form") + (^ (V "gap") 1) + (V "form"))) + (fn [s i ...] + (let [content [(t.make-symbol "with-meta")]] + (table.insert content (. [...] 3)) + (table.insert content (. [...] 2)) + (values i (t.make-list content))))) + }) + +(comment + + (lpeg.match grammar "; hello") + + (lpeg.match grammar "nil") + + (lpeg.match grammar "true") + + (lpeg.match grammar "false") + + (lpeg.match grammar "1.2") + + (lpeg.match grammar "(+ 1 1)") + + (lpeg.match grammar "[:a :b :c]") + + (lpeg.match grammar "\"hello there\"") + + (lpeg.match grammar "\"hello\" there\"") + +) + +(fn read_str + [a-str] + (let [(ok? result) (pcall lpeg.match grammar a-str)] + (if ok? + (let [res-type (type result)] + (if (= res-type "table") + result + (u.throw* t.mal-nil))) + (u.throw* + (t.make-string result))))) + +(comment + + (read_str "; hello") + + (read_str "nil") + + (read_str "true") + + (read_str "false") + + (read_str "1.2") + + (read_str "(+ 1 1)") + + (read_str "[:a :b :c]") + + (read_str "\"hello there\"") + + (read_str "\"hello\" there\"") + + ) + +{:read_str read_str} diff --git a/impls/fennel/run b/impls/fennel/run new file mode 100755 index 0000000000..5842447c37 --- /dev/null +++ b/impls/fennel/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +exec fennel $(dirname $0)/${STEP:-stepA_mal}.fnl "${@}" diff --git a/impls/fennel/step0_repl.fnl b/impls/fennel/step0_repl.fnl new file mode 100644 index 0000000000..394c4f1c52 --- /dev/null +++ b/impls/fennel/step0_repl.fnl @@ -0,0 +1,21 @@ +(fn READ [code-str] + code-str) + +(fn EVAL [ast] + ast) + +(fn PRINT [ast] + ast) + +(fn rep [code-str] + (PRINT (EVAL (READ code-str)))) + +(var done false) + +(while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (print (rep input))))) diff --git a/impls/fennel/step1_read_print.fnl b/impls/fennel/step1_read_print.fnl new file mode 100644 index 0000000000..c2d531878c --- /dev/null +++ b/impls/fennel/step1_read_print.fnl @@ -0,0 +1,39 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn EVAL + [ast] + ast) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str)))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(var done false) + +(while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))) diff --git a/impls/fennel/step2_eval.fnl b/impls/fennel/step2_eval.fnl new file mode 100644 index 0000000000..58e3b592ed --- /dev/null +++ b/impls/fennel/step2_eval.fnl @@ -0,0 +1,75 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local u (require :utils)) + +(local repl_env + {"+" (fn [ast-1 ast-2] + (t.make-number (+ (t.get-value ast-1) + (t.get-value ast-2)))) + "-" (fn [ast-1 ast-2] + (t.make-number (- (t.get-value ast-1) + (t.get-value ast-2)))) + "*" (fn [ast-1 ast-2] + (t.make-number (* (t.get-value ast-1) + (t.get-value ast-2)))) + "/" (fn [ast-1 ast-2] + (t.make-number (/ (t.get-value ast-1) + (t.get-value ast-2))))}) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn EVAL + [ast env] + ;; (print (.. "EVAL: " (printer.pr_str ast true))) + (if (t.symbol?* ast) + (. env (t.get-value ast)) + ;; + (t.vector?* ast) + (t.make-vector (u.map (fn [elt-ast] + (EVAL elt-ast env)) + (t.get-value ast))) + ;; + (t.hash-map?* ast) + (t.make-hash-map (u.map (fn [elt-ast] + (EVAL elt-ast env)) + (t.get-value ast))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + ast + ;; + (let [eval-list (u.map (fn [x] (EVAL x env)) (t.get-value ast)) + f (u.first eval-list) + args (u.slice eval-list 2 -1)] + (f (table.unpack args))))) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(var done false) + +(while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))) + diff --git a/impls/fennel/step3_env.fnl b/impls/fennel/step3_env.fnl new file mode 100644 index 0000000000..d85dcdb400 --- /dev/null +++ b/impls/fennel/step3_env.fnl @@ -0,0 +1,107 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local u (require :utils)) + +(local repl_env + (-> (e.make-env nil) + (e.env-set (t.make-symbol "+") + (fn [ast-1 ast-2] + (t.make-number (+ (t.get-value ast-1) + (t.get-value ast-2))))) + (e.env-set (t.make-symbol "-") + (fn [ast-1 ast-2] + (t.make-number (- (t.get-value ast-1) + (t.get-value ast-2))))) + (e.env-set (t.make-symbol "*") + (fn [ast-1 ast-2] + (t.make-number (* (t.get-value ast-1) + (t.get-value ast-2))))) + (e.env-set (t.make-symbol "/") + (fn [ast-1 ast-2] + (t.make-number (/ (t.get-value ast-1) + (t.get-value ast-2))))))) + +(fn READ + [arg] + (reader.read_str arg)) + +(fn EVAL + [ast env] + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key "' not found"))))) + ;; + (t.vector?* ast) + (t.make-vector (u.map (fn [elt-ast] + (EVAL elt-ast env)) + (t.get-value ast))) + ;; + (t.hash-map?* ast) + (t.make-hash-map (u.map (fn [elt-ast] + (EVAL elt-ast env)) + (t.get-value ast))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + ast + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but that screws up logic below + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + def-val) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name (. bindings (- (* 2 idx) 1)) + b-val (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + (EVAL (. ast-elts 3) new-env)) + ;; + (let [eval-list (u.map (fn [x] (EVAL x env)) ast-elts) + f (. eval-list 1) + args (u.slice eval-list 2 -1)] + (f (table.unpack args))))))) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(var done false) + +(while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))) diff --git a/impls/fennel/step4_if_fn_do.fnl b/impls/fennel/step4_if_fn_do.fnl new file mode 100644 index 0000000000..cb65a5d0cb --- /dev/null +++ b/impls/fennel/step4_if_fn_do.fnl @@ -0,0 +1,125 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local core (require :core)) +(local u (require :utils)) + +(local repl_env + (let [env (e.make-env)] + (each [name func (pairs core)] + (e.env-set env + (t.make-symbol name) + func)) + env)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn EVAL + [ast env] + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key "' not found"))))) + ;; + (t.vector?* ast) + (t.make-vector (u.map (fn [elt-ast] + (EVAL elt-ast env)) + (t.get-value ast))) + ;; + (t.hash-map?* ast) + (t.make-hash-map (u.map (fn [elt-ast] + (EVAL elt-ast env)) + (t.get-value ast))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + ast + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but that screws up logic below + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + def-val) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name (. bindings (- (* 2 idx) 1)) + b-val (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + (EVAL (. ast-elts 3) new-env)) + ;; + (= "do" head-name) + (u.last (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1))) + ;; + (= "if" head-name) + (let [cond-res (EVAL (. ast-elts 2) env)] + (if (or (t.nil?* cond-res) + (t.false?* cond-res)) + (let [else-ast (. ast-elts 4)] + (if (not else-ast) + t.mal-nil + (EVAL else-ast env))) + (EVAL (. ast-elts 3) env))) + ;; + (= "fn*" head-name) + (let [args (t.get-value (. ast-elts 2)) + body (. ast-elts 3)] + (t.make-fn (fn [params] + (EVAL body + (e.make-env env args params))))) + ;; + (let [eval-list (u.map (fn [x] (EVAL x env)) ast-elts) + f (. eval-list 1) + args (u.slice eval-list 2 -1)] + ((t.get-value f) args)))))) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(var done false) + +(while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))) + ;; (fn [exc] + ;; (if (t.nil?* exc) + ;; (print) + ;; (= "string" (type exc)) + ;; (print exc) + ;; (print (PRINT exc)))))))) diff --git a/impls/fennel/step5_tco.fnl b/impls/fennel/step5_tco.fnl new file mode 100644 index 0000000000..d3b9701c67 --- /dev/null +++ b/impls/fennel/step5_tco.fnl @@ -0,0 +1,140 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local core (require :core)) +(local u (require :utils)) + +(local repl_env + (let [env (e.make-env)] + (each [name func (pairs core)] + (e.env-set env + (t.make-symbol name) + func)) + env)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (var result nil) + (while (not result) + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (set result (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key + "' not found")))))) + ;; + (t.vector?* ast) + (set result (t.make-vector (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (t.hash-map?* ast) + (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + (set result ast) + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but that screws up logic below + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + (set result def-val)) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name (. bindings (- (* 2 idx) 1)) + b-val (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + ;; tco + (set ast (. ast-elts 3)) + (set env new-env)) + ;; + (= "do" head-name) + (let [most-forms (u.slice ast-elts 2 -2) ;; XXX + last-body-form (u.last ast-elts) + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] + ;; tco + (set ast last-body-form)) + ;; + (= "if" head-name) + (let [cond-res (EVAL (. ast-elts 2) env)] + (if (or (t.nil?* cond-res) + (t.false?* cond-res)) + (let [else-ast (. ast-elts 4)] + (if (not else-ast) + ;; tco + (set result t.mal-nil) + (set ast else-ast))) + ;; tco + (set ast (. ast-elts 3)))) + ;; + (= "fn*" head-name) + (let [params (t.get-value (. ast-elts 2)) + body (. ast-elts 3)] + ;; tco + (set result + (t.make-fn (fn [args] + (EVAL body + (e.make-env env params args))) + body params env))) + ;; + (let [f (EVAL (. ast-elts 1) env) + args (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1)) + body (t.get-ast f)] ;; tco + (if body + (do + (set ast body) + (set env (e.make-env (t.get-env f) + (t.get-params f) args))) + (set result + ((t.get-value f) args)))))))) + result) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(var done false) + +(while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))) diff --git a/impls/fennel/step6_file.fnl b/impls/fennel/step6_file.fnl new file mode 100644 index 0000000000..4a239e4e1c --- /dev/null +++ b/impls/fennel/step6_file.fnl @@ -0,0 +1,165 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local core (require :core)) +(local u (require :utils)) + +(local repl_env + (let [env (e.make-env)] + (each [name func (pairs core)] + (e.env-set env + (t.make-symbol name) + func)) + env)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (var result nil) + (while (not result) + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (set result (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key + "' not found")))))) + ;; + (t.vector?* ast) + (set result (t.make-vector (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (t.hash-map?* ast) + (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + (set result ast) + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but that screws up logic below + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + (set result def-val)) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name (. bindings (- (* 2 idx) 1)) + b-val (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + ;; tco + (set ast (. ast-elts 3)) + (set env new-env)) + ;; + (= "do" head-name) + (let [most-forms (u.slice ast-elts 2 -2) ;; XXX + last-body-form (u.last ast-elts) + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] + ;; tco + (set ast last-body-form)) + ;; + (= "if" head-name) + (let [cond-res (EVAL (. ast-elts 2) env)] + (if (or (t.nil?* cond-res) + (t.false?* cond-res)) + (let [else-ast (. ast-elts 4)] + (if (not else-ast) + ;; tco + (set result t.mal-nil) + (set ast else-ast))) + ;; tco + (set ast (. ast-elts 3)))) + ;; + (= "fn*" head-name) + (let [params (t.get-value (. ast-elts 2)) + body (. ast-elts 3)] + ;; tco + (set result + (t.make-fn (fn [args] + (EVAL body + (e.make-env env params args))) + body params env))) + ;; + (let [f (EVAL (. ast-elts 1) env) + args (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1)) + body (t.get-ast f)] ;; tco + (if body + (do + (set ast body) + (set env (e.make-env (t.get-env f) + (t.get-params f) args))) + (set result + ((t.get-value f) args)))))))) + result) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e.env-set repl_env + (t.make-symbol "eval") + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + ;; XXX + (error "eval takes 1 arguments")) + (EVAL (u.first asts) repl_env)))) + +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(e.env-set repl_env + (t.make-symbol "*ARGV*") + (t.make-list (u.map t.make-string (u.slice arg 2)))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(if (<= 1 (length arg)) + (xpcall (fn [] + (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? + handle-error) + (do + (var done false) + (while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))))) +; (fn [exc] + ;; (if (t.nil?* exc) + ;; (print) + ;; (= "string" (type exc)) + ;; (print exc) + ;; (print (PRINT exc)))))))))) diff --git a/impls/fennel/step7_quote.fnl b/impls/fennel/step7_quote.fnl new file mode 100644 index 0000000000..a4ff7591bf --- /dev/null +++ b/impls/fennel/step7_quote.fnl @@ -0,0 +1,209 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local core (require :core)) +(local u (require :utils)) + +(local repl_env + (let [env (e.make-env)] + (each [name func (pairs core)] + (e.env-set env + (t.make-symbol name) + func)) + env)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn starts-with + [ast name] + (when (and (t.list?* ast) + (not (t.empty?* ast))) + (let [head-ast (. (t.get-value ast) 1)] + (and (t.symbol?* head-ast) + (= name (t.get-value head-ast)))))) + +(var quasiquote* nil) + +(fn qq-iter + [ast] + (if (t.empty?* ast) + (t.make-list []) + (let [ast-value (t.get-value ast) + elt (. ast-value 1) + acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] + (if (starts-with elt "splice-unquote") + (t.make-list [(t.make-symbol "concat") + (. (t.get-value elt) 2) + acc]) + (t.make-list [(t.make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(set quasiquote* + (fn [ast] + (if (starts-with ast "unquote") + (. (t.get-value ast) 2) + ;; + (t.list?* ast) + (qq-iter ast) + ;; + (t.vector?* ast) + (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) + ;; + (or (t.symbol?* ast) + (t.hash-map?* ast)) + (t.make-list [(t.make-symbol "quote") ast]) + ;; + ast))) + +(fn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (var result nil) + (while (not result) + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (set result (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key + "' not found")))))) + ;; + (t.vector?* ast) + (set result (t.make-vector (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (t.hash-map?* ast) + (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + (set result ast) + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but that screws up logic below + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + (set result def-val)) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name (. bindings (- (* 2 idx) 1)) + b-val (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + ;; tco + (set ast (. ast-elts 3)) + (set env new-env)) + ;; + (= "quote" head-name) + ;; tco + (set result (. ast-elts 2)) + ;; + (= "quasiquote" head-name) + ;; tco + (set ast (quasiquote* (. ast-elts 2))) + ;; + (= "do" head-name) + (let [most-forms (u.slice ast-elts 2 -2) ;; XXX + last-body-form (u.last ast-elts) + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] + ;; tco + (set ast last-body-form)) + ;; + (= "if" head-name) + (let [cond-res (EVAL (. ast-elts 2) env)] + (if (or (t.nil?* cond-res) + (t.false?* cond-res)) + (let [else-ast (. ast-elts 4)] + (if (not else-ast) + ;; tco + (set result t.mal-nil) + (set ast else-ast))) + ;; tco + (set ast (. ast-elts 3)))) + ;; + (= "fn*" head-name) + (let [params (t.get-value (. ast-elts 2)) + body (. ast-elts 3)] + ;; tco + (set result + (t.make-fn (fn [args] + (EVAL body + (e.make-env env params args))) + body params env))) + ;; + (let [f (EVAL (. ast-elts 1) env) + args (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1)) + body (t.get-ast f)] ;; tco + (if body + (do + (set ast body) + (set env (e.make-env (t.get-env f) + (t.get-params f) args))) + (set result + ((t.get-value f) args)))))))) + result) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e.env-set repl_env + (t.make-symbol "eval") + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + ;; XXX + (error "eval takes 1 arguments")) + (EVAL (u.first asts) repl_env)))) + +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(e.env-set repl_env + (t.make-symbol "*ARGV*") + (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(if (<= 1 (length arg)) + (xpcall (fn [] + (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? + handle-error) + (do + (var done false) + (while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))))) diff --git a/impls/fennel/step8_macros.fnl b/impls/fennel/step8_macros.fnl new file mode 100644 index 0000000000..539341b69a --- /dev/null +++ b/impls/fennel/step8_macros.fnl @@ -0,0 +1,240 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local core (require :core)) +(local u (require :utils)) + +(local repl_env + (let [env (e.make-env)] + (each [name func (pairs core)] + (e.env-set env + (t.make-symbol name) + func)) + env)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn starts-with + [ast name] + (when (and (t.list?* ast) + (not (t.empty?* ast))) + (let [head-ast (. (t.get-value ast) 1)] + (and (t.symbol?* head-ast) + (= name (t.get-value head-ast)))))) + +(var quasiquote* nil) + +(fn qq-iter + [ast] + (if (t.empty?* ast) + (t.make-list []) + (let [ast-value (t.get-value ast) + elt (. ast-value 1) + acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] + (if (starts-with elt "splice-unquote") + (t.make-list [(t.make-symbol "concat") + (. (t.get-value elt) 2) + acc]) + (t.make-list [(t.make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(set quasiquote* + (fn [ast] + (if (starts-with ast "unquote") + (. (t.get-value ast) 2) + ;; + (t.list?* ast) + (qq-iter ast) + ;; + (t.vector?* ast) + (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) + ;; + (or (t.symbol?* ast) + (t.hash-map?* ast)) + (t.make-list [(t.make-symbol "quote") ast]) + ;; + ast))) + +(fn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (var result nil) + (while (not result) + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (set result (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key + "' not found")))))) + ;; + (t.vector?* ast) + (set result (t.make-vector (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (t.hash-map?* ast) + (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + (set result ast) + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but... + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + (set result def-val)) + ;; + (= "defmacro!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env) + macro-ast (t.macrofy def-val)] + (e.env-set env + def-name macro-ast) + (set result macro-ast)) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name + (. bindings (- (* 2 idx) 1)) + b-val + (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + ;; tco + (set ast (. ast-elts 3)) + (set env new-env)) + ;; + (= "quote" head-name) + ;; tco + (set result (. ast-elts 2)) + ;; + (= "quasiquote" head-name) + ;; tco + (set ast (quasiquote* (. ast-elts 2))) + ;; + (= "do" head-name) + (let [most-forms (u.slice ast-elts 2 -2) ;; XXX + last-body-form (u.last ast-elts) + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] + ;; tco + (set ast last-body-form)) + ;; + (= "if" head-name) + (let [cond-res (EVAL (. ast-elts 2) env)] + (if (or (t.nil?* cond-res) + (t.false?* cond-res)) + (let [else-ast (. ast-elts 4)] + (if (not else-ast) + ;; tco + (set result t.mal-nil) + (set ast else-ast))) + ;; tco + (set ast (. ast-elts 3)))) + ;; + (= "fn*" head-name) + (let [params (t.get-value (. ast-elts 2)) + body (. ast-elts 3)] + ;; tco + (set result + (t.make-fn + (fn [args] + (EVAL body + (e.make-env env params args))) + body params env false))) + ;; + (let [f (EVAL (. ast-elts 1) env) + ast-rest (u.slice ast-elts 2 -1)] + (if (t.macro?* f) + (set ast ((t.get-value f) ast-rest)) + (let [args (u.map (fn [x] (EVAL x env)) ast-rest) + body (t.get-ast f)] ;; tco + (if body + (do + (set ast body) + (set env + (e.make-env (t.get-env f) + (t.get-params f) + args))) + (set result + ((t.get-value f) args)))))))))) + result) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e.env-set repl_env + (t.make-symbol "eval") + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + ;; XXX + (error "eval takes 1 arguments")) + (EVAL (u.first asts) repl_env)))) + +(rep + (.. "(def! load-file " + " (fn* (f) " + " (eval " + " (read-string " + " (str \"(do \" (slurp f) \"\nnil)\")))))")) + +(rep + (.. "(defmacro! cond " + " (fn* (& xs) " + " (if (> (count xs) 0) " + " (list 'if (first xs) " + " (if (> (count xs) 1) " + " (nth xs 1) " + " (throw \"odd number of forms to cond\")) " + " (cons 'cond (rest (rest xs)))))))")) + +(e.env-set repl_env + (t.make-symbol "*ARGV*") + (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(if (<= 1 (length arg)) + (xpcall (fn [] + (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? + handle-error) + (do + (var done false) + (while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))))) diff --git a/impls/fennel/step9_try.fnl b/impls/fennel/step9_try.fnl new file mode 100644 index 0000000000..f6b34d3f8d --- /dev/null +++ b/impls/fennel/step9_try.fnl @@ -0,0 +1,273 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local core (require :core)) +(local u (require :utils)) + +(local repl_env + (let [env (e.make-env)] + (each [name func (pairs core)] + (e.env-set env + (t.make-symbol name) + func)) + env)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn starts-with + [ast name] + (when (and (t.list?* ast) + (not (t.empty?* ast))) + (let [head-ast (. (t.get-value ast) 1)] + (and (t.symbol?* head-ast) + (= name (t.get-value head-ast)))))) + +(var quasiquote* nil) + +(fn qq-iter + [ast] + (if (t.empty?* ast) + (t.make-list []) + (let [ast-value (t.get-value ast) + elt (. ast-value 1) + acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] + (if (starts-with elt "splice-unquote") + (t.make-list [(t.make-symbol "concat") + (. (t.get-value elt) 2) + acc]) + (t.make-list [(t.make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(set quasiquote* + (fn [ast] + (if (starts-with ast "unquote") + (. (t.get-value ast) 2) + ;; + (t.list?* ast) + (qq-iter ast) + ;; + (t.vector?* ast) + (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) + ;; + (or (t.symbol?* ast) + (t.hash-map?* ast)) + (t.make-list [(t.make-symbol "quote") ast]) + ;; + ast))) + +(fn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (var result nil) + (while (not result) + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (set result (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key + "' not found")))))) + ;; + (t.vector?* ast) + (set result (t.make-vector (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (t.hash-map?* ast) + (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + (set result ast) + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but... + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + (set result def-val)) + ;; + (= "defmacro!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env) + macro-ast (t.macrofy def-val)] + (e.env-set env + def-name macro-ast) + (set result macro-ast)) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name + (. bindings (- (* 2 idx) 1)) + b-val + (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + ;; tco + (set ast (. ast-elts 3)) + (set env new-env)) + ;; + (= "quote" head-name) + ;; tco + (set result (. ast-elts 2)) + ;; + (= "quasiquote" head-name) + ;; tco + (set ast (quasiquote* (. ast-elts 2))) + ;; + (= "try*" head-name) + (set result + (let [(ok? res) + (pcall EVAL (. ast-elts 2) env)] + (if (not ok?) + (let [maybe-catch-ast (. ast-elts 3)] + (if (not maybe-catch-ast) + (u.throw* res) + (if (not (starts-with maybe-catch-ast + "catch*")) + (u.throw* + (t.make-string + "Expected catch* form")) + (let [catch-asts + (t.get-value + maybe-catch-ast)] + (if (< (length catch-asts) 2) + (u.throw* + (t.make-string + (.. "catch* requires at " + "least 2 " + "arguments"))) + (let [catch-sym-ast + (. catch-asts 2) + catch-body-ast + (. catch-asts 3)] + (EVAL catch-body-ast + (e.make-env + env + [catch-sym-ast] + [res])))))))) + res))) + ;; + (= "do" head-name) + (let [most-forms (u.slice ast-elts 2 -2) ;; XXX + last-body-form (u.last ast-elts) + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] + ;; tco + (set ast last-body-form)) + ;; + (= "if" head-name) + (let [cond-res (EVAL (. ast-elts 2) env)] + (if (or (t.nil?* cond-res) + (t.false?* cond-res)) + (let [else-ast (. ast-elts 4)] + (if (not else-ast) + ;; tco + (set result t.mal-nil) + (set ast else-ast))) + ;; tco + (set ast (. ast-elts 3)))) + ;; + (= "fn*" head-name) + (let [params (t.get-value (. ast-elts 2)) + body (. ast-elts 3)] + ;; tco + (set result + (t.make-fn + (fn [args] + (EVAL body + (e.make-env env params args))) + body params env false))) + ;; + (let [f (EVAL (. ast-elts 1) env) + ast-rest (u.slice ast-elts 2 -1)] + (if (t.macro?* f) + (set ast ((t.get-value f) ast-rest)) + (let [args (u.map (fn [x] (EVAL x env)) ast-rest) + body (t.get-ast f)] ;; tco + (if body + (do + (set ast body) + (set env + (e.make-env (t.get-env f) + (t.get-params f) + args))) + (set result + ((t.get-value f) args)))))))))) + result) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e.env-set repl_env + (t.make-symbol "eval") + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* + (t.make-string "eval takes 1 argument"))) + (EVAL (u.first asts) repl_env)))) + +(rep + (.. "(def! load-file " + " (fn* (f) " + " (eval " + " (read-string " + " (str \"(do \" (slurp f) \"\nnil)\")))))")) + +(rep + (.. "(defmacro! cond " + " (fn* (& xs) " + " (if (> (count xs) 0) " + " (list 'if (first xs) " + " (if (> (count xs) 1) " + " (nth xs 1) " + " (throw \"odd number of forms to cond\")) " + " (cons 'cond (rest (rest xs)))))))")) + +(e.env-set repl_env + (t.make-symbol "*ARGV*") + (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(if (<= 1 (length arg)) + (xpcall (fn [] + (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? + handle-error) + (do + (var done false) + (while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))))) diff --git a/impls/fennel/stepA_mal.fnl b/impls/fennel/stepA_mal.fnl new file mode 100644 index 0000000000..417328d02b --- /dev/null +++ b/impls/fennel/stepA_mal.fnl @@ -0,0 +1,278 @@ +(local printer (require :printer)) +(local reader (require :reader)) +(local t (require :types)) +(local e (require :env)) +(local core (require :core)) +(local u (require :utils)) + +(local repl_env + (let [env (e.make-env)] + (each [name func (pairs core)] + (e.env-set env + (t.make-symbol name) + func)) + env)) + +(fn READ + [code-str] + (reader.read_str code-str)) + +(fn starts-with + [ast name] + (when (and (t.list?* ast) + (not (t.empty?* ast))) + (let [head-ast (. (t.get-value ast) 1)] + (and (t.symbol?* head-ast) + (= name (t.get-value head-ast)))))) + +(var quasiquote* nil) + +(fn qq-iter + [ast] + (if (t.empty?* ast) + (t.make-list []) + (let [ast-value (t.get-value ast) + elt (. ast-value 1) + acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] + (if (starts-with elt "splice-unquote") + (t.make-list [(t.make-symbol "concat") + (. (t.get-value elt) 2) + acc]) + (t.make-list [(t.make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(set quasiquote* + (fn [ast] + (if (starts-with ast "unquote") + (. (t.get-value ast) 2) + ;; + (t.list?* ast) + (qq-iter ast) + ;; + (t.vector?* ast) + (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) + ;; + (or (t.symbol?* ast) + (t.hash-map?* ast)) + (t.make-list [(t.make-symbol "quote") ast]) + ;; + ast))) + +(fn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (var result nil) + (while (not result) + (let [dbgeval (e.env-get env "DEBUG-EVAL")] + (when (and dbgeval + (not (t.nil?* dbgeval)) + (not (t.false?* dbgeval))) + (print (.. "EVAL: " (printer.pr_str ast true))))) + (if (t.symbol?* ast) + (let [key (t.get-value ast)] + (set result (or (e.env-get env key) + (u.throw* (t.make-string (.. "'" key + "' not found")))))) + ;; + (t.vector?* ast) + (set result (t.make-vector (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (t.hash-map?* ast) + (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) + (set result ast) + ;; + (let [ast-elts (t.get-value ast) + head-name (t.get-value (. ast-elts 1))] + ;; XXX: want to check for symbol, but... + (if (= "def!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env)] + (e.env-set env + def-name def-val) + (set result def-val)) + ;; + (= "defmacro!" head-name) + (let [def-name (. ast-elts 2) + def-val (EVAL (. ast-elts 3) env) + macro-ast (t.macrofy def-val)] + (e.env-set env + def-name macro-ast) + (set result macro-ast)) + ;; + (= "let*" head-name) + (let [new-env (e.make-env env) + bindings (t.get-value (. ast-elts 2)) + stop (/ (length bindings) 2)] + (for [idx 1 stop] + (let [b-name + (. bindings (- (* 2 idx) 1)) + b-val + (EVAL (. bindings (* 2 idx)) new-env)] + (e.env-set new-env + b-name b-val))) + ;; tco + (set ast (. ast-elts 3)) + (set env new-env)) + ;; + (= "quote" head-name) + ;; tco + (set result (. ast-elts 2)) + ;; + (= "quasiquote" head-name) + ;; tco + (set ast (quasiquote* (. ast-elts 2))) + ;; + (= "try*" head-name) + (set result + (let [(ok? res) + (pcall EVAL (. ast-elts 2) env)] + (if (not ok?) + (let [maybe-catch-ast (. ast-elts 3)] + (if (not maybe-catch-ast) + (u.throw* res) + (if (not (starts-with maybe-catch-ast + "catch*")) + (u.throw* + (t.make-string + "Expected catch* form")) + (let [catch-asts + (t.get-value + maybe-catch-ast)] + (if (< (length catch-asts) 2) + (u.throw* + (t.make-string + (.. "catch* requires at " + "least 2 " + "arguments"))) + (let [catch-sym-ast + (. catch-asts 2) + catch-body-ast + (. catch-asts 3)] + (EVAL catch-body-ast + (e.make-env + env + [catch-sym-ast] + [res])))))))) + res))) + ;; + (= "do" head-name) + (let [most-forms (u.slice ast-elts 2 -2) ;; XXX + last-body-form (u.last ast-elts) + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] + ;; tco + (set ast last-body-form)) + ;; + (= "if" head-name) + (let [cond-res (EVAL (. ast-elts 2) env)] + (if (or (t.nil?* cond-res) + (t.false?* cond-res)) + (let [else-ast (. ast-elts 4)] + (if (not else-ast) + ;; tco + (set result t.mal-nil) + (set ast else-ast))) + ;; tco + (set ast (. ast-elts 3)))) + ;; + (= "fn*" head-name) + (let [params (t.get-value (. ast-elts 2)) + body (. ast-elts 3)] + ;; tco + (set result + (t.make-fn + (fn [args] + (EVAL body + (e.make-env env params args))) + body params env false nil))) + ;; + (let [f (EVAL (. ast-elts 1) env) + ast-rest (u.slice ast-elts 2 -1)] + (if (t.macro?* f) + (set ast ((t.get-value f) ast-rest)) + (let [args (u.map (fn [x] (EVAL x env)) ast-rest) + body (t.get-ast f)] ;; tco + (if body + (do + (set ast body) + (set env + (e.make-env (t.get-env f) + (t.get-params f) + args))) + (set result + ((t.get-value f) args)))))))))) + result) + +(fn PRINT + [ast] + (printer.pr_str ast true)) + +(fn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e.env-set repl_env + (t.make-symbol "eval") + (t.make-fn + (fn [asts] + (when (< (length asts) 1) + (u.throw* + (t.make-string "eval takes 1 argument"))) + (EVAL (u.first asts) repl_env)))) + +(rep + (.. "(def! load-file " + " (fn* (f) " + " (eval " + " (read-string " + " (str \"(do \" (slurp f) \"\nnil)\")))))")) + +(rep + (.. "(defmacro! cond " + " (fn* (& xs) " + " (if (> (count xs) 0) " + " (list 'if (first xs) " + " (if (> (count xs) 1) " + " (nth xs 1) " + " (throw \"odd number of forms to cond\")) " + " (cons 'cond (rest (rest xs)))))))")) + +(e.env-set repl_env + (t.make-symbol "*host-language*") + (t.make-string "fennel")) + +(e.env-set repl_env + (t.make-symbol "*ARGV*") + (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) + +(fn handle-error + [err] + (if (t.nil?* err) + (print) + (= "string" (type err)) + (print err) + (print (.. "Error: " (PRINT err))))) + +(if (<= 1 (length arg)) + (xpcall (fn [] + (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? + handle-error) + (do + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (var done false) + (while (not done) + (io.write "user> ") + (io.flush) + (let [input (io.read)] + (if (not input) + (set done true) + (xpcall (fn [] + (print (rep input))) + handle-error)))))) diff --git a/impls/fennel/types.fnl b/impls/fennel/types.fnl new file mode 100644 index 0000000000..c2831300ab --- /dev/null +++ b/impls/fennel/types.fnl @@ -0,0 +1,320 @@ +(fn make-nil + [a-str] + {:tag :nil + :content "nil"}) + +(fn make-boolean + [a-bool] + {:tag :boolean + :content a-bool}) + +(fn make-number + [a-num] + {:tag :number + :content a-num}) + +(fn make-keyword + [a-str] + {:tag :keyword + :content a-str}) + +(fn make-symbol + [a-str] + {:tag :symbol + :content a-str}) + +(fn make-string + [a-str] + {:tag :string + :content a-str}) + +(local mal-nil (make-nil)) + +(fn make-list + [elts md] + (local md (if md md mal-nil)) + {:tag :list + :content elts + :md md}) + +(fn make-vector + [elts md] + (local md (if md md mal-nil)) + {:tag :vector + :content elts + :md md}) + +(fn make-hash-map + [elts md] + (local md (if md md mal-nil)) + {:tag :hash-map + :content elts + :md md}) + +(fn make-fn + [a-fn ast params env is-macro md] + (local is-macro (if is-macro is-macro false)) + (local md (if md md mal-nil)) + {:tag :fn + :content a-fn + :ast ast + :params params + :env env + :is-macro is-macro + :md md}) + +(fn make-atom + [ast] + {:tag :atom + :content ast}) + +(local mal-true (make-boolean true)) + +(local mal-false (make-boolean false)) + +;; + +(fn get-value + [ast] + (. ast :content)) + +(fn get-type + [ast] + (. ast :tag)) + +(fn get-md + [ast] + (. ast :md)) + +;; + +(fn get-is-macro + [ast] + (. ast :is-macro)) + +(fn get-ast + [ast] + (. ast :ast)) + +(fn get-params + [ast] + (. ast :params)) + +(fn get-env + [ast] + (. ast :env)) + +;; + +(fn nil?* + [ast] + (= :nil (. ast :tag))) + +(fn boolean?* + [ast] + (= :boolean (. ast :tag))) + +(fn number?* + [ast] + (= :number (. ast :tag))) + +(fn keyword?* + [ast] + (= :keyword (. ast :tag))) + +(fn symbol?* + [ast] + (= :symbol (. ast :tag))) + +(fn string?* + [ast] + (= :string (. ast :tag))) + +(fn list?* + [ast] + (= :list (. ast :tag))) + +(fn vector?* + [ast] + (= :vector (. ast :tag))) + +(fn hash-map?* + [ast] + (= :hash-map (. ast :tag))) + +(fn fn?* + [ast] + (= :fn (. ast :tag))) + +(fn atom?* + [ast] + (= :atom (. ast :tag))) + +(fn macro?* + [ast] + (and (fn?* ast) + (get-is-macro ast))) + +;; + +(fn macrofy + [fn-ast] + (local macro-ast {}) + (each [k v (pairs fn-ast)] + (tset macro-ast k v)) + (tset macro-ast + :is-macro true) + macro-ast) + +(fn clone-with-meta + [fn-ast meta-ast] + (local new-fn-ast {}) + (each [k v (pairs fn-ast)] + (tset new-fn-ast k v)) + (tset new-fn-ast + :md meta-ast) + new-fn-ast) + +;; + +(fn set-atom-value! + [atom-ast value-ast] + (tset atom-ast + :content value-ast)) + +(fn deref* + [ast] + (if (not (atom?* ast)) + ;; XXX + (error (.. "Expected atom, got: " (get-type ast))) + (get-value ast))) + +(fn reset!* + [atom-ast val-ast] + (set-atom-value! atom-ast val-ast) + val-ast) + +;; + +(fn empty?* + [ast] + (when (or (list?* ast) + (vector?* ast)) + (= (length (get-value ast)) 0))) + +(fn true?* + [ast] + (and (boolean?* ast) + (= true (get-value ast)))) + +(fn false?* + [ast] + (and (boolean?* ast) + (= false (get-value ast)))) + +(fn equals?* + [ast-1 ast-2] + (let [type-1 (get-type ast-1) + type-2 (get-type ast-2)] + (if (and (not= type-1 type-2) + ;; XXX: not elegant + (not (and (list?* ast-1) (vector?* ast-2))) + (not (and (list?* ast-2) (vector?* ast-1)))) + false + (let [val-1 (get-value ast-1) + val-2 (get-value ast-2)] + ;; XXX: when not a collection... + (if (and (not (list?* ast-1)) + (not (vector?* ast-1)) + (not (hash-map?* ast-1))) + (= val-1 val-2) + (if (not= (length val-1) (length val-2)) + false + (if (and (not (hash-map?* ast-1)) + (not (hash-map?* ast-2))) + (do + (var found-unequal false) + (var idx 1) + (while (and (not found-unequal) + (<= idx (length val-1))) + (let [v1 (. val-1 idx) + v2 (. val-2 idx)] + (when (not (equals?* v1 v2)) + (set found-unequal true)) + (set idx (+ idx 1)))) + (not found-unequal)) + (if (or (not (hash-map?* ast-1)) + (not (hash-map?* ast-2))) + false + (do + (var found-unequal false) + (var idx-in-1 1) + (while (and (not found-unequal) + (<= idx-in-1 (length val-1))) + (let [k1 (. val-1 idx-in-1)] + (var found-in-2 false) + (var idx-in-2 1) + (while (and (not found-in-2) + (<= idx-in-2 (length val-2))) + (let [k2 (. val-2 idx-in-2)] + (if (equals?* k1 k2) + (set found-in-2 true) + (set idx-in-2 (+ idx-in-2 2))))) + (if (not found-in-2) + (set found-unequal true) + (let [v1 (. val-1 (+ idx-in-1 1)) + v2 (. val-2 (+ idx-in-2 1))] + (if (not (equals?* v1 v2)) + (set found-unequal true) + (set idx-in-1 (+ idx-in-1 2))))))) + (not found-unequal)))))))))) + +{ + :make-nil make-nil + :make-boolean make-boolean + :make-number make-number + :make-keyword make-keyword + :make-symbol make-symbol + :make-string make-string + :make-list make-list + :make-vector make-vector + :make-hash-map make-hash-map + :make-fn make-fn + :make-atom make-atom + ;; + :mal-nil mal-nil + :mal-true mal-true + :mal-false mal-false + ;; + :get-value get-value + :get-md get-md + :get-is-macro get-is-macro + :get-ast get-ast + :get-params get-params + :get-env get-env + ;; + :nil?* nil?* + :boolean?* boolean?* + :number?* number?* + :keyword?* keyword?* + :symbol?* symbol?* + :string?* string?* + :list?* list?* + :vector?* vector?* + :hash-map?* hash-map?* + :fn?* fn?* + :atom?* atom?* + :macro?* macro?* + ;; + :macrofy macrofy + :clone-with-meta clone-with-meta + ;; + :set-atom-value! set-atom-value! + :deref* deref* + :reset!* reset!* + ;; + :empty?* empty?* + :true?* true?* + :false?* false?* + :equals?* equals?* +} diff --git a/impls/fennel/utils.fnl b/impls/fennel/utils.fnl new file mode 100644 index 0000000000..c74a07e760 --- /dev/null +++ b/impls/fennel/utils.fnl @@ -0,0 +1,137 @@ +(fn throw* + [ast] + (error ast)) + +(fn abs-index + [i len] + (if (> i 0) + i + (< i 0) + (+ len i 1) + nil)) + +(comment + + (abs-index 0 9) + ;; => nil + + (abs-index 1 9) + ;; => 1 + + (abs-index -1 9) + ;; => 9 + + (abs-index -2 9) + ;; => 8 + + ) + +(fn slice + [tbl beg end] + (local len-tbl (length tbl)) + (local new-beg + (if beg (abs-index beg len-tbl) 1)) + (local new-end + (if end (abs-index end len-tbl) len-tbl)) + (local start + (if (< new-beg 1) 1 new-beg)) + (local fin + (if (< len-tbl new-end) len-tbl new-end)) + (local new-tbl []) + (for [idx start fin] + (tset new-tbl + (+ (length new-tbl) 1) + (. tbl idx))) + new-tbl) + +(comment + + (slice [7 8 9] 2 -1) + ;; => [8 9] + + (slice [1 2 3] 1 2) + ;; => [1 2] + + ) + +(fn first + [tbl] + (. tbl 1)) + +(comment + + (first [7 8 9]) + ;; => 7 + + ) + +(fn last + [tbl] + (. tbl (length tbl))) + +(comment + + (last [7 8 9]) + ;; => 9 + + ) + +(fn map + [a-fn tbl] + (local new-tbl []) + (each [i elt (ipairs tbl)] + (tset new-tbl i (a-fn elt))) + new-tbl) + +(comment + + (map (fn [x] (+ x 1)) [7 8 9]) + ;; => [8 9 10] + + (map (fn [n] [n (+ n 1)]) [1 2 3]) + ;; => [[1 2] [2 3] [3 4]] + + ) + +(fn reverse + [tbl] + (local new-tbl []) + (for [i (length tbl) 1 -1] + (table.insert new-tbl (. tbl i))) + new-tbl) + +(comment + + (reverse [:a :b :c]) + ;; => ["c" "b" "a"] + + ) + +(fn concat-two + [tbl-1 tbl-2] + (local new-tbl []) + (each [i elt (ipairs tbl-1)] + (table.insert new-tbl elt)) + (each [i elt (ipairs tbl-2)] + (table.insert new-tbl elt)) + new-tbl) + +(comment + + (concat-two [:a :b :c] [:d :e :f]) + ;; => ["a" "b" "c" "d" "e" "f"] + + (concat-two {1 :a 2 :b 3 :c} {1 :d 2 :e 3 :f}) + ;; => ["a" "b" "c" "d" "e" "f"] + + ) + +{ + :throw* throw* + :slice slice + :first first + :last last + :map map + :reverse reverse + :concat-two concat-two +} diff --git a/impls/forth/Dockerfile b/impls/forth/Dockerfile new file mode 100644 index 0000000000..4a0be33d86 --- /dev/null +++ b/impls/forth/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install gforth diff --git a/impls/forth/Makefile b/impls/forth/Makefile new file mode 100644 index 0000000000..70617396d2 --- /dev/null +++ b/impls/forth/Makefile @@ -0,0 +1,19 @@ +SOURCES_BASE = str.fs types.fs reader.fs printer.fs +SOURCES_LISP = env.fs core.fs stepA_mal.fs +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.fs mal + +mal.fs: $(SOURCES) + cat $+ | egrep -v "^require |^droprequire " > $@ + +mal: mal.fs + echo "#! /usr/bin/env gforth" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.fs mal diff --git a/impls/forth/core.fs b/impls/forth/core.fs new file mode 100644 index 0000000000..9015f4a320 --- /dev/null +++ b/impls/forth/core.fs @@ -0,0 +1,249 @@ +require env.fs + +0 MalEnv. constant core + +: args-as-native { argv argc -- entry*argc... } + argc 0 ?do + argv i cells + @ as-native + loop ; + +: defcore* ( sym xt ) + MalNativeFn. core env/set ; + +: defcore + parse-allot-name MalSymbol. ( xt ) + ['] defcore* :noname ; + +defcore + args-as-native + MalInt. ;; +defcore - args-as-native - MalInt. ;; +defcore * args-as-native * MalInt. ;; +defcore / args-as-native / MalInt. ;; +defcore < args-as-native < mal-bool ;; +defcore > args-as-native > mal-bool ;; +defcore <= args-as-native <= mal-bool ;; +defcore >= args-as-native >= mal-bool ;; + +defcore list { argv argc } + argc cells allocate throw { start } + argv start argc cells cmove + start argc MalList. ;; + +defcore vector { argv argc } + argc cells allocate throw { start } + argv start argc cells cmove + start argc MalList. + MalVector new swap over MalVector/list ! ;; + +defcore empty? drop @ empty? ;; +defcore count drop @ mal-count ;; + +defcore = drop dup @ swap cell+ @ swap m= mal-bool ;; + +: pr-str-multi ( readably? argv argc ) + ?dup 0= if drop 0 0 + else + { argv argc } + new-str + argv @ pr-buf + argc 1 ?do + a-space + argv i cells + @ pr-buf + loop + endif ; + +defcore prn true -rot pr-str-multi type cr drop mal-nil ;; +defcore pr-str true -rot pr-str-multi MalString. nip ;; +defcore println false -rot pr-str-multi type cr drop mal-nil ;; +defcore str ( argv argc ) + dup 0= if + MalString. + else + { argv argc } + false new-str + argc 0 ?do + argv i cells + @ pr-buf + loop + MalString. nip + endif ;; + +defcore read-string drop @ unpack-str read-str ;; +defcore slurp drop @ unpack-str slurp-file MalString. ;; + +create core-buff 128 allot +defcore readline ( argv argc -- mal-string ) + drop @ unpack-str type stdout flush-file drop + core-buff 128 stdin read-line throw + if core-buff swap MalString. else drop mal-nil endif ;; + + +defcore cons ( argv[item,coll] argc ) + drop dup @ swap cell+ @ ( item coll ) + to-list conj ;; + +defcore concat { lists argc } + MalList new + lists over MalList/start ! + argc over MalList/count ! + MalList/concat ;; + +defcore vec ( argv[coll] argc ) + drop + @ + dup mal-type @ MalList = if + MalVector new tuck MalVector/list ! + endif ;; + +defcore conj { argv argc } + argv @ ( coll ) + argc 1 ?do + argv i cells + @ swap conj + loop ;; + +defcore seq drop @ seq ;; + +defcore assoc { argv argc } + argv @ ( coll ) + argv argc cells + argv cell+ +do + i @ \ key + i cell+ @ \ val + rot assoc + 2 cells +loop ;; + +defcore keys ( argv argc ) + drop @ MalMap/list @ + dup MalList/start @ swap MalList/count @ { start count } + here + start count cells + start +do + i @ , + 2 cells +loop + here>MalList ;; + +defcore vals ( argv argc ) + drop @ MalMap/list @ + dup MalList/start @ swap MalList/count @ { start count } + here + start count cells + start cell+ +do + i @ , + 2 cells +loop + here>MalList ;; + +defcore dissoc { argv argc } + argv @ \ coll + argv argc cells + argv cell+ +do + i @ swap dissoc + cell +loop ;; + +defcore hash-map { argv argc } + MalMap/Empty + argc cells argv + argv +do + i @ i cell+ @ rot assoc + 2 cells +loop ;; + +defcore get { argv argc } + argc 3 < if mal-nil else argv cell+ cell+ @ endif + argv cell+ @ \ key + argv @ \ coll + get ;; + +defcore contains? { argv argc } + 0 + argv cell+ @ \ key + argv @ \ coll + get 0 <> mal-bool ;; + +defcore nth ( argv[coll,i] argc ) + drop dup @ to-list ( argv list ) + swap cell+ @ MalInt/int @ ( list i ) + over MalList/count @ ( list i count ) + 2dup >= if { i count } + 0 0 + new-str i int>str str-append s\" \040>= " count int>str + s" nth out of bounds: " ...throw-str + endif drop ( list i ) + cells swap ( c-offset list ) + MalList/start @ + @ ;; + +defcore first ( argv[coll] argc ) + drop @ to-list + dup MalList/count @ 0= if + drop mal-nil + else + MalList/start @ @ + endif ;; + +defcore rest ( argv[coll] argc ) + drop @ to-list MalList/rest ;; + +defcore meta ( argv[obj] argc ) + drop @ mal-meta @ + ?dup 0= if mal-nil endif ;; + +defcore with-meta ( argv[obj,meta] argc ) + drop ( argv ) + dup cell+ @ swap @ ( meta obj ) + dup mal-type @ MalTypeType-struct @ ( meta obj obj-size ) + dup allocate throw { new-obj } ( meta obj obj-size ) + new-obj swap cmove ( meta ) + new-obj mal-meta ! ( ) + new-obj ;; + +defcore atom ( argv[val] argc ) + drop @ Atom. ;; + +defcore deref ( argv[atom] argc ) + drop @ Atom/val @ ;; + +defcore reset! ( argv[atom,val] argc ) + drop dup cell+ @ ( argv val ) + dup -rot swap @ Atom/val ! ;; + +defcore apply { argv argc -- val } + \ argv is (fn args... more-args) + argv argc 1- cells + @ to-list { more-args } + argc 2 - { list0len } + more-args MalList/count @ list0len + { final-argc } + final-argc cells allocate throw { final-argv } + argv cell+ final-argv list0len cells cmove + more-args MalList/start @ final-argv list0len cells + final-argc list0len - cells cmove + final-argv final-argc argv @ invoke ;; + +defcore throw ( argv argc -- ) + drop @ to exception-object + 1 throw ;; + +defcore map? drop @ mal-type @ MalMap = mal-bool ;; +defcore list? drop @ mal-type @ MalList = mal-bool ;; +defcore vector? drop @ mal-type @ MalVector = mal-bool ;; +defcore keyword? drop @ mal-type @ MalKeyword = mal-bool ;; +defcore symbol? drop @ mal-type @ MalSymbol = mal-bool ;; +defcore string? drop @ mal-type @ MalString = mal-bool ;; +defcore atom? drop @ mal-type @ Atom = mal-bool ;; +defcore true? drop @ mal-true = mal-bool ;; +defcore false? drop @ mal-false = mal-bool ;; +defcore nil? drop @ mal-nil = mal-bool ;; +defcore number? drop @ mal-type @ MalInt = mal-bool ;; +defcore fn? + drop @ + dup mal-type @ MalUserFn = if + MalUserFn/is-macro? @ if + mal-false + else + mal-true + endif + else + mal-type @ MalNativeFn = if + mal-true + else + mal-false + endif + endif ;; +defcore macro? drop @ dup mal-type @ MalUserFn = + swap MalUserFn/is-macro? @ + and mal-bool ;; + +defcore sequential? drop @ sequential? ;; + +defcore keyword drop @ unpack-str MalKeyword. ;; +defcore symbol drop @ unpack-str MalSymbol. ;; + +defcore time-ms 2drop utime d>s 1000 / MalInt. ;; diff --git a/forth/env.fs b/impls/forth/env.fs similarity index 100% rename from forth/env.fs rename to impls/forth/env.fs diff --git a/forth/misc-tests.fs b/impls/forth/misc-tests.fs similarity index 100% rename from forth/misc-tests.fs rename to impls/forth/misc-tests.fs diff --git a/impls/forth/printer.fs b/impls/forth/printer.fs new file mode 100644 index 0000000000..7030e58a60 --- /dev/null +++ b/impls/forth/printer.fs @@ -0,0 +1,114 @@ +require str.fs +require types.fs + +\ === printer protocol and implementations === / + +def-protocol-method pr-buf ( readably? str-addr str-len this -- str-addr str-len ) +def-protocol-method pr-seq-buf ( readably? str-addr str-len this -- str-addr str-len ) + +: pr-str { obj } + true new-str obj pr-buf rot drop ; + +\ Examples of extending existing protocol methods to existing type +MalDefault + extend pr-buf + { this } + s" #<" str-append + this mal-type @ type-name str-append + a-space + this int>str str-append + s" >" str-append ;; +drop + +MalNil extend pr-buf drop s" nil" str-append ;; drop +MalTrue extend pr-buf drop s" true" str-append ;; drop +MalFalse extend pr-buf drop s" false" str-append ;; drop + +MalList + extend pr-buf + -rot s" (" str-append ( list str-addr str-len ) + rot pr-seq-buf + s" )" str-append ;; + extend pr-seq-buf { list } + list MalList/count @ 0 > if + list MalList/start @ { start } + start @ pr-buf + list MalList/count @ 1 ?do + a-space + start i cells + @ pr-buf + loop + endif ;; +drop + +MalVector + extend pr-buf + MalVector/list @ + -rot s" [" str-append ( list str-addr str-len ) + rot pr-seq-buf + s" ]" str-append ;; +drop + +MalMap + extend pr-buf + MalMap/list @ + -rot s" {" str-append ( list str-addr str-len ) + rot { list } + list MalList/count @ { count } + count 0 > if + list MalList/start @ { start } + start @ pr-buf a-space start cell+ @ pr-buf + count 2 / 1 ?do + a-space + start i 2 * cells + @ pr-buf a-space + start i 2 * 1+ cells + @ pr-buf + loop + endif + s" }" str-append ;; +drop + +MalInt + extend pr-buf + MalInt/int @ int>str str-append ;; +drop + +MalSymbol + extend pr-buf + unpack-sym str-append ;; +drop + +MalKeyword + extend pr-buf { kw } + s" :" str-append + kw unpack-keyword str-append ;; +drop + +: escape-str { addr len } + s\" \"" str-append + addr len + addr ?do + i c@ case + [char] " of s\" \\\"" str-append endof + [char] \ of s\" \\\\" str-append endof + 10 of s\" \\n" str-append endof + 13 of s\" \\r" str-append endof + -rot i 1 str-append rot + endcase + loop + s\" \"" str-append ; + +MalString + extend pr-buf + dup MalString/str-addr @ + swap MalString/str-len @ + 4 pick if + escape-str + else + str-append + endif ;; +drop + +Atom + extend pr-buf { this } + s" (atom " str-append + this Atom/val @ pr-buf + s" )" str-append ;; +drop \ No newline at end of file diff --git a/impls/forth/reader.fs b/impls/forth/reader.fs new file mode 100644 index 0000000000..2fbccae519 --- /dev/null +++ b/impls/forth/reader.fs @@ -0,0 +1,151 @@ +require types.fs +require printer.fs + +\ Drop a char off the front of string by advancing the addr and +\ decrementing the length, and fetch next char +: adv-str ( str-addr str-len -- str-addr str-len char ) + swap 1+ swap 1- + dup 0= if 0 ( eof ) + else over c@ endif ; + +: mal-digit? ( char -- flag ) + dup [char] 9 <= if + [char] 0 >= + else + drop 0 + endif ; + +: char-in-str? ( char str-addr str-len ) + rot { needle } + false -rot + over + swap ?do + i c@ needle = if drop true leave endif + loop ; + +: sym-char? ( char -- flag ) + s\" \n\r\t\000[]{}()'\"`,; " char-in-str? 0= ; + +: skip-spaces ( str-addr str-len char -- str-addr str-len non-space-char ) + begin + begin + dup s\" \n\r\t, " char-in-str? + while ( str-addr str-len space-char ) + drop adv-str + repeat + dup [char] ; = if + drop + begin + adv-str s\" \n\r\000" char-in-str? + until + adv-str false + else + true + endif + until ; + +defer read-form ( str-addr str-len -- str-addr str-len mal-obj ) + +: read-int ( str-addr str-len digit-char -- str-addr str-len non-digit-char mal-int ) + 0 { int } + 0 { neg } + dup [char] - = if drop adv-str 1 to neg endif + begin ( str-addr str-len digit-char ) + [char] 0 - int 10 * + to int ( str-addr str-len ) + adv-str dup mal-digit? 0= ( str-addr str-len digit-char ) + until + neg if 0 int - to int endif + int MalInt. ; + +: read-symbol-str ( str-addr str-len sym-char -- str-addr str-len char sym-addr sym-len ) + new-str { sym-addr sym-len } + begin ( str-addr str-len sym-char ) + sym-addr sym-len rot str-append-char to sym-len to sym-addr + adv-str dup sym-char? 0= + until + sym-addr sym-len ; + +: read-string-literal ( in-addr in-len quote-char -- in-addr in-len mal-string ) + new-str { out-addr out-len } + drop \ drop leading quote + begin ( in-addr in-len ) + adv-str over 0= if + 2drop 0 0 s\" expected '\"', got EOF" ...throw-str + endif + dup [char] " <> + while + dup [char] \ = if + drop adv-str + dup [char] n = if drop 10 endif + dup [char] r = if drop 13 endif + endif + out-addr out-len rot str-append-char to out-len to out-addr + repeat + drop adv-str \ skip trailing quote + out-addr out-len MalString. ; + +: read-list ( str-addr str-len open-paren-char close-paren-char + -- str-addr str-len non-paren-char mal-list ) + here { close-char old-here } + drop adv-str + begin ( str-addr str-len char ) + skip-spaces ( str-addr str-len non-space-char ) + over 0= if + drop 2drop 0 0 s" ', got EOF" + close-char pad ! pad 1 + s" expected '" ...throw-str + endif + dup close-char <> + while ( str-addr str-len non-space-non-paren-char ) + read-form , + repeat + drop adv-str + old-here here>MalList ; + +s" deref" MalSymbol. constant deref-sym +s" quote" MalSymbol. constant quote-sym +s" quasiquote" MalSymbol. constant quasiquote-sym +s" splice-unquote" MalSymbol. constant splice-unquote-sym +s" unquote" MalSymbol. constant unquote-sym + +: read-wrapped ( buf-addr buf-len quote-char sym-addr sym-len -- buf-addr buf-len char mal-list ) + here { old-here } + , ( buf-addr buf-len char ) + read-form , ( buf-addr buf-len char ) + old-here here>MalList ; + +: read-form2 ( str-addr str-len char -- str-addr str-len char mal-obj ) + skip-spaces + dup [char] - = 3 pick 1 + c@ mal-digit? and if read-int else + dup mal-digit? if read-int else + dup [char] ( = if [char] ) read-list else + dup [char] [ = if [char] ] read-list MalVector new tuck MalVector/list ! else + dup [char] { = if [char] } read-list MalMap new tuck MalMap/list ! else + dup [char] " = if read-string-literal else + dup [char] : = if drop adv-str read-symbol-str MalKeyword. else + dup [char] @ = if drop adv-str deref-sym read-wrapped else + dup [char] ' = if drop adv-str quote-sym read-wrapped else + dup [char] ` = if drop adv-str quasiquote-sym read-wrapped else + dup [char] ~ = if + drop adv-str + dup [char] @ = if drop adv-str splice-unquote-sym read-wrapped + else unquote-sym read-wrapped + endif + else + dup [char] ^ = if + drop adv-str + read-form { meta } read-form { obj } + meta mal-nil conj + obj swap conj + s" with-meta" MalSymbol. swap conj + else + read-symbol-str + 2dup s" true" str= if 2drop mal-true + else 2dup s" false" str= if 2drop mal-false + else 2dup s" nil" str= if 2drop mal-nil + else + MalSymbol. + endif endif endif endif endif endif endif endif endif endif endif endif endif endif endif ; +' read-form2 is read-form + +: read-str ( str-addr str-len - mal-obj ) + over c@ read-form { obj } drop 2drop obj ; diff --git a/impls/forth/run b/impls/forth/run new file mode 100755 index 0000000000..0a45c57df5 --- /dev/null +++ b/impls/forth/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec gforth $(dirname $0)/${STEP:-stepA_mal}.fs "${@}" diff --git a/impls/forth/step0_repl.fs b/impls/forth/step0_repl.fs new file mode 100644 index 0000000000..f69a97d849 --- /dev/null +++ b/impls/forth/step0_repl.fs @@ -0,0 +1,25 @@ +require types.fs + +: read ; +: eval ; +: print ; + +: rep + read + eval + print ; + +create buff 128 allot + +: read-lines + begin + ." user> " + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap + rep type cr + endif + repeat ; + +read-lines diff --git a/impls/forth/step1_read_print.fs b/impls/forth/step1_read_print.fs new file mode 100644 index 0000000000..5d0ee31353 --- /dev/null +++ b/impls/forth/step1_read_print.fs @@ -0,0 +1,45 @@ +require reader.fs +require printer.fs + +: read read-str ; +: eval ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +: rep ( str-addr str-len -- str-addr str-len ) + read + eval + print ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: read-lines + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +read-lines +cr +bye diff --git a/impls/forth/step2_eval.fs b/impls/forth/step2_eval.fs new file mode 100644 index 0000000000..39a60ad01e --- /dev/null +++ b/impls/forth/step2_eval.fs @@ -0,0 +1,134 @@ +require reader.fs +require printer.fs + +: args-as-native { argv argc -- entry*argc... } + argc 0 ?do + argv i cells + @ as-native + loop ; + +: env-assoc ( map sym-str-addr sym-str-len xt ) + -rot MalSymbol. swap MalNativeFn. rot assoc ; + +MalMap/Empty + s" +" :noname args-as-native + MalInt. ; env-assoc + s" -" :noname args-as-native - MalInt. ; env-assoc + s" *" :noname args-as-native * MalInt. ; env-assoc + s" /" :noname args-as-native / MalInt. ; env-assoc +constant repl-env + +: read read-str ; +: eval ( env obj ) + \ ." EVAL: " dup pr-str safe-type cr + mal-eval ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ eval + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke ( env list this -- list ) + MalNativeFn/xt @ { xt } + eval-rest ( argv argc ) + xt execute ( return-val ) ;; +drop + +MalSymbol + extend mal-eval { env sym -- val } + 0 sym env get + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: read-lines + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +read-lines +cr +bye diff --git a/impls/forth/step3_env.fs b/impls/forth/step3_env.fs new file mode 100644 index 0000000000..bed70bccd6 --- /dev/null +++ b/impls/forth/step3_env.fs @@ -0,0 +1,175 @@ +require reader.fs +require printer.fs +require env.fs + +: args-as-native { argv argc -- entry*argc... } + argc 0 ?do + argv i cells + @ as-native + loop ; + +0 MalEnv. constant repl-env +s" +" MalSymbol. :noname args-as-native + MalInt. ; MalNativeFn. repl-env env/set +s" -" MalSymbol. :noname args-as-native - MalInt. ; MalNativeFn. repl-env env/set +s" *" MalSymbol. :noname args-as-native * MalInt. ; MalNativeFn. repl-env env/set +s" /" MalSymbol. :noname args-as-native / MalInt. ; MalNativeFn. repl-env env/set + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ eval + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke ( env list this -- list ) + MalNativeFn/xt @ { xt } + eval-rest ( argv argc ) + xt execute ( return-val ) ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ eval + \ TODO: dec refcount of env + ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: read-lines + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +read-lines +cr +bye diff --git a/impls/forth/step4_if_fn_do.fs b/impls/forth/step4_if_fn_do.fs new file mode 100644 index 0000000000..bd92f7b463 --- /dev/null +++ b/impls/forth/step4_if_fn_do.fs @@ -0,0 +1,237 @@ +require reader.fs +require printer.fs +require core.fs + +core MalEnv. constant repl-env + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ eval + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke ( env list this -- list ) + MalNativeFn/xt @ { xt } + eval-rest ( argv argc ) + xt execute ( return-val ) ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ eval + \ TODO: dec refcount of env + ;; + +defspecial do { env list -- val } + list MalList/start @ + 0 + list MalList/count @ 1 ?do + drop + dup i cells + @ env swap eval + loop + nip ;; + +defspecial if { env list -- val } + list MalList/start @ cell+ { arg0 } + env arg0 @ eval ( test-val ) + dup mal-false = if + drop -1 + else + mal-nil = + endif + if + \ branch to false + list MalList/count @ 3 > if + env arg0 cell+ cell+ @ eval + else + mal-nil + endif + else + \ branch to true + env arg0 cell+ @ eval + endif ;; + +s" &" MalSymbol. constant &-sym + +MalUserFn + extend eval-invoke { call-env list mal-fn -- list } + call-env list eval-rest { argv argc } + + mal-fn MalUserFn/formal-args @ { f-args-list } + mal-fn MalUserFn/env @ MalEnv. { env } + + f-args-list MalList/start @ { f-args } + f-args-list MalList/count @ ?dup 0= if else + \ pass empty list for last arg, unless overridden below + 1- cells f-args + @ MalList new env env/set + endif + argc 0 ?do + f-args i cells + @ + dup &-sym m= if + drop + f-args i 1+ cells + @ ( more-args-symbol ) + MalList new ( sym more-args ) + argc i - dup { c } over MalList/count ! + c cells allocate throw dup { start } over MalList/start ! + argv i cells + start c cells cmove + env env/set + leave + endif + argv i cells + @ + env env/set + loop + + env mal-fn MalUserFn/body @ eval ;; +drop + +defspecial fn* { env list -- val } + list MalList/start @ cell+ { arg0 } + MalUserFn new + env over MalUserFn/env ! + arg0 @ to-list over MalUserFn/formal-args ! + arg0 cell+ @ over MalUserFn/body ! ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +s\" (def! not (fn* (x) (if x false true)))" rep 2drop + +: read-lines + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +read-lines +cr +bye diff --git a/impls/forth/step5_tco.fs b/impls/forth/step5_tco.fs new file mode 100644 index 0000000000..88ef6d4ce1 --- /dev/null +++ b/impls/forth/step5_tco.fs @@ -0,0 +1,246 @@ +require reader.fs +require printer.fs +require core.fs + +core MalEnv. constant repl-env + +99999999 constant TCO-eval + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + begin + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval + dup TCO-eval = + while + drop + repeat ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ TCO-eval + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke ( env list this -- list ) + MalNativeFn/xt @ { xt } + eval-rest ( argv argc ) + xt execute ( return-val ) ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ TCO-eval + \ TODO: dec refcount of env + ;; + +defspecial do { env list -- val } + list MalList/start @ { start } + list MalList/count @ dup 1- { last } 1 ?do + env start i cells + @ + i last = if + TCO-eval + else + eval drop + endif + loop ;; + +defspecial if { env list -- val } + list MalList/start @ cell+ { arg0 } + env arg0 @ eval ( test-val ) + dup mal-false = if + drop -1 + else + mal-nil = + endif + if + \ branch to false + list MalList/count @ 3 > if + env arg0 cell+ cell+ @ TCO-eval + else + mal-nil + endif + else + \ branch to true + env arg0 cell+ @ TCO-eval + endif ;; + +s" &" MalSymbol. constant &-sym + +MalUserFn + extend eval-invoke { call-env list mal-fn -- list } + call-env list eval-rest { argv argc } + + mal-fn MalUserFn/formal-args @ { f-args-list } + mal-fn MalUserFn/env @ MalEnv. { env } + + f-args-list MalList/start @ { f-args } + f-args-list MalList/count @ ?dup 0= if else + \ pass empty list for last arg, unless overridden below + 1- cells f-args + @ MalList new env env/set + endif + argc 0 ?do + f-args i cells + @ + dup &-sym m= if + drop + f-args i 1+ cells + @ ( more-args-symbol ) + MalList new ( sym more-args ) + argc i - dup { c } over MalList/count ! + c cells allocate throw dup { start } over MalList/start ! + argv i cells + start c cells cmove + env env/set + leave + endif + argv i cells + @ + env env/set + loop + + env mal-fn MalUserFn/body @ TCO-eval ;; +drop + +defspecial fn* { env list -- val } + list MalList/start @ cell+ { arg0 } + MalUserFn new + env over MalUserFn/env ! + arg0 @ to-list over MalUserFn/formal-args ! + arg0 cell+ @ over MalUserFn/body ! ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +s\" (def! not (fn* (x) (if x false true)))" rep 2drop + +: read-lines + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +read-lines +cr +bye diff --git a/impls/forth/step6_file.fs b/impls/forth/step6_file.fs new file mode 100644 index 0000000000..e30264ab3a --- /dev/null +++ b/impls/forth/step6_file.fs @@ -0,0 +1,292 @@ +require reader.fs +require printer.fs +require core.fs + +core MalEnv. constant repl-env + +99999999 constant TCO-eval + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + begin + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval + dup TCO-eval = + while + drop + repeat ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ TCO-eval + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke { env list this -- list } + env list eval-rest ( argv argc ) + this invoke ;; + extend invoke ( argv argc this -- val ) + MalNativeFn/xt @ execute ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ TCO-eval + \ TODO: dec refcount of env + ;; + +defspecial do { env list -- val } + list MalList/start @ { start } + list MalList/count @ dup 1- { last } 1 ?do + env start i cells + @ + i last = if + TCO-eval + else + eval drop + endif + loop ;; + +defspecial if { env list -- val } + list MalList/start @ cell+ { arg0 } + env arg0 @ eval ( test-val ) + dup mal-false = if + drop -1 + else + mal-nil = + endif + if + \ branch to false + list MalList/count @ 3 > if + env arg0 cell+ cell+ @ TCO-eval + else + mal-nil + endif + else + \ branch to true + env arg0 cell+ @ TCO-eval + endif ;; + +s" &" MalSymbol. constant &-sym + +: new-user-fn-env { argv argc mal-fn -- env } + mal-fn MalUserFn/formal-args @ { f-args-list } + mal-fn MalUserFn/env @ MalEnv. { env } + + f-args-list MalList/start @ { f-args } + f-args-list MalList/count @ ?dup 0= if else + \ pass empty list for last arg, unless overridden below + 1- cells f-args + @ MalList new env env/set + endif + argc 0 ?do + f-args i cells + @ + dup &-sym m= if + drop + argc i - { c } + c cells allocate throw { start } + argv i cells + start c cells cmove + f-args i 1+ cells + @ ( more-args-symbol ) + start c MalList. env env/set + leave + endif + argv i cells + @ + env env/set + loop + env ; + +MalUserFn + extend eval-invoke { call-env list mal-fn -- list } + call-env list eval-rest + mal-fn invoke ;; + + extend invoke ( argv argc mal-fn ) + dup { mal-fn } new-user-fn-env { env } + env mal-fn MalUserFn/body @ TCO-eval ;; +drop + +defspecial fn* { env list -- val } + list MalList/start @ cell+ { arg0 } + MalUserFn new + env over MalUserFn/env ! + arg0 @ to-list over MalUserFn/formal-args ! + arg0 cell+ @ over MalUserFn/body ! ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +defcore eval ( argv argc ) + drop @ repl-env swap eval ;; + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +: mk-args-list ( -- ) + here + begin + next-arg 2dup 0 0 d<> while + MalString. , + repeat + 2drop here>MalList ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: nop ; + +defcore swap! { argv argc -- val } + \ argv is (atom fn args...) + argv @ { atom } + argv cell+ @ { fn } + argc 1- { call-argc } + call-argc cells allocate throw { call-argv } + atom Atom/val call-argv 1 cells cmove + argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove + call-argv call-argc fn invoke + dup TCO-eval = if drop eval endif { new-val } + new-val atom Atom/val ! + new-val ;; + +s\" (def! not (fn* (x) (if x false true)))" rep 2drop +s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop + +: repl ( -- ) + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +: main ( -- ) + mk-args-list { args-list } + args-list MalList/count @ 0= if + s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set + repl + else + args-list MalList/start @ @ { filename } + s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set + + repl-env + here s" load-file" MalSymbol. , filename , here>MalList + eval print + endif ; + +main +cr +bye diff --git a/impls/forth/step7_quote.fs b/impls/forth/step7_quote.fs new file mode 100644 index 0000000000..3dd4e067c9 --- /dev/null +++ b/impls/forth/step7_quote.fs @@ -0,0 +1,358 @@ +require reader.fs +require printer.fs +require core.fs + +core MalEnv. constant repl-env + +99999999 constant TCO-eval + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + begin + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval + dup TCO-eval = + while + drop + repeat ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ TCO-eval + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke { env list this -- list } + env list eval-rest ( argv argc ) + this invoke ;; + extend invoke ( argv argc this -- val ) + MalNativeFn/xt @ execute ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +s" concat" MalSymbol. constant concat-sym +s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym + +defer quasiquote + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit + endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop + endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; +' quasiquote0 is quasiquote + +defspecial quasiquote ( env list ) + MalList/start @ cell+ @ ( ast ) + quasiquote TCO-eval ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ TCO-eval + \ TODO: dec refcount of env + ;; + +defspecial do { env list -- val } + list MalList/start @ { start } + list MalList/count @ dup 1- { last } 1 ?do + env start i cells + @ + i last = if + TCO-eval + else + eval drop + endif + loop ;; + +defspecial if { env list -- val } + list MalList/start @ cell+ { arg0 } + env arg0 @ eval ( test-val ) + dup mal-false = if + drop -1 + else + mal-nil = + endif + if + \ branch to false + list MalList/count @ 3 > if + env arg0 cell+ cell+ @ TCO-eval + else + mal-nil + endif + else + \ branch to true + env arg0 cell+ @ TCO-eval + endif ;; + +s" &" MalSymbol. constant &-sym + +: new-user-fn-env { argv argc mal-fn -- env } + mal-fn MalUserFn/formal-args @ { f-args-list } + mal-fn MalUserFn/env @ MalEnv. { env } + + f-args-list MalList/start @ { f-args } + f-args-list MalList/count @ ?dup 0= if else + \ pass empty list for last arg, unless overridden below + 1- cells f-args + @ MalList new env env/set + endif + argc 0 ?do + f-args i cells + @ + dup &-sym m= if + drop + argc i - { c } + c cells allocate throw { start } + argv i cells + start c cells cmove + f-args i 1+ cells + @ ( more-args-symbol ) + start c MalList. env env/set + leave + endif + argv i cells + @ + env env/set + loop + env ; + +MalUserFn + extend eval-invoke { call-env list mal-fn -- list } + call-env list eval-rest + mal-fn invoke ;; + + extend invoke ( argv argc mal-fn ) + dup { mal-fn } new-user-fn-env { env } + env mal-fn MalUserFn/body @ TCO-eval ;; +drop + +defspecial fn* { env list -- val } + list MalList/start @ cell+ { arg0 } + MalUserFn new + env over MalUserFn/env ! + arg0 @ to-list over MalUserFn/formal-args ! + arg0 cell+ @ over MalUserFn/body ! ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +defcore eval ( argv argc ) + drop @ repl-env swap eval ;; + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +: mk-args-list ( -- ) + here + begin + next-arg 2dup 0 0 d<> while + MalString. , + repeat + 2drop here>MalList ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: nop ; + +defcore swap! { argv argc -- val } + \ argv is (atom fn args...) + argv @ { atom } + argv cell+ @ { fn } + argc 1- { call-argc } + call-argc cells allocate throw { call-argv } + atom Atom/val call-argv 1 cells cmove + argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove + call-argv call-argc fn invoke + dup TCO-eval = if drop eval endif { new-val } + new-val atom Atom/val ! + new-val ;; + +s\" (def! not (fn* (x) (if x false true)))" rep 2drop +s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop + +: repl ( -- ) + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +: main ( -- ) + mk-args-list { args-list } + args-list MalList/count @ 0= if + s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set + repl + else + args-list MalList/start @ @ { filename } + s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set + + repl-env + here s" load-file" MalSymbol. , filename , here>MalList + eval print + endif ; + +main +cr +bye diff --git a/impls/forth/step8_macros.fs b/impls/forth/step8_macros.fs new file mode 100644 index 0000000000..ba4b1456c1 --- /dev/null +++ b/impls/forth/step8_macros.fs @@ -0,0 +1,376 @@ +require reader.fs +require printer.fs +require core.fs + +core MalEnv. constant repl-env + +99999999 constant TCO-eval + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + begin + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval + dup TCO-eval = + while + drop + repeat ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ TCO-eval + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke { env list this -- list } + env list eval-rest ( argv argc ) + this invoke ;; + extend invoke ( argv argc this -- val ) + MalNativeFn/xt @ execute ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +s" concat" MalSymbol. constant concat-sym +s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym + +defer quasiquote + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit + endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop + endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; +' quasiquote0 is quasiquote + +defspecial quasiquote ( env list ) + MalList/start @ cell+ @ ( ast ) + quasiquote TCO-eval ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial defmacro! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval + asMacro { val } + val env env/set + val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ TCO-eval + \ TODO: dec refcount of env + ;; + +defspecial do { env list -- val } + list MalList/start @ { start } + list MalList/count @ dup 1- { last } 1 ?do + env start i cells + @ + i last = if + TCO-eval + else + eval drop + endif + loop ;; + +defspecial if { env list -- val } + list MalList/start @ cell+ { arg0 } + env arg0 @ eval ( test-val ) + dup mal-false = if + drop -1 + else + mal-nil = + endif + if + \ branch to false + list MalList/count @ 3 > if + env arg0 cell+ cell+ @ TCO-eval + else + mal-nil + endif + else + \ branch to true + env arg0 cell+ @ TCO-eval + endif ;; + +s" &" MalSymbol. constant &-sym + +: new-user-fn-env { argv argc mal-fn -- env } + mal-fn MalUserFn/formal-args @ { f-args-list } + mal-fn MalUserFn/env @ MalEnv. { env } + + f-args-list MalList/start @ { f-args } + f-args-list MalList/count @ ?dup 0= if else + \ pass empty list for last arg, unless overridden below + 1- cells f-args + @ MalList new env env/set + endif + argc 0 ?do + f-args i cells + @ + dup &-sym m= if + drop + argc i - { c } + c cells allocate throw { start } + argv i cells + start c cells cmove + f-args i 1+ cells + @ ( more-args-symbol ) + start c MalList. env env/set + leave + endif + argv i cells + @ + env env/set + loop + env ; + +MalUserFn + extend eval-invoke { call-env list mal-fn -- list } + mal-fn MalUserFn/is-macro? @ if + list MalList/start @ cell+ \ argv + list MalList/count @ 1- \ argc + mal-fn new-user-fn-env { env } + env mal-fn MalUserFn/body @ eval + call-env swap TCO-eval + else + call-env list eval-rest + mal-fn invoke + endif ;; + + extend invoke ( argv argc mal-fn ) + dup { mal-fn } new-user-fn-env { env } + env mal-fn MalUserFn/body @ TCO-eval ;; +drop + +defspecial fn* { env list -- val } + list MalList/start @ cell+ { arg0 } + MalUserFn new + false over MalUserFn/is-macro? ! + env over MalUserFn/env ! + arg0 @ to-list over MalUserFn/formal-args ! + arg0 cell+ @ over MalUserFn/body ! ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +defcore eval ( argv argc ) + drop @ repl-env swap eval ;; + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +: mk-args-list ( -- ) + here + begin + next-arg 2dup 0 0 d<> while + MalString. , + repeat + 2drop here>MalList ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: nop ; + +defcore swap! { argv argc -- val } + \ argv is (atom fn args...) + argv @ { atom } + argv cell+ @ { fn } + argc 1- { call-argc } + call-argc cells allocate throw { call-argv } + atom Atom/val call-argv 1 cells cmove + argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove + call-argv call-argc fn invoke + dup TCO-eval = if drop eval endif { new-val } + new-val atom Atom/val ! + new-val ;; + +s\" (def! not (fn* (x) (if x false true)))" rep 2drop +s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop +s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop + +: repl ( -- ) + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +: main ( -- ) + mk-args-list { args-list } + args-list MalList/count @ 0= if + s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set + repl + else + args-list MalList/start @ @ { filename } + s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set + + repl-env + here s" load-file" MalSymbol. , filename , here>MalList + eval print + endif ; + +main +cr +bye diff --git a/impls/forth/step9_try.fs b/impls/forth/step9_try.fs new file mode 100644 index 0000000000..6fe9ca6bcd --- /dev/null +++ b/impls/forth/step9_try.fs @@ -0,0 +1,419 @@ +require reader.fs +require printer.fs +require core.fs + +core MalEnv. constant repl-env + +99999999 constant TCO-eval + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + begin + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval + dup TCO-eval = + while + drop + repeat ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ TCO-eval + else + mal-nil + endif + endif ;; + extend invoke { argv argc kw -- val } + 0 kw argv @ get + ?dup 0= if + argc 1 > if + argv cell+ @ + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke { env list this -- list } + env list eval-rest ( argv argc ) + this invoke ;; + extend invoke ( argv argc this -- val ) + MalNativeFn/xt @ execute ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +s" concat" MalSymbol. constant concat-sym +s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym + +defer quasiquote + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit + endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop + endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; +' quasiquote0 is quasiquote + +defspecial quasiquote ( env list ) + MalList/start @ cell+ @ ( ast ) + quasiquote TCO-eval ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial defmacro! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval + asMacro { val } + val env env/set + val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ TCO-eval + \ TODO: dec refcount of env + ;; + +defspecial do { env list -- val } + list MalList/start @ { start } + list MalList/count @ dup 1- { last } 1 ?do + env start i cells + @ + i last = if + TCO-eval + else + eval drop + endif + loop ;; + +defspecial if { env list -- val } + list MalList/start @ cell+ { arg0 } + env arg0 @ eval ( test-val ) + dup mal-false = if + drop -1 + else + mal-nil = + endif + if + \ branch to false + list MalList/count @ 3 > if + env arg0 cell+ cell+ @ TCO-eval + else + mal-nil + endif + else + \ branch to true + env arg0 cell+ @ TCO-eval + endif ;; + +s" &" MalSymbol. constant &-sym + +: new-user-fn-env { argv argc mal-fn -- env } + mal-fn MalUserFn/formal-args @ { f-args-list } + mal-fn MalUserFn/env @ MalEnv. { env } + + f-args-list MalList/start @ { f-args } + f-args-list MalList/count @ ?dup 0= if else + \ pass empty list for last arg, unless overridden below + 1- cells f-args + @ MalList new env env/set + endif + argc 0 ?do + f-args i cells + @ + dup &-sym m= if + drop + argc i - { c } + c cells allocate throw { start } + argv i cells + start c cells cmove + f-args i 1+ cells + @ ( more-args-symbol ) + start c MalList. env env/set + leave + endif + argv i cells + @ + env env/set + loop + env ; + +MalUserFn + extend eval-invoke { call-env list mal-fn -- list } + mal-fn MalUserFn/is-macro? @ if + list MalList/start @ cell+ \ argv + list MalList/count @ 1- \ argc + mal-fn new-user-fn-env { env } + env mal-fn MalUserFn/body @ eval + call-env swap TCO-eval + else + call-env list eval-rest + mal-fn invoke + endif ;; + + extend invoke ( argv argc mal-fn ) + dup { mal-fn } new-user-fn-env { env } + env mal-fn MalUserFn/body @ TCO-eval ;; +drop + +defspecial fn* { env list -- val } + list MalList/start @ cell+ { arg0 } + MalUserFn new + false over MalUserFn/is-macro? ! + env over MalUserFn/env ! + arg0 @ to-list over MalUserFn/formal-args ! + arg0 cell+ @ over MalUserFn/body ! ;; + +5555555555 constant pre-try + +defspecial try* { env list -- val } + list MalList/start @ cell+ { arg0 } + list MalList/count @ 3 < if + env arg0 @ eval + else + pre-try + env arg0 @ ['] eval catch ?dup 0= if + nip + else { errno } + begin pre-try = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + arg0 cell+ @ ( list[catch*,sym,form] ) + MalList/start @ cell+ { catch0 } + env MalEnv. { catch-env } + catch0 @ exception-object catch-env env/set + catch-env catch0 cell+ @ TCO-eval + endif + endif ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +defcore eval ( argv argc ) + drop @ repl-env swap eval ;; + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +: mk-args-list ( -- ) + here + begin + next-arg 2dup 0 0 d<> while + MalString. , + repeat + 2drop here>MalList ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: nop ; + +defcore swap! { argv argc -- val } + \ argv is (atom fn args...) + argv @ { atom } + argv cell+ @ { fn } + argc 1- { call-argc } + call-argc cells allocate throw { call-argv } + atom Atom/val call-argv 1 cells cmove + argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove + call-argv call-argc fn invoke + dup TCO-eval = if drop eval endif { new-val } + new-val atom Atom/val ! + new-val ;; + +defcore map ( argv argc -- list ) + drop dup @ swap cell+ @ to-list { fn list } + here + list MalList/start @ list MalList/count @ cells over + swap +do + i 1 fn invoke + dup TCO-eval = if drop eval endif + , + cell +loop + here>MalList ;; + +s\" (def! not (fn* (x) (if x false true)))" rep 2drop +s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop +s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop + +: repl ( -- ) + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +: main ( -- ) + mk-args-list { args-list } + args-list MalList/count @ 0= if + s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set + repl + else + args-list MalList/start @ @ { filename } + s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set + + repl-env + here s" load-file" MalSymbol. , filename , here>MalList + eval print + endif ; + +main +cr +bye diff --git a/impls/forth/stepA_mal.fs b/impls/forth/stepA_mal.fs new file mode 100644 index 0000000000..ec0fc2b31e --- /dev/null +++ b/impls/forth/stepA_mal.fs @@ -0,0 +1,428 @@ +require reader.fs +require printer.fs +require core.fs + +core MalEnv. constant repl-env + +99999999 constant TCO-eval + +: read read-str ; +s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym +: eval ( env obj ) + begin + over debug-eval-sym swap env/get-addr ?dup-if + @ dup mal-false <> swap mal-nil <> and if + ." EVAL: " dup pr-str safe-type cr + endif + endif + mal-eval + dup TCO-eval = + while + drop + repeat ; +: print + \ ." Type: " dup mal-type @ type-name safe-type cr + pr-str ; + +MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself + +MalKeyword + extend eval-invoke { env list kw -- val } + 0 kw env list MalList/start @ cell+ @ eval get + ?dup 0= if + \ compute not-found value + list MalList/count @ 1 > if + env list MalList/start @ 2 cells + @ TCO-eval + else + mal-nil + endif + endif ;; + extend invoke { argv argc kw -- val } + 0 kw argv @ get + ?dup 0= if + argc 1 > if + argv cell+ @ + else + mal-nil + endif + endif ;; +drop + +\ eval all but the first item of list +: eval-rest { env list -- argv argc } + list MalList/start @ cell+ { expr-start } + list MalList/count @ 1- { argc } + argc cells allocate throw { target } + argc 0 ?do + env expr-start i cells + @ eval + target i cells + ! + loop + target argc ; + +MalNativeFn + extend eval-invoke { env list this -- list } + env list eval-rest ( argv argc ) + this invoke ;; + extend invoke ( argv argc this -- val ) + MalNativeFn/xt @ execute ;; +drop + +SpecialOp + extend eval-invoke ( env list this -- list ) + SpecialOp/xt @ execute ;; +drop + +: install-special ( symbol xt ) + SpecialOp. repl-env env/set ; + +: defspecial + parse-allot-name MalSymbol. + ['] install-special + :noname + ; + +defspecial quote ( env list -- form ) + nip MalList/start @ cell+ @ ;; + +s" concat" MalSymbol. constant concat-sym +s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym + +defer quasiquote + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit + endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop + endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; +' quasiquote0 is quasiquote + +defspecial quasiquote ( env list ) + MalList/start @ cell+ @ ( ast ) + quasiquote TCO-eval ;; + +defspecial def! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval dup { val } ( key val ) + env env/set val ;; + +defspecial defmacro! { env list -- val } + list MalList/start @ cell+ { arg0 } + arg0 @ ( key ) + env arg0 cell+ @ eval + asMacro { val } + val env env/set + val ;; + +defspecial let* { old-env list -- val } + old-env MalEnv. { env } + list MalList/start @ cell+ dup { arg0 } + @ to-list + dup MalList/start @ { bindings-start } ( list ) + MalList/count @ 0 +do + bindings-start i cells + dup @ swap cell+ @ ( sym expr ) + env swap eval + env env/set + 2 +loop + env arg0 cell+ @ TCO-eval + \ TODO: dec refcount of env + ;; + +defspecial do { env list -- val } + list MalList/start @ { start } + list MalList/count @ dup 1- { last } 1 ?do + env start i cells + @ + i last = if + TCO-eval + else + eval drop + endif + loop ;; + +defspecial if { env list -- val } + list MalList/start @ cell+ { arg0 } + env arg0 @ eval ( test-val ) + dup mal-false = if + drop -1 + else + mal-nil = + endif + if + \ branch to false + list MalList/count @ 3 > if + env arg0 cell+ cell+ @ TCO-eval + else + mal-nil + endif + else + \ branch to true + env arg0 cell+ @ TCO-eval + endif ;; + +s" &" MalSymbol. constant &-sym + +: new-user-fn-env { argv argc mal-fn -- env } + mal-fn MalUserFn/formal-args @ { f-args-list } + mal-fn MalUserFn/env @ MalEnv. { env } + + f-args-list MalList/start @ { f-args } + f-args-list MalList/count @ ?dup 0= if else + \ pass empty list for last arg, unless overridden below + 1- cells f-args + @ MalList new env env/set + endif + argc 0 ?do + f-args i cells + @ + dup &-sym m= if + drop + argc i - { c } + c cells allocate throw { start } + argv i cells + start c cells cmove + f-args i 1+ cells + @ ( more-args-symbol ) + start c MalList. env env/set + leave + endif + argv i cells + @ + env env/set + loop + env ; + +MalUserFn + extend eval-invoke { call-env list mal-fn -- list } + mal-fn MalUserFn/is-macro? @ if + list MalList/start @ cell+ \ argv + list MalList/count @ 1- \ argc + mal-fn new-user-fn-env { env } + env mal-fn MalUserFn/body @ eval + call-env swap TCO-eval + else + call-env list eval-rest + mal-fn invoke + endif ;; + + extend invoke ( argv argc mal-fn ) + dup { mal-fn } new-user-fn-env { env } + env mal-fn MalUserFn/body @ TCO-eval ;; +drop + +defspecial fn* { env list -- val } + list MalList/start @ cell+ { arg0 } + MalUserFn new + false over MalUserFn/is-macro? ! + env over MalUserFn/env ! + arg0 @ to-list over MalUserFn/formal-args ! + arg0 cell+ @ over MalUserFn/body ! ;; + +5555555555 constant pre-try + +defspecial try* { env list -- val } + list MalList/start @ cell+ { arg0 } + list MalList/count @ 3 < if + env arg0 @ eval + else + pre-try + env arg0 @ ['] eval catch ?dup 0= if + nip + else { errno } + begin pre-try = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + arg0 cell+ @ ( list[catch*,sym,form] ) + MalList/start @ cell+ { catch0 } + env MalEnv. { catch-env } + catch0 @ exception-object catch-env env/set + catch-env catch0 cell+ @ TCO-eval + endif + endif ;; + +defspecial . { env coll -- rtn-list } + depth { old-depth } + coll to-list dup MalList/count @ swap MalList/start @ { count start } + count cells start + start cell+ +do + env i @ eval as-native + cell +loop ;; + +MalSymbol + extend mal-eval { env sym -- val } + sym env env/get-addr + dup 0= if + drop + 0 0 s" ' not found" sym pr-str s" '" ...throw-str + else + @ + endif ;; +drop + +: eval-ast { env list -- list } + here + list MalList/start @ { expr-start } + list MalList/count @ 0 ?do + env expr-start i cells + @ eval , + loop + here>MalList ; + +MalList + extend mal-eval { env list -- val } + list MalList/count @ 0= if + list + else + env list MalList/start @ @ eval + env list rot eval-invoke + endif ;; +drop + +MalVector + extend mal-eval ( env vector -- vector ) + MalVector/list @ eval-ast + MalVector new swap over MalVector/list ! ;; +drop + +MalMap + extend mal-eval ( env map -- map ) + MalMap/list @ eval-ast + MalMap new swap over MalMap/list ! ;; +drop + +defcore eval ( argv argc ) + drop @ repl-env swap eval ;; + +: rep ( str-addr str-len -- str-addr str-len ) + read + repl-env swap eval + print ; + +: mk-args-list ( -- ) + here + begin + next-arg 2dup 0 0 d<> while + MalString. , + repeat + 2drop here>MalList ; + +create buff 128 allot +77777777777 constant stack-leak-detect + +: nop ; + +defcore swap! { argv argc -- val } + \ argv is (atom fn args...) + argv @ { atom } + argv cell+ @ { fn } + argc 1- { call-argc } + call-argc cells allocate throw { call-argv } + atom Atom/val call-argv 1 cells cmove + argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove + call-argv call-argc fn invoke + dup TCO-eval = if drop eval endif { new-val } + new-val atom Atom/val ! + new-val ;; + +defcore map ( argv argc -- list ) + drop dup @ swap cell+ @ to-list { fn list } + here + list MalList/start @ list MalList/count @ cells over + swap +do + i 1 fn invoke + dup TCO-eval = if drop eval endif + , + cell +loop + here>MalList ;; + +s\" (def! *host-language* \"forth\")" rep 2drop +s\" (def! not (fn* (x) (if x false true)))" rep 2drop +s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop +s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop + +: repl ( -- ) + s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop + begin + ." user> " + stack-leak-detect + buff 128 stdin read-line throw + while ( num-bytes-read ) + dup 0 <> if + buff swap ( str-addr str-len ) + ['] rep + \ execute ['] nop \ uncomment to see stack traces + catch ?dup 0= if + safe-type cr + stack-leak-detect <> if ." --stack leak--" cr endif + else { errno } + begin stack-leak-detect = until + errno 1 <> if + s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc + to exception-object + endif + ." Uncaught exception: " + exception-object pr-str safe-type cr + endif + endif + repeat ; + +: main ( -- ) + mk-args-list { args-list } + args-list MalList/count @ 0= if + s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set + repl + else + args-list MalList/start @ @ { filename } + s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set + + repl-env + here s" load-file" MalSymbol. , filename , here>MalList + eval print + endif ; + +main +cr +bye diff --git a/forth/str.fs b/impls/forth/str.fs similarity index 100% rename from forth/str.fs rename to impls/forth/str.fs diff --git a/impls/forth/tests/step5_tco.mal b/impls/forth/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/forth/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/forth/tests/stepA_mal.mal b/impls/forth/tests/stepA_mal.mal new file mode 100644 index 0000000000..3d8db0565b --- /dev/null +++ b/impls/forth/tests/stepA_mal.mal @@ -0,0 +1,41 @@ +;; Basic interop +(. 5 'MalInt.) +;=>5 +(. 11 31 '+ 'MalInt.) +;=>42 +(. "greetings" 'MalString.) +;=>"greetings" +(. "hello" 'type 'cr 'mal-nil) +;/hello +;=>nil + +;; Interop on non-literals +(. (+ 15 27) 'MalInt.) +;=>42 +(let* [a 17] (. a 25 '+ 'MalInt.)) +;=>42 +(let* [a "hello"] (. a 1 '- 'MalString.)) +;=>"hell" + +;; Use of annoyingly-named forth words +(. 1 'MalInt. (symbol ",") 'here (symbol "@")) +;=>1 +(let* (i 'MalInt.) (. 5 i)) +;=>5 +(let* (comma (symbol ",") fetch (symbol "@")) (. 'here 42 'MalInt. comma fetch)) +;=>42 + +;; Multiple .-forms interacting via heap memory and mal locals +(def! string-parts (fn* (s) (. s 'MalInt. 'swap 'MalInt. 'here '-rot (symbol ",") (symbol ",") 'here>MalList))) +(first (rest (string-parts "sketchy"))) +;=>7 +(def! prn-chars (fn* (start count) (if (> count 0) (do (prn (. start 1 'MalString.)) (prn-chars (+ start 1) (- count 1)))))) +(let* (msg (string-parts "sketchy")) (prn-chars (first msg) (first (rest msg)))) +;/"s" +;/"k" +;/"e" +;/"t" +;/"c" +;/"h" +;/"y" +;=>nil diff --git a/impls/forth/types.fs b/impls/forth/types.fs new file mode 100644 index 0000000000..f5c823d8e5 --- /dev/null +++ b/impls/forth/types.fs @@ -0,0 +1,678 @@ +require str.fs + +\ === sorted-array === / +\ Here are a few utility functions useful for creating and maintaining +\ the deftype* method tables. The keys array is kept in sorted order, +\ and the methods array is maintained in parallel so that an index into +\ one corresponds to an index in the other. + +\ Search a sorted array for key, returning the index of where it was +\ found. If key is not in the array, return the index where it would +\ be if added. +: array-find { a-length a-addr key -- index found? } + 0 a-length ( start end ) + begin + \ cr 2dup . . + 2dup + 2 / dup ( start end middle middle ) + cells a-addr + @ ( start end middle mid-val ) + dup key < if + drop rot ( end middle start ) + 2dup = if + 2drop dup ( end end ) + else + drop swap ( middle end ) + endif + else + key > if ( start end middle ) + nip ( start middle ) + else + -rot 2drop dup ( middle middle ) + endif + endif + 2dup = until + dup a-length = if + drop false + else + cells a-addr + @ key = + endif ; + +\ Create a new array, one cell in length, initialized the provided value +: new-array { value -- array } + cell allocate throw value over ! ; + +\ Resize a heap-allocated array to be one cell longer, inserting value +\ at idx, and shifting the tail of the array as necessary. Returns the +\ (possibly new) array address +: array-insert { old-array-length old-array idx value -- array } + old-array old-array-length 1+ cells resize throw + { a } + a idx cells + dup cell+ old-array-length idx - cells cmove> + value a idx cells + ! + a + ; + + +\ === deftype* -- protocol-enabled structs === / +\ Each type has MalTypeType% struct allocated on the stack, with +\ mutable fields pointing to all class-shared resources, specifically +\ the data needed to allocate new instances, and the table of protocol +\ methods that have been extended to the type. +\ Use 'deftype*' to define a new type, and 'new' to create new +\ instances of that type. + +struct + cell% field mal-type + cell% field mal-meta + \ cell% field ref-count \ Ha, right. +end-struct MalType% + +struct + cell% 2 * field MalTypeType-struct + cell% field MalTypeType-methods + cell% field MalTypeType-method-keys + cell% field MalTypeType-method-vals + cell% field MalTypeType-name-addr + cell% field MalTypeType-name-len +end-struct MalTypeType% + +: new ( MalTypeType -- obj ) + dup MalTypeType-struct 2@ %allocate throw ( MalTypeType obj ) \ create struct + dup -rot mal-type ! ( obj ) \ set struct's type pointer to this type + nil over mal-meta ! + ; + +: deftype* ( struct-align struct-len -- MalTypeType ) + MalTypeType% %allot ( s-a s-l MalTypeType ) + dup 2swap rot ( MalTypeType s-a s-l MalTypeType ) + MalTypeType-struct 2! ( MalTypeType ) \ store struct info + dup MalTypeType-methods 0 swap ! ( MalTypeType ) + dup MalTypeType-method-keys nil swap ! ( MalTypeType ) + dup MalTypeType-method-vals nil swap ! ( MalTypeType ) + dup MalTypeType-name-len 0 swap ! ( MalTypeType ) + ; + +\ parse-name uses temporary space, so copy into dictionary stack: +: parse-allot-name { -- new-str-addr str-len } + parse-name { str-addr str-len } + here { new-str-addr } str-len allot + str-addr new-str-addr str-len cmove + new-str-addr str-len ; + +: deftype ( struct-align struct-len R:type-name -- ) + parse-allot-name { name-addr name-len } + + \ allot and initialize type structure + deftype* { mt } + name-addr mt MalTypeType-name-addr ! + name-len mt MalTypeType-name-len ! + \ ." Defining " mt MalTypeType-name-addr @ mt MalTypeType-name-len @ type cr + mt name-addr name-len nextname 1 0 const-does> ; + +: type-name ( mal-type ) + dup MalTypeType-name-addr @ ( mal-type name-addr ) + swap MalTypeType-name-len @ ( name-addr name-len ) + ; + +MalType% deftype MalDefault + +\ nil type and instance to support extending protocols to it +MalType% deftype MalNil MalNil new constant mal-nil +MalType% deftype MalTrue MalTrue new constant mal-true +MalType% deftype MalFalse MalFalse new constant mal-false + +: mal-bool + 0= if mal-false else mal-true endif ; + +: not-object? ( obj -- bool ) + dup 7 and 0 <> if + drop true + else + 1000000 < + endif ; + +\ === protocol methods === / + +struct + cell% field call-site/type + cell% field call-site/xt +end-struct call-site% + +\ Used by protocol methods to find the appropriate implementation of +\ themselves for the given object, and then execute that implementation. +: execute-method { obj pxt call-site -- } + obj not-object? if + 0 0 obj int>str s" ' on non-object: " pxt >name name>string + s" Refusing to invoke protocol fn '" ...throw-str + endif + \ ." Calling '" pxt >name name>string type ." ' on " obj mal-type @ type-name type ." , cs " call-site . + + obj mal-type @ ( type ) + dup call-site call-site/type @ = if + \ ." hit!" cr + drop + call-site call-site/xt @ + else + \ ." miss!" cr + dup MalTypeType-methods 2@ swap ( type methods method-keys ) + dup 0= if \ No protocols extended to this type; check for a default + 2drop drop MalDefault MalTypeType-methods 2@ swap + endif + + pxt array-find ( type idx found? ) + dup 0= if \ No implementation found for this method; check for a default + 2drop drop MalDefault dup MalTypeType-methods 2@ swap + pxt array-find ( type idx found? ) + endif + 0= if ( type idx ) + 2drop + 0 0 s" '" obj mal-type @ type-name s" ' extended to type '" + pxt >name name>string s" No protocol fn '" ...throw-str + endif + + cells over MalTypeType-method-vals @ + @ ( type xt ) + swap call-site call-site/type ! ( xt ) + dup call-site call-site/xt ! ( xt ) + endif + obj swap execute ; + +\ Extend a type with a protocol method. This mutates the MalTypeType +\ object that represents the MalType being extended. +: extend-method* { type pxt ixt -- type } + \ ." Extend '" pxt dup . >name name>string safe-type ." ' to " type type-name safe-type ." , " + \ type MalTypeType-methods 2@ ( method-keys methods ) + \ 0 ?do + \ dup i cells + @ >name name>string safe-type ." , " + \ \ dup i cells + @ . + \ loop + \ drop cr + + type MalTypeType-methods 2@ swap ( methods method-keys ) + dup 0= if \ no protocols extended to this type + 2drop + 1 type MalTypeType-methods ! + pxt new-array type MalTypeType-method-keys ! + ixt new-array type MalTypeType-method-vals ! + else + pxt array-find { idx found? } + found? if \ overwrite + ." Warning: overwriting protocol method implementation '" + pxt >name name>string safe-type ." ' on " type type-name safe-type ." , " idx . found? . cr + + type MalTypeType-method-vals @ idx cells + ixt ! + else \ resize + type MalTypeType-methods dup @ 1+ dup rot ! ( new-count ) + 1- dup type MalTypeType-method-keys @ idx pxt array-insert ( old-count new-array ) + type MalTypeType-method-keys ! ( old-count ) + type MalTypeType-method-vals @ idx ixt array-insert ( new-array ) + type MalTypeType-method-vals ! + endif + endif + type + ; + + +\ Define a new protocol function. For example: +\ def-protocol-method pr-str +\ When called as above, defines a new word 'pr-str' and stores there its +\ own xt (known as pxt). When a usage of pr-str is compiled, it +\ allocates a call-site object on the heap and injects a reference to +\ both that and the pxt into the compilation, along with a call to +\ execute-method. Thus when pr-str runs, execute-method can check the +\ call-site object to see if the type of the target object is the same +\ as the last call for this site. If so, it executes the implementation +\ immediately. Otherwise, it searches the target type's method list and +\ if necessary MalDefault's method list. If an implementation of pxt is +\ found, it is cached in the call-site, and then executed. +: make-call-site { pxt -- } + pxt postpone literal \ transfer pxt into call site + call-site% %allocate throw dup postpone literal \ allocate call-site, push reference + \ dup ." Make cs '" pxt >name name>string type ." ' " . cr + 0 swap call-site/type ! + postpone execute-method ; + +: def-protocol-method ( parse: name -- ) + : latestxt postpone literal postpone make-call-site postpone ; immediate + ; + +: extend ( type -- type pxt install-xt ) + parse-name find-name name>int ( type pxt ) + ['] extend-method* + :noname + ; + +: ;; ( type pxt -- type ) + [compile] ; ( type pxt install-xt ixt ) + swap execute + ; immediate + +( +\ These whole-protocol names are only needed for 'satisfies?': +protocol IPrintable + def-protocol-method pr-str +end-protocol + +MalList IPrintable extend + ' pr-str :noname drop s" " ; extend-method* + + extend-method pr-str + drop s" " ;; +end-extend +) + +\ === Mal types and protocols === / + +def-protocol-method conj ( obj this -- this ) +def-protocol-method seq ( obj -- mal-list|nil ) +def-protocol-method assoc ( k v this -- this ) +def-protocol-method dissoc ( k this -- this ) +def-protocol-method get ( not-found k this -- value ) +def-protocol-method mal= ( a b -- bool ) +def-protocol-method as-native ( obj -- ) + +def-protocol-method to-list ( obj -- mal-list ) +def-protocol-method empty? ( obj -- mal-bool ) +def-protocol-method mal-count ( obj -- mal-int ) +def-protocol-method sequential? ( obj -- mal-bool ) +def-protocol-method get-map-hint ( obj -- hint ) +def-protocol-method set-map-hint! ( hint obj -- ) + + +\ Fully evalutate any Mal object: +def-protocol-method mal-eval ( env ast -- val ) + +\ Invoke an object, given whole env and unevaluated argument forms: +def-protocol-method eval-invoke ( env list obj -- ... ) + +\ Invoke a function, given parameter values +def-protocol-method invoke ( argv argc mal-fn -- ... ) + + +: m= ( a b -- bool ) + 2dup = if + 2drop true + else + mal= + endif ; + + +MalType% + cell% field MalInt/int +deftype MalInt + +: MalInt. { int -- mal-int } + MalInt new dup MalInt/int int swap ! ; + +MalInt + extend mal= ( other this -- bool ) + over mal-type @ MalInt = if + MalInt/int @ swap MalInt/int @ = + else + 2drop 0 + endif ;; + + extend as-native ( mal-int -- int ) + MalInt/int @ ;; +drop + + +MalType% + cell% field MalList/count + cell% field MalList/start +deftype MalList + +: MalList. ( start count -- mal-list ) + MalList new + swap over MalList/count ! ( start list ) + swap over MalList/start ! ( list ) ; + +: here>MalList ( old-here -- mal-list ) + here over - { bytes } ( old-here ) + MalList new bytes ( old-here mal-list bytes ) + allocate throw dup { target } over MalList/start ! ( old-here mal-list ) + bytes cell / over MalList/count ! ( old-here mal-list ) + swap target bytes cmove ( mal-list ) + 0 bytes - allot \ pop list contents from dictionary stack + ; + +: MalList/concat ( list-of-lists ) + dup MalList/start @ swap MalList/count @ { lists argc } + 0 lists argc cells + lists +do ( count ) + i @ to-list MalList/count @ + + cell +loop { count } + count cells allocate throw { start } + start lists argc cells + lists +do ( target ) + i @ to-list MalList/count @ cells 2dup i @ to-list MalList/start @ -rot ( target bytes src target bytes ) + cmove ( target bytes ) + + ( new-target ) + cell +loop + drop start count MalList. ; + +MalList + extend to-list ;; + extend sequential? drop mal-true ;; + extend conj { elem old-list -- list } + old-list MalList/count @ 1+ { new-count } + new-count cells allocate throw { new-start } + elem new-start ! + new-count 1 > if + old-list MalList/start @ new-start cell+ new-count 1- cells cmove + endif + new-start new-count MalList. ;; + extend seq + dup MalList/count @ 0= if + drop mal-nil + endif ;; + extend empty? MalList/count @ 0= mal-bool ;; + extend mal-count MalList/count @ MalInt. ;; + extend mal= + over mal-nil = if + 2drop false + else + swap to-list dup 0= if + nip + else + 2dup MalList/count @ swap MalList/count @ over = if ( list-a list-b count ) + -rot MalList/start @ swap MalList/start @ { start-b start-a } + true swap ( return-val count ) + 0 ?do + start-a i cells + @ + start-b i cells + @ + m= if else + drop false leave + endif + loop + else + drop 2drop false + endif + endif + endif ;; +drop + +MalList new 0 over MalList/count ! constant MalList/Empty + +: MalList/rest { list -- list } + list MalList/start @ cell+ + list MalList/count @ 1- + MalList. ; + + +MalType% + cell% field MalVector/list +deftype MalVector + +MalVector + extend sequential? drop mal-true ;; + extend to-list + MalVector/list @ ;; + extend empty? + MalVector/list @ + MalList/count @ 0= mal-bool ;; + extend mal-count + MalVector/list @ + MalList/count @ MalInt. ;; + extend mal= + MalVector/list @ swap m= ;; + extend conj + MalVector/list @ { elem old-list } + old-list MalList/count @ { old-count } + old-count 1+ cells allocate throw { new-start } + elem new-start old-count cells + ! + old-list MalList/start @ new-start old-count cells cmove + new-start old-count 1+ MalList. + MalVector new swap + over MalVector/list ! ;; + extend seq + MalVector/list @ seq ;; +drop + +MalType% + cell% field MalMap/list +deftype MalMap + +MalMap new MalList/Empty over MalMap/list ! constant MalMap/Empty + +: MalMap/get-addr ( k map -- addr-or-nil ) + MalMap/list @ + dup MalList/start @ + swap MalList/count @ { k start count } + true \ need to search? + k get-map-hint { hint-idx } + hint-idx -1 <> if + hint-idx count < if + hint-idx cells start + { key-addr } + key-addr @ k m= if + key-addr cell+ + nip false + endif + endif + endif + if \ search + nil ( addr ) + count cells start + start +do + i @ k m= if + drop i + dup start - cell / k set-map-hint! + cell+ leave + endif + [ 2 cells ] literal +loop + endif ; + +MalMap + extend conj ( kv map -- map ) + MalMap/list @ \ get list + over MalList/start @ cell+ @ swap conj \ add value + swap MalList/start @ @ swap conj \ add key + MalMap new dup -rot MalMap/list ! \ put back in map + ;; + extend assoc ( k v map -- map ) + MalMap/list @ \ get list + conj conj + MalMap new tuck MalMap/list ! \ put back in map + ;; + extend dissoc { k map -- map } + map MalMap/list @ + dup MalList/start @ swap MalList/count @ { start count } + map \ return original if key not found + count 0 +do + start i cells + @ k mal= if + drop here + start i MalList. , + start i 2 + cells + count i - 2 - MalList. , + here>MalList MalList/concat + MalMap new dup -rot MalMap/list ! \ put back in map + endif + 2 +loop ;; + extend get ( not-found k map -- value ) + MalMap/get-addr ( not-found addr-or-nil ) + dup 0= if drop else nip @ endif ;; + extend empty? + MalMap/list @ + MalList/count @ 0= mal-bool ;; + extend mal-count + MalMap/list @ + MalList/count @ 2 / MalInt. ;; + extend mal= { b a -- bool } + b mal-type @ MalMap = if + a MalMap/list @ MalList/count @ { a-count } + b MalMap/list @ MalList/count @ { b-count } + a-count b-count = if + a MalMap/list @ MalList/start @ { a-start } + true ( return-val ) + a-count 0 +do + a-start i cells + @ ( return-val key ) + dup a MalMap/get-addr swap b MalMap/get-addr ( return-val a-val-addr b-val-addr ) + dup 0= if + drop 2drop false leave + else + @ swap @ ( return-val b-val a-val ) + m= if else + drop false leave + endif + endif + 2 +loop + else + false + endif + else + false + endif ;; +drop + +\ Examples of extending existing protocol methods to existing type +MalDefault + extend conj ( obj this -- this ) + nip ;; + extend to-list drop 0 ;; + extend empty? drop mal-true ;; + extend sequential? drop mal-false ;; + extend mal= = ;; + extend get-map-hint drop -1 ;; + extend set-map-hint! 2drop ;; +drop + +MalNil + extend conj ( item nil -- mal-list ) + drop MalList/Empty conj ;; + extend seq drop mal-nil ;; + extend as-native drop nil ;; + extend get 2drop ;; + extend to-list drop MalList/Empty ;; + extend empty? drop mal-true ;; + extend mal-count drop 0 MalInt. ;; + extend mal= drop mal-nil = ;; +drop + +MalType% + cell% field MalSymbol/sym-addr + cell% field MalSymbol/sym-len + cell% field MalSymbol/map-hint +deftype MalSymbol + +: MalSymbol. { str-addr str-len -- mal-sym } + MalSymbol new { sym } + str-addr sym MalSymbol/sym-addr ! + str-len sym MalSymbol/sym-len ! + -1 sym MalSymbol/map-hint ! + sym ; + +: unpack-sym ( mal-string -- addr len ) + dup MalSymbol/sym-addr @ + swap MalSymbol/sym-len @ ; + +MalSymbol + extend mal= ( other this -- bool ) + over mal-type @ MalSymbol = if + unpack-sym rot unpack-sym str= + else + 2drop 0 + endif ;; + extend get-map-hint MalSymbol/map-hint @ ;; + extend set-map-hint! MalSymbol/map-hint ! ;; + extend as-native ( this ) + unpack-sym evaluate ;; +drop + +MalType% + cell% field MalKeyword/str-addr + cell% field MalKeyword/str-len +deftype MalKeyword + +: unpack-keyword ( mal-keyword -- addr len ) + dup MalKeyword/str-addr @ + swap MalKeyword/str-len @ ; + +MalKeyword + extend mal= ( other this -- bool ) + over mal-type @ MalKeyword = if + unpack-keyword rot unpack-keyword str= + else + 2drop 0 + endif ;; + ' as-native ' unpack-keyword extend-method* +drop + +: MalKeyword. { str-addr str-len -- mal-keyword } + MalKeyword new { kw } + str-addr kw MalKeyword/str-addr ! + str-len kw MalKeyword/str-len ! + kw ; + +MalType% + cell% field MalString/str-addr + cell% field MalString/str-len +deftype MalString + +: MalString.0 { str-addr str-len -- mal-str } + MalString new { str } + str-addr str MalString/str-addr ! + str-len str MalString/str-len ! + str ; +' MalString.0 is MalString. + +: unpack-str ( mal-string -- addr len ) + dup MalString/str-addr @ + swap MalString/str-len @ ; + +MalString + extend mal= ( other this -- bool ) + over mal-type @ MalString = if + unpack-str rot unpack-str str= + else + 2drop 0 + endif ;; + ' as-native ' unpack-str extend-method* + extend seq { str } + str MalString/str-len @ { len } + len 0= if + mal-nil + else + len cells allocate throw { list-start } + len 0 ?do + str MalString/str-addr @ i + 1 MalString. ( new-char-string ) + list-start i cells + ! + loop + list-start len MalList. + endif ;; +drop + + +MalType% + cell% field MalNativeFn/xt +deftype MalNativeFn + +: MalNativeFn. { xt -- mal-fn } + MalNativeFn new { mal-fn } + xt mal-fn MalNativeFn/xt ! + mal-fn ; + + +MalType% + cell% field MalUserFn/is-macro? + cell% field MalUserFn/env + cell% field MalUserFn/formal-args + cell% field MalUserFn/var-arg + cell% field MalUserFn/body +deftype MalUserFn + +: asMacro ( fn -- macro ) + MalUserFn new + true over MalUserFn/is-macro? ! + over MalUserFn/env @ over MalUserFn/env ! + over MalUserFn/formal-args @ over MalUserFn/formal-args ! + over MalUserFn/var-arg @ over MalUserFn/var-arg ! + swap MalUserFn/body @ over MalUserFn/body ! +; + + +MalType% + cell% field SpecialOp/xt +deftype SpecialOp + +: SpecialOp. + SpecialOp new swap over SpecialOp/xt ! ; + +MalType% + cell% field Atom/val +deftype Atom + +: Atom. Atom new swap over Atom/val ! ; diff --git a/impls/fsharp/Dockerfile b/impls/fsharp/Dockerfile new file mode 100644 index 0000000000..5b51faad9a --- /dev/null +++ b/impls/fsharp/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install fsharp diff --git a/impls/fsharp/Makefile b/impls/fsharp/Makefile new file mode 100644 index 0000000000..505d3ee5d3 --- /dev/null +++ b/impls/fsharp/Makefile @@ -0,0 +1,46 @@ +##################### + +DEBUG = + +SOURCES_BASE = types.fs error.fs node.fs printer.fs tokenizer.fs reader.fs \ + readline.fs +SOURCES_LISP = core.fs env.fs stepA_mal.fs +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +TERMINAL_SOURCES = terminal.cs + +##################### + +SRCS = step0_repl.fs step1_read_print.fs step2_eval.fs step3_env.fs \ + step4_if_fn_do.fs step5_tco.fs step6_file.fs step7_quote.fs \ + step8_macros.fs step9_try.fs stepA_mal.fs +DLL_SOURCES = $(filter-out stepA_mal.fs,$(SOURCES)) + +FSFLAGS = $(if $(strip $(DEBUG)),--debug+,--debug- --optimize+ --tailcalls+) +CSFLAGS = $(if $(strip $(DEBUG)),-debug+,) +##################### + +all: $(patsubst %.fs,%.exe,$(SRCS)) + +dist: mal.exe mal + +mal.exe: stepA_mal.exe + cp $< $@ + +# NOTE/WARNING: static linking triggers mono libraries LGPL +# distribution requirements. +# http://www.mono-project.com/archived/guiderunning_mono_applications/ +mal: $(patsubst %.fs,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) Mono.Terminal.dll mal.dll + mkbundle --static -o $@ $+ --deps + +Mono.Terminal.dll: $(TERMINAL_SOURCES) + mcs $(CSFLAGS) -target:library $+ -out:$@ + +mal.dll: $(DLL_SOURCES) Mono.Terminal.dll + fsharpc $(FSFLAGS) -o $@ -r Mono.Terminal.dll -a $(DLL_SOURCES) + +%.exe: %.fs mal.dll + fsharpc $(FSFLAGS) -o $@ -r mal.dll $< + +clean: + rm -f mal *.dll *.exe *.mdb diff --git a/impls/fsharp/core.fs b/impls/fsharp/core.fs new file mode 100644 index 0000000000..5e7042356e --- /dev/null +++ b/impls/fsharp/core.fs @@ -0,0 +1,310 @@ +module Core + + open System + open Types + + let inline toBool b = if b then Node.TRUE else Node.FALSE + + let inline twoNumberOp (f : int64 -> int64 -> Node) = function + | [Number(a); Number(b)] -> f a b + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let inline twoNodeOp (f : Node -> Node -> Node) = function + | [a; b] -> f a b + | _ -> raise <| Error.wrongArity () + + let add = twoNumberOp (fun a b -> a + b |> Number) + let subtract = twoNumberOp (fun a b -> a - b |> Number) + let multiply = twoNumberOp (fun a b -> a * b |> Number) + let divide = twoNumberOp (fun a b -> a / b |> Number) + let lt = twoNodeOp (fun a b -> a < b |> toBool) + let le = twoNodeOp (fun a b -> a <= b |> toBool) + let ge = twoNodeOp (fun a b -> a >= b |> toBool) + let gt = twoNodeOp (fun a b -> a > b |> toBool) + let eq = twoNodeOp (fun a b -> a = b |> toBool) + + let time_ms _ = + DateTime.Now.Ticks / TimeSpan.TicksPerMillisecond |> int64 |> Number + + let list = Node.makeList + let isList = function + | [List(_, _)] -> Node.TRUE + | [_] -> Node.FALSE + | _ -> raise <| Error.wrongArity () + + let isEmpty = function + | [List(_, [])] -> Node.TRUE + | [Vector(_, seg)] when seg.Count <= 0 -> Node.TRUE + | _ -> Node.FALSE + + let count = function + | [List(_, lst)] -> lst |> List.length |> int64 |> Number + | [Vector(_, seg)] -> seg.Count |> int64 |> Number + | [Nil] -> Node.ZERO + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let pr_str nodes = nodes |> Printer.pr_str |> String + let str nodes = nodes |> Printer.str |> String + let prn nodes = nodes |> Printer.prn |> printfn "%s"; Nil + let println nodes = nodes |> Printer.println |> printfn "%s"; Nil + + let read_str = function + | [String(s)] -> + match Reader.read_str s with + | [node] -> node + | nodes -> Symbol("do")::nodes |> Node.makeList + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let slurp = function + | [String(s)] -> System.IO.File.ReadAllText s |> String + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let cons = function + | [node; List(_, lst)] -> node::lst |> Node.makeList + | [node; Vector(_, seg)] -> node::(List.ofSeq seg) |> Node.makeList + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let concat nodes = + let cons st node = node::st + let accumNode acc = function + | List(_, lst) -> lst |> List.fold cons acc + | Vector(_, seg) -> seg |> Seq.fold cons acc + | _ -> raise <| Error.argMismatch () + + nodes + |> List.fold accumNode [] + |> List.rev + |> Node.makeList + + let vec = function + | [Vector(_, _) as v] -> v + | [List(_, xs)] -> Node.ofArray <| Array.ofSeq xs + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let nth = function + | [List(_, lst); Number(n)] -> + let rec nth_list n = function + | [] -> raise <| Error.indexOutOfBounds () + | h::_ when n = 0L -> h + | _::t -> nth_list (n - 1L) t + nth_list n lst + | [Vector(_, seg); Number(n)] -> + if n < 0L || n >= int64(seg.Count) then + raise <| Error.indexOutOfBounds () + else + seg.Array.[int(n)] + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let first = function + | [List(_, [])] -> Node.NIL + | [List(_, h::_)] -> h + | [Vector(_, seg)] when seg.Count > 0 -> seg.Array.[0] + | [Vector(_, _)] -> Node.NIL + | [Nil] -> Node.NIL + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let rest = function + | [List(_, [])] -> Node.EmptyLIST + | [List(_, _::t)] -> t |> Node.makeList + | [Vector(_, seg)] when seg.Count < 2 -> Node.EmptyLIST + | [Vector(_, seg)] -> seg |> Seq.skip 1 |> List.ofSeq |> Node.makeList + | [Nil] -> Node.EmptyLIST + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let throw = function + | [node] -> raise <| Error.MalError(node) + | _ -> raise <| Error.wrongArity () + + let map = function + | [BuiltInFunc(_, _, f); Node.Seq seq] + | [Func(_, _, f, _, _, _); Node.Seq seq] -> + seq |> Seq.map (fun node -> f [node]) |> List.ofSeq |> Node.makeList + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let apply = function + | BuiltInFunc(_, _, f)::rest + | Macro(_, _, f, _, _, _)::rest + | Func(_, _, f, _, _, _)::rest -> + let rec getArgsAndCall acc = function + | [] -> raise <| Error.wrongArity () + | [Node.Seq seq] -> + seq |> Seq.fold (fun acc node -> node::acc) acc |> List.rev |> f + | [_] -> raise <| Error.argMismatch () + | h::rest -> getArgsAndCall (h::acc) rest + getArgsAndCall [] rest + | _::_ -> raise <| Error.argMismatch () + | [] -> raise <| Error.wrongArity () + + let isConst cmp = function + | [node] -> if node = cmp then Node.TRUE else Node.FALSE + | _ -> raise <| Error.wrongArity () + + let isPattern f = function + | [node] -> if f node then Node.TRUE else Node.FALSE + | _ -> raise <| Error.wrongArity () + + let isSymbol = isPattern (function Symbol(_) -> true | _ -> false) + let isKeyword = isPattern (function Keyword(_) -> true | _ -> false) + let isString = isPattern (function String(_) -> true | _ -> false) + let isNumber = isPattern (function Number(_) -> true | _ -> false) + let isFn = isPattern (function BuiltInFunc(_, _, _) | Func(_, _, _, _, _, _) -> true | _ -> false) + let isMacro = isPattern (function Macro(_, _, _, _, _, _) -> true | _ -> false) + let isSequential = isPattern (function Node.Seq(_) -> true | _ -> false) + let isVector = isPattern (function Vector(_, _) -> true | _ -> false) + let isMap = isPattern (function Map(_, _) -> true | _ -> false) + let isAtom = isPattern (function Atom(_, _) -> true | _ -> false) + + let symbol = function + | [String(s)] -> Symbol s + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let keyword = function + | [String(s)] -> Keyword s + | [Keyword(_) as k] -> k + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let vector lst = lst |> Array.ofList |> Node.ofArray + + let rec getPairs lst = + seq { + match lst with + | first::second::t -> + yield first, second + yield! getPairs t + | [_] -> raise <| Error.expectedEvenNodeCount () + | [] -> () + } + + let mapOpN f = function + | Map(_, map)::rest -> f rest map + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let mapOp1 f = + mapOpN (fun rest map -> + match rest with + | [v] -> f v map + | _ -> raise <| Error.wrongArity ()) + + let mapOp0 f = + mapOpN (fun rest map -> + match rest with + | [] -> f map + | _ -> raise <| Error.wrongArity ()) + + let mapKV f = + mapOp0 (fun map -> map |> Map.toSeq |> Seq.map f |> List.ofSeq |> Node.makeList) + + let hashMap lst = lst |> getPairs |> Map.ofSeq |> Node.makeMap + let assoc = mapOpN (fun rest map -> + rest + |> getPairs + |> Seq.fold (fun map (k, v) -> Map.add k v map) map + |> Node.makeMap) + let dissoc = mapOpN (fun keys map -> + keys + |> List.fold (fun map k -> Map.remove k map) map + |> Node.makeMap) + let get = function + | [Nil; _] -> Node.NIL + | _ as rest -> + rest |> mapOp1 (fun key map -> + match Map.tryFind key map with + | Some(node) -> node + | None -> Node.NIL) + let containsKey key map = if Map.containsKey key map then Node.TRUE else Node.FALSE + let contains = mapOp1 containsKey + let keys = mapKV (fun (k, v) -> k) + let vals = mapKV (fun (k, v) -> v) + + let atom nextValue = function + | [node] -> Atom((nextValue ()), ref node) + | _ -> raise <| Error.wrongArity () + + let deref = function + | [Atom(_, r)] -> !r + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let reset = function + | [Atom(_, r); node] -> + r := node + !r + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let swap = function + | Atom(_, r) + ::(BuiltInFunc(_, _, f) | Func(_, _, f, _, _, _)) + ::rest -> + r := f (!r::rest) + !r + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let conj = function + | List(_, lst)::rest -> + rest + |> List.fold (fun lst node -> node::lst) lst + |> Node.makeList + | Vector(_, seg)::rest -> + (* Might be nice to implement a persistent vector here someday. *) + let cnt = List.length rest + if cnt > 0 then + let target : Node array = seg.Count + cnt |> Array.zeroCreate + System.Array.Copy(seg.Array :> System.Array, seg.Offset, + target :> System.Array, 0, seg.Count) + let rec copyElem i = function + | h::t -> + Array.set target i h + copyElem (i + 1) t + | [] -> () + copyElem (seg.Count) rest + target |> Node.ofArray + else + seg |> Node.makeVector + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let seq = function + | [Nil] -> Node.NIL + | [List(_, [])] -> Node.NIL + | [List(_, _) as l] -> l + | [Vector(_, seg)] when seg.Count < 1 -> Node.NIL + | [Vector(_, seg)] -> seg |> List.ofSeq |> Node.makeList + | [String(s)] when String.length s < 1 -> Node.NIL + | [String(s)] -> s |> Seq.map Node.ofChar |> List.ofSeq |> Node.makeList + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let withMeta = function + | [List(_, lst); m] -> List(m, lst) + | [Vector(_, seg); m] -> Vector(m, seg) + | [Map(_, map); m] -> Map(m, map) + | [BuiltInFunc(_, tag, f); m] -> BuiltInFunc(m, tag, f) + | [Func(_, tag, f, a, b, c); m] -> Func(m, tag, f, a, b, c) + | [Macro(_, tag, f, a, b, c); m] -> Macro(m, tag, f, a, b, c) + | [_; _] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let meta = function + | [List(m, _)] + | [Vector(m, _)] + | [Map(m, _)] + | [BuiltInFunc(m, _, _)] + | [Func(m, _, _, _, _, _)] + | [Macro(m, _, _, _, _, _)] -> m + | [_] -> Node.NIL + | _ -> raise <| Error.wrongArity () diff --git a/impls/fsharp/env.fs b/impls/fsharp/env.fs new file mode 100644 index 0000000000..f505ba5917 --- /dev/null +++ b/impls/fsharp/env.fs @@ -0,0 +1,119 @@ +module Env + + open Types + + let makeEmpty () = Env() + + let ofList lst = + let env = makeEmpty () + let accumulate (e : Env) (k, v) = e.Add(k, v); e + List.fold accumulate env lst + + let set (env : EnvChain) key node = + match env with + | head::_ -> head.[key] <- node + | _ -> raise <| Error.noEnvironment () + + let rec get (chain : EnvChain) key = + match chain with + | [] -> None + | env::rest -> + match env.TryGetValue(key) with + | true, v -> Some(v) + | false, _ -> get rest key + + let private getNextValue = + let counter = ref 0 + fun () -> System.Threading.Interlocked.Increment(counter) + + let makeBuiltInFunc f = + BuiltInFunc(Node.NIL, getNextValue (), f) + + let makeFunc f body binds env = + Func(Node.NIL, getNextValue (), f, body, binds, env) + + let makeMacro f body binds env = + Macro(Node.NIL, getNextValue (), f, body, binds, env) + + let makeRootEnv () = + let wrap name f = name, makeBuiltInFunc f + let env = + [ wrap "+" Core.add + wrap "-" Core.subtract + wrap "*" Core.multiply + wrap "/" Core.divide + wrap "list" Core.list + wrap "list?" Core.isList + wrap "empty?" Core.isEmpty + wrap "count" Core.count + wrap "=" Core.eq + wrap "<" Core.lt + wrap "<=" Core.le + wrap ">=" Core.ge + wrap ">" Core.gt + wrap "time-ms" Core.time_ms + wrap "pr-str" Core.pr_str + wrap "str" Core.str + wrap "prn" Core.prn + wrap "println" Core.println + wrap "read-string" Core.read_str + wrap "slurp" Core.slurp + wrap "cons" Core.cons + wrap "concat" Core.concat + wrap "vec" Core.vec + wrap "nth" Core.nth + wrap "first" Core.first + wrap "rest" Core.rest + wrap "throw" Core.throw + wrap "map" Core.map + wrap "apply" Core.apply + wrap "nil?" (Core.isConst Node.NIL) + wrap "true?" (Core.isConst Node.TRUE) + wrap "false?" (Core.isConst Node.FALSE) + wrap "symbol?" Core.isSymbol + wrap "symbol" Core.symbol + wrap "string?" Core.isString + wrap "keyword?" Core.isKeyword + wrap "keyword" Core.keyword + wrap "number?" Core.isNumber + wrap "fn?" Core.isFn + wrap "macro?" Core.isMacro + wrap "sequential?" Core.isSequential + wrap "vector?" Core.isVector + wrap "vector" Core.vector + wrap "map?" Core.isMap + wrap "hash-map" Core.hashMap + wrap "assoc" Core.assoc + wrap "dissoc" Core.dissoc + wrap "get" Core.get + wrap "contains?" Core.contains + wrap "keys" Core.keys + wrap "vals" Core.vals + wrap "atom" (Core.atom getNextValue) + wrap "atom?" Core.isAtom + wrap "deref" Core.deref + wrap "reset!" Core.reset + wrap "swap!" Core.swap + wrap "conj" Core.conj + wrap "seq" Core.seq + wrap "meta" Core.meta + wrap "with-meta" Core.withMeta ] + |> ofList + [ env ] + + let makeNew outer symbols nodes = + let env = (makeEmpty ())::outer + let rec loop symbols nodes = + match symbols, nodes with + | [Symbol("&"); Symbol(s)], nodes -> + set env s (Node.makeList nodes) + env + | Symbol("&")::_, _ -> raise <| Error.onlyOneSymbolAfterAmp () + | Symbol(s)::symbols, n::nodes -> + set env s n + loop symbols nodes + | [], [] -> env + | _, [] -> raise <| Error.notEnoughValues () + | [], _ -> raise <| Error.tooManyValues () + | _, _ -> raise <| Error.errExpectedX "symbol" + loop symbols nodes diff --git a/impls/fsharp/error.fs b/impls/fsharp/error.fs new file mode 100644 index 0000000000..11a0c8cbdf --- /dev/null +++ b/impls/fsharp/error.fs @@ -0,0 +1,21 @@ +module Error + + exception ReaderError of string + exception EvalError of string + exception MalError of Types.Node + + let expectedXButEOF x = ReaderError(sprintf "Expected %s, got EOF" x) + let expectedX x = ReaderError(sprintf "Expected %s" x) + let unexpectedChar () = ReaderError("Unexpected char") + let invalidToken () = ReaderError("Invalid token") + + let expectedEvenNodeCount () = EvalError("Expected even node count") + let wrongArity () = EvalError("Arity: wrong number of arguments") + let argMismatch () = EvalError("Argument mismatch") + let symbolNotFound s = EvalError(sprintf "'%s' not found" s) + let noEnvironment () = EvalError("No environment") + let tooManyValues () = EvalError("Too many values") + let notEnoughValues () = EvalError("Not enough values") + let onlyOneSymbolAfterAmp () = EvalError("only one symbol after &") + let errExpectedX x = EvalError(sprintf "expected %s" x) + let indexOutOfBounds () = EvalError("Index out of bounds") diff --git a/impls/fsharp/node.fs b/impls/fsharp/node.fs new file mode 100644 index 0000000000..94ae61d657 --- /dev/null +++ b/impls/fsharp/node.fs @@ -0,0 +1,88 @@ +module Node + + open Types + + let TRUE = Bool(true) + let SomeTRUE = Some(TRUE) + let FALSE = Bool(false) + let SomeFALSE = Some(FALSE) + let NIL = Nil + let SomeNIL = Some(NIL) + let ZERO = Number(0L) + + let makeVector seg = Vector(NIL, seg) + let makeList lst = List(NIL, lst) + let makeMap map = Map(NIL, map) + + let EmptyLIST = [] |> makeList + let EmptyVECTOR = System.ArraySegment([| |]) |> makeVector + let EmptyMAP = Map.empty |> makeMap + + let ofArray arr = System.ArraySegment(arr) |> makeVector + + let ofChar chr = sprintf "%c" chr |> String + + let toArray = function + | List(_, lst) -> Array.ofList lst + | Vector(_, seg) -> Array.sub seg.Array seg.Offset seg.Count + | node -> [| node |] + + let length = function + | List(_, lst) -> List.length lst + | Vector(_, seg) -> seg.Count + | Map(_, m) -> m.Count + | _ -> 1 + + (* Active Patterns to help with pattern matching nodes *) + let inline (|Elements|_|) num node = + let rec accumList acc idx lst = + let len = Array.length acc + match lst with + | [] when idx = len -> Some(Elements acc) + | h::t when idx < len -> + acc.[idx] <- h + accumList acc (idx + 1) t + | _ -> None + match node with + | List(_, lst) -> accumList (Array.zeroCreate num) 0 lst + | Vector(_, seg) when seg.Count = num -> Some(toArray node) + | _ -> None + + let inline (|Cons|_|) node = + match node with + | List(_, h::t) -> Some(Cons(h, makeList t)) + | Vector(_, seg) when seg.Count > 0 -> + let h = seg.Array.[seg.Offset] + let t = System.ArraySegment(seg.Array, seg.Offset + 1, seg.Count - 1) + |> makeVector + Some(Cons(h, t)) + | _ -> None + + let inline (|Empty|_|) node = + match node with + | List(_, []) -> Some(Empty) + | Vector(_, seg) when seg.Count = 0 -> Some(Empty) + | _ -> None + + let inline (|Pair|_|) node = + match node with + | List(_, a::b::t) -> Some(a, b, makeList t) + | List(_, []) -> None + | List(_, _) -> raise <| Error.expectedEvenNodeCount () + | Vector(_, seg) -> + match seg.Count with + | 0 -> None + | 1 -> raise <| Error.expectedEvenNodeCount () + | _ -> + let a = seg.Array.[seg.Offset] + let b = seg.Array.[seg.Offset + 1] + let t = System.ArraySegment(seg.Array, seg.Offset + 2, seg.Count - 2) + |> makeVector + Some(a, b, t) + | _ -> None + + let inline (|Seq|_|) node = + match node with + | List(_, lst) -> Some(Seq.ofList lst) + | Vector(_, seg) -> Some(seg :> Node seq) + | _ -> None diff --git a/impls/fsharp/printer.fs b/impls/fsharp/printer.fs new file mode 100644 index 0000000000..ffaefb71cf --- /dev/null +++ b/impls/fsharp/printer.fs @@ -0,0 +1,87 @@ +module Printer + open System.Text + open Types + + type Profile = { Pretty : bool; Separator : string } + let pr_str_profile = { Pretty = true; Separator = " " } + let str_profile = { Pretty = false; Separator = "" } + let prn_profile = { Pretty = true; Separator = " " } + let println_profile = { Pretty = false; Separator = " " } + + let print profile nodes = + let acc = StringBuilder() + let appendStr (str : string) = acc.Append(str) |> ignore + let rec pr_node = function + | Nil -> appendStr "nil" + | List(_, nodes) -> pr_list nodes + | Vector(_, nodes) -> pr_vector nodes + | Map(_, map) -> pr_map map + | Symbol(symbol) -> appendStr symbol + | Keyword(keyword) -> appendStr ":"; appendStr keyword + | Number(num) -> acc.Append(num) |> ignore + | String(str) when profile.Pretty -> pr_str_pretty str + | String(str) -> appendStr str + | Bool(true) -> appendStr "true" + | Bool(false) -> appendStr "false" + | BuiltInFunc(_, tag, _) | Func(_, tag, _, _, _, _) -> + pr_func "func" tag + | Macro(_, tag, _, _, _, _) -> pr_func "macro" tag + | Atom(tag, r) -> pr_atom tag !r + + and pr separator prefix node = + appendStr prefix + pr_node node + separator + + and std_pr = pr " " + + and pr_str_pretty str = + let appendChar = function + | '\t' -> appendStr "\\t" + | '\b' -> appendStr "\\b" + | '\n' -> appendStr "\\n" + | '\r' -> appendStr "\\r" + | '\f' -> appendStr "\\f" + | '"' -> appendStr "\\\"" + | '\\' -> appendStr "\\\\" + | ch -> acc.Append(ch) |> ignore + appendStr "\"" + str |> Seq.iter appendChar + appendStr "\"" + + and pr_func ftype tag = + sprintf "#<%s %d>" ftype tag |> appendStr + + and pr_atom tag node = + appendStr "(atom " + pr_node node + appendStr ")" + + and pr_list nodes = + appendStr "(" + nodes |> List.fold std_pr "" |> ignore + appendStr ")" + + and pr_vector nodes = + appendStr "[" + nodes |> Seq.fold std_pr "" |> ignore + appendStr "]" + + and pr_map map = + let pr prefix key value = + appendStr prefix + pr_node key + appendStr " " + pr_node value + " " + appendStr "{" + map |> Map.fold pr "" |> ignore + appendStr "}" + + nodes |> Seq.fold (pr profile.Separator) "" |> ignore + acc.ToString() + + let pr_str : seq -> string = print pr_str_profile + let str : seq -> string = print str_profile + let prn : seq -> string = print prn_profile + let println : seq -> string = print println_profile diff --git a/impls/fsharp/reader.fs b/impls/fsharp/reader.fs new file mode 100644 index 0000000000..de3c64a628 --- /dev/null +++ b/impls/fsharp/reader.fs @@ -0,0 +1,88 @@ +module Reader + open System + open Tokenizer + open Types + open Node + + type MutableList = System.Collections.Generic.List + let inline addToMutableList (lst:MutableList) item = lst.Add(item); lst + + let quote = Symbol("quote") + let quasiquote = Symbol("quasiquote") + let unquote = Symbol("unquote") + let spliceUnquote = Symbol("splice-unquote") + let deref = Symbol("deref") + let withMeta = Symbol("with-meta") + + let rec readForm = function + | OpenParen::rest -> readList [] rest + | OpenBracket::rest -> readVector (MutableList()) rest + | OpenBrace::rest -> readMap [] rest + | SingleQuote::rest -> wrapForm quote rest + | Backtick::rest -> wrapForm quasiquote rest + | Tilde::rest -> wrapForm unquote rest + | SpliceUnquote::rest -> wrapForm spliceUnquote rest + | At::rest -> wrapForm deref rest + | Caret::rest -> readMeta rest + | tokens -> readAtom tokens + + and wrapForm node tokens = + match readForm tokens with + | Some(form), rest -> Some(makeList [node; form]), rest + | None, _ -> raise <| Error.expectedXButEOF "form" + + and readList acc = function + | CloseParen::rest -> Some(acc |> List.rev |> makeList), rest + | [] -> raise <| Error.expectedXButEOF "')'" + | tokens -> + match readForm tokens with + | Some(form), rest -> readList (form::acc) rest + | None, _ -> raise <| Error.expectedXButEOF "')'" + + and readVector acc = function + | CloseBracket::rest -> Some(acc.ToArray() |> Node.ofArray), rest + | [] -> raise <| Error.expectedXButEOF "']'" + | tokens -> + match readForm tokens with + | Some(form), rest -> readVector (addToMutableList acc form) rest + | None, _ -> raise <| Error.expectedXButEOF "']'" + + and readMap acc = function + | CloseBrace::rest -> Some(acc |> List.rev |> Map.ofList |> makeMap), rest + | [] -> raise <| Error.expectedXButEOF "'}'" + | tokens -> + match readForm tokens with + | Some(key), rest -> + match readForm rest with + | Some(v), rest -> readMap ((key, v)::acc) rest + | None, _ -> raise <| Error.expectedXButEOF "'}'" + | None, _ -> raise <| Error.expectedXButEOF "'}'" + + and readMeta = function + | OpenBrace::rest -> + let meta, rest = readMap [] rest + match readForm rest with + | Some(form), rest -> Some([withMeta; form; meta.Value] |> makeList), rest + | None, _ -> raise <| Error.expectedXButEOF "form" + | _ -> raise <| Error.expectedXButEOF "map" + + and readAtom = function + | Token("nil")::rest -> Node.SomeNIL, rest + | Token("true")::rest -> Node.SomeTRUE, rest + | Token("false")::rest -> Node.SomeFALSE, rest + | Tokenizer.String(str)::rest -> Some(String(str)), rest + | Tokenizer.Keyword(kw)::rest -> Some(Keyword(kw)), rest + | Tokenizer.Number(num)::rest -> Some(Number(Int64.Parse(num))), rest + | Token(sym)::rest -> Some(Symbol(sym)), rest + | [] -> None, [] + | _ -> raise <| Error.invalidToken () + + let rec readForms acc = function + | [] -> List.rev acc + | tokens -> + match readForm tokens with + | Some(form), rest -> readForms (form::acc) rest + | None, rest -> readForms acc rest + + let read_str str = + tokenize str |> readForms [] diff --git a/impls/fsharp/readline.fs b/impls/fsharp/readline.fs new file mode 100644 index 0000000000..fe02ed4357 --- /dev/null +++ b/impls/fsharp/readline.fs @@ -0,0 +1,16 @@ +module Readline + open System + open Mono.Terminal + + type Mode = + | Terminal + | Raw + + let read prompt = function + | Terminal + -> let editor = LineEditor("Mal") + editor.Edit(prompt, "") + | Raw + -> Console.Write(prompt) + Console.Out.Flush() + Console.ReadLine() diff --git a/impls/fsharp/run b/impls/fsharp/run new file mode 100755 index 0000000000..5c5642646f --- /dev/null +++ b/impls/fsharp/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" diff --git a/impls/fsharp/step0_repl.fs b/impls/fsharp/step0_repl.fs new file mode 100644 index 0000000000..6d8d4574b1 --- /dev/null +++ b/impls/fsharp/step0_repl.fs @@ -0,0 +1,30 @@ +module REPL + let READ input = + input + + let EVAL ast = + ast + + let PRINT v = + printfn "%s" v + + let REP input = + input + |> READ + |> EVAL + |> PRINT + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + [] + let rec main args = + let mode = getReadlineMode args + match Readline.read "user> " mode with + | null -> 0 + | input -> + REP input + main args diff --git a/impls/fsharp/step1_read_print.fs b/impls/fsharp/step1_read_print.fs new file mode 100644 index 0000000000..1ce61408ff --- /dev/null +++ b/impls/fsharp/step1_read_print.fs @@ -0,0 +1,43 @@ +module REPL + open System + + let READ input = + try + Reader.read_str input + with + | Error.ReaderError(msg) -> + printfn "%s" msg + [] + + let EVAL ast = + Some(ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let REP input = + READ input + |> Seq.ofList + |> Seq.map (fun form -> EVAL form) + |> Seq.filter Option.isSome + |> Seq.iter (fun value -> PRINT value.Value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + [] + let main args = + let mode = getReadlineMode args + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + REP input + loop() + loop () diff --git a/impls/fsharp/step2_eval.fs b/impls/fsharp/step2_eval.fs new file mode 100644 index 0000000000..436afa1a92 --- /dev/null +++ b/impls/fsharp/step2_eval.fs @@ -0,0 +1,61 @@ +module REPL + open System + open Node + open Types + + let rec eval env ast = + (* Printer.pr_str [ast] |> printfn "EVAL: %s" *) + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, (a0 :: rest)) -> + match eval env a0 with + | BuiltInFunc(_, _, f) -> List.map (eval env) rest |> f + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let REP env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + [] + let main args = + let mode = getReadlineMode args + let env = Env.makeRootEnv () + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/step3_env.fs b/impls/fsharp/step3_env.fs new file mode 100644 index 0000000000..62652008f6 --- /dev/null +++ b/impls/fsharp/step3_env.fs @@ -0,0 +1,99 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec defBang env = function + | [sym; node] -> + match sym with + | Symbol(sym) -> + let node = eval env node + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStar env = function + | [bindings; form] -> + let newEnv = Env.makeNew env [] [] + let binder = setBinding newEnv + match bindings with + | List(_, _) | Vector(_, _) -> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + eval newEnv form + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBang env rest + | List(_, Symbol("let*")::rest) -> letStar env rest + | List(_, (a0 :: rest)) -> + match eval env a0 with + | BuiltInFunc(_, _, f) -> List.map (eval env) rest |> f + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let REP env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + [] + let main args = + let mode = getReadlineMode args + let env = Env.makeRootEnv () + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/step4_if_fn_do.fs b/impls/fsharp/step4_if_fn_do.fs new file mode 100644 index 0000000000..d673819727 --- /dev/null +++ b/impls/fsharp/step4_if_fn_do.fs @@ -0,0 +1,143 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec defBangForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStarForm env = function + | [bindings; form] -> + let newEnv = Env.makeNew env [] [] + let binder = setBinding newEnv + match bindings with + | List(_, _) | Vector(_, _) -> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + eval newEnv form + | _ -> raise <| Error.wrongArity () + + and ifForm env = function + | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm + | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil + | _ -> raise <| Error.wrongArity () + + and ifForm3 env condForm trueForm falseForm = + match eval env condForm with + | Bool(false) | Nil -> eval env falseForm + | _ -> eval env trueForm + + and doForm env = function + | [a] -> eval env a + | a::rest -> + eval env a |> ignore + doForm env rest + | _ -> raise <| Error.wrongArity () + + and fnStarForm outer nodes = + let makeFunc binds body = + let f = fun nodes -> + let inner = Env.makeNew outer binds nodes + eval inner body + Env.makeFunc f body binds outer + + match nodes with + | [List(_, binds); body] -> makeFunc binds body + | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body + | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBangForm env rest + | List(_, Symbol("let*")::rest) -> letStarForm env rest + | List(_, Symbol("if")::rest) -> ifForm env rest + | List(_, Symbol("do")::rest) -> doForm env rest + | List(_, Symbol("fn*")::rest) -> fnStarForm env rest + | List(_, (a0 :: rest)) -> + let args = List.map (eval env) rest + match eval env a0 with + | BuiltInFunc(_, _, f) -> f args + | Func(_, _, _, body, binds, outer) -> + let inner = Env.makeNew outer binds args + body |> eval inner + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let RE env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + + let REP env input = + input + |> RE env + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + [] + let main args = + let mode = getReadlineMode args + let env = Env.makeRootEnv () + + RE env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore + + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/step5_tco.fs b/impls/fsharp/step5_tco.fs new file mode 100644 index 0000000000..c175206ffa --- /dev/null +++ b/impls/fsharp/step5_tco.fs @@ -0,0 +1,145 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec defBangForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStarForm outer = function + | [bindings; form] -> + let inner = Env.makeNew outer [] [] + let binder = setBinding inner + match bindings with + | List(_, _) | Vector(_, _)-> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + inner, form + | _ -> raise <| Error.wrongArity () + + and ifForm env = function + | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm + | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil + | _ -> raise <| Error.wrongArity () + + and ifForm3 env condForm trueForm falseForm = + match eval env condForm with + | Bool(false) | Nil -> falseForm + | _ -> trueForm + + and doForm env = function + | [a] -> a + | a::rest -> + eval env a |> ignore + doForm env rest + | _ -> raise <| Error.wrongArity () + + and fnStarForm outer nodes = + let makeFunc binds body = + let f = fun nodes -> + let inner = Env.makeNew outer binds nodes + eval inner body + Env.makeFunc f body binds outer + + match nodes with + | [List(_, binds); body] -> makeFunc binds body + | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body + | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBangForm env rest + | List(_, Symbol("let*")::rest) -> + let inner, form = letStarForm env rest + form |> eval inner + | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env + | List(_, Symbol("do")::rest) -> doForm env rest |> eval env + | List(_, Symbol("fn*")::rest) -> fnStarForm env rest + | List(_, (a0 :: rest)) -> + let args = List.map (eval env) rest + match eval env a0 with + | BuiltInFunc(_, _, f) -> f args + | Func(_, _, _, body, binds, outer) -> + let inner = Env.makeNew outer binds args + body |> eval inner + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let RE env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + + let REP env input = + input + |> RE env + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + [] + let main args = + let mode = getReadlineMode args + let env = Env.makeRootEnv () + + RE env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore + + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/step6_file.fs b/impls/fsharp/step6_file.fs new file mode 100644 index 0000000000..181d12db70 --- /dev/null +++ b/impls/fsharp/step6_file.fs @@ -0,0 +1,171 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec defBangForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStarForm outer = function + | [bindings; form] -> + let inner = Env.makeNew outer [] [] + let binder = setBinding inner + match bindings with + | List(_, _) | Vector(_, _)-> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + inner, form + | _ -> raise <| Error.wrongArity () + + and ifForm env = function + | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm + | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil + | _ -> raise <| Error.wrongArity () + + and ifForm3 env condForm trueForm falseForm = + match eval env condForm with + | Bool(false) | Nil -> falseForm + | _ -> trueForm + + and doForm env = function + | [a] -> a + | a::rest -> + eval env a |> ignore + doForm env rest + | _ -> raise <| Error.wrongArity () + + and fnStarForm outer nodes = + let makeFunc binds body = + let f = fun nodes -> + let inner = Env.makeNew outer binds nodes + eval inner body + Env.makeFunc f body binds outer + + match nodes with + | [List(_, binds); body] -> makeFunc binds body + | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body + | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBangForm env rest + | List(_, Symbol("let*")::rest) -> + let inner, form = letStarForm env rest + form |> eval inner + | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env + | List(_, Symbol("do")::rest) -> doForm env rest |> eval env + | List(_, Symbol("fn*")::rest) -> fnStarForm env rest + | List(_, (a0 :: rest)) -> + let args = List.map (eval env) rest + match eval env a0 with + | BuiltInFunc(_, _, f) -> f args + | Func(_, _, _, body, binds, outer) -> + let inner = Env.makeNew outer binds args + body |> eval inner + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let RE env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + + let REP env input = + input + |> RE env + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + let eval_func env = function + | [ast] -> eval env ast + | _ -> raise <| Error.wrongArity () + + let argv_func = function + | file::rest -> rest |> List.map Types.String |> makeList + | [] -> EmptyLIST + + let configureEnv args = + let env = Env.makeRootEnv () + + Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) + Env.set env "*ARGV*" <| argv_func args + + RE env """ + (def! not (fn* (a) (if a false true))) + (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + """ |> Seq.iter ignore + + env + + [] + let main args = + let mode = getReadlineMode args + let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq + let env = configureEnv args + + match args with + | file::_ -> + System.IO.File.ReadAllText file + |> RE env |> Seq.iter ignore + 0 + | _ -> + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/step7_quote.fs b/impls/fsharp/step7_quote.fs new file mode 100644 index 0000000000..232bbc1f89 --- /dev/null +++ b/impls/fsharp/step7_quote.fs @@ -0,0 +1,195 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast + + let quoteForm = function + | [node] -> node + | _ -> raise <| Error.wrongArity () + + let rec defBangForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStarForm outer = function + | [bindings; form] -> + let inner = Env.makeNew outer [] [] + let binder = setBinding inner + match bindings with + | List(_) | Vector(_) -> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + inner, form + | _ -> raise <| Error.wrongArity () + + and ifForm env = function + | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm + | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil + | _ -> raise <| Error.wrongArity () + + and ifForm3 env condForm trueForm falseForm = + match eval env condForm with + | Bool(false) | Nil -> falseForm + | _ -> trueForm + + and doForm env = function + | [a] -> a + | a::rest -> + eval env a |> ignore + doForm env rest + | _ -> raise <| Error.wrongArity () + + and fnStarForm outer nodes = + let makeFunc binds body = + let f = fun nodes -> + let inner = Env.makeNew outer binds nodes + eval inner body + Env.makeFunc f body binds outer + + match nodes with + | [List(_, binds); body] -> makeFunc binds body + | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body + | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBangForm env rest + | List(_, Symbol("let*")::rest) -> + let inner, form = letStarForm env rest + form |> eval inner + | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env + | List(_, Symbol("do")::rest) -> doForm env rest |> eval env + | List(_, Symbol("fn*")::rest) -> fnStarForm env rest + | List(_, Symbol("quote")::rest) -> quoteForm rest + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () + | List(_, (a0 :: rest)) -> + let args = List.map (eval env) rest + match eval env a0 with + | BuiltInFunc(_, _, f) -> f args + | Func(_, _, _, body, binds, outer) -> + let inner = Env.makeNew outer binds args + body |> eval inner + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let RE env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + + let REP env input = + input + |> RE env + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + let eval_func env = function + | [ast] -> eval env ast + | _ -> raise <| Error.wrongArity () + + let argv_func = function + | file::rest -> rest |> List.map Types.String |> makeList + | [] -> EmptyLIST + + let configureEnv args = + let env = Env.makeRootEnv () + + Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) + Env.set env "*ARGV*" <| argv_func args + + RE env """ + (def! not (fn* (a) (if a false true))) + (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + """ |> Seq.iter ignore + + env + + [] + let main args = + let mode = getReadlineMode args + let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq + let env = configureEnv args + + match args with + | file::_ -> + System.IO.File.ReadAllText file + |> RE env |> Seq.iter ignore + 0 + | _ -> + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/step8_macros.fs b/impls/fsharp/step8_macros.fs new file mode 100644 index 0000000000..1e5c1e781b --- /dev/null +++ b/impls/fsharp/step8_macros.fs @@ -0,0 +1,211 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast + + let quoteForm = function + | [node] -> node + | _ -> raise <| Error.wrongArity () + + let rec defBangForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and defMacroForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + match node with + | Func(_, _, f, body, binds, outer) -> + let node = Env.makeMacro f body binds outer + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "user defined func" + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStarForm outer = function + | [bindings; form] -> + let inner = Env.makeNew outer [] [] + let binder = setBinding inner + match bindings with + | List(_) | Vector(_) -> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + inner, form + | _ -> raise <| Error.wrongArity () + + and ifForm env = function + | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm + | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil + | _ -> raise <| Error.wrongArity () + + and ifForm3 env condForm trueForm falseForm = + match eval env condForm with + | Bool(false) | Nil -> falseForm + | _ -> trueForm + + and doForm env = function + | [a] -> a + | a::rest -> + eval env a |> ignore + doForm env rest + | _ -> raise <| Error.wrongArity () + + and fnStarForm outer nodes = + let makeFunc binds body = + let f = fun nodes -> + let inner = Env.makeNew outer binds nodes + eval inner body + Env.makeFunc f body binds outer + + match nodes with + | [List(_, binds); body] -> makeFunc binds body + | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body + | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBangForm env rest + | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest + | List(_, Symbol("let*")::rest) -> + let inner, form = letStarForm env rest + form |> eval inner + | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env + | List(_, Symbol("do")::rest) -> doForm env rest |> eval env + | List(_, Symbol("fn*")::rest) -> fnStarForm env rest + | List(_, Symbol("quote")::rest) -> quoteForm rest + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () + | List(_, (a0 :: args)) -> + match eval env a0 with + | Macro(_, _, f, _, _, _) -> f args |> eval env + | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f + | Func(_, _, _, body, binds, outer) -> + let inner = List.map (eval env) args |> Env.makeNew outer binds + body |> eval inner + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let RE env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + + let REP env input = + input + |> RE env + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + let eval_func env = function + | [ast] -> eval env ast + | _ -> raise <| Error.wrongArity () + + let argv_func = function + | file::rest -> rest |> List.map Types.String |> makeList + | [] -> EmptyLIST + + let configureEnv args = + let env = Env.makeRootEnv () + + Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) + Env.set env "*ARGV*" <| argv_func args + + RE env """ + (def! not (fn* (a) (if a false true))) + (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) + """ |> Seq.iter ignore + + env + + [] + let main args = + let mode = getReadlineMode args + let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq + let env = configureEnv args + + match args with + | file::_ -> + System.IO.File.ReadAllText file + |> RE env |> Seq.iter ignore + 0 + | _ -> + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/step9_try.fs b/impls/fsharp/step9_try.fs new file mode 100644 index 0000000000..ba8e1f37d2 --- /dev/null +++ b/impls/fsharp/step9_try.fs @@ -0,0 +1,233 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast + + let quoteForm = function + | [node] -> node + | _ -> raise <| Error.wrongArity () + + let rec defBangForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and defMacroForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + match node with + | Func(_, _, f, body, binds, outer) -> + let node = Env.makeMacro f body binds outer + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "user defined func" + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStarForm outer = function + | [bindings; form] -> + let inner = Env.makeNew outer [] [] + let binder = setBinding inner + match bindings with + | List(_) | Vector(_) -> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + inner, form + | _ -> raise <| Error.wrongArity () + + and ifForm env = function + | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm + | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil + | _ -> raise <| Error.wrongArity () + + and ifForm3 env condForm trueForm falseForm = + match eval env condForm with + | Bool(false) | Nil -> falseForm + | _ -> trueForm + + and doForm env = function + | [a] -> a + | a::rest -> + eval env a |> ignore + doForm env rest + | _ -> raise <| Error.wrongArity () + + and fnStarForm outer nodes = + let makeFunc binds body = + let f = fun nodes -> + let inner = Env.makeNew outer binds nodes + eval inner body + Env.makeFunc f body binds outer + + match nodes with + | [List(_, binds); body] -> makeFunc binds body + | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body + | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" + | _ -> raise <| Error.wrongArity () + + and catchForm env err = function + | List(_, [Symbol("catch*"); Symbol(_) as sym; catchBody]) -> + let inner = Env.makeNew env [sym] [err] + catchBody |> eval inner + | List(_, [_; _; _]) -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + + and tryForm env = function + | [exp] -> + eval env exp + | [exp; catchClause] -> + try + eval env exp + with + | Error.EvalError(str) -> catchForm env (String(str)) catchClause + | Error.MalError(node) -> catchForm env node catchClause + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBangForm env rest + | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest + | List(_, Symbol("let*")::rest) -> + let inner, form = letStarForm env rest + form |> eval inner + | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env + | List(_, Symbol("do")::rest) -> doForm env rest |> eval env + | List(_, Symbol("fn*")::rest) -> fnStarForm env rest + | List(_, Symbol("quote")::rest) -> quoteForm rest + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () + | List(_, Symbol("try*")::rest) -> tryForm env rest + | List(_, (a0 :: args)) -> + match eval env a0 with + | Macro(_, _, f, _, _, _) -> f args |> eval env + | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f + | Func(_, _, _, body, binds, outer) -> + let inner = List.map (eval env) args |> Env.makeNew outer binds + body |> eval inner + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let RE env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + + let REP env input = + input + |> RE env + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + let eval_func env = function + | [ast] -> eval env ast + | _ -> raise <| Error.wrongArity () + + let argv_func = function + | file::rest -> rest |> List.map Types.String |> makeList + | [] -> EmptyLIST + + let configureEnv args = + let env = Env.makeRootEnv () + + Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) + Env.set env "*ARGV*" <| argv_func args + + RE env """ + (def! not (fn* (a) (if a false true))) + (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) + """ |> Seq.iter ignore + + env + + [] + let main args = + let mode = getReadlineMode args + let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq + let env = configureEnv args + + match args with + | file::_ -> + System.IO.File.ReadAllText file + |> RE env |> Seq.iter ignore + 0 + | _ -> + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | Error.MalError(node) -> + printfn "Error: %s" (Printer.pr_str [node]) + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/impls/fsharp/stepA_mal.fs b/impls/fsharp/stepA_mal.fs new file mode 100644 index 0000000000..af2f4b69a5 --- /dev/null +++ b/impls/fsharp/stepA_mal.fs @@ -0,0 +1,245 @@ +module REPL + open System + open Node + open Types + + let rec iterPairs f = function + | Pair(first, second, t) -> + f first second + iterPairs f t + | Empty -> () + | _ -> raise <| Error.errExpectedX "list or vector" + + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast + + let quoteForm = function + | [node] -> node + | _ -> raise <| Error.wrongArity () + + let rec defBangForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and defMacroForm env = function + | [sym; form] -> + match sym with + | Symbol(sym) -> + let node = eval env form + match node with + | Func(_, _, f, body, binds, outer) -> + let node = Env.makeMacro f body binds outer + Env.set env sym node + node + | _ -> raise <| Error.errExpectedX "user defined func" + | _ -> raise <| Error.errExpectedX "symbol" + | _ -> raise <| Error.wrongArity () + + and setBinding env first second = + let s = match first with + | Symbol(s) -> s + | _ -> raise <| Error.errExpectedX "symbol" + let form = eval env second + Env.set env s form + + and letStarForm outer = function + | [bindings; form] -> + let inner = Env.makeNew outer [] [] + let binder = setBinding inner + match bindings with + | List(_) | Vector(_) -> iterPairs binder bindings + | _ -> raise <| Error.errExpectedX "list or vector" + inner, form + | _ -> raise <| Error.wrongArity () + + and ifForm env = function + | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm + | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil + | _ -> raise <| Error.wrongArity () + + and ifForm3 env condForm trueForm falseForm = + match eval env condForm with + | Bool(false) | Nil -> falseForm + | _ -> trueForm + + and doForm env = function + | [a] -> a + | a::rest -> + eval env a |> ignore + doForm env rest + | _ -> raise <| Error.wrongArity () + + and fnStarForm outer nodes = + let makeFunc binds body = + let f = fun nodes -> + let inner = Env.makeNew outer binds nodes + eval inner body + Env.makeFunc f body binds outer + + match nodes with + | [List(_, binds); body] -> makeFunc binds body + | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body + | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" + | _ -> raise <| Error.wrongArity () + + and catchForm env err = function + | List(_, [Symbol("catch*"); Symbol(_) as sym; catchBody]) -> + let inner = Env.makeNew env [sym] [err] + catchBody |> eval inner + | List(_, [_; _; _]) -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + + and tryForm env = function + | [exp] -> + eval env exp + | [exp; catchClause] -> + try + eval env exp + with + | Error.EvalError(str) + | Error.ReaderError(str) -> catchForm env (String(str)) catchClause + | Error.MalError(node) -> catchForm env node catchClause + | _ -> raise <| Error.wrongArity () + + and eval env ast = + ignore <| match Env.get env "DEBUG-EVAL" with + | None | Some(Bool(false)) | Some(Nil) -> () + | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" + match ast with + | Symbol(sym) -> match Env.get env sym with + | Some(value) -> value + | None -> Error.symbolNotFound sym |> raise + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap + | List(_, Symbol("def!")::rest) -> defBangForm env rest + | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest + | List(_, Symbol("let*")::rest) -> + let inner, form = letStarForm env rest + form |> eval inner + | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env + | List(_, Symbol("do")::rest) -> doForm env rest |> eval env + | List(_, Symbol("fn*")::rest) -> fnStarForm env rest + | List(_, Symbol("quote")::rest) -> quoteForm rest + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () + | List(_, Symbol("try*")::rest) -> tryForm env rest + | List(_, (a0 :: args)) -> + match eval env a0 with + | Macro(_, _, f, _, _, _) -> f args |> eval env + | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f + | Func(_, _, _, body, binds, outer) -> + let inner = List.map (eval env) args |> Env.makeNew outer binds + body |> eval inner + | _ -> raise <| Error.errExpectedX "func" + | _ -> ast + + let READ input = + Reader.read_str input + + let EVAL env ast = + Some(eval env ast) + + let PRINT v = + v + |> Seq.singleton + |> Printer.pr_str + |> printfn "%s" + + let RE env input = + READ input + |> Seq.ofList + |> Seq.choose (fun form -> EVAL env form) + + let REP env input = + input + |> RE env + |> Seq.iter (fun value -> PRINT value) + + let getReadlineMode args = + if args |> Array.exists (fun e -> e = "--raw") then + Readline.Mode.Raw + else + Readline.Mode.Terminal + + let eval_func env = function + | [ast] -> eval env ast + | _ -> raise <| Error.wrongArity () + + let argv_func = function + | file::rest -> rest |> List.map Types.String |> makeList + | [] -> EmptyLIST + + let readline_func mode = function + | [String(prompt)] -> + match Readline.read prompt mode with + | null -> Node.NIL + | input -> String(input) + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + + let configureEnv args mode = + let env = Env.makeRootEnv () + + Env.set env "eval" <| Env.makeBuiltInFunc (eval_func env) + Env.set env "*ARGV*" <| argv_func args + Env.set env "readline" <| Env.makeBuiltInFunc (readline_func mode) + + RE env """ + (def! *host-language* "fsharp") + (def! not (fn* (a) (if a false true))) + (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) + """ |> Seq.iter ignore + + env + + [] + let main args = + let mode = getReadlineMode args + let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq + let env = configureEnv args mode + + match args with + | file::_ -> + System.IO.File.ReadAllText file + |> RE env |> Seq.iter ignore + 0 + | _ -> + RE env "(println (str \"Mal [\" *host-language* \"]\"))" |> Seq.iter ignore + let rec loop () = + match Readline.read "user> " mode with + | null -> 0 + | input -> + try + REP env input + with + | Error.EvalError(str) + | Error.ReaderError(str) -> + printfn "Error: %s" str + | Error.MalError(node) -> + printfn "Error: %s" (Printer.pr_str [node]) + | ex -> + printfn "Error: %s" (ex.Message) + loop () + loop () diff --git a/cs/getline.cs b/impls/fsharp/terminal.cs similarity index 100% rename from cs/getline.cs rename to impls/fsharp/terminal.cs diff --git a/impls/fsharp/tests/step5_tco.mal b/impls/fsharp/tests/step5_tco.mal new file mode 100644 index 0000000000..db45a80336 --- /dev/null +++ b/impls/fsharp/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; F#: skipping non-TCO recursion +;; Reason: completes at 10,000, unrecoverable segfault at 20,000 diff --git a/impls/fsharp/tokenizer.fs b/impls/fsharp/tokenizer.fs new file mode 100644 index 0000000000..6bfbc74159 --- /dev/null +++ b/impls/fsharp/tokenizer.fs @@ -0,0 +1,115 @@ +module Tokenizer + + open System + open Types + + type Token = + | EOF + | OpenBracket | CloseBracket + | OpenBrace | CloseBrace + | OpenParen | CloseParen + | SingleQuote + | Backtick + | Tilde | SpliceUnquote + | Caret + | At + | String of string + | Token of string + | Keyword of string + | Number of string + + + let tokenize (str : string) = + let len = str.Length + + let inline isWhiteSpace ch = ch = ',' || Char.IsWhiteSpace(ch) + let inline isNotNewline ch = ch <> '\r' && ch <> '\n' + let inline isDigit ch = Char.IsDigit(ch) + let inline isTokenChar ch = + match ch with + | '[' | ']' | '{' | '}' | '(' | ')' + | '\'' | '"' | '`' | ',' | ';' -> false + | ch when Char.IsWhiteSpace(ch) -> false + | _ -> true + + let rec skipWhile pred p = + if p >= len then p + elif pred (str.[p]) then p + 1 |> skipWhile pred + else p + + let rec accumulateWhile pred (f : string -> Token) start p = + if p >= len then str.Substring(start, p - start) |> f, p + elif pred (str.[p]) then p + 1 |> accumulateWhile pred f start + else str.Substring(start, p - start) |> f, p + + let accumulateString p = + let b = System.Text.StringBuilder() + let rec accChar (ch : char) n = + b.Append(ch) |> ignore + accChars n + and accChars p = + let n = p + 1 + if p >= len then raise <| Error.expectedXButEOF "'\"'" + match str.[p] with + | '\\' -> accEscaped n + | '"' -> n + | ch -> accChar ch n + and accEscaped p = + let n = p + 1 + if p >= len then raise <| Error.expectedXButEOF "char" + match str.[p] with + | 't' -> accChar '\t' n + | 'b' -> accChar '\b' n + | 'n' -> accChar '\n' n + | 'r' -> accChar '\r' n + | 'f' -> accChar '\f' n + | '\'' -> accChar '\'' n + | '"' -> accChar '"' n + | '\\' -> accChar '\\' n + | _ -> raise <| Error.expectedXButEOF "valid escape char" + let n = accChars p + String(b.ToString()), n + + let accumulateKeyword p = + let n = p + 1 + if p >= len then raise <| Error.expectedXButEOF "keyword" + elif isTokenChar str.[p] then accumulateWhile isTokenChar Keyword p n + else raise <| Error.expectedX "keyword char" + + let accumulateSpliceUnquote p = + if p >= len then Tilde, p + elif str.[p] = '@' then SpliceUnquote, (p + 1) + else Tilde, p + + let rec getToken p = + if p >= len then + EOF, p + else + let n = p + 1 + match str.[p] with + | ch when isWhiteSpace ch -> getToken n + | ';' -> skipWhile isNotNewline n |> getToken + | '[' -> OpenBracket, n + | ']' -> CloseBracket, n + | '{' -> OpenBrace, n + | '}' -> CloseBrace, n + | '(' -> OpenParen, n + | ')' -> CloseParen, n + | '\'' -> SingleQuote, n + | '`' -> Backtick, n + | '~' -> accumulateSpliceUnquote n + | '^' -> Caret, n + | '@' -> At, n + | '"' -> accumulateString n + | ':' -> accumulateKeyword n + | '-' when n < len && isDigit str.[n] -> accumulateWhile isDigit Number p n + | ch when isDigit ch -> accumulateWhile isDigit Number p n + | ch when isTokenChar ch -> accumulateWhile isTokenChar Token p n + | _ -> raise <| Error.unexpectedChar () + + let rec accumulate acc p = + match getToken p with + | EOF, p -> List.rev acc + | tok, p -> accumulate (tok::acc) p + + accumulate [] 0 diff --git a/impls/fsharp/types.fs b/impls/fsharp/types.fs new file mode 100644 index 0000000000..f58e98e2fd --- /dev/null +++ b/impls/fsharp/types.fs @@ -0,0 +1,134 @@ +module Types + + [] + type Node = + | Nil + | List of Metadata * Node list + | Vector of Metadata * Node System.ArraySegment + | Map of Metadata * Collections.Map + | Symbol of string + | Keyword of string + | Number of int64 + | String of string + | Bool of bool + | BuiltInFunc of Metadata * int * (Node list -> Node) + | Func of Metadata * int * (Node list -> Node) * Node * Node list * EnvChain + | Macro of Metadata * int * (Node list -> Node) * Node * Node list * EnvChain + | Atom of int * Node Ref + + static member private hashSeq (s : seq) = + let iter st node = (st * 397) ^^^ node.GetHashCode() + s |> Seq.fold iter 0 + + static member private allEqual (x : seq) (y : seq) = + use ex = x.GetEnumerator() + use ey = y.GetEnumerator() + let rec loop () = + match ex.MoveNext(), ey.MoveNext() with + | false, false -> true + | false, true + | true, false -> false + | true, true -> + if ex.Current = ey.Current then + loop () + else + false + loop () + + static member private allCompare (x : seq) (y : seq) = + use ex = x.GetEnumerator() + use ey = y.GetEnumerator() + let rec loop () = + match ex.MoveNext(), ey.MoveNext() with + | false, false -> 0 + | false, true -> -1 + | true, false -> 1 + | true, true -> + let cmp = compare ex.Current ey.Current + if cmp = 0 then loop () else cmp + loop () + + static member private rank x = + match x with + | Nil -> 0 + | List(_, _) -> 1 + | Vector(_, _) -> 2 + | Map(_, _) -> 3 + | Symbol(_) -> 4 + | Keyword(_) -> 5 + | Number(_) -> 6 + | String(_) -> 7 + | Bool(_) -> 8 + | BuiltInFunc(_, _, _) + | Func(_, _, _, _, _, _) + | Macro(_, _, _, _, _, _) -> 9 + | Atom(_, _) -> 10 + + static member private equals x y = + match x, y with + | Nil, Nil -> true + | List(_, a), List(_, b) -> a = b + | List(_, a), Vector(_, b) -> Node.allEqual a b + | Vector(_, a), List(_, b) -> Node.allEqual a b + | Vector(_, a), Vector(_, b) -> Node.allEqual a b + | Map(_, a), Map(_, b) -> a = b + | Symbol(a), Symbol(b) -> a = b + | Keyword(a), Keyword(b) -> a = b + | Number(a), Number(b) -> a = b + | String(a), String(b) -> a = b + | Bool(a), Bool(b) -> a = b + | (BuiltInFunc(_, a, _) | Func(_, a, _, _, _, _) | Macro(_, a, _, _, _, _)), + (BuiltInFunc(_, b, _) | Func(_, b, _, _, _, _) | Macro(_, b, _, _, _, _)) -> + a = b + | Atom(a, _), Atom(b, _) -> a = b + | _, _ -> false + + static member private compare x y = + match x, y with + | Nil, Nil -> 0 + | List(_, a), List(_, b) -> compare a b + | List(_, a), Vector(_, b) -> Node.allCompare a b + | Vector(_, a), List(_, b) -> Node.allCompare a b + | Vector(_, a), Vector(_, b) -> Node.allCompare a b + | Map(_, a), Map(_, b) -> compare a b + | Symbol(a), Symbol(b) -> compare a b + | Keyword(a), Keyword(b) -> compare a b + | Number(a), Number(b) -> compare a b + | String(a), String(b) -> compare a b + | Bool(a), Bool(b) -> compare a b + | (BuiltInFunc(_, a, _) | Func(_, a, _, _, _, _) | Macro(_, a, _, _, _, _)), + (BuiltInFunc(_, b, _) | Func(_, b, _, _, _, _) | Macro(_, b, _, _, _, _)) -> + compare a b + | Atom(a, _), Atom(b, _) -> compare a b + | a, b -> compare (Node.rank a) (Node.rank b) + + override x.Equals yobj = + match yobj with + | :? Node as y -> Node.equals x y + | _ -> false + + override x.GetHashCode() = + match x with + | Nil -> 0 + | List(_, lst) -> hash lst + | Vector(_, vec) -> Node.hashSeq vec + | Map(_, map) -> hash map + | Symbol(sym) -> hash sym + | Keyword(key) -> hash key + | Number(num) -> hash num + | String(str) -> hash str + | Bool(b) -> hash b + | BuiltInFunc(_, tag, _) | Func(_, tag, _, _, _, _) | Macro(_, tag, _, _, _, _) -> + hash tag + | Atom(tag, _) -> hash tag + + interface System.IComparable with + member x.CompareTo yobj = + match yobj with + | :? Node as y -> Node.compare x y + | _ -> invalidArg "yobj" "Cannot compare values of different types." + + + and Env = System.Collections.Generic.Dictionary + and EnvChain = Env list + and Metadata = Node diff --git a/impls/gnu-smalltalk/Dockerfile b/impls/gnu-smalltalk/Dockerfile new file mode 100644 index 0000000000..d48238b785 --- /dev/null +++ b/impls/gnu-smalltalk/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install gnu-smalltalk libreadline-dev diff --git a/impls/gnu-smalltalk/Makefile b/impls/gnu-smalltalk/Makefile new file mode 100644 index 0000000000..7af3113c71 --- /dev/null +++ b/impls/gnu-smalltalk/Makefile @@ -0,0 +1,3 @@ +all: + +clean: diff --git a/impls/gnu-smalltalk/core.st b/impls/gnu-smalltalk/core.st new file mode 100644 index 0000000000..4509facdac --- /dev/null +++ b/impls/gnu-smalltalk/core.st @@ -0,0 +1,255 @@ +Object subclass: Core [ + Ns := Dictionary new. + Core class >> Ns [ ^Ns ] + + Core class >> coerce: block [ + block value ifTrue: [ ^MALObject True ] ifFalse: [ ^MALObject False ] + ] + + Core class >> nilable: args else: block [ + args first type = #nil ifTrue: [ + ^MALObject Nil + ] ifFalse: [ + ^block value + ] + ] + + Core class >> printedArgs: args readable: readable sep: sep [ + | items | + items := args collect: + [ :arg | Printer prStr: arg printReadably: readable ]. + "NOTE: {} join returns the unchanged array" + items isEmpty ifTrue: [ ^'' ] ifFalse: [ ^items join: sep ] + ] +] + +Core Ns at: #+ put: + (Fn new: [ :args | MALNumber new: args first value + args second value ]). +Core Ns at: #- put: + (Fn new: [ :args | MALNumber new: args first value - args second value ]). +Core Ns at: #* put: + (Fn new: [ :args | MALNumber new: args first value * args second value ]). +Core Ns at: #/ put: + (Fn new: [ :args | MALNumber new: args first value // args second value ]). + +Core Ns at: #'pr-str' put: + (Fn new: [ :args | MALString new: (Core printedArgs: args readable: true + sep: ' ') ]). +Core Ns at: #str put: + (Fn new: [ :args | MALString new: (Core printedArgs: args readable: false + sep: '') ]). +Core Ns at: #prn put: + (Fn new: [ :args | + (Core printedArgs: args readable: true sep: ' ') displayNl. + MALObject Nil ]). +Core Ns at: #println put: + (Fn new: [ :args | + (Core printedArgs: args readable: false sep: ' ') displayNl. + MALObject Nil ]). + +Core Ns at: #list put: + (Fn new: [ :args | MALList new: (OrderedCollection from: args) ]). +Core Ns at: #'list?' put: + (Fn new: [ :args | Core coerce: [ args first type = #list ] ]). +Core Ns at: #'empty?' put: + (Fn new: [ :args | Core coerce: [ args first value isEmpty ] ]). +Core Ns at: #count put: + (Fn new: [ :args | MALNumber new: args first value size ]). + +Core Ns at: #= put: + (Fn new: [ :args | Core coerce: [ args first = args second ] ]). + +Core Ns at: #< put: + (Fn new: [ :args | Core coerce: [ args first value < args second value ] ]). +Core Ns at: #<= put: + (Fn new: [ :args | Core coerce: [ args first value <= args second value ] ]). +Core Ns at: #> put: + (Fn new: [ :args | Core coerce: [ args first value > args second value ] ]). +Core Ns at: #>= put: + (Fn new: [ :args | Core coerce: [ args first value >= args second value ] ]). + +Core Ns at: #'read-string' put: + (Fn new: [ :args | Reader readStr: args first value ]). +Core Ns at: #slurp put: + (Fn new: [ :args | MALString new: (File path: args first value) contents ]). +Core Ns at: #throw put: + (Fn new: [ :args | MALCustomError new signal: args first ]). +Core Ns at: #readline put: + (Fn new: [ :args | + | result | + result := ReadLine readLine: args first value. + result isString ifTrue: [ + MALString new: result + ] ifFalse: [ + MALObject Nil + ] ]). +Core Ns at: #'time-ms' put: + (Fn new: [ :args | MALNumber new: Time millisecondClock ]). +Core Ns at: #'gst-eval' put: + (Fn new: [ :args | (Behavior evaluate: args first value) toMALValue ]). + +Core Ns at: #atom put: + (Fn new: [ :args | MALAtom new: args first ]). +Core Ns at: #'atom?' put: + (Fn new: [ :args | Core coerce: [ args first type = #atom ] ]). +Core Ns at: #deref put: + (Fn new: [ :args | args first value ]). +Core Ns at: #'reset!' put: + (Fn new: [ :args | args first value: args second. args second ]). +Core Ns at: #'swap!' put: + (Fn new: [ :args | + | a f x xs result | + a := args first. + f := args second fn. + x := a value. + xs := args allButFirst: 2. + result := f value: (xs copyWithFirst: x). + a value: result. + result ]). + +Core Ns at: #cons put: + (Fn new: [ :args | MALList new: (args second value copyWithFirst: args first) ]). +Core Ns at: #concat put: + (Fn new: [ :args | MALList new: (OrderedCollection join: + (args collect: [ :arg | arg value ])) ]). +Core Ns at: #nth put: + (Fn new: [ :args | + | items index | + items := args first value. + index := args second value + 1. + items at: index ifAbsent: [ MALOutOfBounds new signal ] ]). +Core Ns at: #first put: + (Fn new: [ :args | Core nilable: args else: [ + args first value at: 1 ifAbsent: [ MALObject Nil ] ] ]). +Core Ns at: #rest put: + (Fn new: [ :args | + | items rest | + items := args first value. + (args first type = #nil or: [ items isEmpty ]) ifTrue: [ + rest := {} + ] ifFalse: [ + rest := items allButFirst + ]. + MALList new: (OrderedCollection from: rest) ]). +Core Ns at: #conj put: + (Fn new: [ :args | + | kind result items | + kind := args first type. + result := args first value. + items := args allButFirst. + + kind = #list ifTrue: [ + MALList new: (OrderedCollection from: items reverse, result) + ] ifFalse: [ + MALVector new: (OrderedCollection from: result, items) + ] ]). +Core Ns at: #seq put: + (Fn new: [ :args | + | kind storage result | + kind := args first type. + storage := args first value. + Core nilable: args else: [ + storage isEmpty ifTrue: [ + MALObject Nil + ] ifFalse: [ + kind = #string ifTrue: [ + result := (OrderedCollection from: storage) collect: + [ :char | MALString new: char asString ]. + MALList new: result + ] ifFalse: [ + MALList new: (OrderedCollection from: storage) + ] + ] + ] ]). + +Core Ns at: #apply put: + (Fn new: [ :args | + | f rest result | + f := args first fn. + args size < 3 ifTrue: [ + rest := {} + ] ifFalse: [ + rest := args copyFrom: 2 to: args size - 1 + ]. + rest := rest, args last value. + f value: rest ]). +Core Ns at: #map put: + (Fn new: [ :args | + | items f result | + f := args first fn. + items := args second value. + result := items collect: [ :item | f value: {item} ]. + MALList new: (OrderedCollection from: result) ]). + +Core Ns at: #meta put: + (Fn new: [ :args | + | meta | + meta := args first meta. + meta isNil ifTrue: [ MALObject Nil ] ifFalse: [ meta ] ]). +Core Ns at: #'with-meta' put: + (Fn new: [ :args | args first withMeta: args second ]). + +Core Ns at: #'nil?' put: + (Fn new: [ :args | Core coerce: [ args first type = #nil ] ]). +Core Ns at: #'true?' put: + (Fn new: [ :args | Core coerce: [ args first type = #true ] ]). +Core Ns at: #'false?' put: + (Fn new: [ :args | Core coerce: [ args first type = #false ] ]). +Core Ns at: #'number?' put: + (Fn new: [ :args | Core coerce: [ args first type = #number ] ]). +Core Ns at: #'symbol?' put: + (Fn new: [ :args | Core coerce: [ args first type = #symbol ] ]). +Core Ns at: #'keyword?' put: + (Fn new: [ :args | Core coerce: [ args first type = #keyword ] ]). +Core Ns at: #'string?' put: + (Fn new: [ :args | Core coerce: [ args first type = #string ] ]). +Core Ns at: #'vector?' put: + (Fn new: [ :args | Core coerce: [ args first type = #vector ] ]). +Core Ns at: #'map?' put: + (Fn new: [ :args | Core coerce: [ args first type = #map ] ]). +Core Ns at: #'sequential?' put: + (Fn new: [ :args | Core coerce: [ args first type = #list or: + [ args first type = #vector ] ] ]). +Core Ns at: #'fn?' put: + (Fn new: [ :args | Core coerce: [ args first type = #fn or: + [ args first type = #func and: + [ args first isMacro not ] ] ] ]). +Core Ns at: #'macro?' put: + (Fn new: [ :args | Core coerce: [ args first type = #func and: + [ args first isMacro ] ] ]). + +Core Ns at: #symbol put: + (Fn new: [ :args | MALSymbol new: args first value asSymbol ]). +Core Ns at: #keyword put: + (Fn new: [ :args | MALKeyword new: args first value asSymbol ]). +Core Ns at: #'vec' put: + (Fn new: [ :args | MALVector new: args first value ]). +Core Ns at: #vector put: + (Fn new: [ :args | MALVector new: (OrderedCollection from: args) ]). +Core Ns at: #'hash-map' put: + (Fn new: [ :args | MALMap new: args asDictionary ]). + +Core Ns at: #assoc put: + (Fn new: [ :args | + | result keyVals | + result := Dictionary from: args first value associations. + keyVals := args allButFirst. + 1 to: keyVals size by: 2 do: + [ :i | result add: (keyVals at: i) -> (keyVals at: i + 1) ]. + MALMap new: result ]). +Core Ns at: #dissoc put: + (Fn new: [ :args | + | result keys | + result := Dictionary from: args first value associations. + keys := args allButFirst. + keys do: [ :key | result removeKey: key ifAbsent: [ nil ] ]. + MALMap new: result ]). +Core Ns at: #get put: + (Fn new: [ :args | Core nilable: args else: + [ args first value at: args second ifAbsent: [ MALObject Nil ] ] ]). +Core Ns at: #'contains?' put: + (Fn new: [ :args | Core coerce: [ args first value includesKey: args second ] ]). +Core Ns at: #keys put: + (Fn new: [ :args | MALList new: (OrderedCollection from: args first value keys) ]). +Core Ns at: #vals put: + (Fn new: [ :args | MALList new: (OrderedCollection from: args first value values) ]). diff --git a/impls/gnu-smalltalk/env.st b/impls/gnu-smalltalk/env.st new file mode 100644 index 0000000000..22607f07c8 --- /dev/null +++ b/impls/gnu-smalltalk/env.st @@ -0,0 +1,40 @@ +Object subclass: Env [ + | data outer | + + Env class >> new: outerEnv [ + ^self new: outerEnv binds: {} exprs: {} + ] + + Env class >> new: outerEnv binds: binds exprs: exprs [ + | env | + env := super new. + env init: outerEnv binds: binds exprs: exprs. + ^env + ] + + init: env binds: binds exprs: exprs [ + data := Dictionary new. + outer := env. + 1 to: binds size do: + [ :i | (binds at: i) = #& ifTrue: [ + | rest | + rest := OrderedCollection from: (exprs copyFrom: i). + self set: (binds at: i + 1) value: (MALList new: rest). + ^nil + ] ifFalse: [ + self set: (binds at: i) value: (exprs at: i) + ] ] + ] + + set: key value: value [ + data at: key put: value. + ] + + get: key [ + ^data at: key ifAbsent: [ + outer isNil ifFalse: [ + outer get: key + ] + ] + ] +] diff --git a/impls/gnu-smalltalk/func.st b/impls/gnu-smalltalk/func.st new file mode 100644 index 0000000000..dc5e97fe65 --- /dev/null +++ b/impls/gnu-smalltalk/func.st @@ -0,0 +1,28 @@ +MALObject subclass: Func [ + | ast params env fn isMacro | + + ast [ ^ast ] + params [ ^params ] + env [ ^env ] + fn [ ^fn ] + isMacro [ ^isMacro ] + + isMacro: bool [ + isMacro := bool + ] + + Func class >> new: ast params: params env: env fn: fn [ + | func | + func := super new: #func value: fn meta: nil. + func init: ast params: params env: env fn: fn. + ^func + ] + + init: anAst params: someParams env: anEnv fn: aFn [ + ast := anAst. + params := someParams. + env := anEnv. + fn := aFn. + isMacro := false + ] +] diff --git a/impls/gnu-smalltalk/printer.st b/impls/gnu-smalltalk/printer.st new file mode 100644 index 0000000000..c86fc7ebf3 --- /dev/null +++ b/impls/gnu-smalltalk/printer.st @@ -0,0 +1,56 @@ +Object subclass: Printer [ + Printer class >> prStr: sexp printReadably: printReadably [ + sexp type = #fn ifTrue: [ ^'#' ]. + sexp type = #func ifTrue: [ ^'#' ]. + sexp type = #true ifTrue: [ ^'true' ]. + sexp type = #false ifTrue: [ ^'false' ]. + sexp type = #nil ifTrue: [ ^'nil' ]. + + sexp type = #number ifTrue: [ ^sexp value asString ]. + sexp type = #symbol ifTrue: [ ^sexp value asString ]. + sexp type = #keyword ifTrue: [ ^':', sexp value ]. + + sexp type = #string ifTrue: [ + printReadably ifTrue: [ + ^sexp value repr + ] ifFalse: [ + ^sexp value + ] + ]. + + sexp type = #list ifTrue: [ + ^self prList: sexp printReadably: printReadably + starter: '(' ender: ')' + ]. + sexp type = #vector ifTrue: [ + ^self prList: sexp printReadably: printReadably + starter: '[' ender: ']' + ]. + sexp type = #map ifTrue: [ + ^self prMap: sexp printReadably: printReadably + ]. + + sexp type = #atom ifTrue: [ + ^'(atom ', (self prStr: sexp value printReadably: printReadably), ')' + ]. + + Error halt: 'unimplemented type' + ] + + Printer class >> prList: sexp printReadably: printReadably + starter: starter ender: ender [ + | items | + items := sexp value collect: + [ :item | self prStr: item printReadably: printReadably ]. + ^starter, (items join: ' ') , ender + ] + + Printer class >> prMap: sexp printReadably: printReadably [ + | items | + items := sexp value associations collect: + [ :item | + (self prStr: item key printReadably: printReadably), ' ', + (self prStr: item value printReadably: printReadably) ]. + ^'{', (items join: ' '), '}' + ] +] diff --git a/impls/gnu-smalltalk/reader.st b/impls/gnu-smalltalk/reader.st new file mode 100644 index 0000000000..d2e347f9ed --- /dev/null +++ b/impls/gnu-smalltalk/reader.st @@ -0,0 +1,170 @@ +Object subclass: Reader [ + | storage index | + + TokenRegex := '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}(''"`,;)]*)'. + CommentRegex := ';.*'. + NumberRegex := '-?[0-9]+(?:\.[0-9]+)?'. + StringRegex := '"(?:\\.|[^\\"])*"'. + + Reader class >> tokenizer: input [ + | tokens token hit pos done | + tokens := OrderedCollection new. + pos := 1. + done := false. + + [done] whileFalse: [ + hit := input searchRegex: TokenRegex startingAt: pos. + token := hit at: 1. + token size = 0 ifTrue: [ + tokens add: (input copyFrom: pos to: input size) trimSeparators. + done := true. + ]. + (token size = 0 or: [token matchRegex: CommentRegex]) ifFalse: [ + tokens add: token + ]. + pos := pos + (hit match size). + pos > input size ifTrue: [ + done := true. + ]. + ]. + ^tokens + ] + + Reader class >> readStr: input [ + | tokens reader form | + tokens := self tokenizer: input. + reader := self new: tokens. + tokens isEmpty ifTrue: [ + ^MALEmptyInput new signal + ]. + ^self readForm: reader. + ] + + Reader class >> readForm: reader [ + | token | + token := reader peek. + token = '(' ifTrue: [ + ^self readList: reader class: MALList ender: ')' + ]. + token = '[' ifTrue: [ + ^self readList: reader class: MALVector ender: ']' + ]. + token = '{' ifTrue: [ + ^self readList: reader class: MALMap ender: '}' + ]. + + (token matchRegex: '[])}]') ifTrue: [ + ^MALUnexpectedToken new signal: token + ]. + + token = '''' ifTrue: [ + ^self readSimpleMacro: reader name: #quote + ]. + token = '`' ifTrue: [ + ^self readSimpleMacro: reader name: #quasiquote + ]. + token = '~' ifTrue: [ + ^self readSimpleMacro: reader name: #unquote + ]. + token = '~@' ifTrue: [ + ^self readSimpleMacro: reader name: #'splice-unquote' + ]. + token = '@' ifTrue: [ + ^self readSimpleMacro: reader name: #deref + ]. + + token = '^' ifTrue: [ + ^self readWithMetaMacro: reader + ]. + + ^self readAtom: reader + ] + + Reader class >> readList: reader class: aClass ender: ender [ + | storage token | + storage := OrderedCollection new. + "pop opening token" + reader next. + [ token := reader peek. token isNil ] whileFalse: [ + token = ender ifTrue: [ + ender = '}' ifTrue: [ + storage := storage asDictionary. + ]. + "pop closing token" + reader next. + ^aClass new: storage + ]. + storage add: (self readForm: reader). + ]. + ^MALUnterminatedSequence new signal: ender + ] + + Reader class >> readAtom: reader [ + | token | + token := reader next. + + token = 'true' ifTrue: [ ^MALObject True ]. + token = 'false' ifTrue: [ ^MALObject False ]. + token = 'nil' ifTrue: [ ^MALObject Nil ]. + + (token matchRegex: StringRegex) ifTrue: [ + ^MALString new: token parse + ]. + (token first = $") ifTrue: [ + ^MALUnterminatedSequence new signal: '"' + ]. + + (token matchRegex: NumberRegex) ifTrue: [ + ^MALNumber new: token asNumber + ]. + + (token first = $:) ifTrue: [ + ^MALKeyword new: token allButFirst asSymbol + ]. + + ^MALSymbol new: token asSymbol + ] + + Reader class >> readSimpleMacro: reader name: name [ + | form list | + "pop reader macro token" + reader next. + form := self readForm: reader. + list := OrderedCollection from: { MALSymbol new: name. form }. + ^MALList new: list + ] + + Reader class >> readWithMetaMacro: reader [ + | form meta list | + "pop reader macro token" + reader next. + meta := self readForm: reader. + form := self readForm: reader. + list := OrderedCollection from: + { MALSymbol new: #'with-meta'. form. meta }. + ^MALList new: list + ] + + Reader class >> new: tokens [ + | reader | + reader := super new. + reader init: tokens. + ^reader + ] + + init: tokens [ + storage := tokens. + index := 1. + ] + + peek [ + ^storage at: index ifAbsent: [ nil ] + ] + + next [ + | token | + token := self peek. + index := index + 1. + ^token + ] +] diff --git a/impls/gnu-smalltalk/readline.st b/impls/gnu-smalltalk/readline.st new file mode 100644 index 0000000000..2dca73c7b6 --- /dev/null +++ b/impls/gnu-smalltalk/readline.st @@ -0,0 +1,20 @@ +DLD addLibrary: 'libreadline'. +DLD addLibrary: 'libhistory'. + +Object subclass: ReadLine [ + ReadLine class >> readLine: prompt [ + + ] + + ReadLine class >> addHistory: item [ + + ] + + ReadLine class >> readHistory: filePath [ + + ] + + ReadLine class >> writeHistory: filePath [ + + ] +] diff --git a/impls/gnu-smalltalk/run b/impls/gnu-smalltalk/run new file mode 100755 index 0000000000..740459af26 --- /dev/null +++ b/impls/gnu-smalltalk/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec gst -f $(dirname $0)/${STEP:-stepA_mal}.st "${@}" diff --git a/impls/gnu-smalltalk/step0_repl.st b/impls/gnu-smalltalk/step0_repl.st new file mode 100644 index 0000000000..5549a89fcd --- /dev/null +++ b/impls/gnu-smalltalk/step0_repl.st @@ -0,0 +1,43 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^input + ] + + MAL class >> EVAL: sexp [ + ^sexp + ] + + MAL class >> PRINT: sexp [ + ^sexp + ] + + MAL class >> rep: input [ + ^self PRINT: (self EVAL: (self READ: input)) + ] +] + +| input historyFile | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. + +[ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + (MAL rep: input) displayNl. + ] +] + +'' displayNl. diff --git a/impls/gnu-smalltalk/step1_read_print.st b/impls/gnu-smalltalk/step1_read_print.st new file mode 100644 index 0000000000..53384b4c05 --- /dev/null +++ b/impls/gnu-smalltalk/step1_read_print.st @@ -0,0 +1,50 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> EVAL: sexp [ + ^sexp + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input [ + ^self PRINT: (self EVAL: (self READ: input)) + ] +] + +| input historyFile | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. + +[ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] +] + +'' displayNl. diff --git a/impls/gnu-smalltalk/step2_eval.st b/impls/gnu-smalltalk/step2_eval.st new file mode 100644 index 0000000000..46daa312b7 --- /dev/null +++ b/impls/gnu-smalltalk/step2_eval.st @@ -0,0 +1,86 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> EVAL: sexp env: env [ + | forms function args | + + " ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. " + + sexp type = #symbol ifTrue: [ + ^env at: sexp value ifAbsent: [ + ^MALUnknownSymbol new signal: sexp value + ]. + ]. + + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + forms := self evalList: sexp value env: env. + function := forms first. + args := forms allButFirst asArray. + ^function valueWithArguments: args + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Dictionary from: + { #+ -> [ :a :b | MALNumber new: a value + b value ]. + #- -> [ :a :b | MALNumber new: a value - b value ]. + #* -> [ :a :b | MALNumber new: a value * b value ]. + #/ -> [ :a :b | MALNumber new: a value // b value ] }. + +[ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] +] + +'' displayNl. diff --git a/impls/gnu-smalltalk/step3_env.st b/impls/gnu-smalltalk/step3_env.st new file mode 100644 index 0000000000..bcabe1abfd --- /dev/null +++ b/impls/gnu-smalltalk/step3_env.st @@ -0,0 +1,118 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> EVAL: sexp env: env [ + | ast a0_ a1 a1_ a2 forms function args | + + a2 := env get: #'DEBUG-EVAL'. + (a2 isNil or: [ a2 type = #false or: [ a2 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0_ := ast first value. + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) env: env_) ]. + ^self EVAL: a2 env: env_ + ]. + + forms := self evalList: sexp value env: env. + function := forms first. + args := forms allButFirst asArray. + ^function valueWithArguments: args + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +replEnv set: #+ value: [ :a :b | MALNumber new: a value + b value ]. +replEnv set: #- value: [ :a :b | MALNumber new: a value - b value ]. +replEnv set: #* value: [ :a :b | MALNumber new: a value * b value ]. +replEnv set: #/ value: [ :a :b | MALNumber new: a value // b value ]. + +[ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] +] + +'' displayNl. diff --git a/impls/gnu-smalltalk/step4_if_fn_do.st b/impls/gnu-smalltalk/step4_if_fn_do.st new file mode 100644 index 0000000000..592dadbdff --- /dev/null +++ b/impls/gnu-smalltalk/step4_if_fn_do.st @@ -0,0 +1,144 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. +'core.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> EVAL: sexp env: env [ + | ast a0_ a1 a1_ a2 a3 forms function args | + a1 := env get: #'DEBUG-EVAL'. + (a1 isNil or: [ a1 type = #false or: [ a1 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0_ := ast first value. + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) env: env_) ]. + ^self EVAL: a2 env: env_ + ]. + + a0_ = #do ifTrue: [ + ^(self evalList: ast allButFirst env: env) last + ]. + + a0_ = #if ifTrue: [ + | condition | + a1 := ast second. + a2 := ast third. + a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. + condition := self EVAL: a1 env: env. + + (condition type = #false or: [ condition type = #nil ]) ifTrue: [ + ^self EVAL: a3 env: env + ] ifFalse: [ + ^self EVAL: a2 env: env + ] + ]. + + a0_ = #'fn*' ifTrue: [ + | binds | + a1_ := ast second value. + binds := a1_ collect: [ :item | item value ]. + a2 := ast third. + ^Fn new: [ :args | self EVAL: a2 env: + (Env new: env binds: binds exprs: args) ] + ]. + + forms := self evalList: sexp value env: env. + function := forms first fn. + args := forms allButFirst asArray. + ^function value: args + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. + +MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. + +[ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] +] + +'' displayNl. diff --git a/impls/gnu-smalltalk/step5_tco.st b/impls/gnu-smalltalk/step5_tco.st new file mode 100644 index 0000000000..7c51c799db --- /dev/null +++ b/impls/gnu-smalltalk/step5_tco.st @@ -0,0 +1,183 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. +'func.st' loadRelative. +'core.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> EVAL: aSexp env: anEnv [ + | sexp env ast a0_ a1 a1_ a2 a3 forms function args | + + "NOTE: redefinition of method arguments is not allowed" + sexp := aSexp. + env := anEnv. + + [ + [ :continue | + + a1 := env get: #'DEBUG-EVAL'. + (a1 isNil or: [ a1 type = #false or: [ a1 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0_ := ast first value. + + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) + env: env_) ]. + env := env_. + sexp := a2. + continue value "TCO" + ]. + + a0_ = #do ifTrue: [ + | forms last | + ast size < 2 ifTrue: [ + forms := {}. + last := MALObject Nil. + ] ifFalse: [ + forms := ast copyFrom: 2 to: ast size - 1. + last := ast last. + ]. + + forms do: [ :form | self EVAL: form env: env ]. + sexp := last. + continue value "TCO" + ]. + + a0_ = #if ifTrue: [ + | condition | + a1 := ast second. + a2 := ast third. + a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. + condition := self EVAL: a1 env: env. + + (condition type = #false or: + [ condition type = #nil ]) ifTrue: [ + sexp := a3 + ] ifFalse: [ + sexp := a2 + ]. + continue value "TCO" + ]. + + a0_ = #'fn*' ifTrue: [ + | binds env_ fn | + a1_ := ast second value. + binds := a1_ collect: [ :item | item value ]. + a2 := ast third. + fn := [ :args | + self EVAL: a2 env: + (Env new: env binds: binds exprs: args) ]. + ^Func new: a2 params: binds env: env fn: fn + ]. + + forms := self evalList: sexp value env: env. + function := forms first. + args := forms allButFirst asArray. + + function type = #fn ifTrue: [ ^function fn value: args ]. + function type = #func ifTrue: [ + | env_ | + sexp := function ast. + env_ := Env new: function env binds: function params + exprs: args. + env := env_. + continue value "TCO" + ] + ] valueWithExit + ] repeat. + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. + +MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. + +[ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] +] + +'' displayNl. diff --git a/impls/gnu-smalltalk/step6_file.st b/impls/gnu-smalltalk/step6_file.st new file mode 100644 index 0000000000..5d1cd77dc8 --- /dev/null +++ b/impls/gnu-smalltalk/step6_file.st @@ -0,0 +1,195 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. +'func.st' loadRelative. +'core.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> EVAL: aSexp env: anEnv [ + | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args | + + "NOTE: redefinition of method arguments is not allowed" + sexp := aSexp. + env := anEnv. + + [ + [ :continue | + + a0 := env get: #'DEBUG-EVAL'. + (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0 := ast first. + + a0_ := ast first value. + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) + env: env_) ]. + env := env_. + sexp := a2. + continue value "TCO" + ]. + + a0_ = #do ifTrue: [ + | forms last | + ast size < 2 ifTrue: [ + forms := {}. + last := MALObject Nil. + ] ifFalse: [ + forms := ast copyFrom: 2 to: ast size - 1. + last := ast last. + ]. + + forms do: [ :form | self EVAL: form env: env ]. + sexp := last. + continue value "TCO" + ]. + + a0_ = #if ifTrue: [ + | condition | + a1 := ast second. + a2 := ast third. + a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. + condition := self EVAL: a1 env: env. + + (condition type = #false or: + [ condition type = #nil ]) ifTrue: [ + sexp := a3 + ] ifFalse: [ + sexp := a2 + ]. + continue value "TCO" + ]. + + a0_ = #'fn*' ifTrue: [ + | binds env_ fn | + a1_ := ast second value. + binds := a1_ collect: [ :item | item value ]. + a2 := ast third. + fn := [ :args | + self EVAL: a2 env: + (Env new: env binds: binds exprs: args) ]. + ^Func new: a2 params: binds env: env fn: fn + ]. + + forms := self evalList: sexp value env: env. + function := forms first. + args := forms allButFirst asArray. + + function type = #fn ifTrue: [ ^function fn value: args ]. + function type = #func ifTrue: [ + | env_ | + sexp := function ast. + env_ := Env new: function env binds: function params + exprs: args. + env := env_. + continue value "TCO" + ] + ] valueWithExit + ] repeat. + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv argv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +argv := Smalltalk arguments. +argv notEmpty ifTrue: [ argv := argv allButFirst ]. +argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). + +Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. +replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). +replEnv set: #'*ARGV*' value: (MALList new: argv). + +MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. +MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. + +Smalltalk arguments notEmpty ifTrue: [ + MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv +] ifFalse: [ + [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] + ]. + + '' displayNl. +] diff --git a/impls/gnu-smalltalk/step7_quote.st b/impls/gnu-smalltalk/step7_quote.st new file mode 100644 index 0000000000..5f022afbc8 --- /dev/null +++ b/impls/gnu-smalltalk/step7_quote.st @@ -0,0 +1,247 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. +'func.st' loadRelative. +'core.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + + MAL class >> quasiquote: ast [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ + result := {MALSymbol new: #quote. ast}. + ^MALList new: (OrderedCollection from: result) + ]. + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast + ]. + + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc + ] + + MAL class >> EVAL: aSexp env: anEnv [ + | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args | + + "NOTE: redefinition of method arguments is not allowed" + sexp := aSexp. + env := anEnv. + + [ + [ :continue | + + a0 := env get: #'DEBUG-EVAL'. + (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0 := ast first. + + a0_ := ast first value. + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) + env: env_) ]. + env := env_. + sexp := a2. + continue value "TCO" + ]. + + a0_ = #do ifTrue: [ + | forms last | + ast size < 2 ifTrue: [ + forms := {}. + last := MALObject Nil. + ] ifFalse: [ + forms := ast copyFrom: 2 to: ast size - 1. + last := ast last. + ]. + + forms do: [ :form | self EVAL: form env: env ]. + sexp := last. + continue value "TCO" + ]. + + a0_ = #if ifTrue: [ + | condition | + a1 := ast second. + a2 := ast third. + a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. + condition := self EVAL: a1 env: env. + + (condition type = #false or: + [ condition type = #nil ]) ifTrue: [ + sexp := a3 + ] ifFalse: [ + sexp := a2 + ]. + continue value "TCO" + ]. + + a0_ = #quote ifTrue: [ + a1 := ast second. + ^a1 + ]. + + a0_ = #quasiquote ifTrue: [ + | result | + a1 := ast second. + sexp := self quasiquote: a1. + continue value "TCO" + ]. + + a0_ = #'fn*' ifTrue: [ + | binds env_ fn | + a1_ := ast second value. + binds := a1_ collect: [ :item | item value ]. + a2 := ast third. + fn := [ :args | + self EVAL: a2 env: + (Env new: env binds: binds exprs: args) ]. + ^Func new: a2 params: binds env: env fn: fn + ]. + + forms := self evalList: sexp value env: env. + function := forms first. + args := forms allButFirst asArray. + + function type = #fn ifTrue: [ ^function fn value: args ]. + function type = #func ifTrue: [ + | env_ | + sexp := function ast. + env_ := Env new: function env binds: function params + exprs: args. + env := env_. + continue value "TCO" + ] + ] valueWithExit + ] repeat. + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv argv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +argv := Smalltalk arguments. +argv notEmpty ifTrue: [ argv := argv allButFirst ]. +argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). + +Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. +replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). +replEnv set: #'*ARGV*' value: (MALList new: argv). + +MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. +MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. + +Smalltalk arguments notEmpty ifTrue: [ + MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv +] ifFalse: [ + [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] + ]. + + '' displayNl. +] diff --git a/impls/gnu-smalltalk/step8_macros.st b/impls/gnu-smalltalk/step8_macros.st new file mode 100644 index 0000000000..16ddf292fe --- /dev/null +++ b/impls/gnu-smalltalk/step8_macros.st @@ -0,0 +1,261 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. +'func.st' loadRelative. +'core.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + + MAL class >> quasiquote: ast [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ + result := {MALSymbol new: #quote. ast}. + ^MALList new: (OrderedCollection from: result) + ]. + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast + ]. + + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc + ] + + MAL class >> EVAL: aSexp env: anEnv [ + | sexp env ast a0 a0_ a1 a1_ a2 a3 function args | + + "NOTE: redefinition of method arguments is not allowed" + sexp := aSexp. + env := anEnv. + + [ + [ :continue | + + a0 := env get: #'DEBUG-EVAL'. + (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0 := ast first. + + a0_ := ast first value. + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'defmacro!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := (self EVAL: a2 env: env) deepCopy. + result isMacro: true. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) + env: env_) ]. + env := env_. + sexp := a2. + continue value "TCO" + ]. + + a0_ = #do ifTrue: [ + | forms last | + ast size < 2 ifTrue: [ + forms := {}. + last := MALObject Nil. + ] ifFalse: [ + forms := ast copyFrom: 2 to: ast size - 1. + last := ast last. + ]. + + forms do: [ :form | self EVAL: form env: env ]. + sexp := last. + continue value "TCO" + ]. + + a0_ = #if ifTrue: [ + | condition | + a1 := ast second. + a2 := ast third. + a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. + condition := self EVAL: a1 env: env. + + (condition type = #false or: + [ condition type = #nil ]) ifTrue: [ + sexp := a3 + ] ifFalse: [ + sexp := a2 + ]. + continue value "TCO" + ]. + + a0_ = #quote ifTrue: [ + a1 := ast second. + ^a1 + ]. + + a0_ = #quasiquote ifTrue: [ + | result | + a1 := ast second. + sexp := self quasiquote: a1. + continue value "TCO" + ]. + + a0_ = #'fn*' ifTrue: [ + | binds env_ fn | + a1_ := ast second value. + binds := a1_ collect: [ :item | item value ]. + a2 := ast third. + fn := [ :args | + self EVAL: a2 env: + (Env new: env binds: binds exprs: args) ]. + ^Func new: a2 params: binds env: env fn: fn + ]. + + function := self EVAL: a0 env: env. + args := ast allButFirst asArray. + (function type = #func and: [ function isMacro ]) ifTrue: [ + sexp := function fn value: args. + continue value TCO + ]. + args := self evalList: args env: env. + function type = #fn ifTrue: [ ^function fn value: args ]. + function type = #func ifTrue: [ + | env_ | + sexp := function ast. + env_ := Env new: function env binds: function params + exprs: args. + env := env_. + continue value "TCO" + ] + ] valueWithExit + ] repeat. + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv argv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +argv := Smalltalk arguments. +argv notEmpty ifTrue: [ argv := argv allButFirst ]. +argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). + +Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. +replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). +replEnv set: #'*ARGV*' value: (MALList new: argv). + +MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. +MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. +MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv. + +Smalltalk arguments notEmpty ifTrue: [ + MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv +] ifFalse: [ + [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] + ]. + + '' displayNl. +] diff --git a/impls/gnu-smalltalk/step9_try.st b/impls/gnu-smalltalk/step9_try.st new file mode 100644 index 0000000000..69b6fb484e --- /dev/null +++ b/impls/gnu-smalltalk/step9_try.st @@ -0,0 +1,282 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. +'func.st' loadRelative. +'core.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + + MAL class >> quasiquote: ast [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ + result := {MALSymbol new: #quote. ast}. + ^MALList new: (OrderedCollection from: result) + ]. + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast + ]. + + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc + ] + + MAL class >> EVAL: aSexp env: anEnv [ + | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 function args | + + "NOTE: redefinition of method arguments is not allowed" + sexp := aSexp. + env := anEnv. + + [ + [ :continue | + + a0 := env get: #'DEBUG-EVAL'. + (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0 := ast first. + + a0_ := ast first value. + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'defmacro!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := (self EVAL: a2 env: env) deepCopy. + result isMacro: true. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) + env: env_) ]. + env := env_. + sexp := a2. + continue value "TCO" + ]. + + a0_ = #do ifTrue: [ + | forms last | + ast size < 2 ifTrue: [ + forms := {}. + last := MALObject Nil. + ] ifFalse: [ + forms := ast copyFrom: 2 to: ast size - 1. + last := ast last. + ]. + + forms do: [ :form | self EVAL: form env: env ]. + sexp := last. + continue value "TCO" + ]. + + a0_ = #if ifTrue: [ + | condition | + a1 := ast second. + a2 := ast third. + a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. + condition := self EVAL: a1 env: env. + + (condition type = #false or: + [ condition type = #nil ]) ifTrue: [ + sexp := a3 + ] ifFalse: [ + sexp := a2 + ]. + continue value "TCO" + ]. + + a0_ = #quote ifTrue: [ + a1 := ast second. + ^a1 + ]. + + a0_ = #quasiquote ifTrue: [ + | result | + a1 := ast second. + sexp := self quasiquote: a1. + continue value "TCO" + ]. + + a0_ = #'try*' ifTrue: [ + | A B C | + A := ast second. + ast at: 3 ifAbsent: [ + ^self EVAL: A env: env. + ]. + a2_ := ast third value. + B := a2_ second value. + C := a2_ third. + ^[ self EVAL: A env: env ] on: MALError do: + [ :err | + | data env_ result | + data := err data. + data isString ifTrue: [ + data := MALString new: data + ]. + env_ := Env new: env binds: {B} exprs: {data}. + err return: (self EVAL: C env: env_) + ] + ]. + + a0_ = #'fn*' ifTrue: [ + | binds env_ fn | + a1_ := ast second value. + binds := a1_ collect: [ :item | item value ]. + a2 := ast third. + fn := [ :args | + self EVAL: a2 env: + (Env new: env binds: binds exprs: args) ]. + ^Func new: a2 params: binds env: env fn: fn + ]. + + function := self EVAL: a0 env: env. + args := ast allButFirst asArray. + (function type = #func and: [ function isMacro ]) ifTrue: [ + sexp := function fn value: args. + continue value TCO + ]. + args := self evalList: args env: env. + function type = #fn ifTrue: [ ^function fn value: args ]. + function type = #func ifTrue: [ + | env_ | + sexp := function ast. + env_ := Env new: function env binds: function params + exprs: args. + env := env_. + continue value "TCO" + ] + ] valueWithExit + ] repeat. + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv argv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +argv := Smalltalk arguments. +argv notEmpty ifTrue: [ argv := argv allButFirst ]. +argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). + +Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. +replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). +replEnv set: #'*ARGV*' value: (MALList new: argv). + +MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. +MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. +MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv. + +Smalltalk arguments notEmpty ifTrue: [ + MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv +] ifFalse: [ + [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] + ]. + + '' displayNl. +] diff --git a/impls/gnu-smalltalk/stepA_mal.st b/impls/gnu-smalltalk/stepA_mal.st new file mode 100644 index 0000000000..e5e92455a3 --- /dev/null +++ b/impls/gnu-smalltalk/stepA_mal.st @@ -0,0 +1,284 @@ +String extend [ + String >> loadRelative [ + | scriptPath scriptDirectory | + scriptPath := thisContext currentFileName. + scriptDirectory := FilePath stripFileNameFor: scriptPath. + FileStream fileIn: (FilePath append: self to: scriptDirectory) + ] +] + +'readline.st' loadRelative. +'util.st' loadRelative. +'types.st' loadRelative. +'reader.st' loadRelative. +'printer.st' loadRelative. +'env.st' loadRelative. +'func.st' loadRelative. +'core.st' loadRelative. + +Object subclass: MAL [ + MAL class >> READ: input [ + ^Reader readStr: input + ] + + MAL class >> evalList: list env: env [ + ^list collect: + [ :item | self EVAL: item env: env ]. + ] + + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + + MAL class >> quasiquote: ast [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ + result := {MALSymbol new: #quote. ast}. + ^MALList new: (OrderedCollection from: result) + ]. + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast + ]. + + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc + ] + + MAL class >> EVAL: aSexp env: anEnv [ + | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 function args | + + "NOTE: redefinition of method arguments is not allowed" + sexp := aSexp. + env := anEnv. + + [ + [ :continue | + + a0 := env get: #'DEBUG-EVAL'. + (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) + ifFalse: [ + ('EVAL: ' , (Printer prStr: sexp printReadably: true)) + displayNl. + ]. + + sexp type = #symbol ifTrue: [ + | key value | + key := sexp value. + value := env get: key. + value isNil ifTrue: [ + ^MALUnknownSymbol new signal: key + ]. + ^value + ]. + sexp type = #vector ifTrue: [ + ^MALVector new: (self evalList: sexp value env: env) + ]. + sexp type = #map ifTrue: [ + ^MALMap new: (self evalList: sexp value env: env) + ]. + sexp type ~= #list ifTrue: [ + ^sexp + ]. + sexp value isEmpty ifTrue: [ + ^sexp + ]. + + ast := sexp value. + a0 := ast first. + + a0_ := ast first value. + a0_ = #'def!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := self EVAL: a2 env: env. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'defmacro!' ifTrue: [ + | result | + a1_ := ast second value. + a2 := ast third. + result := (self EVAL: a2 env: env) deepCopy. + result isMacro: true. + env set: a1_ value: result. + ^result + ]. + + a0_ = #'let*' ifTrue: [ + | env_ | + env_ := Env new: env. + a1_ := ast second value. + a2 := ast third. + 1 to: a1_ size by: 2 do: + [ :i | env_ set: (a1_ at: i) value + value: (self EVAL: (a1_ at: i + 1) + env: env_) ]. + env := env_. + sexp := a2. + continue value "TCO" + ]. + + a0_ = #do ifTrue: [ + | forms last | + ast size < 2 ifTrue: [ + forms := {}. + last := MALObject Nil. + ] ifFalse: [ + forms := ast copyFrom: 2 to: ast size - 1. + last := ast last. + ]. + + forms do: [ :form | self EVAL: form env: env ]. + sexp := last. + continue value "TCO" + ]. + + a0_ = #if ifTrue: [ + | condition | + a1 := ast second. + a2 := ast third. + a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. + condition := self EVAL: a1 env: env. + + (condition type = #false or: + [ condition type = #nil ]) ifTrue: [ + sexp := a3 + ] ifFalse: [ + sexp := a2 + ]. + continue value "TCO" + ]. + + a0_ = #quote ifTrue: [ + a1 := ast second. + ^a1 + ]. + + a0_ = #quasiquote ifTrue: [ + | result | + a1 := ast second. + sexp := self quasiquote: a1. + continue value "TCO" + ]. + + a0_ = #'try*' ifTrue: [ + | A B C | + A := ast second. + ast at: 3 ifAbsent: [ + ^self EVAL: A env: env. + ]. + a2_ := ast third value. + B := a2_ second value. + C := a2_ third. + ^[ self EVAL: A env: env ] on: MALError do: + [ :err | + | data env_ result | + data := err data. + data isString ifTrue: [ + data := MALString new: data + ]. + env_ := Env new: env binds: {B} exprs: {data}. + err return: (self EVAL: C env: env_) + ] + ]. + + a0_ = #'fn*' ifTrue: [ + | binds env_ fn | + a1_ := ast second value. + binds := a1_ collect: [ :item | item value ]. + a2 := ast third. + fn := [ :args | + self EVAL: a2 env: + (Env new: env binds: binds exprs: args) ]. + ^Func new: a2 params: binds env: env fn: fn + ]. + + function := self EVAL: a0 env: env. + args := ast allButFirst asArray. + (function type = #func and: [ function isMacro ]) ifTrue: [ + sexp := function fn value: args. + continue value TCO + ]. + args := self evalList: args env: env. + function type = #fn ifTrue: [ ^function fn value: args ]. + function type = #func ifTrue: [ + | env_ | + sexp := function ast. + env_ := Env new: function env binds: function params + exprs: args. + env := env_. + continue value "TCO" + ] + ] valueWithExit + ] repeat. + ] + + MAL class >> PRINT: sexp [ + ^Printer prStr: sexp printReadably: true + ] + + MAL class >> rep: input env: env [ + ^self PRINT: (self EVAL: (self READ: input) env: env) + ] +] + +| input historyFile replEnv argv | + +historyFile := '.mal_history'. +ReadLine readHistory: historyFile. +replEnv := Env new: nil. + +argv := Smalltalk arguments. +argv notEmpty ifTrue: [ argv := argv allButFirst ]. +argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). + +Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. +replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). +replEnv set: #'*ARGV*' value: (MALList new: argv). +replEnv set: #'*host-language*' value: (MALString new: 'smalltalk'). + +MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. +MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. +MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv. + +Smalltalk arguments notEmpty ifTrue: [ + MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv +] ifFalse: [ + MAL rep: '(println (str "Mal [" *host-language* "]"))' env: replEnv. + [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ + input isEmpty ifFalse: [ + ReadLine addHistory: input. + ReadLine writeHistory: historyFile. + [ (MAL rep: input env: replEnv) displayNl ] + on: MALEmptyInput do: [ #return ] + on: MALError do: + [ :err | ('error: ', err messageText) displayNl. #return ]. + ] + ]. + + '' displayNl. +] diff --git a/impls/gnu-smalltalk/tests/stepA_mal.mal b/impls/gnu-smalltalk/tests/stepA_mal.mal new file mode 100644 index 0000000000..f8ff39f8f6 --- /dev/null +++ b/impls/gnu-smalltalk/tests/stepA_mal.mal @@ -0,0 +1,11 @@ +(gst-eval "1 + 1") +;=>2 + +(gst-eval "{1. 2. 3}") +;=>[1 2 3] + +(gst-eval "#('a' 'b' 'c') join: ' '") +;=>"a b c" + +(gst-eval "'Hello World!' displayNl") +;/Hello World! diff --git a/impls/gnu-smalltalk/types.st b/impls/gnu-smalltalk/types.st new file mode 100644 index 0000000000..86c0da47a8 --- /dev/null +++ b/impls/gnu-smalltalk/types.st @@ -0,0 +1,203 @@ +Object subclass: MALObject [ + | type value meta | + + type [ ^type ] + value [ ^value ] + meta [ ^meta ] + + value: aValue [ + value := aValue. + ] + + meta: aMeta [ + meta := aMeta. + ] + + MALObject class >> new: type value: value meta: meta [ + | object | + object := super new. + object init: type value: value meta: meta. + ^object + ] + + init: aType value: aValue meta: aMeta [ + type := aType. + value := aValue. + meta := aMeta. + ] + + withMeta: meta [ + | object | + object := self deepCopy. + object meta: meta. + ^object + ] + + printOn: stream [ + stream nextPutAll: '<'; + nextPutAll: self class printString; + nextPutAll: ': '; + nextPutAll: value printString. + meta notNil ifTrue: [ + stream nextPutAll: ' | ' + nextPutAll: meta printString. + ]. + stream nextPutAll: '>'. + ] + + = x [ + self type ~= x type ifTrue: [ ^false ]. + ^self value = x value + ] + + hash [ + ^self value hash + ] +] + +MALObject subclass: MALTrue [ + MALTrue class >> new [ + ^super new: #true value: true meta: nil. + ] +] + +MALObject subclass: MALFalse [ + MALFalse class >> new [ + ^super new: #false value: false meta: nil. + ] +] + +MALObject subclass: MALNil [ + MALNil class >> new [ + ^super new: #nil value: nil meta: nil. + ] +] + +MALObject class extend [ + True := MALTrue new. + False := MALFalse new. + Nil := MALNil new. + + True [ ^True ] + False [ ^False ] + Nil [ ^Nil ] +] + +MALObject subclass: MALNumber [ + MALNumber class >> new: value [ + ^super new: #number value: value meta: nil. + ] +] + +MALObject subclass: MALString [ + MALString class >> new: value [ + ^super new: #string value: value meta: nil. + ] +] + +MALObject subclass: MALSymbol [ + MALSymbol class >> new: value [ + ^super new: #symbol value: value meta: nil. + ] +] + +MALObject subclass: MALKeyword [ + MALKeyword class >> new: value [ + ^super new: #keyword value: value meta: nil. + ] +] + +MALObject subclass: MALList [ + MALList class >> new: value [ + ^super new: #list value: value meta: nil. + ] + + = x [ + (x type ~= #list and: [ x type ~= #vector ]) ifTrue: [ ^false ]. + ^self value = x value + ] +] + +MALObject subclass: MALVector [ + MALVector class >> new: value [ + ^super new: #vector value: value meta: nil. + ] + + = x [ + (x type ~= #vector and: [ x type ~= #list ]) ifTrue: [ ^false ]. + ^self value = x value + ] +] + +MALObject subclass: MALMap [ + MALMap class >> new: value [ + ^super new: #map value: value meta: nil. + ] +] + +MALObject subclass: MALAtom [ + MALAtom class >> new: value [ + ^super new: #atom value: value meta: nil. + ] +] + +MALObject subclass: Fn [ + | fn | + + fn [ ^fn ] + + Fn class >> new: fn [ + | f | + f := super new: #fn value: fn meta: nil. + f init: fn. + ^f + ] + + init: f [ + fn := f. + ] +] + +Error subclass: MALError [ + description [ ^'A MAL-related error' ] + isResumable [ ^true ] + + data [ ^self messageText ] +] + +MALError subclass: MALUnterminatedSequence [ + MALUnterminatedSequence class >> new [ ^super new ] + + messageText [ ^'expected ''', self basicMessageText, ''', got EOF' ] +] + +MALError subclass: MALUnexpectedToken [ + MALUnexpectedToken class >> new [ ^super new ] + + messageText [ ^'unexpected token: ''', self basicMessageText, ''''] +] + +MALError subclass: MALEmptyInput [ + MALEmptyInput class >> new [ ^super new ] + + messageText [ ^'Empty input' ] +] + +MALError subclass: MALUnknownSymbol [ + MALUnknownSymbol class >> new [ ^super new ] + + messageText [ ^'''', self basicMessageText, ''' not found'] +] + +MALError subclass: MALOutOfBounds [ + MALOutOfBounds class >> new [ ^super new ] + + messageText [ ^'Out of bounds' ] +] + +MALError subclass: MALCustomError [ + MALCustomError class >> new [ ^super new ] + + messageText [ ^Printer prStr: self basicMessageText printReadably: true ] + data [ ^self basicMessageText ] +] diff --git a/impls/gnu-smalltalk/util.st b/impls/gnu-smalltalk/util.st new file mode 100644 index 0000000000..4a0009e6b0 --- /dev/null +++ b/impls/gnu-smalltalk/util.st @@ -0,0 +1,90 @@ +SequenceableCollection extend [ + asDictionary [ + | dict assoc | + dict := Dictionary new. + 1 to: self size by: 2 do: + [ :i | dict add: (self at: i) -> (self at: i + 1) ]. + ^dict + ] +] + +String extend [ + parse [ + |text canary| + canary := 8r177 asCharacter asString. + text := self copyFrom: 2 to: self size - 1. + text := text copyReplaceAll: '\\' with: canary. + text := text copyReplaceAll: '\"' with: '"'. + text := text copyReplaceAll: '\n' with: ' +'. + text := text copyReplaceAll: canary with: '\'. + ^text + ] + + repr [ + |text| + text := self copyReplaceAll: '\' with: '\\'. + text := text copyReplaceAll: ' +' with: '\n'. + text := text copyReplaceAll: '"' with: '\"'. + ^'"', text, '"' + ] +] + +BlockClosure extend [ + valueWithExit [ + ^self value: [ ^nil ] + ] +] + +Object extend [ + toMALValue [ + self = true ifTrue: [ ^MALObject True ]. + self = false ifTrue: [ ^MALObject False ]. + self = nil ifTrue: [ ^MALObject Nil ]. + self isNumber ifTrue: [ ^MALNumber new: self ]. + self isString ifTrue: [ ^MALString new: self ]. + self isSymbol ifTrue: [ ^MALSymbol new: self ]. + self isArray ifTrue: [ + ^MALVector new: (self asOrderedCollection collect: + [ :item | item toMALValue ]) + ]. + self isSequenceable ifTrue: [ + ^MALList new: (self asOrderedCollection collect: + [ :item | item toMALValue ]) + ]. + self class = Dictionary ifTrue: [ + | result | + result := Dictionary new. + self keysAndValuesDo: [ :key :value | + result at: key toMALValue put: value toMALValue + ]. + ^MALMap new: result + ] + ] +] + +"NOTE: bugfix version from 3.2.91 for 3.2.4" +Namespace current: Kernel [ + +MatchingRegexResults extend [ + at: anIndex [ + + | reg text | + anIndex = 0 ifTrue: [^self match]. + cache isNil ifTrue: [cache := Array new: registers size]. + (cache at: anIndex) isNil + ifTrue: + [reg := registers at: anIndex. + text := reg isNil + ifTrue: [nil] + ifFalse: [ + reg isEmpty + ifTrue: [''] + ifFalse: [self subject copyFrom: reg first to: reg last]]. + cache at: anIndex put: text]. + ^cache at: anIndex + ] +] + +] diff --git a/impls/go/Dockerfile b/impls/go/Dockerfile new file mode 100644 index 0000000000..474ceb9a08 --- /dev/null +++ b/impls/go/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ golang libreadline-dev libedit-dev pkg-config + +ENV HOME /mal diff --git a/impls/go/Makefile b/impls/go/Makefile new file mode 100644 index 0000000000..4968b59cf0 --- /dev/null +++ b/impls/go/Makefile @@ -0,0 +1,31 @@ +##################### + +SOURCES_BASE = src/types/types.go src/readline/readline.go \ + src/reader/reader.go src/printer/printer.go \ + src/env/env.go src/core/core.go + +##################### + +SRCS = step0_repl.go step1_read_print.go step2_eval.go step3_env.go \ + step4_if_fn_do.go step5_tco.go step6_file.go step7_quote.go \ + step8_macros.go step9_try.go stepA_mal.go +BINS = $(SRCS:%.go=%) + +##################### + +all: $(BINS) + +dist: mal + +mal: $(word $(words $(BINS)),$(BINS)) + cp $< $@ + +define dep_template +$(1): $(SOURCES_BASE) src/$(1)/$(1).go + go build -o $$@ ./src/$(1) +endef + +$(foreach b,$(BINS),$(eval $(call dep_template,$(b)))) + +clean: + rm -f $(BINS) mal diff --git a/impls/go/go.mod b/impls/go/go.mod new file mode 100644 index 0000000000..9e6de821b0 --- /dev/null +++ b/impls/go/go.mod @@ -0,0 +1,3 @@ +module mal + +go 1.22.2 diff --git a/impls/go/run b/impls/go/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/go/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/go/src/core/core.go b/impls/go/src/core/core.go new file mode 100644 index 0000000000..dad54222c7 --- /dev/null +++ b/impls/go/src/core/core.go @@ -0,0 +1,567 @@ +package core + +import ( + "errors" + "fmt" + "io/ioutil" + "strings" + "time" +) + +import ( + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" +) + +// Errors/Exceptions +func throw(a []MalType) (MalType, error) { + return nil, MalError{a[0]} +} + +func fn_q(a []MalType) (MalType, error) { + switch f := a[0].(type) { + case MalFunc: + return !f.GetMacro(), nil + case Func: + return true, nil + case func([]MalType) (MalType, error): + return true, nil + default: + return false, nil + } +} + +// String functions + +func pr_str(a []MalType) (MalType, error) { + return printer.Pr_list(a, true, "", "", " "), nil +} + +func str(a []MalType) (MalType, error) { + return printer.Pr_list(a, false, "", "", ""), nil +} + +func prn(a []MalType) (MalType, error) { + fmt.Println(printer.Pr_list(a, true, "", "", " ")) + return nil, nil +} + +func println(a []MalType) (MalType, error) { + fmt.Println(printer.Pr_list(a, false, "", "", " ")) + return nil, nil +} + +func slurp(a []MalType) (MalType, error) { + b, e := ioutil.ReadFile(a[0].(string)) + if e != nil { + return nil, e + } + return string(b), nil +} + +// Number functions +func time_ms(a []MalType) (MalType, error) { + return int(time.Now().UnixNano() / int64(time.Millisecond)), nil +} + +// Hash Map functions +func copy_hash_map(hm HashMap) HashMap { + new_hm := HashMap{map[string]MalType{}, nil} + for k, v := range hm.Val { + new_hm.Val[k] = v + } + return new_hm +} + +func assoc(a []MalType) (MalType, error) { + if len(a) < 3 { + return nil, errors.New("assoc requires at least 3 arguments") + } + if len(a)%2 != 1 { + return nil, errors.New("assoc requires odd number of arguments") + } + if !HashMap_Q(a[0]) { + return nil, errors.New("assoc called on non-hash map") + } + new_hm := copy_hash_map(a[0].(HashMap)) + for i := 1; i < len(a); i += 2 { + key := a[i] + if !String_Q(key) { + return nil, errors.New("assoc called with non-string key") + } + new_hm.Val[key.(string)] = a[i+1] + } + return new_hm, nil +} + +func dissoc(a []MalType) (MalType, error) { + if len(a) < 2 { + return nil, errors.New("dissoc requires at least 3 arguments") + } + if !HashMap_Q(a[0]) { + return nil, errors.New("dissoc called on non-hash map") + } + new_hm := copy_hash_map(a[0].(HashMap)) + for i := 1; i < len(a); i += 1 { + key := a[i] + if !String_Q(key) { + return nil, errors.New("dissoc called with non-string key") + } + delete(new_hm.Val, key.(string)) + } + return new_hm, nil +} + +func get(a []MalType) (MalType, error) { + if Nil_Q(a[0]) { + return nil, nil + } + if !HashMap_Q(a[0]) { + return nil, errors.New("get called on non-hash map") + } + if !String_Q(a[1]) { + return nil, errors.New("get called with non-string key") + } + return a[0].(HashMap).Val[a[1].(string)], nil +} + +func contains_Q(hm MalType, key MalType) (MalType, error) { + if Nil_Q(hm) { + return false, nil + } + if !HashMap_Q(hm) { + return nil, errors.New("get called on non-hash map") + } + if !String_Q(key) { + return nil, errors.New("get called with non-string key") + } + _, ok := hm.(HashMap).Val[key.(string)] + return ok, nil +} + +func keys(a []MalType) (MalType, error) { + if !HashMap_Q(a[0]) { + return nil, errors.New("keys called on non-hash map") + } + slc := []MalType{} + for k, _ := range a[0].(HashMap).Val { + slc = append(slc, k) + } + return List{slc, nil}, nil +} + +func vals(a []MalType) (MalType, error) { + if !HashMap_Q(a[0]) { + return nil, errors.New("keys called on non-hash map") + } + slc := []MalType{} + for _, v := range a[0].(HashMap).Val { + slc = append(slc, v) + } + return List{slc, nil}, nil +} + +// Sequence functions + +func cons(a []MalType) (MalType, error) { + val := a[0] + lst, e := GetSlice(a[1]) + if e != nil { + return nil, e + } + return List{append([]MalType{val}, lst...), nil}, nil +} + +func concat(a []MalType) (MalType, error) { + if len(a) == 0 { + return List{}, nil + } + slc1, e := GetSlice(a[0]) + if e != nil { + return nil, e + } + for i := 1; i < len(a); i += 1 { + slc2, e := GetSlice(a[i]) + if e != nil { + return nil, e + } + slc1 = append(slc1, slc2...) + } + return List{slc1, nil}, nil +} + +func vec(a []MalType) (MalType, error) { + switch obj := a[0].(type) { + case Vector: + return obj, nil + case List: + return Vector{obj.Val, nil}, nil + default: + return nil, errors.New("vec: expects a sequence") + } +} + +func nth(a []MalType) (MalType, error) { + slc, e := GetSlice(a[0]) + if e != nil { + return nil, e + } + idx := a[1].(int) + if idx < len(slc) { + return slc[idx], nil + } else { + return nil, errors.New("nth: index out of range") + } +} + +func first(a []MalType) (MalType, error) { + if len(a) == 0 { + return nil, nil + } + if a[0] == nil { + return nil, nil + } + slc, e := GetSlice(a[0]) + if e != nil { + return nil, e + } + if len(slc) == 0 { + return nil, nil + } + return slc[0], nil +} + +func rest(a []MalType) (MalType, error) { + if a[0] == nil { + return List{}, nil + } + slc, e := GetSlice(a[0]) + if e != nil { + return nil, e + } + if len(slc) == 0 { + return List{}, nil + } + return List{slc[1:], nil}, nil +} + +func empty_Q(a []MalType) (MalType, error) { + switch obj := a[0].(type) { + case List: + return len(obj.Val) == 0, nil + case Vector: + return len(obj.Val) == 0, nil + case nil: + return true, nil + default: + return nil, errors.New("empty? called on non-sequence") + } +} + +func count(a []MalType) (MalType, error) { + switch obj := a[0].(type) { + case List: + return len(obj.Val), nil + case Vector: + return len(obj.Val), nil + case map[string]MalType: + return len(obj), nil + case nil: + return 0, nil + default: + return nil, errors.New("count called on non-sequence") + } +} + +func apply(a []MalType) (MalType, error) { + if len(a) < 2 { + return nil, errors.New("apply requires at least 2 args") + } + f := a[0] + args := []MalType{} + for _, b := range a[1 : len(a)-1] { + args = append(args, b) + } + last, e := GetSlice(a[len(a)-1]) + if e != nil { + return nil, e + } + args = append(args, last...) + return Apply(f, args) +} + +func do_map(a []MalType) (MalType, error) { + f := a[0] + results := []MalType{} + args, e := GetSlice(a[1]) + if e != nil { + return nil, e + } + for _, arg := range args { + res, e := Apply(f, []MalType{arg}) + results = append(results, res) + if e != nil { + return nil, e + } + } + return List{results, nil}, nil +} + +func conj(a []MalType) (MalType, error) { + if len(a) < 2 { + return nil, errors.New("conj requires at least 2 arguments") + } + switch seq := a[0].(type) { + case List: + new_slc := []MalType{} + for i := len(a) - 1; i > 0; i -= 1 { + new_slc = append(new_slc, a[i]) + } + return List{append(new_slc, seq.Val...), nil}, nil + case Vector: + new_slc := seq.Val + for _, x := range a[1:] { + new_slc = append(new_slc, x) + } + return Vector{new_slc, nil}, nil + } + + if !HashMap_Q(a[0]) { + return nil, errors.New("dissoc called on non-hash map") + } + new_hm := copy_hash_map(a[0].(HashMap)) + for i := 1; i < len(a); i += 1 { + key := a[i] + if !String_Q(key) { + return nil, errors.New("dissoc called with non-string key") + } + delete(new_hm.Val, key.(string)) + } + return new_hm, nil +} + +func seq(a []MalType) (MalType, error) { + if a[0] == nil { + return nil, nil + } + switch arg := a[0].(type) { + case List: + if len(arg.Val) == 0 { + return nil, nil + } + return arg, nil + case Vector: + if len(arg.Val) == 0 { + return nil, nil + } + return List{arg.Val, nil}, nil + case string: + if len(arg) == 0 { + return nil, nil + } + new_slc := []MalType{} + for _, ch := range strings.Split(arg, "") { + new_slc = append(new_slc, ch) + } + return List{new_slc, nil}, nil + } + return nil, errors.New("seq requires string or list or vector or nil") +} + +// Metadata functions +func with_meta(a []MalType) (MalType, error) { + obj := a[0] + m := a[1] + switch tobj := obj.(type) { + case List: + return List{tobj.Val, m}, nil + case Vector: + return Vector{tobj.Val, m}, nil + case HashMap: + return HashMap{tobj.Val, m}, nil + case Func: + return Func{tobj.Fn, m}, nil + case MalFunc: + fn := tobj + fn.Meta = m + return fn, nil + default: + return nil, errors.New("with-meta not supported on type") + } +} + +func meta(a []MalType) (MalType, error) { + obj := a[0] + switch tobj := obj.(type) { + case List: + return tobj.Meta, nil + case Vector: + return tobj.Meta, nil + case HashMap: + return tobj.Meta, nil + case Func: + return tobj.Meta, nil + case MalFunc: + return tobj.Meta, nil + default: + return nil, errors.New("meta not supported on type") + } +} + +// Atom functions +func deref(a []MalType) (MalType, error) { + if !Atom_Q(a[0]) { + return nil, errors.New("deref called with non-atom") + } + return a[0].(*Atom).Val, nil +} + +func reset_BANG(a []MalType) (MalType, error) { + if !Atom_Q(a[0]) { + return nil, errors.New("reset! called with non-atom") + } + a[0].(*Atom).Set(a[1]) + return a[1], nil +} + +func swap_BANG(a []MalType) (MalType, error) { + if !Atom_Q(a[0]) { + return nil, errors.New("swap! called with non-atom") + } + atm := a[0].(*Atom) + args := []MalType{atm.Val} + f := a[1] + args = append(args, a[2:]...) + res, e := Apply(f, args) + if e != nil { + return nil, e + } + atm.Set(res) + return res, nil +} + +// core namespace +var NS = map[string]MalType{ + "=": call2b(Equal_Q), + "throw": call1e(throw), + "nil?": call1b(Nil_Q), + "true?": call1b(True_Q), + "false?": call1b(False_Q), + "symbol": call1e(func(a []MalType) (MalType, error) { return Symbol{a[0].(string)}, nil }), + "symbol?": call1b(Symbol_Q), + "string?": call1e(func(a []MalType) (MalType, error) { return (String_Q(a[0]) && !Keyword_Q(a[0])), nil }), + "keyword": call1e(func(a []MalType) (MalType, error) { + if Keyword_Q(a[0]) { + return a[0], nil + } else { + return NewKeyword(a[0].(string)) + } + }), + "keyword?": call1b(Keyword_Q), + "number?": call1b(Number_Q), + "fn?": call1e(fn_q), + "macro?": call1e(func(a []MalType) (MalType, error) { return MalFunc_Q(a[0]) && a[0].(MalFunc).GetMacro(), nil }), + "pr-str": callNe(pr_str), + "str": callNe(str), + "prn": callNe(prn), + "println": callNe(println), + "read-string": call1e(func(a []MalType) (MalType, error) { return reader.Read_str(a[0].(string)) }), + "slurp": call1e(slurp), + "readline": call1e(func(a []MalType) (MalType, error) { return readline.Readline(a[0].(string)) }), + "<": call2e(func(a []MalType) (MalType, error) { return a[0].(int) < a[1].(int), nil }), + "<=": call2e(func(a []MalType) (MalType, error) { return a[0].(int) <= a[1].(int), nil }), + ">": call2e(func(a []MalType) (MalType, error) { return a[0].(int) > a[1].(int), nil }), + ">=": call2e(func(a []MalType) (MalType, error) { return a[0].(int) >= a[1].(int), nil }), + "+": call2e(func(a []MalType) (MalType, error) { return a[0].(int) + a[1].(int), nil }), + "-": call2e(func(a []MalType) (MalType, error) { return a[0].(int) - a[1].(int), nil }), + "*": call2e(func(a []MalType) (MalType, error) { return a[0].(int) * a[1].(int), nil }), + "/": call2e(func(a []MalType) (MalType, error) { return a[0].(int) / a[1].(int), nil }), + "time-ms": call0e(time_ms), + "list": callNe(func(a []MalType) (MalType, error) { return List{a, nil}, nil }), + "list?": call1b(List_Q), + "vector": callNe(func(a []MalType) (MalType, error) { return Vector{a, nil}, nil }), + "vector?": call1b(Vector_Q), + "hash-map": callNe(func(a []MalType) (MalType, error) { return NewHashMap(List{a, nil}) }), + "map?": call1b(HashMap_Q), + "assoc": callNe(assoc), // at least 3 + "dissoc": callNe(dissoc), // at least 2 + "get": call2e(get), + "contains?": call2e(func(a []MalType) (MalType, error) { return contains_Q(a[0], a[1]) }), + "keys": call1e(keys), + "vals": call1e(vals), + "sequential?": call1b(Sequential_Q), + "cons": call2e(cons), + "concat": callNe(concat), + "vec": call1e(vec), + "nth": call2e(nth), + "first": call1e(first), + "rest": call1e(rest), + "empty?": call1e(empty_Q), + "count": call1e(count), + "apply": callNe(apply), // at least 2 + "map": call2e(do_map), + "conj": callNe(conj), // at least 2 + "seq": call1e(seq), + "with-meta": call2e(with_meta), + "meta": call1e(meta), + "atom": call1e(func(a []MalType) (MalType, error) { return &Atom{a[0], nil}, nil }), + "atom?": call1b(Atom_Q), + "deref": call1e(deref), + "reset!": call2e(reset_BANG), + "swap!": callNe(swap_BANG), +} + +// callXX functions check the number of arguments +func call0e(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { + return func(args []MalType) (MalType, error) { + if len(args) != 0 { + return nil, fmt.Errorf("wrong number of arguments (%d instead of 0)", len(args)) + } + return f(args) + } +} + +func call1e(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { + return func(args []MalType) (MalType, error) { + if len(args) != 1 { + return nil, fmt.Errorf("wrong number of arguments (%d instead of 1)", len(args)) + } + return f(args) + } +} + +func call2e(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { + return func(args []MalType) (MalType, error) { + if len(args) != 2 { + return nil, fmt.Errorf("wrong number of arguments (%d instead of 2)", len(args)) + } + return f(args) + } +} + +func callNe(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { + // just for documenting purposes, does not check anything + return func(args []MalType) (MalType, error) { + return f(args) + } +} + +func call1b(f func(MalType) bool) func([]MalType) (MalType, error) { + return func(args []MalType) (MalType, error) { + if len(args) != 1 { + return nil, fmt.Errorf("wrong number of arguments (%d instead of 1)", len(args)) + } + return f(args[0]), nil + } +} + +func call2b(f func(MalType, MalType) bool) func([]MalType) (MalType, error) { + return func(args []MalType) (MalType, error) { + if len(args) != 2 { + return nil, fmt.Errorf("wrong number of arguments (%d instead of 2)", len(args)) + } + return f(args[0], args[1]), nil + } +} diff --git a/go/src/env/env.go b/impls/go/src/env/env.go similarity index 98% rename from go/src/env/env.go rename to impls/go/src/env/env.go index 88098fcc0a..0c3ed5b8b2 100644 --- a/go/src/env/env.go +++ b/impls/go/src/env/env.go @@ -6,7 +6,7 @@ import ( ) import ( - . "types" + . "mal/src/types" ) type Env struct { diff --git a/go/src/printer/printer.go b/impls/go/src/printer/printer.go similarity index 98% rename from go/src/printer/printer.go rename to impls/go/src/printer/printer.go index 016e65f8d8..34cda90cb9 100644 --- a/go/src/printer/printer.go +++ b/impls/go/src/printer/printer.go @@ -6,7 +6,7 @@ import ( ) import ( - "types" + "mal/src/types" ) func Pr_list(lst []types.MalType, pr bool, diff --git a/go/src/reader/reader.go b/impls/go/src/reader/reader.go similarity index 92% rename from go/src/reader/reader.go rename to impls/go/src/reader/reader.go index ee64f56be4..b3fdc61c28 100644 --- a/go/src/reader/reader.go +++ b/impls/go/src/reader/reader.go @@ -9,7 +9,7 @@ import ( ) import ( - . "types" + . "mal/src/types" ) type Reader interface { @@ -42,7 +42,7 @@ func tokenize(str string) []string { results := make([]string, 0, 1) // Work around lack of quoting in backtick re := regexp.MustCompile(`[\s,]*(~@|[\[\]{}()'` + "`" + - `~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"` + "`" + + `~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"` + "`" + `,;)]*)`) for _, group := range re.FindAllStringSubmatch(str, -1) { if (group[1] == "") || (group[1][0] == ';') { @@ -65,11 +65,18 @@ func read_atom(rdr Reader) (MalType, error) { return nil, errors.New("number parse error") } return i, nil - } else if (*token)[0] == '"' { + } else if match, _ := + regexp.MatchString(`^"(?:\\.|[^\\"])*"$`, *token); match { str := (*token)[1 : len(*token)-1] return strings.Replace( - strings.Replace(str, `\"`, `"`, -1), - `\n`, "\n", -1), nil + strings.Replace( + strings.Replace( + strings.Replace(str, `\\`, "\u029e", -1), + `\"`, `"`, -1), + `\n`, "\n", -1), + "\u029e", "\\", -1), nil + } else if (*token)[0] == '"' { + return nil, errors.New("expected '\"', got EOF") } else if (*token)[0] == ':' { return NewKeyword((*token)[1:len(*token)]) } else if *token == "nil" { diff --git a/go/src/readline/readline.go b/impls/go/src/readline/readline.go similarity index 100% rename from go/src/readline/readline.go rename to impls/go/src/readline/readline.go diff --git a/go/src/step0_repl/step0_repl.go b/impls/go/src/step0_repl/step0_repl.go similarity index 96% rename from go/src/step0_repl/step0_repl.go rename to impls/go/src/step0_repl/step0_repl.go index 644a087f3f..052591e54c 100644 --- a/go/src/step0_repl/step0_repl.go +++ b/impls/go/src/step0_repl/step0_repl.go @@ -6,7 +6,7 @@ import ( ) import ( - "readline" + "mal/src/readline" ) // read diff --git a/go/src/step1_read_print/step1_read_print.go b/impls/go/src/step1_read_print/step1_read_print.go similarity index 92% rename from go/src/step1_read_print/step1_read_print.go rename to impls/go/src/step1_read_print/step1_read_print.go index f4c4115a7c..09e1957215 100644 --- a/go/src/step1_read_print/step1_read_print.go +++ b/impls/go/src/step1_read_print/step1_read_print.go @@ -6,10 +6,10 @@ import ( ) import ( - "printer" - "reader" - "readline" - . "types" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read diff --git a/go/src/step2_eval/step2_eval.go b/impls/go/src/step2_eval/step2_eval.go similarity index 83% rename from go/src/step2_eval/step2_eval.go rename to impls/go/src/step2_eval/step2_eval.go index 246c4cf0fc..b24f858831 100644 --- a/go/src/step2_eval/step2_eval.go +++ b/impls/go/src/step2_eval/step2_eval.go @@ -7,10 +7,10 @@ import ( ) import ( - "printer" - "reader" - "readline" - . "types" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -52,18 +52,11 @@ func eval_ast(ast MalType, env map[string]MalType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -79,6 +72,10 @@ func EVAL(ast MalType, env map[string]MalType) (MalType, error) { return eval_ast(ast, env) } + if len(ast.(List).Val) == 0 { + return ast, nil + } + // apply list el, e := eval_ast(ast, env) if e != nil { @@ -98,19 +95,38 @@ func PRINT(exp MalType) (string, error) { var repl_env = map[string]MalType{ "+": func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) + a[1].(int), nil }, "-": func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) - a[1].(int), nil }, "*": func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) * a[1].(int), nil }, "/": func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) / a[1].(int), nil }, } +func assertArgNum(a []MalType, n int) error { + if len(a) != n { + return errors.New("wrong number of arguments") + } + return nil +} + // repl func rep(str string) (MalType, error) { var exp MalType diff --git a/go/src/step3_env/step3_env.go b/impls/go/src/step3_env/step3_env.go similarity index 86% rename from go/src/step3_env/step3_env.go rename to impls/go/src/step3_env/step3_env.go index 6a91701608..0f199e1a5f 100644 --- a/go/src/step3_env/step3_env.go +++ b/impls/go/src/step3_env/step3_env.go @@ -7,11 +7,11 @@ import ( ) import ( - . "env" - "printer" - "reader" - "readline" - . "types" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -48,18 +48,11 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -75,6 +68,10 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return eval_ast(ast, env) } + if len(ast.(List).Val) == 0 { + return ast, nil + } + // apply list a0 := ast.(List).Val[0] var a1 MalType = nil @@ -160,15 +157,27 @@ func rep(str string) (MalType, error) { func main() { repl_env.Set(Symbol{"+"}, func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) + a[1].(int), nil }) repl_env.Set(Symbol{"-"}, func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) - a[1].(int), nil }) repl_env.Set(Symbol{"*"}, func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) * a[1].(int), nil }) repl_env.Set(Symbol{"/"}, func(a []MalType) (MalType, error) { + if e := assertArgNum(a, 2); e != nil { + return nil, e + } return a[0].(int) / a[1].(int), nil }) @@ -191,3 +200,10 @@ func main() { fmt.Printf("%v\n", out) } } + +func assertArgNum(a []MalType, n int) error { + if len(a) != n { + return errors.New("wrong number of arguments") + } + return nil +} diff --git a/go/src/step4_if_fn_do/step4_if_fn_do.go b/impls/go/src/step4_if_fn_do/step4_if_fn_do.go similarity index 93% rename from go/src/step4_if_fn_do/step4_if_fn_do.go rename to impls/go/src/step4_if_fn_do/step4_if_fn_do.go index 2e6d60d1f3..9de8d00a30 100644 --- a/go/src/step4_if_fn_do/step4_if_fn_do.go +++ b/impls/go/src/step4_if_fn_do/step4_if_fn_do.go @@ -7,12 +7,12 @@ import ( ) import ( - "core" - . "env" - "printer" - "reader" - "readline" - . "types" + "mal/src/core" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -49,18 +49,11 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -76,6 +69,10 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return eval_ast(ast, env) } + if len(ast.(List).Val) == 0 { + return ast, nil + } + // apply list a0 := ast.(List).Val[0] var a1 MalType = nil diff --git a/go/src/step5_tco/step5_tco.go b/impls/go/src/step5_tco/step5_tco.go similarity index 94% rename from go/src/step5_tco/step5_tco.go rename to impls/go/src/step5_tco/step5_tco.go index 81b7ebdf65..7205fc805d 100644 --- a/go/src/step5_tco/step5_tco.go +++ b/impls/go/src/step5_tco/step5_tco.go @@ -7,12 +7,12 @@ import ( ) import ( - "core" - . "env" - "printer" - "reader" - "readline" - . "types" + "mal/src/core" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -49,18 +49,11 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -78,6 +71,10 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return eval_ast(ast, env) } + if len(ast.(List).Val) == 0 { + return ast, nil + } + // apply list a0 := ast.(List).Val[0] var a1 MalType = nil diff --git a/go/src/step6_file/step6_file.go b/impls/go/src/step6_file/step6_file.go similarity index 94% rename from go/src/step6_file/step6_file.go rename to impls/go/src/step6_file/step6_file.go index d0624d07de..88128d30f1 100644 --- a/go/src/step6_file/step6_file.go +++ b/impls/go/src/step6_file/step6_file.go @@ -8,12 +8,12 @@ import ( ) import ( - "core" - . "env" - "printer" - "reader" - "readline" - . "types" + "mal/src/core" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -50,18 +50,11 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -79,6 +72,10 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return eval_ast(ast, env) } + if len(ast.(List).Val) == 0 { + return ast, nil + } + // apply list a0 := ast.(List).Val[0] var a1 MalType = nil @@ -214,7 +211,7 @@ func main() { // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") - rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") // called with mal script to load and eval if len(os.Args) > 1 { diff --git a/go/src/step7_quote/step7_quote.go b/impls/go/src/step7_quote/step7_quote.go similarity index 82% rename from go/src/step7_quote/step7_quote.go rename to impls/go/src/step7_quote/step7_quote.go index 5260eb5944..11832eb622 100644 --- a/go/src/step7_quote/step7_quote.go +++ b/impls/go/src/step7_quote/step7_quote.go @@ -8,12 +8,12 @@ import ( ) import ( - "core" - . "env" - "printer" - "reader" - "readline" - . "types" + "mal/src/core" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -22,34 +22,48 @@ func READ(str string) (MalType, error) { } // eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } } - return len(slc) > 0 + return false } -func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue } + default: } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc +} + +func quasiquote(ast MalType) MalType { + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) + } + default: + return ast } } @@ -81,18 +95,11 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -110,6 +117,10 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return eval_ast(ast, env) } + if len(ast.(List).Val) == 0 { + return ast, nil + } + // apply list a0 := ast.(List).Val[0] var a1 MalType = nil @@ -159,6 +170,8 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil + case "quasiquoteexpand": + return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "do": @@ -249,7 +262,7 @@ func main() { // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") - rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") // called with mal script to load and eval if len(os.Args) > 1 { diff --git a/go/src/step8_macros/step8_macros.go b/impls/go/src/step8_macros/step8_macros.go similarity index 84% rename from go/src/step8_macros/step8_macros.go rename to impls/go/src/step8_macros/step8_macros.go index cbada3b6b3..762dcaf374 100644 --- a/go/src/step8_macros/step8_macros.go +++ b/impls/go/src/step8_macros/step8_macros.go @@ -8,12 +8,12 @@ import ( ) import ( - "core" - . "env" - "printer" - "reader" - "readline" - . "types" + "mal/src/core" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -22,40 +22,57 @@ func READ(str string) (MalType, error) { } // eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } } - return len(slc) > 0 + return false } -func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue } + default: } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc +} + +func quasiquote(ast MalType) MalType { + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) + } + default: + return ast } } func is_macro_call(ast MalType, env EnvType) bool { if List_Q(ast) { slc, _ := GetSlice(ast) + if len(slc) == 0 { + return false + } a0 := slc[0] if Symbol_Q(a0) && env.Find(a0.(Symbol)) != nil { mac, e := env.Get(a0.(Symbol)) @@ -117,18 +134,11 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -153,6 +163,9 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return nil, e } if !List_Q(ast) { + return eval_ast(ast, env) + } + if len(ast.(List).Val) == 0 { return ast, nil } @@ -204,6 +217,8 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil + case "quasiquoteexpand": + return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": @@ -303,9 +318,8 @@ func main() { // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") - rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") - rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") // called with mal script to load and eval if len(os.Args) > 1 { diff --git a/go/src/step9_try/step9_try.go b/impls/go/src/step9_try/step9_try.go similarity index 85% rename from go/src/step9_try/step9_try.go rename to impls/go/src/step9_try/step9_try.go index 34b380a28e..ddc8a77435 100644 --- a/go/src/step9_try/step9_try.go +++ b/impls/go/src/step9_try/step9_try.go @@ -8,12 +8,12 @@ import ( ) import ( - "core" - . "env" - "printer" - "reader" - "readline" - . "types" + "mal/src/core" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" ) // read @@ -22,40 +22,57 @@ func READ(str string) (MalType, error) { } // eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } } - return len(slc) > 0 + return false } -func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue } + default: } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc +} + +func quasiquote(ast MalType) MalType { + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) + } + default: + return ast } } func is_macro_call(ast MalType, env EnvType) bool { if List_Q(ast) { slc, _ := GetSlice(ast) + if len(slc) == 0 { + return false + } a0 := slc[0] if Symbol_Q(a0) && env.Find(a0.(Symbol)) != nil { mac, e := env.Get(a0.(Symbol)) @@ -117,18 +134,11 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { - ke, e1 := EVAL(k, env) - if e1 != nil { - return nil, e1 - } - if _, ok := ke.(string); !ok { - return nil, errors.New("non string hash-map key") - } kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } - new_hm.Val[ke.(string)] = kv + new_hm.Val[k] = kv } return new_hm, nil } else { @@ -153,6 +163,9 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return nil, e } if !List_Q(ast) { + return eval_ast(ast, env) + } + if len(ast.(List).Val) == 0 { return ast, nil } @@ -204,6 +217,8 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil + case "quasiquoteexpand": + return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": @@ -331,9 +346,8 @@ func main() { // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") - rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") - rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") // called with mal script to load and eval if len(os.Args) > 1 { diff --git a/impls/go/src/stepA_mal/stepA_mal.go b/impls/go/src/stepA_mal/stepA_mal.go new file mode 100644 index 0000000000..2ff77563c9 --- /dev/null +++ b/impls/go/src/stepA_mal/stepA_mal.go @@ -0,0 +1,335 @@ +package main + +import ( + "errors" + "fmt" + "os" + "strings" +) + +import ( + "mal/src/core" + . "mal/src/env" + "mal/src/printer" + "mal/src/reader" + "mal/src/readline" + . "mal/src/types" +) + +// read +func READ(str string) (MalType, error) { + return reader.Read_str(str) +} + +// eval +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } + } + return false +} + +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue + } + default: + } + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc +} + +func quasiquote(ast MalType) MalType { + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) + } + default: + return ast + } +} + +func map_eval(xs []MalType, env EnvType) ([]MalType, error) { + lst := []MalType{} + for _, a := range xs { + exp, e := EVAL(a, env) + if e != nil { + return nil, e + } + lst = append(lst, exp) + } + return lst, nil +} + +func EVAL(ast MalType, env EnvType) (MalType, error) { + for { + //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) + + if Symbol_Q(ast) { + return env.Get(ast.(Symbol)) + } else if Vector_Q(ast) { + lst, e := map_eval(ast.(Vector).Val, env) + if e != nil { + return nil, e + } + return Vector{lst, nil}, nil + } else if HashMap_Q(ast) { + m := ast.(HashMap) + new_hm := HashMap{map[string]MalType{}, nil} + for k, v := range m.Val { + kv, e2 := EVAL(v, env) + if e2 != nil { + return nil, e2 + } + new_hm.Val[k] = kv + } + return new_hm, nil + } else if !List_Q(ast) { + return ast, nil + } else { + // apply list + if len(ast.(List).Val) == 0 { + return ast, nil + } + + a0 := ast.(List).Val[0] + var a1 MalType = nil + var a2 MalType = nil + switch len(ast.(List).Val) { + case 1: + a1 = nil + a2 = nil + case 2: + a1 = ast.(List).Val[1] + a2 = nil + default: + a1 = ast.(List).Val[1] + a2 = ast.(List).Val[2] + } + a0sym := "__<*fn*>__" + if Symbol_Q(a0) { + a0sym = a0.(Symbol).Val + } + switch a0sym { + case "def!": + res, e := EVAL(a2, env) + if e != nil { + return nil, e + } + return env.Set(a1.(Symbol), res), nil + case "let*": + let_env, e := NewEnv(env, nil, nil) + if e != nil { + return nil, e + } + arr1, e := GetSlice(a1) + if e != nil { + return nil, e + } + for i := 0; i < len(arr1); i += 2 { + if !Symbol_Q(arr1[i]) { + return nil, errors.New("non-symbol bind value") + } + exp, e := EVAL(arr1[i+1], let_env) + if e != nil { + return nil, e + } + let_env.Set(arr1[i].(Symbol), exp) + } + ast = a2 + env = let_env + case "quote": + return a1, nil + case "quasiquote": + ast = quasiquote(a1) + case "defmacro!": + fn, e := EVAL(a2, env) + fn = fn.(MalFunc).SetMacro() + if e != nil { + return nil, e + } + return env.Set(a1.(Symbol), fn), nil + case "try*": + var exc MalType + exp, e := EVAL(a1, env) + if e == nil { + return exp, nil + } else { + if a2 != nil && List_Q(a2) { + a2s, _ := GetSlice(a2) + if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") { + switch e.(type) { + case MalError: + exc = e.(MalError).Obj + default: + exc = e.Error() + } + binds := NewList(a2s[1]) + new_env, e := NewEnv(env, binds, NewList(exc)) + if e != nil { + return nil, e + } + exp, e = EVAL(a2s[2], new_env) + if e == nil { + return exp, nil + } + } + } + return nil, e + } + case "do": + lst := ast.(List).Val + _, e := map_eval(lst[1 : len(lst)-1], env) + if e != nil { + return nil, e + } + if len(lst) == 1 { + return nil, nil + } + ast = lst[len(lst)-1] + case "if": + cond, e := EVAL(a1, env) + if e != nil { + return nil, e + } + if cond == nil || cond == false { + if len(ast.(List).Val) >= 4 { + ast = ast.(List).Val[3] + } else { + return nil, nil + } + } else { + ast = a2 + } + case "fn*": + fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} + return fn, nil + default: + f, e := EVAL(a0, env) + if e != nil { + return nil, e + } + args := ast.(List).Val[1:] + if MalFunc_Q(f) && f.(MalFunc).GetMacro() { + new_ast, e := Apply(f.(MalFunc), args) + if e != nil { + return nil, e + } + ast = new_ast + continue + } + args, e = map_eval(args, env) + if e != nil { + return nil, e + } + if MalFunc_Q(f) { + fn := f.(MalFunc) + ast = fn.Exp + env, e = NewEnv(fn.Env, fn.Params, List{args, nil}) + if e != nil { + return nil, e + } + } else { + fn, ok := f.(Func) + if !ok { + return nil, errors.New("attempt to call non-function") + } + return fn.Fn(args) + } + } + } + } // TCO loop +} + +// print +func PRINT(exp MalType) (string, error) { + return printer.Pr_str(exp, true), nil +} + +var repl_env, _ = NewEnv(nil, nil, nil) + +// repl +func rep(str string) (MalType, error) { + var exp MalType + var res string + var e error + if exp, e = READ(str); e != nil { + return nil, e + } + if exp, e = EVAL(exp, repl_env); e != nil { + return nil, e + } + if res, e = PRINT(exp); e != nil { + return nil, e + } + return res, nil +} + +func main() { + // core.go: defined using go + for k, v := range core.NS { + repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) + } + repl_env.Set(Symbol{"eval"}, Func{func(a []MalType) (MalType, error) { + return EVAL(a[0], repl_env) + }, nil}) + repl_env.Set(Symbol{"*ARGV*"}, List{}) + + // core.mal: defined using the language itself + rep("(def! *host-language* \"go\")") + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + // called with mal script to load and eval + if len(os.Args) > 1 { + args := make([]MalType, 0, len(os.Args)-2) + for _, a := range os.Args[2:] { + args = append(args, a) + } + repl_env.Set(Symbol{"*ARGV*"}, List{args, nil}) + if _, e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { + fmt.Printf("Error: %v\n", e) + os.Exit(1) + } + os.Exit(0) + } + + // repl loop + rep("(println (str \"Mal [\" *host-language* \"]\"))") + for { + text, err := readline.Readline("user> ") + text = strings.TrimRight(text, "\n") + if err != nil { + return + } + var out MalType + var e error + if out, e = rep(text); e != nil { + if e.Error() == "" { + continue + } + fmt.Printf("Error: %v\n", e) + continue + } + fmt.Printf("%v\n", out) + } +} diff --git a/go/src/types/types.go b/impls/go/src/types/types.go similarity index 79% rename from go/src/types/types.go rename to impls/go/src/types/types.go index 3fac06d37e..9d4cb10b5f 100644 --- a/go/src/types/types.go +++ b/impls/go/src/types/types.go @@ -28,29 +28,22 @@ type EnvType interface { // Scalars func Nil_Q(obj MalType) bool { - if obj == nil { - return true - } else { - return false - } + return obj == nil } func True_Q(obj MalType) bool { - switch tobj := obj.(type) { - case bool: - return tobj == true - default: - return false - } + b, ok := obj.(bool) + return ok && b == true } func False_Q(obj MalType) bool { - switch tobj := obj.(type) { - case bool: - return tobj == false - default: - return false - } + b, ok := obj.(bool) + return ok && b == false +} + +func Number_Q(obj MalType) bool { + _, ok := obj.(int) + return ok } // Symbols @@ -59,10 +52,8 @@ type Symbol struct { } func Symbol_Q(obj MalType) bool { - if obj == nil { - return false - } - return reflect.TypeOf(obj).Name() == "Symbol" + _, ok := obj.(Symbol) + return ok } // Keywords @@ -71,23 +62,14 @@ func NewKeyword(s string) (MalType, error) { } func Keyword_Q(obj MalType) bool { - if obj == nil { - return false - } - switch s := obj.(type) { - case string: - return strings.HasPrefix(s, "\u029e") - default: - return false - } + s, ok := obj.(string) + return ok && strings.HasPrefix(s, "\u029e") } // Strings func String_Q(obj MalType) bool { - if obj == nil { - return false - } - return reflect.TypeOf(obj).Name() == "string" + _, ok := obj.(string) + return ok } // Functions @@ -97,10 +79,8 @@ type Func struct { } func Func_Q(obj MalType) bool { - if obj == nil { - return false - } - return reflect.TypeOf(obj).Name() == "Func" + _, ok := obj.(Func) + return ok } type MalFunc struct { @@ -114,10 +94,8 @@ type MalFunc struct { } func MalFunc_Q(obj MalType) bool { - if obj == nil { - return false - } - return reflect.TypeOf(obj).Name() == "MalFunc" + _, ok := obj.(MalFunc) + return ok } func (f MalFunc) SetMacro() MalType { @@ -159,10 +137,8 @@ func NewList(a ...MalType) MalType { } func List_Q(obj MalType) bool { - if obj == nil { - return false - } - return reflect.TypeOf(obj).Name() == "List" + _, ok := obj.(List) + return ok } // Vectors @@ -172,10 +148,8 @@ type Vector struct { } func Vector_Q(obj MalType) bool { - if obj == nil { - return false - } - return reflect.TypeOf(obj).Name() == "Vector" + _, ok := obj.(Vector) + return ok } func GetSlice(seq MalType) ([]MalType, error) { @@ -215,10 +189,8 @@ func NewHashMap(seq MalType) (MalType, error) { } func HashMap_Q(obj MalType) bool { - if obj == nil { - return false - } - return reflect.TypeOf(obj).Name() == "HashMap" + _, ok := obj.(HashMap) + return ok } // Atoms @@ -233,12 +205,8 @@ func (a *Atom) Set(val MalType) MalType { } func Atom_Q(obj MalType) bool { - switch obj.(type) { - case *Atom: - return true - default: - return false - } + _, ok := obj.(*Atom) + return ok } // General functions @@ -295,7 +263,17 @@ func Equal_Q(a MalType, b MalType) bool { } return true case HashMap: - return false + am := a.(HashMap).Val + bm := b.(HashMap).Val + if len(am) != len(bm) { + return false + } + for k, v := range am { + if !Equal_Q(v, bm[k]) { + return false + } + } + return true default: return a == b } diff --git a/impls/go/tests/step2_eval.mal b/impls/go/tests/step2_eval.mal new file mode 100644 index 0000000000..4b3a4bf27d --- /dev/null +++ b/impls/go/tests/step2_eval.mal @@ -0,0 +1,34 @@ +;; Testing evaluation of excessive arguments +(+ 1 2 3) +;=>Error: wrong number of arguments + +;; Valid call +(+ 1 2) +;=>3 + + +;; Testing evaluation of missing arguments +(+ 1) +;=>Error: wrong number of arguments + +;; Testing evaluation of missing arguments +(+) +;=>Error: wrong number of arguments + +;; Testing evaluation of excessive arguments +(- 1 2 3) +;=>Error: wrong number of arguments + +;; Valid call +(- 1 2) +;=>-1 + + +;; Testing evaluation of missing arguments +(- 1) +;=>Error: wrong number of arguments + +;; Testing evaluation of missing arguments +(-) +;=>Error: wrong number of arguments + diff --git a/impls/go/tests/step4_if_fn_do.mal b/impls/go/tests/step4_if_fn_do.mal new file mode 100644 index 0000000000..2134ce66f8 --- /dev/null +++ b/impls/go/tests/step4_if_fn_do.mal @@ -0,0 +1,34 @@ +;; Testing evaluation of excessive arguments +(+ 1 2 3) +;=>Error: wrong number of arguments (3 instead of 2) + +;; Valid call +(+ 1 2) +;=>3 + + +;; Testing evaluation of missing arguments +(+ 1) +;=>Error: wrong number of arguments (1 instead of 2) + +;; Testing evaluation of missing arguments +(+) +;=>Error: wrong number of arguments (0 instead of 2) + +;; Testing evaluation of excessive arguments +(= 1 2 3) +;=>Error: wrong number of arguments (3 instead of 2) + +;; Valid call +(= 1 2) +;=>false + + +;; Testing evaluation of missing arguments +(= 1) +;=>Error: wrong number of arguments (1 instead of 2) + +;; Testing evaluation of missing arguments +(=) +;=>Error: wrong number of arguments (0 instead of 2) + diff --git a/impls/go/tests/step5_tco.mal b/impls/go/tests/step5_tco.mal new file mode 100644 index 0000000000..6fa1da6fdf --- /dev/null +++ b/impls/go/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Go: skipping non-TCO recursion +;; Reason: completes even at 100,000 diff --git a/impls/groovy/Dockerfile b/impls/groovy/Dockerfile new file mode 100644 index 0000000000..fc18e61d70 --- /dev/null +++ b/impls/groovy/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install groovy diff --git a/impls/groovy/GroovyWrapper.groovy b/impls/groovy/GroovyWrapper.groovy new file mode 100644 index 0000000000..b375dd7a24 --- /dev/null +++ b/impls/groovy/GroovyWrapper.groovy @@ -0,0 +1,76 @@ +/* From: + * http://groovy.jmiguel.eu/groovy.codehaus.org/WrappingGroovyScript.html + */ +/* + * Copyright 2002-2007 the original author or authors. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ + +/** + * Wrap a script and groovy jars to an executable jar + */ +def cli = new CliBuilder() +cli.h( longOpt: 'help', required: false, 'show usage information' ) +cli.d( longOpt: 'destfile', argName: 'destfile', required: false, args: 1, 'jar destintation filename, defaults to {mainclass}.jar' ) +cli.m( longOpt: 'mainclass', argName: 'mainclass', required: true, args: 1, 'fully qualified main class, eg. HelloWorld' ) +cli.c( longOpt: 'groovyc', required: false, 'Run groovyc' ) + +//-------------------------------------------------------------------------- +def opt = cli.parse(args) +if (!opt) { return } +if (opt.h) { + cli.usage(); + return +} + +def mainClass = opt.m +def scriptBase = mainClass.replace( '.', '/' ) +def scriptFile = new File( scriptBase + '.groovy' ) +if (!scriptFile.canRead()) { + println "Cannot read script file: '${scriptFile}'" + return +} +def destFile = scriptBase + '.jar' +if (opt.d) { + destFile = opt.d +} + +//-------------------------------------------------------------------------- +def ant = new AntBuilder() + +if (opt.c) { + ant.echo( "Compiling ${scriptFile}" ) + org.codehaus.groovy.tools.FileSystemCompiler.main( [ scriptFile ] as String[] ) +} + +def GROOVY_HOME = new File( System.getenv('GROOVY_HOME') ) +if (!GROOVY_HOME.canRead()) { + ant.echo( "Missing environment variable GROOVY_HOME: '${GROOVY_HOME}'" ) + return +} + +ant.jar( destfile: destFile, compress: true, index: true ) { + //fileset( dir: '.', includes: scriptBase + '*.class' ) + fileset( dir: '.', includes: '*.class' ) + + zipgroupfileset( dir: GROOVY_HOME, includes: 'embeddable/groovy-all-*.jar' ) + zipgroupfileset( dir: GROOVY_HOME, includes: 'lib/commons*.jar' ) + // add more jars here + + manifest { + attribute( name: 'Main-Class', value: mainClass ) + } +} + +ant.echo( "Run script using: \'java -jar ${destFile} ...\'" ) diff --git a/impls/groovy/Makefile b/impls/groovy/Makefile new file mode 100644 index 0000000000..888eb9fc24 --- /dev/null +++ b/impls/groovy/Makefile @@ -0,0 +1,38 @@ +CLASSES = types.class reader.class printer.class env.class core.class + +all: ${CLASSES} + +dist: mal.jar + +step1_read_print.groovy: types.class reader.class printer.class +step2_eval.groovy: types.class reader.class printer.class +step3_env.groovy: types.class reader.class printer.class env.class +step4_if_fn_do.groovy step6_file.groovy step7_quote.groovy step8_macros.groovy step9_try.groovy stepA_mal.groovy: ${CLASSES} + +types.class: types.groovy + groovyc $< + +env.class: env.groovy + groovyc $< + +reader.class: reader.groovy + groovyc $< + +printer.class: printer.groovy + groovyc $< + +core.class: core.groovy types.class reader.class printer.class + groovyc $< + +mal.jar: ${CLASSES} + groovyc stepA_mal.groovy + GROOVY_HOME=/usr/share/groovy groovy GroovyWrapper -d $@ -m stepA_mal + +SHELL := bash +mal: mal.jar + cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ + chmod +x mal + +clean: + rm -f *.class classes/* mal.jar mal + rmdir classes || true diff --git a/impls/groovy/core.groovy b/impls/groovy/core.groovy new file mode 100644 index 0000000000..aaf05d4a58 --- /dev/null +++ b/impls/groovy/core.groovy @@ -0,0 +1,136 @@ +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import reader +import printer + +class core { + def static do_pr_str(args) { + return printer._pr_list(args, " ", true) + } + def static do_str(args) { + return printer._pr_list(args, "", false) + } + def static do_prn(args) { + println(printer._pr_list(args, " ", true)) + } + def static do_println(args) { + println(printer._pr_list(args, " ", false)) + } + + def static do_concat(args) { + args.inject([], { a, b -> a + (b as List) }) + } + def static do_nth(args) { + if (args[0].size() <= args[1]) { + throw new MalException("nth: index out of range") + } + args[0][args[1]] + } + def static do_apply(args) { + def start_args = args.drop(1).take(args.size()-2) as List + args[0](start_args + (args.last() as List)) + } + + def static do_swap_BANG(args) { + def (atm,f) = [args[0], args[1]] + atm.value = f([atm.value] + (args.drop(2) as List)) + } + + def static do_conj(args) { + if (types.list_Q(args[0])) { + args.drop(1).inject(args[0], { a, b -> [b] + a }) + } else { + types.vector(args.drop(1).inject(args[0], { a, b -> a + [b] })) + } + } + def static do_seq(args) { + def obj = args[0] + switch (obj) { + case { types.list_Q(obj) }: + return obj.size() == 0 ? null : obj + case { types.vector_Q(obj) }: + return obj.size() == 0 ? null : obj.clone() + case { types.string_Q(obj) }: + return obj.size() == 0 ? null : obj.collect{ it.toString() } + case null: + return null + default: + throw new MalException("seq: called on non-sequence") + } + } + + static ns = [ + "=": { a -> a[0]==a[1]}, + "throw": { a -> throw new MalException(a[0]) }, + + "nil?": { a -> a[0] == null }, + "true?": { a -> a[0] == true }, + "false?": { a -> a[0] == false }, + "string?": { a -> types.string_Q(a[0]) }, + "symbol": { a -> new MalSymbol(a[0]) }, + "symbol?": { a -> a[0] instanceof MalSymbol }, + "keyword": { a -> types.keyword(a[0]) }, + "keyword?": { a -> types.keyword_Q(a[0]) }, + "number?": { a -> a[0] instanceof Integer }, + "fn?": { a -> (a[0] instanceof MalFunc && !a[0].ismacro) || + a[0] instanceof Closure }, + "macro?": { a -> a[0] instanceof MalFunc && a[0].ismacro }, + + "pr-str": core.&do_pr_str, + "str": core.&do_str, + "prn": core.&do_prn, + "println": core.&do_println, + "read-string": reader.&read_str, + "readline": { a -> System.console().readLine(a[0]) }, + "slurp": { a -> new File(a[0]).text }, + + "<": { a -> a[0]": { a -> a[0]>a[1]}, + ">=": { a -> a[0]>=a[1]}, + "+": { a -> a[0]+a[1]}, + "-": { a -> a[0]-a[1]}, + "*": { a -> a[0]*a[1]}, + "/": { a -> a[0]/a[1]}, // / + "time-ms": { a -> System.currentTimeMillis() }, + + "list": { a -> a}, + "list?": { a -> types.list_Q(a[0]) }, + "vector": { a -> types.vector(a) }, + "vector?": { a -> types.vector_Q(a[0]) }, + "hash-map": { a -> types.hash_map(a) }, + "map?": { a -> types.hash_map_Q(a[0]) }, + "assoc": { a -> types.assoc_BANG(types.copy(a[0]), a.drop(1)) }, + "dissoc": { a -> types.dissoc_BANG(types.copy(a[0]), a.drop(1)) }, + "get": { a -> a[0] == null ? null : a[0][a[1]] }, + "contains?": { a -> a[0].containsKey(a[1]) }, + "keys": { a -> a[0].keySet() as List }, + "vals": { a -> a[0].values() as List }, + + "sequential?": { a -> types.&sequential_Q(a[0]) }, + "cons": { a -> [a[0]] + (a[1] as List) }, + "concat": core.&do_concat, + "vec": { a -> types.vector_Q(a[0]) ? a[0] : types.vector(a[0]) }, + "nth": core.&do_nth, + "first": { a -> a[0] == null || a[0].size() == 0 ? null : a[0][0] }, + "rest": { a -> a[0] == null ? [] as List : a[0].drop(1) }, + "empty?": { a -> a[0] == null || a[0].size() == 0 }, + "count": { a -> a[0] == null ? 0 : a[0].size() }, + "apply": core.&do_apply, + "map": { a -> a[1].collect { x -> a[0].call([x]) } }, + + "conj": core.&do_conj, + "seq": core.&do_seq, + + "meta": { a -> a[0].hasProperty("meta") ? a[0].getProperties().meta : null }, + "with-meta": { a -> def b = types.copy(a[0]); b.getMetaClass().meta = a[1]; b }, + "atom": { a -> new types.MalAtom(a[0]) }, + "atom?": { a -> a[0] instanceof types.MalAtom }, + "deref": { a -> a[0].value }, + "reset!": { a -> a[0].value = a[1] }, + "swap!": core.&do_swap_BANG + ] +} + diff --git a/impls/groovy/env.groovy b/impls/groovy/env.groovy new file mode 100644 index 0000000000..be3fabb5e0 --- /dev/null +++ b/impls/groovy/env.groovy @@ -0,0 +1,55 @@ +import types.MalException +import types.MalSymbol + +class env { + static class Env { + def data + def outer + + Env() { + outer = null + data = [:] + } + Env(Env outer_env) { + outer = outer_env + data = [:] + } + Env(Env outer_env, binds, exprs) { + outer = outer_env + data = [:] + for (int i=0; i i) ? exprs[i..-1] : [] + break + } else { + data[binds[i].value] = exprs[i] + } + } + } + + def set(MalSymbol key, def val) { + data[key.value] = val + } + + def find(String key) { + if (data.containsKey(key)) { + this + } else if (outer != null) { + outer.find(key) + } else { + null + } + } + + def get(String key) { + def e = find(key) + if (e == null) { + throw new MalException("'${key}' not found") + } else { + e.data.get(key) + } + } + } + +} + diff --git a/impls/groovy/printer.groovy b/impls/groovy/printer.groovy new file mode 100644 index 0000000000..9631b17fea --- /dev/null +++ b/impls/groovy/printer.groovy @@ -0,0 +1,44 @@ +import groovy.json.StringEscapeUtils +import types +import types.MalSymbol +import types.MalAtom + + +class printer { + def static _pr_list(lst, sep, Boolean print_readably) { + return lst.collect{ e -> pr_str(e, print_readably) }.join(sep) + } + + def static pr_str(exp, Boolean print_readably) { + def _r = print_readably + switch (exp) { + case { types.list_Q(exp) }: + def lst = exp.collect { pr_str(it, _r) } + return "(${lst.join(" ")})" + case { types.vector_Q(exp) }: + def lst = exp.collect { pr_str(it, _r) } + return "[${lst.join(" ")}]" + case Map: + def lst = [] + exp.each { k,v -> lst.add(pr_str(k,_r)); lst.add(pr_str(v,_r)) } + return "{${lst.join(" ")}}" + case String: + if (types.keyword_Q(exp)) { + return ":" + exp.drop(1) + } else if (print_readably) { + return "\"${StringEscapeUtils.escapeJava(exp)}\"" + } else { + return exp + } + case null: + return 'nil' + case MalSymbol: + return exp.value + case MalAtom: + return "(atom ${exp.value})" + default: + return exp.toString() + } + } +} + diff --git a/impls/groovy/reader.groovy b/impls/groovy/reader.groovy new file mode 100644 index 0000000000..40586adb52 --- /dev/null +++ b/impls/groovy/reader.groovy @@ -0,0 +1,155 @@ +import groovy.json.StringEscapeUtils +import types +import types.MalException +import types.MalSymbol + +class reader { + static class Reader { + def tokens + def position + Reader(def toks) { + tokens = toks + position = 0 + } + + def peek() { + if (position >= tokens.size) { + null + } else { + tokens[position] + } + } + def next() { + if (position >= tokens.size) { + null + } else { + tokens[position++] + } + } + } + + def static tokenizer(String str) { + def m = str =~ /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ + def tokens = [] + while (m.find()) { + String token = m.group(1) + if (token != null && + !(token == "") && + !(token[0] == ';')) { + tokens.add(token) + } + } + return tokens + } + + def static read_atom(Reader rdr) { + def token = rdr.next() + def m = token =~ /(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^"((?:\\.|[^\\"])*)"$|^"(.*)$|:(.*)|(^[^"]*$)/ + if (!m.find()) { + throw new MalException("unrecognized token '$token'") + } + if (m.group(1) != null) { + Integer.parseInt(m.group(1)) + } else if (m.group(3) != null) { + null + } else if (m.group(4) != null) { + true + } else if (m.group(5) != null) { + false + } else if (m.group(6) != null) { + if (token[token.length() - 1] != '"') { + throw new MalException("expected '\"', got EOF") + } + StringEscapeUtils.unescapeJava(m.group(6)) + } else if (m.group(7) != null) { + throw new MalException("expected '\"', got EOF") + } else if (m.group(8) != null) { + "\u029e" + m.group(8) + } else if (m.group(9) != null) { + new MalSymbol(m.group(9)) + } else { + throw new MalException("unrecognized '${m.group(0)}'") + } + } + + def static read_list(Reader rdr, char start, char end) { + def token = rdr.next() + def lst = [] + if (token.charAt(0) != start) { + throw new MalException("expected '${start}'") + } + + while ((token = rdr.peek()) != null && token.charAt(0) != end) { + lst.add(read_form(rdr)) + } + + if (token == null) { + throw new MalException("expected '${end}', got EOF") + } + rdr.next() + + return lst + } + + def static read_vector(Reader rdr) { + def lst = read_list(rdr, '[' as char, ']' as char) + return types.vector(lst) + } + + def static read_hash_map(Reader rdr) { + def lst = read_list(rdr, '{' as char, '}' as char) + return types.hash_map(lst) + } + + def static read_form(Reader rdr) { + def token = rdr.peek() + switch (token) { + // reader macros/transforms + case "'": + rdr.next() + return [new MalSymbol("quote"), read_form(rdr)] + case '`': + rdr.next() + return [new MalSymbol("quasiquote"), read_form(rdr)] + case '~': + rdr.next() + return [new MalSymbol("unquote"), read_form(rdr)] + case '~@': + rdr.next() + return [new MalSymbol("splice-unquote"), read_form(rdr)] + case '^': + rdr.next() + def meta = read_form(rdr); + return [new MalSymbol("with-meta"), read_form(rdr), meta] + case '@': + rdr.next() + return [new MalSymbol("deref"), read_form(rdr)] + + // list + case ')': throw new MalException("unexpected ')'") + case '(': return read_list(rdr, '(' as char, ')' as char) + + // vector + case ']': throw new MalException("unexpected ']'") + case '[': return read_vector(rdr) + + // hash-map + case '}': throw new MalException("unexpected '}'") + case '{': return read_hash_map(rdr) + + // atom + default: return read_atom(rdr) + } + } + + def static read_str(String str) { + def tokens = tokenizer(str) + if (tokens.size() == 0) { + return null; + } + //println "tokens ${tokens}" + def rdr = new Reader(tokens) + read_form(rdr) + } +} + diff --git a/impls/groovy/run b/impls/groovy/run new file mode 100755 index 0000000000..b64ea39452 --- /dev/null +++ b/impls/groovy/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec groovy $(dirname $0)/${STEP:-stepA_mal}.groovy "${@}" diff --git a/impls/groovy/step0_repl.groovy b/impls/groovy/step0_repl.groovy new file mode 100644 index 0000000000..be6c5e22fd --- /dev/null +++ b/impls/groovy/step0_repl.groovy @@ -0,0 +1,32 @@ +// READ +READ = { str -> + str +} + +// EVAL +EVAL = { ast, env -> + ast +} + +// PRINT +PRINT = { exp -> + exp +} + +// REPL +REP = { str -> + PRINT(EVAL(READ(str), [:])) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break + } + try { + println REP(line) + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step1_read_print.groovy b/impls/groovy/step1_read_print.groovy new file mode 100644 index 0000000000..c9775a6a68 --- /dev/null +++ b/impls/groovy/step1_read_print.groovy @@ -0,0 +1,38 @@ +import reader +import printer +import types.MalException + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +EVAL = { ast, env -> + ast +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +REP = { str -> + PRINT(EVAL(READ(str), [:])) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step2_eval.groovy b/impls/groovy/step2_eval.groovy new file mode 100644 index 0000000000..f58666c7ce --- /dev/null +++ b/impls/groovy/step2_eval.groovy @@ -0,0 +1,69 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +EVAL = { ast, env -> + // println("EVAL: ${printer.pr_str(ast,true)}") + + switch (ast) { + case MalSymbol: + if (env.containsKey(ast.value)) return env.get(ast.value) + throw new MalException("'${ast.value}' not found") + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: + def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: + return ast + } + + if (ast.size() == 0) return ast + + def el = ast.collect { EVAL(it, env) } + def (f, args) = [el[0], el[1..-1]] + f(args) +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = [ + "+": { a -> a[0]+a[1]}, + "-": { a -> a[0]-a[1]}, + "*": { a -> a[0]*a[1]}, + "/": { a -> a[0]/a[1]}] // / +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step3_env.groovy b/impls/groovy/step3_env.groovy new file mode 100644 index 0000000000..dd38ee3cc3 --- /dev/null +++ b/impls/groovy/step3_env.groovy @@ -0,0 +1,83 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import env.Env + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +EVAL = { ast, env -> + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + return EVAL(ast[2], let_env) + default: + def el = ast.collect { EVAL(it, env) } + def (f, args) = [el[0], el[1..-1]] + f(args) + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +repl_env.set(new MalSymbol("+"), { a -> a[0]+a[1]}); +repl_env.set(new MalSymbol("-"), { a -> a[0]-a[1]}); +repl_env.set(new MalSymbol("*"), { a -> a[0]*a[1]}); +repl_env.set(new MalSymbol("/"), { a -> a[0]/a[1]}); // / +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step4_if_fn_do.groovy b/impls/groovy/step4_if_fn_do.groovy new file mode 100644 index 0000000000..69fad95398 --- /dev/null +++ b/impls/groovy/step4_if_fn_do.groovy @@ -0,0 +1,105 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import env.Env +import core + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +EVAL = { ast, env -> + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + return EVAL(ast[2], let_env) + case { it instanceof MalSymbol && it.value == "do" }: + return (ast[1..-1].collect { EVAL(it, env) })[-1] + case { it instanceof MalSymbol && it.value == "if" }: + def cond = EVAL(ast[1], env) + if (cond == false || cond == null) { + if (ast.size > 3) { + return EVAL(ast[3], env) + } else { + return null + } + } else { + return EVAL(ast[2], env) + } + case { it instanceof MalSymbol && it.value == "fn*" }: + return new MalFunc(EVAL, ast[2], env, ast[1]) + default: + def el = ast.collect { EVAL(it, env) } + def (f, args) = [el[0], el.size() > 1 ? el[1..-1] : []] + f(args) + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +// core.EXT: defined using Groovy +core.ns.each { k,v -> + repl_env.set(new MalSymbol(k), v) +} + +// core.mal: defined using mal itself +REP("(def! not (fn* (a) (if a false true)))") + + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step5_tco.groovy b/impls/groovy/step5_tco.groovy new file mode 100644 index 0000000000..d83fcc4f90 --- /dev/null +++ b/impls/groovy/step5_tco.groovy @@ -0,0 +1,121 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import env.Env +import core + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +EVAL = { ast, env -> + while (true) { + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + env = let_env + ast = ast[2] + break // TCO + case { it instanceof MalSymbol && it.value == "do" }: + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null + ast = ast[-1] + break // TCO + case { it instanceof MalSymbol && it.value == "if" }: + def cond = EVAL(ast[1], env) + if (cond == false || cond == null) { + if (ast.size > 3) { + ast = ast[3] + break // TCO + } else { + return null + } + } else { + ast = ast[2] + break // TCO + } + case { it instanceof MalSymbol && it.value == "fn*" }: + return new MalFunc(EVAL, ast[2], env, ast[1]) + default: + def el = ast.collect { EVAL(it, env) } + def (f, args) = [el[0], el.size() > 1 ? el[1..-1] : []] + if (f instanceof MalFunc) { + env = new Env(f.env, f.params, args) + ast = f.ast + break // TCO + } else { + return f(args) + } + } + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +// core.EXT: defined using Groovy +core.ns.each { k,v -> + repl_env.set(new MalSymbol(k), v) +} + +// core.mal: defined using mal itself +REP("(def! not (fn* (a) (if a false true)))") + + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(StackOverflowError ex) { + println "Error: ${ex}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step6_file.groovy b/impls/groovy/step6_file.groovy new file mode 100644 index 0000000000..a0536a80fa --- /dev/null +++ b/impls/groovy/step6_file.groovy @@ -0,0 +1,129 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import env.Env +import core + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +EVAL = { ast, env -> + while (true) { + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + env = let_env + ast = ast[2] + break // TCO + case { it instanceof MalSymbol && it.value == "do" }: + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null + ast = ast[-1] + break // TCO + case { it instanceof MalSymbol && it.value == "if" }: + def cond = EVAL(ast[1], env) + if (cond == false || cond == null) { + if (ast.size > 3) { + ast = ast[3] + break // TCO + } else { + return null + } + } else { + ast = ast[2] + break // TCO + } + case { it instanceof MalSymbol && it.value == "fn*" }: + return new MalFunc(EVAL, ast[2], env, ast[1]) + default: + def el = ast.collect { EVAL(it, env) } + def (f, args) = [el[0], el.drop(1)] + if (f instanceof MalFunc) { + env = new Env(f.env, f.params, args) + ast = f.ast + break // TCO + } else { + return f(args) + } + } + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +// core.EXT: defined using Groovy +core.ns.each { k,v -> + repl_env.set(new MalSymbol(k), v) +} +repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) +repl_env.set(new MalSymbol("*ARGV*"), this.args as List) + +// core.mal: defined using mal itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if (this.args.size() > 0) { + repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) + REP("(load-file \"${this.args[0]}\")") + System.exit(0) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(StackOverflowError ex) { + println "Error: ${ex}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step7_quote.groovy b/impls/groovy/step7_quote.groovy new file mode 100644 index 0000000000..8e028d5911 --- /dev/null +++ b/impls/groovy/step7_quote.groovy @@ -0,0 +1,167 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import env.Env +import core + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] + } else { + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast + } +} + +EVAL = { ast, env -> + while (true) { + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + env = let_env + ast = ast[2] + break // TCO + case { it instanceof MalSymbol && it.value == "quote" }: + return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquote" }: + ast = quasiquote(ast[1]) + break // TCO + case { it instanceof MalSymbol && it.value == "do" }: + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null + ast = ast[-1] + break // TCO + case { it instanceof MalSymbol && it.value == "if" }: + def cond = EVAL(ast[1], env) + if (cond == false || cond == null) { + if (ast.size > 3) { + ast = ast[3] + break // TCO + } else { + return null + } + } else { + ast = ast[2] + break // TCO + } + case { it instanceof MalSymbol && it.value == "fn*" }: + return new MalFunc(EVAL, ast[2], env, ast[1]) + default: + def el = ast.collect { EVAL(it, env) } + def (f, args) = [el[0], el.drop(1)] + if (f instanceof MalFunc) { + env = new Env(f.env, f.params, args) + ast = f.ast + break // TCO + } else { + return f(args) + } + } + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +// core.EXT: defined using Groovy +core.ns.each { k,v -> + repl_env.set(new MalSymbol(k), v) +} +repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) +repl_env.set(new MalSymbol("*ARGV*"), this.args as List) + +// core.mal: defined using mal itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if (this.args.size() > 0) { + repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) + REP("(load-file \"${this.args[0]}\")") + System.exit(0) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(StackOverflowError ex) { + println "Error: ${ex}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step8_macros.groovy b/impls/groovy/step8_macros.groovy new file mode 100644 index 0000000000..082d592b76 --- /dev/null +++ b/impls/groovy/step8_macros.groovy @@ -0,0 +1,179 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import env.Env +import core + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] + } else { + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast + } +} + +EVAL = { ast, env -> + while (true) { + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + env = let_env + ast = ast[2] + break // TCO + case { it instanceof MalSymbol && it.value == "quote" }: + return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquote" }: + ast = quasiquote(ast[1]) + break // TCO + case { it instanceof MalSymbol && it.value == "defmacro!" }: + def f = EVAL(ast[2], env) + f = f.clone() + f.ismacro = true + return env.set(ast[1], f) + case { it instanceof MalSymbol && it.value == "do" }: + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null + ast = ast[-1] + break // TCO + case { it instanceof MalSymbol && it.value == "if" }: + def cond = EVAL(ast[1], env) + if (cond == false || cond == null) { + if (ast.size > 3) { + ast = ast[3] + break // TCO + } else { + return null + } + } else { + ast = ast[2] + break // TCO + } + case { it instanceof MalSymbol && it.value == "fn*" }: + return new MalFunc(EVAL, ast[2], env, ast[1]) + default: + def f = EVAL(ast[0], env) + def args = ast.drop(1) + if (f instanceof MalFunc && f.ismacro) { + ast = f(args) + break // TCO + } + args = args.collect { EVAL(it, env) } + if (f instanceof MalFunc) { + env = new Env(f.env, f.params, args) + ast = f.ast + break // TCO + } else { + return f(args) + } + } + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +// core.EXT: defined using Groovy +core.ns.each { k,v -> + repl_env.set(new MalSymbol(k), v) +} +repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) +repl_env.set(new MalSymbol("*ARGV*"), this.args as List) + +// core.mal: defined using mal itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + +if (this.args.size() > 0) { + repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) + REP("(load-file \"${this.args[0]}\")") + System.exit(0) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(StackOverflowError ex) { + println "Error: ${ex}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/step9_try.groovy b/impls/groovy/step9_try.groovy new file mode 100644 index 0000000000..5a35b96d3a --- /dev/null +++ b/impls/groovy/step9_try.groovy @@ -0,0 +1,197 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import env.Env +import core + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] + } else { + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast + } +} + +EVAL = { ast, env -> + while (true) { + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + env = let_env + ast = ast[2] + break // TCO + case { it instanceof MalSymbol && it.value == "quote" }: + return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquote" }: + ast = quasiquote(ast[1]) + break // TCO + case { it instanceof MalSymbol && it.value == "defmacro!" }: + def f = EVAL(ast[2], env) + f = f.clone() + f.ismacro = true + return env.set(ast[1], f) + case { it instanceof MalSymbol && it.value == "try*" }: + try { + return EVAL(ast[1], env) + } catch(exc) { + if (ast.size() > 2 && + ast[2][0] instanceof MalSymbol && + ast[2][0].value == "catch*") { + def e = null + if (exc instanceof MalException) { + e = exc.obj + } else { + e = exc.message + } + return EVAL(ast[2][2], new Env(env, [ast[2][1]], [e])) + } else { + throw exc + } + } + case { it instanceof MalSymbol && it.value == "do" }: + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null + ast = ast[-1] + break // TCO + case { it instanceof MalSymbol && it.value == "if" }: + def cond = EVAL(ast[1], env) + if (cond == false || cond == null) { + if (ast.size > 3) { + ast = ast[3] + break // TCO + } else { + return null + } + } else { + ast = ast[2] + break // TCO + } + case { it instanceof MalSymbol && it.value == "fn*" }: + return new MalFunc(EVAL, ast[2], env, ast[1]) + default: + def f = EVAL(ast[0], env) + def args = ast.drop(1) + if (f instanceof MalFunc && f.ismacro) { + ast = f(args) + break // TCO + } + args = args.collect { EVAL(it, env) } + if (f instanceof MalFunc) { + env = new Env(f.env, f.params, args) + ast = f.ast + break // TCO + } else { + return f(args) + } + } + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +// core.EXT: defined using Groovy +core.ns.each { k,v -> + repl_env.set(new MalSymbol(k), v) +} +repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) +repl_env.set(new MalSymbol("*ARGV*"), this.args as List) + +// core.mal: defined using mal itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + +if (this.args.size() > 0) { + repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) + REP("(load-file \"${this.args[0]}\")") + System.exit(0) +} + +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(StackOverflowError ex) { + println "Error: ${ex}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/stepA_mal.groovy b/impls/groovy/stepA_mal.groovy new file mode 100644 index 0000000000..e32fcb8804 --- /dev/null +++ b/impls/groovy/stepA_mal.groovy @@ -0,0 +1,198 @@ +import reader +import printer +import types +import types.MalException +import types.MalSymbol +import types.MalFunc +import env.Env +import core + +// READ +READ = { str -> + reader.read_str str +} + +// EVAL +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] + } else { + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast + } +} + +EVAL = { ast, env -> + while (true) { + def dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv != null) { + def dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != false) { + println("EVAL: ${printer.pr_str(ast,true)}") + } + } + + switch (ast) { + case MalSymbol: return env.get(ast.value); + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it, env) }) + } + break; + case Map: def new_hm = [:] + ast.each { k,v -> + new_hm[k] = EVAL(v, env) + } + return new_hm + default: return ast + } + + if (ast.size() == 0) return ast + + switch (ast[0]) { + case { it instanceof MalSymbol && it.value == "def!" }: + return env.set(ast[1], EVAL(ast[2], env)) + case { it instanceof MalSymbol && it.value == "let*" }: + def let_env = new Env(env) + for (int i=0; i < ast[1].size(); i += 2) { + let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) + } + env = let_env + ast = ast[2] + break // TCO + case { it instanceof MalSymbol && it.value == "quote" }: + return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquote" }: + ast = quasiquote(ast[1]) + break // TCO + case { it instanceof MalSymbol && it.value == "defmacro!" }: + def f = EVAL(ast[2], env) + f = f.clone() + f.ismacro = true + return env.set(ast[1], f) + case { it instanceof MalSymbol && it.value == "try*" }: + try { + return EVAL(ast[1], env) + } catch(exc) { + if (ast.size() > 2 && + ast[2][0] instanceof MalSymbol && + ast[2][0].value == "catch*") { + def e = null + if (exc instanceof MalException) { + e = exc.obj + } else { + e = exc.message + } + return EVAL(ast[2][2], new Env(env, [ast[2][1]], [e])) + } else { + throw exc + } + } + case { it instanceof MalSymbol && it.value == "do" }: + ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null + ast = ast[-1] + break // TCO + case { it instanceof MalSymbol && it.value == "if" }: + def cond = EVAL(ast[1], env) + if (cond == false || cond == null) { + if (ast.size > 3) { + ast = ast[3] + break // TCO + } else { + return null + } + } else { + ast = ast[2] + break // TCO + } + case { it instanceof MalSymbol && it.value == "fn*" }: + return new MalFunc(EVAL, ast[2], env, ast[1]) + default: + def f = EVAL(ast[0], env) + def args = ast.drop(1) + if (f instanceof MalFunc && f.ismacro) { + ast = f(args) + break // TCO + } + args = args.collect { EVAL(it, env) } + if (f instanceof MalFunc) { + env = new Env(f.env, f.params, args) + ast = f.ast + break // TCO + } else { + return f(args) + } + } + } +} + +// PRINT +PRINT = { exp -> + printer.pr_str exp, true +} + +// REPL +repl_env = new Env(); +REP = { str -> + PRINT(EVAL(READ(str), repl_env)) +} + +// core.EXT: defined using Groovy +core.ns.each { k,v -> + repl_env.set(new MalSymbol(k), v) +} +repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) +repl_env.set(new MalSymbol("*ARGV*"), this.args as List) + +// core.mal: defined using mal itself +REP("(def! *host-language* \"groovy\")") +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +if (this.args.size() > 0) { + repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) + REP("(load-file \"${this.args[0]}\")") + System.exit(0) +} + +REP("(println (str \"Mal [\" *host-language* \"]\"))") +while (true) { + line = System.console().readLine 'user> ' + if (line == null) { + break; + } + try { + println REP(line) + } catch(MalException ex) { + println "Error: ${printer.pr_str(ex.obj, true)}" + } catch(StackOverflowError ex) { + println "Error: ${ex}" + } catch(ex) { + println "Error: $ex" + ex.printStackTrace() + } +} diff --git a/impls/groovy/tests/step5_tco.mal b/impls/groovy/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/groovy/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/groovy/types.groovy b/impls/groovy/types.groovy new file mode 100644 index 0000000000..3222406a3f --- /dev/null +++ b/impls/groovy/types.groovy @@ -0,0 +1,121 @@ +import groovy.transform.InheritConstructors +import groovy.transform.AutoClone + +class types { + def static copy(obj) { + def new_obj = obj + if (obj instanceof Collection || obj instanceof Map) { + new_obj = obj.clone() + if (obj.hasProperty("meta")) { + new_obj.getMetaClass().meta = obj.getProperties().meta + } + if (obj.hasProperty("isvector")) { + new_obj.getMetaClass().isvector = obj.getProperties().isvector + } + } else if (obj instanceof Object) { + new_obj = obj.clone() + } + return new_obj + } + + @InheritConstructors + static class MalException extends Exception { + def obj + MalException(String message) { + super(message) + obj = message + } + MalException(_obj) { + super("mal exception containing object") + obj = _obj + } + } + + def static string_Q(o) { + return o instanceof String && (o.size() == 0 || o[0] != "\u029e") + } + + @AutoClone + static class MalSymbol implements Comparable { + String value + MalSymbol(String name) { + value = name + } + int compareTo(o) { value <=> o.value } + } + + def static keyword(o) { + types.&keyword_Q(o) ? o : ("\u029e" + o) + } + def static keyword_Q(o) { + return o instanceof String && o.size() > 0 && o[0] == "\u029e" + } + + def static list_Q(o) { + //return (o instanceof List || o instanceof Object[]) && + return o instanceof List && !o.hasProperty("isvector") + } + + def static vector(o) { + def v = o.collect() + v.metaClass.isvector = true + v + } + def static vector_Q(o) { + return o instanceof List && o.hasProperty("isvector") && o.isvector + } + + def static hash_map(lst) { + def m = [:] + assoc_BANG(m, lst) + } + def static assoc_BANG(m, kvs) { + for (int i=0; i + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Guile +RUN apt-get -y install guile-3.0 libpcre3-dev diff --git a/impls/guile/Makefile b/impls/guile/Makefile new file mode 100644 index 0000000000..993bd8cdd8 --- /dev/null +++ b/impls/guile/Makefile @@ -0,0 +1,17 @@ +SOURCES_BASE = readline.scm types.scm reader.scm printer.scm +SOURCES_LISP = env.scm core.scm stepA_mal.scm +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.scm + +mal.scm: $(SOURCES) + echo "#! /usr/bin/env guile" > $@ + echo "!#" >> $@ + cat $+ | sed $(foreach f,$(+),-e 's/(readline)//') >> $@ + chmod +x $@ + +clean: + rm -f mal.scm diff --git a/impls/guile/core.scm b/impls/guile/core.scm new file mode 100644 index 0000000000..4d86cc6de0 --- /dev/null +++ b/impls/guile/core.scm @@ -0,0 +1,270 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(library (core) + (export core.ns ->list) + (import (guile) (rnrs) (types) (reader) (printer) (ice-9 match) (readline))) + +(define (->list o) ((if (vector? o) vector->list identity) o)) + +(define (vec lst) (if (vector? lst) lst (list->vector lst))) + +(define (_count obj) + (cond + ((_nil? obj) 0) + ((vector? obj) (vector-length obj)) + (else (length obj)))) + +(define (_empty? obj) (zero? (_count obj))) + +;; Well, strange spec... +(define (_equal? o1 o2) + (define (equal-lists? lst1 lst2) + (and (= (length lst1) (length lst2)) + (for-all _equal? lst1 lst2))) + (define (equal-hash-tables? ht1 ht2) + (define (equal-values? k) + (_equal? (_get ht1 k) (_get ht2 k))) + (let ((keys1 (_keys ht1))) + (and (= (length keys1) (length (_keys ht2))) + (for-all equal-values? keys1)))) + (cond + ((and (_sequential? o1) (_sequential? o2)) + (equal-lists? (->list o1) (->list o2))) + ((and (hash-table? o1) (hash-table? o2)) + (equal-hash-tables? o1 o2)) + (else + (equal? o1 o2)))) + +(define (pr-str . args) + (define (pr x) (pr_str x #t)) + (string-join (map pr args) " ")) + +(define (str . args) + (define (pr x) (pr_str x #f)) + (string-join (map pr args) "")) + +(define (prn . args) + (format #t "~a~%" (apply pr-str args)) + nil) + +(define (println . args) + (define (pr x) (pr_str x #f)) + (format #t "~{~a~^ ~}~%" (map pr args)) + nil) + +(define (slurp filename) + (when (not (file-exists? filename)) + (throw 'mal-error (format #f "File/dir '~a' doesn't exist" filename))) + (call-with-input-file filename get-string-all)) + +(define (_cons x y) + (cons x (->list y))) + +(define (concat . args) + (apply append (map ->list args))) + +(define (_nth lst n) + (define ll (->list lst)) + (when (>= n (length ll)) + (throw 'mal-error "nth: index out of range")) + (list-ref ll n)) + +(define (_first lst) + (define ll (->list lst)) + (cond + ((_nil? lst) nil) + ((null? ll) nil) + (else (car ll)))) + +(define (_rest lst) + (define ll (->list lst)) + (cond + ((_nil? lst) '()) + ((null? ll) '()) + (else (cdr ll)))) + +(define (_map f lst) (map (callable-closure f) (->list lst))) + +(define (_apply f . args) + (define ll + (let lp((next args) (ret '())) + (cond + ((null? next) (reverse ret)) + (else + (let ((n (->list (car next)))) + (lp (cdr next) (if (list? n) + (append (reverse n) ret) + (cons n ret)))))))) + (callable-apply f ll)) + +(define (->symbol x) + ((if (symbol? x) identity string->symbol) x)) + +(define (->keyword x) + ((if (_keyword? x) identity string->keyword) x)) + +(define (_hash-map . lst) (list->hash-map lst)) + +(define (_assoc ht . lst) (list->hash-map lst (hash-table-clone ht))) + +(define (_get ht k) + (if (_nil? ht) + nil + (hash-ref ht k nil))) + +(define (_dissoc ht . lst) + (define ht2 (hash-table-clone ht)) + (for-each (lambda (k) (hash-remove! ht2 k)) lst) + ht2) + +(define (_keys ht) (hash-map->list (lambda (k v) k) ht)) + +(define (_vals ht) (hash-map->list (lambda (k v) v) ht)) + +(define (_contains? ht k) + (let ((v (hash-ref ht k '*mal-null*))) + (if (eq? v '*mal-null*) + #f + #t))) + +(define (_sequential? o) (or (list? o) (vector? o))) + +(define (_meta c) + (if (callable? c) + (callable-meta-info c) + (or (object-property c 'meta) nil))) + +(define (_with-meta c ht) + (cond + ((callable? c) + (let ((cc (make-callable ht + (callable-unbox c) + #f + (callable-closure c)))) + cc)) + (else + (let ((cc (box c))) + (set-object-property! cc 'meta ht) + cc)))) + +;; Apply closure 'c' with atom-val as one of arguments, then +;; set the result as the new val of atom. +(define (_swap! atom c . rest) + (let* ((args (cons (atom-val atom) rest)) + (val (callable-apply c args))) + (atom-val-set! atom val) + val)) + +(define (_conj lst . args) + (cond + ((vector? lst) + (list->vector (append (->list lst) args))) + ((list? lst) + (append (reverse args) (->list lst))) + (else (throw 'mal-error (format #f "conj: '~a' is not list/vector" lst))))) + +(define (_seq obj) + (cond + ((_nil? obj) nil) + ((_string? obj) + (if (string-null? obj) nil (map string (string->list obj)))) + ((_empty? obj) nil) + (else (->list obj)))) + +(define (__readline prompt) + (let ((str (_readline prompt))) + (if (eof-object? str) + #f + str))) + +(define (_true? x) (eq? x #t)) +(define (_false? x) (eq? x #f)) + +;; We need regular named procedure for better debug +(define (_atom x) (make-atom x)) +(define (_atom? x) (atom? x)) +(define (_deref x) (atom-val x)) +(define (_reset! x v) (atom-val-set! x v)) + +(define (time-ms) + (let ((t (gettimeofday))) + (round + (+ (* (car t) 1000.0) (/ (cdr t) 1000.0) 0.5)))) + +(define *primitives* + `((list ,list) + (list? ,list?) + (empty? ,_empty?) + (count ,_count) + (= ,_equal?) + (< ,<) + (<= ,<=) + (> ,>) + (>= ,>=) + (+ ,+) + (- ,-) + (* ,*) + (/ ,/) + (pr-str ,pr-str) + (str ,str) + (prn ,prn) + (println ,println) + (read-string ,read_str) + (slurp ,slurp) + (cons ,_cons) + (concat ,concat) + (vec ,vec) + (nth ,_nth) + (first ,_first) + (rest ,_rest) + (map ,_map) + (apply ,_apply) + (nil? ,_nil?) + (true? ,_true?) + (false? ,_false?) + (number? ,number?) + (symbol? ,symbol?) + (symbol ,->symbol) + (string? ,_string?) + (keyword ,->keyword) + (keyword? ,_keyword?) + (vector? ,vector?) + (vector ,vector) + (hash-map ,_hash-map) + (map? ,hash-table?) + (assoc ,_assoc) + (get ,_get) + (dissoc ,_dissoc) + (keys ,_keys) + (vals ,_vals) + (contains? ,_contains?) + (sequential? ,_sequential?) + (fn? ,is-func?) + (macro? ,is-macro?) + (readline ,__readline) + (meta ,_meta) + (with-meta ,_with-meta) + (atom ,_atom) + (atom? ,_atom?) + (deref ,_deref) + (reset! ,_reset!) + (swap! ,_swap!) + (conj ,_conj) + (seq ,_seq) + (time-ms ,time-ms))) + +;; Well, we have to rename it to this strange name... +(define core.ns *primitives*) diff --git a/impls/guile/env.scm b/impls/guile/env.scm new file mode 100644 index 0000000000..c15ea474aa --- /dev/null +++ b/impls/guile/env.scm @@ -0,0 +1,64 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(library (env) + (export make-Env env-has env-check) + (import (guile) (types))) + +(define (env-check sym env) + (env-has sym env (lambda _ #f))) + +(define (sym-err-throw sym) + (throw 'mal-error (format #f "'~a' not found" sym))) + +(define* (env-has sym env #:optional (err sym-err-throw)) + (let ((v ((env 'get) sym))) + (if (equal? v '*mal-null*) + (err sym) + v))) + +(define* (make-Env #:key (outer nil) (binds '()) (exprs '())) + (define _env (make-hash-table)) + (define (_set k v) (hash-set! _env k v)) + (define (_get k) + (let ((v (hash-ref _env k '*mal-null*))) + (if (equal? v '*mal-null*) + (if (_nil? outer) + '*mal-null* + ((outer 'get) k)) + v))) + (define (_find k) (_get k)) + (define (_show) + (hash-for-each (lambda (k v) (format #t "~a : ~a~%" k v)) _env) + (display "outer:\n") + (and (not (_nil? outer)) ((outer 'show)))) + (let lp((b binds) (e exprs)) + (cond + ((null? b) #t) + ((eq? (car b) '&) (hash-set! _env (cadr b) e)) ; handle varglist + (else ; normal binding + (when (not (symbol? (car b))) + (throw 'mal-error (format #f "Invalid binding key! '~a'" (car b)))) + (when (null? e) + (throw 'mal-error "Invalid pattern for this macro")) + (hash-set! _env (car b) (car e)) + (lp (cdr b) (cdr e))))) + (lambda (cmd) + (case cmd + ((set) _set) + ((find) _find) + ((get) _get) + ((show) _show) + (else (throw 'mal-error (format #f "BUG: Invalid cmd '~a'" cmd)))))) diff --git a/impls/guile/pcre.scm b/impls/guile/pcre.scm new file mode 100644 index 0000000000..26de8199c9 --- /dev/null +++ b/impls/guile/pcre.scm @@ -0,0 +1,136 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(library (pcre) + (export new-pcre + pcre-match + pcre-get-substring + pcre-search) + (import (guile) (rnrs) (system foreign))) + +(define (make-blob-pointer len) + (bytevector->pointer (make-bytevector len))) + +(define pcre-ffi (dynamic-link "libpcre")) + +(define %pcre-compile2 + (pointer->procedure '* + (dynamic-func "pcre_compile2" pcre-ffi) + (list '* int '* '* '* '*))) + +(define %pcre-compile + (pointer->procedure '* + (dynamic-func "pcre_compile" pcre-ffi) + (list '* int '* '* '*))) + +(define %pcre-exec + (pointer->procedure int + (dynamic-func "pcre_exec" pcre-ffi) + (list '* '* '* int int int '* int))) + +(define %pcre-study + (pointer->procedure '* + (dynamic-func "pcre_study" pcre-ffi) + (list '* int '*))) + +(define %pcre-get-substring + (pointer->procedure '* + (dynamic-func "pcre_get_substring" pcre-ffi) + (list '* '* int int '*))) + +(define %pcre-free + (pointer->procedure void + (dynamic-func "pcre_free" pcre-ffi) + (list '*))) + +(define %pcre-free-study (dynamic-func "pcre_free_study" pcre-ffi)) + +(define %pcre-free-substring (dynamic-func "pcre_free_substring" pcre-ffi)) + +(define-record-type pcre + (fields + errptr + (mutable strptr) + (mutable ovector) + (mutable matched) + (mutable code) + (mutable extra))) + +(define (%new-pcre) + (make-pcre (make-blob-pointer (sizeof ptrdiff_t)) ; errptr + #f #f 0 #f #f)) + +(define* (new-pcre re #:optional (options 0)) + (let ((reptr (string->pointer re)) + ;;(errcodeptr (make-blob-pointer int)) + (erroffset (make-blob-pointer int)) + (tableptr %null-pointer) + (pcre (%new-pcre))) + ;; FIXME: add exception handling + (pcre-code-set! pcre (%pcre-compile reptr options (pcre-errptr pcre) + erroffset tableptr)) + ;;(set-pointer-finalizer! (pcre-code pcre) %pcre-free) + pcre)) + +(define* (pcre-match pcre str #:key (study-options 0) (exec-options 0) + (ovecsize 30) (offset 0)) + (let ((extra (%pcre-study (pcre-code pcre) study-options (pcre-errptr pcre))) + (strptr (string->pointer str)) + (ovector (make-blob-pointer (* int ovecsize)))) + (pcre-matched-set! pcre + (%pcre-exec (pcre-code pcre) + extra + strptr + (string-length str) + offset + exec-options + ovector + ovecsize)) + (pcre-ovector-set! pcre ovector) + (pcre-strptr-set! pcre strptr) + (set-pointer-finalizer! extra %pcre-free-study) + pcre)) + +(define (pcre-get-substring pcre index) + (let ((strptr (pcre-strptr pcre)) + (ovector (pcre-ovector pcre)) + (matched (pcre-matched pcre)) + (buf (make-blob-pointer (sizeof ptrdiff_t)))) + (%pcre-get-substring strptr ovector matched index buf) + (let ((ret (pointer->string (dereference-pointer buf)))) + (set-pointer-finalizer! (dereference-pointer buf) %pcre-free-substring) + ret))) + +(define* (pcre-search pcre str #:key (study-options 0) (exec-options 0) + (exclude " ")) + (define (trim s) + (string-trim-both s (lambda (x) (string-contains exclude (string x))))) + (define len (string-length str)) + (let lp((i 0) (ret '())) + (cond + ((>= i len) (reverse ret)) + (else + (pcre-match pcre str #:study-options study-options #:exec-options exec-options #:offset i) + (if (<= (pcre-matched pcre) 0) + (lp len ret) + (let ((hit (trim (pcre-get-substring pcre 1))) + (sublen (string-length (pcre-get-substring pcre 0)))) + (if (zero? sublen) + (lp len ret) + (lp (+ i sublen) (cons hit ret))))))))) + +(define (pcre-free pcre) + (and (not (null-pointer? (pcre-code pcre))) + (%pcre-free (pcre-code pcre)))) diff --git a/impls/guile/printer.scm b/impls/guile/printer.scm new file mode 100644 index 0000000000..c3400cf30d --- /dev/null +++ b/impls/guile/printer.scm @@ -0,0 +1,60 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(library (printer) + (export pr_str) + (import (guile) (types) (ice-9 match) (ice-9 regex))) + +(define (print-hashmap hm p) + (call-with-output-string + (lambda (port) + (display "{" port) + (display + (string-join + (hash-map->list + (lambda (k v) + (format #f "~a ~a" (p k) (p v))) + hm) + " ") + port) + (display "}" port)))) + +(define (pr_str obj readable?) + (define (->str s) + (string-sub + (string-sub + (string-sub s "\\\\" "\\\\") + "\"" "\\\"") + "\n" "\\n")) + (define (%pr_str o) (pr_str o readable?)) + (match obj + ((? box?) (%pr_str (unbox obj))) + ((? is-func?) "#") + ((? is-macro?) "#") + ((? list?) (format #f "(~{~a~^ ~})" (map %pr_str obj))) + ((? vector?) (format #f "[~{~a~^ ~}]" (map %pr_str (vector->list obj)))) + ((? hash-table?) (print-hashmap obj %pr_str)) + ((? string?) + (cond + ((_keyword? obj) + => (lambda (m) (format #f ":~a" (substring obj 1)))) + (else (if readable? (format #f "\"~a\"" (->str obj)) obj)))) + ;;((? number?) (format #f "~a" obj)) + ;;((? symbol?) (format #f "~a" obj)) + ((? atom?) (format #f "(atom ~a)" (%pr_str (atom-val obj)))) + ((? _nil?) "nil") + (#t "true") + (#f "false") + (else (format #f "~a" obj)))) diff --git a/impls/guile/reader.scm b/impls/guile/reader.scm new file mode 100644 index 0000000000..0769e09a34 --- /dev/null +++ b/impls/guile/reader.scm @@ -0,0 +1,134 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(library (reader) + (export read_str) + (import (guile) (pcre) (ice-9 match) (srfi srfi-1) + (ice-9 regex) (types) (ice-9 format))) + +(define (make-Reader tokens) + (lambda (cmd) + (case cmd + ((next) + (if (null? tokens) + '() + (let ((r (car tokens))) (set! tokens (cdr tokens)) r))) + ((peek) (if (null? tokens) '() (car tokens))) + (else (error "Reader: Invalid cmd!" cmd))))) + +(define *token-re* + (new-pcre "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)")) + +(define *str-re* + (new-pcre "^(\"(?:\\\\.|[^\\\\\"])*\")$")) + +(define (tokenizer str) + (filter (lambda (s) (and (not (string-null? s)) (not (string=? (substring s 0 1) ";")))) + (pcre-search *token-re* str))) + +(define (delim-read reader delim) + (let lp((next (reader 'peek)) (ret '())) + (cond + ((null? next) (throw 'mal-error (format #f "expected '~a', got EOF" delim))) + ((string=? next delim) (reader 'next) (reverse ret)) + (else + (let* ((cur (read_form reader)) + (n (reader 'peek))) + (lp n (cons cur ret))))))) + +(define (read_list reader) + (cond + ((string=? ")" (reader 'peek)) + (reader 'next) + '()) + (else (delim-read reader ")")))) + +(define (read_vector reader) + (cond + ((string=? "]" (reader 'peek)) + (reader 'next) + #()) + (else (list->vector (delim-read reader "]"))))) + +(define (read_hashmap reader) + (define ht (make-hash-table)) + (define lst (delim-read reader "}")) + (cond + ((null? lst) ht) + (else + (let lp((next lst)) + (cond + ((null? next) ht) + (else + (when (null? (cdr next)) + (throw 'mal-error + (format #f "read_hashmap: '~a' lack of value" (car next)))) + (let ((k (car next)) + (v (cadr next))) + (hash-set! ht k v) + (lp (cddr next))))))))) + +(define (read_atom reader) + (let ((token (reader 'next))) + (cond + ((string-match "^-?[0-9][0-9.]*$" token) + => (lambda (m) (string->number (match:substring m 0)))) + ((> (length (pcre-search *str-re* token)) 0) + (with-input-from-string token read)) + ((eqv? (string-ref token 0) #\") + (throw 'mal-error "expected '\"', got EOF")) + ((string-match "^:(.*)" token) + => (lambda (m) (string->keyword (match:substring m 1)))) + ((string=? "nil" token) nil) + ((string=? "true" token) #t) + ((string=? "false" token) #f) + (else (string->symbol token))))) + +(define (read_form reader) + (define (clean x) + (if (string? x) + (string-trim-both + x + (lambda (c) (char-set-contains? char-set:whitespace c))) + x)) + (define (next) (reader 'next)) + (define (more) (read_form reader)) + (match (clean (reader 'peek)) + (() (throw 'mal-error "blank line")) ; FIXME: what should be returned? + ("'" (next) (list 'quote (more))) + ("`" (next) (list 'quasiquote (more))) + ("~" (next) (list 'unquote (more))) + ("~@" (next) (list 'splice-unquote (more))) + ("^" (next) (let ((meta (more))) `(with-meta ,(more) ,meta))) + ("@" (next) `(deref ,(more))) + (")" (next) (throw 'mal-error "unexpected ')'")) + ("(" (next) (read_list reader)) + ("]" (throw 'mal-error "unexpected ']'")) + ("[" (next) (read_vector reader)) + ("}" (throw 'mal-error "unexpected '}'")) + ("{" (next) (read_hashmap reader)) + ("" (next) (read_form reader)) + (else (read_atom reader)))) + +(define (read_str str) + (if (eof-object? str) + str + (let* ((tokens (tokenizer str)) + (t (if (null? tokens) + (if (char=? (string-ref str 0) #\;) + '() + (list str)) + tokens))) + (read_form (make-Reader t))))) diff --git a/impls/guile/readline.scm b/impls/guile/readline.scm new file mode 100644 index 0000000000..51196b6c77 --- /dev/null +++ b/impls/guile/readline.scm @@ -0,0 +1,32 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;(use-modules (ice-9 readline)) + +(library (readline) + (export _readline) + (import (guile) (ice-9 readline))) + +(define mal-history + (format #f "~a/.mal-history" (getenv "HOME"))) + +(setenv "GUILE_HISTORY" mal-history) +(readline-set! bounce-parens 0) +(activate-readline) + +(define (_readline prompt) + (let ((str (readline prompt))) + (and (not (eof-object? str)) (add-history str)) + str)) diff --git a/impls/guile/run b/impls/guile/run new file mode 100755 index 0000000000..6d9e58d123 --- /dev/null +++ b/impls/guile/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +# XDG_CACHE_HOME is where guile stores the compiled files +XDG_CACHE_HOME=.cache/ exec guile -L $(dirname $0) $(dirname $0)/${STEP:-stepA_mal}.scm "${@}" diff --git a/impls/guile/step0_repl.scm b/impls/guile/step0_repl.scm new file mode 100644 index 0000000000..9680c773a0 --- /dev/null +++ b/impls/guile/step0_repl.scm @@ -0,0 +1,38 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline)) + +(define (READ str) + str) + +(define (EVAL ast env) ast) + +(define (PRINT str) + (format #t "~a~%" str)) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (PRINT (EVAL (READ line) '()))))))) + +(REPL) diff --git a/impls/guile/step1_read_print.scm b/impls/guile/step1_read_print.scm new file mode 100644 index 0000000000..cfb9a2ad06 --- /dev/null +++ b/impls/guile/step1_read_print.scm @@ -0,0 +1,42 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer)) + +(define (READ str) + (read_str str)) + +(define (EVAL ast env) ast) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) '()))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +(REPL) diff --git a/impls/guile/step2_eval.scm b/impls/guile/step2_eval.scm new file mode 100644 index 0000000000..c51ce77e82 --- /dev/null +++ b/impls/guile/step2_eval.scm @@ -0,0 +1,63 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (types)) + +(define *toplevel* + `((+ . ,+) + (- . ,-) + (* . ,*) + (/ . ,/))) + +(define (READ str) + (read_str str)) + +(define (EVAL ast env) + ; (format #t "EVAL: ~a~%" (pr_str ast #t)) + (match ast + ((? symbol? sym) + (or (assoc-ref env sym) + (throw 'mal-error (format #f "'~a' not found" sym)))) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (else + (let ((el (map (lambda (x) (EVAL x env)) ast))) + (apply (car el) (cdr el)))))) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +(REPL) diff --git a/impls/guile/step3_env.scm b/impls/guile/step3_env.scm new file mode 100644 index 0000000000..80dede1be7 --- /dev/null +++ b/impls/guile/step3_env.scm @@ -0,0 +1,83 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (types)) + +(define *primitives* + `((+ ,+) + (- ,-) + (* ,*) + (/ ,/))) + +(define *toplevel* + (receive (b e) (unzip2 *primitives*) + (make-Env #:binds b #:exprs e))) + +(define (READ str) + (read_str str)) + +(define (EVAL ast env) + (define (->list kvs) ((if (vector? kvs) vector->list identity) kvs)) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (EVAL body new-env))) + (else + (let ((el (map (lambda (x) (EVAL x env)) ast))) + (apply (car el) (cdr el)))))) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +(REPL) diff --git a/impls/guile/step4_if_fn_do.scm b/impls/guile/step4_if_fn_do.scm new file mode 100644 index 0000000000..04ec536f05 --- /dev/null +++ b/impls/guile/step4_if_fn_do.scm @@ -0,0 +1,102 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (core) (types)) + +(define *toplevel* + (receive (b e) (unzip2 core.ns) + (make-Env #:binds b #:exprs e))) + +(define (READ str) + (read_str str)) + +(define (eval_seq ast env) + (cond + ((null? ast) nil) + ((null? (cdr ast)) (EVAL (car ast) env)) + (else + (EVAL (car ast) env) + (eval_seq (cdr ast) env)))) + +(define (EVAL ast env) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (EVAL body new-env))) + (('do rest ...) + (eval_seq rest env)) + (('if cnd thn els ...) + (cond + ((and (not (null? els)) (not (null? (cdr els)))) + ;; Invalid `if' form + (throw 'mal-error + (format #f "if: failed to match any pattern in form '~a'" ast))) + ((cond-true? (EVAL cnd env)) (EVAL thn env)) + (else (if (null? els) nil (EVAL (car els) env))))) + (('fn* params body ...) ; function definition + (lambda args + (eval_seq body (make-Env #:outer env #:binds (->list params) #:exprs args)))) + (else + (let ((el (map (lambda (x) (EVAL x env)) ast))) + (apply (car el) (cdr el)))))) + +(define (EVAL-string str) + (EVAL (read_str str) *toplevel*)) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +(EVAL-string "(def! not (fn* (x) (if x false true)))") + +(REPL) diff --git a/impls/guile/step5_tco.scm b/impls/guile/step5_tco.scm new file mode 100644 index 0000000000..d6b02c84cc --- /dev/null +++ b/impls/guile/step5_tco.scm @@ -0,0 +1,128 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (core) (types)) + +(define *toplevel* + (receive (b e) (unzip2 core.ns) + (make-Env #:binds b #:exprs (map make-func e)))) + +(define (READ str) + (read_str str)) + +(define (eval_seq ast env) + (cond + ((null? ast) nil) + ((null? (cdr ast)) (EVAL (car ast) env)) + (else + (EVAL (car ast) env) + (eval_seq (cdr ast) env)))) + +(define (EVAL ast env) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + ;; NOTE: I wish I can use (while #t ...) for that, but this is not Lispy, which means + ;; it'll bring some trouble in control flow. We have to use continuations to return + ;; and use non-standard `break' feature. In a word, not elegant at all. + ;; The named let loop is natural for Scheme, but it looks a bit cheating. But NO! + ;; Such kind of loop is actually `while loop' in Scheme, I don't take advantage of + ;; TCO in Scheme to implement TCO, but it's the same principle with normal loop. + ;; If you're Lispy enough, there's no recursive at all while you saw named let loop. + (let tco-loop((ast ast) (env env)) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (tco-loop body new-env))) + (('do rest ...) + (cond + ((null? rest) + (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) + ((= 1 (length rest)) (tco-loop (car rest) env)) + (else + (let ((mexpr (take rest (1- (length rest)))) + (tail-call (car (take-right rest 1)))) + (eval_seq mexpr env) + (tco-loop tail-call env))))) + (('if cnd thn els ...) + (cond + ((and (not (null? els)) (not (null? (cdr els)))) + ;; Invalid `if' form + (throw 'mal-error + (format #f "if: failed to match any pattern in form '~a'" ast))) + ((cond-true? (EVAL cnd env)) (tco-loop thn env)) + (else (if (null? els) nil (tco-loop (car els) env))))) + (('fn* params body ...) ; function definition + (make-func + (lambda args + (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) + (cond + ((null? body) + (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) + ((= 1 (length body)) (tco-loop (car body) nenv)) + (else + (let ((mexpr (take body (1- (length body)))) + (tail-call (car (take-right body 1)))) + (eval_seq mexpr nenv) + (tco-loop tail-call nenv)))))))) + (else + (let ((el (map (lambda (x) (EVAL x env)) ast))) + (callable-apply (car el) (cdr el))))))) + +(define (EVAL-string str) + (EVAL (read_str str) *toplevel*)) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +(EVAL-string "(def! not (fn* (x) (if x false true)))") + +(REPL) diff --git a/impls/guile/step6_file.scm b/impls/guile/step6_file.scm new file mode 100644 index 0000000000..65abd952ad --- /dev/null +++ b/impls/guile/step6_file.scm @@ -0,0 +1,137 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (core) (types)) + +(define *toplevel* + (receive (b e) (unzip2 core.ns) + (make-Env #:binds b #:exprs (map make-func e)))) + +(define (READ str) + (read_str str)) + +(define (eval_seq ast env) + (cond + ((null? ast) nil) + ((null? (cdr ast)) (EVAL (car ast) env)) + (else + (EVAL (car ast) env) + (eval_seq (cdr ast) env)))) + +(define (EVAL ast env) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + ;; NOTE: I wish I can use (while #t ...) for that, but this is not Lispy, which means + ;; it'll bring some trouble in control flow. We have to use continuations to return + ;; and use non-standard `break' feature. In a word, not elegant at all. + ;; The named let loop is natural for Scheme, but it looks a bit cheating. But NO! + ;; Such kind of loop is actually `while loop' in Scheme, I don't take advantage of + ;; TCO in Scheme to implement TCO, but it's the same principle with normal loop. + ;; If you're Lispy enough, there's no recursive at all while you saw named let loop. + (let tco-loop((ast ast) (env env)) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (tco-loop body new-env))) + (('do rest ...) + (cond + ((null? rest) + (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) + ((= 1 (length rest)) (tco-loop (car rest) env)) + (else + (let ((mexpr (take rest (1- (length rest)))) + (tail-call (car (take-right rest 1)))) + (eval_seq mexpr env) + (tco-loop tail-call env))))) + (('if cnd thn els ...) + (cond + ((and (not (null? els)) (not (null? (cdr els)))) + ;; Invalid `if' form + (throw 'mal-error + (format #f "if: failed to match any pattern in form '~a'" ast))) + ((cond-true? (EVAL cnd env)) (tco-loop thn env)) + (else (if (null? els) nil (tco-loop (car els) env))))) + (('fn* params body ...) ; function definition + (make-func + (lambda args + (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) + (cond + ((null? body) + (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) + ((= 1 (length body)) (tco-loop (car body) nenv)) + (else + (let ((mexpr (take body (1- (length body)))) + (tail-call (car (take-right body 1)))) + (eval_seq mexpr nenv) + (tco-loop tail-call nenv)))))))) + (else + (let ((el (map (lambda (x) (EVAL x env)) ast))) + (callable-apply (car el) (cdr el))))))) + +(define (EVAL-string str) + (EVAL (read_str str) *toplevel*)) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +;; initialization +((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) +((*toplevel* 'set) '*ARGV* '()) +(EVAL-string "(def! not (fn* (x) (if x false true)))") +(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(let ((args (cdr (command-line)))) + (cond + ((> (length args) 0) + ((*toplevel* 'set) '*ARGV* (cdr args)) + (EVAL-string (string-append "(load-file \"" (car args) "\")"))) + (else (REPL)))) diff --git a/impls/guile/step7_quote.scm b/impls/guile/step7_quote.scm new file mode 100644 index 0000000000..cea87b44f7 --- /dev/null +++ b/impls/guile/step7_quote.scm @@ -0,0 +1,145 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (core) (types)) + +(define *toplevel* + (receive (b e) (unzip2 core.ns) + (make-Env #:binds b #:exprs (map make-func e)))) + +(define (READ str) + (read_str str)) + +(define (eval_seq ast env) + (cond + ((null? ast) nil) + ((null? (cdr ast)) (EVAL (car ast) env)) + (else + (EVAL (car ast) env) + (eval_seq (cdr ast) env)))) + +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + +(define (EVAL ast env) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + (let tco-loop((ast ast) (env env)) + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('quote obj) obj) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (tco-loop body new-env))) + (('do rest ...) + (cond + ((null? rest) + (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) + ((= 1 (length rest)) (tco-loop (car rest) env)) + (else + (let ((mexpr (take rest (1- (length rest)))) + (tail-call (car (take-right rest 1)))) + (eval_seq mexpr env) + (tco-loop tail-call env))))) + (('if cnd thn els ...) + (cond + ((and (not (null? els)) (not (null? (cdr els)))) + ;; Invalid `if' form + (throw 'mal-error + (format #f "if: failed to match any pattern in form '~a'" ast))) + ((cond-true? (EVAL cnd env)) (tco-loop thn env)) + (else (if (null? els) nil (tco-loop (car els) env))))) + (('fn* params body ...) ; function definition + (make-func + (lambda args + (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) + (cond + ((null? body) + (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) + ((= 1 (length body)) (tco-loop (car body) nenv)) + (else + (let ((mexpr (take body (1- (length body)))) + (tail-call (car (take-right body 1)))) + (eval_seq mexpr nenv) + (tco-loop tail-call nenv)))))))) + (else + (let ((el (map (lambda (x) (EVAL x env)) ast))) + (callable-apply (car el) (cdr el))))))) + +(define (EVAL-string str) + (EVAL (read_str str) *toplevel*)) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +;; initialization +((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) +((*toplevel* 'set) '*ARGV* '()) +(EVAL-string "(def! not (fn* (x) (if x false true)))") +(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(let ((args (cdr (command-line)))) + (cond + ((> (length args) 0) + ((*toplevel* 'set) '*ARGV* (cdr args)) + (EVAL-string (string-append "(load-file \"" (car args) "\")"))) + (else (REPL)))) diff --git a/impls/guile/step8_macros.scm b/impls/guile/step8_macros.scm new file mode 100644 index 0000000000..f98c096f7b --- /dev/null +++ b/impls/guile/step8_macros.scm @@ -0,0 +1,152 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (core) (types)) + +(define *toplevel* + (receive (b e) (unzip2 core.ns) + (make-Env #:binds b #:exprs (map make-func e)))) + +(define (READ str) + (read_str str)) + +(define (eval_seq ast env) + (cond + ((null? ast) nil) + ((null? (cdr ast)) (EVAL (car ast) env)) + (else + (EVAL (car ast) env) + (eval_seq (cdr ast) env)))) + +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + +(define (EVAL ast env) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + (let tco-loop((ast ast) (env env)) ; expand as possible + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('defmacro! k v) + (let ((c (EVAL v env))) + ((env 'set) k (callable-as-macro c)))) + (('quote obj) obj) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (tco-loop body new-env))) + (('do rest ...) + (cond + ((null? rest) + (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) + ((= 1 (length rest)) (tco-loop (car rest) env)) + (else + (let ((mexpr (take rest (1- (length rest)))) + (tail-call (car (take-right rest 1)))) + (eval_seq mexpr env) + (tco-loop tail-call env))))) + (('if cnd thn els ...) + (cond + ((and (not (null? els)) (not (null? (cdr els)))) + ;; Invalid `if' form + (throw 'mal-error + (format #f "if: failed to match any pattern in form '~a'" ast))) + ((cond-true? (EVAL cnd env)) (tco-loop thn env)) + (else (if (null? els) nil (tco-loop (car els) env))))) + (('fn* params body ...) ; function definition + (make-anonymous-func + (lambda args + (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) + (cond + ((null? body) + (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) + ((= 1 (length body)) (tco-loop (car body) nenv)) + (else + (let ((mexpr (take body (1- (length body)))) + (tail-call (car (take-right body 1)))) + (eval_seq mexpr nenv) + (tco-loop tail-call nenv)))))))) + (else + (let ((f (EVAL (car ast) env)) + (args (cdr ast))) + (if (is-macro f) + (EVAL (callable-apply f args) env) + (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) + +(define (EVAL-string str) + (EVAL (read_str str) *toplevel*)) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +;; initialization +((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) +((*toplevel* 'set) '*ARGV* '()) +(EVAL-string "(def! not (fn* (x) (if x false true)))") +(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(EVAL-string "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(let ((args (cdr (command-line)))) + (cond + ((> (length args) 0) + ((*toplevel* 'set) '*ARGV* (cdr args)) + (EVAL-string (string-append "(load-file \"" (car args) "\")"))) + (else (REPL)))) diff --git a/impls/guile/step9_try.scm b/impls/guile/step9_try.scm new file mode 100644 index 0000000000..951cbd0d4f --- /dev/null +++ b/impls/guile/step9_try.scm @@ -0,0 +1,171 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (core) (types)) + +;; Primitives which doesn't unbox args in default. +;; This is a trick to implement meta-info taking advange of the original +;; types of Guile as possible. +(define *unbox-exception* '(meta assoc swap!)) + +(define *toplevel* + (receive (b e) (unzip2 core.ns) + (let ((env (make-Env #:binds b #:exprs (map make-func e)))) + (for-each (lambda (f) + (callable-unbox-set! ((env 'get) f) #f)) + *unbox-exception*) + env))) + +(define (READ str) + (read_str str)) + +(define (eval_seq ast env) + (cond + ((null? ast) nil) + ((null? (cdr ast)) (EVAL (car ast) env)) + (else + (EVAL (car ast) env) + (eval_seq (cdr ast) env)))) + +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + +(define (EVAL ast env) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + (let tco-loop((ast ast) (env env)) ; expand as possible + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('defmacro! k v) + (let ((c (EVAL v env))) + ((env 'set) k (callable-as-macro c)))) + (('quote obj) obj) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (tco-loop body new-env))) + (('do rest ...) + (cond + ((null? rest) + (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) + ((= 1 (length rest)) (tco-loop (car rest) env)) + (else + (let ((mexpr (take rest (1- (length rest)))) + (tail-call (car (take-right rest 1)))) + (eval_seq mexpr env) + (tco-loop tail-call env))))) + (('if cnd thn els ...) + (cond + ((and (not (null? els)) (not (null? (cdr els)))) + ;; Invalid `if' form + (throw 'mal-error + (format #f "if: failed to match any pattern in form '~a'" ast))) + ((cond-true? (EVAL cnd env)) (tco-loop thn env)) + (else (if (null? els) nil (tco-loop (car els) env))))) + (('fn* params body ...) ; function definition + (make-anonymous-func + (lambda args + (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) + (cond + ((null? body) + (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) + ((= 1 (length body)) (tco-loop (car body) nenv)) + (else + (let ((mexpr (take body (1- (length body)))) + (tail-call (car (take-right body 1)))) + (eval_seq mexpr nenv) + (tco-loop tail-call nenv)))))))) + (('try* A) + (EVAL A env)) + (('try* A ('catch* B C)) + (catch + #t + (lambda () (EVAL A env)) + (lambda e + (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) + (EVAL C nenv))))) + (else + (let ((f (EVAL (car ast) env)) + (args (cdr ast))) + (if (is-macro f) + (EVAL (callable-apply f args) env) + (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) + +(define (EVAL-string str) + (EVAL (read_str str) *toplevel*)) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +;; initialization +((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) +((*toplevel* 'set) 'throw (make-func (lambda (val) (throw 'mal-error val)))) +((*toplevel* 'set) '*ARGV* '()) +(EVAL-string "(def! not (fn* (x) (if x false true)))") +(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(EVAL-string "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(let ((args (cdr (command-line)))) + (cond + ((> (length args) 0) + ((*toplevel* 'set) '*ARGV* (cdr args)) + (EVAL-string (string-append "(load-file \"" (car args) "\")"))) + (else (REPL)))) diff --git a/impls/guile/stepA_mal.scm b/impls/guile/stepA_mal.scm new file mode 100644 index 0000000000..4372a03a0e --- /dev/null +++ b/impls/guile/stepA_mal.scm @@ -0,0 +1,174 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) + (srfi srfi-1) (ice-9 receive) (env) (core) (types)) + +;; Primitives which doesn't unbox args in default. +;; This is a trick to implement meta-info taking advange of the original +;; types of Guile as possible. +(define *unbox-exception* '(meta assoc swap!)) + +(define *toplevel* + (receive (b e) (unzip2 core.ns) + (let ((env (make-Env #:binds b #:exprs (map make-func e)))) + (for-each (lambda (f) + (callable-unbox-set! ((env 'get) f) #f)) + *unbox-exception*) + env))) + +(define (READ str) + (read_str str)) + +(define (eval_seq ast env) + (cond + ((null? ast) nil) + ((null? (cdr ast)) (EVAL (car ast) env)) + (else + (EVAL (car ast) env) + (eval_seq (cdr ast) env)))) + +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + +(define (EVAL ast env) + (define (%unzip2 kvs) + (let lp((next kvs) (k '()) (v '())) + (cond + ;; NOTE: reverse is very important here! + ((null? next) (values (reverse k) (reverse v))) + ((null? (cdr next)) + (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) + (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) + (let tco-loop((ast ast) (env env)) ; expand as possible + (when (cond-true? (env-check 'DEBUG-EVAL env)) + (format #t "EVAL: ~a~%" (pr_str ast #t))) + (match ast + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) + (() ast) + (('defmacro! k v) + (let ((c (EVAL v env))) + ((env 'set) k (callable-as-macro c)))) + (('quote obj) obj) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) + (('def! k v) ((env 'set) k (EVAL v env))) + (('let* kvs body) + (let* ((new-env (make-Env #:outer env)) + (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) + (receive (keys vals) (%unzip2 (->list kvs)) + (for-each setter keys vals)) + (tco-loop body new-env))) + (('do rest ...) + (cond + ((null? rest) + (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) + ((= 1 (length rest)) (tco-loop (car rest) env)) + (else + (let ((mexpr (take rest (1- (length rest)))) + (tail-call (car (take-right rest 1)))) + (eval_seq mexpr env) + (tco-loop tail-call env))))) + (('if cnd thn els ...) + (cond + ((and (not (null? els)) (not (null? (cdr els)))) + ;; Invalid `if' form + (throw 'mal-error + (format #f "if: failed to match any pattern in form '~a'" ast))) + ((cond-true? (EVAL cnd env)) (tco-loop thn env)) + (else (if (null? els) nil (tco-loop (car els) env))))) + (('fn* params body ...) ; function definition + (make-anonymous-func + (lambda args + (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) + (cond + ((null? body) + (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) + ((= 1 (length body)) (tco-loop (car body) nenv)) + (else + (let ((mexpr (take body (1- (length body)))) + (tail-call (car (take-right body 1)))) + (eval_seq mexpr nenv) + (tco-loop tail-call nenv)))))))) + (('try* A) + (EVAL A env)) + (('try* A ('catch* B C)) + (catch + #t + (lambda () (EVAL A env)) + (lambda e + (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) + (EVAL C nenv))))) + (else + (let ((f (EVAL (car ast) env)) + (args (cdr ast))) + (if (is-macro f) + (EVAL (callable-apply f args) env) + (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) + +(define (EVAL-string str) + (EVAL (read_str str) *toplevel*)) + +(define (PRINT exp) + (and (not (eof-object? exp)) + (format #t "~a~%" (pr_str exp #t)))) + +(define (LOOP continue?) + (and continue? (REPL))) + +(define (REPL) + (LOOP + (let ((line (_readline "user> "))) + (cond + ((eof-object? line) #f) + ((string=? line "") #t) + (else + (catch 'mal-error + (lambda () (PRINT (EVAL (READ line) *toplevel*))) + (lambda (k . e) + (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) + +;; initialization +((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) +((*toplevel* 'set) 'throw (make-func (lambda (val) (throw 'mal-error val)))) +((*toplevel* 'set) '*ARGV* '()) +(EVAL-string "(def! not (fn* (x) (if x false true)))") +(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(EVAL-string "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") +(EVAL-string "(def! *host-language* \"guile\")") + +(let ((args (cdr (command-line)))) + (cond + ((> (length args) 0) + ((*toplevel* 'set) '*ARGV* (cdr args)) + (EVAL-string (string-append "(load-file \"" (car args) "\")"))) + (else + (EVAL-string "(println (str \"Mal (\" *host-language* \")\"))") + (REPL)))) diff --git a/impls/guile/types.scm b/impls/guile/types.scm new file mode 100644 index 0000000000..1e51bc8bc6 --- /dev/null +++ b/impls/guile/types.scm @@ -0,0 +1,110 @@ +;; Copyright (C) 2015 +;; "Mu Lei" known as "NalaGinrut" +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(library (types) + (export string-sub *eof* non-list? + string->keyword _keyword? _string? + nil _nil? list->hash-map + cond-true? make-anonymous-func + make-atom atom? atom-val atom-val-set! + make-callable callable? callable-is_macro + callable-as-macro callable-closure + is-func is-func? is-macro is-macro? make-func callable-apply + callable-unbox-set! callable-unbox + callable-meta-info hash-table-clone + box? box unbox) + (import (guile) (only (rnrs) define-record-type) (ice-9 regex) (ice-9 session))) + +(define (non-list? x) (not (list? x))) + + +(define (string-sub str p1 p2) + (regexp-substitute/global #f p1 str 'pre p2 'post)) + +(define *eof* (call-with-input-string "" read)) + +(define (string->keyword str) + (when (not (string? str)) + (throw 'mal-error (format #f "string->keyword: '~a' is not a string" str))) + (string-append "\u029e" str)) + +(define (_keyword? k) + (and (string? k) + (> (string-length k) 0) + (char=? #\1236 (string-ref k 0)))) + +(define (_string? s) + (and (string? s) (not (_keyword? s)))) + +(define-record-type mal-nil) + +(define nil (make-mal-nil)) + +(define (_nil? obj) (mal-nil? obj)) + +(define (cond-true? obj) + (and (not (_nil? obj)) obj)) + +(define-record-type atom (fields (mutable val))) + +(define-record-type callable + (fields + meta-info + (mutable unbox) + (mutable is_macro) + closure)) + +(define (make-func closure) (make-callable nil #t #f closure)) +(define (make-anonymous-func closure) (make-callable nil #f #f closure)) + +(define (callable-apply c arglst) + (apply (callable-closure c) (if (callable-unbox c) (map unbox arglst) arglst))) + +(define (callable-check c b) + (and (callable? c) + (eq? (callable-is_macro c) b) + c)) + +(define (is-func c) (callable-check c #f)) +(define (is-func? c) (and (is-func c) #t)) +(define (is-macro c) (callable-check c #t)) +(define (is-macro? c) (and (is-macro c) #t)) +(define (callable-as-macro c) + (make-callable nil (callable-unbox c) #t (callable-closure c))) + +(define (hash-table-clone ht) + (list->hash-map (hash-fold (lambda (k v p) (cons k (cons v p))) '() ht))) + +(define-record-type box (fields val)) + +(define (box o) (make-box o)) +(define (unbox o) + (if (box? o) (box-val o) o)) + +(define* (list->hash-map lst #:optional (ht (make-hash-table))) + (cond + ((null? lst) ht) + (else + (let lp((next lst)) + (cond + ((null? next) ht) + (else + (when (null? (cdr next)) + (throw 'mal-error + (format #f "hash-map: '~a' lack of value" (car next)))) + (let ((k (car next)) + (v (cadr next))) + (hash-set! ht k v) + (lp (cddr next))))))))) diff --git a/impls/hare/.gitignore b/impls/hare/.gitignore new file mode 100644 index 0000000000..9ab180fbc1 --- /dev/null +++ b/impls/hare/.gitignore @@ -0,0 +1 @@ +!mal \ No newline at end of file diff --git a/impls/hare/Dockerfile b/impls/hare/Dockerfile new file mode 100644 index 0000000000..155c775c87 --- /dev/null +++ b/impls/hare/Dockerfile @@ -0,0 +1,25 @@ +FROM debian:testing +MAINTAINER Lou Woell +LABEL org.opencontainers.image.source=https://github.com/kanaka/mal +LABEL org.opencontainers.image.description="mal test container: hare" + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +ENV HARECACHE='/mal/.cache/hare/' +RUN apt-get -y install binutils hare \ No newline at end of file diff --git a/impls/hare/makefile b/impls/hare/makefile new file mode 100644 index 0000000000..dcffb98177 --- /dev/null +++ b/impls/hare/makefile @@ -0,0 +1,13 @@ +CC= hare build + +BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal + +.PHONY: all +all: $(BINS) + +%: %.ha $(wildcard mal/*.ha) + $(CC) -o $@ $< + +.PHONY: clean +clean: + rm $(BINS) diff --git a/impls/hare/mal/core.ha b/impls/hare/mal/core.ha new file mode 100644 index 0000000000..d8cce31d54 --- /dev/null +++ b/impls/hare/mal/core.ha @@ -0,0 +1,1244 @@ +use fmt; +use os; +use io; +use memio; +use strings; +use bufio; +use time; + +export type ns_entry = (str, (MalType | *fn([]MalType) (MalType | error))); +export type namespace = []ns_entry; + +export fn load_namespace(ns: namespace, env: *env) (void | error) = { + for(let e.. ns){ + let v: MalType = match(e.1){ + case let v: MalType => + yield v; + case let f: *fn([]MalType) (MalType | error) => + yield make_intrinsic(f); + case => + return ("MalType", nil): type_error; + }; + env_set(env, e.0: symbol, v); + }; +}; + +export let core: namespace = [ + ("pr", &prn), + ("list", &mallist), + ("count", &count), + ("list?", &listp), + ("empty?", &emptyp), + ("not", ¬), + ("+", &plus), + ("-", &minus), + ("*", &mult), + ("/", &div), + (">", &greater_than), + ("<", &smaller_than), + (">=", &greq_than), + ("<=", &seq_than), + ("=", &mal_eq), + ("prn", &prn), + ("println", &prn_line), + ("pr-str", &pr_str), + ("str", &pr_str_ugly), + ("read-string", &r_string), + ("slurp", &slurp), + ("atom", &mal_atom), + ("atom?", &atomp), + ("deref", &atom_deref), + ("reset!", &atom_reset), + ("swap!", &atom_swap), + ("cons", &cons), + ("concat", &concat), + ("vec", &vec), + ("nth", &nth), + ("first", &first), + ("rest", &rest), + ("macro?", ¯op), + ("throw", &throw), + ("apply", &apply), + ("map", &map), + ("nil?", &nilp), + ("true?", &truep), + ("false?", &falsep), + ("symbol?", &symbolp), + ("map?", &mapp), + ("vector", &malvector), + ("vector?", &vectorp), + ("sequential?", &sequentialp), + ("symbol", &malsymbol), + ("keyword?", &keywordp), + ("keyword", &malkeyword), + ("hash-map", &malhash_map), + ("get", &malhmget), + ("contains?", &containsp), + ("assoc", &assoc), + ("dissoc", &dissoc), + ("vals", &vals), + ("keys", &keys), + ("readline", &readline), + ("time-ms", &time_ms), + ("string?", &stringp), + ("number?", &numberp), + ("seq", &seq), + ("conj", &conj), + ("meta", &meta), + ("with-meta", &with_meta), + ("fn?", &fnp), +]; + +export fn plus (args: []MalType) (MalType | error) = { + + let result: number = 0; + + for(let n .. args) { + match(n){ + case let n: number => + result += n; + case => + return ("number", args): type_error; + }; + }; + + return result; +}; + +export fn minus (args: []MalType) (MalType | error) = { + + let result: number = args[0] as number; + + for(let n .. args[1..]) { + match(n){ + case let n: number => + result -= n; + case => + return ("number", args): type_error; + }; + }; + + return result; +}; + +export fn mult (args: []MalType) (MalType | error) = { + + let result: number = 1; + + for(let n .. args) { + match(n){ + case let n: number => + result *= n; + case => + return ("number", args): type_error; + }; + }; + + return result; +}; + + +export fn div (args: []MalType) (MalType | error) = { + + let x = match(args[0]){ + case let x: number => + yield x; + case => + return ("number", args): type_error; + }; + + let y = switch(len(args)){ + case 2 => + yield match(args[1]){ + case let y: number => + yield y; + case => + return ("number", args): type_error; + }; + case 1 => + yield 1: number; + case 0 => + yield 1: number; + case => + yield div(args[1..])? as number; + }; + + return x / y; +}; + +fn mallist (args: []MalType) (MalType | error) = { + return make_list(len(args), args); +}; + +fn listp (args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'listp': Too few arguments", args): syntax_error; + + return args[0] is list; +}; + +fn emptyp (args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'emptyp': Too few arguments", args): syntax_error; + + let a: []MalType = match(args[0]){ + case let a: vector => + yield a.data; + case let a: list => + yield a.data; + case => return nil; + }; + + return len(a) == 0; +}; + +fn count (args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'count': Too few arguments", args): syntax_error; + + const arg: []MalType = match(args[0]) { + case let a: list => + yield a.data; + case let a: vector => + yield a.data; + case nil => + return 0; + case => + return ("list", args): type_error; + }; + return len(arg): number; +}; + +fn greater_than (args: []MalType) (MalType | error) = { + + if(len(args) != 2) + return ("> expected exactly 2 args, got:", args): syntax_error; + + const x = match(args[0]){ + case let x: number => + yield x; + case => + return ("number", args): type_error; + }; + + const y = match(args[1]){ + case let y: number => + yield y; + case => + return ("number", args): type_error; + }; + + return x > y; +}; + +fn smaller_than (args: []MalType) (MalType | error) = { + + if(len(args) != 2) + return ("< expected exactly 2 args, got:", args): syntax_error; + + const x = match(args[0]){ + case let x: number => + yield x; + case => + return ("number", args): type_error; + }; + + const y = match(args[1]){ + case let y: number => + yield y; + case => + return ("number", args): type_error; + }; + + return x < y; +}; + + +fn greq_than (args: []MalType) (MalType | error) = { + + if(len(args) != 2) + return (">= expected exactly 2 args, got:", args): syntax_error; + + const x = match(args[0]){ + case let x: number => + yield x; + case => + return ("number", args): type_error; + }; + + const y = match(args[1]){ + case let y: number => + yield y; + case => + return ("number", args): type_error; + }; + + return x >= y; +}; + +fn seq_than (args: []MalType) (MalType | error) = { + if(len(args) != 2) + return ("<= expected exactly 2 args, got:", args): syntax_error; + + const x = match(args[0]){ + case let x: number => + yield x; + case => + return ("number", args): type_error; + }; + + const y = match(args[1]){ + case let y: number => + yield y; + case => + return ("number", args): type_error; + }; + + return x <= y; +}; + +fn list_cmp (ls: []MalType, ls2: []MalType) bool = { + if(!(len(ls) == len(ls2))) + return false; + + for(let i: size = 0; i < len(ls); i += 1){ + if(!(mal_eq(([ls[i], ls2[i]]: []MalType)) as bool)){ + return false; + }; + }; + return true; +}; + +fn mal_eq (args: []MalType) (MalType | error) = { + + if(len(args) != 2) + return ("'=': expected exactly 2 args, got:", args): + syntax_error; + + match(args[0]){ + case let x: number => + if(args[1] is number) { + return x == args[1] as number; + }; + case let x: bool => + if(args[1] is bool) { + return x == args[1] as bool; + }; + case let x: list => + match(args[1]){ + case let y: vector => + return list_cmp(x.data, y.data); + case let y: list => + return list_cmp(x.data, y.data); + case => void; + }; + case let x: vector => + match(args[1]){ + case let y: vector => + return list_cmp(x.data, y.data); + case let y: list => + return list_cmp(x.data, y.data); + case => void; + }; + case let x: nil => + if(args[1] is nil) { + return true; + }; + case let x: string => + match(args[1]){ + case let y: string => + return x.data == y.data; + case => void; + }; + case let s: symbol => + if(args[1] is symbol){ + return s == args[1] as symbol; + }; + case let hm: hashmap => + if(args[1] is hashmap){ + return hash_cmp(hm, args[1] as hashmap); + }; + case => void; + }; + return false; +}; + +fn not (args: []MalType) (MalType | error) = { + if(len(args) == 0) + return ("'not': too few arguments", args): syntax_error; + + match(args[0]){ + case let b: bool => + return !b; + case nil => + return true; + case => + return false; + }; +}; + +fn prn (args: []MalType) (MalType | error) = { + + for(let i: size = 0; i < len(args); i += 1) { + print_form(os::stdout, args[i]); + if (i < len(args) - 1) + fmt::fprint(os::stdout, " ")!; + }; + fmt::fprint(os::stdout, "\n")!; + return nil; +}; + +fn prn_line (args: []MalType) (MalType | error) = { + + for(let i: size = 0; i < len(args); i += 1) { + print_form(os::stdout, args[i], false); + if (i < len(args) - 1) + fmt::fprint(os::stdout, " ")!; + }; + fmt::fprint(os::stdout, "\n")!; + return nil; +}; + +fn pr_str(args: []MalType) (MalType | error) = { + + let strbuf = memio::dynamic(); + defer io::close(&strbuf)!; + for(let i: size = 0; i < len(args); i += 1) { + print_form(&strbuf, args[i]); + if (i < len(args) - 1) + fmt::fprint(&strbuf, " ")!; + }; + + let s: str = memio::string(&strbuf)!; + return make_string(s); +}; + + +fn pr_str_ugly(args: []MalType) (MalType | error) = { + + let strbuf = memio::dynamic(); + defer io::close(&strbuf)!; + + for(let i: size = 0; i < len(args); i += 1) { + print_form(&strbuf, args[i], false); + }; + + let s: str = memio::string(&strbuf)!; + return make_string(s); +}; + +fn r_string(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'read-string': too few arguments", args): syntax_error; + + let input: str = match(args[0]){ + case let s: string => + yield s.data; + case => + return ("string", args[0]): type_error; + }; + + match(read_str(strings::toutf8(input))) { + case io::EOF => + return unexpected_eof; + case let res: (MalType | error) => + return res; + }; +}; + +fn slurp(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'slurp': too few arguments", args): syntax_error; + + let file_name: str = match(args[0]) { + case let s: string => + yield s.data; + case => + return ("string", args[0]): type_error; + }; + + let file = os::open(file_name)?; + let fcontent = io::drain(file)?; + io::close(file)?; + + let s: str = strings::fromutf8(fcontent)!; + return make_string(s); +}; + +fn mal_atom (args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'atom': too few arguments", args): syntax_error; + + return make_atom(args[0]); +}; + +fn atomp (args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'atomp': too few arguments", args): syntax_error; + + return args[0] is atom; +}; + +fn atom_deref (args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'deref': too few arguments", args): syntax_error; + + match(args[0]){ + case let a: atom => + return *a; + case => + return ("atom", args[0]): type_error; + }; +}; + +fn atom_reset (args: []MalType) (MalType | error) ={ + + if(len(args) < 2) + return ("'reset': too few arguments", args): syntax_error; + + let a: atom = match(args[0]){ + case let a: atom => + yield a; + case => + return ("atom", args[0]): type_error; + }; + + let v: MalType = match(args[1]){ + case let v: MalType => + yield v; + case => + return ("atom", args[0]): type_error; + }; + + *a = v; + return v; +}; + +fn atom_swap (args: []MalType) (MalType | error) = { + + if(len(args) < 2) + return ("'swap': too few arguments", args): syntax_error; + + let a: atom = match(args[0]){ + case let a: atom => + yield a; + case => + return ("atom", args[0]): type_error; + }; + + + let func = match(args[1]){ + case let f: (function | intrinsic) => + yield f; + case => + return ("function", args[1]): type_error; + }; + + let appls: list = make_list(len(args[1..]), args[1..]); + appls.data[0] = *a; + + *a = apply([func, appls])?; + + return *a; +}; + +fn cons(args: []MalType) (MalType | error) = { + + if(len(args) < 2) + return ("'cons': too few arguments", args): syntax_error; + + let ls: []MalType = match(args[1]){ + + case let ls: list => + yield ls.data; + case let ls: vector => + yield ls.data; + case => + return("list", args[1]): type_error; + }; + + let new: list = make_list(len(ls)+1); + new.data[0] = args[0]; + new.data[1..] = ls; + return new; +}; + +fn concat(args: []MalType) (MalType | error) = { + + let length: size = 0; + for(let i: size = 0; i < len(args); i += 1){ + match(args[i]){ + case let ls: list => + length += len(ls.data); + case let ls: vector => + length += len(ls.data); + case => + return("list", args[1]): type_error; + }; + }; + + if(length == 0) return make_list(0); + + let new: list = make_list(length); + let nlen: size = 0; + for(let i: size = 0; i < len(args); i += 1){ + let ls: []MalType = match(args[i]){ + case let ls: list => + yield ls.data; + case let ls: vector => + yield ls.data; + }; + + const n = nlen + len(ls); + new.data[nlen..n] = ls; + nlen = n; + }; + return new; +}; + +fn vec(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'vec': too few arguments", args): syntax_error; + + let ls: []MalType = match(args[0]){ + case let ls: vector => + return ls; + case let ls: list => + yield ls.data; + case => + return ("list or vector", + args[0]): type_error; + }; + + let new: vector = make_vec(len(ls)); + + if(len(ls) > 0){ + new.data[0..] = ls; + }; + + return new; +}; + +fn nth(args: []MalType) (MalType | error) = { + + if(len(args) < 2) + return ("'nth': too few arguments", args): syntax_error; + + let ls: []MalType = match(args[0]){ + case let ls: list => + yield ls.data; + case let ls: vector => + yield ls.data; + case => + return ("list", args): type_error; + }; + + let index: number = match(args[1]){ + case let i: number => + yield i; + case => + return ("number", args): type_error; + }; + + if(index >= len(ls): int) + return ("bounds error", args): syntax_error; + + return ls[index]; +}; + +fn first(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'first': too few arguments", args): syntax_error; + + let ls: []MalType = match(args[0]){ + case let ls: list => + yield ls.data; + case let ls: vector => + yield ls.data; + case let ls: nil => + return nil; + case => + return ("list", args): type_error; + }; + + if(0 == len(ls)) return nil; + + return ls[0]; +}; + +fn rest(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'rest': too few arguments", args): syntax_error; + + let ls: []MalType = match(args[0]){ + case let ls: list => + yield ls.data; + case let ls: vector => + yield ls.data; + case let ls: nil => + return make_list(0); + case => + return ("list", args): type_error; + }; + + if(0 == len(ls) || 0 == len(ls[1..])) + return make_list(0); + + return make_list(len(ls[1..]), ls[1..]); +}; + +fn macrop(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'macrop': too few arguments", args): syntax_error; + + return args[0] is macro; +}; + +fn throw(args: []MalType) (MalType | error) ={ + + if(len(args) == 0) + return ("'throw': too few arguments", args): syntax_error; + + return ("error", args[0]): malerror; +}; + +fn map(args: []MalType) (MalType | error) = { + + if(len(args) < 2) + return ("'map': too few arguments", args): syntax_error; + + const ls: []MalType = match(args[1]){ + case let l: list => + yield l.data; + case let l: vector => + yield l.data; + case => + return ("list", args): type_error; + }; + + const length = len(ls); + + const new = make_list(length); + + + for(let i: size = 0; i < len(ls); i += 1){ + + let argls: []MalType = [ls[i]]; + new.data[i] = apply([args[0], &argls: list])?; + }; + + return new; +}; + +fn apply(args: []MalType) (MalType | error) = { + + if(len(args) < 2) + return ("'apply': too few arguments", args): syntax_error; + + const last = args[len(args)-1]; + const rest = args[1..len(args)-1]; + + const last: []MalType = match(args[len(args)-1]){ + case let l: list => + yield l.data; + case let l: vector => + yield l.data; + case => + return ("list", args): type_error; + }; + + const length: size = len(rest) + len(last); + + const ls: []MalType = switch(length){ + case 0 => + yield []; + case => + yield alloc([nil...], length)!; + }; + defer free(ls); + + ls[0 .. len(rest)] = rest; + ls[len(rest)..] = last; + + match(args[0]){ + case let func: function => + let env = env_init(func.envi); + env_bind(env, func.args, ls); + return func.eval(func.body, env); + case let func: macro => + let env = env_init(func.envi); + env_bind(env, func.args, ls); + return func.eval(func.body, env); + case let f: intrinsic => + return f.eval(ls); + case => + return ("function", args): type_error; + }; +}; + +fn nilp(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'nilp': too few arguments", args): syntax_error; + + return args[0] is nil; +}; + +fn symbolp(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'symbolp': too few arguments", args): syntax_error; + + match(args[0]){ + case let s: symbol => + if (!(strings::hasprefix(s, ":"))) + return true; + case => void; + }; + return false; +}; + +fn keywordp(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'keywordp': too few arguments", args): syntax_error; + + match(args[0]){ + case let s: symbol => + if (strings::hasprefix(s, ":")) + return true; + case => void; + }; + return false; +}; + +fn vectorp(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'vectorp': too few arguments", args): syntax_error; + + return args[0] is vector; +}; + +fn sequentialp(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'sequentialp': too few arguments", args): + syntax_error; + + return args[0] is (list | vector); +}; + +fn mapp(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'mapp': too few arguments", args): syntax_error; + + return args[0] is hashmap; +}; + +fn truep(args: []MalType) (MalType | error) = { + match(args[0]){ + case let b: bool => + return b; + case => + return false; + }; +}; + +fn falsep(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'falsep': too few arguments", args): syntax_error; + + match(args[0]){ + case let b: bool => + return !b; + case => + return false; + }; +}; + +fn malvector(args: []MalType) (MalType | error) = { + return make_vec(len(args), args); +}; + +fn malsymbol(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'symbol': too few arguments", args): syntax_error; + + let s: str = match(args[0]){ + case let s: string => + yield s.data; + case => + return ("string", args): type_error; + }; + return make_symbol(s); +}; + +fn malkeyword(args: []MalType) (MalType | error) = { + + if(len(args) == 0) + return ("'keyword': too few arguments", args): syntax_error; + + match(args[0]){ + case let s: string => + let name = strings::lpad(s.data, ':', len(s.data) + 1)!; + defer free(name); + return make_symbol(name); + case let k: symbol => + if(strings::hasprefix(k, ':')) + return k; + return false; + case => + return ("string", args): type_error; + }; +}; + +fn malhash_map(args: []MalType) (MalType | error) = { + + let new = hm_init(); + + if (len(args) % 2 != 0) + return ("odd number of arguments", args): syntax_error; + + for(let i: size = 0; i < len(args); i += 2){ + match(args[i]){ + case let s: (symbol | string) => + hm_add(new, s, args[i+1]); + case => + return ("symbol or string", + args): type_error; + }; + }; + + return new; +}; + +fn malhmget(args: []MalType) (MalType | error) = { + + if(len(args) < 2) + return ("'get': too few arguments", args): syntax_error; + + const hm = match(args[0]){ + case let hm: hashmap => + yield hm; + case nil => return nil; + case => + return ("hashmap", args): type_error; + }; + + const key = match(args[1]){ + case let hm: (string | symbol) => + yield hm; + case => + return ("symbol or string", args): type_error; + }; + + match (hm_get(hm, key)){ + case let e: undefined_key => + return nil; + case let v: MalType => + return v; + }; +}; + +fn containsp(args: []MalType) (MalType | error) = { + + if(len(args) < 2) + return ("'containsp': too few arguments", args): syntax_error; + + const hm = match(args[0]){ + case let hm: hashmap => + yield hm; + case => + return ("hashmap", args): type_error; + }; + + const key = match(args[1]){ + case let hm: (string | symbol) => + yield hm; + case => + return ("symbol or string", args): type_error; + }; + + match(hm_get(hm, key)){ + case undefined_key => return false; + case => return true; + }; +}; + +fn assoc(args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'assoc': too few arguments", args): syntax_error; + + let hm: hashmap = match(args[0]){ + case let hm: hashmap => + yield hm; + case => + return ("hashmap", args): type_error; + }; + + let new: hashmap = hm_copy(hm); + + assert(len(hm.data) == len(new.data)); + + let ls = args[1..]; + for(let i: size = 0; i < len(ls); i += 2){ + match(ls[i]){ + case let s: (symbol | string) => + hm_set(new, s, ls[i+1]); + case => + return ("symbol or string", + args): type_error; + }; + }; + + return new; +}; + +fn dissoc(args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'dissoc': too few arguments", args): syntax_error; + + let hm: hashmap = match(args[0]){ + case let hm: hashmap => + yield hm; + case => + return ("hashmap", args): type_error; + }; + + let ls = args[1..]; + let new: hashmap = hm_copy(hm, ls: [](string | symbol)); + + return new; +}; + +fn vals(args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'vals': too few arguments", args): syntax_error; + + let hm: hashmap = match(args[0]){ + case let hm: hashmap => + yield hm; + case => + return ("hashmap", args): type_error; + }; + + return hm_val_list(hm); +}; + +fn keys(args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'keys': too few arguments", args): syntax_error; + + let hm: hashmap = match(args[0]){ + case let hm: hashmap => + yield hm; + case => + return ("hashmap", args): type_error; + }; + + return hm_key_list(hm); +}; + +fn readline (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'readline': too few arguments", args): syntax_error; + + const prompt: str = match(args[0]){ + case let p: string => + yield p.data; + case => + return ("string", args): type_error; + }; + + fmt::printf(prompt)!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + return nil; + case let e: io::error => + return e; + }; + + const s = strings::fromutf8(input)!; + const ret = make_string(s); + free(input); + return ret; +}; + +fn time_ms (args: []MalType) (MalType | error) = { + let now = time::now(time::clock::REALTIME); + let base = time::instant{sec = 0, ...}; + let diff = time::diff(base, now) / time::MILLISECOND; + return diff: number; +}; + +fn stringp (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'stringp': too few arguments", args): syntax_error; + + return args[0] is string; +}; + +fn numberp (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'numberp': too few arguments", args): syntax_error; + + return args[0] is number; +}; + +fn fnp (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'fnp': too few arguments", args): syntax_error; + + return args[0] is (function | intrinsic); +}; + +fn seq (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'seq': too few arguments", args): syntax_error; + + match(args[0]){ + case let s: string => + if(len(s.data) == 0) return nil; + + let new = make_list(len(s.data)); + + let it = strings::iter(s.data); + + for(let i: size = 0; i < len(s.data); i += 1){ + match(strings::next(&it)){ + case let rn: rune => + let s: str = strings::fromutf8([rn: u8])!; + new.data[i] = make_string(s); + case => + break; + }; + }; + + return new; + case let s: list => + if(len(s.data) == 0) return nil; + return s; + case let s: vector => + if(len(s.data) == 0) return nil; + return make_list(len(s.data), s.data); + case let s: nil => + return nil; + }; + +}; + +fn conj (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'conj': too few arguments", args): syntax_error; + + let old = args[1..]; + let length = len(old); + + match(args[0]){ + case let ls: list => + length += len(ls.data); + let new = make_list(length); + new.data[len(old)..] = ls.data; + + for(let i: size = len(old); i > 0; i -= 1){ + new.data[i-1] = old[len(old) - i]; + }; + return new; + case let ls: vector => + length += len(ls.data); + let new = make_vec(length, ls.data); + new.data[len(ls.data)..] = old; + return new; + case => return ("list or vector", args): type_error; + }; +}; + +fn meta (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'meta': too few arguments", args): syntax_error; + + match(args[0]){ + case let func: function => + return func.meta; + case let func: intrinsic => + return func.meta; + case let hm: hashmap => + return hm.meta; + case let s: string => + return s.meta; + case let l: list => + return l.meta; + case let v: vector => + return v.meta; + case => + return not_implemented; + }; +}; + +fn with_meta (args: []MalType) (MalType | error) = { + + if(len(args) < 1) + return ("'with-meta': too few arguments", args): + syntax_error; + + match(args[0]){ + case let func: function => + let new = make_func(func.eval, func.envi, func.args, + func.body); + new.meta = args[1]; + return new; + case let hm: hashmap => + let new = assoc([hm])?:hashmap; + new.meta = args[1]; + return new; + case let s: string => + let new = make_string(s.data); + new.meta = args[1]; + return new; + case let f: intrinsic => + let new = make_intrinsic(f.eval); + new.meta = args[1]; + return new; + case let ls: list => + let new: list = make_list(len(ls.data), ls.data); + new.meta = args[1]; + return new; + case let v: vector => + let new: vector = make_vec(len(v.data), v.data); + new.meta = args[1]; + return new; + case => + return not_implemented; + }; +}; diff --git a/impls/hare/mal/env.ha b/impls/hare/mal/env.ha new file mode 100644 index 0000000000..12525b8769 --- /dev/null +++ b/impls/hare/mal/env.ha @@ -0,0 +1,60 @@ +export type env = struct { + outer: nullable *env, + data: hashmap, +}; + +export fn env_init(outer: nullable * env = null) *env ={ + const new = alloc(env { + outer = outer, + data = hm_init(), + })!; + + append(gc.memory.envs, new)!; + return new; +}; + +export fn env_bind( + env: *env, + bindings: []MalType, + exprs: []MalType +) void = { + + let more: bool = false; + for(let i: size = 0; i < len(bindings); i += 1){ + if (!(bindings[i] is symbol)){ + return void; + }; + if (more) { + let tail = exprs[i - 1..]; + let new = make_list(len(tail), tail); + env_set(env, bindings[i] as symbol, new); + break; + } else if (bindings[i] as symbol == "&": symbol){ + more = true; + continue; + } else { + env_set(env, bindings[i] as symbol, exprs[i]); + }; + }; +}; + + +export fn env_set(env: *env, key: symbol, val: MalType) void = { + hm_set(env.data, key, val); + return void; +}; + +export fn env_get(envi: *env, key: symbol) (MalType | undefined_symbol) = { + + match(hm_get(envi.data, key)) { + case undefined_key => + match(envi.outer){ + case null => + return ("env_get", key): undefined_symbol; + case let outer: *env => + return env_get(outer, key); + }; + case let result: MalType => + return result; + }; +}; diff --git a/impls/hare/mal/error.ha b/impls/hare/mal/error.ha new file mode 100644 index 0000000000..96be86da53 --- /dev/null +++ b/impls/hare/mal/error.ha @@ -0,0 +1,52 @@ +use bufio; +use io; +use fmt; +use os; +use fs; + +export type malerror = !(str, MalType); + +export type not_implemented = !void; +export type unexpected_eof = !void; +export type unbalanced = !void; + +export type undefined_key = !(str, (symbol | string)); +export type undefined_symbol = !(str, symbol); +export type syntax_error = !(str, (MalType | []MalType)); +export type type_error = !(str, (MalType | []MalType)); + +export type error = !(malerror | fs::error | io::error | unexpected_eof | + unbalanced | not_implemented | undefined_symbol | undefined_key | + syntax_error | type_error); + +export fn format_error(strbuf: io::handle, e: error) void = { + + match(e){ + case let e: type_error => + fmt::fprint(strbuf, "Type Error: expected", e.0, "got:")!; + print_form(strbuf, e.1, false); + fmt::fprint(strbuf, "\n")!; + case let e: syntax_error => + fmt::fprintln(strbuf, "Syntax Error:", e.0)!; + print_form(strbuf, e.1, false); + fmt::fprint(strbuf, "\n")!; + case let e: undefined_symbol => + fmt::fprintf(strbuf, "'{}' not found", e.1)!; + fmt::print("\n")!; + case unexpected_eof => + fmt::fprintln(strbuf, "Unexpected EOF!")!; + case let e: malerror => + print_form(strbuf, e.1, false); + fmt::print("\n")!; + case unbalanced => + fmt::fprintln(strbuf, "Unbalanced Delimiters")!; + case not_implemented => + fmt::fprintln(strbuf, "not implemented")!; + case let e: io::error => + fmt::fprintln(strbuf, io::strerror(e))!; + case let e: fs::error => + fmt::fprintln(strbuf, fs::strerror(e))!; + case => + fmt::fatal("unknown error"); + }; +}; diff --git a/impls/hare/mal/gc.ha b/impls/hare/mal/gc.ha new file mode 100644 index 0000000000..2707ba82d5 --- /dev/null +++ b/impls/hare/mal/gc.ha @@ -0,0 +1,270 @@ +// Some inspirations taken from https://git.sr.ht/~jummit/rekkyo + +type memory = struct { + envs: []*env, + hashs: []hashmap, + symbols: (void | hashmap), + funcs: []function, + lists: []list, + vecs: []vector, + strings: []string, + atoms: []atom, + intrinsics: []intrinsic, +}; + +type garbage_collector = struct { + marked: memory, + memory: memory, +}; + +let gc = garbage_collector { + marked = memory { + symbols = void, + funcs = [], + ... + }, + memory = memory { + symbols = void, + funcs = [], + ... + }, +}; + +fn reset_memory(memory: *memory) void = { + + memory.envs = memory.envs[..0]; + memory.hashs = memory.hashs[..0]; + memory.funcs = memory.funcs[..0]; + memory.lists = memory.lists[..0]; + memory.vecs = memory.vecs[..0]; + memory.strings = memory.strings[..0]; + memory.atoms = memory.atoms[..0]; + memory.intrinsics = memory.intrinsics[..0]; + + match(memory.symbols){ + case let hm: hashmap => + hm.data = hm.data[..0]; + case void => + void; + }; +}; + +fn finish_memory(memory: memory) void = { + + free(memory.envs); + free(memory.hashs); + free(memory.funcs); + free(memory.lists); + free(memory.vecs); + free(memory.strings); + free(memory.atoms); + free(memory.intrinsics); + + match(memory.symbols){ + case let hm: hashmap => + hm_free(hm); + case void => + void; + }; +}; + +fn mark_hash(hm: hashmap) void = { + + append(gc.marked.hashs, hm)!; + mark(hm.meta); + + for(let v .. hm.data){ + mark(v.key); + mark(v.val); + }; +}; + +fn mark_env(envi: *env) void = { + + for(let e .. gc.marked.envs){ + if(e == envi) return void; + }; + + append(gc.marked.envs, envi)!; + mark(envi.data); + + match(envi.outer){ + case null => void; + case let e: *env => + mark_env(e); + }; +}; + +fn mark_col(col: []MalType) void = { + for(let v .. col) { + mark(v); + }; +}; + +fn mark (val: MalType) void = { + + match(gc.marked.symbols){ + case void => + gc.marked.symbols = hm_init(false); + case => void; + }; + + match(val){ + case let v: vector => + for(let x .. gc.marked.vecs){ + if(x == v) return void; + }; + append(gc.marked.vecs, v)!; + mark_col(v.data); + mark(v.meta); + case let l: list => + for(let x .. gc.marked.lists){ + if(x == l) return void; + }; + append(gc.marked.lists, l)!; + mark_col(l.data); + mark(l.meta); + case let f: function => + for(let x .. gc.marked.funcs){ + if(x == f) return void; + }; + append(gc.marked.funcs, f)!; + mark(f.meta); + mark(f.body); + mark_col(f.args); + mark_env(f.envi); + case let i: intrinsic => + for(let x .. gc.marked.intrinsics){ + if(x == i) return void; + }; + append(gc.marked.intrinsics, i)!; + mark(i.meta); + case let m: macro => + let m = m:function; + for(let x .. gc.marked.funcs){ + if(x == m) return void; + }; + append(gc.marked.funcs, m)!; + mark(m.meta); + mark(m.body); + mark_col(m.args); + mark_env(m.envi); + case let h: hashmap => + for(let x .. gc.marked.hashs){ + if(x == h) return void; + }; + mark_hash(h); + case let s: symbol => + match(hm_get(gc.marked.symbols: hashmap, s)){ + case undefined_key => + hm_add(gc.marked.symbols: hashmap, s, s); + case => void; + }; + case let s: string => + for(let x .. gc.marked.strings){ + if(x == s) return void; + }; + append(gc.marked.strings, s)!; + mark(s.meta); + case let a: atom => + for(let x .. gc.marked.atoms){ + if(x == a) return void; + }; + append(gc.marked.atoms, a)!; + mark(*a); + case => void; + }; +}; + +fn sweep() void ={ + + const marked_symbols = match(gc.marked.symbols){ + case void => + gc.marked.symbols = hm_init(false); + yield gc.marked.symbols: hashmap; + case let hm: hashmap => + yield hm; + }; + + const memory_symbols = match(gc.memory.symbols){ + case void => + gc.memory.symbols = hm_init(false); + yield gc.memory.symbols: hashmap; + case let hm: hashmap => + yield hm; + }; + + for (let i: size = 0; len(memory_symbols.data) > i; i += 1) { + match(hm_get(marked_symbols, memory_symbols.data[i].key)){ + case undefined_key => + free(memory_symbols.data[i].key: symbol); + case => + void; + }; + }; + for :sweep (let i: size = 0; len(gc.memory.atoms) > i; i += 1) { + for(let x .. gc.marked.atoms){ + if(x == gc.memory.atoms[i]) continue :sweep; + }; + free(gc.memory.atoms[i]); + }; + for :sweep (let i: size = 0; len(gc.memory.strings) > i; i += 1) { + for(let x .. gc.marked.strings){ + if(x == gc.memory.strings[i]) continue :sweep; + }; + free_string(gc.memory.strings[i]); + }; + for :sweep (let i: size = 0; len(gc.memory.hashs) > i; i += 1) { + for(let x .. gc.marked.hashs){ + if(x == gc.memory.hashs[i]) continue :sweep; + }; + hm_free(gc.memory.hashs[i]); + }; + for :sweep (let i: size = 0; len(gc.memory.envs) > i; i += 1) { + for(let x .. gc.marked.envs){ + if(x == gc.memory.envs[i]) continue :sweep; + }; + free(gc.memory.envs[i]); //.data is collected as a hashmap + }; + for :sweep (let i: size = 0; len(gc.memory.vecs) > i; i += 1) { + for(let x .. gc.marked.vecs){ + if(x == gc.memory.vecs[i]) continue :sweep; + }; + free_vec(gc.memory.vecs[i]); + }; + for :sweep (let i: size = 0; len(gc.memory.lists) > i; i += 1) { + for(let x .. gc.marked.lists){ + if(x == gc.memory.lists[i]) continue :sweep; + }; + free_list(gc.memory.lists[i]); + }; + for :sweep (let i: size = 0; len(gc.memory.funcs) > i; i += 1) { + for(let x .. gc.marked.funcs){ + if(x == gc.memory.funcs[i]) continue :sweep; + }; + free_func(gc.memory.funcs[i]); + }; + for :sweep (let i: size = 0; len(gc.memory.intrinsics) > i; i += 1) { + for(let x .. gc.marked.intrinsics){ + if(x == gc.memory.intrinsics[i]) continue :sweep; + }; + free(gc.memory.intrinsics[i]); + }; + + reset_memory(&gc.memory); + + gc = garbage_collector { + marked = gc.memory, + memory = gc.marked, + }; +}; + +// it doesn't make sense to call this with anything but the global repl_env, +// because as of this version there's no way to keep track of objects reachable +// through the ast of the current evaluation and it's possible continuations. + +export fn run_gc(envi: *env) void = { + + mark_env(envi); + sweep(); +}; diff --git a/impls/hare/mal/hashmap.ha b/impls/hare/mal/hashmap.ha new file mode 100644 index 0000000000..8f6d47b841 --- /dev/null +++ b/impls/hare/mal/hashmap.ha @@ -0,0 +1,268 @@ +// The hashmap implmentation follows this idea: +// https://nullprogram.com/blog/2023/09/30/ + +use io; +use fmt; +use hash::fnv; + +export type hashmap = *struct { + data: []hmap, + meta: MalType, +}; + +export type hmap = struct { + key: (symbol | string), + val: MalType, + child: [4](size | void), +}; + +type pos = struct { + exists: bool, + index: size, + child: (size | void), +}; + +export fn hm_init(gcd: bool = true) hashmap = { + let new: hashmap = alloc(struct { + data: []hmap = [], + meta: MalType = nil, + })!; + + if(gcd) append(gc.memory.hashs, new)!; + + return new; +}; + +fn hm_free(hm: hashmap) void = { + free(hm.data); + free(hm); +}; + +fn new( + hm: hashmap, + p: pos, + k: (symbol | string), + v: MalType +) void = { + const new = hmap { + key = k, + val = v, + child: [4](size | void) = [void...], + }; + + append(hm.data, new)!; + + match(p.child) { + case void => + return void; + case let i: size => + hm.data[p.index].child[i] = len(hm.data) - 1; + }; + +}; + +export fn keycmp(x: (symbol | string), y: (symbol | string)) bool = { + + const kx: str = match(x){ + case let k: symbol => + yield k: str; + case let k: string => + yield k.data; + }; + + const ky: str = match(y){ + case let k: symbol => + yield k: str; + case let k: string => + yield k.data; + }; + + return kx == ky; +}; + +fn hm_find(hm: hashmap, key: (symbol | string)) pos = { + + let index: size = 0; + + const k: str = match(key){ + case let k: symbol => + yield k: str; + case let k: string => + yield k.data; + }; + + let hash: u32 = fnv::string32(k); + + if(len(hm.data) == 0) + return pos { + exists = false, + index = 0, + child = void, + }; + + for(true){ + if (keycmp(key, hm.data[index].key)){ + return pos { + exists = true, + index = index, + child = void, + }; + }; + + let c = hash >> 30; + + match(hm.data[index].child[c]){ + case void => + return pos { + exists = false, + index = index, + child = c, + }; + case let i: size => + index = i; + hash <<= 2; + continue; + }; + }; +}; + +export fn hm_set( + hm: hashmap, + key: (symbol | string), + val: MalType, +) void = { + + let p: pos = hm_find(hm, key); + + if(p.exists){ + hm.data[p.index].val = val; + } else { + new(hm, p, key, val); + }; + +}; + +export fn hm_add( + hm: hashmap, + key: (symbol | string), + val: MalType, +) void = { + + let p: pos = hm_find(hm, key); + + if(p.exists){ + return void; + } else { + new(hm, p, key, val); + }; +}; + +export fn hm_get( + hm: hashmap, + key: (symbol | string) +) (MalType | error) = { + + if(len(hm.data) == 0){ + return ("hm_get 0", key):undefined_key; + }; + + let p: pos = hm_find(hm, key); + + if(p.exists) { + return hm.data[p.index].val; + } else { + return ("hm_get", key):undefined_key; + }; +}; + +fn hm_copy(hm: hashmap, filter: [](string | symbol) = []) hashmap = { + const new = hm_init(); + + if(len(filter) == 0){ + for(let e .. hm.data) { + append(new.data, e)!; + }; + } else { + for :map (let e .. hm.data) { + for(let f .. filter) { + if(keycmp(f, e.key)) + continue :map; + }; + + hm_add(new, e.key, e.val); + }; + }; + + return new; +}; + +fn hm_print( + strbuf: io::handle, + hm: hashmap, + pp: bool, +) void = { + for (let i: size = 0; i < len(hm.data); i += 1){ + + let e = hm.data[i]; + + print_form(strbuf, e.key, pp); + fmt::fprint(strbuf, " ")!; + print_form(strbuf, e.val, pp); + if(!(i + 1 == len(hm.data))) fmt::fprint(strbuf, " ")!; + }; +}; + +fn hash_cmp(hm1: hashmap, hm2: hashmap) bool = { + + if(len(hm1.data) != len(hm2.data)){ + return false; + }; + + for(let i: size = 0; i < len(hm1.data); i += 1) { + match(hm_get(hm2, hm1.data[i].key)){ + case undefined_key => + return false; + case let v: MalType => + if(!(mal_eq([hm1.data[i].val, v]) as bool)) + return false; + }; + }; + + return true; +}; + +fn hm_val_list(hm: hashmap) list = { + const length = len(hm.data); + const new = make_list(length); + + for(let i: size = 0; i < length; i += 1){ + new.data[i] = hm.data[i].val; + }; + + return new; +}; + +fn hm_key_list(hm: hashmap) list = { + const length = len(hm.data); + const new = make_list(length); + + for(let i: size = 0; i < length; i += 1){ + new.data[i] = hm.data[i].key; + }; + return new; +}; + +export fn eval_hash( + hm: hashmap, + eval: *fn(MalType, *env) (MalType | error), + env: *env, +) (hashmap | error) = { + + const new = hm_init(); + + for(let e .. hm.data){ + hm_add(new, e.key, eval(e.val, env)?); + }; + + return new; +}; diff --git a/impls/hare/mal/printer.ha b/impls/hare/mal/printer.ha new file mode 100644 index 0000000000..659e0ff5fc --- /dev/null +++ b/impls/hare/mal/printer.ha @@ -0,0 +1,119 @@ +use io; +use memio; +use fmt; +use strings; + +export fn print_form( + strbuf: io::handle, + form: (MalType | []MalType), + print_readably: bool = true +) void = { + + match(form){ + case let l: list => + print_list(strbuf, l.data, list_beg, print_readably); + case let v: vector => + print_list(strbuf, v.data, vec_beg, print_readably); + case let c: []MalType => + print_list(strbuf, c, list_beg, print_readably); + case let h: hashmap => + print_hash(strbuf, h, print_readably); + case let s: string => + print_string(strbuf, s, print_readably); + case nil => + memio::concat(strbuf, "nil")!; + case let b: bool => + fmt::fprint(strbuf, b)!; + case let s: symbol => + memio::concat(strbuf, s: str)!; + case let i: number => + fmt::fprint(strbuf, i: int)!; + case let a: atom => + print_list(strbuf, ["atom": symbol, *a], + list_beg, print_readably); + case let func: (intrinsic | function) => + memio::concat(strbuf, "#")!; + case => void; + }; +}; + +fn print_string( + strbuf: io::handle, + s: string, + print_readable: bool +) void = { + + let runes = strings::torunes(s.data)!; + + + if(!print_readable){ + memio::concat(strbuf, s.data)!; + } else { + memio::appendrune(strbuf, '"')!; + for(let rn .. runes){ + let ret = switch (rn) { + case '"' => + yield "\\\""; + case '\\' => + yield "\\\\"; + case '\b' => + yield "\\b"; + case '\f' => + yield "\\f"; + case '\n' => + yield "\\n"; + case '\r' => + yield "\\r"; + case '\t' => + yield "\\t"; + case => + yield rn; + }; + + match(ret) { + case let rn: rune => + memio::appendrune(strbuf, rn)!; + case let rn: str => + memio::concat(strbuf, rn)!; + }; + }; + memio::appendrune(strbuf, '"')!; + }; + +}; + +fn print_hash(strbuf: io::handle, hm: hashmap, pp: bool) void ={ + + const open = '{'; + const close = '}'; + + fmt::fprint(strbuf, open)!; + hm_print(strbuf, hm, pp); + fmt::fprint(strbuf, close)!; +}; + + +fn print_list( + strbuf: io::handle, + ls: []MalType, + t: coll_beg, + pp: bool +) void = { + + let open = '('; + let close = ')'; + + if(t is vec_beg){ + open = '['; + close = ']'; + }; + + memio::appendrune(strbuf, open)!; + for(let i: size = 0; i < len(ls); i += 1) { + let form = print_form(strbuf, ls[i], pp); + if(!(i == len(ls)-1)){ + fmt::fprint(strbuf, " ")!; + }; + }; + memio::appendrune(strbuf, close)!; +}; diff --git a/impls/hare/mal/reader.ha b/impls/hare/mal/reader.ha new file mode 100644 index 0000000000..dddceddcd3 --- /dev/null +++ b/impls/hare/mal/reader.ha @@ -0,0 +1,219 @@ +use io; +use fmt; +use memio; +use strings; + +export fn read_str(input: []u8) (MalType | error | io::EOF) = { + + const tk: tokenizer = tokenizer_init(input); + + match(read_form(&tk)?){ + case let res: MalType => + return res; + case let e: coll_end => + return unbalanced; + case let res: io::EOF => + return io::EOF; + }; + +}; + +fn read_form(tk: *tokenizer) (...MalType | ...coll_end | io::EOF | error) = { + for(true){ + match(tokenizer_next(tk)?) { + case let t: coll_beg => + return read_collection(tk, t); + case let t: coll_end => + return t; + case let s: str => + return read_string(s); + case let c: comment => void; + case let a: word => + return read_symbol(a); + case let q: quote_tk => + return read_quote(tk, q); + case let m: mal_meta => + return read_meta(tk); + case let i: int => + return i: number; + case io::EOF => + return io::EOF; + }; + }; +}; + +fn read_meta(tk: *tokenizer) (list | error) = { + + let res: []MalType = []; + defer free(res); + + const meta = match(read_form(tk)?){ + case let l: MalType => + yield l; + case coll_end => + return unbalanced; + case io::EOF => + return unexpected_eof; + }; + + const next_form = match(read_form(tk)?){ + case let l: MalType => + yield l; + case coll_end => + return unbalanced; + case io::EOF => + return unexpected_eof; + }; + + return make_list(3, ["with-meta": symbol, next_form, meta]); +}; + +fn read_quote(tk: *tokenizer, t: quote_tk) (list | error) = { + + const qs: symbol = match(t){ + case quote => + yield "quote"; + case unquote => + yield "unquote"; + case quasiquote => + yield "quasiquote"; + case unquote_splice => + yield "splice-unquote"; + case at => + yield "deref"; + }; + + const form: MalType = match(read_form(tk)?){ + case let l: MalType => + yield l; + case coll_end => + return unbalanced; + case io::EOF => + return unexpected_eof; + }; + + return make_list(2, [qs: symbol, form]); + +}; + +fn read_hashmap(tk: *tokenizer) (hashmap | error) = { + + const res = hm_init(); + + for(true){ + let key = match(read_form(tk)?){ + case hash_end => + break; + case let key: (string | symbol) => + yield key; + case io::EOF => + return unexpected_eof; + }; + + + let val = match(read_form(tk)?){ + case hash_end => + return unbalanced; + case let form: MalType => + yield form; + case io::EOF => + return unexpected_eof; + }; + + let d = hm_add(res, key, val); + }; + + return res; +}; + +fn read_collection( + tk: *tokenizer, + t: coll_beg +) (hashmap | list | vector | error) = { + + if(t is hash_beg){ + return read_hashmap(tk); + }; + + let res: []MalType = []; + defer free(res); + + for(true){ + match(read_form(tk)?){ + case list_end => + if(!(t is list_beg)){ + return unbalanced; + }; + return make_list(len(res), res); + case vec_end => + if(!(t is vec_beg)){ + return unbalanced; + }; + return make_vec(len(res), res); + case hash_end => + return unbalanced; + case let form: MalType => + append(res, form)!; + continue; + case io::EOF => + return unexpected_eof; + }; + }; +}; + +//todo: keywords as a distinct type +fn read_symbol(s: word) MalType = { + switch(s){ + case "true" => + return true; + case "false" => + return false; + case "nil" => + return nil; + case => + return make_symbol(s); + }; + +}; + +fn read_string(s: str) (string | error) = { + + let strbuf = memio::dynamic(); + defer io::close(&strbuf)!; + let runes = strings::torunes(s)!; + + for (let i: size = 0; i < len(runes); i += 1) { + let rn = switch (runes[i]) { + case '\\' => + i += 1; + yield scan_escape(runes[i]); + case => + yield runes[i]; + }; + memio::appendrune(&strbuf, rn)!; + }; + + let s: str = memio::string(&strbuf)!; + return make_string(s); +}; + +fn scan_escape(rn: rune) rune = { + switch (rn) { + case '\"' => + return '\"'; + case '\\' => + return '\\'; + case 'b' => + return '\b'; + case 'f' => + return '\f'; + case 'n' => + return '\n'; + case 'r' => + return '\r'; + case 't' => + return '\t'; + case => + return rn; + }; +}; diff --git a/impls/hare/mal/tokenizer.ha b/impls/hare/mal/tokenizer.ha new file mode 100644 index 0000000000..84748deb9c --- /dev/null +++ b/impls/hare/mal/tokenizer.ha @@ -0,0 +1,312 @@ +use fmt; +use io; +use strings; +use strconv; +use ascii; + +type undefined = !void; + +type comment = str; + +type list_beg = void; +type vec_beg = void; +type hash_beg = void; +type coll_beg = (list_beg | vec_beg | hash_beg); + +type list_end = void; +type vec_end = void; +type hash_end = void; +type coll_end = (list_end | vec_end | hash_end); + +type mal_meta = void; + +type at = void; +type unquote = void; +type unquote_splice = void; +type quote = void; +type quasiquote = void; +type quote_tk = ( unquote_splice | unquote | quote | quasiquote | at); + +type word = str; + +type token = (int | str | io::EOF | undefined | ...coll_beg | mal_meta | + ...quote_tk | vec_beg | ...coll_end | comment | word); + +type tokenizer = struct { + buffer: []u8, + un: (token | void), + rb: (rune | void), + cursor: size, + loc: size, + prev_rn: size, + prev_t: size, + next_t: size, +}; + +fn tokenizer_init(input: []u8) tokenizer = { + return tokenizer { + buffer = input, + un = void, + rb = void, + cursor = 0, + ... + }; +}; + +fn unget_rune(tk: *tokenizer, rn: rune) void = { + assert(tk.rb is void); + tk.rb = rn; + tk.loc = tk.prev_rn; +}; + +fn unget_token(tk: *tokenizer, tok: token) void = { + assert(tk.un is void); + tk.un = tok; + tk.next_t = tk.loc; + tk.loc = tk.prev_t; +}; + +fn nextrune(tk: *tokenizer) (rune | io::EOF) = { + + if(tk.rb is rune){ + const rn = tk.rb as rune; + tk.rb = void; + tk.prev_rn = tk.loc; + tk.loc += 1; + return rn; + }; + + if (tk.cursor >= len(tk.buffer)) { + return io::EOF; + }; + + let rn: rune = tk.buffer[tk.cursor]: rune; + + tk.prev_rn = tk.loc; + tk.loc = tk.cursor; + tk.cursor += 1; + + return rn; +}; + +fn iswhitespace(rn: rune) bool = { + if(ascii::isspace(rn) || rn == ','){ + return true; + }; + return false; +}; + +fn nextrunews(tk: *tokenizer) (rune | io::EOF ) = { + + for (true) { + match (nextrune(tk)) { + case let rn: rune => + if (iswhitespace(rn)) { + continue; + }; + return rn; + case io::EOF => + return io::EOF; + }; + }; +}; + +fn scan_string(tk: *tokenizer) (token | error) = { + + const start = tk.cursor; + let esc: bool = false; + + for(true){ + const rn = match(nextrune(tk)) { + case let rn: rune => + yield rn; + case io::EOF => + return unexpected_eof; + }; + + switch(rn){ + case '\\' => + esc = !esc; + continue; + case '"' => + if(esc){ + esc = false; + continue; + } else { + break; + }; + case => + esc = false; + continue; + }; + }; + + return strings::fromutf8(tk.buffer[start .. tk.loc])!; +}; + +fn scan_comment(tk: *tokenizer) comment = { + + const start = tk.loc; + let end = start; + + for(true){ + const rn = match(nextrune(tk)){ + case let rn: rune => + yield rn; + case io::EOF => + end = tk.cursor; + break; + }; + switch(rn){ + case '\n' => + end = tk.loc; + break; + case => continue; + }; + + }; + + return (strings::fromutf8(tk.buffer[start .. end])!); + +}; + +fn tokenizer_next(tk: *tokenizer) (token | error) = { + + match(tk.un){ + case let tok: token => + tk.un = void; + tk.prev_t = tk.loc; + tk.loc = tk.next_t; + return tok; + case void => + tk.prev_t = tk.loc; + }; + + const rn = match(nextrunews(tk)) { + case let rn: rune => + yield rn; + case io::EOF => + return io::EOF; + }; + + switch (rn) { + case '(' => return list_beg; + case ')' => return list_end; + case '[' => return vec_beg; + case ']' => return vec_end; + case '{' => return hash_beg; + case '}' => return hash_end; + case '"' => return scan_string(tk); + case ';' => return scan_comment(tk); + case '^' => return mal_meta; + case '\'' => return quote; + case '`' => return quasiquote; + case '~' => return scan_quote(tk); + case '@' => return at; + case => return scan_atom(tk, rn); + }; +}; + +fn scan_atom(tk: *tokenizer, rn: rune) (token | error) = { + + if (rn == '-') { + let nrn = match(nextrune(tk)){ + case io::EOF => + yield 'n'; + case let nrn: rune => + unget_rune(tk, nrn); + yield nrn; + }; + + if(ascii::isdigit(nrn)){ + return scan_number(tk); + }; + } else + if(ascii::isdigit(rn)){ + return scan_number(tk); + }; + + return scan_word(tk)!; +}; + +fn scan_number(tk: *tokenizer) (token | error) = { + + const start = tk.loc; + let end: size = start; + + for(true){ + const rn = match(nextrune(tk)){ + case io::EOF => + end = tk.cursor; + break; + case let rn: rune => + yield rn; + }; + + if(!ascii::isdigit(rn)){ + end = tk.loc; + unget_rune(tk, rn); + break; + }; + + }; + + return strconv::stoi(strings::fromutf8(tk.buffer[start .. end])!)!; +}; + +fn scan_word(tk: *tokenizer) (token | error) = { + + const start = tk.loc; + let end: size = start; + + for(true){ + const rn = match(nextrune(tk)){ + case io::EOF => + end = tk.cursor; + break; + case let rn: rune => + yield rn; + }; + + if(!iswordrn(rn)){ + end = tk.loc; + unget_rune(tk, rn); + break; + }; + + }; + + return strings::fromutf8(tk.buffer[start .. end])!: word; +}; + +fn iswordrn(rn: rune) bool = { + if(ascii::isalnum(rn)){ + return true; + }; + + switch(rn){ + case '-' => return true; + case '_' => return true; + case '?' => return true; + case '!' => return true; + case '>' => return true; + case '=' => return true; + case '<' => return true; + case '*' => return true; + case '/' => return true; + case ':' => return true; + case => void; + }; + + return false; +}; + +fn scan_quote(tk: *tokenizer) (token | error) = { + match(tokenizer_next(tk)?){ + case at => + return unquote_splice; + case let res: token => + unget_token(tk, res); + return unquote; + }; +}; diff --git a/impls/hare/mal/types.ha b/impls/hare/mal/types.ha new file mode 100644 index 0000000000..63e3fc3b90 --- /dev/null +++ b/impls/hare/mal/types.ha @@ -0,0 +1,186 @@ +use strings; +use types; + +export type nil = void; +export type symbol = str; +export type number = i64; +export type atom = *MalType; + +export type vector = *struct { + data: []MalType, + meta: MalType, +}; + +export type list = *struct { + data: []MalType, + meta: MalType, +}; + +export type string = *struct { + data: str, + meta: MalType, +}; + +export type intrinsic = *struct { + eval: *fn([]MalType) (MalType | error), + meta: MalType, +}; + +export type function = *struct { + eval: *fn(MalType, *env) (MalType | error), + envi: *env, + args: []MalType, + body: MalType, + meta: MalType, +}; + +export type macro = function; + +export type MalType = (macro | function | intrinsic | atom | bool | + string | hashmap | list | vector | number | symbol | nil); + +// Any mal object that is supposed to persist should be created by one of these +// functions. Any allocations done by other functions should be freed manually. +// +// Envs & Hashmaps are treated separately in their implementation files. + +export fn make_intrinsic( + func: *fn([]MalType) (MalType | error), +) intrinsic = { + + const new = alloc(struct { + eval: *fn([]MalType) (MalType | error) = func, + meta: MalType = nil, + })!; + + append(gc.memory.intrinsics, new)!; + return new; +}; + +export fn make_func( + eval: *fn(MalType, *env) (MalType | error), + envi: *env, + args: []MalType, + body: MalType, +) function = { + + let arg_list: []MalType = []; + if(len(args) > 0) { + arg_list = alloc([nil...], len(args))!; + arg_list[0..] = args; + }; + + const new = alloc(struct{ + eval: *fn(MalType, *env) (MalType | error) = eval, + envi: *env= envi, + args: []MalType = arg_list, + body: MalType = body, + meta: MalType = nil })!; + + append(gc.memory.funcs, new)!; + return new; +}; + +fn free_func(f: function) void = { + free(f.args); + free(f); +}; + +export fn make_list(s: size, init: []MalType = []) list = { + + const new: list = alloc(struct { + data: []MalType = [], + meta: MalType = nil, + })!; + + if (s == 0) return new; + + new.data = alloc([nil...], s)!; + new.data[0..len(init)] = init; + + append(gc.memory.lists, new)!; + return new; +}; + +fn free_list(l: list) void = { + free(l.data); + free(l); +}; + +export fn make_vec(s: size, init: []MalType = []) vector = { + + const new: vector = alloc(struct { + data: []MalType = [], + meta: MalType = nil, + })!; + + if (s == 0) return new; + + new.data = alloc([nil...], s)!; + new.data[0..len(init)] = init; + + append(gc.memory.vecs, new)!; + return new; +}; + +fn free_vec(v: vector) void = { + free(v.data); + free(v); +}; + +export fn make_symbol(name: str) symbol = { + + let hm: hashmap = match(gc.memory.symbols){ + case void => + gc.memory.symbols = hm_init(false); + yield gc.memory.symbols: hashmap; + case let hm: hashmap => + yield hm; + }; + + match(hm_get(hm, name: symbol)) { + case undefined_key => void; + case let s: symbol => + return s; + }; + + const new = strings::dup(name)!: symbol; + hm_add(gc.memory.symbols: hashmap, new, new); + + return new; +}; + +export fn make_string(s: str) string = { + + const new_str = strings::dup(s)!; + + const new = alloc(struct { + data: str = new_str, + meta: MalType = nil, + })!; + + append(gc.memory.strings, new)!; + return new; +}; + +fn free_string(s: string) void = { + free(s.data); + free(s); +}; + +export fn make_atom(ref: MalType) atom = { + + const new = alloc(ref)!; + append(gc.memory.atoms, new)!; + return new; +}; + +// check if two strings share the same buffer in memory +// Does not check for substrings! +fn str_memeq(s1: str, s2: str) bool = { + + const ts1 = &s1: *types::string; + const ts2 = &s2: *types::string; + + return ts1.data == ts2.data; +}; diff --git a/impls/hare/run b/impls/hare/run new file mode 100755 index 0000000000..373d352735 --- /dev/null +++ b/impls/hare/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" \ No newline at end of file diff --git a/impls/hare/step0_repl.ha b/impls/hare/step0_repl.ha new file mode 100644 index 0000000000..6bb71a4028 --- /dev/null +++ b/impls/hare/step0_repl.ha @@ -0,0 +1,42 @@ +use bufio; +use fmt; +use io; +use os; +use strings; + +fn read (input: []u8) []u8 = { + return input; +}; + +fn eval (input: []u8) []u8 = { + return input; +}; + +fn print (input: []u8) str = { + return strings::fromutf8(input)!; +}; + +fn rep (input: []u8) str = { + return print(eval(read(input))); +}; + +export fn main() void = { + + for(true){ + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + defer free(input); + + fmt::println(rep(input))!; + }; + +}; diff --git a/impls/hare/step1_read_print.ha b/impls/hare/step1_read_print.ha new file mode 100644 index 0000000000..c4a11f46e7 --- /dev/null +++ b/impls/hare/step1_read_print.ha @@ -0,0 +1,52 @@ +use bufio; +use fmt; +use io; +use mal; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input)?; +}; + +fn eval (input: mal::MalType) mal::MalType = { + return input; +}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; +}; + +fn rep (input: []u8) void = { + match (read(input)){ + case let e: mal::error => + mal::format_error(os::stderr, e); + case let form: mal::MalType => + print(eval(form)); + case io::EOF => + return void; + }; +}; + +export fn main() void = { + + for(true){ + + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + defer free(input); + rep(input); + }; + +}; diff --git a/impls/hare/step2_eval.ha b/impls/hare/step2_eval.ha new file mode 100644 index 0000000000..9641acba9e --- /dev/null +++ b/impls/hare/step2_eval.ha @@ -0,0 +1,122 @@ +use bufio; +use fmt; +use io; +use mal; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input)?; +}; + +fn eval_list(ls: mal::list, env: mal::hashmap) mal::MalType = { + + if(len(ls.data) == 0) return ls; + + const func = match(eval(ls.data[0], env)){ + case let func: mal::intrinsic => + yield func; + case => return ls; + }; + + for(let i: size = 1; i < len(ls.data); i += 1){ + ls.data[i] = eval(ls.data[i], env); + }; + + return func.eval(ls.data[1..])!; +}; + + +fn eval_vec(vec: mal::vector, env: mal::hashmap) mal::vector ={ + + if(len(vec.data) == 0) return vec; + + for(let i: size = 0; i < len(vec.data); i += 1){ + vec.data[i] = eval(vec.data[i], env); + }; + return vec; +}; + +fn eval_hash( + map: mal::hashmap, + env: mal::hashmap, +) mal::hashmap = { + + let res = mal::hm_init(); + + for(let e .. map.data) { + mal::hm_add(res, e.key, eval(e.val, env)); + }; + + return res; +}; + +fn eval (ast: mal::MalType, env: mal::hashmap) mal::MalType = { + + let res: mal::MalType = match(ast){ + case let key: mal::symbol => + let v: mal::MalType = match(mal::hm_get(env, key)){ + case let v: mal::MalType => + yield v; + case => + yield mal::nil; + }; + yield eval(v, env); + case let ls: mal::list => + yield eval_list(ls, env); + case let vec: mal::vector => + yield eval_vec(vec, env); + case let hash: mal::hashmap => + yield eval_hash(hash, env); + case let func: mal::intrinsic => + yield func; + case => + yield ast; + }; + + return res; +}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; +}; + +fn rep (input: []u8, env: mal::hashmap) void = { + match (read(input)){ + case let e: mal::error => + mal::format_error(os::stderr, e); + case let form: mal::MalType => + print(eval(form, env)); + case io::EOF => + return void; + }; +}; + +export fn main() void = { + + const env = mal::hm_init(); + + mal::hm_add(env, "+": mal::symbol, mal::make_intrinsic(&mal::plus)); + mal::hm_add(env, "-": mal::symbol, mal::make_intrinsic(&mal::minus)); + mal::hm_add(env, "*": mal::symbol, mal::make_intrinsic(&mal::mult)); + mal::hm_add(env, "/": mal::symbol, mal::make_intrinsic(&mal::div)); + + for(true){ + + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + defer free(input); + rep(input, env); + }; +}; diff --git a/impls/hare/step3_env.ha b/impls/hare/step3_env.ha new file mode 100644 index 0000000000..2315ef6491 --- /dev/null +++ b/impls/hare/step3_env.ha @@ -0,0 +1,171 @@ +use bufio; +use fmt; +use io; +use mal; +use os; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input)?; +}; + +fn eval_let( + env: *mal::env, + bindings: []mal::MalType, + body: mal::MalType... +) (mal::MalType | mal::error) = { + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + mal::env_set(let_env, bindings[i] as mal::symbol, + eval(bindings[i+1], let_env)?); + }; + + let result: mal::MalType = mal::nil; + for(let form .. body){ + result = eval(form, let_env)?; + }; + return result; +}; + +fn eval_list(ls: mal::list, env: *mal::env) (mal::MalType | mal::error) = { + + if(len(ls.data) == 0) return ls; + + // handle special cases of 'let*' and 'def!' forms + match(ls.data[0]){ + case let sym: mal::symbol => + if(sym == "def!"){ + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + mal::env_set(env, ls.data[1] as mal::symbol, val); + return val; + + } else if(sym == "let*"){ + if(len(ls.data) < 3) + return ("let*: too few arguments", + ls): mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + return eval_let(env, bindings, ls.data[2..]...); + }; + case => void; + }; + + const func = match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + yield func; + case => return ls; + }; + + for(let i: size = 1; i < len(ls.data); i += 1){ + ls.data[i] = eval(ls.data[i], env)?; + }; + + return func.eval(ls.data[1..]); +}; + + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + let res: mal::vector = mal::make_vec(len(vec.data)); + + if(len(vec.data) == 0) return vec; + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i], env)?; + }; + return res; +}; + +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => + void; + case mal::nil => + void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + + let res: mal::MalType = match(ast){ + case let key: mal::symbol => + yield eval(mal::env_get(env, key)?, env)?; + case let ls: mal::list => + yield eval_list(ls, env)?; + case let vec: mal::vector => + yield eval_vec(vec, env)?; + case let hash: mal::hashmap => + yield mal::eval_hash(hash, &eval, env)?; + case let func: mal::intrinsic => + yield func; + case => yield ast; + }; + + return res; +}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; +}; + +fn rep (input: []u8, env: *mal::env) void = { + let ast = match (read(input)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + print(result); +}; + +export fn main() void = { + + const env = mal::env_init(); + + mal::env_set(env, "nil":mal::symbol, mal::nil); + mal::load_namespace(mal::core, env)!; + + for(true){ + + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + defer free(input); + rep(input, env); + }; +}; diff --git a/impls/hare/step4_if_fn_do.ha b/impls/hare/step4_if_fn_do.ha new file mode 100644 index 0000000000..afd26823fd --- /dev/null +++ b/impls/hare/step4_if_fn_do.ha @@ -0,0 +1,225 @@ +use bufio; +use fmt; +use io; +use mal; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input); +}; + +fn eval_let( + env: *mal::env, + bindings: []mal::MalType, + body: mal::MalType... +) (mal::MalType | mal::error) = { + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + mal::env_set(let_env, bindings[i] as mal::symbol, + eval(bindings[i+1], let_env)?); + }; + + let result: mal::MalType = mal::nil; + for(let form .. body){ + result = eval(form, let_env)?; + }; + return result; +}; + +fn eval_list(ls: mal::list, env: *mal::env) (mal::MalType | mal::error) = { + + if(len(ls.data) == 0) return ls; + + // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms + match(ls.data[0]){ + case let sym: mal::symbol => + switch(sym){ + case "def!" => + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + mal::env_set(env, ls.data[1] as mal::symbol, val); + return val; + + case "let*" => + if(len(ls.data) < 3) + return ("let*: too few arguments", + ls): mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + return eval_let(env, bindings, ls.data[2..]...); + case "do" => + let result: mal::MalType = mal::nil; + for(let form .. ls.data[1..]){ + result = eval(form, env)?; + }; + return result; + case "if" => + if(len(ls.data) > 4 || len(ls.data) < 3) + return ("if expects 2 or 3 arguments", + ls): mal::syntax_error; + match(eval(ls.data[1], env)?){ + case mal::nil => + if(len(ls.data) == 4){ + return eval(ls.data[3], env); + } else { + return mal::nil; + }; + case let b: bool => + if(b){ + return eval(ls.data[2], env); + } else if(len(ls.data) == 4){ + return eval(ls.data[3], env); + } else { + return mal::nil; + }; + case => + return eval(ls.data[2], env); + }; + case "fn*" => + let args = match(ls.data[1]){ + case let a: mal::list => + yield a.data; + case let a: mal::vector => + yield a.data; + }; + let body = match(ls.data[2]){ + case let b: mal::MalType => + yield b; + case => return mal::nil; + }; + return mal::make_func(&eval, env, args, body); + case => void; + }; + case => void; + }; + + + match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + let args: []mal::MalType = []; + defer free(args); + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + return func.eval(args); + case let func: mal::function => + let args: []mal::MalType = []; + defer free(args); + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + let local = mal::env_init(func.envi); + mal::env_bind(local, func.args, args); + return eval(func.body, local); + case => return ls; + }; +}; + + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + if(len(vec.data) == 0) return vec; + let res: mal::vector = mal::make_vec(len(vec.data)); + + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i],env)?; + }; + return res; +}; + +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => void; + case mal::nil => void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + let res: mal::MalType = match(ast){ + case let key: mal::symbol => + yield if(strings::hasprefix(key, ':')){ + yield key; + } else { + yield mal::env_get(env, key)?; + }; + case let ls: mal::list => + yield eval_list(ls, env)?; + case let vec: mal::vector => + yield eval_vec(vec, env)?; + case let hash: mal::hashmap => + yield mal::eval_hash(hash, &eval, env)?; + case let func: mal::intrinsic => + yield func; + case let func: mal::function => + yield func; + case => yield ast; + }; + + return res; +}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; +}; + +fn rep (input: []u8, env: *mal::env) void = { + let ast = match(read(input)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + print(result); +}; + +export fn main() void = { + + const env = mal::env_init(); + mal::load_namespace(mal::core, env)!; + + for(true){ + + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + defer free(input); + rep(input, env); + }; +}; diff --git a/impls/hare/step5_tco.ha b/impls/hare/step5_tco.ha new file mode 100644 index 0000000000..4d4aa3e677 --- /dev/null +++ b/impls/hare/step5_tco.ha @@ -0,0 +1,217 @@ +use bufio; +use fmt; +use io; +use mal; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input); +}; + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + if(len(vec.data) == 0) return vec; + let res: mal::vector = mal::make_vec(len(vec.data)); + + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i], env)?; + }; + return res; +}; + +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + +for(true){ + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => void; + case mal::nil => void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + + let ls: mal::list = match(ast){ + case let key: mal::symbol => + if(strings::hasprefix(key, ':')){ + return key; + } else { + return mal::env_get(env, key)?; + }; + case let vec: mal::vector => + return eval_vec(vec, env)?; + case let hash: mal::hashmap => + return mal::eval_hash(hash, &eval, env)?; + case let ls: mal::list => + yield ls; + case => + return ast; + }; + + if(len(ls.data) == 0) return ast; + + // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms + match(ls.data[0]){ + + case let sym: mal::symbol => + + switch(sym){ + case "def!" => + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + mal::env_set(env, ls.data[1] as mal::symbol, val); + return val; + + case "let*" => + if(len(ls.data) != 3) + return ("let*: too few arguments", + ls): mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + mal::env_set(let_env, bindings[i] as mal::symbol, + eval(bindings[i+1], let_env)?); + }; + + env = let_env; + ast = ls.data[2]; + continue; + case "do" => + let result: mal::MalType = mal::nil; + for(let form .. ls.data[1..len(ls.data)-1]){ + result = eval(form, env)?; + }; + ast = ls.data[len(ls.data)-1]; + continue; + case "if" => + if(len(ls.data) > 4 || len(ls.data) < 3) + return ("if expects 2 or 3 arguments", + ls): mal::syntax_error; + match(eval(ls.data[1], env)?){ + case mal::nil => + if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case let b: bool => + if(b){ + ast = ls.data[2]; + continue; + } else if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case => + ast = ls.data[2]; + continue; + }; + case "fn*" => + let args = match(ls.data[1]){ + case let a: mal::list => + yield a.data; + case let a: mal::vector => + yield a.data; + }; + let body = match(ls.data[2]){ + case let b: mal::MalType => + yield b; + case => return mal::nil; + }; + return mal::make_func(&eval, env, args, body); + case => void; + }; + case => void; + }; + + + match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + let args: []mal::MalType = []; + defer free(args); + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + return func.eval(args); + case let func: mal::function => + let args: []mal::MalType = []; + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + ast = func.body; + free(args); + continue; + case => return ("not a function:", ls.data[0]): mal::syntax_error; + }; +};}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; +}; + +fn rep (input: []u8, env: *mal::env) void = { + let ast = match(read(input)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + print(result); +}; + +export fn main() void = { + + const env = mal::env_init(); + mal::load_namespace(mal::core, env)!; + + for(true){ + + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + defer free(input); + rep(input, env); + }; +}; diff --git a/impls/hare/step6_file.ha b/impls/hare/step6_file.ha new file mode 100644 index 0000000000..c51551ced5 --- /dev/null +++ b/impls/hare/step6_file.ha @@ -0,0 +1,270 @@ +use bufio; +use fmt; +use io; +use mal; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input); +}; + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + if(len(vec.data) == 0) return vec; + let res: mal::vector = mal::make_vec(len(vec.data)); + + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i], env)?; + }; + return res; +}; + +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + +for(true){ + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => void; + case mal::nil => void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + + let ls: mal::list = match(ast){ + case let key: mal::symbol => + if(strings::hasprefix(key, ':')){ + return key; + } else { + return mal::env_get(env, key)?; + }; + case let vec: mal::vector => + return eval_vec(vec, env)?; + case let hash: mal::hashmap => + return mal::eval_hash(hash, &eval, env)?; + case let ls: mal::list => + yield ls; + case => + return ast; + }; + + if(len(ls.data) == 0) return ast; + + // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms + match(ls.data[0]){ + + case let sym: mal::symbol => + + switch(sym){ + case "def!" => + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + mal::env_set(env, ls.data[1] as mal::symbol, val); + return val; + + case "let*" => + if(len(ls.data) != 3) + return ("let*: too few arguments", + ls): mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + mal::env_set(let_env, bindings[i] as mal::symbol, + eval(bindings[i+1], let_env)?); + }; + + env = let_env; + ast = ls.data[2]; + continue; + case "do" => + let result: mal::MalType = mal::nil; + for(let form .. ls.data[1..len(ls.data)-1]){ + result = eval(form, env)?; + }; + ast = ls.data[len(ls.data)-1]; + continue; + case "if" => + if(len(ls.data) > 4 || len(ls.data) < 3) + return ("if expects 2 or 3 arguments", + ls): mal::syntax_error; + match(eval(ls.data[1], env)?){ + case mal::nil => + if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case let b: bool => + if(b){ + ast = ls.data[2]; + continue; + } else if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case => + ast = ls.data[2]; + continue; + }; + case "fn*" => + let args = match(ls.data[1]){ + case let a: mal::list => + yield a.data; + case let a: mal::vector => + yield a.data; + }; + let body = match(ls.data[2]){ + case let b: mal::MalType => + yield b; + case => return mal::nil; + }; + return mal::make_func(&eval, env, args, body); + case => void; + }; + case => void; + }; + + + match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + let args: []mal::MalType = []; + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + return func.eval(args); + case let func: mal::function => + let args: []mal::MalType = []; + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + ast = func.body; + continue; + case => return ("not a function:", ls.data[0]): mal::syntax_error; + }; +};}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; + }; + +fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { + let ast = match(read(input)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + if(printp) print(result); +}; + + +let repl_env: nullable *mal::env = null; + +fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { + + if(len(args) < 1) + return ("'do_eval': too few arguments", args): + mal::syntax_error; + + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + return mal::not_implemented; + }; + return eval(args[0], env); +}; + +export fn main() void = { + + repl_env = mal::env_init(); + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + fmt::fatal("No repl environment initialized!"); + }; + + mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); + mal::load_namespace(mal::core, env)!; + let load_file = "(def! load-file (fn* (f) (eval (read-string + (str \"(do \" (slurp f) \"\nnil)\")))))"; + + rep(strings::toutf8(load_file), env, false); + + const args = os::args; + + let argvlen: size = if (len(args) > 2) { + yield len(args)-2; + } else { + yield 0; + }; + + let argv = mal::make_list(argvlen); + + if (len(args) > 2){ + for(let i: size = 2; i < len(args); i += 1){ + argv.data[i-2] = &args[i]: mal::string; + }; + }; + + mal::env_set(env, "*ARGV*", argv); + + if(len(args) > 1){ + let exec_str = strings::join("", "(load-file \"", args[1], + "\")")!; + rep(strings::toutf8(exec_str), env, false); + free(exec_str); + os::exit(0); + }; + + for(true){ + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + rep(input, env); + free(input); + }; +}; diff --git a/impls/hare/step7_quote.ha b/impls/hare/step7_quote.ha new file mode 100644 index 0000000000..01ab2481b2 --- /dev/null +++ b/impls/hare/step7_quote.ha @@ -0,0 +1,340 @@ +use bufio; +use fmt; +use io; +use mal; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input); +}; + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + if(len(vec.data) == 0) return vec; + let res: mal::vector = mal::make_vec(len(vec.data)); + + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i], env)?; + }; + return res; +}; + +fn starts_with(ast: mal::MalType, sym: str) bool = { + match(ast){ + case let ls: mal::list=> + if(len(ls.data) < 1) return false; + match(ls.data[0]){ + case let s: mal::symbol => + return s == sym; + case => + return false; + }; + case => + return false; + }; +}; + +fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { + + let acc = mal::make_list(0); + + for(let i: size = len(ast); 0 < i ; i -= 1){ + + let elt: mal::MalType = ast[i - 1]; + + if(starts_with(elt, "splice-unquote")){ + let elt: mal::list = match(elt){ + case let l: mal::list => + yield l; + case => + return ("list", ast): mal::type_error; + }; + + acc = mal::make_list(3, ["concat":mal::symbol, + elt.data[1], acc]); + } else { + acc = mal::make_list(3, ["cons":mal::symbol, + quasiquote(elt)?, acc]); + }; + }; + + return acc; +}; + +fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { + match(ast) { + case let ls: mal::list => + if(starts_with(ls, "unquote")) { + return ls.data[1]; + } else { + return qq_iter(ls.data); + }; + case let ls: mal::vector => + let res: mal::list = mal::make_list(2, ["vec":mal::symbol, + qq_iter(ls.data)?]); + return res; + case let hm: (mal::symbol | mal::hashmap) => + let res: mal::list = mal::make_list(2, ["quote":mal::symbol, + ast]); + return res; + case => + return ast; + }; +}; +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + +for(true){ + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => void; + case mal::nil => void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + + let ls: mal::list = match(ast){ + case let key: mal::symbol => + if(strings::hasprefix(key, ':')){ + return key; + } else { + return mal::env_get(env, key)?; + }; + case let vec: mal::vector => + return eval_vec(vec, env)?; + case let hash: mal::hashmap => + return mal::eval_hash(hash, &eval, env)?; + case let ls: mal::list => + yield ls; + case => + return ast; + }; + + if(len(ls.data) == 0) return ast; + + // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms + match(ls.data[0]){ + + case let sym: mal::symbol => + + switch(sym){ + case "quasiquote" => + ast = quasiquote(ls.data[1])?; + continue; + case "quote" => + return ls.data[1]; + case "def!" => + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + mal::env_set(env, ls.data[1] as mal::symbol, val); + return val; + + case "let*" => + if(len(ls.data) != 3) + return ("let*: too few arguments", + ls): mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + mal::env_set(let_env, bindings[i] as mal::symbol, + eval(bindings[i+1], let_env)?); + }; + + env = let_env; + ast = ls.data[2]; + continue; + case "do" => + let result: mal::MalType = mal::nil; + for(let form .. ls.data[1..len(ls.data)-1]){ + result = eval(form, env)?; + }; + ast = ls.data[len(ls.data)-1]; + continue; + case "if" => + if(len(ls.data) > 4 || len(ls.data) < 3) + return ("if expects 2 or 3 arguments", + ls): mal::syntax_error; + match(eval(ls.data[1], env)?){ + case mal::nil => + if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case let b: bool => + if(b){ + ast = ls.data[2]; + continue; + } else if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case => + ast = ls.data[2]; + continue; + }; + case "fn*" => + let args = match(ls.data[1]){ + case let a: mal::vector => + yield a.data; + case let a: mal::list => + yield a.data; + }; + let body = match(ls.data[2]){ + case let b: mal::MalType => + yield b; + case => return mal::nil; + }; + return mal::make_func(&eval, env, args, body); + case => void; + }; + case => void; + }; + + + match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + let args: []mal::MalType = []; + defer free(args); + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + return func.eval(args); + case let func: mal::function => + let args: []mal::MalType = []; + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + free(args); + ast = func.body; + continue; + case => return ("not a function:", ls.data[0]): mal::syntax_error; + }; +};}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; + }; + +fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { + let ast = match(read(input)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + if(printp) print(result); +}; + + +let repl_env: nullable *mal::env = null; + +fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { + + if(len(args) < 1) + return ("'do_eval': too few arguments", args): + mal::syntax_error; + + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + return mal::not_implemented; + }; + return eval(args[0], env); +}; + +export fn main() void = { + + repl_env = mal::env_init(); + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + fmt::fatal("No repl environment initialized!"); + }; + + mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); + mal::load_namespace(mal::core, env)!; + let load_file = "(def! load-file (fn* (f) + (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"; + + rep(strings::toutf8(load_file), env, false); + + // handle command line arguments + const args = os::args; + + let argvlen: size = if (len(args) > 2) { + yield len(args)-2; + } else { + yield 0; + }; + + let argv = mal::make_list(argvlen); + + if (len(args) > 2){ + for(let i: size = 2; i < len(args); i += 1){ + argv.data[i-2] = &args[i]: mal::string; + }; + }; + + mal::env_set(env, "*ARGV*", argv); + + if(len(args) > 1){ + let exec_str = strings::join("", "(load-file \"", args[1], + "\")")!; + rep(strings::toutf8(exec_str), env, false); + free(exec_str); + os::exit(0); + }; + + for(true){ + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + rep(input, env); + free(input); + }; +}; diff --git a/impls/hare/step8_macros.ha b/impls/hare/step8_macros.ha new file mode 100644 index 0000000000..4f3c9a4cb8 --- /dev/null +++ b/impls/hare/step8_macros.ha @@ -0,0 +1,406 @@ +use bufio; +use fmt; +use io; +use mal; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input); +}; + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + if(len(vec.data) == 0) return vec; + let res: mal::vector = mal::make_vec(len(vec.data)); + + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i], env)?; + }; + return res; +}; + +fn starts_with(ast: mal::MalType, sym: str) bool = { + match(ast){ + case let ls: mal::list=> + if(len(ls.data) < 1) return false; + match(ls.data[0]){ + case let s: mal::symbol => + return s == sym; + case => + return false; + }; + case => + return false; + }; +}; + +fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { + + let acc = mal::make_list(0); + + for(let i: size = len(ast); 0 < i ; i -= 1){ + + let elt: mal::MalType = ast[i - 1]; + + if(starts_with(elt, "splice-unquote")){ + let elt: mal::list = match(elt){ + case let l: mal::list => + yield l; + case => + return ("list", ast): mal::type_error; + }; + + acc = mal::make_list(3, ["concat":mal::symbol, + elt.data[1], acc]); + } else { + acc = mal::make_list(3, ["cons":mal::symbol, + quasiquote(elt)?, acc]); + }; + }; + + return acc; +}; + +fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { + match(ast) { + case let ls: mal::list => + if(starts_with(ls, "unquote")) { + return ls.data[1]; + } else { + return qq_iter(ls.data); + }; + case let ls: mal::vector => + let res: mal::list = mal::make_list(2, ["vec":mal::symbol, + qq_iter(ls.data)?]); + return res; + case let hm: (mal::symbol | mal::hashmap) => + let res: mal::list = mal::make_list(2, ["quote":mal::symbol, + ast]); + return res; + case => + return ast; + }; +}; +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + +for(true){ + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => void; + case mal::nil => void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + + let ls: mal::list = match(ast){ + case let key: mal::symbol => + if(strings::hasprefix(key, ':')){ + return key; + } else { + return mal::env_get(env, key)?; + }; + case let vec: mal::vector => + return eval_vec(vec, env)?; + case let hash: mal::hashmap => + return mal::eval_hash(hash, &eval, env)?; + case let ls: mal::list => + yield ls; + case => + return ast; + }; + + if(len(ls.data) == 0) return ast; + + // handle special cases of 'if' 'fn*', 'do', 'let*', 'defmacro!' and + // 'def!' forms. + match(ls.data[0]){ + + case let sym: mal::symbol => + + switch(sym){ + case "quasiquote" => + ast = quasiquote(ls.data[1])?; + continue; + case "quote" => + return ls.data[1]; + case "defmacro!" => + if(len(ls.data) != 3) + return ("defmacro! expects 2 arguments", + ls): mal::syntax_error; + + let name: mal::symbol = match(ls.data[1]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", + ls.data[1]): mal::type_error; + }; + let res: mal::macro = match(eval(ls.data[2], env)) { + case let func: mal::function => + yield func; + case => + return ("function", + ls.data[2]): mal::type_error; + }; + mal::env_set(env, name, res); + return res; + case "def!" => + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + + let name: mal::symbol = match(ls.data[1]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", ls.data[1]): mal::type_error; + }; + + mal::env_set(env, name, val); + return val; + + case "let*" => + if(len(ls.data) != 3) + return ("let*: too few arguments", + ls): mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + + let name: mal::symbol = match(bindings[i]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", ls.data[1]): + mal::type_error; + }; + + mal::env_set(let_env, name, eval(bindings[i+1], + let_env)?); + }; + + env = let_env; + ast = ls.data[2]; + continue; + case "do" => + let result: mal::MalType = mal::nil; + for(let form .. ls.data[1..len(ls.data)-1]){ + result = eval(form, env)?; + }; + ast = ls.data[len(ls.data)-1]; + continue; + case "if" => + if(len(ls.data) > 4 || len(ls.data) < 3) + return ("if expects 2 or 3 arguments", + ls): mal::syntax_error; + + match(eval(ls.data[1], env)?){ + case mal::nil => + if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case let b: bool => + if(b){ + ast = ls.data[2]; + continue; + } else if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case => + ast = ls.data[2]; + continue; + }; + case "fn*" => + let args = match(ls.data[1]){ + case let a: mal::vector => + yield a.data; + case let a: mal::list => + yield a.data; + }; + let body = match(ls.data[2]){ + case let b: mal::MalType => + yield b; + case => return mal::nil; + }; + return mal::make_func(&eval, env, args, body); + case => void; + }; + case => void; + }; + + // apply + + match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + let args: []mal::MalType = []; + defer free(args); + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + return func.eval(args); + case let mac: mal::macro => + ast = _apply(mac, ls.data[1..])?; + continue; + case let func: mal::function => + let args: []mal::MalType = []; + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + free(args); + ast = func.body; + continue; + case => return ("not a function:", ls.data[0]): mal::syntax_error; + }; +};}; + +fn _apply( + func: (mal::function | mal::intrinsic), + args: []mal::MalType +) (mal::MalType | mal::error) = { + + match(func){ + case let func: mal::function => + let env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + return func.eval(func.body, env); + case let func: mal::intrinsic => + return func.eval(args); + }; +}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; + }; + +fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { + let ast = match(read(input)){ + case let e :mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + if(printp) print(result); +}; + + +let repl_env: nullable *mal::env = null; + +fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { + + if(len(args) < 1) + return ("'do_eval': too few arguments", args): + mal::syntax_error; + + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + return mal::not_implemented; + }; + return eval(args[0], env); +}; + +export fn main() void = { + + repl_env = mal::env_init(); + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + fmt::fatal("No repl environment initialized!"); + }; + + mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); + mal::load_namespace(mal::core, env)!; + + let load_file = "(def! load-file (fn* (f) +(eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"; + + let cond = "(defmacro! cond +(fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) +(nth xs 1) (throw \"odd number of forms to cond\")) +(cons 'cond (rest (rest xs)))))))"; + + rep(strings::toutf8(cond), env, false); + rep(strings::toutf8(load_file), env, false); + + // handle command line arguments + const args = os::args; + + let argvlen: size = if (len(args) > 2) { + yield len(args)-2; + } else { + yield 0; + }; + + let argv = mal::make_list(argvlen); + + if (len(args) > 2){ + for(let i: size = 2; i < len(args); i += 1){ + argv.data[i-2] = &args[i]: mal::string; + }; + }; + + mal::env_set(env, "*ARGV*", argv); + + if(len(args) > 1){ + let exec_str = strings::join("", "(load-file \"", args[1], + "\")")!; + rep(strings::toutf8(exec_str), env, false); + free(exec_str); + os::exit(0); + }; + + for(true){ + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + rep(input, env); + free(input); + }; +}; diff --git a/impls/hare/step9_try.ha b/impls/hare/step9_try.ha new file mode 100644 index 0000000000..739f9e269d --- /dev/null +++ b/impls/hare/step9_try.ha @@ -0,0 +1,439 @@ +use bufio; +use fmt; +use io; +use mal; +use memio; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input); +}; + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + if(len(vec.data) == 0) return vec; + let res: mal::vector = mal::make_vec(len(vec.data)); + + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i], env)?; + }; + return res; +}; + +fn starts_with(ast: mal::MalType, sym: str) bool = { + match(ast){ + case let ls: mal::list=> + if(len(ls.data) < 1) return false; + match(ls.data[0]){ + case let s: mal::symbol => + return s == sym; + case => + return false; + }; + case => + return false; + }; +}; + +fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { + + let acc = mal::make_list(0); + + for(let i: size = len(ast); 0 < i ; i -= 1){ + + let elt: mal::MalType = ast[i - 1]; + + if(starts_with(elt, "splice-unquote")){ + let elt: mal::list = match(elt){ + case let l: mal::list => + yield l; + case => + return ("list", ast): mal::type_error; + }; + + acc = mal::make_list(3, ["concat":mal::symbol, + elt.data[1], acc]); + } else { + acc = mal::make_list(3, ["cons":mal::symbol, + quasiquote(elt)?, acc]); + }; + }; + + return acc; +}; + +fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { + match(ast) { + case let ls: mal::list => + if(starts_with(ls, "unquote")) { + return ls.data[1]; + } else { + return qq_iter(ls.data); + }; + case let ls: mal::vector => + let res: mal::list = + mal::make_list(2, ["vec":mal::symbol, + qq_iter(ls.data)?]); + return res; + case let hm: (mal::symbol | mal::hashmap) => + let res: mal::list = + mal::make_list(2, ["quote":mal::symbol, ast]); + return res; + case => + return ast; + }; +}; + +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + + for(true){ + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => void; + case mal::nil => void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + + let ls: mal::list = match(ast){ + case let key: mal::symbol => + if(strings::hasprefix(key, ':')){ + return key; + } else { + return mal::env_get(env, key)?; + }; + case let vec: mal::vector => + return eval_vec(vec, env)?; + case let hash: mal::hashmap => + return mal::eval_hash(hash, &eval, env)?; + case let ls: mal::list => + yield ls; + case => + return ast; + }; + + if(len(ls.data) == 0) return ast; + + // handle special cases of 'if' 'fn*', 'do', 'let*', 'defmacro!' and + // 'def!' forms. + match(ls.data[0]){ + + case let sym: mal::symbol => + + switch(sym){ + case "try*" => + match(eval(ls.data[1], env)){ + case let e: mal::error => + let s: mal::MalType = match(e){ + case let e: mal::malerror => + yield e.1; + case => + let buf = memio::dynamic(); + mal::format_error(&buf, e); + let s = memio::string(&buf)!; + let ret = mal::make_string(s); + io::close(&buf)!; + yield ret; + }; + + env = mal::env_init(env); + + if (len(ls.data) < 3) return e; + + match(ls.data[2]){ + case let l: mal::list => + if(!(starts_with(l, "catch*"))) + return ("expected catch* phrase", + l): mal::syntax_error; + mal::env_set( + env, l.data[1] as mal::symbol, s); + ast = l.data[2]; + continue; + case => + return ("list", ls): mal::type_error; + }; + case let c: mal::MalType=> + return c; + }; + case "quasiquote" => + ast = quasiquote(ls.data[1])?; + continue; + case "quote" => + return ls.data[1]; + case "defmacro!" => + if(len(ls.data) != 3) + return ("defmacro! expects 2 arguments", + ls): mal::syntax_error; + let name: mal::symbol = match(ls.data[1]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", ls.data[1]): mal::type_error; + }; + let res: mal::macro = match(eval(ls.data[2], env)) { + case let func: mal::function => + yield func; + case => + return ("function", ls.data[2]): mal::type_error; + }; + mal::env_set(env, name, res); + return res; + case "def!" => + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + + let name: mal::symbol = match(ls.data[1]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", ls.data[1]): mal::type_error; + }; + + mal::env_set(env, name, val); + return val; + + case "let*" => + if(len(ls.data) != 3) + return ("let*: too few arguments", + ls): mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + + let name: mal::symbol = match(bindings[i]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", + ls.data[1]): mal::type_error; + }; + + mal::env_set(let_env, name, eval(bindings[i+1], + let_env)?); + }; + + env = let_env; + ast = ls.data[2]; + continue; + case "do" => + let result: mal::MalType = mal::nil; + for(let form .. ls.data[1..len(ls.data)-1]){ + result = eval(form, env)?; + }; + ast = ls.data[len(ls.data)-1]; + continue; + case "if" => + if(len(ls.data) > 4 || len(ls.data) < 3) + return ("if expects 2 or 3 arguments", + ls): mal::syntax_error; + match(eval(ls.data[1], env)?){ + case mal::nil => + if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case let b: bool => + if(b){ + ast = ls.data[2]; + continue; + } else if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case => + ast = ls.data[2]; + continue; + }; + case "fn*" => + let args = match(ls.data[1]){ + case let a: mal::vector => + yield a.data; + case let a: mal::list => + yield a.data; + }; + let body = match(ls.data[2]){ + case let b: mal::MalType => + yield b; + case => return mal::nil; + }; + return mal::make_func(&eval, env, args, body); + case => void; + }; + case => void; + }; + + // apply + + match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + let args: []mal::MalType = []; + defer free(args); + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + return func.eval(args); + case let mac: mal::macro => + ast = _apply(mac, ls.data[1..])?; + continue; + case let func: mal::function => + let args: []mal::MalType = []; + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + free(args); + ast = func.body; + continue; + case => return ("not a function:", ls.data[0]): mal::syntax_error; + }; +};}; + +fn _apply(func: (mal::function | mal::intrinsic), args: []mal::MalType) + (mal::MalType | mal::error) = { + + match(func){ + case let func: mal::function => + let env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + return func.eval(func.body, env); + case let func: mal::intrinsic => + return func.eval(args); + }; +}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; + }; + +fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { + let ast = match(read(input)){ + case let e: mal::error => + fmt::errorln("Exception:")!; + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + fmt::errorln("Exception:")!; + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + if(printp) print(result); +}; + +let repl_env: nullable *mal::env = null; + +fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { + + if(len(args) < 1) + return ("'do_eval': too few arguments", args): + mal::syntax_error; + + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + return mal::not_implemented; + }; + return eval(args[0], env); +}; + +export fn main() void = { + + repl_env = mal::env_init(); + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + fmt::fatal("No repl environment initialized!"); + }; + + mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); + mal::load_namespace(mal::core, env)!; + + let load_file = "(def! load-file + (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))"; + + let cond = "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) + (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) + (throw \"odd number of forms to cond\")) (cons 'cond + (rest (rest xs)))))))"; + + rep(strings::toutf8(cond), env, false); + rep(strings::toutf8(load_file), env, false); + + // handle command line arguments + const args = os::args; + + let argvlen: size = if (len(args) > 2) { + yield len(args)-2; + } else { + yield 0; + }; + + let argv = mal::make_list(argvlen); + + if (len(args) > 2){ + for(let i: size = 2; i < len(args); i += 1){ + argv.data[i-2] = &args[i]: mal::string; + }; + }; + + mal::env_set(env, "*ARGV*", argv); + + if(len(args) > 1){ + let exec_str = strings::join("", "(load-file \"", args[1], + "\")")!; + rep(strings::toutf8(exec_str), env, false); + free(exec_str); + os::exit(0); + }; + + for(true){ + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + rep(input, env); + free(input); + }; +}; diff --git a/impls/hare/stepA_mal.ha b/impls/hare/stepA_mal.ha new file mode 100644 index 0000000000..884905f774 --- /dev/null +++ b/impls/hare/stepA_mal.ha @@ -0,0 +1,445 @@ +use bufio; +use fmt; +use io; +use mal; +use memio; +use os; +use strings; + +fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { + return mal::read_str(input); +}; + +fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ + + if(len(vec.data) == 0) return vec; + let res: mal::vector = mal::make_vec(len(vec.data)); + + for(let i: size = 0; i < len(vec.data); i += 1){ + res.data[i] = eval(vec.data[i], env)?; + }; + return res; +}; + +fn starts_with(ast: mal::MalType, sym: str) bool = { + match(ast){ + case let ls: mal::list=> + if(len(ls.data) < 1) return false; + match(ls.data[0]){ + case let s: mal::symbol => + return s == sym; + case => + return false; + }; + case => + return false; + }; +}; + +fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { + + let acc = mal::make_list(0); + + for(let i: size = len(ast); 0 < i ; i -= 1){ + + let elt: mal::MalType = ast[i - 1]; + + if(starts_with(elt, "splice-unquote")){ + let elt: mal::list = match(elt){ + case let l: mal::list => + yield l; + case => + return ("list", ast): mal::type_error; + }; + + acc = mal::make_list(3, ["concat":mal::symbol, + elt.data[1], acc]); + } else { + acc = mal::make_list(3, ["cons":mal::symbol, + quasiquote(elt)?, acc]); + }; + }; + + return acc; +}; + +fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { + match(ast) { + case let ls: mal::list => + if(starts_with(ls, "unquote")) { + return ls.data[1]; + } else { + return qq_iter(ls.data); + }; + case let ls: mal::vector => + let res: mal::list = + mal::make_list(2, ["vec":mal::symbol, + qq_iter(ls.data)?]); + return res; + case let hm: (mal::symbol | mal::hashmap) => + let res: mal::list = + mal::make_list(2, ["quote":mal::symbol, ast]); + return res; + case => + return ast; + }; +}; + +fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { + + for(true){ + + match(mal::env_get(env, "DEBUG-EVAL")){ + case mal::undefined_symbol => void; + case mal::nil => void; + case => + fmt::print("EVAL: ")!; + mal::print_form(os::stdout, ast); + fmt::print("\n")!; + mal::print_form(os::stdout, env.data); + fmt::print("\n")!; + }; + + let ls: mal::list = match(ast){ + case let key: mal::symbol => + if(strings::hasprefix(key, ':')){ + return key; + } else { + return mal::env_get(env, key)?; + }; + case let vec: mal::vector => + return eval_vec(vec, env)?; + case let hash: mal::hashmap => + return mal::eval_hash(hash, &eval, env)?; + case let ls: mal::list => + yield ls; + case => + return ast; + }; + + if(len(ls.data) == 0) return ast; + + // handle special cases of 'if' 'fn*', 'do', 'let*', 'defmacro!' and + // 'def!' forms. + match(ls.data[0]){ + + case let sym: mal::symbol => + + switch(sym){ + case "try*" => + match(eval(ls.data[1], env)){ + case let e: mal::error => + let s: mal::MalType = match(e){ + case let e: mal::malerror => + yield e.1; + case => + let buf = memio::dynamic(); + mal::format_error(&buf, e); + let s = memio::string(&buf)!; + let ret = mal::make_string(s); + io::close(&buf)!; + yield ret; + }; + + env = mal::env_init(env); + + if (len(ls.data) < 3) return e; + + match(ls.data[2]){ + case let l: mal::list => + if(!(starts_with(l, "catch*"))) + return ("expected catch* phrase", + l): mal::syntax_error; + mal::env_set(env, + l.data[1] as mal::symbol, s); + ast = l.data[2]; + continue; + case => + return ("list", ls): mal::type_error; + }; + case let c: mal::MalType=> + return c; + }; + case "quasiquote" => + ast = quasiquote(ls.data[1])?; + continue; + case "quote" => + return ls.data[1]; + case "defmacro!" => + if(len(ls.data) != 3) + return ("defmacro! expects 2 arguments", + ls): mal::syntax_error; + let name: mal::symbol = match(ls.data[1]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", ls.data[1]): mal::type_error; + }; + let res: mal::macro = match(eval(ls.data[2], env)) { + case let func: mal::function => + yield func; + case => + return ("function", ls.data[2]): mal::type_error; + }; + mal::env_set(env, name, res); + return res; + case "def!" => + if(len(ls.data) != 3) + return ("def! expects 2 arguments", + ls): mal::syntax_error; + + let val = eval(ls.data[2], env)?; + + let name: mal::symbol = match(ls.data[1]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", ls.data[1]): mal::type_error; + }; + + mal::env_set(env, name, val); + return val; + + case "let*" => + if(len(ls.data) != 3) + return ("let*: too few arguments", ls): + mal::syntax_error; + + let bindings: []mal::MalType = match(ls.data[1]){ + case let b: mal::list => + yield b.data; + case let b: mal::vector => + yield b.data; + case => + return ("let*", ls): mal::syntax_error; + }; + + let let_env = mal::env_init(env); + + for(let i: size = 0; i < len(bindings); i += 2){ + + let name: mal::symbol = match(bindings[i]){ + case let name: mal::symbol => + yield name; + case => + return ("symbol", ls.data[1]): + mal::type_error; + }; + + mal::env_set(let_env, name, eval(bindings[i+1], + let_env)?); + }; + + env = let_env; + ast = ls.data[2]; + continue; + case "do" => + let result: mal::MalType = mal::nil; + for(let form .. ls.data[1..len(ls.data)-1]){ + result = eval(form, env)?; + }; + ast = ls.data[len(ls.data)-1]; + continue; + case "if" => + if(len(ls.data) > 4 || len(ls.data) < 3) + return ("if expects 2 or 3 arguments", + ls): mal::syntax_error; + match(eval(ls.data[1], env)?){ + case mal::nil => + if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case let b: bool => + if(b){ + ast = ls.data[2]; + continue; + } else if(len(ls.data) == 4){ + ast = ls.data[3]; + continue; + } else { + return mal::nil; + }; + case => + ast = ls.data[2]; + continue; + }; + case "fn*" => + let args = match(ls.data[1]){ + case let a: mal::vector => + yield a.data; + case let a: mal::list => + yield a.data; + }; + let body = match(ls.data[2]){ + case let b: mal::MalType => + yield b; + case => return mal::nil; + }; + return mal::make_func(&eval, env, args, body); + case => void; + }; + case => void; + }; + + // apply + + match(eval(ls.data[0], env)?){ + case let func: mal::intrinsic => + let args: []mal::MalType = []; + defer free(args); + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + return func.eval(args); + case let mac: mal::macro => + ast = _apply(mac, ls.data[1..])?; + continue; + case let func: mal::function => + let args: []mal::MalType = []; + for(let arg .. ls.data[1..]){ + append(args, eval(arg, env)?)!; + }; + env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + free(args); + ast = func.body; + continue; + case => return ("not a function:", ls.data[0]): mal::syntax_error; + }; +};}; + +fn _apply(func: (mal::function | mal::intrinsic), args: []mal::MalType) + (mal::MalType | mal::error) = { + + match(func){ + case let func: mal::function => + let env = mal::env_init(func.envi); + mal::env_bind(env, func.args, args); + return func.eval(func.body, env); + case let func: mal::intrinsic => + return func.eval(args); + }; +}; + +fn print (input: mal::MalType) void = { + mal::print_form(os::stdout, input); + fmt::print("\n")!; + }; + +fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { + let ast = match(read(input)){ + case let e: mal::error => + fmt::errorln("Exception:")!; + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + case io::EOF => + return void; + }; + + let result = match(eval(ast, env)){ + case let e: mal::error => + fmt::errorln("Exception:")!; + return mal::format_error(os::stderr, e); + case let form: mal::MalType => + yield form; + }; + + if(printp) print(result); + + mal::run_gc(env); +}; + +let repl_env: nullable *mal::env = null; + +fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { + + if(len(args) < 1) + return ("'do_eval': too few arguments", args): + mal::syntax_error; + + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + return mal::not_implemented; + }; + return eval(args[0], env); +}; + +export fn main() void = { + + repl_env = mal::env_init(); + const env = match(repl_env){ + case let env: *mal::env => + yield env; + case => + fmt::fatal("No repl environment initialized!"); + }; + + mal::env_set(env, "*host-language*", mal::make_string("hare")); + mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); + mal::load_namespace(mal::core, env)!; + + let load_file = "(def! load-file + (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))"; + + let cond = "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) + (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) + (throw \"odd number of forms to cond\")) (cons 'cond + (rest (rest xs)))))))"; + + rep(strings::toutf8(load_file), env, false); + rep(strings::toutf8(cond), env, false); + + // handle command line arguments + const args = os::args; + + let argvlen: size = if (len(args) > 2) { + yield len(args)-2; + } else { + yield 0; + }; + + let argv = mal::make_list(argvlen); + + if (len(args) > 2){ + for(let i: size = 2; i < len(args); i += 1){ + argv.data[i-2] = &args[i]: mal::string; + }; + }; + + mal::env_set(env, "*ARGV*", argv); + + if(len(args) > 1){ + let exec_str = strings::join("", "(load-file \"", args[1], + "\")")!; + rep(strings::toutf8(exec_str), env, false); + free(exec_str); + os::exit(0); + }; + + rep(strings::toutf8("(println (str \"Mal [\" *host-language* \"]\"))"), + env, false); + + for(true){ + fmt::printf("user> ")!; + bufio::flush(os::stdout)!; + + const input = match(bufio::read_line(os::stdin)){ + case let input: []u8 => + yield input; + case io::EOF => + break; + case io::error => + break; + }; + + rep(input, env); + free(input); + }; +}; diff --git a/impls/haskell/Core.hs b/impls/haskell/Core.hs new file mode 100644 index 0000000000..94a961a961 --- /dev/null +++ b/impls/haskell/Core.hs @@ -0,0 +1,383 @@ +module Core +( ns ) +where + +import Control.Monad.Except (throwError) +import Control.Monad.Trans (liftIO) +import qualified Data.Map.Strict as Map +import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.IORef (newIORef, readIORef, writeIORef) + +import Readline (readline) +import Reader (read_str) +import Types +import Printer (_pr_list) + +-- General functions + +equal_Q :: Fn +equal_Q [a, b] = return $ MalBoolean $ a == b +equal_Q _ = throwStr "illegal arguments to =" + +-- Error/Exception functions + +throw :: Fn +throw [mv] = throwError mv +throw _ = throwStr "illegal arguments to throw" + +-- Unary predicates + +pred1 :: String -> (MalVal -> Bool) -> (String, Fn) +pred1 name op = (name, fn) where + fn :: Fn + fn [a] = return $ MalBoolean $ op a + fn _ = throwStr $ "illegal arguments to " ++ name + +atom_Q :: MalVal -> Bool +atom_Q (MalAtom _ _) = True +atom_Q _ = False + +false_Q :: MalVal -> Bool +false_Q (MalBoolean False) = True +false_Q _ = False + +fn_Q :: MalVal -> Bool +fn_Q (MalFunction _ _) = True +fn_Q _ = False + +macro_Q :: MalVal -> Bool +macro_Q (MalMacro _) = True +macro_Q _ = False + +map_Q :: MalVal -> Bool +map_Q (MalHashMap _ _) = True +map_Q _ = False + +keyword_Q :: MalVal -> Bool +keyword_Q (MalKeyword _) = True +keyword_Q _ = False + +list_Q :: MalVal -> Bool +list_Q (MalSeq _ (Vect False) _) = True +list_Q _ = False + +nil_Q :: MalVal -> Bool +nil_Q Nil = True +nil_Q _ = False + +number_Q :: MalVal -> Bool +number_Q (MalNumber _) = True +number_Q _ = False + +string_Q :: MalVal -> Bool +string_Q (MalString _) = True +string_Q _ = False + +symbol_Q :: MalVal -> Bool +symbol_Q (MalSymbol _) = True +symbol_Q _ = False + +true_Q :: MalVal -> Bool +true_Q (MalBoolean True) = True +true_Q _ = False + +vector_Q :: MalVal -> Bool +vector_Q (MalSeq _ (Vect True) _) = True +vector_Q _ = False + +-- Scalar functions + +symbol :: Fn +symbol [MalString s] = return $ MalSymbol s +symbol _ = throwStr "symbol called with non-string" + +keyword :: Fn +keyword [kw@(MalKeyword _)] = return kw +keyword [MalString s] = return $ MalKeyword s +keyword _ = throwStr "keyword called with non-string" + +-- String functions + +pr_str :: Fn +pr_str args = liftIO $ MalString <$> _pr_list True " " args + +str :: Fn +str args = liftIO $ MalString <$> _pr_list False "" args + +prn :: Fn +prn args = liftIO $ do + putStrLn =<< _pr_list True " " args + return Nil + +println :: Fn +println args = liftIO $ do + putStrLn =<< _pr_list False " " args + return Nil + +slurp :: Fn +slurp [MalString path] = MalString <$> liftIO (readFile path) +slurp _ = throwStr "invalid arguments to slurp" + +do_readline :: Fn +do_readline [MalString prompt] = do + maybeLine <- liftIO $ readline prompt + case maybeLine of + Nothing -> return Nil + Just line -> return $ MalString line +do_readline _ = throwStr "invalid arguments to readline" + +read_string :: Fn +read_string [MalString s] = read_str s +read_string _ = throwStr "invalid read-string" + +-- Numeric functions + +num_op :: String -> (Int -> Int -> a) -> (a -> MalVal) -> (String, Fn) +num_op name op constructor = (name, fn) where + fn :: Fn + fn [MalNumber a, MalNumber b] = return $ constructor $ op a b + fn _ = throwStr $ "illegal arguments to " ++ name + +time_ms :: Fn +time_ms [] = MalNumber . round . (* 1000) <$> liftIO getPOSIXTime +time_ms _ = throwStr "invalid time-ms" + + +-- List functions + +list :: Fn +list = return . toList + +-- Vector functions + +vector :: Fn +vector = return . MalSeq (MetaData Nil) (Vect True) + +-- Hash Map functions + +hash_map :: Fn +hash_map kvs = case kv2map Map.empty kvs of + Just m -> return m + Nothing -> throwStr "invalid call to hash-map" + +assoc :: Fn +assoc (MalHashMap _ hm : kvs) = case kv2map hm kvs of + Just m -> return m + Nothing -> throwStr "invalid assoc" +assoc _ = throwStr "invalid call to assoc" + +dissoc :: Fn +dissoc (MalHashMap _ hm : ks) = MalHashMap (MetaData Nil) . foldl + (flip Map.delete) hm <$> mapM encodeKey ks +dissoc _ = throwStr "invalid call to dissoc" + +get :: Fn +get [MalHashMap _ hm, k] = orNil . flip Map.lookup hm <$> encodeKey k + where + orNil (Just v) = v + orNil Nothing = Nil +get [Nil, k] = const Nil <$> encodeKey k +get _ = throwStr "invalid call to get" + +contains_Q :: Fn +contains_Q [MalHashMap _ m, k] = MalBoolean . flip Map.member m <$> encodeKey k +contains_Q [Nil, k] = MalBoolean . const False <$> encodeKey k +contains_Q _ = throwStr "invalid call to contains?" + +keys :: Fn +keys [MalHashMap _ hm] = return $ toList $ decodeKey <$> Map.keys hm +keys _ = throwStr "invalid call to keys" + +vals :: Fn +vals [MalHashMap _ hm] = return $ toList $ Map.elems hm +vals _ = throwStr "invalid call to vals" + +-- Sequence functions + +sequential_Q :: MalVal -> Bool +sequential_Q (MalSeq _ _ _) = True +sequential_Q _ = False + +cons :: Fn +cons [x, Nil ] = return $ toList [x] +cons [x, MalSeq _ _ lst] = return $ toList (x : lst) +cons _ = throwStr "illegal call to cons" + +unwrapSeq :: MalVal -> IOThrows [MalVal] +unwrapSeq (MalSeq _ _ xs) = return xs +unwrapSeq _ = throwStr "invalid concat" + +do_concat :: Fn +do_concat args = toList . concat <$> mapM unwrapSeq args + +vec :: Fn +vec [MalSeq _ _ xs] = return $ MalSeq (MetaData Nil) (Vect True) xs +vec [_] = throwStr "vec: arg type" +vec _ = throwStr "vec: arg count" + +nth :: Fn +nth [MalSeq _ _ lst, MalNumber idx] = + case drop idx lst of + x : _ -> return x + [] -> throwStr "nth: index out of range" +-- See https://wiki.haskell.org/Avoiding_partial_functions +nth _ = throwStr "invalid call to nth" + +first :: Fn +first [Nil ] = return Nil +first [MalSeq _ _ [] ] = return Nil +first [MalSeq _ _ (x : _)] = return x +first _ = throwStr "illegal call to first" + +rest :: Fn +rest [Nil ] = return $ toList [] +rest [MalSeq _ _ [] ] = return $ toList [] +rest [MalSeq _ _ (_ : xs)] = return $ toList xs +rest _ = throwStr "illegal call to rest" + +empty_Q :: Fn +empty_Q [Nil] = return $ MalBoolean True +empty_Q [MalSeq _ _ xs] = return $ MalBoolean $ xs == [] +empty_Q _ = throwStr "illegal call to empty?" + +count :: Fn +count [Nil ] = return $ MalNumber 0 +count [MalSeq _ _ lst] = return $ MalNumber $ length lst +count _ = throwStr "non-sequence passed to count" + +concatLast :: [MalVal] -> IOThrows [MalVal] +concatLast [MalSeq _ _ lst] = return lst +concatLast (a : as) = (a :) <$> concatLast as +concatLast _ = throwStr "last argument of apply must be a sequence" + +apply :: Fn +apply (MalFunction _ f : xs) = f =<< concatLast xs +apply (MalMacro f : xs) = f =<< concatLast xs +apply _ = throwStr "Illegal call to apply" + +do_map :: Fn +do_map [MalFunction _ f, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args +do_map _ = throwStr "Illegal call to map" + +conj :: Fn +conj (MalSeq _ (Vect False) lst : args) = return $ toList $ reverse args ++ lst +conj (MalSeq _ (Vect True) lst : args) = return $ MalSeq (MetaData Nil) (Vect True) $ lst ++ args +conj _ = throwStr "illegal arguments to conj" + +do_seq :: Fn +do_seq [Nil ] = return Nil +do_seq [MalSeq _ _ [] ] = return Nil +do_seq [MalSeq _ _ lst ] = return $ toList lst +do_seq [MalString "" ] = return Nil +do_seq [MalString s ] = return $ toList $ MalString <$> pure <$> s +do_seq _ = throwStr "seq: called on non-sequence" + +-- Metadata functions + +with_meta :: Fn +with_meta [MalSeq _ v x, m] = return $ MalSeq (MetaData m) v x +with_meta [MalHashMap _ x, m] = return $ MalHashMap (MetaData m) x +with_meta [MalAtom _ x, m] = return $ MalAtom (MetaData m) x +with_meta [MalFunction _ f, m] = return $ MalFunction (MetaData m) f +with_meta _ = throwStr "invalid with-meta call" + +do_meta :: Fn +do_meta [MalSeq (MetaData m) _ _ ] = return m +do_meta [MalHashMap (MetaData m) _] = return m +do_meta [MalAtom (MetaData m) _ ] = return m +do_meta [MalFunction (MetaData m) _] = return m +do_meta _ = throwStr "invalid meta call" + +-- Atom functions + +atom :: Fn +atom [val] = MalAtom (MetaData Nil) <$> liftIO (newIORef val) +atom _ = throwStr "invalid atom call" + +deref :: Fn +deref [MalAtom _ ref] = liftIO $ readIORef ref +deref _ = throwStr "invalid deref call" + +reset_BANG :: Fn +reset_BANG [MalAtom _ ref, val] = do + liftIO $ writeIORef ref val + return val +reset_BANG _ = throwStr "invalid reset!" + +swap_BANG :: Fn +swap_BANG (MalAtom _ ref : MalFunction _ f : args) = do + val <- liftIO $ readIORef ref + new_val <- f (val : args) + liftIO $ writeIORef ref new_val + return new_val +swap_BANG _ = throwStr "Illegal swap!" + +ns :: [(String, Fn)] +ns = [ + ("=", equal_Q), + ("throw", throw), + (pred1 "nil?" nil_Q), + (pred1 "true?" true_Q), + (pred1 "false?" false_Q), + (pred1 "string?" string_Q), + ("symbol", symbol), + (pred1 "symbol?" symbol_Q), + ("keyword", keyword), + (pred1 "keyword?" keyword_Q), + (pred1 "number?" number_Q), + (pred1 "fn?" fn_Q), + (pred1 "macro?" macro_Q), + + ("pr-str", pr_str), + ("str", str), + ("prn", prn), + ("println", println), + ("readline", do_readline), + ("read-string", read_string), + ("slurp", slurp), + + num_op "<" (<) MalBoolean, + num_op "<=" (<=) MalBoolean, + num_op ">" (>) MalBoolean, + num_op ">=" (>=) MalBoolean, + num_op "+" (+) MalNumber, + num_op "-" (-) MalNumber, + num_op "*" (*) MalNumber, + num_op "/" div MalNumber, + ("time-ms", time_ms), + + ("list", list), + (pred1 "list?" list_Q), + ("vector", vector), + (pred1 "vector?" vector_Q), + ("hash-map", hash_map), + (pred1 "map?" map_Q), + ("assoc", assoc), + ("dissoc", dissoc), + ("get", get), + ("contains?", contains_Q), + ("keys", keys), + ("vals", vals), + + (pred1 "sequential?" sequential_Q), + ("cons", cons), + ("concat", do_concat), + ("vec", vec), + ("nth", nth), + ("first", first), + ("rest", rest), + ("empty?", empty_Q), + ("count", count), + ("apply", apply), + ("map", do_map), + + ("conj", conj), + ("seq", do_seq), + + ("with-meta", with_meta), + ("meta", do_meta), + ("atom", atom), + (pred1 "atom?" atom_Q), + ("deref", deref), + ("reset!", reset_BANG), + ("swap!", swap_BANG)] diff --git a/impls/haskell/Dockerfile b/impls/haskell/Dockerfile new file mode 100644 index 0000000000..8df6aa02d0 --- /dev/null +++ b/impls/haskell/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install make python +RUN apt-get install -y ghc libghc-readline-dev diff --git a/impls/haskell/Env.hs b/impls/haskell/Env.hs new file mode 100644 index 0000000000..0dd9b0bdba --- /dev/null +++ b/impls/haskell/Env.hs @@ -0,0 +1,36 @@ +module Env +( Env, env_get, env_new, env_put, env_set ) +where + +import Data.IORef (IORef, modifyIORef, newIORef, readIORef) +import qualified Data.Map.Strict as Map + +import Printer (_pr_str) +import Types + +data Env = Env (Maybe Env) (IORef (Map.Map String MalVal)) + +env_new :: Maybe Env -> IO Env +env_new outer = Env outer <$> newIORef Map.empty + +env_get :: Env -> String -> IO (Maybe MalVal) +env_get (Env maybeOuter ref) key = do + m <- readIORef ref + case Map.lookup key m of + Nothing -> case maybeOuter of + Nothing -> return Nothing + Just outer -> env_get outer key + justVal -> return justVal + +env_set :: Env -> String -> MalVal -> IO () +env_set (Env _ ref) key value = modifyIORef ref $ Map.insert key value + +put1 :: (String, MalVal) -> IO () +put1 (key, value) = do + putChar ' ' + putStr key + putChar ':' + putStr =<< _pr_str True value + +env_put :: Env -> IO () +env_put (Env _ ref) = mapM_ put1 =<< Map.assocs <$> readIORef ref diff --git a/impls/haskell/Makefile b/impls/haskell/Makefile new file mode 100644 index 0000000000..aeb0c69915 --- /dev/null +++ b/impls/haskell/Makefile @@ -0,0 +1,22 @@ +BINS4 = step4_if_fn_do step5_tco step6_file step7_quote step8_macros \ + step9_try stepA_mal +BINS3 = step3_env $(BINS4) +BINS1 = step1_read_print step2_eval $(BINS3) +BINS = step0_repl $(BINS1) +ghc_flags = -Wall -Wextra +LDLIBS = -lreadline + +##################### + +all: $(BINS) + +$(BINS): %: %.hs + ghc ${ghc_flags} --make $< $(LDLIBS) -o $@ + +$(BINS1): Types.hs Reader.hs Printer.hs +$(BINS3): Env.hs +$(BINS4): Core.hs +$(BINS): Readline.hs + +clean: + rm -f $(BINS) *.hi *.o diff --git a/impls/haskell/Printer.hs b/impls/haskell/Printer.hs new file mode 100644 index 0000000000..e0931b6dd2 --- /dev/null +++ b/impls/haskell/Printer.hs @@ -0,0 +1,38 @@ +module Printer +( _pr_str, _pr_list ) +where + +import qualified Data.Map.Strict as Map +import Data.IORef (readIORef) +import Data.List (intercalate) + +import Types + +_pr_list :: Bool -> String -> [MalVal] -> IO String +_pr_list pr sep = fmap (intercalate sep) . mapM (_pr_str pr) + +enclose :: String -> String -> String -> String +enclose open close middle = open ++ middle ++ close + +escape :: Char -> String -> String +escape '\n' acc = '\\' : 'n' : acc +escape '\\' acc = '\\' : '\\' : acc +escape '"' acc = '\\' : '"' : acc +escape c acc = c : acc + +_pr_str :: Bool -> MalVal -> IO String +_pr_str _ (MalKeyword kwd) = return $ ':' : kwd +_pr_str True (MalString str) = return $ enclose "\"" "\"" $ foldr escape [] str +_pr_str False (MalString str) = return str +_pr_str _ (MalSymbol name) = return name +_pr_str _ (MalNumber num) = return $ show num +_pr_str _ (MalBoolean True) = return "true" +_pr_str _ (MalBoolean False) = return "false" +_pr_str _ Nil = return "nil" +_pr_str pr (MalSeq _ (Vect False) xs) = enclose "(" ")" <$> _pr_list pr " " xs +_pr_str pr (MalSeq _ (Vect True) xs) = enclose "[" "]" <$> _pr_list pr " " xs +_pr_str pr (MalHashMap _ m) = enclose "{" "}" <$> _pr_list pr " " + (Map.foldMapWithKey (\k v -> [decodeKey k, v]) m) +_pr_str pr (MalAtom _ r) = enclose "(atom " ")" <$> (_pr_str pr =<< readIORef r) +_pr_str _ (MalFunction _ _) = return "" +_pr_str _ (MalMacro _) = return "" diff --git a/impls/haskell/Reader.hs b/impls/haskell/Reader.hs new file mode 100644 index 0000000000..47ed49cd2d --- /dev/null +++ b/impls/haskell/Reader.hs @@ -0,0 +1,123 @@ +module Reader +( read_str ) +where + +import qualified Data.Map.Strict as Map +import Text.ParserCombinators.Parsec ( + Parser, parse, char, digit, anyChar, + (<|>), oneOf, noneOf, many, many1) + +import Types + +---------------------------------------------------------------------- +-- A MAL grammar and a possible parsing are described here. + +-- If you are only interested in the grammar, please ignore the +-- left-hand side of <$> and =<< operators (second column). + +-- *> <* <*> all mean concatenation +-- <|> means alternative +-- many p = (many1 p) | empty means p*, zero or more p +-- many1 p = p (many p) means p+, one or more p + +-- For efficiency, the alternative operator <|> expects each branch +-- to either: +-- * succeed, +-- * fall after looking at the next character without consuming it, +-- * or consume some input and fail, indicating that the input is +-- incorrect and no remaining branches should be ignored. + +allowedChar :: Parser Char +allowedChar = noneOf "\n\r \"(),;[\\]{}" + +sep :: Parser String +sep = many (oneOf ", \n" + <|> char ';' <* many (noneOf "\n")) + +stringChar :: Parser Char +stringChar = unescapeChar <$> (char '\\' *> anyChar) + <|> noneOf "\"" + +afterMinus :: Parser MalVal +afterMinus = negative <$> many1 digit + <|> hyphenSymbol <$> many allowedChar + +afterTilde :: Parser MalVal +afterTilde = spliceUnquote <$> (char '@' *> sep *> form) + <|> unquote <$> (sep *> form) + +form :: Parser MalVal +form = MalString <$> (char '"' *> many stringChar <* char '"') + <|> MalKeyword <$> (char ':' *> many1 allowedChar) + <|> char '-' *> afterMinus + <|> toList <$> (char '(' *> sep *> many (form <* sep) <* char ')') + <|> vector <$> (char '[' *> sep *> many (form <* sep) <* char ']') + <|> (toMap =<< char '{' *> sep *> many (form <* sep) <* char '}') + <|> quote <$> (char '\'' *> sep *> form) + <|> quasiquote <$> (char '`' *> sep *> form) + <|> deref <$> (char '@' *> sep *> form) + <|> char '~' *> afterTilde + <|> withMeta <$> (char '^' *> sep *> form <* sep) <*> form + <|> positive <$> many1 digit + <|> symbol <$> many1 allowedChar + +read_form :: Parser MalVal +read_form = sep *> form + +---------------------------------------------------------------------- +-- Part specific to Haskell + +addPrefix :: String -> MalVal -> MalVal +addPrefix s x = toList [MalSymbol s, x] + +deref :: MalVal -> MalVal +deref = addPrefix "deref" + +hyphenSymbol :: String -> MalVal +hyphenSymbol = MalSymbol . (:) '-' + +negative :: String -> MalVal +negative = MalNumber . negate . read + +positive :: String -> MalVal +positive = MalNumber . read + +quasiquote :: MalVal -> MalVal +quasiquote = addPrefix "quasiquote" + +quote :: MalVal -> MalVal +quote = addPrefix "quote" + +spliceUnquote :: MalVal -> MalVal +spliceUnquote = addPrefix "splice-unquote" + +toMap :: [MalVal] -> Parser MalVal +toMap kvs = case kv2map Map.empty kvs of + Just m -> return m + Nothing -> fail "invalid contents in map braces" + +unquote :: MalVal -> MalVal +unquote = addPrefix "unquote" + +symbol :: String -> MalVal +symbol "true" = MalBoolean True +symbol "false" = MalBoolean False +symbol "nil" = Nil +symbol s = MalSymbol s + +unescapeChar :: Char -> Char +unescapeChar 'n' = '\n' +unescapeChar c = c + +vector :: [MalVal] -> MalVal +vector = MalSeq (MetaData Nil) (Vect True) + +withMeta :: MalVal -> MalVal -> MalVal +withMeta m d = toList [MalSymbol "with-meta", d, m] + +-- The only exported function + +read_str :: String -> IOThrows MalVal +read_str str = case parse read_form "Mal" str of + Left err -> throwStr $ show err + Right val -> return val diff --git a/impls/haskell/Readline.hs b/impls/haskell/Readline.hs new file mode 100644 index 0000000000..b5df4d34a1 --- /dev/null +++ b/impls/haskell/Readline.hs @@ -0,0 +1,38 @@ +module Readline +( addHistory, readline, load_history ) +where + +-- Pick one of these: +-- GPL license +import qualified System.Console.Readline as RL +-- BSD license +--import qualified System.Console.Editline.Readline as RL + +import Control.Monad (when) +import System.Directory (getHomeDirectory, doesFileExist) +import System.IO (hFlush, stdout) +import System.IO.Error (tryIOError) + +history_file :: IO String +history_file = do + home <- getHomeDirectory + return $ home ++ "/.mal-history" + +load_history :: IO () +load_history = do + hfile <- history_file + fileExists <- doesFileExist hfile + when fileExists $ do + content <- readFile hfile + mapM_ RL.addHistory (lines content) + +readline :: String -> IO (Maybe String) +readline prompt = do + hFlush stdout + RL.readline prompt + +addHistory :: String -> IO () +addHistory line = do + hfile <- history_file + _ <- tryIOError (appendFile hfile (line ++ "\n")) + RL.addHistory line diff --git a/impls/haskell/Types.hs b/impls/haskell/Types.hs new file mode 100644 index 0000000000..b9b20fc85e --- /dev/null +++ b/impls/haskell/Types.hs @@ -0,0 +1,84 @@ +module Types +( MalVal (..), IOThrows, Fn, MetaData (..), Vect (..), + decodeKey, encodeKey, kv2map, + throwStr, toList) +where + +import Data.IORef (IORef) +import qualified Data.Map.Strict as Map +-- The documentation recommends strict except in specific cases. +import Control.Monad.Except (ExceptT, throwError) + +-- Base Mal types -- +type Fn = [MalVal] -> IOThrows MalVal + +-- Use type safety for unnamed components, without runtime penalty. +newtype MetaData = MetaData MalVal +newtype Vect = Vect Bool + +data MalVal = Nil + | MalBoolean Bool + | MalNumber Int + | MalString String + | MalSymbol String + | MalKeyword String + | MalSeq MetaData Vect [MalVal] + | MalHashMap MetaData (Map.Map MapKey MalVal) + | MalAtom MetaData (IORef MalVal) + | MalFunction MetaData Fn + | MalMacro Fn + +-- Stored into maps to distinguish keywords and symbols. +-- MapKey is not exported, other modules use encodeKey or kv2map. +data MapKey = MapKeyKeyword String | MapKeyString String +instance Eq MapKey where + MapKeyString a == MapKeyString b = a == b + MapKeyKeyword a == MapKeyKeyword b = a == b + _ == _ = False +instance Ord MapKey where + compare (MapKeyString a) (MapKeyString b) = compare a b + compare (MapKeyKeyword a) (MapKeyKeyword b) = compare a b + compare (MapKeyKeyword _) (MapKeyString _) = LT + compare (MapKeyString _) (MapKeyKeyword _) = GT + +encodeKey :: MalVal -> IOThrows MapKey +encodeKey (MalString key) = pure $ MapKeyString key +encodeKey (MalKeyword key) = pure $ MapKeyKeyword key +encodeKey _ = throwStr "map keys must be keywords or strings" + +decodeKey :: MapKey -> MalVal +decodeKey (MapKeyString k) = MalString k +decodeKey (MapKeyKeyword k) = MalKeyword k + +instance Eq MalVal where + Nil == Nil = True + (MalBoolean a) == (MalBoolean b) = a == b + (MalNumber a) == (MalNumber b) = a == b + (MalString a) == (MalString b) = a == b + (MalKeyword a) == (MalKeyword b) = a == b + (MalSymbol a) == (MalSymbol b) = a == b + (MalSeq _ _ a) == (MalSeq _ _ b) = a == b + (MalHashMap _ a) == (MalHashMap _ b) = a == b + (MalAtom _ a) == (MalAtom _ b) = a == b + _ == _ = False + +--- Errors/Exceptions --- + +type IOThrows = ExceptT MalVal IO + +throwStr :: String -> IOThrows a +throwStr = throwError . MalString + +-- Convenient shortcuts for common situations. + +toList :: [MalVal] -> MalVal +toList = MalSeq (MetaData Nil) (Vect False) + +-- Use Maybe because Core throws while Reader fails. +kv2map :: Map.Map MapKey MalVal -> [MalVal] -> Maybe MalVal +kv2map start forms = MalHashMap (MetaData Nil) <$> assoc1 start forms where + assoc1 :: Map.Map MapKey MalVal -> [MalVal] -> Maybe (Map.Map MapKey MalVal) + assoc1 acc (MalKeyword s : v : kvs) = assoc1 (Map.insert (MapKeyKeyword s) v acc) kvs + assoc1 acc (MalString s : v : kvs) = assoc1 (Map.insert (MapKeyString s) v acc) kvs + assoc1 acc [] = Just acc + assoc1 _ _ = Nothing diff --git a/impls/haskell/run b/impls/haskell/run new file mode 100755 index 0000000000..6efdc3de32 --- /dev/null +++ b/impls/haskell/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/haskell/step0_repl.hs b/impls/haskell/step0_repl.hs new file mode 100644 index 0000000000..c30e9b74bf --- /dev/null +++ b/impls/haskell/step0_repl.hs @@ -0,0 +1,37 @@ +import Readline (addHistory, readline, load_history) + +type MalVal = String + +-- read + +mal_read :: String -> MalVal +mal_read = id + +-- eval + +eval :: MalVal -> MalVal +eval = id + +-- print + +mal_print :: MalVal -> String +mal_print = id + +-- repl + +repl_loop :: IO () +repl_loop = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop + Just str -> do + addHistory str + let out = mal_print $ eval $ mal_read str + putStrLn out + repl_loop + +main :: IO () +main = do + load_history + repl_loop diff --git a/impls/haskell/step1_read_print.hs b/impls/haskell/step1_read_print.hs new file mode 100644 index 0000000000..c16d5faba6 --- /dev/null +++ b/impls/haskell/step1_read_print.hs @@ -0,0 +1,43 @@ +import Control.Monad.Except (runExceptT) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer (_pr_str) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +eval :: MalVal -> MalVal +eval = id + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: IO () +repl_loop = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop + Just str -> do + addHistory str + res <- runExceptT $ eval <$> mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop + +main :: IO () +main = do + load_history + repl_loop diff --git a/impls/haskell/step2_eval.hs b/impls/haskell/step2_eval.hs new file mode 100644 index 0000000000..340858712c --- /dev/null +++ b/impls/haskell/step2_eval.hs @@ -0,0 +1,86 @@ +import Control.Monad.Except (liftIO, runExceptT) +import qualified Data.Map.Strict as Map + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) + +type Env = Map.Map String MalVal + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + -- putStr "EVAL: " + -- putStrLn =<< mal_print ast + case ast of + MalSymbol sym -> do + let maybeVal = Map.lookup sym env + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +add :: Fn +add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b +add _ = throwStr $ "illegal arguments to +" + +sub :: Fn +sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b +sub _ = throwStr $ "illegal arguments to -" + +mult :: Fn +mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b +mult _ = throwStr $ "illegal arguments to *" + +divd :: Fn +divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b +divd _ = throwStr $ "illegal arguments to /" + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +main :: IO () +main = do + let repl_env = Map.fromList [("+", MalFunction (MetaData Nil) add), + ("-", MalFunction (MetaData Nil) sub), + ("*", MalFunction (MetaData Nil) mult), + ("/", MalFunction (MetaData Nil) divd)] + + load_history + repl_loop repl_env diff --git a/impls/haskell/step3_env.hs b/impls/haskell/step3_env.hs new file mode 100644 index 0000000000..1119bd8a04 --- /dev/null +++ b/impls/haskell/step3_env.hs @@ -0,0 +1,119 @@ +import Control.Monad.Except (liftIO, runExceptT) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer (_pr_list, _pr_str) +import Env + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +add :: Fn +add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b +add _ = throwStr $ "illegal arguments to +" + +sub :: Fn +sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b +sub _ = throwStr $ "illegal arguments to -" + +mult :: Fn +mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b +mult _ = throwStr $ "illegal arguments to *" + +divd :: Fn +divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b +divd _ = throwStr $ "illegal arguments to /" + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +defBuiltIn :: Env -> String -> Fn -> IO () +defBuiltIn env sym f = + env_set env sym $ MalFunction (MetaData Nil) f + +main :: IO () +main = do + repl_env <- env_new Nothing + + defBuiltIn repl_env "+" add + defBuiltIn repl_env "-" sub + defBuiltIn repl_env "*" mult + defBuiltIn repl_env "/" divd + + load_history + repl_loop repl_env diff --git a/impls/haskell/step4_if_fn_do.hs b/impls/haskell/step4_if_fn_do.hs new file mode 100644 index 0000000000..355df30a06 --- /dev/null +++ b/impls/haskell/step4_if_fn_do.hs @@ -0,0 +1,148 @@ +import Control.Monad.Except (liftIO, runExceptT) +import Data.Foldable (foldlM) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) +import Env +import Core (ns) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args + +apply_ast (MalSymbol "if") [a1, a2, a3] env = do + cond <- eval env a1 + eval env $ case cond of + Nil -> a3 + MalBoolean False -> a3 + _ -> a2 +apply_ast (MalSymbol "if") [a1, a2] env = do + cond <- eval env a1 + case cond of + Nil -> return Nil + MalBoolean False -> return Nil + _ -> eval env a2 +apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" + +apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where + fn :: [MalVal] -> IOThrows MalVal + fn args = do + fn_env <- liftIO $ env_new $ Just env + let loop [] [] = eval fn_env ast + loop [MalSymbol "&", k] vs = loop [k] [toList vs] + loop (MalSymbol k : ks) (v : vs) = do + liftIO $ env_set fn_env k v + loop ks vs + loop _ _ = do + p <- liftIO $ _pr_list True " " params + a <- liftIO $ _pr_list True " " args + throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p + loop params args +apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +-- Read and evaluate a line. Ignore successful results, else print +-- an error message case of error. +-- The error function seems appropriate, but has no effect. +re :: Env -> String -> IO () +re repl_env line = do + res <- runExceptT $ eval repl_env =<< mal_read line + case res of + Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv + Right _ -> return () + +defBuiltIn :: Env -> (String, Fn) -> IO () +defBuiltIn env (sym, f) = + env_set env sym $ MalFunction (MetaData Nil) f + +main :: IO () +main = do + repl_env <- env_new Nothing + + -- core.hs: defined using Haskell + mapM_ (defBuiltIn repl_env) Core.ns + + -- core.mal: defined using the language itself + re repl_env "(def! not (fn* (a) (if a false true)))" + + load_history + repl_loop repl_env diff --git a/impls/haskell/step5_tco.hs b/impls/haskell/step5_tco.hs new file mode 100644 index 0000000000..355df30a06 --- /dev/null +++ b/impls/haskell/step5_tco.hs @@ -0,0 +1,148 @@ +import Control.Monad.Except (liftIO, runExceptT) +import Data.Foldable (foldlM) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) +import Env +import Core (ns) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args + +apply_ast (MalSymbol "if") [a1, a2, a3] env = do + cond <- eval env a1 + eval env $ case cond of + Nil -> a3 + MalBoolean False -> a3 + _ -> a2 +apply_ast (MalSymbol "if") [a1, a2] env = do + cond <- eval env a1 + case cond of + Nil -> return Nil + MalBoolean False -> return Nil + _ -> eval env a2 +apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" + +apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where + fn :: [MalVal] -> IOThrows MalVal + fn args = do + fn_env <- liftIO $ env_new $ Just env + let loop [] [] = eval fn_env ast + loop [MalSymbol "&", k] vs = loop [k] [toList vs] + loop (MalSymbol k : ks) (v : vs) = do + liftIO $ env_set fn_env k v + loop ks vs + loop _ _ = do + p <- liftIO $ _pr_list True " " params + a <- liftIO $ _pr_list True " " args + throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p + loop params args +apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +-- Read and evaluate a line. Ignore successful results, else print +-- an error message case of error. +-- The error function seems appropriate, but has no effect. +re :: Env -> String -> IO () +re repl_env line = do + res <- runExceptT $ eval repl_env =<< mal_read line + case res of + Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv + Right _ -> return () + +defBuiltIn :: Env -> (String, Fn) -> IO () +defBuiltIn env (sym, f) = + env_set env sym $ MalFunction (MetaData Nil) f + +main :: IO () +main = do + repl_env <- env_new Nothing + + -- core.hs: defined using Haskell + mapM_ (defBuiltIn repl_env) Core.ns + + -- core.mal: defined using the language itself + re repl_env "(def! not (fn* (a) (if a false true)))" + + load_history + repl_loop repl_env diff --git a/impls/haskell/step6_file.hs b/impls/haskell/step6_file.hs new file mode 100644 index 0000000000..9b7e7dad37 --- /dev/null +++ b/impls/haskell/step6_file.hs @@ -0,0 +1,164 @@ +import System.Environment (getArgs) +import Control.Monad.Except (liftIO, runExceptT) +import Data.Foldable (foldlM) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) +import Env +import Core (ns) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args + +apply_ast (MalSymbol "if") [a1, a2, a3] env = do + cond <- eval env a1 + eval env $ case cond of + Nil -> a3 + MalBoolean False -> a3 + _ -> a2 +apply_ast (MalSymbol "if") [a1, a2] env = do + cond <- eval env a1 + case cond of + Nil -> return Nil + MalBoolean False -> return Nil + _ -> eval env a2 +apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" + +apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where + fn :: [MalVal] -> IOThrows MalVal + fn args = do + fn_env <- liftIO $ env_new $ Just env + let loop [] [] = eval fn_env ast + loop [MalSymbol "&", k] vs = loop [k] [toList vs] + loop (MalSymbol k : ks) (v : vs) = do + liftIO $ env_set fn_env k v + loop ks vs + loop _ _ = do + p <- liftIO $ _pr_list True " " params + a <- liftIO $ _pr_list True " " args + throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p + loop params args +apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +-- Read and evaluate a line. Ignore successful results, else print +-- an error message case of error. +-- The error function seems appropriate, but has no effect. +re :: Env -> String -> IO () +re repl_env line = do + res <- runExceptT $ eval repl_env =<< mal_read line + case res of + Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv + Right _ -> return () + +defBuiltIn :: Env -> (String, Fn) -> IO () +defBuiltIn env (sym, f) = + env_set env sym $ MalFunction (MetaData Nil) f + +evalFn :: Env -> Fn +evalFn env [ast] = eval env ast +evalFn _ _ = throwStr "illegal call of eval" + +main :: IO () +main = do + args <- getArgs + + repl_env <- env_new Nothing + + -- core.hs: defined using Haskell + mapM_ (defBuiltIn repl_env) Core.ns + defBuiltIn repl_env ("eval", evalFn repl_env) + + -- core.mal: defined using the language itself + re repl_env "(def! not (fn* (a) (if a false true)))" + re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + + case args of + script : scriptArgs -> do + env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs + re repl_env $ "(load-file \"" ++ script ++ "\")" + [] -> do + env_set repl_env "*ARGV*" $ toList [] + + load_history + repl_loop repl_env diff --git a/impls/haskell/step7_quote.hs b/impls/haskell/step7_quote.hs new file mode 100644 index 0000000000..4407b2f369 --- /dev/null +++ b/impls/haskell/step7_quote.hs @@ -0,0 +1,188 @@ +import System.Environment (getArgs) +import Control.Monad.Except (liftIO, runExceptT) +import Data.Foldable (foldlM, foldrM) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) +import Env +import Core (ns) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] + +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast (MalSymbol "quote") [a1] _ = return a1 +apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" + +apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 +apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" + +apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args + +apply_ast (MalSymbol "if") [a1, a2, a3] env = do + cond <- eval env a1 + eval env $ case cond of + Nil -> a3 + MalBoolean False -> a3 + _ -> a2 +apply_ast (MalSymbol "if") [a1, a2] env = do + cond <- eval env a1 + case cond of + Nil -> return Nil + MalBoolean False -> return Nil + _ -> eval env a2 +apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" + +apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where + fn :: [MalVal] -> IOThrows MalVal + fn args = do + fn_env <- liftIO $ env_new $ Just env + let loop [] [] = eval fn_env ast + loop [MalSymbol "&", k] vs = loop [k] [toList vs] + loop (MalSymbol k : ks) (v : vs) = do + liftIO $ env_set fn_env k v + loop ks vs + loop _ _ = do + p <- liftIO $ _pr_list True " " params + a <- liftIO $ _pr_list True " " args + throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p + loop params args +apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +-- Read and evaluate a line. Ignore successful results, else print +-- an error message case of error. +-- The error function seems appropriate, but has no effect. +re :: Env -> String -> IO () +re repl_env line = do + res <- runExceptT $ eval repl_env =<< mal_read line + case res of + Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv + Right _ -> return () + +defBuiltIn :: Env -> (String, Fn) -> IO () +defBuiltIn env (sym, f) = + env_set env sym $ MalFunction (MetaData Nil) f + +evalFn :: Env -> Fn +evalFn env [ast] = eval env ast +evalFn _ _ = throwStr "illegal call of eval" + +main :: IO () +main = do + args <- getArgs + + repl_env <- env_new Nothing + + -- core.hs: defined using Haskell + mapM_ (defBuiltIn repl_env) Core.ns + defBuiltIn repl_env ("eval", evalFn repl_env) + + -- core.mal: defined using the language itself + re repl_env "(def! not (fn* (a) (if a false true)))" + re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + + case args of + script : scriptArgs -> do + env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs + re repl_env $ "(load-file \"" ++ script ++ "\")" + [] -> do + env_set repl_env "*ARGV*" $ toList [] + + load_history + repl_loop repl_env diff --git a/impls/haskell/step8_macros.hs b/impls/haskell/step8_macros.hs new file mode 100644 index 0000000000..72d1243c86 --- /dev/null +++ b/impls/haskell/step8_macros.hs @@ -0,0 +1,200 @@ +import System.Environment (getArgs) +import Control.Monad.Except (liftIO, runExceptT) +import Data.Foldable (foldlM, foldrM) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) +import Env +import Core (ns) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] + +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast (MalSymbol "quote") [a1] _ = return a1 +apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" + +apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 +apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" + +apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do + func <- eval env a2 + case func of + MalFunction _ f -> do + let m = MalMacro f + liftIO $ env_set env a1 m + return m + _ -> throwStr "defmacro! on non-function" +apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" + +apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args + +apply_ast (MalSymbol "if") [a1, a2, a3] env = do + cond <- eval env a1 + eval env $ case cond of + Nil -> a3 + MalBoolean False -> a3 + _ -> a2 +apply_ast (MalSymbol "if") [a1, a2] env = do + cond <- eval env a1 + case cond of + Nil -> return Nil + MalBoolean False -> return Nil + _ -> eval env a2 +apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" + +apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where + fn :: [MalVal] -> IOThrows MalVal + fn args = do + fn_env <- liftIO $ env_new $ Just env + let loop [] [] = eval fn_env ast + loop [MalSymbol "&", k] vs = loop [k] [toList vs] + loop (MalSymbol k : ks) (v : vs) = do + liftIO $ env_set fn_env k v + loop ks vs + loop _ _ = do + p <- liftIO $ _pr_list True " " params + a <- liftIO $ _pr_list True " " args + throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p + loop params args +apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + MalMacro m -> eval env =<< m rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +-- Read and evaluate a line. Ignore successful results, else print +-- an error message case of error. +-- The error function seems appropriate, but has no effect. +re :: Env -> String -> IO () +re repl_env line = do + res <- runExceptT $ eval repl_env =<< mal_read line + case res of + Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv + Right _ -> return () + +defBuiltIn :: Env -> (String, Fn) -> IO () +defBuiltIn env (sym, f) = + env_set env sym $ MalFunction (MetaData Nil) f + +evalFn :: Env -> Fn +evalFn env [ast] = eval env ast +evalFn _ _ = throwStr "illegal call of eval" + +main :: IO () +main = do + args <- getArgs + + repl_env <- env_new Nothing + + -- core.hs: defined using Haskell + mapM_ (defBuiltIn repl_env) Core.ns + defBuiltIn repl_env ("eval", evalFn repl_env) + + -- core.mal: defined using the language itself + re repl_env "(def! not (fn* (a) (if a false true)))" + re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + re repl_env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + + case args of + script : scriptArgs -> do + env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs + re repl_env $ "(load-file \"" ++ script ++ "\")" + [] -> do + env_set repl_env "*ARGV*" $ toList [] + + load_history + repl_loop repl_env diff --git a/impls/haskell/step9_try.hs b/impls/haskell/step9_try.hs new file mode 100644 index 0000000000..cd4ba3a492 --- /dev/null +++ b/impls/haskell/step9_try.hs @@ -0,0 +1,208 @@ +import System.Environment (getArgs) +import Control.Monad.Except (catchError, liftIO, runExceptT) +import Data.Foldable (foldlM, foldrM) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) +import Env +import Core (ns) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] + +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast (MalSymbol "quote") [a1] _ = return a1 +apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" + +apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 +apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" + +apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do + func <- eval env a2 + case func of + MalFunction _ f -> do + let m = MalMacro f + liftIO $ env_set env a1 m + return m + _ -> throwStr "defmacro! on non-function" +apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" + +apply_ast (MalSymbol "try*") [a1] env = eval env a1 +apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", MalSymbol a21, a22]] env = + catchError (eval env a1) $ \exc -> do + try_env <- liftIO $ env_new $ Just env + liftIO $ env_set try_env a21 exc + eval try_env a22 +apply_ast (MalSymbol "try*") _ _ = throwStr "invalid try*" + +apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args + +apply_ast (MalSymbol "if") [a1, a2, a3] env = do + cond <- eval env a1 + eval env $ case cond of + Nil -> a3 + MalBoolean False -> a3 + _ -> a2 +apply_ast (MalSymbol "if") [a1, a2] env = do + cond <- eval env a1 + case cond of + Nil -> return Nil + MalBoolean False -> return Nil + _ -> eval env a2 +apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" + +apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where + fn :: [MalVal] -> IOThrows MalVal + fn args = do + fn_env <- liftIO $ env_new $ Just env + let loop [] [] = eval fn_env ast + loop [MalSymbol "&", k] vs = loop [k] [toList vs] + loop (MalSymbol k : ks) (v : vs) = do + liftIO $ env_set fn_env k v + loop ks vs + loop _ _ = do + p <- liftIO $ _pr_list True " " params + a <- liftIO $ _pr_list True " " args + throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p + loop params args +apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + MalMacro m -> eval env =<< m rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +-- Read and evaluate a line. Ignore successful results, else print +-- an error message case of error. +-- The error function seems appropriate, but has no effect. +re :: Env -> String -> IO () +re repl_env line = do + res <- runExceptT $ eval repl_env =<< mal_read line + case res of + Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv + Right _ -> return () + +defBuiltIn :: Env -> (String, Fn) -> IO () +defBuiltIn env (sym, f) = + env_set env sym $ MalFunction (MetaData Nil) f + +evalFn :: Env -> Fn +evalFn env [ast] = eval env ast +evalFn _ _ = throwStr "illegal call of eval" + +main :: IO () +main = do + args <- getArgs + + repl_env <- env_new Nothing + + -- core.hs: defined using Haskell + mapM_ (defBuiltIn repl_env) Core.ns + defBuiltIn repl_env ("eval", evalFn repl_env) + + -- core.mal: defined using the language itself + re repl_env "(def! not (fn* (a) (if a false true)))" + re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + re repl_env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + + case args of + script : scriptArgs -> do + env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs + re repl_env $ "(load-file \"" ++ script ++ "\")" + [] -> do + env_set repl_env "*ARGV*" $ toList [] + + load_history + repl_loop repl_env diff --git a/impls/haskell/stepA_mal.hs b/impls/haskell/stepA_mal.hs new file mode 100644 index 0000000000..0f3c680489 --- /dev/null +++ b/impls/haskell/stepA_mal.hs @@ -0,0 +1,210 @@ +import System.Environment (getArgs) +import Control.Monad.Except (catchError, liftIO, runExceptT) +import Data.Foldable (foldlM, foldrM) + +import Readline (addHistory, readline, load_history) +import Types +import Reader (read_str) +import Printer(_pr_list, _pr_str) +import Env +import Core (ns) + +-- read + +mal_read :: String -> IOThrows MalVal +mal_read = read_str + +-- eval + +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] + +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast + +let_bind :: Env -> [MalVal] -> IOThrows () +let_bind _ [] = return () +let_bind env (MalSymbol b : e : xs) = do + liftIO . env_set env b =<< eval env e + let_bind env xs +let_bind _ _ = throwStr "invalid let*" + +apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal + +apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do + evd <- eval env a2 + liftIO $ env_set env a1 evd + return evd +apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" + +apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do + let_env <- liftIO $ env_new $ Just env + let_bind let_env params + eval let_env a2 +apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" + +apply_ast (MalSymbol "quote") [a1] _ = return a1 +apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" + +apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 +apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" + +apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do + func <- eval env a2 + case func of + MalFunction _ f -> do + let m = MalMacro f + liftIO $ env_set env a1 m + return m + _ -> throwStr "defmacro! on non-function" +apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" + +apply_ast (MalSymbol "try*") [a1] env = eval env a1 +apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", MalSymbol a21, a22]] env = + catchError (eval env a1) $ \exc -> do + try_env <- liftIO $ env_new $ Just env + liftIO $ env_set try_env a21 exc + eval try_env a22 +apply_ast (MalSymbol "try*") _ _ = throwStr "invalid try*" + +apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args + +apply_ast (MalSymbol "if") [a1, a2, a3] env = do + cond <- eval env a1 + eval env $ case cond of + Nil -> a3 + MalBoolean False -> a3 + _ -> a2 +apply_ast (MalSymbol "if") [a1, a2] env = do + cond <- eval env a1 + case cond of + Nil -> return Nil + MalBoolean False -> return Nil + _ -> eval env a2 +apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" + +apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where + fn :: [MalVal] -> IOThrows MalVal + fn args = do + fn_env <- liftIO $ env_new $ Just env + let loop [] [] = eval fn_env ast + loop [MalSymbol "&", k] vs = loop [k] [toList vs] + loop (MalSymbol k : ks) (v : vs) = do + liftIO $ env_set fn_env k v + loop ks vs + loop _ _ = do + p <- liftIO $ _pr_list True " " params + a <- liftIO $ _pr_list True " " args + throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p + loop params args +apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" + +apply_ast first rest env = do + evd <- eval env first + case evd of + MalFunction _ f -> f =<< mapM (eval env) rest + MalMacro m -> eval env =<< m rest + _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) + +eval :: Env -> MalVal -> IOThrows MalVal +eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" + case traceEval of + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do + putStr "EVAL: " + putStr =<< _pr_str True ast + putStr " " + env_put env + putStrLn "" + case ast of + MalSymbol sym -> do + maybeVal <- liftIO $ env_get env sym + case maybeVal of + Nothing -> throwStr $ "'" ++ sym ++ "' not found" + Just val -> return val + MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env + MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs + MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs + _ -> return ast + +-- print + +mal_print :: MalVal -> IO String +mal_print = _pr_str True + +-- repl + +repl_loop :: Env -> IO () +repl_loop env = do + line <- readline "user> " + case line of + Nothing -> return () + Just "" -> repl_loop env + Just str -> do + addHistory str + res <- runExceptT $ eval env =<< mal_read str + out <- case res of + Left mv -> (++) "Error: " <$> mal_print mv + Right val -> mal_print val + putStrLn out + repl_loop env + +-- Read and evaluate a line. Ignore successful results, else print +-- an error message case of error. +-- The error function seems appropriate, but has no effect. +re :: Env -> String -> IO () +re repl_env line = do + res <- runExceptT $ eval repl_env =<< mal_read line + case res of + Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv + Right _ -> return () + +defBuiltIn :: Env -> (String, Fn) -> IO () +defBuiltIn env (sym, f) = + env_set env sym $ MalFunction (MetaData Nil) f + +evalFn :: Env -> Fn +evalFn env [ast] = eval env ast +evalFn _ _ = throwStr "illegal call of eval" + +main :: IO () +main = do + args <- getArgs + + repl_env <- env_new Nothing + + -- core.hs: defined using Haskell + mapM_ (defBuiltIn repl_env) Core.ns + defBuiltIn repl_env ("eval", evalFn repl_env) + + -- core.mal: defined using the language itself + re repl_env "(def! *host-language* \"haskell\")" + re repl_env "(def! not (fn* (a) (if a false true)))" + re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + re repl_env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + + case args of + script : scriptArgs -> do + env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs + re repl_env $ "(load-file \"" ++ script ++ "\")" + [] -> do + env_set repl_env "*ARGV*" $ toList [] + re repl_env "(println (str \"Mal [\" *host-language* \"]\"))" + + load_history + repl_loop repl_env diff --git a/impls/haskell/tests/step5_tco.mal b/impls/haskell/tests/step5_tco.mal new file mode 100644 index 0000000000..eb5ace7418 --- /dev/null +++ b/impls/haskell/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Haskell: skipping non-TCO recursion +;; Reason: completes up to 100,000, stackoverflow at 1,000,000 diff --git a/impls/haxe/Compat.hx b/impls/haxe/Compat.hx new file mode 100644 index 0000000000..720593ac82 --- /dev/null +++ b/impls/haxe/Compat.hx @@ -0,0 +1,70 @@ +#if js + @:native("console") + extern class Console { + public static function log(s:Dynamic):Void; + } + + @:native("process") + extern class Process { + public static var argv(default,null):Array; + public static function exit(code:Int):Void; + } + + @:jsRequire("fs") + extern class FS { + static function readFileSync(filename:String, + options:{encoding:String}):String; + } + + @:jsRequire("./node_readline") + extern class RL { + static function readline(prompt:String):Null; + } +#end + +class Compat { + public static function println(s:String) { + #if js + Console.log(s); + #else + Sys.println(s); + #end + } + + public static function slurp(filename:String) { + #if js + return FS.readFileSync(filename, {encoding: "utf-8"}); + #else + return sys.io.File.getContent(filename); + #end + } + + public static function exit(code:Int) { + #if js + Process.exit(0); + #else + Sys.exit(0); + #end + } + + public static function cmdline_args() { + #if js + return Process.argv.slice(2); + #else + return Sys.args(); + #end + } + + public static function readline(prompt:String) { + #if js + var line = RL.readline(prompt); + if (line == null) { throw new haxe.io.Eof(); } + #else + Sys.print(prompt); + var line = Sys.stdin().readLine(); + #end + return line; + } + + +} diff --git a/impls/haxe/Dockerfile b/impls/haxe/Dockerfile new file mode 100644 index 0000000000..4ce1f7e6db --- /dev/null +++ b/impls/haxe/Dockerfile @@ -0,0 +1,31 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Haxe +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install haxe + +ENV NPM_CONFIG_CACHE /mal/.npm +ENV HOME / + +RUN mkdir /haxelib && haxelib setup /haxelib +# Install support for C++ compilation +RUN haxelib install hxcpp diff --git a/impls/haxe/Makefile b/impls/haxe/Makefile new file mode 100644 index 0000000000..4d2133ab33 --- /dev/null +++ b/impls/haxe/Makefile @@ -0,0 +1,104 @@ +STEP1_DEPS = Compat.hx types/Types.hx reader/Reader.hx printer/Printer.hx +STEP3_DEPS = $(STEP1_DEPS) env/Env.hx +STEP4_DEPS = $(STEP3_DEPS) core/Core.hx + +STEPS = step0_repl step1_read_print step2_eval step3_env \ + step4_if_fn_do step5_tco step6_file step7_quote \ + step8_macros step9_try stepA_mal + +haxe_MODE ?= neko +dist_neko = mal.n +dist_python = mal.py +dist_cpp = cpp/mal + +all: all-$(haxe_MODE) + +all-neko: $(foreach x,$(STEPS),$(x).n) + +all-python: $(foreach x,$(STEPS),$(x).py) + +all-cpp: $(foreach x,$(STEPS),cpp/$(x)) + +all-js: $(foreach x,$(STEPS),$(x).js) + +dist: mal.n mal.py cpp/mal mal.js mal + +mal.n: stepA_mal.n + cp $< $@ + +mal.py: stepA_mal.py + cp $< $@ + +cpp/mal: cpp/stepA_mal + cp $< $@ + +mal.js: stepA_mal.js + cp $< $@ + + +mal: $(dist_$(haxe_MODE)) + $(if $(filter cpp,$(haxe_MODE)),\ + cp $< $@;,\ + $(if $(filter neko,$(haxe_MODE)),\ + nekotools boot $<;,\ + $(if $(filter js,$(haxe_MODE)),\ + echo "#!/usr/bin/env node" > $@;\ + cat $< >> $@;,\ + $(if $(filter python,$(haxe_MODE)),\ + echo "#!/usr/bin/env python3" > $@;\ + cat $< >> $@;,\ + $(error Invalid haxe_MODE: $(haxe_MODE)))))) + chmod +x $@ + + +# Neko target (neko) + +s%.n: S%.hx + haxe -main $(patsubst %.hx,%,$<) -neko $@ + +step1_read_print.n step2_eval.n: $(STEP1_DEPS) +step3_env.n: $(STEP3_DEPS) +step4_if_fn_do.n step5_tco.n step6_file.n step7_quote.n step8_macros.n step9_try.n stepA_mal.n: $(STEP4_DEPS) + + +# Python 3 target (python) + +s%.py: S%.hx + haxe -main $(patsubst %.hx,%,$<) -python $@ + +step1_read_print.py step2_eval.py: $(STEP1_DEPS) +step3_env.py: $(STEP3_DEPS) +step4_if_fn_do.py step5_tco.py step6_file.py step7_quote.py step8_macros.py step9_try.py stepA_mal.py: $(STEP4_DEPS) + + +# C++ target (cpp) + +cpp/s%: S%.hx + haxe -main $(patsubst %.hx,%,$<) -cpp cpp + cp $(patsubst cpp/s%,cpp/S%,$@) $@ + +cpp/step1_read_print cpp/step2_eval: $(STEP1_DEPS) +cpp/step3_env: $(STEP3_DEPS) +cpp/step4_if_fn_do cpp/step5_tco cpp/step6_file cpp/step7_quote cpp/step8_macros cpp/step9_try cpp/stepA_mal: $(STEP4_DEPS) + + +# JavaScript target (js) + +s%.js: S%.hx + haxe -main $(patsubst %.hx,%,$<) -js $@ + +JS_DEPS = node_readline.js node_modules +step0_repl.js: $(JS_DEPS) +step1_read_print.js step2_eval.js: $(STEP1_DEPS) $(JS_DEPS) +step3_env.js: $(STEP3_DEPS) $(JS_DEPS) +step4_if_fn_do.js step5_tco.js step6_file.js step7_quote.js step8_macros.js step9_try.js stepA_mal.js: $(STEP4_DEPS) $(JS_DEPS) + +node_modules: + npm install + +### + +clean: + rm -f mal.n mal.py cpp/mal mal.js mal + rm -f step*.py step*.js step*.n + [ -e cpp/ ] && rm -r cpp/ || true diff --git a/impls/haxe/Step0_repl.hx b/impls/haxe/Step0_repl.hx new file mode 100644 index 0000000000..d34806a8e3 --- /dev/null +++ b/impls/haxe/Step0_repl.hx @@ -0,0 +1,36 @@ +import Compat; + +class Step0_repl { + // READ + static function READ(str:String) { + return str; + } + + // EVAL + static function EVAL(ast:String, env:String) { + return ast; + } + + // PRINT + static function PRINT(exp:String) { + return exp; + } + + // repl + static function rep(line:String) { + return PRINT(EVAL(READ(line), "")); + } + + public static function main() { + while (true) { + try { + var line = Compat.readline("user> "); + Compat.println(rep(line)); + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + Compat.println("Error: " + exc); + } + } + } +} diff --git a/impls/haxe/Step1_read_print.hx b/impls/haxe/Step1_read_print.hx new file mode 100644 index 0000000000..dd22fb95b2 --- /dev/null +++ b/impls/haxe/Step1_read_print.hx @@ -0,0 +1,42 @@ +import Compat; +import types.Types.MalType; +import reader.*; +import printer.*; + +class Step1_read_print { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function EVAL(ast:MalType, env:String) { + return ast; + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static function rep(line:String) { + return PRINT(EVAL(READ(line), "")); + } + + public static function main() { + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + Compat.println("Error: " + exc); + } + } + } +} diff --git a/impls/haxe/Step2_eval.hx b/impls/haxe/Step2_eval.hx new file mode 100644 index 0000000000..993eecdb65 --- /dev/null +++ b/impls/haxe/Step2_eval.hx @@ -0,0 +1,86 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import reader.*; +import printer.*; + +class Step2_eval { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function EVAL(ast:MalType, env:Map) { + // Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + if (env.exists(s)) { + return env.get(s); + } else { + throw "'" + s + "' not found"; + } + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch ( EVAL(alst[0], env)) { + case MalFunc(f,_,_,_,_,_): + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + return f(args); + case _: throw "Call of non-function"; + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static function NumOp(op):MalType { + return MalFunc(function(args:Array) { + return switch (args) { + case [MalInt(a), MalInt(b)]: MalInt(op(a,b)); + case _: throw "Invalid numeric op call"; + } + + },null,null,null,false,nil); + } + static var repl_env:Map = + ["+" => NumOp(function(a,b) {return a+b;}), + "-" => NumOp(function(a,b) {return a-b;}), + "*" => NumOp(function(a,b) {return a*b;}), + "/" => NumOp(function(a,b) {return Std.int(a/b);})]; + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + Compat.println("Error: " + exc); + } + } + } +} diff --git a/impls/haxe/Step3_env.hx b/impls/haxe/Step3_env.hx new file mode 100644 index 0000000000..eec34d028f --- /dev/null +++ b/impls/haxe/Step3_env.hx @@ -0,0 +1,103 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import reader.*; +import printer.*; +import env.*; + +class Step3_env { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function EVAL(ast:MalType, env:Env):MalType { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + return EVAL(alst[2], let_env); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,_,_,_,_,_): + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + return f(args); + case _: throw "Call of non-function"; + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static function NumOp(op):MalType { + return MalFunc(function(args:Array) { + return switch (args) { + case [MalInt(a), MalInt(b)]: MalInt(op(a,b)); + case _: throw "Invalid numeric op call"; + } + + },null,null,null,false,nil); + } + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + repl_env.set(MalSymbol("+"), NumOp(function(a,b) {return a+b;})); + repl_env.set(MalSymbol("-"), NumOp(function(a,b) {return a-b;})); + repl_env.set(MalSymbol("*"), NumOp(function(a,b) {return a*b;})); + repl_env.set(MalSymbol("/"), NumOp(function(a,b) {return Std.int(a/b);})); + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + Compat.println("Error: " + exc); + } + } + } +} diff --git a/impls/haxe/Step4_if_fn_do.hx b/impls/haxe/Step4_if_fn_do.hx new file mode 100644 index 0000000000..d48d9cc052 --- /dev/null +++ b/impls/haxe/Step4_if_fn_do.hx @@ -0,0 +1,121 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import reader.*; +import printer.*; +import env.*; +import core.*; + +class Step4_if_fn_do { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function EVAL(ast:MalType, env:Env):MalType { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + return EVAL(alst[2], let_env); + case MalSymbol("do"): + for (i in 1...alst.length-1) + EVAL(alst[i], env); + return EVAL(alst[alst.length-1], env); + case MalSymbol("if"): + var cond = EVAL(alst[1], env); + if (cond != MalFalse && cond != MalNil) { + return EVAL(alst[2], env); + } else if (alst.length > 3) { + return EVAL(alst[3], env); + } else { + return MalNil; + } + case MalSymbol("fn*"): + return MalFunc(function (args) { + return EVAL(alst[2], new Env(env, _list(alst[1]), args)); + },null,null,null,false,nil); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,_,_,_,_,_): + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + return f(args); + case _: throw "Call of non-function"; + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + // core.EXT: defined using Haxe + for (k in Core.ns.keys()) { + repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); + } + + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))"); + + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; + } + } + } +} diff --git a/impls/haxe/Step5_tco.hx b/impls/haxe/Step5_tco.hx new file mode 100644 index 0000000000..7176aca768 --- /dev/null +++ b/impls/haxe/Step5_tco.hx @@ -0,0 +1,133 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import reader.*; +import printer.*; +import env.*; +import core.*; + +class Step5_tco { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + ast = alst[2]; + env = let_env; + continue; // TCO + case MalSymbol("do"): + for (i in 1...alst.length-1) + EVAL(alst[i], env); + ast = alst[alst.length-1]; + continue; // TCO + case MalSymbol("if"): + var cond = EVAL(alst[1], env); + if (cond != MalFalse && cond != MalNil) { + ast = alst[2]; + } else if (alst.length > 3) { + ast = alst[3]; + } else { + return MalNil; + } + continue; // TCO + case MalSymbol("fn*"): + return MalFunc(function (args) { + return EVAL(alst[2], new Env(env, _list(alst[1]), args)); + },alst[2],env,alst[1],false,nil); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,a,e,params,_,_): + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + if (a != null) { + ast = a; + env = new Env(e, _list(params), args); + continue; // TCO + } else { + return f(args); + } + case _: throw "Call of non-function"; + } + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + // core.EXT: defined using Haxe + for (k in Core.ns.keys()) { + repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); + } + + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))"); + + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; + } + } + } +} diff --git a/impls/haxe/Step6_file.hx b/impls/haxe/Step6_file.hx new file mode 100644 index 0000000000..fab62295c6 --- /dev/null +++ b/impls/haxe/Step6_file.hx @@ -0,0 +1,148 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import reader.*; +import printer.*; +import env.*; +import core.*; + +class Step6_file { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + ast = alst[2]; + env = let_env; + continue; // TCO + case MalSymbol("do"): + for (i in 1...alst.length-1) + EVAL(alst[i], env); + ast = alst[alst.length-1]; + continue; // TCO + case MalSymbol("if"): + var cond = EVAL(alst[1], env); + if (cond != MalFalse && cond != MalNil) { + ast = alst[2]; + } else if (alst.length > 3) { + ast = alst[3]; + } else { + return MalNil; + } + continue; // TCO + case MalSymbol("fn*"): + return MalFunc(function (args) { + return EVAL(alst[2], new Env(env, _list(alst[1]), args)); + },alst[2],env,alst[1],false,nil); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,a,e,params,_,_): + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + if (a != null) { + ast = a; + env = new Env(e, _list(params), args); + continue; // TCO + } else { + return f(args); + } + case _: throw "Call of non-function"; + } + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + // core.EXT: defined using Haxe + for (k in Core.ns.keys()) { + repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); + } + + var evalfn = MalFunc(function(args) { + return EVAL(args[0], repl_env); + },null,null,null,false,nil); + repl_env.set(MalSymbol("eval"), evalfn); + + var cmdargs = Compat.cmdline_args(); + var argarray = cmdargs.map(function(a) { return MalString(a); }); + repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); + + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))"); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + + if (cmdargs.length > 0) { + rep('(load-file "${cmdargs[0]}")'); + Compat.exit(0); + } + + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; + } + } + } +} diff --git a/impls/haxe/Step7_quote.hx b/impls/haxe/Step7_quote.hx new file mode 100644 index 0000000000..93b7009dac --- /dev/null +++ b/impls/haxe/Step7_quote.hx @@ -0,0 +1,178 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import reader.*; +import printer.*; +import env.*; +import core.*; + +class Step7_quote { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); + } + } + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } + static function quasiquote(ast:MalType) { + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; + } + } + + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + ast = alst[2]; + env = let_env; + continue; // TCO + case MalSymbol("quote"): + return alst[1]; + case MalSymbol("quasiquote"): + ast = quasiquote(alst[1]); + continue; // TCO + case MalSymbol("do"): + for (i in 1...alst.length-1) + EVAL(alst[i], env); + ast = alst[alst.length-1]; + continue; // TCO + case MalSymbol("if"): + var cond = EVAL(alst[1], env); + if (cond != MalFalse && cond != MalNil) { + ast = alst[2]; + } else if (alst.length > 3) { + ast = alst[3]; + } else { + return MalNil; + } + continue; // TCO + case MalSymbol("fn*"): + return MalFunc(function (args) { + return EVAL(alst[2], new Env(env, _list(alst[1]), args)); + },alst[2],env,alst[1],false,nil); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,a,e,params,_,_): + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + if (a != null) { + ast = a; + env = new Env(e, _list(params), args); + continue; // TCO + } else { + return f(args); + } + case _: throw "Call of non-function"; + } + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + // core.EXT: defined using Haxe + for (k in Core.ns.keys()) { + repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); + } + + var evalfn = MalFunc(function(args) { + return EVAL(args[0], repl_env); + },null,null,null,false,nil); + repl_env.set(MalSymbol("eval"), evalfn); + + var cmdargs = Compat.cmdline_args(); + var argarray = cmdargs.map(function(a) { return MalString(a); }); + repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); + + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))"); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + + if (cmdargs.length > 0) { + rep('(load-file "${cmdargs[0]}")'); + Compat.exit(0); + } + + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; + } + } + } +} diff --git a/impls/haxe/Step8_macros.hx b/impls/haxe/Step8_macros.hx new file mode 100644 index 0000000000..bef3954eef --- /dev/null +++ b/impls/haxe/Step8_macros.hx @@ -0,0 +1,192 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import reader.*; +import printer.*; +import env.*; +import core.*; + +class Step8_macros { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); + } + } + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } + static function quasiquote(ast:MalType) { + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; + } + } + + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + ast = alst[2]; + env = let_env; + continue; // TCO + case MalSymbol("quote"): + return alst[1]; + case MalSymbol("quasiquote"): + ast = quasiquote(alst[1]); + continue; // TCO + case MalSymbol("defmacro!"): + var func = EVAL(alst[2], env); + return switch (func) { + case MalFunc(f,ast,e,params,_,_): + env.set(alst[1], MalFunc(f,ast,e,params,true,nil)); + case _: + throw "Invalid defmacro! call"; + } + case MalSymbol("do"): + for (i in 1...alst.length-1) + EVAL(alst[i], env); + ast = alst[alst.length-1]; + continue; // TCO + case MalSymbol("if"): + var cond = EVAL(alst[1], env); + if (cond != MalFalse && cond != MalNil) { + ast = alst[2]; + } else if (alst.length > 3) { + ast = alst[3]; + } else { + return MalNil; + } + continue; // TCO + case MalSymbol("fn*"): + return MalFunc(function (args) { + return EVAL(alst[2], new Env(env, _list(alst[1]), args)); + },alst[2],env,alst[1],false,nil); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,a,e,params,ismacro,_): + if (ismacro) { + ast = f(alst.slice(1)); + continue; // TCO + } + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + if (a != null) { + ast = a; + env = new Env(e, _list(params), args); + continue; // TCO + } else { + return f(args); + } + case _: throw "Call of non-function"; + } + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + // core.EXT: defined using Haxe + for (k in Core.ns.keys()) { + repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); + } + + var evalfn = MalFunc(function(args) { + return EVAL(args[0], repl_env); + },null,null,null,false,nil); + repl_env.set(MalSymbol("eval"), evalfn); + + var cmdargs = Compat.cmdline_args(); + var argarray = cmdargs.map(function(a) { return MalString(a); }); + repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); + + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))"); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + + if (cmdargs.length > 0) { + rep('(load-file "${cmdargs[0]}")'); + Compat.exit(0); + } + + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; + } + } + } +} diff --git a/impls/haxe/Step9_try.hx b/impls/haxe/Step9_try.hx new file mode 100644 index 0000000000..651c96d092 --- /dev/null +++ b/impls/haxe/Step9_try.hx @@ -0,0 +1,214 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import reader.*; +import printer.*; +import env.*; +import core.*; +import haxe.rtti.Meta; + +class Step9_try { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); + } + } + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } + static function quasiquote(ast:MalType) { + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; + } + } + + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + ast = alst[2]; + env = let_env; + continue; // TCO + case MalSymbol("quote"): + return alst[1]; + case MalSymbol("quasiquote"): + ast = quasiquote(alst[1]); + continue; // TCO + case MalSymbol("defmacro!"): + var func = EVAL(alst[2], env); + return switch (func) { + case MalFunc(f,ast,e,params,_,_): + env.set(alst[1], MalFunc(f,ast,e,params,true,nil)); + case _: + throw "Invalid defmacro! call"; + } + case MalSymbol("try*"): + try { + return EVAL(alst[1], env); + } catch (err:Dynamic) { + if (alst.length > 2) { + switch (alst[2]) { + case MalList([MalSymbol("catch*"), a21, a22]): + var exc; + if (Type.getClass(err) == MalException) { + exc = err.obj; + } else { + exc = MalString(Std.string(err)); + }; + return EVAL(a22, new Env(env, [a21], [exc])); + case _: + throw err; + } + } else { + throw err; + } + } + case MalSymbol("do"): + for (i in 1...alst.length-1) + EVAL(alst[i], env); + ast = alst[alst.length-1]; + continue; // TCO + case MalSymbol("if"): + var cond = EVAL(alst[1], env); + if (cond != MalFalse && cond != MalNil) { + ast = alst[2]; + } else if (alst.length > 3) { + ast = alst[3]; + } else { + return MalNil; + } + continue; // TCO + case MalSymbol("fn*"): + return MalFunc(function (args) { + return EVAL(alst[2], new Env(env, _list(alst[1]), args)); + },alst[2],env,alst[1],false,nil); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,a,e,params,ismacro,_): + if (ismacro) { + ast = f(alst.slice(1)); + continue; // TCO + } + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + if (a != null) { + ast = a; + env = new Env(e, _list(params), args); + continue; // TCO + } else { + return f(args); + } + case _: throw "Call of non-function"; + } + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + // core.EXT: defined using Haxe + for (k in Core.ns.keys()) { + repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); + } + + var evalfn = MalFunc(function(args) { + return EVAL(args[0], repl_env); + },null,null,null,false,nil); + repl_env.set(MalSymbol("eval"), evalfn); + + var cmdargs = Compat.cmdline_args(); + var argarray = cmdargs.map(function(a) { return MalString(a); }); + repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); + + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))"); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + + if (cmdargs.length > 0) { + rep('(load-file "${cmdargs[0]}")'); + Compat.exit(0); + } + + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; + } + } + } +} diff --git a/impls/haxe/StepA_mal.hx b/impls/haxe/StepA_mal.hx new file mode 100644 index 0000000000..fe1e7c9536 --- /dev/null +++ b/impls/haxe/StepA_mal.hx @@ -0,0 +1,216 @@ +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import reader.*; +import printer.*; +import env.*; +import core.*; +import haxe.rtti.Meta; + +class StepA_mal { + // READ + static function READ(str:String):MalType { + return Reader.read_str(str); + } + + // EVAL + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); + } + } + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } + static function quasiquote(ast:MalType) { + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; + } + } + + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) + Compat.println("EVAL: " + PRINT(ast)); + var alst; + switch (ast) { + case MalSymbol(s): + var res = env.get(s); + if (res == null) throw "'" + s + "' not found"; + return res; + case MalList(l): + alst = l; + case MalVector(l): + return MalVector(l.map(function(x) { return EVAL(x, env); })); + case MalHashMap(m): + var new_map = new Map(); + for (k in m.keys()) { + new_map[k] = EVAL(m[k], env); + } + return MalHashMap(new_map); + case _: return ast; + } + // apply + if (alst.length == 0) { return ast; } + switch (alst[0]) { + case MalSymbol("def!"): + return env.set(alst[1], EVAL(alst[2], env)); + case MalSymbol("let*"): + var let_env = new Env(env); + switch (alst[1]) { + case MalList(l) | MalVector(l): + for (i in 0...l.length) { + if ((i%2) > 0) { continue; } + let_env.set(l[i], EVAL(l[i+1], let_env)); + } + case _: throw "Invalid let*"; + } + ast = alst[2]; + env = let_env; + continue; // TCO + case MalSymbol("quote"): + return alst[1]; + case MalSymbol("quasiquote"): + ast = quasiquote(alst[1]); + continue; // TCO + case MalSymbol("defmacro!"): + var func = EVAL(alst[2], env); + return switch (func) { + case MalFunc(f,ast,e,params,_,_): + env.set(alst[1], MalFunc(f,ast,e,params,true,nil)); + case _: + throw "Invalid defmacro! call"; + } + case MalSymbol("try*"): + try { + return EVAL(alst[1], env); + } catch (err:Dynamic) { + if (alst.length > 2) { + switch (alst[2]) { + case MalList([MalSymbol("catch*"), a21, a22]): + var exc; + if (Type.getClass(err) == MalException) { + exc = err.obj; + } else { + exc = MalString(Std.string(err)); + }; + return EVAL(a22, new Env(env, [a21], [exc])); + case _: + throw err; + } + } else { + throw err; + } + } + case MalSymbol("do"): + for (i in 1...alst.length-1) + EVAL(alst[i], env); + ast = alst[alst.length-1]; + continue; // TCO + case MalSymbol("if"): + var cond = EVAL(alst[1], env); + if (cond != MalFalse && cond != MalNil) { + ast = alst[2]; + } else if (alst.length > 3) { + ast = alst[3]; + } else { + return MalNil; + } + continue; // TCO + case MalSymbol("fn*"): + return MalFunc(function (args) { + return EVAL(alst[2], new Env(env, _list(alst[1]), args)); + },alst[2],env,alst[1],false,nil); + case _: + switch ( EVAL(alst[0], env)) { + case MalFunc(f,a,e,params,ismacro,_): + if (ismacro) { + ast = f(alst.slice(1)); + continue; // TCO + } + var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); + if (a != null) { + ast = a; + env = new Env(e, _list(params), args); + continue; // TCO + } else { + return f(args); + } + case _: throw "Call of non-function"; + } + } + } + } + + // PRINT + static function PRINT(exp:MalType):String { + return Printer.pr_str(exp, true); + } + + // repl + static var repl_env = new Env(null); + + static function rep(line:String):String { + return PRINT(EVAL(READ(line), repl_env)); + } + + public static function main() { + // core.EXT: defined using Haxe + for (k in Core.ns.keys()) { + repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); + } + + var evalfn = MalFunc(function(args) { + return EVAL(args[0], repl_env); + },null,null,null,false,nil); + repl_env.set(MalSymbol("eval"), evalfn); + + var cmdargs = Compat.cmdline_args(); + var argarray = cmdargs.map(function(a) { return MalString(a); }); + repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); + + // core.mal: defined using the language itself + rep("(def! *host-language* \"haxe\")"); + rep("(def! not (fn* (a) (if a false true)))"); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + + if (cmdargs.length > 0) { + rep('(load-file "${cmdargs[0]}")'); + Compat.exit(0); + } + + rep("(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + try { + var line = Compat.readline("user> "); + if (line == "") { continue; } + Compat.println(rep(line)); + } catch (exc:BlankLine) { + continue; + } catch (exc:haxe.io.Eof) { + Compat.exit(0); + } catch (exc:Dynamic) { + if (Type.getClass(exc) == MalException) { + Compat.println("Error: " + Printer.pr_str(exc.obj, true)); + } else { + Compat.println("Error: " + exc); + }; + } + } + } +} diff --git a/impls/haxe/core/Core.hx b/impls/haxe/core/Core.hx new file mode 100644 index 0000000000..99eae9b7d2 --- /dev/null +++ b/impls/haxe/core/Core.hx @@ -0,0 +1,401 @@ +package core; + +import Compat; +import types.Types.MalType; +import types.Types.*; +import types.MalException; +import printer.Printer; +import reader.Reader; +import haxe.Timer; + +class Core { + static function BoolFn(v) { + if (v) { return MalTrue; } + else { return MalFalse; } + } + + static function BoolOp(op) { + return function(args:Array) { + return switch (args) { + case [MalInt(a), MalInt(b)]: BoolFn(op(a,b)); + case _: throw "Invalid boolean op call"; + } + + }; + } + + static function NumOp(op) { + return function(args:Array) { + return switch (args) { + case [MalInt(a), MalInt(b)]: MalInt(op(a,b)); + case _: throw "Invalid numeric op call"; + } + + }; + } + + static var start = Timer.stamp(); + static function time_ms(args) { + return MalInt(Std.int(1000 * (Timer.stamp()-start))); + } + + static function equal_Q(args) { + return BoolFn(_equal_Q(args[0],args[1])); + } + + static function pr_str(args) { + return MalString( + args.map(function(s) { return Printer.pr_str(s,true); }).join(" ") + ); + } + static function str(args) { + return MalString( + args.map(function(s) { return Printer.pr_str(s,false); }).join("") + ); + } + static function prn(args) { + Compat.println(args.map(function(s) { return Printer.pr_str(s,true); }).join(" ")); + return nil; + } + static function println(args) { + Compat.println(args.map(function(s) { return Printer.pr_str(s,false); }).join(" ")); + return nil; + } + + static function symbol(args) { + return switch (args[0]) { + case MalString(s): MalSymbol(s); + case MalSymbol(_): args[0]; + case _: throw "Invalid symbol call"; + } + } + + static function keyword(args) { + return switch (args[0]) { + case MalString(s): + if (keyword_Q(args[0])) { + args[0]; + } else { + MalString("\x7f" + s); + } + case _: throw "Invalid keyword call"; + } + } + + static function read_string(args) { + return switch (args[0]) { + case MalString(s): Reader.read_str(s); + case _: throw "invalid read_str call"; + } + } + + static function readline(args) { + return switch (args[0]) { + case MalString(prompt): + try { + MalString(Compat.readline(prompt)); + } catch (exc:haxe.io.Eof) { + nil; + } + case _: throw "invalid readline call"; + } + } + + static function slurp(args) { + return switch (args[0]) { + case MalString(s): + MalString(Compat.slurp(s)); + case _: throw "invalid slurp call"; + } + } + + // sequential functions + static function sequential_Q(args) { + return BoolFn(list_Q(args[0]) || vector_Q(args[0])); + } + + static function cons(args) { + return switch [args[0], args[1]] { + case [a, MalList(l)] | + [a, MalVector(l)]: + MalList([a].concat(l)); + case [a, MalNil]: + MalList([a]); + case _: throw "Invalid cons call"; + } + } + + static function do_concat(args:Array) { + var res:Array = []; + for (a in args) { + switch (a) { + case MalList(l) | MalVector(l): + res = res.concat(l); + case MalNil: + continue; + case _: + throw "concat called with non-sequence"; + } + } + return MalList(res); + } + + static function do_vec(args:Array) { + switch (args[0]) { + case MalList(l): + return MalVector(l); + case MalVector(l): + return args[0]; + case _: + throw "vec called with non-sequence"; + } + } + + static function nth(args) { + return switch [args[0], args[1]] { + case [seq, MalInt(idx)]: + _nth(seq, idx); + case _: throw "Invalid nth call"; + } + } + + static function empty_Q(args) { + return switch (args[0]) { + case MalList(l) | MalVector(l): + if (l.length == 0) { MalTrue; } + else { MalFalse; } + case MalNil: MalTrue; + case _: MalFalse; + } + } + + static function count(args) { + return switch (args[0]) { + case MalList(l) | MalVector(l): MalInt(l.length); + case MalNil: MalInt(0); + case _: throw "count called on non-sequence"; + } + } + + static function apply(args) { + return switch [args[0], args[args.length-1]] { + case [MalFunc(f,_,_,_,_), MalList(l)] | + [MalFunc(f,_,_,_,_), MalVector(l)]: + var fargs = args.slice(1,args.length-1).concat(l); + return f(fargs); + case _: throw "Invalid apply call"; + } + } + + static function do_map(args) { + return switch [args[0], args[1]] { + case [MalFunc(f,_,_,_,_), MalList(l)] | + [MalFunc(f,_,_,_,_), MalVector(l)]: + return MalList(l.map(function(x) { return f([x]); })); + case _: throw "Invalid map call"; + } + } + + static function conj(args) { + return switch (args[0]) { + case MalList(l): + var elems = args.slice(1); + elems.reverse(); + MalList(elems.concat(l)); + case MalVector(l): + MalVector(l.concat(args.slice(1))); + case _: throw "Invalid conj call"; + } + } + + static function seq(args) { + return switch (args[0]) { + case MalList(l): + l.length > 0 ? args[0] : nil; + case MalVector(l): + l.length > 0 ? MalList(l.slice(0)) : nil; + case MalString(s): + if (s.length == 0) { return nil; } + MalList(s.split("").map(function(c) { return MalString(c); })); + case MalNil: + nil; + case _: throw "seq: called on non-sequence"; + } + } + + + // hash-map functions + + public static function get(hm:MalType, key:MalType) { + return switch [hm, key] { + case [MalHashMap(m), MalString(k)]: + if (m.exists(k)) { + m[k]; + } else { + nil; + } + case [nil, MalString(k)]: + nil; + case _: throw "invalid get call"; + } + } + + public static function assoc(args) { + return switch (args[0]) { + case MalHashMap(m): + var new_m = _clone(args[0]); + MalHashMap(assoc_BANG(new_m, args.slice(1))); + case _: throw "invalid assoc call"; + } + } + + public static function dissoc(args) { + return switch (args[0]) { + case MalHashMap(m): + var new_m = _clone(args[0]); + MalHashMap(dissoc_BANG(new_m, args.slice(1))); + case _: throw "invalid dissoc call"; + } + } + + public static function contains_Q(hm:MalType, key:MalType) { + return switch [hm, key] { + case [MalHashMap(m), MalString(k)]: + m.exists(k); + case _: throw "invalid contains? call"; + } + } + + public static function keys(hm:MalType) { + return switch (hm) { + case MalHashMap(m): + MalList([for (k in m.keys()) MalString(k)]); + case _: throw "invalid keys call"; + } + } + + public static function vals(hm:MalType) { + return switch (hm) { + case MalHashMap(m): + MalList([for (k in m.keys()) m[k]]); + case _: throw "invalid vals call"; + } + } + + // metadata functions + static function meta(args) { + return switch (args[0]) { + case MalFunc(f,_,_,_,_,meta): meta; + case _: throw "meta called on non-function"; + } + } + + static function with_meta(args) { + return switch (args[0]) { + case MalFunc(f,a,e,p,mac,_): + MalFunc(f,a,e,p,mac,args[1]); + case _: throw "with_meta called on non-function"; + } + } + + + + // atom functions + + static function deref(args) { + return switch (args[0]) { + case MalAtom(v): v.val; + case _: throw "deref called on non-atom"; + } + } + + static function reset_BANG(args) { + return switch (args[0]) { + case MalAtom(v): v.val = args[1]; + case _: throw "reset! called on non-atom"; + } + } + + static function swap_BANG(args) { + return switch [args[0], args[1]] { + case [MalAtom(v), MalFunc(f,_,_,_,_)]: + var fargs = [v.val].concat(args.slice(2)); + v.val = f(fargs); + v.val; + case _: throw "swap! called on non-atom"; + } + } + + + public static var ns:Map -> MalType> = [ + "=" => function(a) { return BoolFn(_equal_Q(a[0],a[1])); }, + "throw" => function(a) { throw new MalException(a[0]); }, + + "nil?" => function(a) { return BoolFn(nil_Q(a[0])); }, + "true?" => function(a) { return BoolFn(true_Q(a[0])); }, + "false?" => function(a) { return BoolFn(false_Q(a[0])); }, + "string?" => function(a) { return BoolFn(string_Q(a[0])); }, + "symbol" => symbol, + "symbol?" => function(a) { return BoolFn(symbol_Q(a[0])); }, + "keyword" => keyword, + "keyword?" => function(a) { return BoolFn(keyword_Q(a[0])); }, + "number?" => function(a) { return BoolFn(number_Q(a[0])); }, + "fn?" => function(a) { return BoolFn(_fn_Q(a[0])); }, + "macro?" => function(a) { return BoolFn(_macro_Q(a[0])); }, + + "pr-str" => pr_str, + "str" => str, + "prn" => prn, + "println" => println, + "read-string" => read_string, + "readline" => readline, + "slurp" => slurp, + + "<" => BoolOp(function(a,b) {return a" => BoolOp(function(a,b) {return a>b;}), + ">=" => BoolOp(function(a,b) {return a>=b;}), + "+" => NumOp(function(a,b) {return a+b;}), + "-" => NumOp(function(a,b) {return a-b;}), + "*" => NumOp(function(a,b) {return a*b;}), + "/" => NumOp(function(a,b) {return Std.int(a/b);}), + "time-ms" => time_ms, + + "list" => function(a) { return MalList(a); }, + "list?" => function(a) { return BoolFn(list_Q(a[0])); }, + "vector" => function(a) { return MalVector(a); }, + "vector?" => function(a) { return BoolFn(vector_Q(a[0])); }, + "hash-map" => hash_map, + "map?" => function(a) { return BoolFn(hash_map_Q(a[0])); }, + "assoc" => assoc, + "dissoc" => dissoc, + "get" => function(a) { return get(a[0],a[1]); }, + "contains?" => function(a) { return BoolFn(contains_Q(a[0], a[1])); }, + "keys" => function(a) { return keys(a[0]); } , + "vals" => function(a) { return vals(a[0]); } , + + "sequential?" => sequential_Q, + "cons" => cons, + "concat" => do_concat, + "vec" => do_vec, + + "nth" => nth, + "first" => function(a) { return first(a[0]); }, + "rest" => function(a) { return rest(a[0]); }, + "empty?" => empty_Q, + "count" => count, + "apply" => apply, + "map" => do_map, + + "conj" => conj, + "seq" => seq, + + "meta" => meta, + "with-meta" => with_meta, + "atom" => function(a) { return MalAtom({val:a[0]}); }, + "atom?" => function(a) { return BoolFn(atom_Q(a[0])); }, + "deref" => deref, + "reset!" => reset_BANG, + "swap!" => swap_BANG + ]; +} diff --git a/impls/haxe/env/Env.hx b/impls/haxe/env/Env.hx new file mode 100644 index 0000000000..ed4e34ef5d --- /dev/null +++ b/impls/haxe/env/Env.hx @@ -0,0 +1,48 @@ +package env; + +import types.Types.MalType; +import types.Types.*; + +class Env { + var data = new Map(); + var outer:Env = null; + + public function new(outer:Env, + binds:Array = null, + exprs:Array = null) { + this.outer = outer; + + if (binds != null) { + for (i in 0...binds.length) { + var b = binds[i], e = exprs[i]; + switch (b) { + case MalSymbol("&"): + switch (binds[i+1]) { + case MalSymbol(b2): + data[b2] = MalList(exprs.slice(i)); + case _: + throw "invalid vararg binding"; + } + break; + case MalSymbol(s): + data[s] = e; + case _: throw "invalid bind"; + } + } + } + } + + public function set(key:MalType, val:MalType) { + switch (key) { + case MalSymbol(s): data[s] = val; + case _: throw "Invalid Env.set call"; + } + return val; + } + + public function get(key:String):MalType { + if (data.exists(key)) return data.get(key); + else if (outer != null) return outer.get(key); + else return null; + } +} diff --git a/impls/haxe/node_readline.js b/impls/haxe/node_readline.js new file mode 100644 index 0000000000..80885cf27b --- /dev/null +++ b/impls/haxe/node_readline.js @@ -0,0 +1,46 @@ +// IMPORTANT: choose one +var RL_LIB = "libreadline"; // NOTE: libreadline is GPL +//var RL_LIB = "libedit"; + +var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); + +var rlwrap = {}; // namespace for this module in web context + +var ffi = require('ffi-napi'), + fs = require('fs'); + +var rllib = ffi.Library(RL_LIB, { + 'readline': [ 'string', [ 'string' ] ], + 'add_history': [ 'int', [ 'string' ] ]}); + +var rl_history_loaded = false; + +exports.readline = rlwrap.readline = function(prompt) { + prompt = prompt || "user> "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i"; + } + case _: throw "unknown type for printing"; + } + } +} diff --git a/impls/haxe/reader/BlankLine.hx b/impls/haxe/reader/BlankLine.hx new file mode 100644 index 0000000000..2b1104026c --- /dev/null +++ b/impls/haxe/reader/BlankLine.hx @@ -0,0 +1,6 @@ +package reader; + +class BlankLine { + public function new() { + } +} diff --git a/impls/haxe/reader/Reader.hx b/impls/haxe/reader/Reader.hx new file mode 100644 index 0000000000..6c935ec0af --- /dev/null +++ b/impls/haxe/reader/Reader.hx @@ -0,0 +1,137 @@ +package reader; + +import types.Types.MalType; +import types.Types.*; + +class Reader { + // Reader class implementation + var tokens:Array; + var position:Int = 0; + + public function new(toks:Array) { + tokens = toks; + } + + public function next() { + return tokens[position++]; + } + + public function peek() { + if (tokens.length > position) { + return tokens[position]; + } else { + return null; + } + } + + + // Static functions grouped with Reader class + static function tokenize(str:String) { + var re = ~/[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g; + var tokens = new Array(); + var pos = 0; + while (re.matchSub(str, pos)) { + var t = re.matched(1); + if (t == "") { break; } + var pos_len = re.matchedPos(); + pos = pos_len.pos + pos_len.len; + if (t.charAt(0) == ";") { continue; } + tokens.push(t); + + } + return tokens; + } + + static function read_atom(rdr:Reader) { + var re_int = ~/^-?[0-9][0-9]*$/; + var re_str = ~/^"(?:\\.|[^\\"])*"$/; + var re_str_bad = ~/^".*$/; + var token = rdr.next(); + return switch (token) { + case "nil": + MalNil; + case "true": + MalTrue; + case "false": + MalFalse; + case _ if (token.charAt(0) == ":"): + MalString("\x7f" + token.substr(1)); + case _ if (re_int.match(token)): + MalInt(Std.parseInt(token)); + case _ if (re_str.match(token)): + var re1 = ~/\\\\/g, + re2 = ~/\\n/g, + re3 = ~/\\"/g, + re4 = ~/\x7f/g, + s = token.substr(1, token.length-2); + MalString(re4.replace( + re3.replace( + re2.replace( + re1.replace( + s, + "\x7f"), + "\n"), + "\""), + "\\")); + case _ if (re_str_bad.match(token)): + throw 'expected \'"\', got EOF'; + case _: + MalSymbol(token); + } + } + + static function read_seq(rdr:Reader, start, end) { + var lst = []; + var token = rdr.next(); + if (token != start) { + throw 'expected \'${start}\''; + } + while ((token = rdr.peek()) != end) { + if (token == null) { + throw 'expected \'${end}\', got EOF'; + } + lst.push(read_form(rdr)); + } + rdr.next(); + return lst; + } + + static function read_form(rdr:Reader):MalType { + var token = rdr.peek(); + return switch (token) { + // reader macros/transforms + case "'": rdr.next(); + MalList([MalSymbol("quote"), read_form(rdr)]); + case "`": rdr.next(); + MalList([MalSymbol("quasiquote"), read_form(rdr)]); + case "~": rdr.next(); + MalList([MalSymbol("unquote"), read_form(rdr)]); + case "~@": rdr.next(); + MalList([MalSymbol("splice-unquote"), read_form(rdr)]); + case "^": rdr.next(); + var meta = read_form(rdr); + MalList([MalSymbol("with-meta"), read_form(rdr), meta]); + case "@": rdr.next(); + MalList([MalSymbol("deref"), read_form(rdr)]); + + // list + case ")": throw("unexpected ')'"); + case "(": MalList(read_seq(rdr, '(', ')')); + + // vector + case "]": throw("unexpected ']'"); + case "[": MalVector(read_seq(rdr, '[', ']')); + + // hashmap + case "}": throw("unexpected '}'"); + case "{": hash_map(read_seq(rdr, '{', '}')); + case _: read_atom(rdr); + } + } + + public static function read_str(str:String):MalType { + var tokens = tokenize(str); + if (tokens.length == 0) { throw(new BlankLine()); } + return read_form(new Reader(tokens)); + } +} diff --git a/impls/haxe/run b/impls/haxe/run new file mode 100755 index 0000000000..3bb679ae65 --- /dev/null +++ b/impls/haxe/run @@ -0,0 +1,8 @@ +#!/usr/bin/env bash +case ${haxe_MODE:-neko} in + neko) exec neko $(dirname $0)/${STEP:-stepA_mal}.n "${@}" ;; + python) exec python3 $(dirname $0)/${STEP:-stepA_mal}.py "${@}" ;; + js) exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" ;; + cpp) exec $(dirname $0)/cpp/${STEP:-stepA_mal} "${@}" ;; + *) echo "Invalid haxe_MODE: ${haxe_MODE}"; exit 2 ;; +esac diff --git a/impls/haxe/tests/step5_tco.mal b/impls/haxe/tests/step5_tco.mal new file mode 100644 index 0000000000..087368335f --- /dev/null +++ b/impls/haxe/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 100000)) +res1 +;=>nil diff --git a/impls/haxe/types/MalException.hx b/impls/haxe/types/MalException.hx new file mode 100644 index 0000000000..8e3ff2f021 --- /dev/null +++ b/impls/haxe/types/MalException.hx @@ -0,0 +1,10 @@ +package types; + +import types.Types.MalType; + +class MalException { + public var obj:MalType = null; + public function new(obj:MalType) { + this.obj = obj; + } +} diff --git a/impls/haxe/types/Types.hx b/impls/haxe/types/Types.hx new file mode 100644 index 0000000000..669e29b466 --- /dev/null +++ b/impls/haxe/types/Types.hx @@ -0,0 +1,257 @@ +package types; + +import env.Env; + +class MalAtomContainer { +} + +enum MalType { + MalNil; + MalTrue; + MalFalse; + MalInt(val:Int); + MalString(val:String); + MalSymbol(val:String); + MalList(val:Array); + MalVector(val:Array); + MalHashMap(val:Map); + MalAtom(val:{val:MalType}); + MalFunc(val:(Array)->MalType, + ast:MalType, + env:Env, + params:MalType, + ismacro:Bool, + meta:MalType); +} + +class Types { + public static var nil:MalType = MalNil; + + public static function _equal_Q(a:MalType, b:MalType) { + return switch [a, b] { + case [MalInt(va), MalInt(vb)]: va == vb; + case [MalString(va), MalString(vb)] | + [MalSymbol(va), MalSymbol(vb)]: va == vb; + case [MalList(la), MalList(lb)] | + [MalList(la), MalVector(lb)] | + [MalVector(la), MalList(lb)] | + [MalVector(la), MalVector(lb)]: + if (la.length != lb.length) { return false; } + for (i in 0...la.length) { + if (!_equal_Q(la[i], lb[i])) { + false; + } + } + true; + case [MalHashMap(ma), MalHashMap(mb)]: + var maks = ma.keys(), + mbks = mb.keys(), + malen = 0, + mblen = 0; + for (k in maks) { + malen += 1; + if ((!mb.exists(k)) || !_equal_Q(ma[k], mb[k])) { + return false; + } + } + for (k in mbks) { mblen += 1; } + if (malen != mblen) { return false; } + true; + case _: a == b; + } + } + + public static function _clone(a:MalType) { + return switch (a) { + case MalHashMap(m): + var new_m = new Map(); + for (k in m.keys()) { + new_m[k] = m[k]; + } + return new_m; + case _: throw "unsupported clone call"; + } + } + + public static function _fn_Q(x:MalType) { + return switch (x) { + case MalFunc(_,_,_,_,ismacro,_): !ismacro; + case _: false; + } + } + + public static function _macro_Q(x:MalType) { + return switch (x) { + case MalFunc(_,_,_,_,ismacro,_): ismacro; + case _: false; + } + } + + public static function nil_Q(x:MalType) { + return switch (x) { + case MalNil: true; + case _: false; + } + } + + public static function true_Q(x:MalType) { + return switch (x) { + case MalTrue: true; + case _: false; + } + } + + public static function false_Q(x:MalType) { + return switch (x) { + case MalFalse: true; + case _: false; + } + } + + public static function string_Q(x:MalType) { + return switch (x) { + case MalString(s): s.charAt(0) != "\x7f"; + case _: false; + } + } + + + public static function symbol_Q(x:MalType) { + return switch (x) { + case MalSymbol(_): true; + case _: false; + } + } + + public static function keyword_Q(x:MalType) { + return switch (x) { + case MalString(s): + s.charAt(0) == "\x7f"; + case _: false; + } + } + + public static function number_Q(x:MalType) { + return switch (x) { + case MalInt(_): true; + case _: false; + } + } + + + // Sequence operations + public static function list_Q(x:MalType) { + return switch (x) { + case MalList(_): true; + case _: false; + } + } + + public static function vector_Q(x:MalType) { + return switch (x) { + case MalVector(_): true; + case _: false; + } + } + + public static function first(seq:MalType) { + return switch (seq) { + case MalList(l) | MalVector(l): + if (l.length == 0) { nil; } + else { l[0]; } + case MalNil: MalNil; + case _: throw "first called on non-sequence"; + } + } + + public static function rest(seq:MalType) { + return switch (seq) { + case MalList(l) | MalVector(l): + if (l.length <= 1) { MalList([]); } + else { MalList(l.slice(1)); } + case MalNil: MalList([]); + case _: throw "rest called on non-sequence"; + } + } + + public static function _nth(seq:MalType, idx:Int) { + return switch (seq) { + case MalList(l) | MalVector(l): + if (l.length > idx) { + l[idx]; + } else { + throw "nth index out of bounds"; + } + case _: throw "nth called on non-sequence"; + } + } + + public static function _list(seq:MalType) { + return switch (seq) { + case MalList(l) | MalVector(l): l; + case _: throw "_array called on non-sequence"; + } + } + + public static function _map(hm:MalType) { + return switch (hm) { + case MalHashMap(m): m; + case _: throw "_map called on non-hash-map"; + } + } + + public static function last(seq:MalType) { + return switch (seq) { + case MalList(l) | MalVector(l): + if (l.length == 0) { nil; } + else { l[l.length-1]; } + case _: throw "last called on non-sequence"; + } + } + + public static function hash_map(kvs:Array) { + var m = new Map(); + return MalHashMap(assoc_BANG(m, kvs)); + } + + public static function assoc_BANG(m:Map, + kvs:Array) { + for (i in 0...kvs.length) { + if (i % 2 > 0) { continue; } + switch (kvs[i]) { + case MalString(k): + m[k] = kvs[i+1]; + case _: throw "invalid assoc! call"; + } + } + return m; + } + + public static function dissoc_BANG(m:Map, + ks:Array) { + for (i in 0...ks.length) { + switch (ks[i]) { + case MalString(k): + m.remove(k); + case _: throw "invalid dissoc! call"; + } + } + return m; + } + + public static function hash_map_Q(x:MalType) { + return switch (x) { + case MalHashMap(_): true; + case _: false; + } + } + + public static function atom_Q(x:MalType) { + return switch (x) { + case MalAtom(_): true; + case _: false; + } + } + +} + diff --git a/impls/hy/Dockerfile b/impls/hy/Dockerfile new file mode 100644 index 0000000000..4d977ee8b2 --- /dev/null +++ b/impls/hy/Dockerfile @@ -0,0 +1,28 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Hy +RUN apt-get -y install python-pip && \ + pip install hy && \ + mkdir /.cache && \ + chmod uog+rwx /.cache diff --git a/impls/hy/Makefile b/impls/hy/Makefile new file mode 100644 index 0000000000..47f487eba1 --- /dev/null +++ b/impls/hy/Makefile @@ -0,0 +1,7 @@ +all: mal.hy + +mal.hy: stepA_mal.hy + cp $< $@ + +clean: + rm -f mal.hy *.pyc diff --git a/impls/hy/core.hy b/impls/hy/core.hy new file mode 100644 index 0000000000..79b063b42a --- /dev/null +++ b/impls/hy/core.hy @@ -0,0 +1,98 @@ +(import [hy.models [HyKeyword :as Keyword HyString :as Str HySymbol :as Sym]]) +(import [copy [copy]]) +(import [time [time]]) +(import [mal_types [MalException Atom clone]]) +(import [reader [read-str]]) +(import [printer [pr-str]]) + +(defn sequential? [a] + (or (instance? tuple a) (instance? list a))) + +(defn equal [a b] + (if (and (sequential? a) (sequential? b) (= (len a) (len b))) + (every? (fn [[a b]] (equal a b)) (zip a b)) + + (and (instance? dict a) (instance? dict b) (= (.keys a) (.keys b))) + (every? (fn [k] (and (equal (get a k) (get b k)))) a) + + (= (type a) (type b)) + (= a b) + + False)) + +(def ns + {"=" equal + "throw" (fn [a] (raise (MalException a))) + + "nil?" none? + "true?" (fn [a] (and (instance? bool a) (= a True))) + "false?" (fn [a] (and (instance? bool a) (= a False))) + "number?" (fn [a] (and (not (instance? bool a)) (instance? int a))) + "string?" (fn [a] (and (string? a) (not (keyword? a)))) + "symbol" (fn [a] (Sym a)) + "symbol?" (fn [a] (instance? Sym a)) + "keyword" (fn [a] (Keyword (if (keyword? a) a (+ ":" a)))) + "keyword?" (fn [a] (keyword? a)) + "fn?" (fn [a] (and (callable a) (or (not (hasattr a "macro")) + (not a.macro)))) + "macro?" (fn [a] (and (callable a) (and (hasattr a "macro") a.macro))) + + "pr-str" (fn [&rest a] (Str (.join " " (map (fn [e] (pr-str e True)) a)))) + "str" (fn [&rest a] (Str (.join "" (map (fn [e] (pr-str e False)) a)))) + "prn" (fn [&rest a] (print (.join " " (map (fn [e] (pr-str e True)) a)))) + "println" (fn [&rest a] (print (.join " " (map (fn [e] (pr-str e False)) a)))) + "read-string" read-str + "readline" (fn [a] (Str (raw_input a))) + "slurp" (fn [a] (Str (-> a open .read))) + + "<" < + "<=" <= + ">" > + ">=" >= + "+" + + "-" - + "*" * + "/" (fn [a b] (int (/ a b))) + "time-ms" (fn [] (int (* 1000 (time)))) + + "list" (fn [&rest args] (tuple args)) + "list?" (fn [a] (instance? tuple a)) + "vector" (fn [&rest a] (list a)) + "vector?" (fn [a] (instance? list a)) + "hash-map" (fn [&rest a] (dict (partition a 2))) + "map?" (fn [a] (instance? dict a)) + "assoc" (fn [m &rest a] (setv m (copy m)) + (for [[k v] (partition a 2)] (assoc m k v)) m) + "dissoc" (fn [m &rest a] (setv m (copy m)) + (for [k a] (if (.has_key m k) (.pop m k))) m) + "get" (fn [m a] (if (and m (.has_key m a)) (get m a))) + "contains?" (fn [m a] (if (none? m) None (.has_key m a))) + "keys" (fn [m] (tuple (.keys m))) + "vals" (fn [m] (tuple (.values m))) + + "sequential?" sequential? + "cons" (fn [a b] (tuple (chain [a] b))) + "concat" (fn [&rest a] (tuple (apply chain a))) + "vec" (fn [a] (list a)) + "nth" (fn [a b] (get a b)) + "first" (fn [a] (if (none? a) None (first a))) + "rest" (fn [a] (if (none? a) (,) (tuple (rest a)))) + "empty?" empty? + "count" (fn [a] (if (none? a) 0 (len a))) + "apply" (fn [f &rest a] (apply f (+ (list (butlast a)) (list (last a))))) + "map" (fn [f a] (tuple (map f a))) + + "conj" (fn [a &rest xs] (if (instance? list a) (+ a (list xs)) + (tuple (+ (tuple (reversed xs)) a)))) + "seq" (fn [a] (if (or (none? a) (empty? a)) None + (string? a) (tuple (map Str a)) + (tuple a))) + + "meta" (fn [a] (if (hasattr a "meta") a.meta)) + "with-meta" (fn [a b] (setv a (clone a)) (setv a.meta b) a) + "atom" (fn [a] (Atom a)) + "atom?" (fn [a] (instance? Atom a)) + "deref" (fn [a] a.val) + "reset!" (fn [a b] (do (setv a.val b) b)) + "swap!" (fn [a f &rest xs] (do (setv a.val (apply f (+ (, a.val) xs))) a.val)) + }) diff --git a/impls/hy/env.hy b/impls/hy/env.hy new file mode 100644 index 0000000000..02161704e4 --- /dev/null +++ b/impls/hy/env.hy @@ -0,0 +1,31 @@ +(import [hy.models [HySymbol :as Sym]]) + +(defn env-new [&optional [outer None] [binds []] [exprs []]] + (setv env {:outer outer}) + (while binds + (if + (= (Sym "&") (first binds)) + (do (assoc env (nth binds 1) (tuple exprs)) (break)) + + True + (do (assoc env (first binds) (first exprs)) + (setv binds (list (rest binds)) + exprs (list (rest exprs)))))) + env) + +(defn env-find [env k] + (if + (.has_key env k) env + (get env ':outer) (env-find (get env ':outer) k) + True None)) + +(defn env-get [env k] + (setv e (env-find env k)) + (if-not e + (raise (Exception (+ "'" k "' not found")))) + (get e k)) + +(defn env-set [env k v] + (assoc env k v) + v) + diff --git a/impls/hy/mal_types.hy b/impls/hy/mal_types.hy new file mode 100644 index 0000000000..4a30e6fdbd --- /dev/null +++ b/impls/hy/mal_types.hy @@ -0,0 +1,15 @@ +(import [types :as pytypes]) + +(defclass MalException [Exception] + (defn --init-- [self val] (setv self.val val))) + +(defclass Atom [] + (defn --init-- [self val] (setv self.val val))) + +(defn clone [obj] + (if (= (type obj) pytypes.FunctionType) + (pytypes.FunctionType obj.__code__ obj.__globals__ + :name obj.__name__ + :argdefs obj.__defaults__ + :closure obj.__closure__) + obj)) diff --git a/impls/hy/printer.hy b/impls/hy/printer.hy new file mode 100644 index 0000000000..55809fc195 --- /dev/null +++ b/impls/hy/printer.hy @@ -0,0 +1,25 @@ +(import [hy.models [HyInteger :as Int HyKeyword :as Keyword + HyString :as Str HySymbol :as Sym]]) +(import [mal_types [Atom]]) + +(defn escape [s] + (-> (str s) (.replace "\\" "\\\\") + (.replace "\"" "\\\"") + (.replace "\n" "\\n"))) + +(defn pr-str [obj &optional [print-readably True]] + (setv _r print-readably + t (type obj)) + (Str + (if + (none? obj) "nil" + (= t bool) (if obj "true" "false") + (= t Keyword) (+ ":" (name obj)) + (= t Str) (if _r (+ "\"" (escape obj) "\"") obj) + (= t tuple) (+ "(" (.join " " (map (fn [x] (pr-str x _r)) obj)) ")") + (= t list) (+ "[" (.join " " (map (fn [x] (pr-str x _r)) obj)) "]") + (= t dict) (+ "{" (.join " " (map (fn [k] (+ (pr-str k _r) " " + (pr-str (get obj k) _r))) + obj)) "}") + (instance? Atom obj) (+ "(atom " (pr-str obj.val _r) ")") + True (str obj)))) diff --git a/impls/hy/reader.hy b/impls/hy/reader.hy new file mode 100644 index 0000000000..26bc5fcd3d --- /dev/null +++ b/impls/hy/reader.hy @@ -0,0 +1,96 @@ +(import [hy.models [HyInteger :as Int HyKeyword :as Keyword + HyString :as Str HySymbol :as Sym]] + [re]) + +(defclass Blank [Exception]) + +(defclass Reader [] + (defn --init-- [self tokens &optional [position 0]] + (setv self.tokens tokens self.position position)) + (defn next [self] + (setv self.position (+ 1 self.position)) + (get self.tokens (- self.position 1))) + (defn peek [self] + (if (> (len self.tokens) self.position) + (get self.tokens self.position) + None))) + +(def tok-re (.compile re "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}()'\"`@,;]+)")) +(def int-re (.compile re "-?[0-9]+$")) +(def str-re (.compile re "^\"(?:[\\\\].|[^\\\\\"])*\"$")) +(def str-bad-re (.compile re "^\".*$")) + +(defn tokenize [str] + (list-comp + t + (t (.findall re tok-re str)) + (!= (get t 0) ";"))) + +(defn unescape [s] + (-> s (.replace "\\\\" "\u029e") + (.replace "\\\"" "\"") + (.replace "\\n" "\n") + (.replace "\u029e" "\\"))) + +(defn read-atom [rdr] + (setv token (.next rdr)) + (if + (.match re int-re token) (int token) + (.match re str-re token) (Str (unescape (cut token 1 -1))) + (.match re str-bad-re token) (raise (Exception "expected '\"', got EOF")) + (= ":" (get token 0)) (Keyword token) + (= "nil" token) None + (= "true" token) True + (= "false" token) False + True (Sym token))) + +(defn read-seq [rdr &optional [start "("] [end ")"]] + (setv ast (list) + token (.next rdr)) + (if (!= token start) + (raise (Exception (+ "expected '" start "'"))) + (do + (setv token (.peek rdr)) + (while (!= token end) + (if (not token) (raise (Exception (+ "expected '" end + ", got EOF")))) + (.append ast (read-form rdr)) + (setv token (.peek rdr))) + (.next rdr) + ast))) + +(defn read-form [rdr] + (setv token (.peek rdr)) + (if + (= ";" (get token 0)) (.next rdr) + + (= "'" token) (do (.next rdr) + (tuple [(Sym "quote") (read-form rdr)])) + (= "`" token) (do (.next rdr) + (tuple [(Sym "quasiquote") (read-form rdr)])) + (= "~" token) (do (.next rdr) + (tuple [(Sym "unquote") (read-form rdr)])) + (= "~@" token) (do (.next rdr) + (tuple [(Sym "splice-unquote") + (read-form rdr)])) + (= "^" token) (do (.next rdr) + (setv meta (read-form rdr)) + (tuple [(Sym "with-meta") (read-form rdr) meta])) + (= "@" token) (do (.next rdr) + (tuple [(Sym "deref") (read-form rdr)])) + + (= ")" token) (raise (Exception "unexpected ')'")) + (= "(" token) (tuple (read-seq rdr "(" ")")) + + (= "]" token) (raise (Exception "unexpected ')'")) + (= "[" token) (read-seq rdr "[" "]") + + (= "}" token) (raise (Exception "unexpected '}'")) + (= "{" token) (dict (partition (read-seq rdr "{" "}") 2)) + + True (read-atom rdr))) + +(defn read-str [str] + (setv tokens (tokenize str)) + (if (= 0 (len tokens)) (raise (Blank "blank line"))) + (read-form (Reader tokens))) diff --git a/impls/hy/run b/impls/hy/run new file mode 100755 index 0000000000..e203849508 --- /dev/null +++ b/impls/hy/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal}.hy "${@}" diff --git a/impls/hy/step0_repl.hy b/impls/hy/step0_repl.hy new file mode 100755 index 0000000000..d651bbf0ef --- /dev/null +++ b/impls/hy/step0_repl.hy @@ -0,0 +1,22 @@ +#!/usr/bin/env hy + +(defn READ [str] + str) + +(defn EVAL [ast env] + ast) + +(defn PRINT [exp] + exp) + +(defn REP [str] + (PRINT (EVAL (READ str) {}))) + +(defmain [&rest args] + ;; indented to match later steps + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break))))) diff --git a/impls/hy/step1_read_print.hy b/impls/hy/step1_read_print.hy new file mode 100755 index 0000000000..ba8670e14b --- /dev/null +++ b/impls/hy/step1_read_print.hy @@ -0,0 +1,30 @@ +#!/usr/bin/env hy + +(import sys traceback) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) + +(defn READ [str] + (read-str str)) + +(defn EVAL [ast env] + ast) + +(defn PRINT [exp] + (pr-str exp True)) + +(defn REP [str] + (PRINT (EVAL (READ str) {}))) + +(defmain [&rest args] + ;; indented to match later steps + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (print (.join "" (apply traceback.format_exception + (.exc_info sys)))))))) diff --git a/impls/hy/step2_eval.hy b/impls/hy/step2_eval.hy new file mode 100755 index 0000000000..adfc2a16a6 --- /dev/null +++ b/impls/hy/step2_eval.hy @@ -0,0 +1,65 @@ +#!/usr/bin/env hy + +(import sys traceback) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn EVAL [ast env] + ;; indented to match later steps + (if + (symbol? ast) + (if (.has_key env ast) (get env ast) + (raise (Exception (+ ast " not found")))) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + ;; apply + (do + (setv el (list (map (fn [x] (EVAL x env)) ast)) + f (first el) + args (list (rest el))) + (apply f args)))) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env {'+ + + '- - + '* * + '/ (fn [a b] (int (/ a b)))}) + +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +(defmain [&rest args] + ;; indented to match later steps + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (print (.join "" (apply traceback.format_exception + (.exc_info sys)))))))) diff --git a/impls/hy/step3_env.hy b/impls/hy/step3_env.hy new file mode 100755 index 0000000000..26fca8fa7a --- /dev/null +++ b/impls/hy/step3_env.hy @@ -0,0 +1,85 @@ +#!/usr/bin/env hy + +(import [hy.models [HySymbol :as Sym]]) +(import sys traceback) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn EVAL [ast env] + ;; indented to match later steps + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (EVAL a2 env)) + + ;; apply + (do + (setv el (list (map (fn [x] (EVAL x env)) ast)) + f (first el) + args (list (rest el))) + (apply f args)))))) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +(env-set repl-env '+ +) +(env-set repl-env '- -) +(env-set repl-env '* *) +(env-set repl-env '/ /) + +(defmain [&rest args] + ;; indented to match later steps + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (print (.join "" (apply traceback.format_exception + (.exc_info sys)))))))) diff --git a/impls/hy/step4_if_fn_do.hy b/impls/hy/step4_if_fn_do.hy new file mode 100755 index 0000000000..ae01bf32a5 --- /dev/null +++ b/impls/hy/step4_if_fn_do.hy @@ -0,0 +1,109 @@ +#!/usr/bin/env hy + +(import [hy.models [HySymbol :as Sym]]) +(import sys traceback) +(import [mal_types [MalException]]) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) +(import core) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn EVAL [ast env] + ;; indented to match later steps + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (EVAL a2 env)) + + (= (Sym "do") a0) + (last (list (map (fn [x] (EVAL x env)) (list (rest ast))))) + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (EVAL (nth ast 3) env) + None) + (EVAL a2 env))) + + (= (Sym "fn*") a0) + (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + + ;; apply + (do + (setv el (list (map (fn [x] (EVAL x env)) ast)) + f (first el) + args (list (rest el))) + (apply f args)))))) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +;; core.hy: defined using Hy +(for [k core.ns] + (env-set repl-env (Sym k) (get core.ns k))) + +;; core.mal: defined using the language itself +(REP "(def! not (fn* [a] (if a false true)))") + +(defmain [&rest args] + ;; indented to match later steps + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (setv msg (.rstrip (.join "" (apply traceback.format_exception + (.exc_info sys))))) + (if (instance? MalException e) + (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) + (print msg))))) diff --git a/impls/hy/step5_tco.hy b/impls/hy/step5_tco.hy new file mode 100755 index 0000000000..6b364657ab --- /dev/null +++ b/impls/hy/step5_tco.hy @@ -0,0 +1,126 @@ +#!/usr/bin/env hy + +(import [hy.models [HySymbol :as Sym]]) +(import sys traceback) +(import [mal_types [MalException]]) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) +(import core) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn EVAL [ast env] + (setv res None) + (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (setv res + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "do") a0) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (list (map (fn [x] (EVAL x env)) ast)) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) + (break)) + res) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +;; core.hy: defined using Hy +(for [k core.ns] + (env-set repl-env (Sym k) (get core.ns k))) + +;; core.mal: defined using the language itself +(REP "(def! not (fn* [a] (if a false true)))") + +(defmain [&rest args] + ;; indented to match later steps + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (setv msg (.rstrip (.join "" (apply traceback.format_exception + (.exc_info sys))))) + (if (instance? MalException e) + (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) + (print msg))))) diff --git a/impls/hy/step6_file.hy b/impls/hy/step6_file.hy new file mode 100755 index 0000000000..9cf4c7380a --- /dev/null +++ b/impls/hy/step6_file.hy @@ -0,0 +1,133 @@ +#!/usr/bin/env hy + +(import [hy.models [HyString :as Str HySymbol :as Sym]]) +(import sys traceback) +(import [mal_types [MalException]]) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) +(import core) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn EVAL [ast env] + (setv res None) + (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (setv res + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "do") a0) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (list (map (fn [x] (EVAL x env)) ast)) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) + (break)) + res) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +;; core.hy: defined using Hy +(for [k core.ns] + (env-set repl-env (Sym k) (get core.ns k))) +(env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) +(env-set repl-env (Sym "*ARGV*") (, )) + +;; core.mal: defined using the language itself +(REP "(def! not (fn* [a] (if a false true)))") +(REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(defmain [&rest args] + (if (>= (len args) 2) + (do + (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) + (REP (+ "(load-file \"" (get args 1) "\")"))) + (do + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (setv msg (.rstrip (.join "" (apply traceback.format_exception + (.exc_info sys))))) + (if (instance? MalException e) + (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) + (print msg))))))) diff --git a/impls/hy/step7_quote.hy b/impls/hy/step7_quote.hy new file mode 100755 index 0000000000..757852db5f --- /dev/null +++ b/impls/hy/step7_quote.hy @@ -0,0 +1,157 @@ +#!/usr/bin/env hy + +(import [hy.models [HyString :as Str HySymbol :as Sym]]) +(import sys traceback) +(import [mal_types [MalException]]) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) +(import core) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) +(defn QUASIQUOTE [ast] + (if + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) + +(defn EVAL [ast env] + (setv res None) + (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (setv res + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "do") a0) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (list (map (fn [x] (EVAL x env)) ast)) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) + (break)) + res) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +;; core.hy: defined using Hy +(for [k core.ns] + (env-set repl-env (Sym k) (get core.ns k))) +(env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) +(env-set repl-env (Sym "*ARGV*") (, )) + +;; core.mal: defined using the language itself +(REP "(def! not (fn* [a] (if a false true)))") +(REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(defmain [&rest args] + (if (>= (len args) 2) + (do + (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) + (REP (+ "(load-file \"" (get args 1) "\")"))) + (do + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (setv msg (.rstrip (.join "" (apply traceback.format_exception + (.exc_info sys))))) + (if (instance? MalException e) + (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) + (print msg))))))) diff --git a/impls/hy/step8_macros.hy b/impls/hy/step8_macros.hy new file mode 100755 index 0000000000..97ee0ee46c --- /dev/null +++ b/impls/hy/step8_macros.hy @@ -0,0 +1,166 @@ +#!/usr/bin/env hy + +(import [hy.models [HyString :as Str HySymbol :as Sym]]) +(import sys traceback) +(import [mal_types [MalException]]) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) +(import core) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) +(defn QUASIQUOTE [ast] + (if + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) + +(defn EVAL [ast env] + (setv res None) + (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (setv res + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "defmacro!") a0) + (do (setv func (EVAL a2 env) + func.macro True) + (env-set env a1 func)) + + (= (Sym "do") a0) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv f (EVAL a0 env)) + (if (and (hasattr f "macro") f.macro) + (do (setv ast (apply f (list (rest ast)))) + (continue))) ;; TCO + (setv args (list (map (fn [x] (EVAL x env)) + (list (rest ast))))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) + (break)) + res) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +;; core.hy: defined using Hy +(for [k core.ns] + (env-set repl-env (Sym k) (get core.ns k))) +(env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) +(env-set repl-env (Sym "*ARGV*") (, )) + +;; core.mal: defined using the language itself +(REP "(def! not (fn* [a] (if a false true)))") +(REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(defmain [&rest args] + (if (>= (len args) 2) + (do + (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) + (REP (+ "(load-file \"" (get args 1) "\")"))) + (do + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (setv msg (.rstrip (.join "" (apply traceback.format_exception + (.exc_info sys))))) + (if (instance? MalException e) + (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) + (print msg))))))) diff --git a/impls/hy/step9_try.hy b/impls/hy/step9_try.hy new file mode 100755 index 0000000000..5dc44a0cf0 --- /dev/null +++ b/impls/hy/step9_try.hy @@ -0,0 +1,180 @@ +#!/usr/bin/env hy + +(import [hy.models [HyString :as Str HySymbol :as Sym]]) +(import sys traceback) +(import [mal_types [MalException]]) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) +(import core) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) +(defn QUASIQUOTE [ast] + (if + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) + +(defn EVAL [ast env] + (setv res None) + (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (setv res + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "defmacro!") a0) + (do (setv func (EVAL a2 env) + func.macro True) + (env-set env a1 func)) + + (= (Sym "try*") a0) + (if (and a2 (= (Sym "catch*") (nth a2 0))) + (try + (EVAL a1 env) + (except [e Exception] + (if (instance? MalException e) + (setv exc e.val) + (setv exc (Str (get e.args 0)))) + (do (setv ast (nth a2 2) + env (env-new env [(nth a2 1)] + [exc])) + (continue)))) ;; TCO + (do (setv ast a1) (continue))) ;; TCO + + (= (Sym "do") a0) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv f (EVAL a0 env)) + (if (and (hasattr f "macro") f.macro) + (do (setv ast (apply f (list (rest ast)))) + (continue))) ;; TCO + (setv args (list (map (fn [x] (EVAL x env)) + (list (rest ast))))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) + (break)) + res) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +;; core.hy: defined using Hy +(for [k core.ns] + (env-set repl-env (Sym k) (get core.ns k))) +(env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) +(env-set repl-env (Sym "*ARGV*") (, )) + +;; core.mal: defined using the language itself +(REP "(def! not (fn* [a] (if a false true)))") +(REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(defmain [&rest args] + (if (>= (len args) 2) + (do + (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) + (REP (+ "(load-file \"" (get args 1) "\")"))) + (do + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (setv msg (.rstrip (.join "" (apply traceback.format_exception + (.exc_info sys))))) + (if (instance? MalException e) + (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) + (print msg))))))) diff --git a/impls/hy/stepA_mal.hy b/impls/hy/stepA_mal.hy new file mode 100755 index 0000000000..3e881fdab6 --- /dev/null +++ b/impls/hy/stepA_mal.hy @@ -0,0 +1,182 @@ +#!/usr/bin/env hy + +(import [hy.models [HyString :as Str HySymbol :as Sym]]) +(import sys traceback) +(import [mal_types [MalException]]) +(import [reader [read-str Blank]]) +(import [printer [pr-str]]) +(import [env [env-new env-get env-set env-find]]) +(import core) + +;; read +(defn READ [str] + (read-str str)) + +;; eval +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) +(defn QUASIQUOTE [ast] + (if + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) + +(defn EVAL [ast env] + (setv res None) + (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (setv res + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "defmacro!") a0) + (do (setv func (EVAL a2 env) + func.macro True) + (env-set env a1 func)) + + (= (Sym "try*") a0) + (if (and a2 (= (Sym "catch*") (nth a2 0))) + (try + (EVAL a1 env) + (except [e Exception] + (if (instance? MalException e) + (setv exc e.val) + (setv exc (Str (get e.args 0)))) + (do (setv ast (nth a2 2) + env (env-new env [(nth a2 1)] + [exc])) + (continue)))) ;; TCO + (do (setv ast a1) (continue))) ;; TCO + + (= (Sym "do") a0) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv f (EVAL a0 env)) + (if (and (hasattr f "macro") f.macro) + (do (setv ast (apply f (list (rest ast)))) + (continue))) ;; TCO + (setv args (list (map (fn [x] (EVAL x env)) + (list (rest ast))))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) + (break)) + res) + +;; print +(defn PRINT [exp] + (pr-str exp True)) + +;; repl +(def repl-env (env-new)) +(defn REP [str] + (PRINT (EVAL (READ str) repl-env))) + +;; core.hy: defined using Hy +(for [k core.ns] + (env-set repl-env (Sym k) (get core.ns k))) +(env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) +(env-set repl-env (Sym "*ARGV*") (, )) + +;; core.mal: defined using the language itself +(REP "(def! *host-language* \"Hy\")") +(REP "(def! not (fn* [a] (if a false true)))") +(REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(defmain [&rest args] + (if (>= (len args) 2) + (do + (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) + (REP (+ "(load-file \"" (get args 1) "\")"))) + (do + (REP "(println (str \"Mal [\" *host-language* \"]\"))") + (while True + (try + (do (setv line (raw_input "user> ")) + (if (= "" line) (continue)) + (print (REP line))) + (except [EOFError] (break)) + (except [Blank]) + (except [e Exception] + (setv msg (.rstrip (.join "" (apply traceback.format_exception + (.exc_info sys))))) + (if (instance? MalException e) + (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) + (print msg))))))) diff --git a/impls/hy/tests/step5_tco.mal b/impls/hy/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/hy/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/io/Dockerfile b/impls/io/Dockerfile new file mode 100644 index 0000000000..64cfd84bb7 --- /dev/null +++ b/impls/io/Dockerfile @@ -0,0 +1,57 @@ +FROM ubuntu:24.04 AS base +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN apt-get -y install libpcre3-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Compile the io interpreter +########################################################## + +FROM base AS builder + +RUN apt-get -y install git cmake gcc + +RUN cd /tmp \ + && git clone --recursive -q --depth=1 https://github.com/IoLanguage/io.git \ + && cd /tmp/io \ + && mkdir build && cd build \ + && cmake -DCMAKE_BUILD_TYPE=release .. && make && make install + +# Force eerie (Io package manager) to install itself and the packages in /opt/.eerie +ENV HOME=/opt + +RUN cd /tmp/io/eerie \ + && mkdir -p /opt \ + && . ./install_unix.sh --notouch \ + && eerie install https://github.com/IoLanguage/Range.git \ + && eerie install https://github.com/IoLanguage/ReadLine.git \ + && eerie install https://github.com/IoLanguage/Regex.git + +########################################################## +# Specific implementation requirements +########################################################## + +FROM base AS io + +COPY --from=builder /usr/local/lib/ /usr/lib/ +COPY --from=builder /usr/local/bin/ /usr/bin/ +COPY --from=builder /opt/.eerie/ /opt/.eerie/ + +ENV HOME=/mal diff --git a/impls/io/Env.io b/impls/io/Env.io new file mode 100644 index 0000000000..5b793eb22a --- /dev/null +++ b/impls/io/Env.io @@ -0,0 +1,45 @@ +Env := Object clone do( + outer ::= nil + data ::= nil + + with := method(aOuter, aBinds, aExprs, + self clone setOuter(aOuter) setData(Map clone) initBinds(aBinds, aExprs) + ) + + initBinds := method(aBinds, aExprs, + if(aBinds isNil not, + aBinds foreach(i, b, + if(b val == "&", + set(aBinds at(i + 1), aExprs slice(i)) break, + set(b, aExprs at(i)) + ) + ) + ) + self + ) + + set := method(key, val, + data atPut(key val, val) + val + ) + + find := method(key, + keyStr := key val + if(data hasKey(keyStr), + self, + if(outer isNil, + nil, + outer find(key) + ) + ) + ) + + get := method(key, + keyStr := key val + foundEnv := find(key) + if(foundEnv isNil, + Exception raise("'" .. keyStr .. "' not found"), + (foundEnv data) at(keyStr) + ) + ) +) diff --git a/impls/io/Makefile b/impls/io/Makefile new file mode 100644 index 0000000000..16310cea7c --- /dev/null +++ b/impls/io/Makefile @@ -0,0 +1,11 @@ +STEPS = step0_repl.io step1_read_print.io step2_eval.io step3_env.io step4_if_fn_do.io step5_tco.io \ + step6_file.io step7_quote.io step8_macros.io step9_try.io stepA_mal.io + +all: eerie + +eerie: + ln -s /opt/.eerie eerie + +$(STEPS): eerie + +clean: diff --git a/impls/io/MalCore.io b/impls/io/MalCore.io new file mode 100644 index 0000000000..740e2c6187 --- /dev/null +++ b/impls/io/MalCore.io @@ -0,0 +1,154 @@ +MalCore := Object clone do( + slurp := block(a, + f := File with(a at(0)) + res := f contents + f close + res + ) + + dissoc := block(a, + res := MalMap withMap(a at(0)) + a rest foreach(k, res removeKey(k)) + res + ) + + vec := block(a, + coll := a at(0) + coll type switch( + "MalVector", coll, + "MalList", MalVector with(coll), + Exception raise("vec: arg type"))) + + nth := block(a, + if(a at(1) < a at(0) size, + a at(0) at(a at(1)), + Exception raise("nth: index out of range") + ) + ) + + conj := block(a, + coll := a at(0) + coll type switch( + "MalList", + MalList with(a rest reverse appendSeq(coll)), + "MalVector", + MalVector with(coll appendSeq(a rest)) + ) + ) + + seq := block(a, + obj := a at(0) + (obj isNil) ifTrue(return(nil)) + (obj type == "MalList") ifTrue(return(if(obj isEmpty, nil, obj))) + (obj type == "MalVector") ifTrue(return(if(obj isEmpty, nil, MalList with(obj)))) + (obj type == "Sequence") ifTrue( + if(obj isEmpty, return(nil)) + lst := list() + obj foreach(i, c, lst append(obj inclusiveSlice(i, i))) + return(MalList with(lst)) + ) + nil + ) + + swapBang := block(a, + atom := a at(0) + newVal := a at(1) call(MalList with(list(atom val)) appendSeq(a slice(2))) + atom setVal(newVal) val + ) + + ioToMal := method(v, + (v isNil) ifTrue(return(v)) + (v == true) ifTrue(return(v)) + (v == false) ifTrue(return(v)) + (v type == "Number") ifTrue(return(v)) + (v type == "Sequence") ifTrue(return(v)) + (v type == "List") ifTrue(return(MalList with(v map(e, ioToMal(e))))) + (v type == "Map") ifTrue( + lst := list() + v foreach(key, val, + lst push(key asString) + lst push(ioToMal(val)) + ) + return(MalMap withList(lst)) + ) + v asString + ) + + ioEval := block(a, + MalCore ioToMal(doString(a at(0))) + ) + + NS := Map with( + "=", block(a, a at(0) == a at(1)), + "throw", block(a, MalException with(a at(0)) raise), + + "nil?", block(a, a at(0) isNil), + "true?", block(a, a at(0) == true), + "false?", block(a, a at(0) == false), + "string?", block(a, a at(0) type == "Sequence"), + "symbol", block(a, MalSymbol with(a at(0))), + "symbol?", block(a, a at(0) type == "MalSymbol"), + "keyword", block(a, MalKeyword with(a at(0))), + "keyword?", block(a, a at(0) type == "MalKeyword"), + "number?", block(a, a at(0) type == "Number"), + "fn?", block(a, (a at(0) type == "Block") or + ((a at(0) type == "MalFunc") and (a at(0) isMacro not))), + "macro?", block(a, (a at(0) type == "MalFunc") and (a at(0) isMacro)), + + "pr-str", block(a, a map(s, s malPrint(true)) join(" ")), + "str", block(a, a map(s, s malPrint(false)) join("")), + "prn", block(a, a map(s, s malPrint(true)) join(" ") println ; nil), + "println", block(a, a map(s, s malPrint(false)) join(" ") println ; nil), + "read-string", block(a, MalReader read_str(a at(0))), + "readline", block(a, MalReadline readLine(a at(0))), + "slurp", slurp, + + "<", block(a, a at(0) < a at(1)), + "<=", block(a, a at(0) <= a at(1)), + ">", block(a, a at(0) > a at(1)), + ">=", block(a, a at(0) >= a at(1)), + "+", block(a, a at(0) + a at(1)), + "-", block(a, a at(0) - a at(1)), + "*", block(a, a at(0) * a at(1)), + "/", block(a, a at(0) / a at(1)), + "time-ms", block(a, (Date now asNumber * 1000.0) round), + + "list", block(a, a), + "list?", block(a, a at(0) type == "MalList"), + "vector", block(a, MalVector with(a)), + "vector?", block(a, a at(0) type == "MalVector"), + "hash-map", block(a, MalMap withList(a)), + "map?", block(a, a at(0) type == "MalMap"), + "assoc", block(a, MalMap withMap(a at(0) merge(MalMap withList(a rest)))), + "dissoc", dissoc, + "get", block(a, a at(0) ifNil(return nil) get(a at(1))), + "contains?", block(a, a at(0) ifNil(return nil) contains(a at(1))), + "keys", block(a, a at(0) malKeys), + "vals", block(a, a at(0) malVals), + + "sequential?", block(a, if(a at(0) ?isSequential, true, false)), + "cons", block(a, MalList with(list(a at(0)) appendSeq(a at(1)))), + "concat", block(a, MalList with(a reduce(appendSeq, list()))), + "vec", vec, + "nth", nth, + "first", block(a, a at(0) ifNil(return nil) first), + "rest", block(a, a at(0) ifNil(return MalList with(list())) rest), + "empty?", block(a, a at(0) ifNil(true) isEmpty), + "count", block(a, a at(0) ifNil(return(0)) size), + "apply", block(a, a at(0) call(MalList with(a slice(1, -1) appendSeq(a last)))), + "map", block(a, MalList with(a at(1) map(e, a at(0) call(MalList with(list(e)))))), + + "conj", conj, + "seq", seq, + + "meta", block(a, a at(0) ?meta), + "with-meta", block(a, a at(0) clone setMeta(a at(1))), + "atom", block(a, MalAtom with(a at(0))), + "atom?", block(a, a at(0) type == "MalAtom"), + "deref", block(a, a at(0) val), + "reset!", block(a, a at(0) setVal(a at(1)) ; a at(1)), + "swap!", swapBang, + + "io-eval", ioEval + ) +) diff --git a/impls/io/MalReader.io b/impls/io/MalReader.io new file mode 100644 index 0000000000..16cc3bd414 --- /dev/null +++ b/impls/io/MalReader.io @@ -0,0 +1,92 @@ +MalReader := Object clone do ( + + Reader := Object clone do ( + pos ::= 0 + tokens ::= list() + + with := method(theTokens, + self clone setTokens(theTokens) + ) + + peek := method(tokens at(pos)) + + next := method( + pos = pos + 1 + tokens at(pos - 1) + ) + ) + + tokenizerRegex := Regex with("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)") + + tokenize := method(str, + tokenizerRegex matchesIn(str) \ + map(m, m at(1) asMutable strip) \ + select(t, t size > 0) \ + select(t, t exSlice(0, 1) != ";") + ) + + numberRegex := Regex with("^-?[0-9]+$") + stringRegex := Regex with("^\"(?:[\\\\].|[^\\\\\"])*\"$") + + read_string := method(token, + placeholder := 127 asCharacter + token exSlice(1, -1) replaceSeq("\\\\", placeholder) replaceSeq("\\\"", "\"") replaceSeq("\\n", "\n") replaceSeq(placeholder, "\\") + ) + + read_atom := method(rdr, + token := rdr next + (token hasMatchOfRegex(numberRegex)) ifTrue(return(token asNumber)) + (token == "true") ifTrue(return(true)) + (token == "false") ifTrue(return(false)) + (token == "nil") ifTrue(return(nil)) + (token beginsWithSeq(":")) ifTrue(return(MalKeyword with(token exSlice(1)))) + (token hasMatchOfRegex(stringRegex)) ifTrue(return(read_string(token))) + (token beginsWithSeq("\"")) ifTrue(Exception raise("expected '\"', got EOF")) + MalSymbol with(token) + ) + + read_list := method(rdr, start, end, + token := rdr next + if(token != start, Exception raise("expected '" .. start .. "'")) + ast := list() + token = rdr peek + while(token != end, + if(token isNil, Exception raise("expected '" .. end .. "', got EOF")) + ast push(read_form(rdr)) + token = rdr peek + ) + rdr next + ast + ) + + reader_macro := method(symbol, rdr, + rdr next + MalList with(list(MalSymbol with(symbol), read_form(rdr))) + ) + + read_form := method(rdr, + token := rdr peek + (token == "'") ifTrue(return(reader_macro("quote", rdr))) + (token == "`") ifTrue(return(reader_macro("quasiquote", rdr))) + (token == "~") ifTrue(return(reader_macro("unquote", rdr))) + (token == "~@") ifTrue(return(reader_macro("splice-unquote", rdr))) + (token == "^") ifTrue( + rdr next + meta := read_form(rdr) + return(MalList with(list(MalSymbol with("with-meta"), read_form(rdr), meta))) + ) + (token == "@") ifTrue(return(reader_macro("deref", rdr))) + (token == "(") ifTrue(return(MalList with(read_list(rdr, "(", ")")))) + (token == ")") ifTrue(Exception raise("unexepcted ')'")) + (token == "[") ifTrue(return(MalVector with(read_list(rdr, "[", "]")))) + (token == "]") ifTrue(Exception raise("unexepcted ']'")) + (token == "{") ifTrue(return(MalMap withList(read_list(rdr, "{", "}")))) + (token == "}") ifTrue(Exception raise("unexepcted '}'")) + read_atom(rdr) + ) + + read_str := method(str, + tokens := tokenize(str) + if(tokens isEmpty, nil, read_form(Reader with(tokens))) + ) +) diff --git a/impls/io/MalReadline.io b/impls/io/MalReadline.io new file mode 100644 index 0000000000..e38f4099e6 --- /dev/null +++ b/impls/io/MalReadline.io @@ -0,0 +1,19 @@ +MalReadline := Object clone do ( + historyLoaded := false + historyFile := (System getEnvironmentVariable("HOME")) .. "/.mal-history" + + loadHistory := method( + if(File exists(historyFile), ReadLine loadHistory(historyFile)) + historyLoaded = true + ) + + readLine := method(prompt, + if(historyLoaded not, loadHistory) + line := ReadLine readLine(prompt) + if(line isNil, return(nil)) + if(line isEmpty, return(line)) + ReadLine addHistory(line) + ReadLine saveHistory(historyFile) + line + ) +) diff --git a/impls/io/MalTypes.io b/impls/io/MalTypes.io new file mode 100644 index 0000000000..a5b7c0c644 --- /dev/null +++ b/impls/io/MalTypes.io @@ -0,0 +1,134 @@ +MalTypes := Object clone + +nil malPrint := method(readable, self asString) +true malPrint := method(readable, self asString) +false malPrint := method(readable, self asString) +Number malPrint := method(readable, self asString) + +// Io strings are of type Sequence +Sequence malPrint := method(readable, + if(readable, + "\"" .. (self asString asMutable replaceSeq("\\", "\\\\") replaceSeq("\"", "\\\"") replaceSeq("\n", "\\n")) .. "\"", + self asString) +) + +MalMeta := Object clone do( + meta ::= nil +) + +MalSymbol := Object clone appendProto(MalMeta) do ( + val ::= nil + with := method(str, self clone setVal(if(str ?val, str val, str))) + malPrint := method(readable, val) + == := method(other, (self type == other type) and (val == other val)) +) + +MalKeyword := Object clone do ( + val ::= nil + with := method(str, self clone setVal(if(str ?val, str val, str))) + malPrint := method(readable, ":" .. val) + == := method(other, (self type == other type) and (val == other val)) +) + +MalSequential := Object clone do( + isSequential := method(true) + equalSequence := method(other, + if((other ?isSequential) not, return false) + if(self size != other size, return false) + unequalElement := self detect(i, valA, + (valA == (other at(i))) not + ) + if(unequalElement, false, true) + ) +) + +MalList := List clone appendProto(MalSequential) appendProto(MalMeta) do ( + with := method(lst, self clone copy(lst)) + malPrint := method(readable, + "(" .. (self map(e, e malPrint(readable)) join(" ")) .. ")" + ) + rest := method(MalList with(resend)) + slice := method(MalList with(resend)) + == := method(other, equalSequence(other)) +) + +MalVector := List clone appendProto(MalSequential) appendProto(MalMeta) do ( + with := method(lst, self clone copy(lst)) + malPrint := method(readable, + "[" .. (self map(e, e malPrint(readable)) join(" ")) .. "]" + ) + rest := method(MalList with(resend)) + slice := method(MalList with(resend)) + == := method(other, equalSequence(other)) +) + +MalMap := Map clone appendProto(MalMeta) do ( + withList := method(lst, + obj := self clone + k := nil + lst foreach(i, e, + if(i % 2 == 0, + k := e, + obj atPut(objToKey(k), e) + ) + ) + obj + ) + withMap := method(aMap, self clone merge(aMap)) + objToKey := method(obj, + if(obj type == "MalKeyword", "K_" .. (obj val), "S_" .. obj) + ) + keyToObj := method(s, + if(s beginsWithSeq("K_"), + MalKeyword with(s exSlice(2)), + s exSlice(2) + ) + ) + malPrint := method(readable, + "{" .. + (self map(k, v, + (keyToObj(k) malPrint(readable)) .. " " .. (v malPrint(readable)) + ) join(" ")) .. "}" + ) + contains := method(obj, hasKey(objToKey(obj))) + get := method(obj, at(objToKey(obj))) + malKeys := method(MalList with(keys map(k, keyToObj(k)))) + malVals := method(MalList with(values)) + removeKey := method(obj, removeAt(objToKey(obj))) + == := method(other, + if(self type != other type, return false) + if(keys size != other keys size, return false) + unequalElement := self detect(k, valA, + (valA == (other at(k))) not + ) + if(unequalElement, false, true) + ) +) + +Block malPrint := method(readable, "#") +Block appendProto(MalMeta) + +MalFunc := Object clone appendProto(MalMeta) do ( + ast ::= nil + params ::= nil + env ::= nil + blk ::= nil + isMacro ::= false + with := method(aAst, aParams, aEnv, aBlk, + self clone setAst(aAst) setParams(aParams) setEnv(aEnv) setBlk(aBlk) + ) + malPrint := method(readable, "#") + call := method(args, blk call(args)) +) + +MalAtom := Object clone appendProto(MalMeta) do ( + val ::= nil + with := method(str, self clone setVal(str)) + malPrint := method(readable, "(atom " .. (val malPrint(true)) .. ")") + == := method(other, (self type == other type) and (val == other val)) +) + +MalException := Exception clone do ( + val ::= nil + with := method(str, self clone setVal(str)) +) diff --git a/impls/io/run b/impls/io/run new file mode 100755 index 0000000000..d49d10a227 --- /dev/null +++ b/impls/io/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +io $(dirname $0)/${STEP:-stepA_mal}.io "$@" diff --git a/impls/io/step0_repl.io b/impls/io/step0_repl.io new file mode 100644 index 0000000000..154d7c0876 --- /dev/null +++ b/impls/io/step0_repl.io @@ -0,0 +1,18 @@ +Regex + +READ := method(str, str) + +EVAL := method(ast, env, ast) + +PRINT := method(exp, exp) + +RE := method(str, EVAL(READ(str), nil)) + +REP := method(str, PRINT(RE(str))) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + REP(line) println +) diff --git a/impls/io/step1_read_print.io b/impls/io/step1_read_print.io new file mode 100644 index 0000000000..b1cd57ecd1 --- /dev/null +++ b/impls/io/step1_read_print.io @@ -0,0 +1,22 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +EVAL := method(ast, env, ast) + +PRINT := method(exp, exp malPrint(true)) + +RE := method(str, EVAL(READ(str), nil)) + +REP := method(str, PRINT(RE(str))) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + ("Error: " .. (e error)) println + ) +) diff --git a/impls/io/step2_eval.io b/impls/io/step2_eval.io new file mode 100644 index 0000000000..3f43a124dd --- /dev/null +++ b/impls/io/step2_eval.io @@ -0,0 +1,54 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env at(ast val) ifNil(Exception raise("'" .. (ast val) "' not found")), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +EVAL := method(ast, env, + + // ("EVAL: " .. PRINT(ast)) println + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + el := eval_ast(ast, env) + f := el at(0) + args := el rest + f callWithArgList(args) +) + +PRINT := method(exp, exp malPrint(true)) + +repl_env := Map with( + "+", block(a, b, a + b), + "-", block(a, b, a - b), + "*", block(a, b, a * b), + "/", block(a, b, a / b) +) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + ("Error: " .. (e error)) println + ) +) diff --git a/impls/io/step3_env.io b/impls/io/step3_env.io new file mode 100644 index 0000000000..2be8c67fa5 --- /dev/null +++ b/impls/io/step3_env.io @@ -0,0 +1,75 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + return(EVAL(ast at(2), letEnv)) + ) + ) + + // Apply + el := eval_ast(ast, env) + f := el at(0) + args := el rest + f callWithArgList(args) +) + +PRINT := method(exp, exp malPrint(true)) + +repl_env := Env with(nil) +repl_env set(MalSymbol with("+"), block(a, b, a + b)) +repl_env set(MalSymbol with("-"), block(a, b, a - b)) +repl_env set(MalSymbol with("*"), block(a, b, a * b)) +repl_env set(MalSymbol with("/"), block(a, b, a / b)) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + ("Error: " .. (e error)) println + ) +) diff --git a/impls/io/step4_if_fn_do.io b/impls/io/step4_if_fn_do.io new file mode 100644 index 0000000000..dbd37ce85d --- /dev/null +++ b/impls/io/step4_if_fn_do.io @@ -0,0 +1,84 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "do", + return(eval_ast(ast rest, env) last), + "if", + return(EVAL(if(EVAL(ast at(1), env), ast at(2), ast at(3)), env)), + "fn*", + return(block(a, EVAL(ast at(2), Env with(env, ast at(1), a)))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + return(EVAL(ast at(2), letEnv)) + ) + ) + + // Apply + el := eval_ast(ast, env) + f := el at(0) + args := el rest + f call(args) +) + +PRINT := method(exp, exp malPrint(true)) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +repl_env := Env with(nil) +MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) + +// core.mal: defined using the language itself +RE("(def! not (fn* (a) (if a false true)))") + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) + ) +) diff --git a/impls/io/step5_tco.io b/impls/io/step5_tco.io new file mode 100644 index 0000000000..ead709d186 --- /dev/null +++ b/impls/io/step5_tco.io @@ -0,0 +1,99 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + loop( + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "do", + eval_ast(ast slice(1,-1), env) + ast = ast last + continue, // TCO + "if", + ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) + continue, // TCO + "fn*", + return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + ast = ast at(2) + env = letEnv + continue // TCO + ) + ) + + // Apply + el := eval_ast(ast, env) + f := el at(0) + args := el rest + f type switch( + "Block", + return(f call(args)), + "MalFunc", + ast = f ast + env = Env with(f env, f params, args) + continue, // TCO + Exception raise("Unknown function type") + ) + ) +) + +PRINT := method(exp, exp malPrint(true)) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +repl_env := Env with(nil) +MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) + +// core.mal: defined using the language itself +RE("(def! not (fn* (a) (if a false true)))") + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) + ) +) diff --git a/impls/io/step6_file.io b/impls/io/step6_file.io new file mode 100644 index 0000000000..517b59aaa9 --- /dev/null +++ b/impls/io/step6_file.io @@ -0,0 +1,108 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + loop( + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "do", + eval_ast(ast slice(1,-1), env) + ast = ast last + continue, // TCO + "if", + ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) + continue, // TCO + "fn*", + return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + ast = ast at(2) + env = letEnv + continue // TCO + ) + ) + + // Apply + el := eval_ast(ast, env) + f := el at(0) + args := el rest + f type switch( + "Block", + return(f call(args)), + "MalFunc", + ast = f ast + env = Env with(f env, f params, args) + continue, // TCO + Exception raise("Unknown function type") + ) + ) +) + +PRINT := method(exp, exp malPrint(true)) + +repl_env := Env with(nil) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) +repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) +repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) + +// core.mal: defined using the language itself +RE("(def! not (fn* (a) (if a false true)))") +RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if(System args size > 1, + REP("(load-file \"" .. (System args at(1)) .. "\")") + System exit(0) +) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) + ) +) diff --git a/impls/io/step7_quote.io b/impls/io/step7_quote.io new file mode 100644 index 0000000000..f84e571771 --- /dev/null +++ b/impls/io/step7_quote.io @@ -0,0 +1,130 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) + +quasiquote := method(ast, + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + loop( + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "do", + eval_ast(ast slice(1,-1), env) + ast = ast last + continue, // TCO + "if", + ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) + continue, // TCO + "fn*", + return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + ast = ast at(2) + env = letEnv + continue, // TCO + "quote", + return(ast at(1)), + "quasiquote", + ast = quasiquote(ast at(1)) + continue // TCO + ) + ) + + // Apply + el := eval_ast(ast, env) + f := el at(0) + args := el rest + f type switch( + "Block", + return(f call(args)), + "MalFunc", + ast = f ast + env = Env with(f env, f params, args) + continue, // TCO + Exception raise("Unknown function type") + ) + ) +) + +PRINT := method(exp, exp malPrint(true)) + +repl_env := Env with(nil) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) +repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) +repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) + +// core.mal: defined using the language itself +RE("(def! not (fn* (a) (if a false true)))") +RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if(System args size > 1, + REP("(load-file \"" .. (System args at(1)) .. "\")") + System exit(0) +) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) + ) +) diff --git a/impls/io/step8_macros.io b/impls/io/step8_macros.io new file mode 100644 index 0000000000..b3a05e40c8 --- /dev/null +++ b/impls/io/step8_macros.io @@ -0,0 +1,138 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) + +quasiquote := method(ast, + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + loop( + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "do", + eval_ast(ast slice(1,-1), env) + ast = ast last + continue, // TCO + "if", + ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) + continue, // TCO + "fn*", + return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + ast = ast at(2) + env = letEnv + continue, // TCO + "quote", + return(ast at(1)), + "quasiquote", + ast = quasiquote(ast at(1)) + continue, // TCO + "defmacro!", + return(env set(ast at(1), EVAL(ast at(2), env) clone setIsMacro(true))) + ) + ) + + // Apply + f := EVAL(ast at(0), env) + raw_args := ast rest + f type switch( + "Block", + args := eval_ast(raw_args, env) + return(f call(args)), + "MalFunc", + if(f isMacro, + ast = f blk call(raw_args) + continue) // TCO + args := eval_ast(raw_args, env) + ast = f ast + env = Env with(f env, f params, args) + continue, // TCO + Exception raise("Unknown function type") + ) + ) +) + +PRINT := method(exp, exp malPrint(true)) + +repl_env := Env with(nil) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) +repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) +repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) + +// core.mal: defined using the language itself +RE("(def! not (fn* (a) (if a false true)))") +RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +if(System args size > 1, + REP("(load-file \"" .. (System args at(1)) .. "\")") + System exit(0) +) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) + ) +) diff --git a/impls/io/step9_try.io b/impls/io/step9_try.io new file mode 100644 index 0000000000..ea575325b7 --- /dev/null +++ b/impls/io/step9_try.io @@ -0,0 +1,149 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) + +quasiquote := method(ast, + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + loop( + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "do", + eval_ast(ast slice(1,-1), env) + ast = ast last + continue, // TCO + "if", + ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) + continue, // TCO + "fn*", + return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + ast = ast at(2) + env = letEnv + continue, // TCO + "quote", + return(ast at(1)), + "quasiquote", + ast = quasiquote(ast at(1)) + continue, // TCO + "defmacro!", + return(env set(ast at(1), EVAL(ast at(2), env) clone setIsMacro(true))), + "try*", + if(ast at(2) == nil, return(EVAL(ast at(1), env))) + e := try(result := EVAL(ast at(1), env)) + e catch(Exception, + exc := if(e type == "MalException", e val, e error) + catchAst := ast at(2) + catchEnv := Env with(env) + catchEnv set(catchAst at(1), exc) + result := EVAL(catchAst at(2), catchEnv) + ) + return(result) + ) + ) + + // Apply + f := EVAL(ast at(0), env) + raw_args := ast rest + f type switch( + "Block", + args := eval_ast(raw_args, env) + return(f call(args)), + "MalFunc", + if(f isMacro, + ast = f blk call(raw_args) + continue) // TCO + args := eval_ast(raw_args, env) + ast = f ast + env = Env with(f env, f params, args) + continue, // TCO + Exception raise("Unknown function type") + ) + ) +) + +PRINT := method(exp, exp malPrint(true)) + +repl_env := Env with(nil) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) +repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) +repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) + +// core.mal: defined using the language itself +RE("(def! not (fn* (a) (if a false true)))") +RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +if(System args size > 1, + REP("(load-file \"" .. (System args at(1)) .. "\")") + System exit(0) +) + +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) + ) +) diff --git a/impls/io/stepA_mal.io b/impls/io/stepA_mal.io new file mode 100644 index 0000000000..e64908f5e9 --- /dev/null +++ b/impls/io/stepA_mal.io @@ -0,0 +1,151 @@ +MalTypes +MalReader + +READ := method(str, MalReader read_str(str)) + +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) + +quasiquote := method(ast, + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) + +eval_ast := method(ast, env, + (ast type) switch( + "MalSymbol", env get(ast), + "MalList", MalList with(ast map(a, EVAL(a, env))), + "MalVector", MalVector with(ast map(a, EVAL(a, env))), + "MalMap", + m := MalMap clone + ast foreach(k, v, + m atPut(k, EVAL(v, env)) + ) + m, + ast + ) +) + +debugEvalSymbol := MalSymbol with("DEBUG-EVAL") + +EVAL := method(ast, env, + loop( + + debugEvalEnv := env find(debugEvalSymbol) + if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), + ("EVAL: " .. PRINT(ast)) println) + + if(ast type != "MalList", return(eval_ast(ast, env))) + if(ast isEmpty, return ast) + + if(ast at(0) type == "MalSymbol", + ast at(0) val switch( + "def!", + return(env set(ast at(1), EVAL(ast at(2), env))), + "do", + eval_ast(ast slice(1,-1), env) + ast = ast last + continue, // TCO + "if", + ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) + continue, // TCO + "fn*", + return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), + "let*", + letEnv := Env with(env) + varName := nil + ast at(1) foreach(i, e, + if(i % 2 == 0, + varName := e, + letEnv set(varName, EVAL(e, letEnv)) + ) + ) + ast = ast at(2) + env = letEnv + continue, // TCO + "quote", + return(ast at(1)), + "quasiquote", + ast = quasiquote(ast at(1)) + continue, // TCO + "defmacro!", + return(env set(ast at(1), EVAL(ast at(2), env) clone setIsMacro(true))), + "try*", + if(ast at(2) == nil, return(EVAL(ast at(1), env))) + e := try(result := EVAL(ast at(1), env)) + e catch(Exception, + exc := if(e type == "MalException", e val, e error) + catchAst := ast at(2) + catchEnv := Env with(env) + catchEnv set(catchAst at(1), exc) + result := EVAL(catchAst at(2), catchEnv) + ) + return(result) + ) + ) + + // Apply + f := EVAL(ast at(0), env) + raw_args := ast rest + f type switch( + "Block", + args := eval_ast(raw_args, env) + return(f call(args)), + "MalFunc", + if(f isMacro, + ast = f blk call(raw_args) + continue) // TCO + args := eval_ast(raw_args, env) + ast = f ast + env = Env with(f env, f params, args) + continue, // TCO + Exception raise("Unknown function type") + ) + ) +) + +PRINT := method(exp, exp malPrint(true)) + +repl_env := Env with(nil) + +RE := method(str, EVAL(READ(str), repl_env)) + +REP := method(str, PRINT(RE(str))) + +MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) +repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) +repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) + +// core.mal: defined using the language itself +RE("(def! *host-language* \"io\")") +RE("(def! not (fn* (a) (if a false true)))") +RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +if(System args size > 1, + REP("(load-file \"" .. (System args at(1)) .. "\")") + System exit(0) +) + +RE("(println (str \"Mal [\" *host-language* \"]\"))") +loop( + line := MalReadline readLine("user> ") + if(line isNil, break) + if(line isEmpty, continue) + e := try(REP(line) println) + e catch(Exception, + if(e type == "MalException", + ("Error: " .. ((e val) malPrint(true))) println, + ("Error: " .. (e error)) println + ) + ) +) diff --git a/impls/io/tests/step5_tco.mal b/impls/io/tests/step5_tco.mal new file mode 100644 index 0000000000..58142ab23c --- /dev/null +++ b/impls/io/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Io: skipping non-TCO recursion +;; Reason: never completes, never segfaults diff --git a/impls/io/tests/stepA_mal.mal b/impls/io/tests/stepA_mal.mal new file mode 100644 index 0000000000..5b0f5dcdd3 --- /dev/null +++ b/impls/io/tests/stepA_mal.mal @@ -0,0 +1,33 @@ +;; Testing basic Io interop + +(io-eval "7") +;=>7 + +(io-eval "\"7\"") +;=>"7" + +(io-eval "123 == 123") +;=>true + +(io-eval "123 == 456") +;=>false + +(io-eval "list(7, 8, 9)") +;=>(7 8 9) + +(io-eval "Map with(\"abc\", 789)") +;=>{"abc" 789} + +(io-eval "\"hello\" println") +;/hello +;=>"hello" + +(io-eval "Lobby foo := 8") +(io-eval "Lobby foo") +;=>8 + +(io-eval "list(\"a\", \"b\", \"c\") map(x, \"X\" .. x .. \"Y\") join(\" \")") +;=>"XaY XbY XcY" + +(io-eval "list(1, 2, 3) map(x, 1 + x)") +;=>(2 3 4) diff --git a/impls/janet/Dockerfile b/impls/janet/Dockerfile new file mode 100644 index 0000000000..ed304066fe --- /dev/null +++ b/impls/janet/Dockerfile @@ -0,0 +1,28 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ + ca-certificates wget + +RUN wget -O- \ + https://github.com/janet-lang/janet/releases/download/v1.36.0/janet-v1.36.0-linux-x64.tar.gz \ + | tar -xzC/opt +RUN ln -sf /opt/janet-v1.36.0-linux/bin/janet /usr/local/bin/janet diff --git a/impls/janet/Makefile b/impls/janet/Makefile new file mode 100644 index 0000000000..8a7cbb717e --- /dev/null +++ b/impls/janet/Makefile @@ -0,0 +1,2 @@ +all: + true diff --git a/impls/janet/core.janet b/impls/janet/core.janet new file mode 100644 index 0000000000..ba7eb5956e --- /dev/null +++ b/impls/janet/core.janet @@ -0,0 +1,777 @@ +(import ./types :as t) +(import ./utils :as u) +(import ./printer) +(import ./reader) + +(defn deref* + [ast] + (if (not (t/atom?* ast)) + (u/throw* (t/make-string (string "Expected atom, got: " (t/get-type ast)))) + (t/get-value ast))) + +(defn reset!* + [atom-ast val-ast] + (t/set-atom-value! atom-ast val-ast) + val-ast) + +(defn cons* + [head-ast tail-ast] + [head-ast ;(t/get-value tail-ast)]) + +(defn concat* + [& list-asts] + (reduce (fn [acc list-ast] + [;acc ;(t/get-value list-ast)]) + [] + list-asts)) + +(defn nth* + [coll-ast num-ast] + (let [elts (t/get-value coll-ast) + n-elts (length elts) + i (t/get-value num-ast)] + (if (< i n-elts) + (in elts i) + (u/throw* (t/make-string (string "Index out of range: " i)))))) + +(defn first* + [coll-or-nil-ast] + (if (or (t/nil?* coll-or-nil-ast) + (t/empty?* coll-or-nil-ast)) + t/mal-nil + (in (t/get-value coll-or-nil-ast) 0))) + +(defn rest* + [coll-or-nil-ast] + (if (or (t/nil?* coll-or-nil-ast) + (t/empty?* coll-or-nil-ast)) + (t/make-list []) + (t/make-list (slice (t/get-value coll-or-nil-ast) 1)))) + +(defn janet-eval* + [janet-val] + (case (type janet-val) + :nil + t/mal-nil + ## + :boolean + (t/make-boolean janet-val) + ## + :number # XXX: there may be some incompatibilities + (t/make-number janet-val) + ## + :string + (t/make-string janet-val) + ## + :keyword # XXX: there may be some incompatibilities + (t/make-keyword (string ":" janet-val)) + ## + :symbol # XXX: there may be some incompatibilities + (t/make-symbol (string janet-val)) + ## + :tuple + (t/make-list (map janet-eval* janet-val)) + ## + :array + (t/make-list (map janet-eval* janet-val)) + ## + :struct + (t/make-hash-map (struct ;(map janet-eval* (kvs janet-val)))) + ## + :table + (t/make-hash-map (struct ;(map janet-eval* (kvs janet-val)))) + ## + (u/throw* (t/make-string (string "Unsupported type: " (type janet-val)))))) + +(defn arith-fn + [op] + (t/make-function + (fn [asts] + (t/make-number + (op ;(map |(t/get-value $) + asts)))))) + +(defn cmp-fn + [op] + (t/make-function + (fn [asts] + (if (op ;(map |(t/get-value $) asts)) + t/mal-true + t/mal-false)))) + +(def mal-symbol + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "symbol requires 1 argument"))) + (t/make-symbol (t/get-value (in asts 0)))))) + +(def mal-keyword + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "keyword requires 1 argument"))) + (let [arg-ast (in asts 0)] + (cond + (t/keyword?* arg-ast) + arg-ast + ## + (t/string?* arg-ast) + (t/make-keyword (string ":" (t/get-value arg-ast))) + ## + (u/throw* (t/make-string "Expected string"))))))) + +(def mal-list + (t/make-function + (fn [asts] + (t/make-list asts)))) + +(def mal-vector + (t/make-function + (fn [asts] + (t/make-vector asts)))) + +(def mal-vec + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "vec requires 1 argument"))) + (let [ast (in asts 0)] + (cond + (t/vector?* ast) + ast + ## + (t/list?* ast) + (t/make-vector (t/get-value ast)) + ## + (t/nil?* ast) + (t/make-vector ()) + ## + (u/throw* (t/make-string "vec requires a vector, list, or nil"))))))) + +(def mal-hash-map + (t/make-function + (fn [asts] + (when (= 1 (% (length asts) 2)) + (u/throw* (t/make-string + "hash-map requires an even number of arguments"))) + (t/make-hash-map asts)))) + +(def mal-atom + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "atom requires 1 argument"))) + (t/make-atom (in asts 0))))) + +(def mal-nil? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "nil? requires 1 argument"))) + (if (t/nil?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-true? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "true? requires 1 argument"))) + (if (t/true?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-false? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "false? requires 1 argument"))) + (if (t/false?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-number? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "number? requires 1 argument"))) + (if (t/number?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-symbol? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "symbol? requires 1 argument"))) + (if (t/symbol?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-keyword? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "keyword? requires 1 argument"))) + (if (t/keyword?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-string? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "string? requires 1 argument"))) + (if (t/string?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-list? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "list? requires 1 argument"))) + (if (t/list?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-vector? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "vector? requires 1 argument"))) + (if (t/vector?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-map? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "map? requires 1 argument"))) + (if (t/hash-map?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-fn? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "fn? requires 1 argument"))) + (let [target-ast (in asts 0)] + (if (and (t/fn?* target-ast) + (not (t/get-is-macro target-ast))) + t/mal-true + t/mal-false))))) + +(def mal-macro? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "macro? requires 1 argument"))) + (let [the-ast (in asts 0)] + (if (t/macro?* the-ast) + t/mal-true + t/mal-false))))) + +(def mal-atom? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "atom? requires 1 argument"))) + (if (t/atom?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-sequential? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "sequential? requires 1 argument"))) + (if (or (t/list?* (in asts 0)) + (t/vector?* (in asts 0))) + t/mal-true + t/mal-false)))) + +(def mal-= + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "= requires 2 arguments"))) + (let [ast-1 (in asts 0) + ast-2 (in asts 1)] + (if (t/equals?* ast-1 ast-2) + t/mal-true + t/mal-false))))) + +(def mal-empty? + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "empty? requires 1 argument"))) + (if (t/empty?* (in asts 0)) + t/mal-true + t/mal-false)))) + +(def mal-contains? + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "contains? requires 2 arguments"))) + (let [head-ast (in asts 0)] + (when (not (or (t/hash-map?* head-ast) + (t/nil?* head-ast))) + (u/throw* (t/make-string + "contains? first argument should be a hash-map or nil"))) + (if (t/nil?* head-ast) + t/mal-nil + (let [item-struct (t/get-value head-ast) + key-ast (in asts 1)] + (if-let [val-ast (get item-struct key-ast)] + t/mal-true + t/mal-false))))))) + +(def mal-deref + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "deref requires 1 argument"))) + (let [ast (in asts 0)] + (deref* ast))))) + +(def mal-reset! + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "reset! requires 2 arguments"))) + (let [atom-ast (in asts 0) + val-ast (in asts 1)] + (reset!* atom-ast val-ast))))) + +(def mal-swap! + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "swap! requires at least 2 arguments"))) + (let [atom-ast (in asts 0) + fn-ast (in asts 1) + args-asts (slice asts 2) + inner-ast (deref* atom-ast)] + (reset!* atom-ast + ((t/get-value fn-ast) [inner-ast ;args-asts])))))) + +(def mal-pr-str + (t/make-function + (fn [asts] + (def buf @"") + (when (> (length asts) 0) + (each ast asts + (buffer/push-string buf (printer/pr_str ast true)) + (buffer/push-string buf " ")) + # remove extra space at end + (buffer/popn buf 1)) + (t/make-string (string buf))))) + +(def mal-str + (t/make-function + (fn [asts] + (def buf @"") + (when (> (length asts) 0) + (each ast asts + (buffer/push-string buf (printer/pr_str ast false)))) + (t/make-string (string buf))))) + +(def mal-prn + (t/make-function + (fn [asts] + (def buf @"") + (when (> (length asts) 0) + (each ast asts + (buffer/push-string buf (printer/pr_str ast true)) + (buffer/push-string buf " ")) + # remove extra space at end + (buffer/popn buf 1)) + (print (string buf)) + t/mal-nil))) + +(def mal-println + (t/make-function + (fn [asts] + (def buf @"") + (when (> (length asts) 0) + (each ast asts + (buffer/push-string buf (printer/pr_str ast false)) + (buffer/push-string buf " ")) + # remove extra space at end + (buffer/popn buf 1)) + (print (string buf)) + t/mal-nil))) + +(def mal-read-string + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "read-string requires 1 argument"))) + (if-let [res (reader/read_str (t/get-value (in asts 0)))] + res + (u/throw* (t/make-string "No code content")))))) + +(def mal-slurp + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "slurp requires 1 argument"))) + (let [a-str (t/get-value (in asts 0))] + (if (not (os/stat a-str)) + (u/throw* (string "File not found: " a-str)) + # XXX: escaping? + (t/make-string (slurp a-str))))))) + +(def mal-count + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "count requires 1 argument"))) + (let [ast (in asts 0)] + (if (t/nil?* ast) + (t/make-number 0) + (t/make-number (length (t/get-value ast)))))))) + +(def mal-cons + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "cons requires 2 arguments"))) + (let [head-ast (in asts 0) + tail-ast (in asts 1)] + (t/make-list (cons* head-ast tail-ast)))))) + +(def mal-concat + (t/make-function + (fn [asts] + (t/make-list (concat* ;asts))))) + +(def mal-nth + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "nth requires 2 arguments"))) + (let [coll-ast (in asts 0) + num-ast (in asts 1)] + (nth* coll-ast num-ast))))) + +(def mal-first + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "first requires 1 argument"))) + (let [coll-or-nil-ast (in asts 0)] + (first* coll-or-nil-ast))))) + +(def mal-rest + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "rest requires 1 argument"))) + (let [coll-or-nil-ast (in asts 0)] + (rest* coll-or-nil-ast))))) + +(def mal-assoc + (t/make-function + (fn [asts] + (when (< (length asts) 3) + (u/throw* (t/make-string "assoc requires at least 3 arguments"))) + (let [head-ast (in asts 0)] + (when (not (or (t/hash-map?* head-ast) + (t/nil?* head-ast))) + (u/throw* (t/make-string + "assoc first argument should be a hash-map or nil"))) + (if (t/nil?* head-ast) + t/mal-nil + (let [item-table (table ;(kvs (t/get-value head-ast))) + kv-asts (slice asts 1 -1)] + (each [key-ast val-ast] (partition 2 kv-asts) + (put item-table key-ast val-ast)) + (t/make-hash-map (table/to-struct item-table)))))))) + +(def mal-dissoc + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "dissoc requires at least 2 arguments"))) + (let [head-ast (in asts 0)] + (when (not (or (t/hash-map?* head-ast) + (t/nil?* head-ast))) + (u/throw* (t/make-string + "dissoc first argument should be a hash-map or nil"))) + (if (t/nil?* head-ast) + t/mal-nil + (let [item-table (table ;(kvs (t/get-value head-ast))) + key-asts (slice asts 1 -1)] + (each key-ast key-asts + (put item-table key-ast nil)) + (t/make-hash-map (table/to-struct item-table)))))))) + +(def mal-get + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "get requires 2 arguments"))) + (let [head-ast (in asts 0)] + (when (not (or (t/hash-map?* head-ast) + (t/nil?* head-ast))) + (u/throw* (t/make-string + "get first argument should be a hash-map or nil"))) + (if (t/nil?* head-ast) + t/mal-nil + (let [item-struct (t/get-value head-ast) + key-ast (in asts 1)] + (if-let [val-ast (get item-struct key-ast)] + val-ast + t/mal-nil))))))) + +(def mal-keys + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "keys requires 1 argument"))) + (let [head-ast (in asts 0)] + (when (not (or (t/hash-map?* head-ast) + (t/nil?* head-ast))) + (u/throw* (t/make-string + "keys first argument should be a hash-map or nil"))) + (if (t/nil?* head-ast) + t/mal-nil + (let [item-struct (t/get-value head-ast)] + (t/make-list (keys item-struct)))))))) + +(def mal-vals + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "vals requires 1 argument"))) + (let [head-ast (in asts 0)] + (when (not (or (t/hash-map?* head-ast) + (t/nil?* head-ast))) + (u/throw* (t/make-string + "vals first argument should be a hash-map or nil"))) + (if (t/nil?* head-ast) + t/mal-nil + (let [item-struct (t/get-value head-ast)] + (t/make-list (values item-struct)))))))) + +(def mal-conj + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "conj requires at least 2 arguments"))) + (let [coll-ast (in asts 0) + item-asts (slice asts 1)] + (cond + (t/nil?* coll-ast) + (t/make-list [;(reverse item-asts)]) + ## + (t/list?* coll-ast) + (t/make-list [;(reverse item-asts) ;(t/get-value coll-ast)]) + ## + (t/vector?* coll-ast) + (t/make-vector [;(t/get-value coll-ast) ;item-asts]) + ## + (u/throw* (t/make-string "Expected list or vector"))))))) + +(def mal-seq + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "seq requires 1 argument"))) + (let [arg-ast (in asts 0)] + (cond + (t/list?* arg-ast) + (if (t/empty?* arg-ast) + t/mal-nil + arg-ast) + ## + (t/vector?* arg-ast) + (if (t/empty?* arg-ast) + t/mal-nil + (t/make-list (t/get-value arg-ast))) + ## + (t/string?* arg-ast) + (if (t/empty?* arg-ast) + t/mal-nil + (let [str-asts (map |(t/make-string (string/from-bytes $)) + (t/get-value arg-ast))] + (t/make-list str-asts))) + ## + (t/nil?* arg-ast) + arg-ast + ## + (u/throw* (t/make-string "Expected list, vector, string, or nil"))))))) + +(def mal-map + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "map requires at least 2 arguments"))) + (let [the-fn (t/get-value (in asts 0)) + coll (t/get-value (in asts 1))] + (t/make-list (map |(the-fn [$]) + coll)))))) + +# (apply F A B [C D]) is equivalent to (F A B C D) +(def mal-apply + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "apply requires at least 1 argument"))) + (let [the-fn (t/get-value (in asts 0))] # e.g. F + (if (= (length asts) 1) + (the-fn []) + (let [last-asts (t/get-value (get (slice asts -2) 0)) # e.g. [C D] + args-asts (slice asts 1 -2)] # e.g. [A B] + (the-fn [;args-asts ;last-asts]))))))) + +(def mal-meta + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "meta requires 1 argument"))) + (let [head-ast (in asts 0)] + (if (or (t/list?* head-ast) + (t/vector?* head-ast) + (t/hash-map?* head-ast) + (t/fn?* head-ast)) + (t/get-meta (in asts 0)) + t/mal-nil))))) + +(def mal-with-meta + (t/make-function + (fn [asts] + (when (< (length asts) 2) + (u/throw* (t/make-string "with-meta requires 2 arguments"))) + (let [target-ast (in asts 0) + meta-ast (in asts 1)] + (cond + (t/list?* target-ast) + (t/make-list (t/get-value target-ast) meta-ast) + ## + (t/vector?* target-ast) + (t/make-vector (t/get-value target-ast) meta-ast) + ## + (t/hash-map?* target-ast) + (t/make-hash-map (t/get-value target-ast) meta-ast) + ## + (t/fn?* target-ast) + (t/clone-with-meta target-ast meta-ast) + ## + (u/throw* (t/make-string "Expected list, vector, hash-map, or fn"))))))) + +(def mal-throw + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "throw requires 1 argument"))) + (u/throw* (in asts 0))))) + +(def mal-readline + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "readline requires 1 argument"))) + (let [prompt (t/get-value (in asts 0)) + buf @""] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf) + (if (< 0 (length buf)) + (t/make-string (string/trimr buf)) + t/mal-nil))))) + +(def mal-time-ms + (t/make-function + (fn [asts] + (t/make-number + (math/floor (* 1000 (os/clock))))))) + +(def mal-janet-eval + (t/make-function + (fn [asts] + (when (< (length asts) 1) + (u/throw* (t/make-string "janet-eval requires 1 argument"))) + (let [head-ast (in asts 0)] + (when (not (t/string?* head-ast)) + (u/throw* (t/make-string + "janet-eval first argument should be a string"))) + (let [res (try + (eval-string (t/get-value head-ast)) # XXX: escaping? + ([err] + (u/throw* (t/make-string (string "Eval failed: " err)))))] + (janet-eval* res)))))) + +(def unimplemented mal-throw) + +(def ns + {(t/make-symbol "+") (arith-fn +) + (t/make-symbol "-") (arith-fn -) + (t/make-symbol "*") (arith-fn *) + (t/make-symbol "/") (arith-fn /) + (t/make-symbol "list") mal-list + (t/make-symbol "list?") mal-list? + (t/make-symbol "vec") mal-vec + (t/make-symbol "vector?") mal-vector? + (t/make-symbol "empty?") mal-empty? + (t/make-symbol "count") mal-count + (t/make-symbol "=") mal-= + (t/make-symbol "<") (cmp-fn <) + (t/make-symbol "<=") (cmp-fn <=) + (t/make-symbol ">") (cmp-fn >) + (t/make-symbol ">=") (cmp-fn >=) + (t/make-symbol "pr-str") mal-pr-str + (t/make-symbol "str") mal-str + (t/make-symbol "prn") mal-prn + (t/make-symbol "println") mal-println + (t/make-symbol "read-string") mal-read-string + (t/make-symbol "slurp") mal-slurp + (t/make-symbol "atom") mal-atom + (t/make-symbol "atom?") mal-atom? + (t/make-symbol "deref") mal-deref + (t/make-symbol "reset!") mal-reset! + (t/make-symbol "swap!") mal-swap! + (t/make-symbol "cons") mal-cons + (t/make-symbol "concat") mal-concat + (t/make-symbol "nth") mal-nth + (t/make-symbol "first") mal-first + (t/make-symbol "rest") mal-rest + (t/make-symbol "throw") mal-throw + (t/make-symbol "apply") mal-apply + (t/make-symbol "map") mal-map + (t/make-symbol "nil?") mal-nil? + (t/make-symbol "true?") mal-true? + (t/make-symbol "false?") mal-false? + (t/make-symbol "symbol?") mal-symbol? + (t/make-symbol "symbol") mal-symbol + (t/make-symbol "keyword") mal-keyword + (t/make-symbol "keyword?") mal-keyword? + (t/make-symbol "vector") mal-vector + (t/make-symbol "sequential?") mal-sequential? + (t/make-symbol "hash-map") mal-hash-map + (t/make-symbol "map?") mal-map? + (t/make-symbol "assoc") mal-assoc + (t/make-symbol "dissoc") mal-dissoc + (t/make-symbol "get") mal-get + (t/make-symbol "contains?") mal-contains? + (t/make-symbol "keys") mal-keys + (t/make-symbol "vals") mal-vals + (t/make-symbol "readline") mal-readline + (t/make-symbol "time-ms") mal-time-ms + (t/make-symbol "meta") mal-meta + (t/make-symbol "with-meta") mal-with-meta + (t/make-symbol "fn?") mal-fn? + (t/make-symbol "string?") mal-string? + (t/make-symbol "number?") mal-number? + (t/make-symbol "conj") mal-conj + (t/make-symbol "seq") mal-seq + (t/make-symbol "macro?") mal-macro? + (t/make-symbol "janet-eval") mal-janet-eval +}) diff --git a/impls/janet/env.janet b/impls/janet/env.janet new file mode 100644 index 0000000000..4b2b817f1f --- /dev/null +++ b/impls/janet/env.janet @@ -0,0 +1,41 @@ +(import ./types :as t) +(import ./utils :as u) + +(defn make-env + [&opt outer binds exprs] + (default binds []) + (default exprs []) + (def n-binds (length binds)) + (var found-amp false) + (var idx 0) + (while (and (not found-amp) + (< idx n-binds)) + (def c-bind (in binds idx)) + (when (= (t/get-value c-bind) "&") + (set found-amp true) + (break)) + (++ idx)) + (def new-binds + (if found-amp + (array/concat (array ;(slice binds 0 idx)) + (in binds (inc idx))) + binds)) + (def new-exprs + (if found-amp + (array/concat (array ;(slice exprs 0 idx)) + (array (t/make-list (slice exprs idx)))) + exprs)) + # XXX: would length mismatches of new-binds / new-exprs ever be an issue? + @{:data (zipcoll new-binds new-exprs) + :outer outer}) + +(defn env-set + [env sym value] + (put-in env [:data sym] + value)) + +(defn env-get + [env sym] + (or (get-in env [:data sym]) + (if-let [outer (get env :outer)] + (env-get outer sym)))) diff --git a/impls/janet/printer.janet b/impls/janet/printer.janet new file mode 100644 index 0000000000..a4d35fe04a --- /dev/null +++ b/impls/janet/printer.janet @@ -0,0 +1,101 @@ +(import ./types :as t) + +(defn escape + [a-str] + (->> (buffer a-str) + (peg/replace-all "\\" "\\\\") + (peg/replace-all "\"" "\\\"") + (peg/replace-all "\n" "\\n") + string)) + +(defn code* + [ast buf print_readably] + (cond + (or (t/boolean?* ast) + (t/nil?* ast) + (t/keyword?* ast) + (t/symbol?* ast)) + (buffer/push-string buf (t/get-value ast)) + ## + (t/number?* ast) + (buffer/push-string buf (string (t/get-value ast))) + ## + (t/string?* ast) + (if print_readably + (buffer/push-string buf (string "\"" + (escape (t/get-value ast)) + "\"")) + (buffer/push-string buf (t/get-value ast))) + ## + (t/list?* ast) + (do + (buffer/push-string buf "(") + (var remove false) + (each elt (t/get-value ast) + (code* elt buf print_readably) + (buffer/push-string buf " ") + (set remove true)) + (when remove + (buffer/popn buf 1)) + (buffer/push-string buf ")")) + ## + (t/hash-map?* ast) + (do + (buffer/push-string buf "{") + (var remove false) + (eachp [k v] (t/get-value ast) + (code* k buf print_readably) + (buffer/push-string buf " ") + (code* v buf print_readably) + (buffer/push-string buf " ") + (set remove true)) + (when remove + (buffer/popn buf 1)) + (buffer/push-string buf "}")) + ## + (t/vector?* ast) + (do + (buffer/push-string buf "[") + (var remove false) + (each elt (t/get-value ast) + (code* elt buf print_readably) + (buffer/push-string buf " ") + (set remove true)) + (when remove + (buffer/popn buf 1)) + (buffer/push-string buf "]")) + ## XXX: what about macro? + (t/fn?* ast) + (buffer/push-string buf "#") + ## + (t/atom?* ast) + (do + (buffer/push-string buf "(atom ") + (code* (t/get-value ast) buf print_readably) + (buffer/push-string buf ")")) + ## + (t/exception?* ast) + (do + (buffer/push-string buf "Error: ") + (code* (t/get-value ast) buf print_readably)))) + +(comment + + (let [buf @""] + (code* (make-number 1) buf false)) + # => @"1" + + ) + +(defn pr_str + [ast print_readably] + (let [buf @""] + (code* ast buf print_readably) + buf)) + +(comment + + (pr_str (make-number 1) false) + # => @"1" + + ) diff --git a/impls/janet/reader.janet b/impls/janet/reader.janet new file mode 100644 index 0000000000..0d856dcdfa --- /dev/null +++ b/impls/janet/reader.janet @@ -0,0 +1,311 @@ +(import ./types :as t) +(import ./utils :as u) + +(def grammar + ~{:main (capture (some :input)) + :input (choice :gap :form) + :gap (choice :ws :comment) + :ws (set " \f\n\r\t,") + :comment (sequence ";" + (any (if-not (set "\r\n") + 1))) + :form (choice :boolean :nil :number :keyword :symbol + :string :list :vector :hash-map + :deref :quasiquote :quote :splice-unquote :unquote + :with-meta) + :name-char (if-not (set " \f\n\r\t,[]{}()'`~^@\";") + 1) + :boolean (sequence (choice "false" "true") + (not :name-char)) + :nil (sequence "nil" + (not :name-char)) + :number (drop (cmt + (capture (some :name-char)) + ,scan-number)) + :keyword (sequence ":" + (any :name-char)) + :symbol (some :name-char) + :string (sequence "\"" + (any (if-not (set "\"\\") + 1)) + (any (sequence "\\" + 1 + (any (if-not (set "\"\\") + 1)))) + (choice "\"" + (error (constant "unbalanced \"")))) + :hash-map (sequence "{" + (any :input) + (choice "}" + (error (constant "unbalanced }")))) + :list (sequence "(" + (any :input) + (choice ")" + (error (constant "unbalanced )")))) + :vector (sequence "[" + (any :input) + (choice "]" + (error (constant "unbalanced ]")))) + :deref (sequence "@" :form) + :quasiquote (sequence "`" :form) + :quote (sequence "'" :form) + :splice-unquote (sequence "~@" :form) + :unquote (sequence "~" :form) + :with-meta (sequence "^" :form (some :gap) :form) + } + ) + +(comment + + (peg/match grammar " ") + # => @[" "] + + (peg/match grammar "; hello") + # => @["; hello"] + + (peg/match grammar "true") + # => @["true"] + + (peg/match grammar "false") + # => @["false"] + + (peg/match grammar "nil") + # => @["nil"] + + (peg/match grammar "18") + # => @["18"] + + (peg/match grammar "sym") + # => @["sym"] + + (peg/match grammar ":alpha") + # => @[":alpha"] + + (peg/match grammar "\"a string\"") + # => @["\"a string\""] + + (peg/match grammar "(+ 1 2)") + # => @["(+ 1 2)"] + + (peg/match grammar "[:a :b :c]") + # => @["[:a :b :c]"] + + (peg/match grammar "{:a 1 :b 2}") + # => @{"{:a 1 :b 2}"] + + ) + +(defn unescape + [a-str] + (->> a-str + (peg/replace-all "\\\\" "\u029e") # XXX: a hack? + (peg/replace-all "\\\"" "\"") + (peg/replace-all "\\n" "\n") + (peg/replace-all "\u029e" "\\") + string)) + +(def enlive-grammar + (let [cg (table ;(kvs grammar))] + (each kwd [# :comment # XX: don't capture comments + :boolean :keyword :nil + :symbol + # :ws # XXX: dont' capture whitespace + ] + (put cg kwd + ~(cmt (capture ,(in cg kwd)) + ,|{:tag (keyword kwd) + :content $}))) + (put cg :number + ~(cmt (capture ,(in cg :number)) + ,|{:tag :number + :content (scan-number $)})) + (put cg :string + ~(cmt (capture ,(in cg :string)) + ,|{:tag :string + # discard surrounding double quotes + :content (unescape (slice $ 1 -2))})) + (each kwd [:deref :quasiquote :quote :splice-unquote :unquote] + (put cg kwd + ~(cmt (capture ,(in cg kwd)) + ,|{:tag :list + :content [{:tag :symbol + :content (string kwd)} + ;(slice $& 0 -2)]}))) + (each kwd [:list :vector] + (put cg kwd + (tuple # array needs to be converted + ;(put (array ;(in cg kwd)) + 2 ~(cmt (capture ,(get-in cg [kwd 2])) + ,|{:tag (keyword kwd) + :content (slice $& 0 -2)}))))) + (put cg :hash-map + (tuple # array needs to be converted + ;(put (array ;(in cg :hash-map)) + 2 ~(cmt (capture ,(get-in cg [:hash-map 2])) + ,|{:tag :hash-map + :content (struct ;(slice $& 0 -2))})))) + (put cg :with-meta + ~(cmt (capture ,(in cg :with-meta)) + ,|{:tag :list + :content [{:tag :symbol + :content "with-meta"} + (get $& 1) + (get $& 0)]})) + # tried using a table with a peg but had a problem, so use a struct + (table/to-struct cg))) + +(comment + + (peg/match enlive-grammar "nil") + # => @[{:content "nil" :tag :nil} "nil"] + + (peg/match enlive-grammar "true") + # => @[{:content "true" :tag :boolean} "true"] + + (peg/match enlive-grammar ":hi") + # => @[{:content ":hi" :tag :keyword} ":hi"] + + (peg/match enlive-grammar "sym") + # => @[{:content "sym" :tag :symbol} "sym"] + + (peg/match enlive-grammar "'a") + `` + '@[{:content ({:content "quote" + :tag :symbol} + {:content "a" + :tag :symbol}) + :tag :list} "'a"] + `` + + (peg/match enlive-grammar "@a") + `` + '@[{:content ({:content "deref" + :tag :symbol} + {:content "a" + :tag :symbol}) + :tag :list} "@a"] + `` + + (peg/match enlive-grammar "`a") + `` + '@[{:content ({:content "quasiquote" + :tag :symbol} + {:content "a" + :tag :symbol}) + :tag :list} "`a"] + `` + + (peg/match enlive-grammar "~a") + `` + '@[{:content ({:content "unquote" + :tag :symbol} + {:content "a" + :tag :symbol}) + :tag :list} "~a"] + `` + + (peg/match enlive-grammar "~@a") + `` + '@[{:content ({:content "splice-unquote" + :tag :symbol} + {:content "a" + :tag :symbol}) + :tag :list} "~@a"] + `` + + (peg/match enlive-grammar "(a b c)") + `` + '@[{:content ({:content "a" + :tag :symbol} + {:content "b" + :tag :symbol} + {:content "c" + :tag :symbol}) + :tag :list} "(a b c)"] + `` + + (peg/match enlive-grammar "(a [:x :y] c)") + `` + '@[{:content ({:content "a" + :tag :symbol} + {:content ({:content ":x" + :tag :keyword} + {:content ":y" + :tag :keyword}) + :tag :vector} + {:content "c" + :tag :symbol}) + :tag :list} "(a [:x :y] c)"] + `` + + (peg/match enlive-grammar "^{:a 1} [:x :y]") + `` + '@[{:content ({:content "with-meta" + :tag :symbol} + {:content ({:content ":x" + :tag :keyword} + {:content ":y" + :tag :keyword}) + :tag :vector} + {:content {{:content ":a" + :tag :keyword} + {:content "1" + :tag :number}} + :tag :hash-map}) + :tag :list} "^{:a 1} [:x :y]"] + `` + + (peg/match enlive-grammar ";; hi") + # => @[";; hi"] + + (peg/match enlive-grammar "[:x ;; hi\n :y]") + `` + '@[{:content ({:content ":x" + :tag :keyword} + {:content ":y" + :tag :keyword}) + :tag :vector} "[:x ;; hi\n :y]"] + `` + + (peg/match enlive-grammar " 7 ") + # => @[{:content 7 :tag :number} " 7 "] + + (peg/match enlive-grammar " abc ") + # => @[{:content "abc" :tag :symbol} " abc "] + + (peg/match enlive-grammar " \nabc ") + # => @[{:content "abc" :tag :symbol} " \nabc "] + + ) + +(defn read_str + [code-str] + (let [[parsed _] + (try + (peg/match enlive-grammar code-str) + ([err] + (u/throw* (t/make-string err))))] + (if (= (type parsed) :struct) + parsed + (u/throw* t/mal-nil)))) + +(comment + + (read_str "(+ 1 2)") + `` + '{:content ({:content "+" + :tag :symbol} + {:content 1 + :tag :number} + {:content 2 + :tag :number}) + :tag :list} + `` + + (read_str ";; hello") + # => nil + + (read_str "\"1\"") + # => {:content "1" :tag :string} + + ) diff --git a/impls/janet/run b/impls/janet/run new file mode 100755 index 0000000000..f4782c8fae --- /dev/null +++ b/impls/janet/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec janet $(dirname $0)/${STEP:-stepA_mal}.janet "${@}" diff --git a/impls/janet/step0_repl.janet b/impls/janet/step0_repl.janet new file mode 100644 index 0000000000..d31b9d11ea --- /dev/null +++ b/impls/janet/step0_repl.janet @@ -0,0 +1,31 @@ +(defn READ + [code-str] + code-str) + +(defn EVAL + [ast] + ast) + +(defn PRINT + [ast] + ast) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str)))) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn main + [& args] + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (< 0 (length buf)) + (prin (rep buf)) + (break)))) diff --git a/impls/janet/step1_read_print.janet b/impls/janet/step1_read_print.janet new file mode 100644 index 0000000000..fa9e71fa63 --- /dev/null +++ b/impls/janet/step1_read_print.janet @@ -0,0 +1,49 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(defn EVAL + [ast] + ast) + +(defn PRINT + [value] + (printer/pr_str value true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str)))) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err)))))) diff --git a/impls/janet/step2_eval.janet b/impls/janet/step2_eval.janet new file mode 100644 index 0000000000..fa1dc786bc --- /dev/null +++ b/impls/janet/step2_eval.janet @@ -0,0 +1,92 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(defn arith-fn + [op] + (fn [ast-1 ast-2] + (t/make-number (op (t/get-value ast-1) + (t/get-value ast-2))))) + +(def repl_env + {(t/make-symbol "+") (arith-fn +) + (t/make-symbol "-") (arith-fn -) + (t/make-symbol "*") (arith-fn *) + (t/make-symbol "/") (arith-fn /)}) + +(var EVAL nil) + +(defn EVAL + [ast env] + + # (print (string "EVAL: " (printer/pr_str ast true))) + + (case (t/get-type ast) + + :symbol + (or (env ast) + (error + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast))))) + + :vector + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast))) + + :list + (if (t/empty?* ast) + ast + (let [ast-head (in (t/get-value ast) 0) + f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast)) + args (map |(EVAL $0 env) raw-args)] + (apply f args))) + + # Neither a list, map, symbol or vector. + ast)) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err)))))) diff --git a/impls/janet/step3_env.janet b/impls/janet/step3_env.janet new file mode 100644 index 0000000000..e07941a45c --- /dev/null +++ b/impls/janet/step3_env.janet @@ -0,0 +1,118 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(defn arith-fn + [op] + (fn [ast-1 ast-2] + (t/make-number (op (t/get-value ast-1) + (t/get-value ast-2))))) + +(def repl_env + (let [env (e/make-env)] + (e/env-set env (t/make-symbol "+") (arith-fn +)) + (e/env-set env (t/make-symbol "-") (arith-fn -)) + (e/env-set env (t/make-symbol "*") (arith-fn *)) + (e/env-set env (t/make-symbol "/") (arith-fn /)) + env)) + +(var EVAL nil) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast env] + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (or (e/env-get env ast) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast))))) + + :vector + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast))) + + :list + (if (t/empty?* ast) + ast + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + def-val) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + (EVAL (in (t/get-value ast) 2) new-env)) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast)) + args (map |(EVAL $0 env) raw-args)] + (apply f args))))) + + # Neither a list, map, symbol or vector. + ast)) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err)))))) diff --git a/impls/janet/step4_if_fn_do.janet b/impls/janet/step4_if_fn_do.janet new file mode 100644 index 0000000000..c028bd79f1 --- /dev/null +++ b/impls/janet/step4_if_fn_do.janet @@ -0,0 +1,135 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) +(import ./core) + +(def repl_env + (let [env (e/make-env)] + (eachp [k v] core/ns + (e/env-set env k v)) + env)) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(var EVAL nil) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast env] + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (or (e/env-get env ast) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast))))) + + :vector + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast))) + + :list + (if (t/empty?* ast) + ast + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + def-val) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + (EVAL (in (t/get-value ast) 2) new-env)) + ## + "do" + (let [most-do-body-forms (slice (t/get-value ast) 1 -2) + last-body-form (last (t/get-value ast))] + (each x most-do-body-forms (EVAL x env)) + (EVAL last-body-form env)) + ## + "if" + (let [cond-res (EVAL (in (t/get-value ast) 1) env)] + (if (or (t/nil?* cond-res) + (t/false?* cond-res)) + (if-let [else-ast (get (t/get-value ast) 3)] + (EVAL else-ast env) + t/mal-nil) + (EVAL (in (t/get-value ast) 2) env))) + ## + "fn*" + (let [params (t/get-value (in (t/get-value ast) 1)) + body (in (t/get-value ast) 2)] + (t/make-function (fn [args] + (EVAL body + (e/make-env env params args))))) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast)) + args (map |(EVAL $0 env) raw-args)] + ((t/get-value f) args))))) + + # Neither a list, map, symbol or vector. + ast)) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err)))))) diff --git a/impls/janet/step5_tco.janet b/impls/janet/step5_tco.janet new file mode 100644 index 0000000000..e94852b8da --- /dev/null +++ b/impls/janet/step5_tco.janet @@ -0,0 +1,156 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) +(import ./core) + +(def repl_env + (let [env (e/make-env)] + (eachp [k v] core/ns + (e/env-set env k v)) + env)) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(var EVAL nil) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (label result + (while true + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (if-let [value (e/env-get env ast)] + (return result value) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (return result + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast)))))) + + :vector + (return result + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast)))) + + :list + (if (t/empty?* ast) + (return result ast) + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + (return result def-val)) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + ## tco + (set ast (in (t/get-value ast) 2)) + (set env new-env)) + ## + "do" + (let [most-do-body-forms (slice (t/get-value ast) 1 -2) + last-body-form (last (t/get-value ast))] + (each x most-do-body-forms (EVAL x env)) + ## tco + (set ast last-body-form)) + ## + "if" + (let [cond-res (EVAL (in (t/get-value ast) 1) env)] + (if (or (t/nil?* cond-res) + (t/false?* cond-res)) + (if-let [else-ast (get (t/get-value ast) 3)] + ## tco + (set ast else-ast) + (return result t/mal-nil)) + ## tco + (set ast (in (t/get-value ast) 2)))) + ## + "fn*" + (let [params (t/get-value (in (t/get-value ast) 1)) + body (in (t/get-value ast) 2)] + ## tco + (return result + (t/make-function (fn [args] + (EVAL body + (e/make-env env params args))) + nil false + body params env))) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast)) + args (map |(EVAL $0 env) raw-args)] + (if-let [body (t/get-ast f)] ## tco + (do + (set ast body) + (set env (e/make-env (t/get-env f) (t/get-params f) args))) + (return result + ((t/get-value f) args))))))) + + # Neither a list, map, symbol or vector. + (return result ast))))) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err)))))) diff --git a/impls/janet/step6_file.janet b/impls/janet/step6_file.janet new file mode 100644 index 0000000000..fc078d65bf --- /dev/null +++ b/impls/janet/step6_file.janet @@ -0,0 +1,184 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) +(import ./core) + +(def repl_env + (let [env (e/make-env)] + (eachp [k v] core/ns + (e/env-set env k v)) + env)) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(var EVAL nil) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (label result + (while true + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (if-let [value (e/env-get env ast)] + (return result value) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (return result + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast)))))) + + :vector + (return result + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast)))) + + :list + (if (t/empty?* ast) + (return result ast) + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + (return result def-val)) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + ## tco + (set ast (in (t/get-value ast) 2)) + (set env new-env)) + ## + "do" + (let [most-do-body-forms (slice (t/get-value ast) 1 -2) + last-body-form (last (t/get-value ast))] + (each x most-do-body-forms (EVAL x env)) + ## tco + (set ast last-body-form)) + ## + "if" + (let [cond-res (EVAL (in (t/get-value ast) 1) env)] + (if (or (t/nil?* cond-res) + (t/false?* cond-res)) + (if-let [else-ast (get (t/get-value ast) 3)] + ## tco + (set ast else-ast) + (return result t/mal-nil)) + ## tco + (set ast (in (t/get-value ast) 2)))) + ## + "fn*" + (let [params (t/get-value (in (t/get-value ast) 1)) + body (in (t/get-value ast) 2)] + ## tco + (return result + (t/make-function (fn [args] + (EVAL body + (e/make-env env params args))) + nil false + body params env))) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast)) + args (map |(EVAL $0 env) raw-args)] + (if-let [body (t/get-ast f)] ## tco + (do + (set ast body) + (set env (e/make-env (t/get-env f) (t/get-params f) args))) + (return result + ((t/get-value f) args))))))) + + # Neither a list, map, symbol or vector. + (return result ast))))) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e/env-set repl_env + (t/make-symbol "eval") + (t/make-function (fn [asts] + (EVAL (in asts 0) repl_env)))) + +(rep `` + (def! load-file + (fn* (fpath) + (eval + (read-string (str "(do " + (slurp fpath) "\n" + "nil)"))))) +``) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (let [args-len (length args) + argv (if (<= 2 args-len) + (drop 2 args) + ())] + (e/env-set repl_env + (t/make-symbol "*ARGV*") + (t/make-list (map t/make-string argv))) + (if (< 1 args-len) + (try + (rep + (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? + ([err] + (handle-error err))) + (do + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err))))))))) diff --git a/impls/janet/step7_quote.janet b/impls/janet/step7_quote.janet new file mode 100644 index 0000000000..a45b9b81ba --- /dev/null +++ b/impls/janet/step7_quote.janet @@ -0,0 +1,233 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) +(import ./core) + +(def repl_env + (let [env (e/make-env)] + (eachp [k v] core/ns + (e/env-set env k v)) + env)) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(var EVAL nil) + +(defn starts-with + [ast name] + (when (and (t/list?* ast) + (not (t/empty?* ast))) + (let [head-ast (in (t/get-value ast) 0)] + (and (t/symbol?* head-ast) + (= name (t/get-value head-ast)))))) + +(var quasiquote* nil) + +(defn qq-iter + [ast] + (if (t/empty?* ast) + (t/make-list ()) + (let [elt (in (t/get-value ast) 0) + acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] + (if (starts-with elt "splice-unquote") + (t/make-list [(t/make-symbol "concat") + (in (t/get-value elt) 1) + acc]) + (t/make-list [(t/make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(varfn quasiquote* + [ast] + (cond + (starts-with ast "unquote") + (in (t/get-value ast) 1) + ## + (t/list?* ast) + (qq-iter ast) + ## + (t/vector?* ast) + (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) + ## + (or (t/symbol?* ast) + (t/hash-map?* ast)) + (t/make-list [(t/make-symbol "quote") ast]) + ## + ast)) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (label result + (while true + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (if-let [value (e/env-get env ast)] + (return result value) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (return result + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast)))))) + + :vector + (return result + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast)))) + + :list + (if (t/empty?* ast) + (return result ast) + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + (return result def-val)) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + ## tco + (set ast (in (t/get-value ast) 2)) + (set env new-env)) + ## + "quote" + (return result (in (t/get-value ast) 1)) + ## + "quasiquote" + ## tco + (set ast (quasiquote* (in (t/get-value ast) 1))) + ## + "do" + (let [most-do-body-forms (slice (t/get-value ast) 1 -2) + last-body-form (last (t/get-value ast))] + (each x most-do-body-forms (EVAL x env)) + ## tco + (set ast last-body-form)) + ## + "if" + (let [cond-res (EVAL (in (t/get-value ast) 1) env)] + (if (or (t/nil?* cond-res) + (t/false?* cond-res)) + (if-let [else-ast (get (t/get-value ast) 3)] + ## tco + (set ast else-ast) + (return result t/mal-nil)) + ## tco + (set ast (in (t/get-value ast) 2)))) + ## + "fn*" + (let [params (t/get-value (in (t/get-value ast) 1)) + body (in (t/get-value ast) 2)] + ## tco + (return result + (t/make-function (fn [args] + (EVAL body + (e/make-env env params args))) + nil false + body params env))) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast)) + args (map |(EVAL $0 env) raw-args)] + (if-let [body (t/get-ast f)] ## tco + (do + (set ast body) + (set env (e/make-env (t/get-env f) (t/get-params f) args))) + (return result + ((t/get-value f) args))))))) + + # Neither a list, map, symbol or vector. + (return result ast))))) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e/env-set repl_env + (t/make-symbol "eval") + (t/make-function (fn [asts] + (EVAL (in asts 0) repl_env)))) + +(rep `` + (def! load-file + (fn* (fpath) + (eval + (read-string (str "(do " + (slurp fpath) "\n" + "nil)"))))) +``) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (let [args-len (length args) + argv (if (<= 2 args-len) + (drop 2 args) + ())] + (e/env-set repl_env + (t/make-symbol "*ARGV*") + (t/make-list (map t/make-string argv))) + (if (< 1 args-len) + (try + (rep + (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? + ([err] + (handle-error err))) + (do + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err))))))))) diff --git a/impls/janet/step8_macros.janet b/impls/janet/step8_macros.janet new file mode 100644 index 0000000000..d894a8195b --- /dev/null +++ b/impls/janet/step8_macros.janet @@ -0,0 +1,255 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) +(import ./core) + +(def repl_env + (let [env (e/make-env)] + (eachp [k v] core/ns + (e/env-set env k v)) + env)) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(var EVAL nil) + +(defn starts-with + [ast name] + (when (and (t/list?* ast) + (not (t/empty?* ast))) + (let [head-ast (in (t/get-value ast) 0)] + (and (t/symbol?* head-ast) + (= name (t/get-value head-ast)))))) + +(var quasiquote* nil) + +(defn qq-iter + [ast] + (if (t/empty?* ast) + (t/make-list ()) + (let [elt (in (t/get-value ast) 0) + acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] + (if (starts-with elt "splice-unquote") + (t/make-list [(t/make-symbol "concat") + (in (t/get-value elt) 1) + acc]) + (t/make-list [(t/make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(varfn quasiquote* + [ast] + (cond + (starts-with ast "unquote") + (in (t/get-value ast) 1) + ## + (t/list?* ast) + (qq-iter ast) + ## + (t/vector?* ast) + (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) + ## + (or (t/symbol?* ast) + (t/hash-map?* ast)) + (t/make-list [(t/make-symbol "quote") ast]) + ## + ast)) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (label result + (while true + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (if-let [value (e/env-get env ast)] + (return result value) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (return result + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast)))))) + + :vector + (return result + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast)))) + + :list + (if (t/empty?* ast) + (return result ast) + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + (return result def-val)) + ## + "defmacro!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env) + macro-ast (t/macrofy def-val)] + (e/env-set env + def-name macro-ast) + (return result macro-ast)) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + ## tco + (set ast (in (t/get-value ast) 2)) + (set env new-env)) + ## + "quote" + (return result (in (t/get-value ast) 1)) + ## + "quasiquote" + ## tco + (set ast (quasiquote* (in (t/get-value ast) 1))) + ## + "do" + (let [most-do-body-forms (slice (t/get-value ast) 1 -2) + last-body-form (last (t/get-value ast))] + (each x most-do-body-forms (EVAL x env)) + ## tco + (set ast last-body-form)) + ## + "if" + (let [cond-res (EVAL (in (t/get-value ast) 1) env)] + (if (or (t/nil?* cond-res) + (t/false?* cond-res)) + (if-let [else-ast (get (t/get-value ast) 3)] + ## tco + (set ast else-ast) + (return result t/mal-nil)) + ## tco + (set ast (in (t/get-value ast) 2)))) + ## + "fn*" + (let [params (t/get-value (in (t/get-value ast) 1)) + body (in (t/get-value ast) 2)] + ## tco + (return result + (t/make-function (fn [args] + (EVAL body + (e/make-env env params args))) + nil false + body params env))) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast))] + (if (t/macro?* f) + (set ast ((t/get-value f) raw-args)) + (let [args (map |(EVAL $0 env) raw-args)] + (if-let [body (t/get-ast f)] ## tco + (do + (set ast body) + (set env (e/make-env (t/get-env f) (t/get-params f) args))) + (return result + ((t/get-value f) args))))))))) + + # Neither a list, map, symbol or vector. + (return result ast))))) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e/env-set repl_env + (t/make-symbol "eval") + (t/make-function (fn [asts] + (EVAL (in asts 0) repl_env)))) + +(rep `` + (def! load-file + (fn* (fpath) + (eval + (read-string (str "(do " + (slurp fpath) "\n" + "nil)"))))) +``) + +(rep `` + (defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if + (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs))))))) +``) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (let [args-len (length args) + argv (if (<= 2 args-len) + (drop 2 args) + ())] + (e/env-set repl_env + (t/make-symbol "*ARGV*") + (t/make-list (map t/make-string argv))) + (if (< 1 args-len) + (try + (rep + (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? + ([err] + (handle-error err))) + (do + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err))))))))) diff --git a/impls/janet/step9_try.janet b/impls/janet/step9_try.janet new file mode 100644 index 0000000000..712a951441 --- /dev/null +++ b/impls/janet/step9_try.janet @@ -0,0 +1,279 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) +(import ./core) + +(def repl_env + (let [env (e/make-env)] + (eachp [k v] core/ns + (e/env-set env k v)) + env)) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(var EVAL nil) + +(defn starts-with + [ast name] + (when (and (t/list?* ast) + (not (t/empty?* ast))) + (let [head-ast (in (t/get-value ast) 0)] + (and (t/symbol?* head-ast) + (= name (t/get-value head-ast)))))) + +(var quasiquote* nil) + +(defn qq-iter + [ast] + (if (t/empty?* ast) + (t/make-list ()) + (let [elt (in (t/get-value ast) 0) + acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] + (if (starts-with elt "splice-unquote") + (t/make-list [(t/make-symbol "concat") + (in (t/get-value elt) 1) + acc]) + (t/make-list [(t/make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(varfn quasiquote* + [ast] + (cond + (starts-with ast "unquote") + (in (t/get-value ast) 1) + ## + (t/list?* ast) + (qq-iter ast) + ## + (t/vector?* ast) + (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) + ## + (or (t/symbol?* ast) + (t/hash-map?* ast)) + (t/make-list [(t/make-symbol "quote") ast]) + ## + ast)) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (label result + (while true + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (if-let [value (e/env-get env ast)] + (return result value) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (return result + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast)))))) + + :vector + (return result + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast)))) + + :list + (if (t/empty?* ast) + (return result ast) + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + (return result def-val)) + ## + "defmacro!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env) + macro-ast (t/macrofy def-val)] + (e/env-set env + def-name macro-ast) + (return result macro-ast)) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + ## tco + (set ast (in (t/get-value ast) 2)) + (set env new-env)) + ## + "quote" + (return result (in (t/get-value ast) 1)) + ## + "quasiquote" + ## tco + (set ast (quasiquote* (in (t/get-value ast) 1))) + ## + "try*" + (let [res + (try + (EVAL (in (t/get-value ast) 1) env) + ([err] + (if-let [maybe-catch-ast (get (t/get-value ast) 2)] + (if (starts-with maybe-catch-ast "catch*") + (let [catch-asts (t/get-value maybe-catch-ast)] + (if (>= (length catch-asts) 2) + (let [catch-sym-ast (in catch-asts 1) + catch-body-ast (in catch-asts 2)] + (EVAL catch-body-ast (e/make-env env + [catch-sym-ast] + [err]))) + (u/throw* + (t/make-string + "catch* requires at least 2 arguments")))) + (u/throw* + (t/make-string + "Expected catch* form"))) + # XXX: is this appropriate? show error message? + (u/throw* err))))] + (return result res)) + ## + "do" + (let [most-do-body-forms (slice (t/get-value ast) 1 -2) + last-body-form (last (t/get-value ast))] + (each x most-do-body-forms (EVAL x env)) + ## tco + (set ast last-body-form)) + ## + "if" + (let [cond-res (EVAL (in (t/get-value ast) 1) env)] + (if (or (t/nil?* cond-res) + (t/false?* cond-res)) + (if-let [else-ast (get (t/get-value ast) 3)] + ## tco + (set ast else-ast) + (return result t/mal-nil)) + ## tco + (set ast (in (t/get-value ast) 2)))) + ## + "fn*" + (let [params (t/get-value (in (t/get-value ast) 1)) + body (in (t/get-value ast) 2)] + ## tco + (return result + (t/make-function (fn [args] + (EVAL body + (e/make-env env params args))) + nil false + body params env))) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast))] + (if (t/macro?* f) + (set ast ((t/get-value f) raw-args)) + (let [args (map |(EVAL $0 env) raw-args)] + (if-let [body (t/get-ast f)] ## tco + (do + (set ast body) + (set env (e/make-env (t/get-env f) (t/get-params f) args))) + (return result + ((t/get-value f) args))))))))) + + # Neither a list, map, symbol or vector. + (return result ast))))) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e/env-set repl_env + (t/make-symbol "eval") + (t/make-function (fn [asts] + (EVAL (in asts 0) repl_env)))) + +(rep `` + (def! load-file + (fn* (fpath) + (eval + (read-string (str "(do " + (slurp fpath) "\n" + "nil)"))))) +``) + +(rep `` + (defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if + (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs))))))) +``) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (let [args-len (length args) + argv (if (<= 2 args-len) + (drop 2 args) + ())] + (e/env-set repl_env + (t/make-symbol "*ARGV*") + (t/make-list (map t/make-string argv))) + (if (< 1 args-len) + (try + (rep + (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? + ([err] + (handle-error err))) + (do + (var buf nil) + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err))))))))) diff --git a/impls/janet/stepA_mal.janet b/impls/janet/stepA_mal.janet new file mode 100644 index 0000000000..d5a3a87e9c --- /dev/null +++ b/impls/janet/stepA_mal.janet @@ -0,0 +1,284 @@ +(import ./reader) +(import ./printer) +(import ./types :as t) +(import ./utils :as u) +(import ./env :as e) +(import ./core) + +(def repl_env + (let [env (e/make-env)] + (eachp [k v] core/ns + (e/env-set env k v)) + env)) + +(defn READ + [code-str] + (reader/read_str code-str)) + +(var EVAL nil) + +(defn starts-with + [ast name] + (when (and (t/list?* ast) + (not (t/empty?* ast))) + (let [head-ast (in (t/get-value ast) 0)] + (and (t/symbol?* head-ast) + (= name (t/get-value head-ast)))))) + +(var quasiquote* nil) + +(defn qq-iter + [ast] + (if (t/empty?* ast) + (t/make-list ()) + (let [elt (in (t/get-value ast) 0) + acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] + (if (starts-with elt "splice-unquote") + (t/make-list [(t/make-symbol "concat") + (in (t/get-value elt) 1) + acc]) + (t/make-list [(t/make-symbol "cons") + (quasiquote* elt) + acc]))))) + +(varfn quasiquote* + [ast] + (cond + (starts-with ast "unquote") + (in (t/get-value ast) 1) + ## + (t/list?* ast) + (qq-iter ast) + ## + (t/vector?* ast) + (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) + ## + (or (t/symbol?* ast) + (t/hash-map?* ast)) + (t/make-list [(t/make-symbol "quote") ast]) + ## + ast)) + +(var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) + +(varfn EVAL + [ast-param env-param] + (var ast ast-param) + (var env env-param) + (label result + (while true + + (if-let [dbgeval (e/env-get env DEBUG-EVAL)] + (if (not (or (t/nil?* dbgeval) + (t/false?* dbgeval))) + (print (string "EVAL: " (printer/pr_str ast true))))) + + (case (t/get-type ast) + + :symbol + (if-let [value (e/env-get env ast)] + (return result value) + (u/throw* + (t/make-string + (string "'" (t/get-value ast) "'" " not found" )))) + + :hash-map + (return result + (t/make-hash-map (struct ;(map |(EVAL $0 env) + (kvs (t/get-value ast)))))) + + :vector + (return result + (t/make-vector (map |(EVAL $0 env) + (t/get-value ast)))) + + :list + (if (t/empty?* ast) + (return result ast) + (let [ast-head (in (t/get-value ast) 0) + head-name (t/get-value ast-head)] + (case head-name + "def!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env)] + (e/env-set env + def-name def-val) + (return result def-val)) + ## + "defmacro!" + (let [def-name (in (t/get-value ast) 1) + def-val (EVAL (in (t/get-value ast) 2) env) + macro-ast (t/macrofy def-val)] + (e/env-set env + def-name macro-ast) + (return result macro-ast)) + ## + "let*" + (let [new-env (e/make-env env) + bindings (t/get-value (in (t/get-value ast) 1))] + (each [let-name let-val] (partition 2 bindings) + (e/env-set new-env + let-name (EVAL let-val new-env))) + ## tco + (set ast (in (t/get-value ast) 2)) + (set env new-env)) + ## + "quote" + (return result (in (t/get-value ast) 1)) + ## + "quasiquote" + ## tco + (set ast (quasiquote* (in (t/get-value ast) 1))) + ## + "try*" + (let [res + (try + (EVAL (in (t/get-value ast) 1) env) + ([err] + (if-let [maybe-catch-ast (get (t/get-value ast) 2)] + (if (starts-with maybe-catch-ast "catch*") + (let [catch-asts (t/get-value maybe-catch-ast)] + (if (>= (length catch-asts) 2) + (let [catch-sym-ast (in catch-asts 1) + catch-body-ast (in catch-asts 2)] + (EVAL catch-body-ast (e/make-env env + [catch-sym-ast] + [err]))) + (u/throw* + (t/make-string + "catch* requires at least 2 arguments")))) + (u/throw* + (t/make-string + "Expected catch* form"))) + # XXX: is this appropriate? show error message? + (u/throw* err))))] + (return result res)) + ## + "do" + (let [most-do-body-forms (slice (t/get-value ast) 1 -2) + last-body-form (last (t/get-value ast))] + (each x most-do-body-forms (EVAL x env)) + ## tco + (set ast last-body-form)) + ## + "if" + (let [cond-res (EVAL (in (t/get-value ast) 1) env)] + (if (or (t/nil?* cond-res) + (t/false?* cond-res)) + (if-let [else-ast (get (t/get-value ast) 3)] + ## tco + (set ast else-ast) + (return result t/mal-nil)) + ## tco + (set ast (in (t/get-value ast) 2)))) + ## + "fn*" + (let [params (t/get-value (in (t/get-value ast) 1)) + body (in (t/get-value ast) 2)] + ## tco + (return result + (t/make-function (fn [args] + (EVAL body + (e/make-env env params args))) + nil false + body params env))) + ## + (let [f (EVAL ast-head env) + raw-args (drop 1 (t/get-value ast))] + (if (t/macro?* f) + (set ast ((t/get-value f) raw-args)) + (let [args (map |(EVAL $0 env) raw-args)] + (if-let [body (t/get-ast f)] ## tco + (do + (set ast body) + (set env (e/make-env (t/get-env f) (t/get-params f) args))) + (return result + ((t/get-value f) args))))))))) + + # Neither a list, map, symbol or vector. + (return result ast))))) + +(defn PRINT + [ast] + (printer/pr_str ast true)) + +(defn rep + [code-str] + (PRINT (EVAL (READ code-str) repl_env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(e/env-set repl_env + (t/make-symbol "eval") + (t/make-function (fn [asts] + (EVAL (in asts 0) repl_env)))) + +(rep `` + (def! load-file + (fn* (fpath) + (eval + (read-string (str "(do " + (slurp fpath) "\n" + "nil)"))))) +``) + +(rep `` + (defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list 'if + (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs))))))) +``) + +(e/env-set repl_env + (t/make-symbol "*host-language*") + (t/make-string "janet")) + +# getline gives problems +(defn getstdin [prompt buf] + (file/write stdout prompt) + (file/flush stdout) + (file/read stdin :line buf)) + +(defn handle-error + [err] + (cond + (t/nil?* err) + (print) + ## + (string? err) + (print err) + ## + (print (string "Error: " (PRINT err))))) + +(defn main + [& args] + (let [args-len (length args) + argv (if (<= 2 args-len) + (drop 2 args) + ())] + (e/env-set repl_env + (t/make-symbol "*ARGV*") + (t/make-list (map t/make-string argv))) + (if (< 1 args-len) + (try + (rep + (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? + ([err] + (handle-error err))) + (do + (var buf nil) + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (while true + (set buf @"") + (getstdin "user> " buf) + (if (= 0 (length buf)) + (break) + (try + (print (rep buf)) + ([err] + (handle-error err))))))))) diff --git a/impls/janet/tests/stepA_mal.mal b/impls/janet/tests/stepA_mal.mal new file mode 100644 index 0000000000..2b6ba61721 --- /dev/null +++ b/impls/janet/tests/stepA_mal.mal @@ -0,0 +1,42 @@ +;; Testing basic Janet interop + +(janet-eval "7") +;=>7 + +(janet-eval "\"7\"") +;=>"7" + +(janet-eval "nil") +;=>nil + +(janet-eval "(= 123 123)") +;=>true + +(janet-eval "(= 123 456)") +;=>false + +(janet-eval ":my-keyword") +;=>:my-keyword + +(janet-eval "'(7 8 9)") +;=>(7 8 9) + +(janet-eval "{:abc 789}") +;=>{:abc 789} + +(janet-eval "(print \"hello\")") +;/hello +;=>nil + +(janet-eval "(defn foo [] 8)") +(janet-eval "(foo)") +;=>8 + +(janet-eval "(let [tup [:a 1 :b 2]] (struct ;tup))") +;=>{:a 1 :b 2} + +(janet-eval "(do (def tbl @{}) (put tbl :x 8) tbl)") +;=>{:x 8} + +(janet-eval "(do (var mut 1) (set mut 2) mut)") +;=>2 diff --git a/impls/janet/types.janet b/impls/janet/types.janet new file mode 100644 index 0000000000..1931dcf6e1 --- /dev/null +++ b/impls/janet/types.janet @@ -0,0 +1,245 @@ +(defn make-nil + [] + {:tag :nil + :content "nil"}) + +(defn make-boolean + [bool] + {:tag :boolean + :content (string bool)}) + +(defn make-keyword + [a-str] + {:tag :keyword + :content a-str}) + +(defn make-number + [a-num] + {:tag :number + :content a-num}) + +(defn make-string + [a-str] + {:tag :string + :content a-str}) + +(defn make-symbol + [a-str] + {:tag :symbol + :content a-str}) + +(defn make-hash-map + [items &opt meta] + (default meta (make-nil)) + (let [a-struct (if (dictionary? items) + items + (struct ;items))] + {:tag :hash-map + :content a-struct + :meta meta})) + +(defn make-list + [items &opt meta] + (default meta (make-nil)) + {:tag :list + :content items + :meta meta}) + +(defn make-vector + [items &opt meta] + (default meta (make-nil)) + {:tag :vector + :content items + :meta meta}) + +(defn make-function + [a-fn &opt meta is-macro ast params env] + (default meta (make-nil)) + (default is-macro false) + {:tag :function + :content a-fn + :meta meta + :is-macro is-macro + :ast ast + :params params + :env env}) + +(defn make-atom + [ast] + @{:tag :atom + :content ast}) + +(defn set-atom-value! + [atom-ast value-ast] + (put atom-ast + :content value-ast)) + +(defn make-exception + [ast] + {:tag :exception + :content ast}) + +## common accessors + +(defn get-value + [ast] + (ast :content)) + +(defn get-type + [ast] + (ast :tag)) + +(defn get-meta + [ast] + (ast :meta)) + +## function-specific accessors + +(defn get-is-macro + [ast] + (ast :is-macro)) + +(defn get-ast + [ast] + (ast :ast)) + +(defn get-params + [ast] + (ast :params)) + +(defn get-env + [ast] + (ast :env)) + +## function-specific functions + +(defn macrofy + [fn-ast] + (merge fn-ast {:is-macro true})) + +(defn clone-with-meta + [fn-ast meta-ast] + (merge fn-ast {:meta meta-ast})) + +## predicates + +(defn nil?* + [ast] + (= :nil (get-type ast))) + +(defn boolean?* + [ast] + (= :boolean (get-type ast))) + +(defn true?* + [ast] + (and (boolean?* ast) + (= "true" (get-value ast)))) + +(defn false?* + [ast] + (and (boolean?* ast) + (= "false" (get-value ast)))) + +(defn number?* + [ast] + (= :number (get-type ast))) + +(defn symbol?* + [ast] + (= :symbol (get-type ast))) + +(defn keyword?* + [ast] + (= :keyword (get-type ast))) + +(defn string?* + [ast] + (= :string (get-type ast))) + +(defn list?* + [ast] + (= :list (get-type ast))) + +(defn vector?* + [ast] + (= :vector (get-type ast))) + +(defn hash-map?* + [ast] + (= :hash-map (get-type ast))) + +(defn fn?* + [ast] + (= :function (get-type ast))) + +(defn macro?* + [ast] + (and (fn?* ast) + (get-is-macro ast))) + +(defn atom?* + [ast] + (= :atom (get-type ast))) + +(defn exception?* + [ast] + (= :exception (get-type ast))) + +(defn empty?* + [ast] + (empty? (get-value ast))) + +# XXX: likely this could be simpler +(defn equals?* + [ast-1 ast-2] + (let [type-1 (get-type ast-1) + type-2 (get-type ast-2)] + (if (and (not= type-1 type-2) + # XXX: not elegant + (not (and (list?* ast-1) (vector?* ast-2))) + (not (and (list?* ast-2) (vector?* ast-1)))) + false + (let [val-1 (get-value ast-1) + val-2 (get-value ast-2)] + # XXX: when not a collection... + (if (and (not (list?* ast-1)) + (not (vector?* ast-1)) + (not (hash-map?* ast-1))) + (= val-1 val-2) + (if (not= (length val-1) (length val-2)) + false + (if (and (not (hash-map?* ast-1)) + (not (hash-map?* ast-2))) + (do + (var found-unequal false) + (each [v1 v2] (partition 2 (interleave val-1 val-2)) + (when (not (equals?* v1 v2)) + (set found-unequal true) + (break))) + (not found-unequal)) + (if (or (not (hash-map?* ast-1)) + (not (hash-map?* ast-2))) + false + (do + (var found-unequal false) + (each [k1 k2] (partition 2 (interleave (keys val-1) + (keys val-2))) + (when (not (equals?* k1 k2)) + (set found-unequal true) + (break)) + (when (not (equals?* (val-1 k1) (val-2 k2))) + (set found-unequal true) + (break))) + (not found-unequal)))))))))) + +## highlander types + +(def mal-nil + (make-nil)) + +(def mal-true + (make-boolean true)) + +(def mal-false + (make-boolean false)) diff --git a/impls/janet/utils.janet b/impls/janet/utils.janet new file mode 100644 index 0000000000..2fe6b6d156 --- /dev/null +++ b/impls/janet/utils.janet @@ -0,0 +1,3 @@ +(defn throw* + [ast] + (error ast)) diff --git a/impls/java-truffle/.gitignore b/impls/java-truffle/.gitignore new file mode 100644 index 0000000000..e797f2e42f --- /dev/null +++ b/impls/java-truffle/.gitignore @@ -0,0 +1,10 @@ +.classpath +.project +.settings +target +/.gradle/ +/build/ +.factorypath +.apt_generated +bin +graal_dumps diff --git a/impls/java-truffle/Dockerfile b/impls/java-truffle/Dockerfile new file mode 100644 index 0000000000..515fdf36d5 --- /dev/null +++ b/impls/java-truffle/Dockerfile @@ -0,0 +1,12 @@ +FROM ghcr.io/graalvm/graalvm-ce:21.1.0 + +RUN microdnf install python3 unzip && \ + ln -sf /usr/bin/python3 /usr/bin/python && \ + curl -o gradle.zip "https://downloads.gradle-dn.com/distributions/gradle-7.0.2-bin.zip" && \ + mkdir /opt/gradle && \ + unzip -d /opt/gradle gradle.zip + +RUN mkdir -p /mal +WORKDIR /mal +ENV GRADLE_USER_HOME=/tmp/.gradle +ENV PATH="$PATH:/opt/gradle/gradle-7.0.2/bin" diff --git a/impls/java-truffle/Makefile b/impls/java-truffle/Makefile new file mode 100644 index 0000000000..4ce458d18d --- /dev/null +++ b/impls/java-truffle/Makefile @@ -0,0 +1,8 @@ +all: + gradle build + +build/classes/java/main/truffle/mal/step%.class: src/main/java/truffle/mal/*.java + gradle build + +clean: + gradle clean diff --git a/impls/java-truffle/README.md b/impls/java-truffle/README.md new file mode 100644 index 0000000000..932b742207 --- /dev/null +++ b/impls/java-truffle/README.md @@ -0,0 +1,699 @@ +# Truffle Mal + +This Mal is implemented in Java using the [Truffle Framework](https://github.com/oracle/graal/blob/master/truffle/README.md). +Truffle is a library for implementing interpreters. When +these interpreters are run on GraalVM, the GraalVM compiler +is able to JIT compile interpreted programs using a technique +called [partial evaluation](https://en.wikipedia.org/wiki/Partial_evaluation). + +Partially evaluating an interpreter plus a program to produce compiled +code requires a careful balance. If every last bit of interpreter code +(including supporting libraries, etc.) +is subject to partial evaluation, the result will explode to +unreasonable size. Boundaries must be drawn. Exclude too much, though, +and the speed up resulting from compilation may not be worth the +effort of the compilation. + +Truffle's "thesis" is that a small set of primitives are sufficient to make +JIT compilation via partial evaluation practical. +These primitives feed runtime data collected by the executing interpreter +to the compiler, allowing it to _specialize_, or optimistically +simplify, the interpreter code at compilation time. The compiler inserts +lightweight runtime checks of the assumptions that justify its +simplifications. If the checks fail, the compiled code is _de-optimized_, +and control is returned to the interpreter. +See [Practical Partial Evaluation for High-Performance Dynamic Language Runtimes](http://chrisseaton.com/rubytruffle/pldi17-truffle/pldi17-truffle.pdf), from PLDI 2017, for a deeper treatment of the ideas behind Truffle. + +The Truffle Mal implementation is my attempt at putting the Truffle thesis +to the test. + +Can I, an engineer without a background in compiler design, use Truffle to +implement an interpreter for a dynamic language (Mal) that substantially +outperforms the existing Java interpreter for Mal? + +*The Short Answer: Yup.* + +```bash + # Recursive Fibonacci on OpenJDK 11 with java mal + $ ./run ../tests/fib.mal 30 10 + Times (in ms) for (fib 30) on java: [2062 1809 1814 1777 1772 1791 1725 1723 1786 1745] + + # Recursive Fibonacci on GraalVM with java-truffle mal + $ ./run ../tests/fib.mal 30 10 + Times (in ms) for (fib 30) on java-truffle: [280 142 21 26 22 75 21 26 21 24] + + # That's an 82x speed-up! Just out of curiosity... + # How does Clojure on OpenJDK 11? We'll even throw in a type hint. + $ lein repl + Clojure 1.10.0 + OpenJDK 64-Bit Server VM 11.0.7+10-post-Ubuntu-2ubuntu218.04 + user=> (defn fib [^long n] (if (= n 0) 1 (if (= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))) + #'user/fib + user=> (dotimes [i 5] (time (fib 30))) + "Elapsed time: 32.0791 msecs" + "Elapsed time: 31.7552 msecs" + "Elapsed time: 31.5361 msecs" + "Elapsed time: 31.4796 msecs" + "Elapsed time: 31.4541 msecs" +``` + +A recursive Fibonacci computation is _obviously_ not sufficient to characterize the +performance of our implementation (and as we'll see, it turns out to be +something of a best-case scenario), but it sure looks impressive! + +Do more complicated Mal programs show similar speed-ups? + +How much simplicity did we have to sacrifice in the name of performance? + +Was it worth it? + +How much of the speed-up is really attributable to the Truffle/GraalVM combo, +and how much came from putting more time into the code itself? + +We'll explore the answers to these questions together in the remainder! + +## Disclaimers + +*First and foremost*: To the extend that this experiment _succeeds_ in its goal of +producing an efficient Mal implementation, the credit is due to the teams +behind Truffle and GraalVM. To the extend that this experiment _fails_, the blame +falls on *me*! The reader should assume, by default, that any deficiencies in +this Mal implementation are due to my own failure to understand or +properly apply the tools at my disposal, and _not_ due to any fundamental +limitations of Truffle or GraalVM. + +*Second:* This Mal implementation is _not_ idiomatic Java, and it's _not_ an +idiomatic application of Truffle. The project's +unusual organization (large numbers of package-private classes bundled +into single files like Types.java, substantial duplication between step files) +represent my attempt to adhere both to the spirit of Mal's +pedagogical approach and the organization of the existing Java implementation. +Consequently I have abused Truffle in several ways (that I am aware of, and perhaps +others that I am not?). Each Mal step +registers a distinct Truffle implementation whose language id has the form "mal_step${n}". +The languages for each step have distinct AST node sub-classes, but they share +the built-in AST nodes in Core.java and the runtime types in Types.java. This sharing +creates some awkwardness in Core.java. + +## Prerequisites + +[GraalVM Community Edition](https://www.graalvm.org/downloads/) (version 20.1.0 or higher) +should be on your PATH and pointed to by JAVA_HOME. + +You'll also need to [install Gradle](https://gradle.org/install/) +if you're going to build without using the provided Docker image. + +## Outline of Approach + +For step 0 through step A, I've purposefully avoided Truffle-specific optimizations. +Step A is intended to be a fully naive application of Truffle, where +a 'pure' interpreter is developed using Truffle AST nodes, but without any attempt +to leverage Truffle primitives to specialize compiled code. + +By comparing Truffle step A on OpenJDK to the existing Java step A, we can get a sense of the +overhead imposed by the Truffle framework on interpreter performance. + +By comparing Truffle step A on OpenJDK to Truffle step A on GraalVM, we can get a sense of how +much performance the GraalVM compiler can give the language implementor "for free". + +Each step _after_ A employs Truffle primitives to enable specialization +of code during compilation. + +* Step B specializes function calls by assuming that the same function will + always be called (i.e. that call sites are _monomorphic_), until proven otherwise. + At call sites where the same function _actually is_ always called, the compiler + can eliminate some code and perform inlining. + +* Step C optimizes and specializes environment lookups, allowing + us to avoid HashMap-related overhead for lookups of symbols that are statically in + scope (i.e. function arguments and let bindings) under the assumption that some + def! doesn't dynamically bind the looked-up symbols at runtime in scopes where they + aren't declared. + +* Step D enables _further_ specialization of environment lookups for closed-over + environments, allowing us to skip the lookups entirely under the assumption that + the symbols have not been rebound. + +* Step E specializes macro expansion, allowing the results of a macro expansion to + _replace_ the apply form entirely. We have to 'cheat' in this step, and extend Mal's + macro semantics (in a backward-compatible way!). The results are worth it! + +## Performance Evaluation Method + +Truffle Mal performance is evaluated relative to Java Mal on several benchmarks. +For each benchmark, we run Java Mal and Truffle Mal on both OpenJDK and GraalVM. + +```bash + # OpenJDK + $ java -version + openjdk version "11.0.7" 2020-04-14 + OpenJDK Runtime Environment (build 11.0.7+10-post-Ubuntu-2ubuntu218.04) + OpenJDK 64-Bit Server VM (build 11.0.7+10-post-Ubuntu-2ubuntu218.04, mixed mode, sharing) + + # GraalVM + $ java -version + openjdk version "11.0.7" 2020-04-14 + OpenJDK Runtime Environment GraalVM CE 20.1.0 (build 11.0.7+10-jvmci-20.1-b02) + OpenJDK 64-Bit Server VM GraalVM CE 20.1.0 (build 11.0.7+10-jvmci-20.1-b02, mixed mode, sharing) +``` + +It must be said that Truffle Mal leverage Clojure's implementations of persistent +vectors and maps. This likely has little to no impact on the perf4 and fib benchmarks, +which don't operate on vectors or maps. Self-hosted Mal, however, depends on +the host Mal's map implementation for its environments. Since Java Mal's maps +are built on java.util.HashMap and don't take advantage of structural sharing, +we expect the complexity of Java Mal's assoc and dissoc functions to be strictly +worse than Truffle Mal's ( O(n) versus O(lg(n)) ). Whether or not this actually +tips things in favor of Truffle Mal isn't clear; the sizes of the environments +in question are quite small. I have not made any attempt to account for this +in the results. + +### Fib + +This simple benchmark focuses on symbol lookups, arithmetic, and function application. +We use the naive recursive approach to computing the 30th Fibonacci number. We run +the computation 10 times, and select the fastest result. + +### Busywork + +The busywork.mal benchmark is a refactoring of the perf3.mal benchmark, +which primarily tests macro and atom performance. + +We measure how long it takes to execute 10,000 iterations of a 'busywork' function. +As with fib.mal, this is done 10 times and we use the fastest result. + +### Fib on Mal + +For a more interesting test, we run the `fib.mal` benchmark using self-hosted +Mal. This gives each implementation a more comprehensive workout. We compute +the 15th Fibonacci number 10 times, and take the fastest execution time. + +Note that self-hosted Mal does not support tail call optimization, and so consumes more +stack the longer it runs. For Truffle Mal, we need to increase the stack size from the +default of 1MB to 8MB to avoid stack overflow. + +## Results + +Truffle performance is given in absolute terms, and relative to the faster of the +Java implementation's OpenJDK and GraalVM runs for the same benchmark. + +### Step A: No Optimizations + +Step A represents a naive Mal interpreter written using Truffle AST nodes, but with +no special effort made to leverage Truffle primitives to assist the GraalVM compiler. + +| Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | +| ---------- | -------------- | ----------------- | ----------------- | +| Fib | 1700 ms | 1293 ms (1.3x) | 675 ms (2.5x) | +| Busywork | 781 ms | 914 ms | 888 ms | +| Fib on Mal | 686 ms | 2101 ms | 1664 ms | + +On the Fib benchmark, the Java and Truffle implementations of Mal are in the same +ball park on OpenJDK, with Truffle being 1.3x faster. However, when we run the +Truffle implementation on GraalVM, we see nearly a 2x speed-up over OpenJDK effectively +for free, putting it at 2.5x faster than plain old Java. + +The Busywork benchmark is a different story, with the Truffle implementation _slightly_ +slower on both OpenJDK and GraalVM, and with GraalVM providing very little extra performance. + +Fib on Mal is stranger yet: the Truffle implementation is 3x _slower_ on OpenJDK, and GraalVM +doesn't offer much help. What's going on?! + +A bit of profiling quickly yields the answer: Macros. + +From `truffle.mal.stepA_mal$ApplyNode`: + +```java + if (fn.isMacro) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var result = applyMacro(env, fn); + var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); + var target = Truffle.getRuntime().createCallTarget(newRoot); + return invokeNode.invoke(target, new Object[] {}, false); + } else { +``` + +A Truffle `CallTarget` represents an AST that can be called from other code. Call Target construction +is a heavy-weight operation that traverses the entire AST to do various initialization things. +The cost of this is _supposed_ to be amortized over the many calls to the code, and offset by the +gains we see for code that is called often enough to be JIT compiled. Truffle ASTs support self-modification. +Ideally, we'd expand a macro once, and then replace the macro application node with the result. + +Mal's macro semantics, alas, prevent us from doing so. +A Mal macro can choose to expand code one way or another based on the current value of any in-scope +environment, or even user input. Even worse, Mal's incremental macro expansion behavior is such that it +is allowable to write 'tail-recursive' macros that would, if eagerly expanded, take up space +exponential in their inputs. Consider a sumdown macro: + +``` + (defmacro! sumdown-via-macro* (fn* [acc n] + `(if (<= ~n 0) + ~acc + (sumdown-via-macro* ~(+ acc n) ~(- n 1))))) + + (defmacro! sumdown-via-macro2 (fn* [n] + `(sumdown-via-macro* 0 ~(eval n)))) +``` + +This executes without issue in any conforming Mal implementation! + +We'll return to macros in Step E, but before we do, we'll see what we can specialize +within the confines of Mal's semantics. + +### Step B: Specializing Function Calls + +In Step A, all function call sites are represented in the AST using Truffle's +`IndirectCallNode`. Truffle also provides a `DirectCallNode` for use at call sites +where the same function is always called. Direct function calls may be inlined by +the GraalVM compiler. + +Mal's semantics make it difficult (and sometimes impossible?) to prove statically +that the same function will always be called at a given call site. However, it's +trivial for our interpreter to _assume_ that a call site is direct up until we +learn that it isn't. If we use Truffle properly, we can express this assumption +in a way that the GraalVM compiler understands. + +Here's what the Steb B version of `InvokeNode` looks like: + +```java + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedTarget; + @CompilationFinal private CallTarget cachedTarget; + @CompilationFinal @Child private DirectCallNode directCallNode; + @CompilationFinal @Child private IndirectCallNode indirectCallNode; + + /* SNIP */ + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + usingCachedTarget = true; + cachedTarget = target; + directCallNode = Truffle.getRuntime().createDirectCallNode(target); + } + while (true) { + try { + if (usingCachedTarget) { + if (cachedTarget == target) { + return directCallNode.call(args); + } + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedTarget = false; + indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); + } + return indirectCallNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } +``` + +It _looks_ like it should be slower now, with all the branching. What have we done? + +Notice that all the new member variables have been annotated with `@CompilationFinal`. +This tells the compiler to treat these variables as if they were `final`, because their values +will not change in compiled code. + +We _ensure_ that they do not change in compiled code +by inserting the `CompilerDirectives.transferToInterpreterAndInvalidate()` intrinsic. +In interpreted code, this is a no-op. In _compiled_ code, it is replaced with an instruction +that causes the compiler to _de-optimize_ the compiled code and return to the interpreter +to continue execution. + +Suppose a function containing a call site that is not in tail position has been executed +enough times to trigger compilation, +and each time the invoked function has been the same. When compilation kicks in, the +variables `initialized` and `usingCachedTarget` would be true, and `tailPosition` would +be false. +Accordingly, the invoke code simplifies to: + +```java + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + while (true) { + try { + if (cachedTarget == target) { + return directCallNode.call(args); + } + CompilerDirectives.transferToInterpreterAndInvalidate(); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } +``` + +Much better! + +Because we're using a `DirectCallNode`, the compiler might decide to inline the called +function as well. Function inlining allows the partial evaluation algorithm to extend +across function boundaries. + +Let's see if there's an improvement in practice... + +| Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | +| ---------- | -------------- | ----------------- | ----------------- | +| Fib | 1700 ms | 991 ms (1.7x) | 430 ms (3.9x) | +| Busywork | 781 ms | 671 ms (1.2x) | 409 ms (1.9x) | +| Fib on Mal | 686 ms | 1912 ms (0.35x) | 1407 ms (0.48x) | + +We see modest improvements over Step A in all cases, with the Busywork benchmark +having a 2x improvement over Step A on GraalVM. + +### Step C: Static Symbol Lookup + +A little profiling shows that quite a lot of the 'work' that goes into executing a Mal +program is just environment maintenance: constructing HashMaps, putting symbol/value pairs +into them, and looking them back up again. For code that does a lot of function calling +(like our Fib benchmark), this adds up to a lot of overhead. + +Why do we need the HashMaps at all? Why can't we build environments around Object arrays? +During construction of an AST from a Mal form, we can keep track of the variables in +each lexical scope, and assign each one a _slot_ (an index in the Object array for the +environment associated with that scope). During execution, we can construct +environments out of Object arrays, and get/set values using these slots. No more +HashMaps! Right? + +The trouble, of course, is that `def!` can mutate environments at runtime, adding +bindings for symbols that were never 'declared' via `let*` or `fn*`. Consider this +function: + +``` + (def! f (fn* [x b] (do (who-knows? b) y))) +``` + +The symbol `y` isn't lexically in scope, so we wouldn't assign +it a slot; we'd have to try to look it up in the global environment +at execution time. But what if, at execution time, `who-knows?` turns out +to resolve to a _macro_ like: + +``` + (fn* [b] (if b `(def! y 42))) +``` + +If `b` is truthy, the `y` symbol ends up bound in the function body's environment after all, +but there's no slot for it in the environment's object array. Drat! + +But the power of Truffle is that we don't _need_ to statically prove that our slot +assignments and usage are valid. We're not writing a compiler! Instead, we can just +_assume_ that the slot assignments we make are valid, right up until we find that they +aren't. Then we can fall back on a less efficient but more general approach. + +I won't elaborate much on the details of the code too much in step, it involves the most significant changes. +At a high level, here's what we do: + +* Introduce a `LexicalScope` class that assigns symbols to array indices, and + thread `LexicalScope` objects through our AST construction methods. +* Extend `MalEnv` with a `staticBindings` Object array _in addition to_ the normal + `bindings` HashMap. The Object array is constructed based on the number of symbols in + the associated `LexicalScope`. The `bindings` HashMap is only constructed _lazily_, + if a symbol that isn't in a `LexicalScope` is bound via a `def!`. +* Further extend `MalEnv` with slot-based `get` and `set` methods, in addition to the + existing symbol-based `get` and `set` methods. +* Extend the AST nodes for `let*` and `fn*` to introduce new `LexicalScope` objects + with the right symbols, assign slots to those symbols, + and use the slot-based `get` and `set` methods on `MalEnv` to bind symbols. +* Modify the AST node for symbol lookups to speculatively use slot-based lookups + when the symbol in question is in a lexical scope _under the assumption that it has + not been re-defined via `def!`. + +That last bit is the key to the whole thing: We use Truffle's `Assumption` abstraction +to tell the compiler about the assumption that our slot-based symbol look-ups depend on. +When a `LexicalScope` assigns a slot, it creates an `Assumption` that the symbol +has not been bound by `def!` in that or any outer `LexicalScope`. The slot-based +symbol lookup code is guarded by that assumption. The 'dynamic' `set` method of `MalEnv` +(the one used by `def!`) is modified to _invalidate_ that assumption, triggering +de-optimization of any symbol lookups that might have been rendered incorrect. + +After slot assignment, where do we stand? + +| Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | +| ---------- | -------------- | ----------------- | ----------------- | +| Fib | 1700 ms | 829 ms (2.1x) | 219 ms (7.8x) | +| Busywork | 781 ms | 686 ms (1.1x) | 394 ms (2.0x) | +| Fib on Mal | 686 ms | 1932 ms (0.35x) | 1507 ms (0.46x) | + +This optimization starts to show off the real power of the Truffle framework on GraalVM, +at least for the Fib benchmark. +On the JDK, we see a modest improvement (1.2x) over Step B that comes from eliminating +some of the HashMap overhead. Given the complexity that we had to introduce, +this isn't very satisfying, On GraalVM, though, we see a better than 2x speed-up, taking +us to almost 8x faster than the Java interpreter. + +However, the other two benchmarks show no meaningful improvement at all. Fib on Mal +even seems to have become slower! Once again, we're bit by macros here. Recall that +since we currently create a new AST each and every time we +encounter a macro, the compiler never has a chance to compile it. We pay all the overhead +of our extra book-keeping, and get absolutely no benefit. + +### Step D: Caching Symbol Lookups + +We can take the symbol lookup improvements much further, now that we've laid the groundwork! + +Symbol lookups for symbols that are declared in some lexical scope will now use the fast-path Object array +lookups instead of the HashMap lookups, and Truffle _should_ even be able to unroll the loops +that walk up the chain of environments for us. For local symbol lookups, we probably won't do +much better. + +But what about symbols in a function body that _aren't_ lexically in scope? In a well-behaved +Mal program that isn't doing anything fancy with `def!`, these symbols will either produce +runtime environments, or resolve to the global environment. In practice, they're almost always +looking up core functions, whose values are unlikely (but not impossible!) to change over +the lifetime of the program. + +We can _further_ specialize symbol lookups by simply caching looked-up values for symbols +that are not lexically in scope, and _skipping subsequent lookups entirely_ unless the +looked-up symbol gets rebound. Once again, we create an `Assumption` for each cached +lookup to represent that we assume it has not been redefined, update `def!` to invalidate +that assumption. + +| Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | +| ---------- | -------------- | ----------------- | ----------------- | +| Fib | 1700 ms | 733 ms (2.3x) | 18 ms (94x !!) | +| Busywork | 781 ms | 657 ms (1.2x) | 311 ms (2.5x) | +| Fib on Mal | 686 ms | 1971 ms (0.35x) | 1474 ms (0.47x) | + +On our Fib benchmark, caching symbol lookups makes a _huge_ difference. Look at the +code for `fib`: + +``` +(def! fib (fn* [n] + (if (= n 0) + 1 + (if (= n 1) + 1 + (+ (fib (- n 1)) + (fib (- n 2))))))) +``` + +There are 7 look-ups of symbols not in lexical scope (`=`, `=`, `+`, `fib`, `-`, `fib`, and `-`), +and we've effectively eliminated all of them. All that's left are fast slot-based lookups for `n`, +two comparisons, and three arithmetic operations. All of those end up getting inlined by the compiler. +Moreover, the compiler actually 'unrolls' the recorsion several levels for us by inlining `fib` into itself. +The result is quite fast, even out-performing type-hinted Clojure (Mal's inspiration)... on OpenJDK, anyway. + +Alas, the macros still defeat us on the other benchmarks, for the same reasons. The time has come to do something +about that. + +### Step E: Macro Inlining + +If we stay within the confines of Mal's semantics, macros are a +show-stopper performance killer for us. Mal's +macro semantics are just too dynamic for their own good. Sure, you _can_ +write tail recursive macros... but why _would_ you? + +In practice, macros are often just introducing 'syntactic sugar' to improve expressiveness. +Consider the macros `cond`, `or`, `and`, `->`, and `->>`. Their +expansion behavior does not depend on runtime values (so they expand the same +way on each application), and they produce code that is linear in the size of +their inputs. + +Why do all the work to re-expand them on every application? Why not expand them _once_, +and then just substitute the result? Clojure macros, for example, work this way. + +To make further progress, we're going to have to "cheat" our way into fast macros. +We extend Mal's semantics +such that a macro with a map for metadata containing the entry `:inline? true` +is expanded once, and the result is _inlined_ in place of the macro application +forever after. We then mark all of the above macros as inlined macros. + +This isn't a Truffle-specific optimization by any means. Any Mal interpreter +that supports these semantics will see _substantial_ performance gains. However, +the immutable nature of Mal data structures might make the refactoring of +these interpreters a bit trickier than we'd like. + +Using Truffle, though, it's a trivial change. Truffle ASTs are explicitly self-modifying. +It boils down to this: + +```java + if (fn.isMacro) { + var expanded = applyMacro(env, fn); + if (isInlinableMacro(fn)) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + var newNode = expanded.body; + this.replace(newNode); + return newNode.executeGeneric(frame, env); + } else { + return invokeMacro(expanded); + } + else { +``` + +A few extra lines is all it takes. Look what happens now... + +| Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | +| ---------- | -------------- | ----------------- | ----------------- | +| Fib | 1700 ms | 718 ms (2.3x) | 21 ms (81x) | +| Busywork | 781 ms | 19 ms (41x) | 12 ms (65x) | +| Fib on Mal | 686 ms | 104 ms (6.6x) | 25 ms (27x) | + +No substantial difference on Fib, which makes sense: that benchmark doesn't use macros. + +_Huge_ gains on Busywork and Fib on Mal, because both are so dependent on macros. +It's a bit suspicious, though, that there isn't more of a performance difference between +the OpenJDK and GraalVM runs. Maybe the test runs so fast we're not sufficiently warmed up? +Let's crank up the number of iterations from 10k to 100k and see what happens. + + +| Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | +| ------------ | -------------- | ----------------- | ----------------- | +| Busywork 10x | 7264 ms | 223 ms (32x) | 37 ms (196x) | + +That's more like it. Recall that before this macro optimization, Java +and Java Truffle were close in performance. If we implemented macro inlining +in Java Mal, to make for a fair comparison, it's still likely that Truffle Mal +wins by around 6-7x, which is pretty decent! + +What about the Fib on Mal benchmark? Why don't we see a bigger difference +between the OpenJDK and GraalVM runs? It's not insufficient warm-up this time. +Doing some profiling shows that we're spending quite a bit of time in +code that isn't partially evaluated. For example, self-hosted Mal's environment +implementation turns symbols into strings, and uses the strings as +keys in environment maps, instead of just using the symbols themselves. +The code for turning objects into strings in Printer depends heavily on +JDK-provided classes that were not designed with partial evaluation in mind, +so we must exclude them from partial evaluation to avoid an explosion in +code size. + +## Conclusions + +Does Truffle deliver on the promise of high-performance JIT-ed code via +partial evaluation of interpreter code? Based on my experience, it certainly does. +It's not exactly magic pixie dust that gives you 100x for free, but it +doesn't claim to be. It _does_ enable order-of-magnitude speed improvements +over plain old interpreters with _much_ less than an order-of-magnitude +increase in effort. + +Let's revisit the questions we started with: + +*Do more complicated Mal programs show similar speed-ups?* + +No, GraalVM JIT compilation does not provide arbitrary Mal programs with the +massive performance gains we see on the Fib benchmark. This should be +totally unsurprising. + +*How much of the speed-up is really attributable to the Truffle/GraalVM combo, +and how much came from optimizations that could be applied to any Mal interpreter?* + +Our benchmarks show that the answer depends heavily on the nature of the +program. Let's look at the performance of Truffle Mal on GraalVM relative +to its performance on OpenJDK (where we don't have the benefit of Truffle- +enabled partial evaluation): + +| Benchmark | TruffleMal (GraalVM relative to OpenJDK) | +| ------------ | ---------------------------------------- | +| Fib | 34x | +| Busywork 10x | 6x | +| Fib On Mal | 4x | + +In extreme cases, for programs that are heavy on arithmetic and function calls, +our use of Truffle/GraalVM buys us 30x _after accounting for our optimizations_. + +That's pretty amazing. + +Realistically, though, we're likely to see more 3-6x speed-ups directly attributable +to Truffle/GraalVM. Still impressive! + +*How much simplicity did we have to sacrifice in the name of performance?* + +Let's look at the size, in lines of code, of each implementation. + +| File | LOC (Java) | LOC (Truffle Step A) | LOC (Truffle Step E) | +| -------------- | ---------- | -------------------- | -------------------- | +| stepA_mal.java | 310 | 757 | 886 | +| env.java | 58 | 145 | 370 | +| printer.java | 53 | 100 | 100 | +| reader.java | 151 | 166 | 166 | +| types.java | 381 | 532 | 545 | +| core.java | 633 | 1506 | 1511 | +| *Total* | 1586 | 3206 (2x) | 3578 (2.25x) | + +The Truffle-based implementation, before optimizations, weighs in at about +2x the size of the Java implementation. +Much of this can be attributed to 'boilerplate' associated with use of the Truffle framework. +In my opinion, this boilerplate adds effectively nothing to the conceptual complexity of +the implementation. In fact, much of the extra weight comes from the core functions. +The LOC count is longer because we make use of the Truffle DSL, a feature not covered in +this write-up, to trivially allow specialization of core functions based on argument type. +I would argue that while this increases code _size_, it may actually _reduce_ code complexity +via a form of pattern matching. + +Our specializations to the interpreter nodes themselves added about 15%, or 120 lines. +More significantly, we increased the size of the environment implementation by 2.5x, +adding substantial complexity in the process. + +*Was it worth it?* + +This is both totally subjective and a gross over-simplification, +but let's just guess that we've increased the complexity of the baseline Java interpreter +overall by roughly 1.5 x, and environments in particular by 3x. +In exchange for this increase in complexity, we've managed to obtain between from 25x to 80x +better performance over the baseline Java interpreter, depending on the Mal +program. + +We could perform most of our optimizations on that Java interpreter _without_ +using Truffle. However, we'd end up at a similar level of complexity, and +would see substantially smaller performance gains. + +Based on these results, if I were to attempt a 'production quality' Mal implementation, +I'd probably do it with Truffle and GraalVM. The performance gains alone seem to justify it. + +It's also worth observing that the Truffle/GraalVM provide _other_ interesting benefits +that are not performance-related. I won't cover them here. I think the most interesting +non-performance benefit is the promise of interoperability with other Truffle languages. + +## Bonus: AOT-compiled Mal + +GraalVM can ahead-of-time compile Java into a stand-alone executable (with some caveats) +called a _native image_. +This works even for Truffle interpreters! With AOT-compiled Mal, we get all the JIT compilation +goodness of Truffle, _and_ we ditch the need for a Java runtime, **and** we skip the long JVM +start-up time! A GraalVM native image of our Mal interpreter is well suited for scripts and +command line applications. + +The `make-native.sh` script can be used to compile a native image of any Mal step. +To run it, though, you'll need some additional +[prerequisites](https://www.graalvm.org/reference-manual/native-image/#prerequisites). + +The `make-native.sh` script + +* assumes you've already run `gradle build` to compile all Java classes +* takes as its only argument a step name, e.g. `step3_env` +** when no argument is supplied, `stepE_macros` is selected by default +* produces a `build/${STEP}` native image + diff --git a/impls/java-truffle/build.gradle b/impls/java-truffle/build.gradle new file mode 100644 index 0000000000..a5d5c9c62f --- /dev/null +++ b/impls/java-truffle/build.gradle @@ -0,0 +1,28 @@ +/* + * This file was generated by the Gradle 'init' task. + */ + +plugins { + id 'java' +} + +repositories { + mavenLocal() + maven { + url = uri('https://repo.maven.apache.org/maven2') + } +} + +dependencies { + implementation 'org.graalvm.truffle:truffle-api:21.1.0' + implementation 'org.organicdesign:Paguro:3.2.0' + annotationProcessor 'org.graalvm.truffle:truffle-dsl-processor:21.1.0' +} + +group = 'com.github.mmcgill' +version = '0.0.1' +sourceCompatibility = '11' + +task printClasspath { + println sourceSets.main.runtimeClasspath.getAsPath() +} diff --git a/impls/java-truffle/make-native.sh b/impls/java-truffle/make-native.sh new file mode 100755 index 0000000000..db86494e4d --- /dev/null +++ b/impls/java-truffle/make-native.sh @@ -0,0 +1,8 @@ +#!/usr/bin/env bash + +STEP=${1:-stepE_macros} + +CP=$(gradle -q --console plain printClasspath) +native-image --macro:truffle --no-fallback --initialize-at-build-time \ + -H:+TruffleCheckBlackListedMethods \ + -cp "$CP" truffle.mal.$STEP build/$STEP diff --git a/impls/java-truffle/run b/impls/java-truffle/run new file mode 100755 index 0000000000..c5ca27135f --- /dev/null +++ b/impls/java-truffle/run @@ -0,0 +1,20 @@ +#!/usr/bin/env bash + +CP=$(gradle -q --console plain printClasspath) + +# -Dgraal.LogVerbose=true \ +# -Dgraal.TraceTruffleStackTraceLimit=100 \ +# -Dgraal.TruffleCompilationThreshold=100 \ +# -Dgraal.TraceTruffleCompilationDetails=true \ +# -Dgraal.Dump=Truffle:2 \ +# -Dgraal.TraceTruffleCompilation=true \ +# -Dgraal.TruffleFunctionInlining=true \ +# -Dgraal.TruffleCompilationExceptionsArePrinted=true \ +java \ + -Dgraalvm.locatorDisabled=true \ + -Xss8m \ + --add-opens org.graalvm.truffle/com.oracle.truffle.api=ALL-UNNAMED \ + --add-opens org.graalvm.truffle/com.oracle.truffle.api.interop=ALL-UNNAMED \ + --add-opens org.graalvm.truffle/com.oracle.truffle.api.nodes=ALL-UNNAMED \ + -classpath $CP \ + truffle.mal.${STEP:-stepE_macros} "$@" diff --git a/impls/java-truffle/settings.gradle b/impls/java-truffle/settings.gradle new file mode 100644 index 0000000000..f94aa36156 --- /dev/null +++ b/impls/java-truffle/settings.gradle @@ -0,0 +1,5 @@ +/* + * This file was generated by the Gradle 'init' task. + */ + +rootProject.name = 'truffle-mal' diff --git a/impls/java-truffle/src/main/java/truffle/mal/Core.java b/impls/java-truffle/src/main/java/truffle/mal/Core.java new file mode 100644 index 0000000000..294049e131 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/Core.java @@ -0,0 +1,1515 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.FileInputStream; +import java.io.FileNotFoundException; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.io.StringWriter; +import java.util.ArrayList; +import java.util.HashMap; +import java.util.Map; +import java.util.Stack; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.dsl.Fallback; +import com.oracle.truffle.api.dsl.GenerateNodeFactory; +import com.oracle.truffle.api.dsl.NodeChild; +import com.oracle.truffle.api.dsl.NodeFactory; +import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; + +class Core { + static final Map> NS = new HashMap<>(); + + static { + NS.put("+", AddBuiltinFactory.getInstance()); + NS.put("-", SubtractBuiltinFactory.getInstance()); + NS.put("*", MultiplyBuiltinFactory.getInstance()); + NS.put("/", DivideBuiltinFactory.getInstance()); + + NS.put("prn", PrnBuiltinFactory.getInstance()); + NS.put("list", ListBuiltinFactory.getInstance()); + NS.put("list?", IsListBuiltinFactory.getInstance()); + NS.put("empty?", IsEmptyBuiltinFactory.getInstance()); + NS.put("count", CountBuiltinFactory.getInstance()); + NS.put("=", EqualsBuiltinFactory.getInstance()); + NS.put("<", LessThanBuiltinFactory.getInstance()); + NS.put("<=", LessThanEqualBuiltinFactory.getInstance()); + NS.put(">", GreaterThanBuiltinFactory.getInstance()); + NS.put(">=", GreaterThanEqualBuiltinFactory.getInstance()); + NS.put("pr-str", PrStrBuiltinFactory.getInstance()); + NS.put("str", StrBuiltinFactory.getInstance()); + NS.put("println", PrintlnBuiltinFactory.getInstance()); + + NS.put("read-string", ReadStringBuiltinFactory.getInstance()); + NS.put("slurp", SlurpBuiltinFactory.getInstance()); + NS.put("eval", EvalBuiltinFactory.getInstance()); + NS.put("atom", AtomBuiltinFactory.getInstance()); + NS.put("atom?", IsAtomBuiltinFactory.getInstance()); + NS.put("deref", DerefBuiltinFactory.getInstance()); + NS.put("reset!", ResetBuiltinFactory.getInstance()); + NS.put("swap!", SwapBuiltinFactory.getInstance()); + + NS.put("cons", ConsBuiltinFactory.getInstance()); + NS.put("concat", ConcatBuiltinFactory.getInstance()); + NS.put("vec", VecBuiltinFactory.getInstance()); + + NS.put("nth", NthBuiltinFactory.getInstance()); + NS.put("first", FirstBuiltinFactory.getInstance()); + NS.put("rest", RestBuiltinFactory.getInstance()); + + NS.put("throw", ThrowBuiltinFactory.getInstance()); + NS.put("apply", ApplyBuiltinFactory.getInstance()); + NS.put("map", MapBuiltinFactory.getInstance()); + NS.put("nil?", IsNilBuiltinFactory.getInstance()); + NS.put("true?", IsTrueBuiltinFactory.getInstance()); + NS.put("false?", IsFalseBuiltinFactory.getInstance()); + NS.put("symbol?", IsSymbolBuiltinFactory.getInstance()); + NS.put("symbol", SymbolBuiltinFactory.getInstance()); + NS.put("keyword", KeywordBuiltinFactory.getInstance()); + NS.put("keyword?", IsKeywordBuiltinFactory.getInstance()); + NS.put("vector", VectorBuiltinFactory.getInstance()); + NS.put("vector?", IsVectorBuiltinFactory.getInstance()); + NS.put("sequential?", IsSequentialBuiltinFactory.getInstance()); + NS.put("hash-map", HashMapBuiltinFactory.getInstance()); + NS.put("map?", IsMapBuiltinFactory.getInstance()); + NS.put("assoc", AssocBuiltinFactory.getInstance()); + NS.put("dissoc", DissocBuiltinFactory.getInstance()); + NS.put("get", GetBuiltinFactory.getInstance()); + NS.put("contains?", ContainsBuiltinFactory.getInstance()); + NS.put("keys", KeysBuiltinFactory.getInstance()); + NS.put("vals", ValsBuiltinFactory.getInstance()); + + NS.put("readline", ReadlineBuiltinFactory.getInstance()); + NS.put("meta", MetaBuiltinFactory.getInstance()); + NS.put("with-meta", WithMetaBuiltinFactory.getInstance()); + NS.put("time-ms", TimeMsBuiltinFactory.getInstance()); + NS.put("conj", ConjBuiltinFactory.getInstance()); + NS.put("string?", IsStringBuiltinFactory.getInstance()); + NS.put("number?", IsNumberBuiltinFactory.getInstance()); + NS.put("fn?", IsFnBuiltinFactory.getInstance()); + NS.put("macro?", IsMacroBuiltinFactory.getInstance()); + NS.put("seq", SeqBuiltinFactory.getInstance()); + } + + static MalEnv newGlobalEnv(Class> languageClass, TruffleLanguage language) { + var env = new MalEnv(languageClass); + for (var entry : NS.entrySet()) { + var root = new BuiltinRootNode(language, entry.getValue()); + var fnVal = new MalFunction( + Truffle.getRuntime().createCallTarget(root), null, root.getNumArgs(), + // Built-in functions should not be tail called. It doesn't help with + // stack consumption, since they aren't recursive, and it *does* + // invalidate direct call sites, which hurts performance. + false); + env.set(MalSymbol.get(entry.getKey()), fnVal); + } + return env; + } +} + +abstract class AbstractInvokeNode extends Node { + abstract Object invoke(CallTarget target, Object[] args); +} +/** A hack to make certain nodes sharable across languages. + */ +interface IMalLanguage { + CallTarget evalForm(Object form); + AbstractInvokeNode invokeNode(); + PrintStream out(); + BufferedReader in(); +} + +abstract class BuiltinNode extends Node { + protected IMalLanguage language; + + protected void setLanguage(IMalLanguage language) { + this.language = language; + } + + @TruffleBoundary + protected static MalException illegalArgumentException(String expectedType, Object obj) { + return new MalException("Illegal argument: '"+obj.toString()+"' is not of type "+expectedType); + } + + final String name; + + protected BuiltinNode(String name) { + this.name = name; + } + + abstract Object executeGeneric(VirtualFrame frame); + + long executeLong(VirtualFrame frame) throws UnexpectedResultException { + var value = executeGeneric(frame); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + boolean executeBoolean(VirtualFrame frame) throws UnexpectedResultException { + var value = executeGeneric(frame); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } +} + +class ReadArgNode extends Node { + final int argNum; + + ReadArgNode(int argNum) { + this.argNum = argNum; + } + + Object executeGeneric(VirtualFrame frame) { + return frame.getArguments()[argNum]; + } +} + +class ReadArgsNode extends Node { + final int argPos; + + ReadArgsNode(int argPos) { + this.argPos = argPos; + } + + Object executeGeneric(VirtualFrame frame) { + Object[] args = frame.getArguments(); + final var len = args.length - argPos; + var result = new Object[len]; + System.arraycopy(args, argPos, result, 0, len); + return result; + } +} + +class BuiltinRootNode extends RootNode { + private final int numArgs; + @Child private BuiltinNode node; + + public BuiltinRootNode(TruffleLanguage lang, NodeFactory nodeFactory) { + super(lang); + var sig = nodeFactory.getExecutionSignature(); + int numArgs = nodeFactory.getExecutionSignature().size(); + Object[] readArgNodes = new Node[numArgs]; + for (int i=0; i < numArgs; ++i) { + if (sig.get(i).equals(ReadArgsNode.class)) { + assert i == numArgs-1 : "ReadArgsNode must be last argument"; + readArgNodes[i] = new ReadArgsNode(i+1); + numArgs = -1; // variadic + } else { + readArgNodes[i] = new ReadArgNode(i+1); + } + } + node = nodeFactory.createNode(readArgNodes); + if (lang instanceof IMalLanguage) { + node.setLanguage((IMalLanguage)lang); + } + this.numArgs = numArgs; + } + + public int getNumArgs() { + return numArgs; + } + + @Override + public Object execute(VirtualFrame frame) { + return node.executeGeneric(frame); + } + + @Override + public String toString() { + return "#"; + } +} + +/************** MATH *******************/ + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class AddBuiltin extends BuiltinNode { + + protected AddBuiltin() { super("+"); } + + @Specialization + protected long add(long lhs, long rhs) { + return lhs + rhs; + } +} + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class SubtractBuiltin extends BuiltinNode { + + protected SubtractBuiltin() { super("-"); } + + @Specialization + protected long subtract(long lhs, long rhs) { + return lhs - rhs; + } + +} + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class MultiplyBuiltin extends BuiltinNode { + + protected MultiplyBuiltin() { super("*"); } + + @Specialization + protected long multiply(long lhs, long rhs) { + return lhs * rhs; + } +} + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class DivideBuiltin extends BuiltinNode { + protected DivideBuiltin() { super("/"); } + + @Specialization + protected long divide(long lhs, long rhs) { + return lhs / rhs; + } +} + +/************** STRINGS *******************/ + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class PrnBuiltin extends BuiltinNode { + protected PrnBuiltin() { super("prn"); } + + @Specialization + @TruffleBoundary + protected Object prn(Object[] args) { + var buf = new StringBuilder(); + if (args.length > 0) { + Printer.prStr(buf, args[0], true); + } + for (int i=1; i < args.length; ++i) { + buf.append(' '); + Printer.prStr(buf, args[i], true); + } + language.out().println(buf.toString()); + return MalNil.NIL; + } +} + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class PrStrBuiltin extends BuiltinNode { + + protected PrStrBuiltin() { super("pr-str"); } + + @Specialization + @TruffleBoundary + protected String prStr(Object... args) { + var buf = new StringBuilder(); + if (args.length > 0) { + Printer.prStr(buf, args[0], true); + } + for (int i=1; i < args.length; ++i) { + buf.append(' '); + Printer.prStr(buf, args[i], true); + } + return buf.toString(); + } +} + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class StrBuiltin extends BuiltinNode { + + protected StrBuiltin() { super("str"); } + + @Specialization + @TruffleBoundary + protected String prStr(Object... args) { + var buf = new StringBuilder(); + for (int i=0; i < args.length; ++i) { + Printer.prStr(buf, args[i], false); + } + return buf.toString(); + } +} + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class PrintlnBuiltin extends BuiltinNode { + + protected PrintlnBuiltin() { super("println"); } + + @Specialization + @TruffleBoundary + protected MalNil println(Object... args) { + var buf = new StringBuilder(); + if (args.length > 0) { + Printer.prStr(buf, args[0], false); + } + for (int i=1; i < args.length; ++i) { + buf.append(' '); + Printer.prStr(buf, args[i], false); + } + // The correct thing is to use the output stream associated with our language context. + // However, since each step is effectively its own language, and we wish + // to share this node among them, we'll just cheat and call System.out directly. + language.out().println(buf.toString()); + return MalNil.NIL; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class ReadStringBuiltin extends BuiltinNode { + + protected ReadStringBuiltin() { super("read-string"); } + + @TruffleBoundary + @Specialization + protected Object readString(String s) { + return Reader.readStr(s); + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class SlurpBuiltin extends BuiltinNode { + + protected SlurpBuiltin() { super("slurp"); } + + @TruffleBoundary + @Specialization + protected String slurp(String path) { + try { + var writer = new StringWriter(); + var reader = new InputStreamReader(new FileInputStream(path)); + try { + reader.transferTo(writer); + return writer.toString(); + } finally { + reader.close(); + } + } catch (FileNotFoundException ex) { + throw new MalException(ex.getMessage()); + } catch (IOException ex) { + throw new MalException(ex.getMessage()); + } + } +} + +/************ COLLECTIONS *****************/ + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class ListBuiltin extends BuiltinNode { + + protected ListBuiltin() { super("list"); } + + @Specialization + protected MalList list(Object[] args) { + var result = MalList.EMPTY; + for (int i=args.length-1; i >= 0; --i) { + result = result.cons(args[i]); + } + return result; + } +} + +@NodeChild(value = "list", type = ReadArgNode.class) +@GenerateNodeFactory +abstract class IsListBuiltin extends BuiltinNode { + + protected IsListBuiltin() { super("list?"); } + + @Specialization + public boolean isList(MalList list) { + return true; + } + + @Fallback + public boolean isList(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsEmptyBuiltin extends BuiltinNode { + + protected IsEmptyBuiltin() { super("empty?"); } + + @Specialization + protected boolean isEmpty(MalList list) { + return list.head == null; + } + + @Specialization + protected boolean isEmpty(MalVector vector) { + return vector.size() == 0; + } + + @Fallback + protected Object typeError(Object arg) { + throw illegalArgumentException("list", arg); + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class CountBuiltin extends BuiltinNode { + + protected CountBuiltin() { super("count"); } + + @Specialization + protected long count(MalList arg) { + return arg.length; + } + + @Specialization + protected long count(MalVector arg) { + return arg.size(); + } + + @Specialization + protected long count(MalNil arg) { + return 0; + } + + @Fallback + protected Object count(Object arg) { + throw illegalArgumentException("list", arg); + } +} + +@NodeChild(value="obj", type=ReadArgNode.class) +@NodeChild(value="list", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class ConsBuiltin extends BuiltinNode { + + protected ConsBuiltin() { super("cons"); } + + @Specialization + @TruffleBoundary + protected MalList cons(Object obj, MalVector vec) { + return cons(obj, vec.toList()); + } + + @Specialization + @TruffleBoundary + protected MalList cons(Object obj, MalList list) { + return list.cons(obj); + } +} + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class ConcatBuiltin extends BuiltinNode { + + protected ConcatBuiltin() { super("concat"); } + + private MalList concat1(MalList a, MalList b) { + var elems = new Stack(); + for (Object elem : a) { + elems.push(elem); + } + while (!elems.isEmpty()) { + b = b.cons(elems.pop()); + } + return b; + } + + private MalList concat1(MalVector a, MalList b) { + for (int i=a.size()-1; i >= 0; i--) { + b = b.cons(a.get(i)); + } + return b; + } + + @Specialization + @TruffleBoundary + protected MalList concat(Object... args) { + if (args.length == 0) { + return MalList.EMPTY; + } + Object arg = args[args.length-1]; + MalList result; + if (arg instanceof MalVector) { + result = ((MalVector) arg).toList(); + } else { + result = (MalList)arg; + } + for (int i=args.length-2; i >= 0; --i) { + arg = args[i]; + if (arg instanceof MalVector) { + result = concat1((MalVector)arg, result); + } else { + result = concat1((MalList)arg, result); + } + } + return result; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class VecBuiltin extends BuiltinNode { + + protected VecBuiltin() { super("vec"); } + + @Specialization + protected MalVector vec(MalVector v) { + return v; + } + + @Specialization + protected MalVector vec(MalList l) { + return MalVector.EMPTY.concat(l); + } +} + +@NodeChild(value="list", type=ReadArgNode.class) +@NodeChild(value="n", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class NthBuiltin extends BuiltinNode { + + protected NthBuiltin() { super("nth"); } + + @Specialization + @TruffleBoundary + protected Object nth(MalVector vec, long n) { + if (n >= vec.size()) { + throwInvalidArgument(); + } + return vec.get((int)n); + } + + private void throwInvalidArgument() { + throw new MalException("Out of bounds"); + } + + @Specialization + protected Object nth(MalList list, long n) { + if (n >= list.length) { + throwInvalidArgument(); + } + while (--n >= 0) { + list = list.tail; + } + return list.head; + } +} + +@GenerateNodeFactory +@NodeChild(value="arg", type=ReadArgNode.class) +abstract class FirstBuiltin extends BuiltinNode { + protected FirstBuiltin() { super("first"); } + + @Specialization + protected MalNil first(MalNil nil) { + return MalNil.NIL; + } + + @Specialization + protected Object first(MalVector vec) { + if (vec.size() == 0) + return MalNil.NIL; + return vec.get(0); + } + + @Specialization + protected Object first(MalList list) { + if (list.head == null) { + return MalNil.NIL; + } + return list.head; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class RestBuiltin extends BuiltinNode { + + protected RestBuiltin() { super("rest"); } + + @Specialization + protected MalList rest(MalNil nil) { + return MalList.EMPTY; + } + + @Specialization + @TruffleBoundary + protected MalList rest(MalVector vec) { + return rest(vec.toList()); + } + + @Specialization + protected MalList rest(MalList list) { + if (list.head == null) { + return list; + } + return list.tail; + } +} + +@NodeChild(value="fn", type=ReadArgNode.class) +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class ApplyBuiltin extends BuiltinNode { + @Child private AbstractInvokeNode invokeNode; + + protected ApplyBuiltin() { + super("apply"); + } + + @Override + protected void setLanguage(IMalLanguage language) { + super.setLanguage(language); + this.invokeNode = language.invokeNode(); + } + + @TruffleBoundary + private Object[] getArgs(Object[] args) { + Object[] fnArgs; + if (args.length == 0) { + fnArgs = args; + } else { + Object lastArg = args[args.length-1]; + int lastArgSize; + if (lastArg instanceof MalVector) { + lastArgSize = ((MalVector)lastArg).size(); + } else { + lastArgSize = (int)((MalList)lastArg).length; + } + fnArgs = new Object[args.length + lastArgSize]; + for (int i=0; i < args.length-1; i++) { + fnArgs[i+1] = args[i]; + } + int i = args.length; + assert lastArg instanceof Iterable; + for (Object obj : ((Iterable)lastArg)) { + fnArgs[i++] = obj; + } + } + return fnArgs; + } + + @Specialization + protected Object apply(VirtualFrame frame, MalFunction fn, Object[] args) { + var fnArgs = getArgs(args); + fnArgs[0] = fn.closedOverEnv; + return invokeNode.invoke(fn.callTarget, fnArgs); + } +} + +@NodeChild(value="fn", type=ReadArgNode.class) +@NodeChild(value="col", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class MapBuiltin extends BuiltinNode { + @Child private AbstractInvokeNode invokeNode; + + protected MapBuiltin() { + super("map"); + } + + @Override + protected void setLanguage(IMalLanguage language) { + super.setLanguage(language); + invokeNode = language.invokeNode(); + } + + @TruffleBoundary + private Object doMap(MalFunction fn, Iterable vals) { + var result = new ArrayList(); + Object[] args = new Object[2]; + args[0] = fn.closedOverEnv; + for (Object obj : vals) { + args[1] = obj; + result.add(invokeNode.invoke(fn.callTarget, args)); + } + return MalList.from(result); + } + + @Specialization + protected Object map(MalFunction fn, MalVector vec) { + return doMap(fn, vec); + } + + @Specialization + protected Object map(MalFunction fn, MalList list) { + return doMap(fn, list); + } +} + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class VectorBuiltin extends BuiltinNode { + + protected VectorBuiltin() { super("vector"); } + + @TruffleBoundary + @Specialization + public MalVector vector(Object[] args) { + MalVector v = MalVector.EMPTY; + for (Object arg : args) { + v = v.append(arg); + } + return v; + } +} + +@NodeChild(value="col", type=ReadArgNode.class) +@NodeChild(value="elems", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class ConjBuiltin extends BuiltinNode { + + protected ConjBuiltin() { super("conj"); } + + @Specialization + protected MalList conj(MalList list, Object[] elems) { + for (int i=0; i < elems.length; i++) { + list = list.cons(elems[i]); + } + return list; + } + + @Specialization + protected MalVector conj(MalVector vec, Object[] elems) { + for (int i=0; i < elems.length; i++) { + vec = vec.append(elems[i]); + } + return vec; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class SeqBuiltin extends BuiltinNode { + + protected SeqBuiltin() { super("seq"); } + + @Specialization + protected Object seq(MalList list) { + if (list.length == 0) { + return MalNil.NIL; + } + return list; + } + @Specialization + protected Object seq(MalVector vec) { + if (vec.size() == 0) { + return MalNil.NIL; + } + return vec.toList(); + } + @Specialization + protected Object seq(String str) { + if (str.isEmpty()) { + return MalNil.NIL; + } + MalList l = MalList.EMPTY; + for (int i=str.length()-1; i >= 0; i--) { + l = l.cons(str.substring(i, i+1)); + } + return l; + } + @Specialization + protected MalNil seq(MalNil nil) { + return nil; + } +} + +/************* Maps ********************/ + +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class HashMapBuiltin extends BuiltinNode { + + protected HashMapBuiltin() { super("hash-map"); } + + @Specialization + @TruffleBoundary + protected MalMap hashMap(Object[] args) { + MalMap map = MalMap.EMPTY; + for (int i=0; i < args.length; i += 2) { + map = map.assoc(args[i], args[i+1]); + } + return map; + } +} + +@NodeChild(value="map", type=ReadArgNode.class) +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class AssocBuiltin extends BuiltinNode { + + protected AssocBuiltin() { super("assoc"); } + + @Specialization + protected Object assoc(MalMap map, Object[] args) { + for (int i=0; i < args.length; i+=2) { + map = map.assoc(args[i], args[i+1]); + } + return map; + } +} + +@NodeChild(value="map", type=ReadArgNode.class) +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class DissocBuiltin extends BuiltinNode { + + protected DissocBuiltin() { super("dissoc"); } + + @Specialization + protected MalMap dissoc(MalMap map, Object[] args) { + for (Object arg : args) { + map = map.dissoc(arg); + } + return map; + } +} + +@NodeChild(value="map", type=ReadArgNode.class) +@NodeChild(value="key", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class GetBuiltin extends BuiltinNode { + + protected GetBuiltin() { super("get"); } + + @Specialization + @TruffleBoundary + protected Object get(MalMap map, Object key) { + return map.map.getOrDefault(key, MalNil.NIL); + } + + @Specialization + protected Object get(MalNil nil, Object key) { + return MalNil.NIL; + } +} + +@NodeChild(value="map", type=ReadArgNode.class) +@NodeChild(value="key", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class ContainsBuiltin extends BuiltinNode { + + protected ContainsBuiltin() { super("contains?"); } + + @Specialization + @TruffleBoundary + protected boolean contains(MalMap map, Object key) { + return map.map.containsKey(key); + } +} + +@NodeChild(value="map", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class KeysBuiltin extends BuiltinNode { + + protected KeysBuiltin() { super("keys"); } + + @Specialization + @TruffleBoundary + protected MalList keys(MalMap map) { + MalList list = MalList.EMPTY; + var iter = map.map.keyIterator(); + while (iter.hasNext()) { + list = list.cons(iter.next()); + } + return list; + } +} + +@NodeChild(value="map", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class ValsBuiltin extends BuiltinNode { + + protected ValsBuiltin() { super("vals"); } + + @Specialization + @TruffleBoundary + protected Object vals(MalMap map) { + MalList list = MalList.EMPTY; + var iter = map.map.valIterator(); + while (iter.hasNext()) { + list = list.cons(iter.next()); + } + return list; + } +} + +/************* COMPARISONS *************/ + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class EqualsBuiltin extends BuiltinNode { + + protected EqualsBuiltin() { super("="); } + + @Specialization + protected boolean equals(long lhs, long rhs) { + return lhs == rhs; + } + + @Specialization + protected boolean equals(boolean lhs, boolean rhs) { + return lhs == rhs; + } + + @TruffleBoundary + @Specialization + protected boolean equals(String lhs, String rhs) { + return lhs.equals(rhs); + } + + @Specialization + protected boolean equals(MalFunction lhs, MalFunction rhs) { + return lhs == rhs; + } + + @Specialization + protected boolean equals(MalNil lhs, MalNil rhs) { + return lhs == rhs; + } + + @TruffleBoundary + @Specialization + protected boolean equals(MalValue lhs, MalValue rhs) { + if (lhs == null) { + return lhs == rhs; + } else { + return lhs.equals(rhs); + } + } + + @Fallback + protected boolean equals(Object lhs, Object rhs) { + return false; + } +} + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class GreaterThanBuiltin extends BuiltinNode { + + protected GreaterThanBuiltin() { super(">"); } + + @Specialization + protected boolean greaterThan(long lhs, long rhs) { + return lhs > rhs; + } + + @Specialization + protected Object typeError(Object lhs, long rhs) { + throw illegalArgumentException("integer", lhs); + } + + @Fallback + protected Object typeError(Object lhs, Object rhs) { + throw illegalArgumentException("integer", rhs); + } +} + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class GreaterThanEqualBuiltin extends BuiltinNode { + + protected GreaterThanEqualBuiltin() { super(">="); } + + @Specialization + protected boolean greaterThanEqual(long lhs, long rhs) { + return lhs >= rhs; + } + + @Specialization + protected Object typeError(Object lhs, long rhs) { + throw illegalArgumentException("integer", lhs); + } + + @Fallback + protected Object typeError(Object lhs, Object rhs) { + throw illegalArgumentException("integer", rhs); + } +} + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class LessThanBuiltin extends BuiltinNode { + + protected LessThanBuiltin() { super("<"); } + + @Specialization + protected boolean lessThan(long lhs, long rhs) { + return lhs < rhs; + } + + @Specialization + protected Object typeError(Object lhs, long rhs) { + throw illegalArgumentException("integer", lhs); + } + + @Fallback + protected Object typeError(Object lhs, Object rhs) { + throw illegalArgumentException("integer", rhs); + } +} + +@NodeChild(value="lhs", type=ReadArgNode.class) +@NodeChild(value="rhs", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class LessThanEqualBuiltin extends BuiltinNode { + + protected LessThanEqualBuiltin() { super("<="); } + + @Specialization + protected boolean lessThanEqual(long lhs, long rhs) { + return lhs <= rhs; + } + + @Specialization + protected Object typeError(Object lhs, long rhs) { + throw illegalArgumentException("integer", lhs); + } + + @Fallback + protected Object typeError(Object lhs, Object rhs) { + throw illegalArgumentException("integer", rhs); + } +} + +/*************** Atoms ********************/ + +@NodeChild(value="val", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class AtomBuiltin extends BuiltinNode { + protected AtomBuiltin() { super("atom"); } + + @Specialization + protected MalAtom atom(Object val) { + return new MalAtom(val); + } +} + +@NodeChild(value="val", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsAtomBuiltin extends BuiltinNode { + + protected IsAtomBuiltin() { super("atom?"); } + + @Specialization + protected boolean isAtom(Object obj) { + return obj instanceof MalAtom; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class DerefBuiltin extends BuiltinNode { + + protected DerefBuiltin() { super("deref"); } + + @Specialization + protected Object deref(MalAtom atom) { + return atom.deref(); + } +} + +@NodeChild(value="atom", type=ReadArgNode.class) +@NodeChild(value="val", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class ResetBuiltin extends BuiltinNode { + + protected ResetBuiltin() { super("reset!"); } + + @Specialization + protected Object reset(MalAtom atom, Object val) { + atom.reset(val); + return val; + } +} + +@NodeChild(value="atom", type=ReadArgNode.class) +@NodeChild(value="fn", type=ReadArgNode.class) +@NodeChild(value="args", type=ReadArgsNode.class) +@GenerateNodeFactory +abstract class SwapBuiltin extends BuiltinNode { + @Child private AbstractInvokeNode invokeNode; + + protected SwapBuiltin() { + super("swap!"); + } + + @Override + protected void setLanguage(IMalLanguage language) { + super.setLanguage(language); + this.invokeNode = language.invokeNode(); + } + + @Specialization + protected Object swap(MalAtom atom, MalFunction fn, Object... args) { + synchronized (atom) { + Object[] fnArgs = new Object[2+args.length]; + fnArgs[0] = fn.closedOverEnv; + fnArgs[1] = atom.deref(); + for (int i=0; i < args.length; i++) { + fnArgs[i+2] = args[i]; + } + Object newVal = invokeNode.invoke(fn.callTarget, fnArgs); + atom.reset(newVal); + return newVal; + } + } +} + +/*************** Predicates ***************/ + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsNilBuiltin extends BuiltinNode { + protected IsNilBuiltin() { super("nil?"); } + + @Specialization + protected boolean isNil(MalNil nil) { + return true; + } + + @Fallback + protected boolean isNil(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsTrueBuiltin extends BuiltinNode { + protected IsTrueBuiltin() { super("true?"); } + + @Specialization + protected boolean isTrue(boolean b) { + return b == true; + } + + @Fallback + protected boolean isTrue(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsFalseBuiltin extends BuiltinNode { + protected IsFalseBuiltin() { super("false?"); } + + @Specialization + protected boolean isFalse(boolean b) { + return b == false; + } + + @Fallback + protected boolean isFalse(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsSymbolBuiltin extends BuiltinNode { + protected IsSymbolBuiltin() { super("symbol?"); } + + @Specialization + protected boolean isSymbol(MalSymbol sym) { + return true; + } + + @Fallback + protected boolean isSymbol(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsKeywordBuiltin extends BuiltinNode { + + protected IsKeywordBuiltin() { super("keyword?"); } + + @Specialization + protected boolean isKeyword(MalKeyword kw) { + return true; + } + + @Fallback + protected boolean isKeyword(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsVectorBuiltin extends BuiltinNode { + + protected IsVectorBuiltin() { super("vector?"); } + + @Specialization + protected boolean isVector(MalVector vec) { + return true; + } + + @Fallback + protected boolean isVector(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsSequentialBuiltin extends BuiltinNode { + + protected IsSequentialBuiltin() { super("sequential?"); } + + @Specialization + protected Object isSequential(MalList list) { + return true; + } + @Specialization + protected Object isSequential(MalVector vec) { + return true; + } + @Fallback + protected Object isSequential(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsMapBuiltin extends BuiltinNode { + + protected IsMapBuiltin() { super("map?"); } + + @Specialization + protected boolean isMap(MalMap map) { + return true; + } + @Fallback + protected boolean isMap(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsStringBuiltin extends BuiltinNode { + + protected IsStringBuiltin() { super("string?"); } + + @Specialization + protected boolean isString(String val) { + return true; + } + + @Fallback + protected boolean isString(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsNumberBuiltin extends BuiltinNode { + + protected IsNumberBuiltin() { super("number?"); } + + @Specialization + protected boolean isNumber(long n) { + return true; + } + + @Fallback + protected boolean isNumber(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsFnBuiltin extends BuiltinNode { + + protected IsFnBuiltin() { super("fn?"); } + + @Specialization + protected boolean isFn(MalFunction fn) { + return !fn.isMacro; + } + + @Fallback + protected boolean isFn(Object obj) { + return false; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class IsMacroBuiltin extends BuiltinNode { + + protected IsMacroBuiltin() { super("macro?"); } + + @Specialization + protected boolean isMacro(MalFunction fn) { + return fn.isMacro; + } + + @Fallback + protected boolean isMacro(Object obj) { + return false; + } +} + +/*************** Other ********************/ + +@NodeChild(value="ast", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class EvalBuiltin extends BuiltinNode { + + protected EvalBuiltin() { super("eval"); } + + @Specialization + @TruffleBoundary + protected Object eval(Object ast) { + return language.evalForm(ast).call(); + } +} + +@NodeChild(value="obj", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class ThrowBuiltin extends BuiltinNode { + + protected ThrowBuiltin() { super("throw"); } + + @TruffleBoundary + @Specialization + protected Object throwException(String obj) { + throw new MalException(obj); + } + + @TruffleBoundary + @Fallback + protected Object throwException(Object obj) { + throw new MalException(obj); + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class SymbolBuiltin extends BuiltinNode { + + protected SymbolBuiltin() { super("symbol"); } + + @Specialization + protected MalSymbol symbol(String str) { + return MalSymbol.get(str); + } + + @Specialization + protected MalSymbol symbol(MalSymbol sym) { + return sym; + } +} + +@GenerateNodeFactory +@NodeChild(value="arg", type=ReadArgNode.class) +abstract class KeywordBuiltin extends BuiltinNode { + + protected KeywordBuiltin() { super("keyword"); } + + @Specialization + protected MalKeyword keyword(String arg) { + return MalKeyword.get(arg); + } + + @Specialization + protected MalKeyword keyword(MalKeyword kw) { + return kw; + } +} + +@NodeChild(value="prompt", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class ReadlineBuiltin extends BuiltinNode { + + protected ReadlineBuiltin() { super("readline"); } + + @Specialization + @TruffleBoundary + protected Object readline(String prompt) { + language.out().print(prompt); + language.out().flush(); + try { + String s = language.in().readLine(); + return s == null ? MalNil.NIL : s; + } catch (IOException ex) { + throw new MalException(ex.getMessage()); + } + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class MetaBuiltin extends BuiltinNode { + + protected MetaBuiltin() { super("meta"); } + + @Specialization + protected Object meta(MetaHolder arg) { + return arg.getMeta(); + } + + @Fallback + protected Object meta(Object obj) { + return MalNil.NIL; + } +} + +@NodeChild(value="arg", type=ReadArgNode.class) +@NodeChild(value="meta", type=ReadArgNode.class) +@GenerateNodeFactory +abstract class WithMetaBuiltin extends BuiltinNode { + + protected WithMetaBuiltin() { super("with-meta"); } + + @Specialization + protected Object withMeta(MetaHolder holder, Object meta) { + return holder.withMeta(meta); + } +} + +@GenerateNodeFactory +abstract class TimeMsBuiltin extends BuiltinNode { + + protected TimeMsBuiltin() { super("time-ms"); } + + @TruffleBoundary + @Specialization + protected long timeMs() { + return System.nanoTime() / 1000000; + } +} \ No newline at end of file diff --git a/impls/java-truffle/src/main/java/truffle/mal/MalEnv.java b/impls/java-truffle/src/main/java/truffle/mal/MalEnv.java new file mode 100644 index 0000000000..3678b679bd --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/MalEnv.java @@ -0,0 +1,374 @@ +package truffle.mal; + +import java.util.HashMap; +import java.util.Map; + +import com.oracle.truffle.api.Assumption; +import com.oracle.truffle.api.CompilerDirectives; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.interop.InteropLibrary; +import com.oracle.truffle.api.interop.InvalidArrayIndexException; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.library.ExportLibrary; +import com.oracle.truffle.api.library.ExportMessage; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.utilities.UnionAssumption; + +import truffle.mal.LexicalScope.EnvSlot; + +@ExportLibrary(InteropLibrary.class) +class MalEnv implements TruffleObject { + final Class> language; + final MalEnv outer; + // bindings is initialized lazily, to avoid the overhead of creating a new HashMap + // in cases where nothing will be bound (e.g. invoking a function with no arguments) + private Map bindings; + final LexicalScope scope; + final Object[] staticBindings; + private Map cachedResults; + + private MalEnv(Class> language, MalEnv outer, LexicalScope scope, Object[] staticBindings) { + this.language = language; + this.outer = outer; + this.scope = scope; + this.staticBindings = staticBindings; + } + + MalEnv(Class> language) { + this(language, null, null, null); + } + + MalEnv(MalEnv outer) { + this(outer.language, outer, null, null); + } + + MalEnv(Class> language, LexicalScope scope) { + this(language, null, scope, new Object[scope.getStaticBindingCount()]); + } + + MalEnv(MalEnv outer, LexicalScope scope) { + this(outer.language, outer, scope, new Object[scope.getStaticBindingCount()]); + } + + /** + * Dynamic set, for use by def! to bind a symbol that wasn't assigned a slot via a LexicalScope. + * + * @param symbol the symbol to bind + * @param value its new value + */ + @TruffleBoundary + void set(MalSymbol symbol, Object value) { + if (bindings == null) { + bindings = new HashMap<>(); + } + if (!bindings.containsKey(symbol) && scope != null) { + scope.wasDynamicallyBound(symbol); + } + if (cachedResults != null) { + var result = cachedResults.get(symbol); + if (result != null) { + result.notRedefined.invalidate(); + } + } + bindings.put(symbol, value); + } + + /** + * Bind a symbol that was assigned a slot via a LexicalScope. + * @param slot the slot assigned to the symbol + * @param value the symbol's new value + */ + void set(EnvSlot slot, Object value) { + assert slot.height == 0; + staticBindings[slot.slotNum] = value; + } + + /** + * Dynamic get, for when the looked-up symbol has been assigned a slot + * but isn't guaranteed to resolve from that lexical scope, e.g. because a def! + * may have dynamically bound it in an inner scope. + * + * @param symbol + * @param slot + * @return + */ + @TruffleBoundary + Object get(MalSymbol symbol, EnvSlot slot) { + var env = this; + int height = 0; + while (height < slot.height) { + Object result = null; + if (env.bindings != null) { + result = env.bindings.get(symbol); + } + if (result != null) { + return result; + } + env = env.outer; + height++; + } + return env.staticBindings[slot.slotNum]; + } + + /** + * Dynamic get, for when the looked-up symbol has no statically assigned slot. + * + * @param symbol the symbol to look up + * @return its current value, or null if unbound + */ + @TruffleBoundary + Object get(MalSymbol symbol) { + MalEnv env = this; + while (env != null) { + if (env.bindings != null) { + var result = env.bindings.get(symbol); + if (result != null) { + return result; + } + } + env = env.outer; + } + return null; + } + + @TruffleBoundary + CachedResult cachedGet(MalSymbol symbol) { + if (cachedResults == null) { + cachedResults = new HashMap<>(); + } + var result = cachedResults.get(symbol); + if (result == null) { + Object obj = null; + if (bindings != null) { + obj = bindings.get(symbol); + } + if (obj == null && outer != null) { + result = outer.cachedGet(symbol); + } else { + result = new CachedResult(obj); + } + cachedResults.put(symbol, result); + } + return result; + } + + /** + * Static get, for when the looked-up symbol is guaranteed to resolve from a particular lexical scope. + * @param slot + * @return + */ + @ExplodeLoop + Object get(EnvSlot slot) { + MalEnv env = this; + for (int i=0; i < slot.height; i++) { + env = env.outer; + } + return env.staticBindings[slot.slotNum]; + } + + @ExportMessage + boolean hasLanguage() { + return true; + } + + @ExportMessage + Class> getLanguage() { + return language; + } + + @ExportMessage + boolean hasMembers() { + return true; + } + + @ExportMessage + @TruffleBoundary + Object readMember(String member) { + return bindings.get(MalSymbol.get(member)); + } + + @ExportMessage + @TruffleBoundary + boolean isMemberReadable(String member) { + return bindings.containsKey(MalSymbol.get(member)); + } + + @ExportMessage + @TruffleBoundary + Object toDisplayString(boolean allowSideEffects) { + return "#"; + } + + @ExportMessage + @TruffleBoundary + boolean isMemberInsertable(String member) { + return !bindings.containsKey(MalSymbol.get(member)); + } + + @ExportMessage + @TruffleBoundary + boolean isMemberModifiable(String member) { + return bindings.containsKey(MalSymbol.get(member)); + } + + @ExportMessage + @TruffleBoundary + void writeMember(String member, Object value) { + set(MalSymbol.get(member), value); + } + + @ExportMessage + @TruffleBoundary + Object getMembers(boolean includeInternal) { + Object[] names = new Object[bindings.size()]; + int i=0; + for (MalSymbol sym : bindings.keySet()) { + names[i++] = sym.symbol; + } + return new EnvMembersObject(names); + } + + static class CachedResult { + final Object result; + final Assumption notRedefined = Truffle.getRuntime().createAssumption(); + + CachedResult(Object result) { + this.result = result; + } + } +} + +@ExportLibrary(InteropLibrary.class) +final class EnvMembersObject implements TruffleObject { + private final Object[] names; + + EnvMembersObject(Object[] names) { + this.names = names; + } + @ExportMessage + boolean hasArrayElements() { + return true; + } + @ExportMessage + boolean isArrayElementReadable(long index) { + return index >= 0 && index < names.length; + } + @ExportMessage + long getArraySize() { + return names.length; + } + @ExportMessage + Object readArrayElement(long index) throws InvalidArrayIndexException { + if (!isArrayElementReadable(index)) { + CompilerDirectives.transferToInterpreter(); + throw InvalidArrayIndexException.create(index); + } + return names[(int)index]; + } +} + +/** + * A LexicalScope tracks the variables known statically to be in a given lexical scope, and keeps track of + * associated environment slots. + */ +class LexicalScope { + final LexicalScope parent; + final int depth; + final Map slots; + private int staticBindingCount; + final Map notDynamicallyBound; + + LexicalScope() { + this(null); + } + + LexicalScope(LexicalScope parent) { + this.parent = parent; + this.depth = parent == null? 0 : parent.depth+1; + this.slots = new HashMap<>(); + this.staticBindingCount = 0; + this.notDynamicallyBound = new HashMap<>(); + } + + private Assumption getNotDynamicallyBound(MalSymbol symbol) { + var assumption = notDynamicallyBound.get(symbol); + if (assumption == null) { + assumption = Truffle.getRuntime().createAssumption(symbol.symbol+" not dynamically shadowed"); + notDynamicallyBound.put(symbol, assumption); + } + return assumption; + } + + /** + * Allocate a slot for a symbol in this lexical scope, or return the slot already bound to the symbol. + * + * @param symbol + * @return + */ + @TruffleBoundary + public EnvSlot allocateSlot(MalSymbol symbol) { + var slot = new EnvSlot(0, slots.size(), getNotDynamicallyBound(symbol)); + slots.put(symbol, slot); + staticBindingCount++; + return slot; + } + + /** + * If symbols is statically known to be in scope, returns a slot that can be used to look up + * the bound symbol efficiently. Otherwise, returns null; + * + * @param symbol + * @return + */ + @TruffleBoundary + public EnvSlot getSlot(MalEnv env, MalSymbol symbol) { + int height = 0; + var scope = this; + Assumption assumption = getNotDynamicallyBound(symbol); + while (scope != null) { + if (scope.slots.containsKey(symbol)) { + var slot = scope.slots.get(symbol); + if (env.get(slot) != null) { + if (height == 0) { + return slot; + } else { + return new EnvSlot(height, scope.slots.get(symbol).slotNum, assumption); + } + } + } + height++; + scope = scope.parent; + env = env.outer; + if (scope != null) { + assumption = new UnionAssumption(assumption, scope.getNotDynamicallyBound(symbol)); + } + } + return null; + } + + @TruffleBoundary + public void wasDynamicallyBound(MalSymbol sym) { + var assumption = notDynamicallyBound.get(sym); + if (assumption != null) { + assumption.invalidate(); + } + } + + public int getStaticBindingCount() { + return staticBindingCount; + } + + static class EnvSlot { + public final int height; + public final int slotNum; + public final Assumption notDynamicallyBound; + + private EnvSlot(int height, int slotNum, Assumption notDynamicallyBound) { + this.height = height; + this.slotNum = slotNum; + this.notDynamicallyBound = notDynamicallyBound; + } + } +} \ No newline at end of file diff --git a/impls/java-truffle/src/main/java/truffle/mal/Printer.java b/impls/java-truffle/src/main/java/truffle/mal/Printer.java new file mode 100644 index 0000000000..37056cb3f7 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/Printer.java @@ -0,0 +1,100 @@ +package truffle.mal; + +public class Printer { + + public static String prStr(Object form, boolean printReadably) { + var buf = new StringBuilder(); + prStr(buf, form, printReadably); + return buf.toString(); + } + + public static void prStr(StringBuilder buf, Object form, boolean printReadably) { + if (form instanceof Boolean) { + + buf.append((boolean)form); + + } else if (form instanceof Long) { + + buf.append((long)form); + + } else if (form instanceof String) { + + var s = (String)form; + if (printReadably) { + buf.append('"'); + buf.append(s.replace("\\", "\\\\").replace("\n", "\\n").replace("\"", "\\\"")); + buf.append('"'); + } else { + buf.append(s); + } + + } else if (form instanceof MalSymbol) { + + buf.append(((MalSymbol)form).symbol); + + } else if (form instanceof MalKeyword) { + + buf.append(':'); + buf.append(((MalKeyword)form).keyword); + + } else if (form instanceof MalNil) { + + buf.append("nil"); + + } else if (form instanceof MalList) { + + var list = (MalList)form; + buf.append("("); + MalList l = list; + while (l != null && l.head != null) { + prStr(buf, l.head, printReadably); + l = l.tail; + if (l.head != null) { + buf.append(' '); + } + } + buf.append(")"); + + } else if (form instanceof MalVector) { + + var vector = (MalVector)form; + final int size = vector.size(); + buf.append('['); + for (int i=0; i < size; ++i) { + prStr(buf, vector.get(i), printReadably); + if (i < size-1) { + buf.append(' '); + } + } + buf.append(']'); + + } else if (form instanceof MalMap) { + + var map = (MalMap)form; + int i = 0; + buf.append('{'); + for (var entry : map.map) { + prStr(buf, entry.getKey(), printReadably); + buf.append(' '); + prStr(buf, entry.getValue(), printReadably); + if (++i < map.map.size()) { + buf.append(' '); + } + } + buf.append('}'); + + } else if (form instanceof MalFunction) { + + buf.append("#"); + + } else if (form instanceof MalAtom) { + + buf.append("(atom "); + prStr(buf, ((MalAtom)form).deref(), printReadably); + buf.append(")"); + + } else { + throw new RuntimeException("Not a MAL type: "+form.getClass().getCanonicalName()); + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/Reader.java b/impls/java-truffle/src/main/java/truffle/mal/Reader.java new file mode 100644 index 0000000000..0a888c4cf2 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/Reader.java @@ -0,0 +1,166 @@ +package truffle.mal; + +import java.util.ArrayList; +import java.util.List; +import java.util.regex.Pattern; + +public class Reader { + private static final Pattern TOKEN_PATTERN = Pattern.compile("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)"); + + public static List tokenize(String s) { + var m = TOKEN_PATTERN.matcher(s); + var result = new ArrayList(); + while (m.find()) { + String t = m.group(1); + if (!t.isEmpty()) { + result.add(t); + } + } + return result; + } + + public static Object readStr(String s) { + return new Reader(tokenize(s)).readForm(); + } + + private int i = 0; + private final List tokens; + + private Reader(List tokens) { + this.tokens = tokens; + } + + private boolean hasNext() { + return i < tokens.size(); + } + + private String peek() { + if (!hasNext()) { + throw new MalException("EOF"); + } + return tokens.get(i); + } + + private String next() { + if (!hasNext()) { + throw new MalException("EOF"); + } + return tokens.get(i++); + } + + private Object readForm() { + if (!hasNext()) { + return MalNil.NIL; + } + String t = peek(); + if (t.equals("'")) { + next(); + return MalList.EMPTY.cons(readForm()).cons(MalSymbol.QUOTE); + } else if (t.equals("`")) { + next(); + return MalList.EMPTY.cons(readForm()).cons(MalSymbol.QUASIQUOTE); + } else if (t.equals("@")) { + next(); + return MalList.EMPTY.cons(readForm()).cons(MalSymbol.DEREF); + } else if (t.equals("~")) { + next(); + return MalList.EMPTY.cons(readForm()).cons(MalSymbol.UNQUOTE); + } else if (t.equals("~@")) { + next(); + return MalList.EMPTY.cons(readForm()).cons(MalSymbol.SPLICE_UNQUOTE); + } else if (t.equals("^")) { + next(); + var meta = readForm(); + var obj = readForm(); + return MalList.EMPTY.cons(meta).cons(obj).cons(MalSymbol.get("with-meta")); + } else if (t.equals("(")) { + return readList(); + } else if (t.equals("[")) { + return readVector(); + } else if (t.equals("{")) { + return readMap(); + } else if (t.startsWith(";")) { + // gobble up consecutive comments without consuming stack space + while (t.startsWith(";")) { + next(); + if (!hasNext()) + break; + t = peek(); + } + return readForm(); + } else { + return readAtom(); + } + } + + private MalVector readVector() { + var elements = new ArrayList(); + next(); // consume '[' + while (!peek().equals("]")) { + elements.add(readForm()); + } + next(); // consume ']' + return MalVector.EMPTY.concat(elements); + } + + private MalList readList() { + var elements = new ArrayList(); + next(); // consume '(' + while (!peek().equals(")")) { + elements.add(readForm()); + } + next(); // consume ')' + MalList result = MalList.EMPTY; + var iter = elements.listIterator(elements.size()); + while (iter.hasPrevious()) { + result = result.cons(iter.previous()); + } + return result; + } + + private MalMap readMap() { + MalMap map = MalMap.EMPTY; + next(); // consume '{' + while (!peek().equals("}")) { + map = map.assoc(readForm(), readForm()); + } + next(); // consume '}' + return map; + } + + private Object readAtom() { + String t = next(); + if (t.charAt(0) == '"') { + StringBuilder sb = new StringBuilder(); + int i=1; + for (int j=t.indexOf('\\', i); j != -1; j=t.indexOf('\\', i)) { + sb.append(t.subSequence(i, j)); + switch (t.charAt(j+1)) { + case 'n': sb.append('\n'); break; + case '"': sb.append('"'); break; + case '\\': sb.append('\\'); break; + } + i = j+2; + } + if (i > t.length()-1 || t.charAt(t.length()-1) != '"') { + throw new MalException("EOF"); + } + sb.append(t.substring(i, t.length()-1)); + return sb.toString(); + } else if (t.charAt(0) == ':') { + return MalKeyword.get(t.substring(1)); + } else if (t.charAt(0) >= '0' && t.charAt(0) <= '9') { + return Long.parseLong(t); + } else if (t.length() > 1 && t.charAt(0) == '-' && t.charAt(1) >= '0' && t.charAt(1) <= '9') { + return Long.parseLong(t); + } else if (t.equals("true")) { + return true; + } else if (t.equals("false")) { + return false; + } else if (t.equals("nil")) { + return MalNil.NIL; + } else { + return MalSymbol.get(t); + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/Types.java b/impls/java-truffle/src/main/java/truffle/mal/Types.java new file mode 100644 index 0000000000..11a65c7659 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/Types.java @@ -0,0 +1,555 @@ +package truffle.mal; + +import java.util.Iterator; +import java.util.Stack; + +import org.organicdesign.fp.collections.PersistentHashMap; +import org.organicdesign.fp.collections.PersistentVector; + +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.TruffleException; +import com.oracle.truffle.api.interop.InteropLibrary; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.library.ExportLibrary; +import com.oracle.truffle.api.library.ExportMessage; +import com.oracle.truffle.api.nodes.Node; + +public class Types { +} + +interface MetaHolder { + Object getMeta(); + T withMeta(Object meta); +} + +@SuppressWarnings("serial") +class MalException extends RuntimeException implements TruffleException { + final Object obj; + + MalException(String message) { + super(message); + this.obj = message; + } + + MalException(Object obj) { + super(Printer.prStr(obj, true)); + this.obj = obj; + } + + @Override + public Throwable fillInStackTrace() { + return this; + } + + @Override + public Node getLocation() { + return null; + } +} + +abstract class MalValue { + @Override + @TruffleBoundary + public String toString() { + return Printer.prStr(this, true); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalNil extends MalValue implements TruffleObject { + public static final MalNil NIL = new MalNil(); + + private MalNil() {} + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalList extends MalValue implements TruffleObject, Iterable, MetaHolder { + public static final MalList EMPTY = new MalList(); + + @TruffleBoundary + public static MalList from(Iterable list) { + var result = EMPTY; + var stack = new Stack(); + list.forEach(stack::add); + while (!stack.isEmpty()) { + result = result.cons(stack.pop()); + } + return result; + } + + private static int computeHash(Object head, MalList tail) { + final int prime = 31; + int result = 1; + result = prime * result + head.hashCode(); + result = prime * result + tail.hashCode(); + return result; + } + + public final Object head; + public final MalList tail; + private final int hash; + // The lazy programmer's way of ensuring constant-time size() calls: waste lots of memory! + public final int length; + public final Object meta; + + @TruffleBoundary + private MalList() { + this.head = null; + this.tail = null; + this.hash = 31; + this.length = 0; + this.meta = MalNil.NIL; + } + + @TruffleBoundary + private MalList(MalList list, Object meta) { + this.head = list.head; + this.tail = list.tail; + this.hash = list.hash; + this.length = list.length; + this.meta = meta; + } + + @TruffleBoundary + private MalList(Object head, MalList tail, Object meta) { + this.head = head; + this.tail = tail; + this.hash = computeHash(head, tail); + this.length = tail.length+1; + this.meta = meta; + } + + public boolean isEmpty() { + return head == null; + } + + @TruffleBoundary + public MalList cons(Object val) { + return new MalList(val, this, this.meta); + } + + @Override + public int hashCode() { + return hash; + } + + @Override + @TruffleBoundary + public boolean equals(Object obj) { + if (this == obj) + return true; + if (obj == null) + return false; + if (obj instanceof MalVector) { + MalVector other = (MalVector)obj; + if (this.length != other.size()) + return false; + int i=0; + MalList list = this; + while (!list.isEmpty()) { + if (!list.head.equals(other.get(i))) { + return false; + } + i++; + list = list.tail; + } + return true; + } + if (this.getClass() != obj.getClass()) + return false; + + MalList other = (MalList) obj; + if (head == null) { + if (other.head != null) + return false; + } else if (!head.equals(other.head)) + return false; + if (tail == null) { + if (other.tail != null) + return false; + } else if (!tail.equals(other.tail)) + return false; + return true; + } + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } + + @Override + public Iterator iterator() { + return new MalListIterator(this); + } + + private static class MalListIterator implements Iterator { + private MalList list; + + MalListIterator(MalList list) { + this.list = list; + } + + @Override + public boolean hasNext() { + return !list.equals(MalList.EMPTY); + } + + @Override + public Object next() { + Object obj = list.head; + list = list.tail; + return obj; + } + } + + @Override + public Object getMeta() { + return meta; + } + + @Override + public MalList withMeta(Object meta) { + return new MalList(this, meta); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalVector extends MalValue implements TruffleObject, Iterable, MetaHolder { + public static final MalVector EMPTY = new MalVector(); + + private final PersistentVector vector; + private final Object meta; + + private MalVector() { + vector = PersistentVector.empty(); + meta = MalNil.NIL; + } + + private MalVector(PersistentVector vector, Object meta) { + this.vector = vector; + this.meta = meta; + } + + @TruffleBoundary + public MalVector append(Object obj) { + return new MalVector(vector.append(obj), this.meta); + } + + @TruffleBoundary + public MalVector concat(Object[] objs) { + var v = vector.mutable(); + for (int i=0; i < objs.length; ++i) { + v.append(objs[i]); + } + return new MalVector(v.immutable(), meta); + } + + @TruffleBoundary + public MalVector concat(Iterable objs) { + return new MalVector(vector.concat(objs), meta); + } + + public int size() { + return vector.size(); + } + + public Object get(int i) { + return vector.get(i); + } + + @Override + public int hashCode() { + return vector.hashCode(); + } + + @Override + @TruffleBoundary + public boolean equals(Object obj) { + if (this == obj) + return true; + if (obj == null) + return false; + if (obj instanceof MalList) + return obj.equals(this); + if (getClass() != obj.getClass()) + return false; + MalVector other = (MalVector) obj; + return vector.equals(other.vector); + } + + @Override + public Iterator iterator() { + return vector.iterator(); + } + + @TruffleBoundary + public MalList toList() { + MalList result = MalList.EMPTY; + for (int i=vector.size()-1; i >= 0; i--) { + result = result.cons(vector.get(i)); + } + return result; + } + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } + + @Override + public Object getMeta() { + return meta; + } + + @Override + public MalVector withMeta(Object meta) { + return new MalVector(this.vector, meta); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalMap extends MalValue implements TruffleObject, MetaHolder { + public static final MalMap EMPTY = new MalMap(); + + public final PersistentHashMap map; + private final Object meta; + + private MalMap() { + map = PersistentHashMap.EMPTY; + meta = MalNil.NIL; + } + + private MalMap(PersistentHashMap map, Object meta) { + this.map = map; + this.meta = meta; + } + + @TruffleBoundary + public MalMap assoc(Object key, Object val) { + return new MalMap(map.assoc(key, val), meta); + } + + @TruffleBoundary + public MalMap dissoc(Object key) { + return new MalMap(map.without(key), meta); + } + + @TruffleBoundary + public Object get(Object key) { + if (map.containsKey(key)) { + return map.get(key); + } else { + return MalNil.NIL; + } + } + + @TruffleBoundary + @Override + public int hashCode() { + return map.hashCode(); + } + + @TruffleBoundary + @Override + public boolean equals(Object obj) { + if (this == obj) + return true; + if (obj == null) + return false; + if (getClass() != obj.getClass()) + return false; + MalMap other = (MalMap) obj; + return map.equals(other.map); + } + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } + + @Override + public Object getMeta() { + return meta; + } + + @Override + public MalMap withMeta(Object meta) { + return new MalMap(map, meta); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalKeyword extends MalValue implements TruffleObject { + public static final MalKeyword INLINE_Q = MalKeyword.get("inline?"); + + public final String keyword; + + public static MalKeyword get(String keyword) { + return new MalKeyword(keyword); + } + + private MalKeyword(String keyword) { + this.keyword = keyword; + } + + @Override + public int hashCode() { + return keyword.hashCode(); + } + + @Override + public boolean equals(Object obj) { + if (obj == null) { + return false; + } + if (!(obj instanceof MalKeyword)) { + return false; + } + return keyword.equals(((MalKeyword)obj).keyword); + } + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalSymbol extends MalValue implements TruffleObject { + public static MalSymbol get(String symbol) { + return new MalSymbol(symbol); + } + + public static final MalSymbol LET_STAR = MalSymbol.get("let*"); + public static final MalSymbol DEF_BANG = MalSymbol.get("def!"); + public static final MalSymbol DO = MalSymbol.get("do"); + public static final MalSymbol IF = MalSymbol.get("if"); + public static final MalSymbol FN_STAR = MalSymbol.get("fn*"); + public static final MalSymbol AMPERSAND = MalSymbol.get("&"); + public static final MalSymbol QUOTE = MalSymbol.get("quote"); + public static final MalSymbol QUASIQUOTE = MalSymbol.get("quasiquote"); + public static final MalSymbol UNQUOTE = MalSymbol.get("unquote"); + public static final MalSymbol SPLICE_UNQUOTE = MalSymbol.get("splice-unquote"); + public static final MalSymbol DEFMACRO = MalSymbol.get("defmacro!"); + public static final MalSymbol MACROEXPAND = MalSymbol.get("macroexpand"); + public static final MalSymbol DEREF = MalSymbol.get("deref"); + public static final MalSymbol TRY = MalSymbol.get("try*"); + public static final MalSymbol CATCH = MalSymbol.get("catch*"); + + public final String symbol; + + private MalSymbol(String symbol) { + this.symbol = symbol; + } + + @Override + public int hashCode() { + return symbol.hashCode(); + } + + @Override + public boolean equals(Object obj) { + if (this == obj) + return true; + if (obj == null) + return false; + if (getClass() != obj.getClass()) + return false; + MalSymbol other = (MalSymbol) obj; + if (symbol == null) { + if (other.symbol != null) + return false; + } else if (!symbol.equals(other.symbol)) + return false; + return true; + } + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalFunction extends MalValue implements TruffleObject, MetaHolder { + final RootCallTarget callTarget; + final MalEnv closedOverEnv; + final int numArgs; + final boolean isMacro; + final Object meta; + final boolean canBeTailCalled; + + MalFunction(RootCallTarget callTarget, MalEnv closedOverEnv, int numArgs, boolean canBeTailCalled) { + this.callTarget = callTarget; + this.closedOverEnv = closedOverEnv; + this.numArgs = numArgs; + this.isMacro = false; + this.meta = MalNil.NIL; + this.canBeTailCalled = canBeTailCalled; + } + + MalFunction(RootCallTarget callTarget, MalEnv closedOverEnv, int numArgs) { + this(callTarget, closedOverEnv, numArgs, true); + } + + MalFunction(MalFunction f, boolean isMacro) { + this(f, f.meta, isMacro, true); + } + + MalFunction(MalFunction f, Object meta, boolean isMacro) { + this(f, meta, isMacro, true); + } + + MalFunction(MalFunction f, Object meta, boolean isMacro, boolean canBeTailCalled) { + this.callTarget = f.callTarget; + this.closedOverEnv = f.closedOverEnv; + this.numArgs = f.numArgs; + this.isMacro = isMacro; + this.meta = meta; + this.canBeTailCalled = canBeTailCalled; + } + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } + + @Override + public Object getMeta() { + return meta; + } + + @Override + public MalFunction withMeta(Object meta) { + return new MalFunction(this, meta, this.isMacro); + } +} + +@ExportLibrary(InteropLibrary.class) +class MalAtom extends MalValue implements TruffleObject { + private Object value; + + public MalAtom(Object initialValue) { + this.value = initialValue; + } + + public Object deref() { + return value; + } + + public Object reset(Object newValue) { + this.value = newValue; + return newValue; + } + + @ExportMessage + Object toDisplayString(boolean allowSideEffects) { + return this.toString(); + } +} \ No newline at end of file diff --git a/impls/java-truffle/src/main/java/truffle/mal/step0_repl.java b/impls/java-truffle/src/main/java/truffle/mal/step0_repl.java new file mode 100644 index 0000000000..820d5caa3b --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step0_repl.java @@ -0,0 +1,33 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; + +public class step0_repl { + private static String READ(String s) { + return s; + } + + private static void PRINT(String s) { + System.out.println(s); + } + + private static void rep(String s) { + PRINT(READ(s)); + } + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + rep(s); + } + } + } +} \ No newline at end of file diff --git a/impls/java-truffle/src/main/java/truffle/mal/step1_read_print.java b/impls/java-truffle/src/main/java/truffle/mal/step1_read_print.java new file mode 100644 index 0000000000..edb179bd66 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step1_read_print.java @@ -0,0 +1,26 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; + +public class step1_read_print { + + public static void main(String[] args) throws IOException { + boolean done = false; + var reader = new BufferedReader(new InputStreamReader(System.in)); + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + System.out.println(Printer.prStr(Reader.readStr(s), true)); + } catch (MalException ex) { + System.out.println(ex.getMessage()); + } + } + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step2_eval.java b/impls/java-truffle/src/main/java/truffle/mal/step2_eval.java new file mode 100644 index 0000000000..5f9068af94 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step2_eval.java @@ -0,0 +1,258 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.util.HashMap; +import java.util.Map; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step2_eval { + static final String LANGUAGE_ID = "mal_step2"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + var context = Context.create(LANGUAGE_ID); + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + System.out.println(val.toString()); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + static Map replEnv = new HashMap<>(); + static { + replEnv.put(MalSymbol.get("+"), new BuiltinFn(args -> { return (long)args[0]+(long)args[1]; })); + replEnv.put(MalSymbol.get("-"), new BuiltinFn(args -> { return (long)args[0]-(long)args[1]; })); + replEnv.put(MalSymbol.get("*"), new BuiltinFn(args -> { return (long)args[0]*(long)args[1]; })); + replEnv.put(MalSymbol.get("/"), new BuiltinFn(args -> { return (long)args[0]/(long)args[1]; })); + }; + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame); + + public long executeLong(VirtualFrame frame) throws UnexpectedResultException { + var value = executeGeneric(frame); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame) throws UnexpectedResultException { + var value = executeGeneric(frame); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static MalNode formToNode(Object form) { + if (form instanceof MalSymbol) { + + return new LookupNode((MalSymbol)form); + + } else if (form instanceof MalVector) { + + return new VectorNode((MalVector)form); + + } else if (form instanceof MalMap) { + + return new MapNode((MalMap)form); + + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + + return new ApplyNode((MalList)form); + + } else { + + return new LiteralNode(form); + + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(vector.get(i)); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame) { + var elements = new Object[elementNodes.length]; + for (int i=0; i < elementNodes.length; i++) { + elements[i] = elementNodes[i].executeGeneric(frame); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(entry.getKey()); + nodes[i++] = formToNode(entry.getValue()); + } + } + @Override + public Object executeGeneric(VirtualFrame frame) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame), nodes[i+1].executeGeneric(frame)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @TruffleBoundary + private Object lookup() { + var result = replEnv.get(symbol); + if (result == null) { + throw new MalException(symbol+" not found"); + } + return result; + } + + @Override + public Object executeGeneric(VirtualFrame frame) { + return lookup(); + } + } + + static class ApplyNode extends MalNode { + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + + ApplyNode(MalList list) { + super(list); + fnNode = formToNode(list.head); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(list.head); + list = list.tail; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame) { + var fn = (BuiltinFn)fnNode.executeGeneric(frame); + var args = new Object[argNodes.length]; + for (int i=0; i < args.length; i++) { + args[i] = argNodes[i].executeGeneric(frame); + } + return fn.fn.apply(args); + } + } + + static class MalRootNode extends RootNode { + final Object form; + @Child MalNode body; + + MalRootNode(TruffleLanguage language, Object form) { + super(language, new FrameDescriptor()); + this.form = form; + this.body = formToNode(form); + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame); + } + } + + public final static class MalContext { + + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + var root = new MalRootNode(this, Reader.readStr(s)); + return Truffle.getRuntime().createCallTarget(root); + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step3_env.java b/impls/java-truffle/src/main/java/truffle/mal/step3_env.java new file mode 100644 index 0000000000..913cff7733 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step3_env.java @@ -0,0 +1,307 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.util.ArrayList; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step3_env { + static final String LANGUAGE_ID = "mal_step3"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + var context = Context.create(LANGUAGE_ID); + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + System.out.println(val.toString()); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static MalNode formToNode(Object form) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode((MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode((MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head)) { + return new DefNode(list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(list); + } else { + return new ApplyNode(list); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(vector.get(i)); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(entry.getKey()); + nodes[i++] = formToNode(entry.getValue()); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException(symbol+" not found"); + } + return result; + } + } + + static class ApplyNode extends MalNode { + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + + ApplyNode(MalList list) { + super(list); + fnNode = formToNode(list.head); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(list.head); + list = list.tail; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (BuiltinFn)fnNode.executeGeneric(frame, env); + var args = new Object[argNodes.length]; + for (int i=0; i < args.length; i++) { + args[i] = argNodes[i].executeGeneric(frame, env); + } + return fn.fn.apply(args); + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + DefNode(MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.valueNode = formToNode(list.tail.tail.head); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + LetBindingNode(MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(valueForm); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalList form) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode((MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(form.tail.tail.head); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + static class MalRootNode extends RootNode { + final Object form; + @Child MalNode body; + + MalRootNode(TruffleLanguage language, Object form) { + super(language, new FrameDescriptor()); + this.form = form; + this.body = formToNode(form); + } + + @Override + public Object execute(VirtualFrame frame) { + var ctx = lookupContextReference(MalLanguage.class).get(); + return body.executeGeneric(frame, ctx.globalEnv); + } + } + + final static class MalContext { + final MalEnv globalEnv = new MalEnv(MalLanguage.class); + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage { + @Override + protected MalContext createContext(Env env) { + var ctx = new MalContext(); + ctx.globalEnv.set(MalSymbol.get("+"), new BuiltinFn(args -> { return (long)args[0]+(long)args[1]; })); + ctx.globalEnv.set(MalSymbol.get("-"), new BuiltinFn(args -> { return (long)args[0]-(long)args[1]; })); + ctx.globalEnv.set(MalSymbol.get("*"), new BuiltinFn(args -> { return (long)args[0]*(long)args[1]; })); + ctx.globalEnv.set(MalSymbol.get("/"), new BuiltinFn(args -> { return (long)args[0]/(long)args[1]; })); + return ctx; + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + var root = new MalRootNode(this, Reader.readStr(s)); + return Truffle.getRuntime().createCallTarget(root); + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step4_if_fn_do.java b/impls/java-truffle/src/main/java/truffle/mal/step4_if_fn_do.java new file mode 100644 index 0000000000..3909f26a22 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step4_if_fn_do.java @@ -0,0 +1,532 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step4_if_fn_do { + static final String LANGUAGE_ID = "mal_step4"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static MalNode formToNode(MalLanguage language, Object form) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else { + return new ApplyNode(language, list); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i)); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey()); + nodes[i++] = formToNode(language, entry.getValue()); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException(symbol+" not found"); + } + return result; + } + } + + static class InvokeNode extends AbstractInvokeNode { + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + InvokeNode() { + } + + Object invoke(CallTarget target, Object[] args) { + return callNode.call(target, args); + } + } + + static class ApplyNode extends MalNode { + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + ApplyNode(MalLanguage language, MalList list) { + super(list); + fnNode = formToNode(language, list.head); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head); + list = list.tail; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return callNode.call(fn.callTarget, args); + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.valueNode = formToNode(language, list.tail.tail.head); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + static class MalRootNode extends RootNode { + final Object form; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form) { + super(language, new FrameDescriptor()); + this.form = form; + this.body = formToNode(language, form); + } + + @Override + public Object execute(VirtualFrame frame) { + var ctx = lookupContextReference(MalLanguage.class).get(); + return body.executeGeneric(frame, ctx.globalEnv); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form) { + super(form); + conditionNode = formToNode(language, form.tail.head); + trueNode = formToNode(language, form.tail.tail.head); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var root = new MalRootNode(this, form); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step5_tco.java b/impls/java-truffle/src/main/java/truffle/mal/step5_tco.java new file mode 100644 index 0000000000..5b21db24c8 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step5_tco.java @@ -0,0 +1,562 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step5_tco { + static final String LANGUAGE_ID = "mal_step5"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else { + return new ApplyNode(language, list, tailPosition); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false); + nodes[i++] = formToNode(language, entry.getValue(), false); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException(symbol+" not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + if (tailPosition) { + throw new TailCallException(target, args); + } else { + while (true) { + try { + return callNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + static class ApplyNode extends MalNode { + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { + super(list); + fnNode = formToNode(language, list.head, false); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args); + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.valueNode = formToNode(language, list.tail.tail.head, false); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm, false); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a top-level evaluated form. + */ + static class MalRootNode extends RootNode { + final Object form; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, false); + } + + @Override + public Object execute(VirtualFrame frame) { + var ctx = lookupContextReference(MalLanguage.class).get(); + return body.executeGeneric(frame, ctx.globalEnv); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + conditionNode = formToNode(language, form.tail.head, false); + trueNode = formToNode(language, form.tail.tail.head, tailPosition); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var root = new MalRootNode(this, form); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step6_file.java b/impls/java-truffle/src/main/java/truffle/mal/step6_file.java new file mode 100644 index 0000000000..692f4e979e --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step6_file.java @@ -0,0 +1,579 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step6_file { + static final String LANGUAGE_ID = "mal_step6"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else { + return new ApplyNode(language, list, tailPosition); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false); + nodes[i++] = formToNode(language, entry.getValue(), false); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException(symbol+" not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + if (tailPosition) { + throw new TailCallException(target, args); + } else { + while (true) { + try { + return callNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + static class ApplyNode extends MalNode { + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { + super(list); + fnNode = formToNode(language, list.head, false); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args); + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.valueNode = formToNode(language, list.tail.tail.head, false); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm, false); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a top-level evaluated form. + */ + static class MalRootNode extends RootNode { + final Object form; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, false); + } + + @Override + public Object execute(VirtualFrame frame) { + var ctx = lookupContextReference(MalLanguage.class).get(); + return body.executeGeneric(frame, ctx.globalEnv); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + conditionNode = formToNode(language, form.tail.head, false); + trueNode = formToNode(language, form.tail.tail.head, tailPosition); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var root = new MalRootNode(this, form); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step7_quote.java b/impls/java-truffle/src/main/java/truffle/mal/step7_quote.java new file mode 100644 index 0000000000..b517fc34bb --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step7_quote.java @@ -0,0 +1,623 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step7_quote { + static final String LANGUAGE_ID = "mal_step7"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition); + } else { + return new ApplyNode(language, list, tailPosition); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false); + nodes[i++] = formToNode(language, entry.getValue(), false); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException(symbol+" not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + if (tailPosition) { + throw new TailCallException(target, args); + } else { + while (true) { + try { + return callNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + static class ApplyNode extends MalNode { + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { + super(list); + fnNode = formToNode(language, list.head, false); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args); + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.valueNode = formToNode(language, list.tail.tail.head, false); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm, false); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a top-level evaluated form. + */ + static class MalRootNode extends RootNode { + final Object form; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, false); + } + + @Override + public Object execute(VirtualFrame frame) { + var ctx = lookupContextReference(MalLanguage.class).get(); + return body.executeGeneric(frame, ctx.globalEnv); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + conditionNode = formToNode(language, form.tail.head, false); + trueNode = formToNode(language, form.tail.tail.head, tailPosition); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var root = new MalRootNode(this, form); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step8_macros.java b/impls/java-truffle/src/main/java/truffle/mal/step8_macros.java new file mode 100644 index 0000000000..1790e65ce5 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step8_macros.java @@ -0,0 +1,712 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step8_macros { + static final String LANGUAGE_ID = "mal_step8"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + context.eval(LANGUAGE_ID, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition); + } else if (MalSymbol.MACROEXPAND.equals(head)) { + return new MacroexpandNode(list); + } else { + return new ApplyNode(language, list, tailPosition); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false); + nodes[i++] = formToNode(language, entry.getValue(), false); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException(symbol+" not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + return invoke(target, args, true); + } + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + while (true) { + try { + return callNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + private static MalFunction getMacroFn(MalEnv env, Object form) { + if (!(form instanceof MalList)) + return null; + MalList list = (MalList)form; + if (!(list.head instanceof MalSymbol)) + return null; + MalSymbol fnSym = (MalSymbol)list.head; + var obj = env.get(fnSym); + if (obj == null) + return null; + if (!(obj instanceof MalFunction)) + return null; + MalFunction fn = (MalFunction)obj; + return fn.isMacro ? fn : null; + } + + static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { + var fn = getMacroFn(env, form); + while (fn != null) { + MalList list = (MalList)form; + var args = new Object[(int)list.length]; + args[0] = fn.closedOverEnv; + int i=1; + list = list.tail; + while (!list.isEmpty()) { + args[i++] = list.head; + list = list.tail; + } + form = invokeNode.invoke(fn.callTarget, args, false); + fn = getMacroFn(env, form); + } + return form; + } + + static class MacroexpandNode extends MalNode { + @Child private InvokeNode invokeNode = new InvokeNode(false); + private final Object body; + + MacroexpandNode(MalList form) { + super(form); + this.body = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return macroexpand(invokeNode, env, body); + } + } + + static class ApplyNode extends MalNode { + final MalLanguage language; + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { + super(list); + this.language = language; + fnNode = formToNode(language, list.head, false); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @TruffleBoundary + private CallTarget applyMacro(MalEnv env, MalFunction fn) { + Object[] args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; ++i) { + args[i+1] = argNodes[i].form; + } + // We should never throw a tail call during expansion! + var result = macroexpand(invokeNode, env, form); + var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); + return Truffle.getRuntime().createCallTarget(newRoot); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + if (fn.isMacro) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var target = applyMacro(env, fn); + return invokeNode.invoke(target, new Object[] {}, false); + } else { + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args); + } + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + private final boolean macro; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.macro = MalSymbol.DEFMACRO.equals(list.head); + this.valueNode = formToNode(language, list.tail.tail.head, false); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + if (macro) { + value = new MalFunction((MalFunction)value, true); + } + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm, false); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a form to be evaluated, together with an environment. + */ + static class MalRootNode extends RootNode { + final Object form; + final MalEnv env; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, tailPosition); + this.env = env; + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame, env); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + conditionNode = formToNode(language, form.tail.head, false); + trueNode = formToNode(language, form.tail.tail.head, tailPosition); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var env = getCurrentContext(MalLanguage.class).globalEnv; + var root = new MalRootNode(this, form, env, false); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/step9_try.java b/impls/java-truffle/src/main/java/truffle/mal/step9_try.java new file mode 100644 index 0000000000..5abb11b668 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/step9_try.java @@ -0,0 +1,750 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class step9_try { + static final String LANGUAGE_ID = "mal_step9"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + context.eval(LANGUAGE_ID, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition); + } else if (MalSymbol.MACROEXPAND.equals(head)) { + return new MacroexpandNode(list); + } else if (MalSymbol.TRY.equals(head)) { + return new TryNode(language, list, tailPosition); + } else { + return new ApplyNode(language, list, tailPosition); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false); + nodes[i++] = formToNode(language, entry.getValue(), false); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException("'"+symbol+"' not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + return invoke(target, args, true); + } + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + while (true) { + try { + return callNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + private static MalFunction getMacroFn(MalEnv env, Object form) { + if (!(form instanceof MalList)) + return null; + MalList list = (MalList)form; + if (!(list.head instanceof MalSymbol)) + return null; + MalSymbol fnSym = (MalSymbol)list.head; + var obj = env.get(fnSym); + if (obj == null) + return null; + if (!(obj instanceof MalFunction)) + return null; + MalFunction fn = (MalFunction)obj; + return fn.isMacro ? fn : null; + } + + static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { + var fn = getMacroFn(env, form); + while (fn != null) { + MalList list = (MalList)form; + var args = new Object[(int)list.length]; + args[0] = fn.closedOverEnv; + int i=1; + list = list.tail; + while (!list.isEmpty()) { + args[i++] = list.head; + list = list.tail; + } + form = invokeNode.invoke(fn.callTarget, args, false); + fn = getMacroFn(env, form); + } + return form; + } + + static class MacroexpandNode extends MalNode { + @Child private InvokeNode invokeNode = new InvokeNode(false); + private final Object body; + + MacroexpandNode(MalList form) { + super(form); + this.body = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return macroexpand(invokeNode, env, body); + } + } + + static class ApplyNode extends MalNode { + final MalLanguage language; + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { + super(list); + this.language = language; + fnNode = formToNode(language, list.head, false); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @TruffleBoundary + private CallTarget applyMacro(MalEnv env, MalFunction fn) { + Object[] args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; ++i) { + args[i+1] = argNodes[i].form; + } + // We should never throw a tail call during expansion! + Object form = invokeNode.invoke(fn.callTarget, args, false); + var result = macroexpand(invokeNode, env, form); + var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); + return Truffle.getRuntime().createCallTarget(newRoot); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + if (fn.isMacro) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var target = applyMacro(env, fn); + return invokeNode.invoke(target, new Object[] {}, false); + } else { + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args); + } + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + private final boolean macro; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.macro = MalSymbol.DEFMACRO.equals(list.head); + this.valueNode = formToNode(language, list.tail.tail.head, false); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + if (macro) { + value = new MalFunction((MalFunction)value, true); + } + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm, false); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a form to be evaluated, together with an environment. + */ + static class MalRootNode extends RootNode { + final Object form; + final MalEnv env; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, tailPosition); + this.env = env; + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame, env); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + conditionNode = formToNode(language, form.tail.head, false); + trueNode = formToNode(language, form.tail.tail.head, tailPosition); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + static class TryNode extends MalNode { + @Child private MalNode tryBody; + @Child private MalNode catchBody; + final MalSymbol exSymbol; + + TryNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var tryForm = form.tail.head; + var catchForm = (MalList)form.tail.tail.head; + // We don't allow tail calls inside a try body, because + // they'd get thrown past the catch that should catch subsequent failures. + this.tryBody = formToNode(language, tryForm, false); + if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { + exSymbol = (MalSymbol)catchForm.tail.head; + catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition); + } else { + exSymbol = null; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + try { + return tryBody.executeGeneric(frame, env); + } catch (MalException ex) { + if (catchBody == null) { + throw ex; + } + var catchEnv = new MalEnv(env); + catchEnv.set(exSymbol, ex.obj); + return catchBody.executeGeneric(frame, catchEnv); + } + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var env = getCurrentContext(MalLanguage.class).globalEnv; + var root = new MalRootNode(this, form, env, false); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/stepA_mal.java b/impls/java-truffle/src/main/java/truffle/mal/stepA_mal.java new file mode 100644 index 0000000000..e4a45eabb6 --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/stepA_mal.java @@ -0,0 +1,757 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class stepA_mal { + static final String LANGUAGE_ID = "mal_stepA"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + context.eval(LANGUAGE_ID, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + @TruffleBoundary + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition); + } else if (MalSymbol.MACROEXPAND.equals(head)) { + return new MacroexpandNode(list); + } else if (MalSymbol.TRY.equals(head)) { + return new TryNode(language, list, tailPosition); + } else { + return new ApplyNode(language, list, tailPosition); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false); + nodes[i++] = formToNode(language, entry.getValue(), false); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException("'"+symbol+"' not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + return invoke(target, args, true); + } + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + while (true) { + try { + return callNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + private static MalFunction getMacroFn(MalEnv env, Object form) { + if (!(form instanceof MalList)) + return null; + MalList list = (MalList)form; + if (!(list.head instanceof MalSymbol)) + return null; + MalSymbol fnSym = (MalSymbol)list.head; + var obj = env.get(fnSym); + if (obj == null) + return null; + if (!(obj instanceof MalFunction)) + return null; + MalFunction fn = (MalFunction)obj; + return fn.isMacro ? fn : null; + } + + static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { + var fn = getMacroFn(env, form); + while (fn != null) { + MalList list = (MalList)form; + var args = new Object[(int)list.length]; + args[0] = fn.closedOverEnv; + int i=1; + list = list.tail; + while (!list.isEmpty()) { + args[i++] = list.head; + list = list.tail; + } + form = invokeNode.invoke(fn.callTarget, args, false); + fn = getMacroFn(env, form); + } + return form; + } + + static class MacroexpandNode extends MalNode { + @Child private InvokeNode invokeNode = new InvokeNode(false); + private final Object body; + + MacroexpandNode(MalList form) { + super(form); + this.body = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return macroexpand(invokeNode, env, body); + } + } + + static class ApplyNode extends MalNode { + final MalLanguage language; + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { + super(list); + this.language = language; + fnNode = formToNode(language, list.head, false); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @TruffleBoundary + private CallTarget applyMacro(MalEnv env, MalFunction fn) { + Object[] args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; ++i) { + args[i+1] = argNodes[i].form; + } + // We should never throw a tail call during expansion! + Object form = invokeNode.invoke(fn.callTarget, args, false); + var result = macroexpand(invokeNode, env, form); + var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); + return Truffle.getRuntime().createCallTarget(newRoot); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + if (fn.isMacro) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var target = applyMacro(env, fn); + return invokeNode.invoke(target, new Object[] {}, false); + } else { + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args); + } + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + private final boolean macro; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.macro = MalSymbol.DEFMACRO.equals(list.head); + this.valueNode = formToNode(language, list.tail.tail.head, false); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + if (macro) { + value = new MalFunction((MalFunction)value, true); + } + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm, false); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a form to be evaluated, together with an environment. + */ + static class MalRootNode extends RootNode { + final Object form; + final MalEnv env; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, tailPosition); + this.env = env; + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame, env); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + conditionNode = formToNode(language, form.tail.head, false); + trueNode = formToNode(language, form.tail.tail.head, tailPosition); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + + @Override + public String toString() { + return form.toString(); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + static class TryNode extends MalNode { + @Child private MalNode tryBody; + @Child private MalNode catchBody; + final MalSymbol exSymbol; + + TryNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var tryForm = form.tail.head; + var catchForm = (MalList)form.tail.tail.head; + // We don't allow tail calls inside a try body, because + // they'd get thrown past the catch that should catch subsequent failures. + this.tryBody = formToNode(language, tryForm, false); + if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { + exSymbol = (MalSymbol)catchForm.tail.head; + catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition); + } else { + exSymbol = null; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + try { + return tryBody.executeGeneric(frame, env); + } catch (MalException ex) { + if (catchBody == null) { + throw ex; + } + var catchEnv = new MalEnv(env); + catchEnv.set(exSymbol, ex.obj); + return catchBody.executeGeneric(frame, catchEnv); + } + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var env = getCurrentContext(MalLanguage.class).globalEnv; + var root = new MalRootNode(this, form, env, false); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/stepB_calls.java b/impls/java-truffle/src/main/java/truffle/mal/stepB_calls.java new file mode 100644 index 0000000000..60a5f8019b --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/stepB_calls.java @@ -0,0 +1,797 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives; +import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.DirectCallNode; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +public class stepB_calls { + static final String LANGUAGE_ID = "mal_stepB"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + context.eval(LANGUAGE_ID, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + @TruffleBoundary + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { + return new DefNode(language, list); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition); + } else if (MalSymbol.MACROEXPAND.equals(head)) { + return new MacroexpandNode(list); + } else if (MalSymbol.TRY.equals(head)) { + return new TryNode(language, list, tailPosition); + } else { + return new ApplyNode(language, list, tailPosition); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false); + nodes[i++] = formToNode(language, entry.getValue(), false); + } + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + + LookupNode(MalSymbol symbol) { + super(symbol); + this.symbol = symbol; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = env.get(symbol); + if (result == null) { + throw new MalException("'"+symbol+"' not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + @TruffleBoundary + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedTarget; + @CompilationFinal private CallTarget cachedTarget; + @CompilationFinal @Child private DirectCallNode directCallNode; + @CompilationFinal @Child private IndirectCallNode indirectCallNode; + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + return invoke(target, args, true); + } + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + usingCachedTarget = true; + cachedTarget = target; + directCallNode = Truffle.getRuntime().createDirectCallNode(target); + } + while (true) { + try { + if (usingCachedTarget) { + if (cachedTarget == target) { + return directCallNode.call(args); + } + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedTarget = false; + indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); + } + return indirectCallNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + private static MalFunction getMacroFn(MalEnv env, Object form) { + if (!(form instanceof MalList)) + return null; + MalList list = (MalList)form; + if (!(list.head instanceof MalSymbol)) + return null; + MalSymbol fnSym = (MalSymbol)list.head; + var obj = env.get(fnSym); + if (obj == null) + return null; + if (!(obj instanceof MalFunction)) + return null; + MalFunction fn = (MalFunction)obj; + return fn.isMacro ? fn : null; + } + + static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { + var fn = getMacroFn(env, form); + while (fn != null) { + MalList list = (MalList)form; + var args = new Object[(int)list.length]; + args[0] = fn.closedOverEnv; + int i=1; + list = list.tail; + while (!list.isEmpty()) { + args[i++] = list.head; + list = list.tail; + } + form = invokeNode.invoke(fn.callTarget, args, false); + fn = getMacroFn(env, form); + } + return form; + } + + static class MacroexpandNode extends MalNode { + @Child private InvokeNode invokeNode = new InvokeNode(false); + private final Object body; + + MacroexpandNode(MalList form) { + super(form); + this.body = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return macroexpand(invokeNode, env, body); + } + } + + static class ApplyNode extends MalNode { + final MalLanguage language; + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedFn; + @CompilationFinal private MalFunction cachedFn; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { + super(list); + this.language = language; + fnNode = formToNode(language, list.head, false); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @TruffleBoundary + private CallTarget applyMacro(MalEnv env, MalFunction fn) { + Object[] args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; ++i) { + args[i+1] = argNodes[i].form; + } + // We should never throw a tail call during expansion! + Object form = invokeNode.invoke(fn.callTarget, args, false); + var result = macroexpand(invokeNode, env, form); + var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); + return Truffle.getRuntime().createCallTarget(newRoot); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + cachedFn = fn; + usingCachedFn = true; + } + if (usingCachedFn) { + if (fn != cachedFn) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedFn = false; + } else { + fn = cachedFn; + } + } + if (fn.isMacro) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var target = applyMacro(env, fn); + return invokeNode.invoke(target, new Object[] {}, false); + } else { + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); + } + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + private final boolean macro; + @Child private MalNode valueNode; + + DefNode(MalLanguage language, MalList list) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.macro = MalSymbol.DEFMACRO.equals(list.head); + this.valueNode = formToNode(language, list.tail.tail.head, false); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + if (macro) { + value = new MalFunction((MalFunction)value, true); + } + env.set(symbol, value); + return value; + } + } + + static class LetBindingNode extends Node { + private final MalSymbol symbol; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { + this.symbol = symbol; + this.valueNode = formToNode(language, valueForm, false); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(symbol, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a form to be evaluated, together with an environment. + */ + static class MalRootNode extends RootNode { + final Object form; + final MalEnv env; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, tailPosition); + this.env = env; + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame, env); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + conditionNode = formToNode(language, form.tail.head, false); + trueNode = formToNode(language, form.tail.tail.head, tailPosition); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || val == Boolean.FALSE) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final MalSymbol symbol; + protected final int argPos; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos) { + this.symbol = symbol; + this.argPos = argPos; + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos) { + super(symbol, argPos); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(symbol, buildVarArgsList(frame.getArguments())); + } + } + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0]); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + + @Override + public String toString() { + return form.toString(); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form) { + super(form); + fnRoot = new FnRootNode(language, form); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + static class TryNode extends MalNode { + @Child private MalNode tryBody; + @Child private MalNode catchBody; + final MalSymbol exSymbol; + + TryNode(MalLanguage language, MalList form, boolean tailPosition) { + super(form); + var tryForm = form.tail.head; + var catchForm = (MalList)form.tail.tail.head; + // We don't allow tail calls inside a try body, because + // they'd get thrown past the catch that should catch subsequent failures. + this.tryBody = formToNode(language, tryForm, false); + if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { + exSymbol = (MalSymbol)catchForm.tail.head; + catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition); + } else { + exSymbol = null; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + try { + return tryBody.executeGeneric(frame, env); + } catch (MalException ex) { + if (catchBody == null) { + throw ex; + } + var catchEnv = new MalEnv(env); + catchEnv.set(exSymbol, ex.obj); + return catchBody.executeGeneric(frame, catchEnv); + } + } + } + + final static class MalContext { + final MalEnv globalEnv; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var env = getCurrentContext(MalLanguage.class).globalEnv; + var root = new MalRootNode(this, form, env, false); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/stepC_slots.java b/impls/java-truffle/src/main/java/truffle/mal/stepC_slots.java new file mode 100644 index 0000000000..a528bc7a0f --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/stepC_slots.java @@ -0,0 +1,848 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives; +import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.DirectCallNode; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +import truffle.mal.LexicalScope.EnvSlot; + +public class stepC_slots { + static final String LANGUAGE_ID = "mal_stepC"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + context.eval(LANGUAGE_ID, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + @TruffleBoundary + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition, LexicalScope scope) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form, scope); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form, scope); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form, scope); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { + return new DefNode(language, list, scope); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition, scope); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition, scope); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition, scope); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list, scope); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition, scope); + } else if (MalSymbol.MACROEXPAND.equals(head)) { + return new MacroexpandNode(list); + } else if (MalSymbol.TRY.equals(head)) { + return new TryNode(language, list, tailPosition, scope); + } else { + return new ApplyNode(language, list, tailPosition, scope); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector, LexicalScope scope) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false, scope); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map, LexicalScope scope) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false, scope); + nodes[i++] = formToNode(language, entry.getValue(), false, scope); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + var k = nodes[i].executeGeneric(frame, env); + var v = nodes[i+1].executeGeneric(frame, env); + result = result.assoc(k, v); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + private final LexicalScope scope; + @CompilationFinal boolean initialized = false; + @CompilationFinal EnvSlot slot; + + LookupNode(MalSymbol symbol, LexicalScope scope) { + super(symbol); + this.symbol = symbol; + this.scope = scope; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + slot = scope.getSlot(env, symbol); + } + Object result = null; + if (slot != null) { + if (slot.notDynamicallyBound.isValid()) { + result = env.get(slot); + } else { + result = env.get(symbol, slot); + } + } else { + result = env.get(symbol); + } + if (result == null) { + throw new MalException("'"+symbol.symbol+"' not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedTarget; + @CompilationFinal private CallTarget cachedTarget; + @CompilationFinal @Child private DirectCallNode directCallNode; + @CompilationFinal @Child private IndirectCallNode indirectCallNode; + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + return invoke(target, args, true); + } + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + usingCachedTarget = true; + cachedTarget = target; + directCallNode = Truffle.getRuntime().createDirectCallNode(target); + } + while (true) { + try { + if (usingCachedTarget) { + if (cachedTarget == target) { + return directCallNode.call(args); + } + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedTarget = false; + indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); + } + return indirectCallNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + private static MalFunction getMacroFn(MalEnv env, Object form) { + if (!(form instanceof MalList)) + return null; + MalList list = (MalList)form; + if (!(list.head instanceof MalSymbol)) + return null; + MalSymbol fnSym = (MalSymbol)list.head; + var obj = env.get(fnSym); + if (obj == null) + return null; + if (!(obj instanceof MalFunction)) + return null; + MalFunction fn = (MalFunction)obj; + return fn.isMacro ? fn : null; + } + + static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { + var fn = getMacroFn(env, form); + while (fn != null) { + MalList list = (MalList)form; + var args = new Object[(int)list.length]; + args[0] = fn.closedOverEnv; + int i=1; + list = list.tail; + while (!list.isEmpty()) { + args[i++] = list.head; + list = list.tail; + } + form = invokeNode.invoke(fn.callTarget, args, false); + fn = getMacroFn(env, form); + } + return form; + } + + static class MacroexpandNode extends MalNode { + @Child private InvokeNode invokeNode = new InvokeNode(false); + private final Object body; + + MacroexpandNode(MalList form) { + super(form); + this.body = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return macroexpand(invokeNode, env, body); + } + } + + static class ApplyNode extends MalNode { + final MalLanguage language; + final LexicalScope scope; + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedFn; + @CompilationFinal private MalFunction cachedFn; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition, LexicalScope scope) { + super(list); + this.language = language; + this.scope = scope; + fnNode = formToNode(language, list.head, false, scope); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false, scope); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @TruffleBoundary + private CallTarget applyMacro(MalEnv env, MalFunction fn) { + Object[] args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; ++i) { + args[i+1] = argNodes[i].form; + } + // We should never throw a tail call during expansion! + Object form = invokeNode.invoke(fn.callTarget, args, false); + var result = macroexpand(invokeNode, env, form); + var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition, scope); + return Truffle.getRuntime().createCallTarget(newRoot); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + cachedFn = fn; + usingCachedFn = true; + } + if (usingCachedFn) { + if (fn != cachedFn) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedFn = false; + } else { + fn = cachedFn; + } + } + if (fn.isMacro) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var target = applyMacro(env, fn); + return invokeNode.invoke(target, new Object[] {}, false); + } else { + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); + } + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + private final boolean macro; + private final LexicalScope scope; + @Child private MalNode valueNode; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private EnvSlot slot; + + DefNode(MalLanguage language, MalList list, LexicalScope scope) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.macro = MalSymbol.DEFMACRO.equals(list.head); + this.scope = scope; + this.valueNode = formToNode(language, list.tail.tail.head, false, scope); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + if (macro) { + value = new MalFunction((MalFunction)value, true); + } + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + var slot = scope.getSlot(env, symbol); + if (slot != null && slot.height == 0) { + this.slot = slot; + } + } + if (slot != null) { + env.set(slot, value); + } else { + env.set(symbol, value); + } + return value; + } + } + + static class LetBindingNode extends Node { + private final EnvSlot slot; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm, LexicalScope scope) { + this.slot = scope.allocateSlot(symbol); + this.valueNode = formToNode(language, valueForm, false, scope); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(slot, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + private final LexicalScope scope; + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope outerScope) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + scope = new LexicalScope(outerScope); + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1), scope); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition, scope); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv, scope); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a form to be evaluated, together with an environment. + */ + static class MalRootNode extends RootNode { + final Object form; + final MalEnv env; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition, LexicalScope scope) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, tailPosition, scope); + this.env = env; + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame, env); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1, scope); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + conditionNode = formToNode(language, form.tail.head, false, scope); + trueNode = formToNode(language, form.tail.tail.head, tailPosition, scope); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition, scope); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final int argPos; + protected final EnvSlot slot; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { + this.argPos = argPos; + this.slot = scope.allocateSlot(symbol); + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { + super(symbol, argPos, scope); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(slot, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos, LexicalScope scope) { + super(symbol, argPos, scope); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(slot, buildVarArgsList(frame.getArguments())); + } + } + + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + final LexicalScope scope; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form, LexicalScope outerScope) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + this.scope = new LexicalScope(outerScope); + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1, scope); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1, scope); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true, scope); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0], scope); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + + @Override + public String toString() { + return form.toString(); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form, LexicalScope scope) { + super(form); + fnRoot = new FnRootNode(language, form, scope); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + static class TryNode extends MalNode { + @Child private MalNode tryBody; + @Child private MalNode catchBody; + final EnvSlot exSlot; + final LexicalScope catchScope; + + TryNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + var tryForm = form.tail.head; + var catchForm = (MalList)form.tail.tail.head; + // We don't allow tail calls inside a try body, because + // they'd get thrown past the catch that should catch subsequent failures. + this.tryBody = formToNode(language, tryForm, false, scope); + if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { + catchScope = new LexicalScope(scope); + var exSymbol = (MalSymbol)catchForm.tail.head; + exSlot = catchScope.allocateSlot(exSymbol); + catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition, catchScope); + } else { + catchScope = null; + exSlot = null; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + try { + return tryBody.executeGeneric(frame, env); + } catch (MalException ex) { + if (catchBody == null) { + throw ex; + } + var catchEnv = new MalEnv(env, catchScope); + catchEnv.set(exSlot, ex.obj); + return catchBody.executeGeneric(frame, catchEnv); + } + } + } + + final static class MalContext { + final MalEnv globalEnv; + final LexicalScope globalScope; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + globalScope = new LexicalScope(); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var ctx = getCurrentContext(MalLanguage.class); + var root = new MalRootNode(this, form, ctx.globalEnv, false, ctx.globalScope); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/stepD_caching.java b/impls/java-truffle/src/main/java/truffle/mal/stepD_caching.java new file mode 100644 index 0000000000..28d5c2a36a --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/stepD_caching.java @@ -0,0 +1,860 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.Assumption; +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives; +import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.DirectCallNode; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +import truffle.mal.LexicalScope.EnvSlot; +import truffle.mal.MalEnv.CachedResult; + +public class stepD_caching { + static final String LANGUAGE_ID = "mal_stepD"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + context.eval(LANGUAGE_ID, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + @TruffleBoundary + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition, LexicalScope scope) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form, scope); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form, scope); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form, scope); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { + return new DefNode(language, list, scope); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition, scope); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition, scope); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition, scope); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list, scope); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition, scope); + } else if (MalSymbol.MACROEXPAND.equals(head)) { + return new MacroexpandNode(list); + } else if (MalSymbol.TRY.equals(head)) { + return new TryNode(language, list, tailPosition, scope); + } else { + return new ApplyNode(language, list, tailPosition, scope); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector, LexicalScope scope) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false, scope); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new ArrayList<>(elementNodes.length); + for (int i=0; i < elementNodes.length; i++) { + elements.add(elementNodes[i].executeGeneric(frame, env)); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map, LexicalScope scope) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false, scope); + nodes[i++] = formToNode(language, entry.getValue(), false, scope); + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + var k = nodes[i].executeGeneric(frame, env); + var v = nodes[i+1].executeGeneric(frame, env); + result = result.assoc(k, v); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + private final LexicalScope scope; + @CompilationFinal boolean initialized = false; + @CompilationFinal EnvSlot slot; + @CompilationFinal CachedResult cachedResult; + @CompilationFinal Assumption notRedefined; + + LookupNode(MalSymbol symbol, LexicalScope scope) { + super(symbol); + this.symbol = symbol; + this.scope = scope; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + slot = scope.getSlot(env, symbol); + if (slot == null) { + cachedResult = env.cachedGet(symbol); + notRedefined = cachedResult.notRedefined; + } + } + Object result = null; + if (slot != null) { + if (slot.notDynamicallyBound.isValid()) { + result = env.get(slot); + } else { + result = env.get(symbol, slot); + } + } else { + if (notRedefined.isValid()) { + result = cachedResult.result; + } else { + result = env.get(symbol); + } + } + if (result == null) { + throw new MalException("'"+symbol.symbol+"' not found"); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedTarget; + @CompilationFinal private CallTarget cachedTarget; + @CompilationFinal @Child private DirectCallNode directCallNode; + @CompilationFinal @Child private IndirectCallNode indirectCallNode; + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + return invoke(target, args, true); + } + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + usingCachedTarget = true; + cachedTarget = target; + directCallNode = Truffle.getRuntime().createDirectCallNode(target); + } + while (true) { + try { + if (usingCachedTarget) { + if (cachedTarget == target) { + return directCallNode.call(args); + } + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedTarget = false; + indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); + } + return indirectCallNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + private static MalFunction getMacroFn(MalEnv env, Object form) { + if (!(form instanceof MalList)) + return null; + MalList list = (MalList)form; + if (!(list.head instanceof MalSymbol)) + return null; + MalSymbol fnSym = (MalSymbol)list.head; + var obj = env.get(fnSym); + if (obj == null) + return null; + if (!(obj instanceof MalFunction)) + return null; + MalFunction fn = (MalFunction)obj; + return fn.isMacro ? fn : null; + } + + static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { + var fn = getMacroFn(env, form); + while (fn != null) { + MalList list = (MalList)form; + var args = new Object[(int)list.length]; + args[0] = fn.closedOverEnv; + int i=1; + list = list.tail; + while (!list.isEmpty()) { + args[i++] = list.head; + list = list.tail; + } + form = invokeNode.invoke(fn.callTarget, args, false); + fn = getMacroFn(env, form); + } + return form; + } + + static class MacroexpandNode extends MalNode { + @Child private InvokeNode invokeNode = new InvokeNode(false); + private final Object body; + + MacroexpandNode(MalList form) { + super(form); + this.body = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return macroexpand(invokeNode, env, body); + } + } + + static class ApplyNode extends MalNode { + final MalLanguage language; + final LexicalScope scope; + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedFn; + @CompilationFinal private MalFunction cachedFn; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition, LexicalScope scope) { + super(list); + this.language = language; + this.scope = scope; + fnNode = formToNode(language, list.head, false, scope); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false, scope); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @TruffleBoundary + private CallTarget applyMacro(MalEnv env, MalFunction fn) { + Object[] args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; ++i) { + args[i+1] = argNodes[i].form; + } + // We should never throw a tail call during expansion! + Object form = invokeNode.invoke(fn.callTarget, args, false); + var result = macroexpand(invokeNode, env, form); + var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition, scope); + return Truffle.getRuntime().createCallTarget(newRoot); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + cachedFn = fn; + usingCachedFn = true; + } + if (usingCachedFn) { + if (fn != cachedFn) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedFn = false; + } else { + fn = cachedFn; + } + } + if (fn.isMacro) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var target = applyMacro(env, fn); + return invokeNode.invoke(target, new Object[] {}, false); + } else { + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); + } + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + private final boolean macro; + private final LexicalScope scope; + @Child private MalNode valueNode; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private EnvSlot slot; + + DefNode(MalLanguage language, MalList list, LexicalScope scope) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.macro = MalSymbol.DEFMACRO.equals(list.head); + this.scope = scope; + this.valueNode = formToNode(language, list.tail.tail.head, false, scope); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + if (macro) { + value = new MalFunction((MalFunction)value, true); + } + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + var slot = scope.getSlot(env, symbol); + if (slot != null && slot.height == 0) { + this.slot = slot; + } + } + if (slot != null) { + env.set(slot, value); + } else { + env.set(symbol, value); + } + return value; + } + } + + static class LetBindingNode extends Node { + private final EnvSlot slot; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm, LexicalScope scope) { + this.slot = scope.allocateSlot(symbol); + this.valueNode = formToNode(language, valueForm, false, scope); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(slot, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + private final LexicalScope scope; + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope outerScope) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + scope = new LexicalScope(outerScope); + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1), scope); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition, scope); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv, scope); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a form to be evaluated, together with an environment. + */ + static class MalRootNode extends RootNode { + final Object form; + final MalEnv env; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition, LexicalScope scope) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, tailPosition, scope); + this.env = env; + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame, env); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1, scope); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + conditionNode = formToNode(language, form.tail.head, false, scope); + trueNode = formToNode(language, form.tail.tail.head, tailPosition, scope); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition, scope); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final int argPos; + protected final EnvSlot slot; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { + this.argPos = argPos; + this.slot = scope.allocateSlot(symbol); + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { + super(symbol, argPos, scope); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(slot, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos, LexicalScope scope) { + super(symbol, argPos, scope); + } + + @TruffleBoundary + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(slot, buildVarArgsList(frame.getArguments())); + } + } + + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + final LexicalScope scope; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form, LexicalScope outerScope) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + this.scope = new LexicalScope(outerScope); + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1, scope); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1, scope); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true, scope); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0], scope); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + + @Override + public String toString() { + return form.toString(); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form, LexicalScope scope) { + super(form); + fnRoot = new FnRootNode(language, form, scope); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + static class TryNode extends MalNode { + @Child private MalNode tryBody; + @Child private MalNode catchBody; + final EnvSlot exSlot; + final LexicalScope catchScope; + + TryNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + var tryForm = form.tail.head; + var catchForm = (MalList)form.tail.tail.head; + // We don't allow tail calls inside a try body, because + // they'd get thrown past the catch that should catch subsequent failures. + this.tryBody = formToNode(language, tryForm, false, scope); + if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { + catchScope = new LexicalScope(scope); + var exSymbol = (MalSymbol)catchForm.tail.head; + exSlot = catchScope.allocateSlot(exSymbol); + catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition, catchScope); + } else { + catchScope = null; + exSlot = null; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + try { + return tryBody.executeGeneric(frame, env); + } catch (MalException ex) { + if (catchBody == null) { + throw ex; + } + var catchEnv = new MalEnv(env, catchScope); + catchEnv.set(exSlot, ex.obj); + return catchBody.executeGeneric(frame, catchEnv); + } + } + } + + final static class MalContext { + final MalEnv globalEnv; + final LexicalScope globalScope; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + globalScope = new LexicalScope(); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var ctx = getCurrentContext(MalLanguage.class); + var root = new MalRootNode(this, form, ctx.globalEnv, false, ctx.globalScope); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java-truffle/src/main/java/truffle/mal/stepE_macros.java b/impls/java-truffle/src/main/java/truffle/mal/stepE_macros.java new file mode 100644 index 0000000000..b0f7f5202a --- /dev/null +++ b/impls/java-truffle/src/main/java/truffle/mal/stepE_macros.java @@ -0,0 +1,905 @@ +package truffle.mal; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.PrintStream; +import java.util.ArrayList; +import java.util.Collections; +import java.util.function.Function; + +import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotException; +import org.graalvm.polyglot.Value; + +import com.oracle.truffle.api.Assumption; +import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.CompilerDirectives; +import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.Scope; +import com.oracle.truffle.api.Truffle; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.FrameDescriptor; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.nodes.ControlFlowException; +import com.oracle.truffle.api.nodes.DirectCallNode; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.nodes.Node; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.nodes.UnexpectedResultException; +import com.oracle.truffle.api.source.Source; + +import truffle.mal.LexicalScope.EnvSlot; +import truffle.mal.MalEnv.CachedResult; + +public class stepE_macros { + static final String LANGUAGE_ID = "mal_stepE"; + + public static void main(String[] args) throws IOException { + boolean done = false; + BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); + + var context = Context.create(LANGUAGE_ID); + context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); + context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + context.eval(LANGUAGE_ID, "(defmacro! cond ^{:inline? true} (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); + + var buf = new StringBuilder(); + buf.append("(def! *ARGV* (list"); + for (int i=1; i < args.length; i++) { + buf.append(' '); + buf.append(Printer.prStr(args[i], true)); + } + buf.append("))"); + context.eval(LANGUAGE_ID, buf.toString()); + + if (args.length > 0) { + context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); + return; + } + + while (!done) { + System.out.print("user> "); + String s = reader.readLine(); + if (s == null) { + done = true; + } else { + try { + Value val = context.eval(LANGUAGE_ID, s); + context.getBindings(LANGUAGE_ID).putMember("*1", val); + context.eval(LANGUAGE_ID, "(prn *1)"); + } catch (PolyglotException ex) { + if (ex.isGuestException()) { + System.out.println("Error: "+ex.getMessage()); + } else { + throw ex; + } + } + } + } + } + + static class BuiltinFn implements TruffleObject { + final Function fn; + BuiltinFn(Function fn) { + this.fn = fn; + } + } + + static abstract class MalNode extends Node { + final Object form; + protected MalNode(Object form) { + this.form = form; + } + + public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); + + public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Long) { + return (long)value; + } + throw new UnexpectedResultException(value); + } + + public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { + var value = executeGeneric(frame, env); + if (value instanceof Boolean) { + return (boolean)value; + } + throw new UnexpectedResultException(value); + } + } + + private static boolean isPair(Object obj) { + return (obj instanceof MalList && ((MalList)obj).length > 0) + || + (obj instanceof MalVector && ((MalVector)obj).size() > 0); + } + + private static Object quasiquote(Object form) { + if (!isPair(form)) { + return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); + } + MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; + if (MalSymbol.UNQUOTE.equals(list.head)) { + return list.tail.head; + } + var result = new ArrayList(); + if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { + result.add(MalSymbol.get("concat")); + result.add(((MalList)list.head).tail.head); + } else { + result.add(MalSymbol.get("cons")); + result.add(quasiquote(list.head)); + } + result.add(quasiquote(list.tail)); + return MalList.from(result); + } + + @TruffleBoundary + private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition, LexicalScope scope) { + if (form instanceof MalSymbol) { + return new LookupNode((MalSymbol)form, scope); + } else if (form instanceof MalVector) { + return new VectorNode(language, (MalVector)form, scope); + } else if (form instanceof MalMap) { + return new MapNode(language, (MalMap)form, scope); + } else if (form instanceof MalList && !((MalList)form).isEmpty()) { + var list = (MalList)form; + var head = list.head; + if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { + return new DefNode(language, list, scope); + } else if (MalSymbol.LET_STAR.equals(head)) { + return new LetNode(language, list, tailPosition, scope); + } else if (MalSymbol.DO.equals(head)) { + return new DoNode(language, list, tailPosition, scope); + } else if (MalSymbol.IF.equals(head)) { + return new IfNode(language, list, tailPosition, scope); + } else if (MalSymbol.FN_STAR.equals(head)) { + return new FnNode(language, list, scope); + } else if (MalSymbol.QUOTE.equals(head)) { + return new QuoteNode(language, list); + } else if (MalSymbol.QUASIQUOTE.equals(head)) { + return formToNode(language, quasiquote(list.tail.head), tailPosition, scope); + } else if (MalSymbol.MACROEXPAND.equals(head)) { + return new MacroexpandNode(list); + } else if (MalSymbol.TRY.equals(head)) { + return new TryNode(language, list, tailPosition, scope); + } else { + return new ApplyNode(language, list, tailPosition, scope); + } + } else { + return new LiteralNode(form); + } + } + + static class LiteralNode extends MalNode { + LiteralNode(Object form) { + super(form); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return form; + } + } + + static class VectorNode extends MalNode { + @Children private MalNode[] elementNodes; + + VectorNode(MalLanguage language, MalVector vector, LexicalScope scope) { + super(vector); + this.elementNodes = new MalNode[vector.size()]; + for (int i=0; i < vector.size(); i++) { + elementNodes[i] = formToNode(language, vector.get(i), false, scope); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var elements = new Object[elementNodes.length]; + for (int i=0; i < elementNodes.length; i++) { + elements[i] = elementNodes[i].executeGeneric(frame, env); + } + return MalVector.EMPTY.concat(elements); + } + } + + static class MapNode extends MalNode { + @Children private MalNode[] nodes; + MapNode(MalLanguage language, MalMap map, LexicalScope scope) { + super(map); + nodes = new MalNode[map.map.size()*2]; + int i=0; + for (var entry : map.map) { + nodes[i++] = formToNode(language, entry.getKey(), false, scope); + nodes[i++] = formToNode(language, entry.getValue(), false, scope); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var result = MalMap.EMPTY; + for (int i=0; i < nodes.length; i += 2) { + var k = nodes[i].executeGeneric(frame, env); + var v = nodes[i+1].executeGeneric(frame, env); + result = result.assoc(k, v); + } + return result; + } + } + + static class LookupNode extends MalNode { + private final MalSymbol symbol; + private final LexicalScope scope; + @CompilationFinal boolean initialized = false; + @CompilationFinal EnvSlot slot; + @CompilationFinal CachedResult cachedResult; + @CompilationFinal Assumption notRedefined; + + LookupNode(MalSymbol symbol, LexicalScope scope) { + super(symbol); + this.symbol = symbol; + this.scope = scope; + } + + @TruffleBoundary + private void throwNotFound() { + throw new MalException("'"+symbol.symbol+"' not found"); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + slot = scope.getSlot(env, symbol); + if (slot == null) { + cachedResult = env.cachedGet(symbol); + notRedefined = cachedResult.notRedefined; + } + } + Object result = null; + if (slot != null) { + if (slot.notDynamicallyBound.isValid()) { + result = env.get(slot); + } else { + result = env.get(symbol, slot); + } + } else { + if (notRedefined.isValid()) { + result = cachedResult.result; + } else { + result = env.get(symbol); + } + } + if (result == null) { + throwNotFound(); + } + return result; + } + } + + @SuppressWarnings("serial") + static class TailCallException extends ControlFlowException { + final CallTarget callTarget; + final Object[] args; + TailCallException(CallTarget target, Object[] args) { + this.callTarget = target; + this.args = args; + } + } + + static class InvokeNode extends AbstractInvokeNode { + final boolean tailPosition; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedTarget; + @CompilationFinal private CallTarget cachedTarget; + @CompilationFinal @Child private DirectCallNode directCallNode; + @CompilationFinal @Child private IndirectCallNode indirectCallNode; + + InvokeNode(boolean tailPosition) { + this.tailPosition = tailPosition; + } + + Object invoke(CallTarget target, Object[] args) { + return invoke(target, args, true); + } + + Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { + if (tailPosition && allowTailCall) { + throw new TailCallException(target, args); + } else { + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + usingCachedTarget = true; + cachedTarget = target; + directCallNode = Truffle.getRuntime().createDirectCallNode(target); + } + while (true) { + try { + if (usingCachedTarget) { + if (cachedTarget == target) { + return directCallNode.call(args); + } + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedTarget = false; + indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); + } + return indirectCallNode.call(target, args); + } catch (TailCallException ex) { + target = ex.callTarget; + args = ex.args; + } + } + } + } + } + + private static MalFunction getMacroFn(MalEnv env, Object form) { + if (!(form instanceof MalList)) + return null; + MalList list = (MalList)form; + if (!(list.head instanceof MalSymbol)) + return null; + MalSymbol fnSym = (MalSymbol)list.head; + var obj = env.get(fnSym); + if (obj == null) + return null; + if (!(obj instanceof MalFunction)) + return null; + MalFunction fn = (MalFunction)obj; + return fn.isMacro ? fn : null; + } + + static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { + var fn = getMacroFn(env, form); + while (fn != null) { + MalList list = (MalList)form; + var args = new Object[(int)list.length]; + args[0] = fn.closedOverEnv; + int i=1; + list = list.tail; + while (!list.isEmpty()) { + args[i++] = list.head; + list = list.tail; + } + form = invokeNode.invoke(fn.callTarget, args, false); + fn = getMacroFn(env, form); + } + return form; + } + + static class MacroexpandNode extends MalNode { + @Child private InvokeNode invokeNode = new InvokeNode(false); + private final Object body; + + MacroexpandNode(MalList form) { + super(form); + this.body = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return macroexpand(invokeNode, env, body); + } + } + + private static boolean isInlinableMacro(MalFunction fn) { + var meta = fn.getMeta(); + if (meta == null || !(meta instanceof MalMap)) + return false; + var inline = ((MalMap)meta).get(MalKeyword.INLINE_Q); + return Boolean.TRUE.equals(inline); + } + + static class InlinedMacroNode extends MalNode { + @Child private DirectCallNode node; + InlinedMacroNode(Object form, CallTarget target) { + super(form); + node = Truffle.getRuntime().createDirectCallNode(target); + } + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return node.call(); + } + } + + static class ApplyNode extends MalNode { + final MalLanguage language; + final LexicalScope scope; + @Child private MalNode fnNode; + @Children private MalNode[] argNodes; + @Child private InvokeNode invokeNode; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private boolean usingCachedFn; + @CompilationFinal private MalFunction cachedFn; + + ApplyNode(MalLanguage language, MalList list, boolean tailPosition, LexicalScope scope) { + super(list); + this.language = language; + this.scope = scope; + fnNode = formToNode(language, list.head, false, scope); + argNodes = new MalNode[list.length-1]; + int i=0; + list = list.tail; + while (!list.isEmpty()) { + argNodes[i++] = formToNode(language, list.head, false, scope); + list = list.tail; + } + invokeNode = new InvokeNode(tailPosition); + } + + @TruffleBoundary + private MalRootNode applyMacro(MalEnv env, MalFunction fn) { + Object[] args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; ++i) { + args[i+1] = argNodes[i].form; + } + // We should never throw a tail call during expansion! + Object form = invokeNode.invoke(fn.callTarget, args, false); + var result = macroexpand(invokeNode, env, form); + return new MalRootNode(language, result, env, invokeNode.tailPosition, scope); + } + + @TruffleBoundary + private Object invokeMacro(MalRootNode macroNode) { + // Mal's macro semantics are... interesting. To preserve them in the + // general case, we must re-expand a macro each time it's applied. + // Executing the result means turning it into a Truffle AST, creating + // a CallTarget, calling it, and then throwing it away. + // This is TERRIBLE for performance! Truffle should not be used like this! + var target = Truffle.getRuntime().createCallTarget(macroNode); + return invokeNode.invoke(target, new Object[] {}, false); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var fn = (MalFunction)fnNode.executeGeneric(frame, env); + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + cachedFn = fn; + usingCachedFn = true; + } + if (usingCachedFn) { + if (fn != cachedFn) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + usingCachedFn = false; + } else { + fn = cachedFn; + } + } + if (fn.isMacro) { + var expanded = applyMacro(env, fn); + if (isInlinableMacro(fn)) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + var newNode = expanded.body; + this.replace(newNode); + return newNode.executeGeneric(frame, env); + } else { + return invokeMacro(expanded); + } + } else { + var args = new Object[argNodes.length+1]; + args[0] = fn.closedOverEnv; + for (int i=0; i < argNodes.length; i++) { + args[i+1] = argNodes[i].executeGeneric(frame, env); + } + return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); + } + } + } + + static class DefNode extends MalNode { + private final MalSymbol symbol; + private final boolean macro; + private final LexicalScope scope; + @Child private MalNode valueNode; + @CompilationFinal private boolean initialized = false; + @CompilationFinal private EnvSlot slot; + + DefNode(MalLanguage language, MalList list, LexicalScope scope) { + super(list); + this.symbol = (MalSymbol)list.tail.head; + this.macro = MalSymbol.DEFMACRO.equals(list.head); + this.scope = scope; + this.valueNode = formToNode(language, list.tail.tail.head, false, scope); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var value = valueNode.executeGeneric(frame, env); + if (macro) { + value = new MalFunction((MalFunction)value, true); + } + if (!initialized) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + initialized = true; + var slot = scope.getSlot(env, symbol); + if (slot != null && slot.height == 0) { + this.slot = slot; + } + } + if (slot != null) { + env.set(slot, value); + } else { + env.set(symbol, value); + } + return value; + } + } + + static class LetBindingNode extends Node { + private final EnvSlot slot; + @Child private MalNode valueNode; + + LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm, LexicalScope scope) { + this.slot = scope.allocateSlot(symbol); + this.valueNode = formToNode(language, valueForm, false, scope); + } + + public void executeGeneric(VirtualFrame frame, MalEnv env) { + env.set(slot, valueNode.executeGeneric(frame, env)); + } + } + + static class LetNode extends MalNode { + private final LexicalScope scope; + @Children private LetBindingNode[] bindings; + @Child private MalNode bodyNode; + + LetNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope outerScope) { + super(form); + var bindingForms = new ArrayList(); + assert form.tail.head instanceof Iterable; + ((Iterable)form.tail.head).forEach(bindingForms::add); + bindings = new LetBindingNode[bindingForms.size()/2]; + scope = new LexicalScope(outerScope); + for (int i=0; i < bindingForms.size(); i+=2) { + bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1), scope); + } + bodyNode = formToNode(language, form.tail.tail.head, tailPosition, scope); + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { + var innerEnv = new MalEnv(outerEnv, scope); + for (int i=0; i < bindings.length; i++) { + bindings[i].executeGeneric(frame, innerEnv); + } + return bodyNode.executeGeneric(frame, innerEnv); + } + } + + /** + * Represents a form to be evaluated, together with an environment. + */ + static class MalRootNode extends RootNode { + final Object form; + final MalEnv env; + @Child MalNode body; + + MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition, LexicalScope scope) { + super(language, new FrameDescriptor()); + this.form = form; + // There's no stack to unwind at the top level, so + // a top-level form is never in tail position. + this.body = formToNode(language, form, tailPosition, scope); + this.env = env; + } + + @Override + public Object execute(VirtualFrame frame) { + return body.executeGeneric(frame, env); + } + + @Override + public String toString() { + return Printer.prStr(form, true); + } + } + + static class DoNode extends MalNode { + @Children private MalNode[] bodyNodes; + + DoNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + bodyNodes = new MalNode[form.length-1]; + int i = 0; + for (var f : form.tail) { + bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1, scope); + } + } + + @ExplodeLoop + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + if (bodyNodes.length == 0) { + return MalNil.NIL; + } + + for (int i=0; i < bodyNodes.length-1; i++) { + bodyNodes[i].executeGeneric(frame, env); + } + return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); + } + } + + static class IfNode extends MalNode { + @Child private MalNode conditionNode; + @Child private MalNode trueNode; + @Child private MalNode falseNode; + + IfNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + conditionNode = formToNode(language, form.tail.head, false, scope); + trueNode = formToNode(language, form.tail.tail.head, tailPosition, scope); + var falseForm = form.tail.tail.tail.head; + falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition, scope); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + var val = conditionNode.executeGeneric(frame, env); + if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { + if (falseNode == null) { + return MalNil.NIL; + } else { + return falseNode.executeGeneric(frame, env); + } + } else { + return trueNode.executeGeneric(frame, env); + } + } + } + + static abstract class AbstractBindArgNode extends Node { + protected final int argPos; + protected final EnvSlot slot; + + protected AbstractBindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { + this.argPos = argPos; + this.slot = scope.allocateSlot(symbol); + } + + public abstract void execute(VirtualFrame frame, MalEnv env); + } + + static class BindArgNode extends AbstractBindArgNode { + + public BindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { + super(symbol, argPos, scope); + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + env.set(slot, frame.getArguments()[argPos]); + } + } + + static class BindVarargsNode extends BindArgNode { + public BindVarargsNode(MalSymbol symbol, int argPos, LexicalScope scope) { + super(symbol, argPos, scope); + } + + private MalList buildVarArgsList(Object[] args) { + MalList varArgs = MalList.EMPTY; + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + return varArgs; + } + + @Override + public void execute(VirtualFrame frame, MalEnv env) { + //env.set(slot, buildVarArgsList(frame.getArguments())); + MalList varArgs = MalList.EMPTY; + var args = frame.getArguments(); + for (int i=args.length-1; i >= argPos; --i) { + varArgs = varArgs.cons(args[i]); + } + //env.set(slot, varArgs); + env.staticBindings[slot.slotNum] = varArgs; + } + } + + /** + * Root node of a user-defined function, responsible for managing + * the environment when the function is invoked. + */ + static class FnRootNode extends RootNode { + final MalList form; + final int numArgs; + final LexicalScope scope; + @Children AbstractBindArgNode[] bindNodes; + @Child MalNode bodyNode; + + FnRootNode(MalLanguage language, MalList form, LexicalScope outerScope) { + super(language, new FrameDescriptor()); + this.form = form; + var argNamesList = new ArrayList(); + assert form.tail.head instanceof Iterable; + var foundAmpersand = false; + for (var name : (Iterable)form.tail.head) { + if (MalSymbol.AMPERSAND.equals(name)) { + foundAmpersand = true; + } else { + argNamesList.add((MalSymbol)name); + } + } + this.numArgs = foundAmpersand? -1 : argNamesList.size(); + this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; + this.scope = new LexicalScope(outerScope); + for (int i=0; i < argNamesList.size(); i++) { + if (numArgs == -1 && i == argNamesList.size()-1) { + bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1, scope); + } else { + bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1, scope); + } + } + this.bodyNode = formToNode(language, form.tail.tail.head, true, scope); + } + + @ExplodeLoop + @Override + public Object execute(VirtualFrame frame) { + var env = new MalEnv((MalEnv)frame.getArguments()[0], scope); + for (int i=0; i < bindNodes.length; i++) { + bindNodes[i].execute(frame, env); + } + return bodyNode.executeGeneric(frame, env); + } + + @Override + public String toString() { + return form.toString(); + } + } + + /** + * Node representing a (fn* ...) form. + */ + static class FnNode extends MalNode { + final FnRootNode fnRoot; + final RootCallTarget fnCallTarget; + + FnNode(MalLanguage language, MalList form, LexicalScope scope) { + super(form); + fnRoot = new FnRootNode(language, form, scope); + this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return new MalFunction(fnCallTarget, env, fnRoot.numArgs); + } + } + + static class QuoteNode extends MalNode { + final Object quoted; + + QuoteNode(MalLanguage language, MalList form) { + super(form); + quoted = form.tail.head; + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + return quoted; + } + } + + static class TryNode extends MalNode { + @Child private MalNode tryBody; + @Child private MalNode catchBody; + final EnvSlot exSlot; + final LexicalScope catchScope; + + TryNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { + super(form); + var tryForm = form.tail.head; + var catchForm = (MalList)form.tail.tail.head; + // We don't allow tail calls inside a try body, because + // they'd get thrown past the catch that should catch subsequent failures. + this.tryBody = formToNode(language, tryForm, false, scope); + if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { + catchScope = new LexicalScope(scope); + var exSymbol = (MalSymbol)catchForm.tail.head; + exSlot = catchScope.allocateSlot(exSymbol); + catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition, catchScope); + } else { + catchScope = null; + exSlot = null; + } + } + + @Override + public Object executeGeneric(VirtualFrame frame, MalEnv env) { + try { + return tryBody.executeGeneric(frame, env); + } catch (MalException ex) { + if (catchBody == null) { + throw ex; + } + var catchEnv = new MalEnv(env, catchScope); + catchEnv.set(exSlot, ex.obj); + return catchBody.executeGeneric(frame, catchEnv); + } + } + } + + final static class MalContext { + final MalEnv globalEnv; + final LexicalScope globalScope; + final Iterable topScopes; + final PrintStream out; + final BufferedReader in; + + MalContext(MalLanguage language) { + globalEnv = Core.newGlobalEnv(MalLanguage.class, language); + globalScope = new LexicalScope(); + topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); + out = System.out; + in = new BufferedReader(new InputStreamReader(System.in)); + } + } + + @TruffleLanguage.Registration( + id=LANGUAGE_ID, + name=LANGUAGE_ID, + defaultMimeType = "application/x-"+LANGUAGE_ID, + characterMimeTypes = "application/x-"+LANGUAGE_ID) + public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { + @Override + protected MalContext createContext(Env env) { + return new MalContext(this); + } + + @Override + public CallTarget evalForm(Object form) { + var ctx = getCurrentContext(MalLanguage.class); + var root = new MalRootNode(this, form, ctx.globalEnv, false, ctx.globalScope); + return Truffle.getRuntime().createCallTarget(root); + } + + @Override + public AbstractInvokeNode invokeNode() { + return new InvokeNode(false); + } + + @Override + protected CallTarget parse(ParsingRequest request) throws Exception { + Source source = request.getSource(); + String s = source.getCharacters().toString(); + return evalForm(Reader.readStr(s)); + } + + @Override + protected Iterable findTopScopes(MalContext context) { + return context.topScopes; + } + + @Override + public PrintStream out() { + return getCurrentContext(MalLanguage.class).out; + } + + @Override + public BufferedReader in() { + return getCurrentContext(MalLanguage.class).in; + } + } +} diff --git a/impls/java/Dockerfile b/impls/java/Dockerfile new file mode 100644 index 0000000000..a19397a0ac --- /dev/null +++ b/impls/java/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Java and maven +RUN apt-get -y install default-jdk-headless maven +ENV MAVEN_OPTS -Duser.home=/mal diff --git a/impls/java/Makefile b/impls/java/Makefile new file mode 100644 index 0000000000..34d38feb7d --- /dev/null +++ b/impls/java/Makefile @@ -0,0 +1,30 @@ + +SOURCES_BASE = src/main/java/mal/readline.java src/main/java/mal/types.java \ + src/main/java/mal/reader.java src/main/java/mal/printer.java +SOURCES_LISP = src/main/java/mal/env.java src/main/java/mal/core.java \ + src/main/java/mal/stepA_mal.java +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + mvn install + +dist: mal.jar mal + +mal.jar: target/classes/mal/stepA_mal.class + mvn assembly:assembly + cp target/mal-0.0.1.jar $@ + +SHELL := bash +mal: mal.jar + cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ + chmod +x mal + +src/main/mal/%.java: + mvn install + +target/classes/mal/step%.class: src/main/java/mal/step%.java ${SOURCES} + mvn install + +clean: + mvn clean + rm -f mal.jar mal diff --git a/java/pom.xml b/impls/java/pom.xml similarity index 83% rename from java/pom.xml rename to impls/java/pom.xml index fa2b567357..63621f87b5 100644 --- a/java/pom.xml +++ b/impls/java/pom.xml @@ -29,6 +29,7 @@ maven-compiler-plugin + 3.0 1.7 1.7 @@ -76,6 +77,19 @@ + + maven-assembly-plugin + + + jar-with-dependencies + + + + mal.stepA_mal + + + + diff --git a/impls/java/run b/impls/java/run new file mode 100755 index 0000000000..670f45c4db --- /dev/null +++ b/impls/java/run @@ -0,0 +1,9 @@ +#!/usr/bin/env bash +args="" +if [ "$#" -gt 0 ]; then + args="-Dexec.args='$1'" + for a in "${@:2}"; do + args="$args '$a'" + done +fi +exec mvn -quiet -e exec:java -Dexec.mainClass="mal.${STEP:-stepA_mal}" ${args:+"$args"} diff --git a/java/src/main/java/mal/core.java b/impls/java/src/main/java/mal/core.java similarity index 84% rename from java/src/main/java/mal/core.java rename to impls/java/src/main/java/mal/core.java index facaeb132b..977d5ab844 100644 --- a/java/src/main/java/mal/core.java +++ b/impls/java/src/main/java/mal/core.java @@ -49,6 +49,20 @@ public MalVal apply(MalList args) throws MalThrowable { return args.nth(0) == False ? True : False; } }; + static MalFunction number_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return args.nth(0) instanceof MalInteger ? True : False; + } + }; + static MalFunction string_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + if (!(args.nth(0) instanceof MalString)) { return False; } + String s = ((MalString)args.nth(0)).getValue(); + if (s.length() != 0 && s.charAt(0) == '\u029e') { return False; } + return True; + } + }; + static MalFunction symbol = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return new MalSymbol((MalString)args.nth(0)); @@ -60,21 +74,36 @@ public MalVal apply(MalList args) throws MalThrowable { } }; static MalFunction keyword = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return new MalString( - "\u029e" + ((MalString)args.nth(0)).getValue()); - } - }; - static MalFunction keyword_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { if (args.nth(0) instanceof MalString && (((MalString)args.nth(0)).getValue().charAt(0) == '\u029e')) { - return True; + return (MalString)args.nth(0); } else { - return False; + return new MalString( + "\u029e" + ((MalString)args.nth(0)).getValue()); } } }; + static MalFunction keyword_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + if (!(args.nth(0) instanceof MalString)) { return False; } + String s = ((MalString)args.nth(0)).getValue(); + if (s.length() == 0 || s.charAt(0) != '\u029e') { return False; } + return True; + } + }; + static MalFunction fn_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + if (!(args.nth(0) instanceof MalFunction)) { return False; } + return ((MalFunction)args.nth(0)).isMacro() ? False : True; + } + }; + static MalFunction macro_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + if (!(args.nth(0) instanceof MalFunction)) { return False; } + return ((MalFunction)args.nth(0)).isMacro() ? True : False; + } + }; // String functions @@ -366,16 +395,30 @@ public MalVal apply(MalList a) throws MalThrowable { } }; + static MalFunction vec = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return new MalVector(((MalList)a.nth(0)).getList()); + } + }; + static MalFunction first = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { - MalList ml = ((MalList)a.nth(0)); + MalVal exp = a.nth(0); + if (exp == Nil) { + return Nil; + } + MalList ml = ((MalList)exp); return ml.size() > 0 ? ml.nth(0) : Nil; } }; static MalFunction rest = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { - MalList ml = ((MalList)a.nth(0)); + MalVal exp = a.nth(0); + if (exp == Nil) { + return new MalList(); + } + MalList ml = ((MalList)exp); return ml.rest(); } }; @@ -391,6 +434,29 @@ public MalVal apply(MalList a) throws MalThrowable { } }; + // General sequence functions + static MalFunction apply = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalFunction f = (MalFunction)a.nth(0); + MalList args = a.slice(1,a.size()-1); + args.value.addAll( ((MalList)a.nth(a.size()-1)).value); + return f.apply(args); + } + }; + + static MalFunction map = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalFunction f = (MalFunction) a.nth(0); + MalList src_lst = (MalList) a.nth(1); + MalList new_lst = new MalList(); + for(Integer i=0; i lst = new ArrayList(); + for (String c : s.split("(?!^)")) { + lst.add(new MalString(c)); + } + return new MalList(lst); + } else if (mv == Nil) { + return Nil; + } else { + throw new MalError("seq: called on non-sequence"); } - return new_lst; } }; @@ -500,10 +568,14 @@ public MalVal apply(MalList a) throws MalThrowable { .put("nil?", nil_Q) .put("true?", true_Q) .put("false?", false_Q) + .put("number?", number_Q) + .put("string?", string_Q) .put("symbol", symbol) .put("symbol?", symbol_Q) .put("keyword", keyword) .put("keyword?", keyword_Q) + .put("fn?", fn_Q) + .put("macro?", macro_Q) .put("pr-str", pr_str) .put("str", str) @@ -538,15 +610,18 @@ public MalVal apply(MalList a) throws MalThrowable { .put("sequential?", sequential_Q) .put("cons", cons) .put("concat", concat) + .put("vec", vec) .put("nth", nth) .put("first", first) .put("rest", rest) .put("empty?", empty_Q) .put("count", count) - .put("conj", conj) .put("apply", apply) .put("map", map) + .put("conj", conj) + .put("seq", seq) + .put("with-meta", with_meta) .put("meta", meta) .put("atom", new_atom) diff --git a/impls/java/src/main/java/mal/env.java b/impls/java/src/main/java/mal/env.java new file mode 100644 index 0000000000..b4c2cdfac8 --- /dev/null +++ b/impls/java/src/main/java/mal/env.java @@ -0,0 +1,49 @@ +package mal; + +import java.util.HashMap; + +import mal.types.MalThrowable; +import mal.types.MalException; +import mal.types.MalVal; +import mal.types.MalSymbol; +import mal.types.MalList; + +public class env { + public static class Env { + Env outer = null; + HashMap data = new HashMap(); + + public Env(Env outer) { + this.outer = outer; + } + public Env(Env outer, MalList binds, MalList exprs) { + this.outer = outer; + for (Integer i=0; i tokenize(String str) { ArrayList tokens = new ArrayList(); - Pattern pattern = Pattern.compile("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)"); + Pattern pattern = Pattern.compile("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)"); Matcher matcher = pattern.matcher(str); while (matcher.find()) { String token = matcher.group(1); @@ -51,7 +51,7 @@ public static ArrayList tokenize(String str) { public static MalVal read_atom(Reader rdr) throws ParseError { String token = rdr.next(); - Pattern pattern = Pattern.compile("(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"(.*)\"$|:(.*)|(^[^\"]*$)"); + Pattern pattern = Pattern.compile("(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"((?:[\\\\].|[^\\\\\"])*)\"$|^\"(.*)$|:(.*)|(^[^\"]*$)"); Matcher matcher = pattern.matcher(token); if (!matcher.find()) { throw new ParseError("unrecognized token '" + token + "'"); @@ -65,11 +65,13 @@ public static MalVal read_atom(Reader rdr) } else if (matcher.group(5) != null) { return types.False; } else if (matcher.group(6) != null) { - return new MalString(StringEscapeUtils.unescapeJson(matcher.group(6))); + return new MalString(StringEscapeUtils.unescapeJava(matcher.group(6))); } else if (matcher.group(7) != null) { - return new MalString("\u029e" + matcher.group(7)); + throw new ParseError("expected '\"', got EOF"); } else if (matcher.group(8) != null) { - return new MalSymbol(matcher.group(8)); + return new MalString("\u029e" + matcher.group(8)); + } else if (matcher.group(9) != null) { + return new MalSymbol(matcher.group(9)); } else { throw new ParseError("unrecognized '" + matcher.group(0) + "'"); } diff --git a/java/src/main/java/mal/readline.java b/impls/java/src/main/java/mal/readline.java similarity index 100% rename from java/src/main/java/mal/readline.java rename to impls/java/src/main/java/mal/readline.java diff --git a/impls/java/src/main/java/mal/step0_repl.java b/impls/java/src/main/java/mal/step0_repl.java new file mode 100644 index 0000000000..b966a1f776 --- /dev/null +++ b/impls/java/src/main/java/mal/step0_repl.java @@ -0,0 +1,48 @@ +package mal; + +import java.io.IOException; + +import mal.readline; + +public class step0_repl { + // read + public static String READ(String str) { + return str; + } + + // eval + public static String EVAL(String ast, String env) { + return ast; + } + + // print + public static String PRINT(String exp) { + return exp; + } + + // repl + public static String RE(String env, String str) { + return EVAL(READ(str), env); + } + + public static void main(String[] args) { + String prompt = "user> "; + + if (args.length > 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + System.out.println(PRINT(RE(null, line))); + } + } +} diff --git a/java/src/main/java/mal/step1_read_print.java b/impls/java/src/main/java/mal/step1_read_print.java similarity index 100% rename from java/src/main/java/mal/step1_read_print.java rename to impls/java/src/main/java/mal/step1_read_print.java diff --git a/impls/java/src/main/java/mal/step2_eval.java b/impls/java/src/main/java/mal/step2_eval.java new file mode 100644 index 0000000000..e5bbfdcf7f --- /dev/null +++ b/impls/java/src/main/java/mal/step2_eval.java @@ -0,0 +1,125 @@ +package mal; + +import java.io.IOException; + +import java.util.List; +import java.util.Map; +import java.util.HashMap; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; + +public class step2_eval { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static MalVal EVAL(MalVal orig_ast, Map env) throws MalThrowable { + // System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + // apply list + if (ast.size() == 0) { return ast; } + final MalVal f = EVAL(ast.nth(0), env); + if (!(f instanceof ILambda)) + throw new MalError("cannot apply " + printer._pr_str(ast, true)); + final MalList args = new MalList(); + for (int i=1; i env, String str) throws MalThrowable { + return EVAL(READ(str), env); + } + + static MalFunction add = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).add((MalInteger)a.nth(1)); + } + }; + static MalFunction subtract = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).subtract((MalInteger)a.nth(1)); + } + }; + static MalFunction multiply = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).multiply((MalInteger)a.nth(1)); + } + }; + static MalFunction divide = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).divide((MalInteger)a.nth(1)); + } + }; + + + public static void main(String[] args) throws MalThrowable { + String prompt = "user> "; + + Map repl_env = new HashMap(); + repl_env.put("+", add); + repl_env.put("-", subtract); + repl_env.put("*", multiply); + repl_env.put("/", divide); + + if (args.length > 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/step3_env.java b/impls/java/src/main/java/mal/step3_env.java new file mode 100644 index 0000000000..aff63c4d9d --- /dev/null +++ b/impls/java/src/main/java/mal/step3_env.java @@ -0,0 +1,153 @@ +package mal; + +import java.io.IOException; + +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; + +public class step3_env { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + if (!(a0 instanceof MalSymbol)) { + throw new MalError("attempt to apply on non-symbol '" + + printer._pr_str(a0,true) + "'"); + } + + switch (((MalSymbol)a0).getName()) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + return EVAL(a2, let_env); + default: + final ILambda f = (ILambda)EVAL(a0, env); + final MalList args = new MalList(); + for (int i=1; i 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/step4_if_fn_do.java b/impls/java/src/main/java/mal/step4_if_fn_do.java new file mode 100644 index 0000000000..d0979fbc8c --- /dev/null +++ b/impls/java/src/main/java/mal/step4_if_fn_do.java @@ -0,0 +1,162 @@ +package mal; + +import java.io.IOException; + +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class step4_if_fn_do { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, a3, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + return EVAL(a2, let_env); + case "do": + for (int i=1; i 3) { + a3 = ast.nth(3); + return EVAL(a3, env); + } else { + return types.Nil; + } + } else { + // eval true slot form + a2 = ast.nth(2); + return EVAL(a2, env); + } + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction () { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + final MalFunction f = (MalFunction)EVAL(a0, env); + final MalList args = new MalList(); + for (int i=1; i 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/step5_tco.java b/impls/java/src/main/java/mal/step5_tco.java new file mode 100644 index 0000000000..9fffee39c3 --- /dev/null +++ b/impls/java/src/main/java/mal/step5_tco.java @@ -0,0 +1,174 @@ +package mal; + +import java.io.IOException; + +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class step5_tco { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + while (true) { + + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, a3, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "do": + for (int i=1; i 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + final MalFunction f = (MalFunction)EVAL(a0, env); + final MalList args = new MalList(); + for (int i=1; i 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/step6_file.java b/impls/java/src/main/java/mal/step6_file.java new file mode 100644 index 0000000000..dc7f681f59 --- /dev/null +++ b/impls/java/src/main/java/mal/step6_file.java @@ -0,0 +1,192 @@ +package mal; + +import java.io.IOException; + +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class step6_file { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + while (true) { + + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, a3, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "do": + for (int i=1; i 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + final MalFunction f = (MalFunction)EVAL(a0, env); + final MalList args = new MalList(); + for (int i=1; i 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + fileIdx = 1; + } + if (args.length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/step7_quote.java b/impls/java/src/main/java/mal/step7_quote.java new file mode 100644 index 0000000000..ed9a10c04d --- /dev/null +++ b/impls/java/src/main/java/mal/step7_quote.java @@ -0,0 +1,229 @@ +package mal; + +import java.io.IOException; + +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class step7_quote { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; + } + + public static MalVal quasiquote(MalVal ast) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) + return new MalList(new MalSymbol("quote"), ast); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); + } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; + } + + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + while (true) { + + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, a3, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast.nth(1); + case "quasiquote": + orig_ast = quasiquote(ast.nth(1)); + break; + case "do": + for (int i=1; i 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + final MalFunction f = (MalFunction)EVAL(a0, env); + final MalList args = new MalList(); + for (int i=1; i 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + fileIdx = 1; + } + if (args.length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/step8_macros.java b/impls/java/src/main/java/mal/step8_macros.java new file mode 100644 index 0000000000..1210ae19d5 --- /dev/null +++ b/impls/java/src/main/java/mal/step8_macros.java @@ -0,0 +1,242 @@ +package mal; + +import java.io.IOException; + +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class step8_macros { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; + } + + public static MalVal quasiquote(MalVal ast) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) + return new MalList(new MalSymbol("quote"), ast); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); + } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; + } + + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + while (true) { + + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, a3, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast.nth(1); + case "quasiquote": + orig_ast = quasiquote(ast.nth(1)); + break; + case "defmacro!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + res = res.copy(); + ((MalFunction)res).setMacro(); + env.set((MalSymbol)a1, res); + return res; + case "do": + for (int i=1; i 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + final MalFunction f = (MalFunction)EVAL(a0, env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + continue; + } + final MalList args = new MalList(); + for (int i=1; i (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + Integer fileIdx = 0; + if (args.length > 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + fileIdx = 1; + } + if (args.length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/step9_try.java b/impls/java/src/main/java/mal/step9_try.java new file mode 100644 index 0000000000..2e10bfbed6 --- /dev/null +++ b/impls/java/src/main/java/mal/step9_try.java @@ -0,0 +1,270 @@ +package mal; + +import java.io.IOException; + +import java.io.StringWriter; +import java.io.PrintWriter; +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class step9_try { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; + } + + public static MalVal quasiquote(MalVal ast) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) + return new MalList(new MalSymbol("quote"), ast); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); + } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; + } + + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + while (true) { + + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, a3, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast.nth(1); + case "quasiquote": + orig_ast = quasiquote(ast.nth(1)); + break; + case "defmacro!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + res = res.copy(); + ((MalFunction)res).setMacro(); + env.set((MalSymbol)a1, res); + return res; + case "try*": + try { + return EVAL(ast.nth(1), env); + } catch (Throwable t) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast.nth(2); + MalVal a20 = ((MalList)a2).nth(0); + if (((MalSymbol)a20).getName().equals("catch*")) { + if (t instanceof MalException) { + exc = ((MalException)t).getValue(); + } else { + StringWriter sw = new StringWriter(); + t.printStackTrace(new PrintWriter(sw)); + String tstr = sw.toString(); + exc = new MalString(t.getMessage() + ": " + tstr); + } + return EVAL(((MalList)a2).nth(2), + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw t; + } + case "do": + for (int i=1; i 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + final MalFunction f = (MalFunction)EVAL(a0, env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + continue; + } + final MalList args = new MalList(); + for (int i=1; i (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + Integer fileIdx = 0; + if (args.length > 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + fileIdx = 1; + } + if (args.length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/impls/java/src/main/java/mal/stepA_mal.java b/impls/java/src/main/java/mal/stepA_mal.java new file mode 100644 index 0000000000..1064248a7e --- /dev/null +++ b/impls/java/src/main/java/mal/stepA_mal.java @@ -0,0 +1,272 @@ +package mal; + +import java.io.IOException; + +import java.io.StringWriter; +import java.io.PrintWriter; +import java.util.List; +import java.util.Map; +import mal.types.*; +import mal.readline; +import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; + +public class stepA_mal { + // read + public static MalVal READ(String str) throws MalThrowable { + return reader.read_str(str); + } + + // eval + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; + } + + public static MalVal quasiquote(MalVal ast) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) + return new MalList(new MalSymbol("quote"), ast); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); + } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; + } + + public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { + while (true) { + + final MalVal dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) + System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast instanceof MalSymbol) { + final String key = ((MalSymbol)orig_ast).getName(); + final MalVal val = env.get(key); + if (val == null) + throw new MalException("'" + key + "' not found"); + return val; + } else if (orig_ast instanceof MalVector) { + final MalList old_lst = (MalList)orig_ast; + final MalVector new_lst = new MalVector(); + for (MalVal mv : (List)old_lst.value) { + new_lst.conj_BANG(EVAL(mv, env)); + } + return new_lst; + } else if (orig_ast instanceof MalHashMap) { + final Map old_hm = ((MalHashMap)orig_ast).value; + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : old_hm.entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (!orig_ast.list_Q()) { + return orig_ast; + } + final MalList ast = (MalList)orig_ast; + MalVal a0, a1,a2, a3, res; + // apply list + if (ast.size() == 0) { return ast; } + a0 = ast.nth(0); + String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() + : "__<*fn*>__"; + switch (a0sym) { + case "def!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + env.set(((MalSymbol)a1), res); + return res; + case "let*": + a1 = ast.nth(1); + a2 = ast.nth(2); + MalSymbol key; + MalVal val; + Env let_env = new Env(env); + for(int i=0; i<((MalList)a1).size(); i+=2) { + key = (MalSymbol)((MalList)a1).nth(i); + val = ((MalList)a1).nth(i+1); + let_env.set(key, EVAL(val, let_env)); + } + orig_ast = a2; + env = let_env; + break; + case "quote": + return ast.nth(1); + case "quasiquote": + orig_ast = quasiquote(ast.nth(1)); + break; + case "defmacro!": + a1 = ast.nth(1); + a2 = ast.nth(2); + res = EVAL(a2, env); + res = res.copy(); + ((MalFunction)res).setMacro(); + env.set((MalSymbol)a1, res); + return res; + case "try*": + try { + return EVAL(ast.nth(1), env); + } catch (Throwable t) { + if (ast.size() > 2) { + MalVal exc; + a2 = ast.nth(2); + MalVal a20 = ((MalList)a2).nth(0); + if (((MalSymbol)a20).getName().equals("catch*")) { + if (t instanceof MalException) { + exc = ((MalException)t).getValue(); + } else { + StringWriter sw = new StringWriter(); + t.printStackTrace(new PrintWriter(sw)); + String tstr = sw.toString(); + exc = new MalString(t.getMessage() + ": " + tstr); + } + return EVAL(((MalList)a2).nth(2), + new Env(env, ((MalList)a2).slice(1,2), + new MalList(exc))); + } + } + throw t; + } + case "do": + for (int i=1; i 3) { + orig_ast = ast.nth(3); + } else { + return types.Nil; + } + } else { + // eval true slot form + orig_ast = ast.nth(2); + } + break; + case "fn*": + final MalList a1f = (MalList)ast.nth(1); + final MalVal a2f = ast.nth(2); + final Env cur_env = env; + return new MalFunction (a2f, (mal.env.Env)env, a1f) { + public MalVal apply(MalList args) throws MalThrowable { + return EVAL(a2f, new Env(cur_env, a1f, args)); + } + }; + default: + final MalFunction f = (MalFunction)EVAL(a0, env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + continue; + } + final MalList args = new MalList(); + for (int i=1; i (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + + Integer fileIdx = 0; + if (args.length > 0 && args[0].equals("--raw")) { + readline.mode = readline.Mode.JAVA; + fileIdx = 1; + } + if (args.length > fileIdx) { + RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); + return; + } + + // repl loop + RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + String line; + try { + line = readline.readline(prompt); + if (line == null) { continue; } + } catch (readline.EOFException e) { + break; + } catch (IOException e) { + System.out.println("IOException: " + e.getMessage()); + break; + } + try { + System.out.println(PRINT(RE(repl_env, line))); + } catch (MalContinue e) { + } catch (MalException e) { + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); + } catch (MalThrowable t) { + System.out.println("Error: " + t.getMessage()); + } catch (Throwable t) { + System.out.println("Uncaught " + t + ": " + t.getMessage()); + } + } + } +} diff --git a/java/src/main/java/mal/types.java b/impls/java/src/main/java/mal/types.java similarity index 94% rename from java/src/main/java/mal/types.java rename to impls/java/src/main/java/mal/types.java index a8a2dfa604..aa11cf8cca 100644 --- a/java/src/main/java/mal/types.java +++ b/impls/java/src/main/java/mal/types.java @@ -64,6 +64,20 @@ public static Boolean _equal_Q(MalVal a, MalVal b) { } } return true; + } else if (a instanceof MalHashMap) { + if (((MalHashMap)a).value.size() != ((MalHashMap)b).value.size()) { + return false; + } + //HashMap hm = (HashMap)a.value; + MalHashMap mhm = ((MalHashMap)a); + HashMap hm = (HashMap)mhm.value; + for (String k : hm.keySet()) { + if (! _equal_Q(((MalVal)((MalHashMap)a).value.get(k)), + ((MalVal)((MalHashMap)b).value.get(k)))) { + return false; + } + } + return true; } else { return a == b; } diff --git a/impls/java/tests/step5_tco.mal b/impls/java/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/java/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/jq/Dockerfile b/impls/jq/Dockerfile new file mode 100644 index 0000000000..3a6415d4bd --- /dev/null +++ b/impls/jq/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +######################################################### +# Specific implementation requirements +######################################################### + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install jq diff --git a/impls/jq/Makefile b/impls/jq/Makefile new file mode 100644 index 0000000000..f196e6bac4 --- /dev/null +++ b/impls/jq/Makefile @@ -0,0 +1,11 @@ +all: + +clean: + rm -fr .mypy_cache/ + +check: + flake8 run + pylint run + mypy run + +.PHONY: all clean check diff --git a/impls/jq/core.jq b/impls/jq/core.jq new file mode 100644 index 0000000000..90ca88c126 --- /dev/null +++ b/impls/jq/core.jq @@ -0,0 +1,516 @@ +include "utils"; +include "printer"; +include "reader"; + +def core_identify: + { + "+": { + kind: "fn", # native function + inputs: 2, + function: "number_add" + }, + "-": { + kind: "fn", # native function + inputs: 2, + function: "number_sub" + }, + "*": { + kind: "fn", # native function + inputs: 2, + function: "number_mul" + }, + "/": { + kind: "fn", # native function + inputs: 2, + function: "number_div" + }, + "eval": { + kind: "fn", + inputs: 1, + function: "eval" + }, + "env": { + kind: "fn", + function: "env", + inputs: 0 + }, + "prn": { + kind: "fn", + function: "prn", + inputs: -1 + }, + "pr-str": { + kind: "fn", + function: "pr-str", + inputs: -1 + }, + "str": { + kind: "fn", + function: "str", + inputs: -1 + }, + "println": { + kind: "fn", + function: "println", + inputs: -1 + }, + "list": { + kind: "fn", + function: "list", + inputs: -1 + }, + "list?": { + kind: "fn", + function: "list?", + inputs: 1 + }, + "empty?": { + kind: "fn", + function: "empty?", + inputs: 1 + }, + "count": { + kind: "fn", + function: "count", + inputs: 1 + }, + "=": { + kind: "fn", + function: "=", + inputs: 2 + }, + "<": { + kind: "fn", + function: "<", + inputs: 2 + }, + "<=": { + kind: "fn", + function: "<=", + inputs: 2 + }, + ">": { + kind: "fn", + function: ">", + inputs: 2 + }, + ">=": { + kind: "fn", + function: ">=", + inputs: 2 + }, + "read-string": { + kind: "fn", + function: "read-string", + inputs: 1 + }, + "slurp": { + kind: "fn", + function: "slurp", + inputs: 1 + }, + "atom": { + kind: "fn", + function: "atom", + inputs: 1 + }, + "atom?": { + kind: "fn", + function: "atom?", + inputs: 1 + }, + "deref": { + kind: "fn", + function: "deref", + inputs: 1 + }, + "reset!": { # defined in interp + kind: "fn", + function: "reset!", + inputs: 2 + }, + "swap!": { # defined in interp + kind: "fn", + function: "swap!", + inputs: -3 + }, + "cons": { + kind: "fn", + function: "cons", + inputs: 2 + }, + "concat": { + kind: "fn", + function: "concat", + inputs: -1 + }, + "vec": { + kind: "fn", + function: "vec", + inputs: 1 + }, + "nth": { + kind: "fn", + function: "nth", + inputs: 2 + }, + "first": { + kind: "fn", + function: "first", + inputs: 1 + }, + "rest": { + kind: "fn", + function: "rest", + inputs: 1 + }, + "throw": { + kind: "fn", + function: "throw", + inputs: 1 + }, + "apply": { # defined in interp + kind: "fn", + function: "apply", + inputs: -3 + }, + "map": { # defined in interp + kind: "fn", + function: "map", + inputs: 2 + }, + "nil?": { + kind: "fn", + function: "nil?", + inputs: 1 + }, + "true?": { + kind: "fn", + function: "true?", + inputs: 1 + }, + "false?": { + kind: "fn", + function: "false?", + inputs: 1 + }, + "symbol": { + kind: "fn", + function: "symbol", + inputs: 1 + }, + "symbol?": { + kind: "fn", + function: "symbol?", + inputs: 1 + }, + "keyword": { + kind: "fn", + function: "keyword", + inputs: 1 + }, + "keyword?": { + kind: "fn", + function: "keyword?", + inputs: 1 + }, + "vector": { + kind: "fn", + function: "vector", + inputs: -1 + }, + "vector?": { + kind: "fn", + function: "vector?", + inputs: 1 + }, + "sequential?": { + kind: "fn", + function: "sequential?", + inputs: 1 + }, + "hash-map": { + kind: "fn", + function: "hash-map", + inputs: -1 + }, + "map?": { + kind: "fn", + function: "map?", + inputs: 1 + }, + "assoc": { + kind: "fn", + function: "assoc", + inputs: -2 + }, + "dissoc": { + kind: "fn", + function: "dissoc", + inputs: -2 + }, + "get": { + kind: "fn", + function: "get", + inputs: 2 + }, + "contains?": { + kind: "fn", + function: "contains?", + inputs: 2 + }, + "keys": { + kind: "fn", + function: "keys", + inputs: 1 + }, + "vals": { + kind: "fn", + function: "vals", + inputs: 1 + }, + "string?": { + kind: "fn", + function: "string?", + inputs: 1 + }, + "fn?": { + kind: "fn", + function: "fn?", + inputs: 1 + }, + "number?": { + kind: "fn", + function: "number?", + inputs: 1 + }, + "macro?": { + kind: "fn", + function: "macro?", + inputs: 1 + }, + "readline": { + kind: "fn", + function: "readline", + inputs: 1 + }, + "time-ms": { + kind: "fn", + function: "time-ms", + inputs: 0 + }, + "meta": { + kind: "fn", + function: "meta", + inputs: 1 + }, + "with-meta": { + kind: "fn", + function: "with-meta", + inputs: 2 + }, + "seq": { + kind: "fn", + function: "seq", + inputs: 1 + }, + "conj": { + kind: "fn", + function: "conj", + inputs: -3 + } + }; + +def vec2list(obj): + if obj.kind == "list" then + obj.value | map(vec2list(.)) | wrap("list") + else + if obj.kind == "vector" then + obj.value | map(vec2list(.)) | wrap("list") + else + if obj.kind == "hashmap" then + obj.value | map_values(.value |= vec2list(.)) | wrap("hashmap") + else + obj + end + end + end; + +def make_sequence: + . as $dot + | if .value|length == 0 then null | wrap("nil") else + ( + select(.kind == "string") | .value | split("") | map(wrap("string")) + ) // ( + select(.kind == "list" or .kind == "vector") | .value + ) // jqmal_error("cannot make sequence from \(.kind)") | wrap("list") + end; + +def core_interp(arguments; env): + ( + select(.function == "number_add") | + arguments | map(.value) | .[0] + .[1] | wrap("number") + ) // ( + select(.function == "number_sub") | + arguments | map(.value) | .[0] - .[1] | wrap("number") + ) // ( + select(.function == "number_mul") | + arguments | map(.value) | .[0] * .[1] | wrap("number") + ) // ( + select(.function == "number_div") | + arguments | map(.value) | .[0] / .[1] | wrap("number") + ) // ( + select(.function == "env") | + env | tojson | wrap("string") + ) // ( + select(.function == "prn") | + arguments | map(pr_str(env; {readable: true})) | join(" ") | _display | null | wrap("nil") + ) // ( + select(.function == "pr-str") | + arguments | map(pr_str(env; {readable: true})) | join(" ") | wrap("string") + ) // ( + select(.function == "str") | + arguments | map(pr_str(env; {readable: false})) | join("") | wrap("string") + ) // ( + select(.function == "println") | + arguments | map(pr_str(env; {readable: false})) | join(" ") | _display | null | wrap("nil") + ) // ( + select(.function == "list") | + arguments | wrap("list") + ) // ( + select(.function == "list?") | null | wrap(arguments | first.kind == "list" | tostring) + ) // ( + select(.function == "empty?") | null | wrap(arguments|first.value | length == 0 | tostring) + ) // ( + select(.function == "count") | arguments|first.value | length | wrap("number") + ) // ( + select(.function == "=") | null | wrap(vec2list(arguments[0]) == vec2list(arguments[1]) | tostring) + ) // ( + select(.function == "<") | null | wrap(arguments[0].value < arguments[1].value | tostring) + ) // ( + select(.function == "<=") | null | wrap(arguments[0].value <= arguments[1].value | tostring) + ) // ( + select(.function == ">") | null | wrap(arguments[0].value > arguments[1].value | tostring) + ) // ( + select(.function == ">=") | null | wrap(arguments[0].value >= arguments[1].value | tostring) + ) // ( + select(.function == "slurp") | arguments[0].value | slurp | wrap("string") + ) // ( + select(.function == "read-string") | arguments | first.value | read_form + ) // ( + select(.function == "atom?") | null | wrap(arguments | first.kind == "atom" | tostring) + ) // ( + select(.function == "cons") | ([arguments[0]] + arguments[1].value) | wrap("list") + ) // ( + select(.function == "concat") | arguments | map(.value) | (add//[]) | wrap("list") + ) // ( + select(.function == "vec") | {kind:"vector", value:arguments[0].value} + ) // ( + select(.function == "nth") + | arguments[0].value as $lst + | arguments[1].value as $idx + | if ($lst|length < $idx) or ($idx < 0) then + jqmal_error("index out of range") + else + $lst[$idx] + end + ) // ( + select(.function == "first") | arguments[0].value | first // {kind:"nil"} + ) // ( + select(.function == "rest") | arguments[0]?.value?[1:]? // [] | wrap("list") + ) // ( + select(.function == "throw") | jqmal_error(arguments[0] | tojson) + ) // ( + select(.function == "nil?") | null | wrap((arguments[0].kind == "nil") | tostring) + ) // ( + select(.function == "true?") | null | wrap((arguments[0].kind == "true") | tostring) + ) // ( + select(.function == "false?") | null | wrap((arguments[0].kind == "false") | tostring) + ) // ( + select(.function == "symbol?") | null | wrap((arguments[0].kind == "symbol") | tostring) + ) // ( + select(.function == "symbol") | arguments[0].value | wrap("symbol") + ) // ( + select(.function == "keyword") | arguments[0].value | wrap("keyword") + ) // ( + select(.function == "keyword?") | null | wrap((arguments[0].kind == "keyword") | tostring) + ) // ( + select(.function == "vector") | arguments | wrap("vector") + ) // ( + select(.function == "vector?") | null | wrap((arguments[0].kind == "vector") | tostring) + ) // ( + select(.function == "sequential?") | null | wrap((arguments[0].kind == "vector" or arguments[0].kind == "list") | tostring) + ) // ( + select(.function == "hash-map") | + if (arguments|length) % 2 == 1 then + jqmal_error("Odd number of arguments to hash-map") + else + [ arguments | + nwise(2) | + try { + key: (.[0] | extract_string), + value: { + kkind: .[0].kind, + value: .[1] + } + } + ] | from_entries | wrap("hashmap") + end + ) // ( + select(.function == "map?") | null | wrap((arguments[0].kind == "hashmap") | tostring) + ) // ( + select(.function == "assoc") | + if (arguments|length) % 2 == 0 then + jqmal_error("Odd number of key-values to assoc") + else + arguments[0].value + ([ arguments[1:] | + nwise(2) | + try { + key: (.[0] | extract_string), + value: { + kkind: .[0].kind, + value: .[1] + } + } + ] | from_entries) | wrap("hashmap") + end + ) // ( + select(.function == "dissoc") | + arguments[1:] | map(.value) as $keynames | + arguments[0].value | with_entries(select(.key as $k | $keynames | contains([$k]) | not)) | wrap("hashmap") + ) // ( + select(.function == "get") | arguments[0].value[arguments[1].value].value // {kind:"nil"} + ) // ( + select(.function == "contains?") | null | wrap((arguments[0].value | has(arguments[1].value)) | tostring) + ) // ( + select(.function == "keys") | arguments[0].value | with_entries(.value as $v | .key as $k | {key: $k, value: {value: $k, kind: $v.kkind}}) | to_entries | map(.value) | wrap("list") + ) // ( + select(.function == "vals") | arguments[0].value | map(.value) | to_entries | map(.value) | wrap("list") + ) // ( + select(.function == "string?") | null | wrap((arguments[0].kind == "string") | tostring) + ) // ( + select(.function == "fn?") | null | wrap((arguments[0].kind == "fn" or (arguments[0].kind == "function" and (arguments[0].is_macro|not))) | tostring) + ) // ( + select(.function == "number?") | null | wrap((arguments[0].kind == "number") | tostring) + ) // ( + select(.function == "macro?") | null | wrap((arguments[0].is_macro == true) | tostring) + ) // ( + select(.function == "readline") | arguments[0].value | __readline | wrap("string") + ) // ( + select(.function == "time-ms") | now * 1000 | wrap("number") + ) // ( + select(.function == "meta") | arguments[0].meta // {kind:"nil"} + ) // ( + select(.function == "with-meta") | arguments[0] | .meta |= arguments[1] + ) // ( + select(.function == "seq") | arguments[0] | make_sequence + ) // ( + select(.function == "conj") + | arguments[0] as $orig + | arguments[1:] as $stuff + | if $orig.kind == "list" then + [ $stuff|reverse[], $orig.value[] ] | wrap("list") + else + [ $orig.value[], $stuff[] ] | wrap("vector") + end + ) // jqmal_error("Unknown native function \(.function)"); diff --git a/impls/jq/docs/impl-notes.md b/impls/jq/docs/impl-notes.md new file mode 100644 index 0000000000..7bbaf3f354 --- /dev/null +++ b/impls/jq/docs/impl-notes.md @@ -0,0 +1,58 @@ +# General Implementation Notes + +This document contains notes on the jq implementation, describing the deviations from the MAL specification and implementation details where necessary. + +## Main Deviations per Step + +### Step 0 +As jq lacks a way to input free-form data on-demand, the REPL is implemented using a wrapper around the jq interpreter, which intercepts requests from our implementation and feeds the result back to jq as JSON; see the `__readline` function in [utils.jq](../utils.jq), and its implementation in [the wrapper](../run). + +All further free-form I/O primitives are implemented in a similar way. + +### Step 1 +There is not much deviation from the MAL process in this step, MAL data are implemented as JSON objects with two fields: `kind` and `value` (see [reader.jq](../reader.jq)). + +### Step 2 +jq cannot store functions as values, and so we are forced to represent them using their names and a large switch-case structure (`select()` in jq). +The environment is simply modelled as a JSON object, and functions are represented as `{ "kind": "fn", "inputs": n, "function": name }` where `n` is the number of arguments the function takes and `name` is the name of the function to be handled by the switch-case structure (in `interpret()` at this stage). + +### Step 3 +The second of three environment implementations is introduced here, where an environment is an optional parent environment (which corresponds to the `outer` environment concept in the guide), and the environment from the previous step. Two convenience functions are introduced to handle the environment operations: `env-get` and `env-set`. + +The forms `let*` and `def!` are implemented mostly as described in the guide, with `let*` utilizing a left-associative fold (`reduce` in jq) to build the intermediate environment up; which is discarded after the fold is done. + +### Step 4 +In this step, environments grow yet another field `fallback`, which is used to add a second environment chain to non-top-level environments. This is used to implement functions that refer to unbound symbols in their body (this could be the function itself, or any other symbol defined later in the parent environment) - this is necessary as there are no variable references or mutable variables in jq (and thus we cannot modify an environment in-place). + +Due to this limitation, the `fn*` form is implemented by: +- Recording the "free" symbols in the function body (which are not defined in the function's environment) +- And storing a copy of the current environment in the function itself (for closures) + +The `interpret` function also gets an `_eval` callback parameter, which is used to evaluate the function body after a new environment is created with the correct bindings. + +Everything else is largely the same as in the guide. + +### Step 5 +Tail-calls are implemented as a (fairly complex) fixpoint iteration in the `EVAL` function; this "loop" takes an object of the form `{ast, env, ret_env, finish, cont}` and "iteratively" performs an evaluation step with `.ast` and `.env` (which is updated on every "iteration") until `.cont` is `false` (which is driven by the `finish` "flag"). Upon completion, the resulting environment is pulled from `ret_env` and the fixpoint is returned as the evaluation result. + +This is largely due to the lack of "actual" loops in jq, a computation of this form can also be expressed as a reduction over an infinite generator, but the fixpoint iteration is more straightforward to implement (as jq has a built-in `recurse` function). + +### Step 6 +This step deviates from the guide _significantly_, in the implementation of atoms; since jq does not have mutable variables (_or_ global variables), we cannot implement atoms in any simple way. + +First, let's go over atom identity and creation; this implementation "stamps" atoms with their creation timestamp (the result of `now | tostring`), which is used as a unique identifier for the atom. +The fixpoint calculation of `EVAL` (and `TCOWrap` in particular) is adjusted to handle atoms "leaking" into the global environment (as they are not bound to any environment in reality, which differs from our implementation where atoms are bound to the active environment they were created in). + +The `interpret` function is also moved to a separate [interp.jq](../interp.jq) file, as it can be shared between steps going forward, and will also grow in complexity due to the introduction of atoms. + +### Step 7 +This step does not deviate from the guide. + +### Step 8 +This step does not deviate from the guide. + +### Step 9 +This step uses the native jq exception handling mechanism `try ... catch ...`, and follows the guide closely (and so no significant deviations are present). + +### Step A +This step does not deviate from the guide. diff --git a/impls/jq/env.jq b/impls/jq/env.jq new file mode 100644 index 0000000000..e0b77c4b30 --- /dev/null +++ b/impls/jq/env.jq @@ -0,0 +1,196 @@ +include "utils"; + +def childEnv(binds; exprs): + { + parent: ., + fallback: null, + environment: [binds, exprs] | transpose | ( + . as $dot | reduce .[] as $item ( + { value: [], seen: false, name: null, idx: 0 }; + if $item[1] != null then + if .seen then + { + value: (.value[1:-1] + (.value|last[1].value += [$item[1]])), + seen: true, + name: .name + } + else + if $item[0] == "&" then + $dot[.idx+1][0] as $name | { + value: (.value + [[$name, {kind:"list", value: [$item[1]]}]]), + seen: true, + name: $name + } + else + { + value: (.value + [$item]), + seen: false, + name: null + } + end + end | (.idx |= .idx + 1) + else + if $item[0] == "&" then + $dot[.idx+1][0] as $name | { + value: (.value + [[$name, {kind:"list", value: []}]]), + seen: true, + name: $name + } + else . end + end + ) + ) | .value | map({(.[0]): .[1]}) | add + }; + +def env_multiset(fn): + .environment += (reduce fn.names[] as $key(.environment; .[$key] |= fn)); + +def env_set($key; $value): + (if $value.kind == "function" or $value.kind == "atom" then + # inform the function/atom of its names + ($value | + if $value.kind == "atom" then + # check if the one we have is newer + ($key | env_get(env)) as $ours | + if $ours.last_modified > $value.last_modified then + $ours + else + # update modification timestamp + $value | .last_modified |= now + end + else + . + end) | + .names += [$key] | + .names |= unique + + else + $value + end) as $value | + # merge together, as .environment[$key] |= value does not work + .environment += (.environment | .[$key] |= $value); + +def env_dump_keys: + def _dump1: + .environment // {} | keys; + if . == null then [] else + if .parent == null then + ( + _dump1 + + (.fallback | env_dump_keys) + ) + else + ( + _dump1 + + (.parent | env_dump_keys) + + (.fallback | env_dump_keys) + ) + end | unique + end; + +# Helper for env_get. +def env_find(env): + if env.environment[.] == null then + if env.parent then + env_find(env.parent) // if env.fallback then env_find(env.fallback) else null end + else + null + end + else + env + end; + +def env_get(env): + # key -> value or null + . as $key | env_find(env).environment[$key] | + if . != null and .kind == "atom" then + ($key | env_find(env.parent).environment[$key]) as $possibly_newer | + if $possibly_newer.identity == .identity + and $possibly_newer.last_modified > .last_modified + then + $possibly_newer + end + end; + +def env_set(env; $key; $value): + (if $value.kind == "function" then + # inform the function/atom of its names + $value | (.names += [$key]) | (.names |= unique) + else + $value + end) as $value | { + parent: env.parent, + environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)), # merge together, as env.environment[key] |= value does not work + fallback: env.fallback + }; + +def wrapEnv(atoms): + { + replEnv: ., + currentEnv: ., + atoms: atoms, + isReplEnv: true + }; + +def wrapEnv(replEnv; atoms): + { + replEnv: replEnv, + currentEnv: ., + atoms: atoms, # id -> value + isReplEnv: (replEnv == .) # should we allow separate copies? + }; + +def unwrapReplEnv: + .replEnv; + +def unwrapCurrentEnv: + .currentEnv; + +def env_set_(env; key; value): + if env.currentEnv != null then + # Moving the common env_set before the if breaks something. ? + if env.isReplEnv then + env_set(env.currentEnv; key; value) | wrapEnv(env.atoms) + else + env_set(env.currentEnv; key; value) | wrapEnv(env.replEnv; env.atoms) + end + else + env_set(env; key; value) + end; + +def addToEnv(name): + # { expr, env } -> { same expr, new env } + .expr as $value | + .env |= ( + . as $rawEnv | + if .isReplEnv then + env_set_(.currentEnv; name; $value) | wrapEnv($rawEnv.atoms) + else + env_set_(.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv; $rawEnv.atoms) + end); + +def _env_remove_references(refs): + if . != null then + if .environment == null then + debug("This one broke the rules, officer: \(.)") + else + { + environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries), + parent: (.parent | _env_remove_references(refs)), + fallback: (.fallback | _env_remove_references(refs)) + } + end + else . end; + +def env_remove_references(refs): + . as $env + | if (refs|length == 0) then + # optimisation: most functions are purely lexical + $env + else + if has("replEnv") then + .currentEnv |= _env_remove_references(refs) + else + _env_remove_references(refs) + end + end; diff --git a/impls/jq/interp.jq b/impls/jq/interp.jq new file mode 100644 index 0000000000..275962b536 --- /dev/null +++ b/impls/jq/interp.jq @@ -0,0 +1,183 @@ +include "utils"; +include "core"; +include "env"; +include "printer"; + +def arg_check(args): + if .inputs < 0 then + if (abs(.inputs) - 1) > (args | length) then + jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))") + else + . + end + else if .inputs != (args|length) then + jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") + else + . + end end; + +def extractReplEnv(env): + env | .replEnv // .; + +def extractEnv(env): + env | .currentEnv // .; + +def updateReplEnv(renv): + def findpath: + if .env.parent then + .path += ["parent"] | + .env |= .parent | + findpath + else + .path + end; + ({ env: ., path: [] } | findpath) as $path | + setpath($path; renv); + +def extractCurrentReplEnv(env): + def findpath: + if .env.parent then + .path += ["parent"] | + .env |= .parent | + findpath + else + .path + end; + if env.currentEnv != null then + ({ env: env.currentEnv, path: [] } | findpath) as $path | + env.currentEnv | getpath($path) + else + env + end; + +def extractAtoms(env): + env.atoms // {}; + +def addFrees(newEnv; frees): + . as $env + | reduce frees[] as $free ( + $env; + . as $dot + | extractEnv(newEnv) as $env + | ($free | env_get($env)) as $lookup + | if $lookup != null then + env_set_(.; $free; $lookup) + else + . + end) + | . as $env + | $env; + +def interpret(arguments; env; _eval): + extractReplEnv(env) as $replEnv | + extractAtoms(env) as $envAtoms | + (if $DEBUG then debug("INTERP: \(pr_str(env))") end) | + (select(.kind == "fn") | + arg_check(arguments) | + (select(.function == "eval") | + # special function + { expr: arguments[0], env: $replEnv|wrapEnv($replEnv; $envAtoms) } + | _eval + | .env as $xenv + | extractReplEnv($xenv) as $xreplenv + | setpath( + ["env", "currentEnv"]; + extractEnv(env) | updateReplEnv($xreplenv)) + ) // + (select(.function == "reset!") | + # env modifying function + arguments[0].identity as $id | + ($envAtoms | setpath([$id]; arguments[1])) as $envAtoms | + arguments[1] | + {expr:., env: (env | setpath(["atoms"]; $envAtoms))} + ) // + (select(.function == "swap!") | + # env modifying function + arguments[0].identity as $id | + $envAtoms[$id] as $initValue | + arguments[1] as $function | + ([$initValue] + arguments[2:]) as $args | + ($function | interpret($args; env; _eval)) as $newEnvValue | + ($envAtoms | setpath([$id]; $newEnvValue.expr)) as $envAtoms | + $newEnvValue.expr | + {expr:., env:(env | setpath(["atoms"]; $envAtoms))} + ) // (select(.function == "atom") | + (now|tostring) as $id | + {kind: "atom", identity: $id} as $value | + ($envAtoms | setpath([$id]; arguments[0])) as $envAtoms | + $value | {expr:., env:(env | setpath(["atoms"]; $envAtoms))} + ) // (select(.function == "deref") | + $envAtoms[arguments[0].identity] | {expr:., env:env} + ) // + (select(.function == "apply") | + # (apply F ...T A) -> (F ...T ...A) + arguments as $args + | ($args|first) as $F + | ($args|last.value) as $A + | $args[1:-1] as $T + | $F | interpret([$T[], $A[]]; env; _eval) + ) // + (select(.function == "map") | + arguments + | first as $F + | last.value as $L + | (reduce $L[] as $elem ( + {env: env, val: []}; + . as $dot | + ($F | interpret([$elem]; $dot.env; _eval)) as $val | + { + val: (.val + [$val.expr]), + env: (.env | setpath(["atoms"]; $val.env.atoms)) + } + )) as $ex + | $ex.val | wrap("list") | {expr:., env:$ex.env} + ) // + (core_interp(arguments; env) | {expr:., env:env}) + ) // + (select(.kind == "function") as $fn | + # todo: arg_check + (.body | pr_str(env)) as $src | + # _debug("INTERP " + $src) | + # _debug("FREES " + ($fn.free_referencess | tostring)) | + extractEnv(.env | addFrees(env; $fn.free_referencess)) | + .fallback |= extractEnv(env) | + childEnv($fn.binds; arguments) | + # tell it about its surroundings + (reduce $fn.free_referencess[] as $name ( + .; + . as $env | try env_set_( + .; + $name; + $name | env_get(env) // jqmal_error("'\(.)' not found ") | + . as $xvalue + | if $xvalue.kind == "function" then + setpath(["free_referencess"]; $fn.free_referencess) + else + $xvalue + end + ) catch $env)) | + # tell it about itself + env_multiset($fn) | + wrapEnv($replEnv; $envAtoms) | + { + env: ., + expr: $fn.body + } + | . as $dot + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") + | _eval + | . as $envexp + | (extractReplEnv($envexp.env)) as $xreplenv + | + { + expr: .expr, + env: extractEnv(env) + | updateReplEnv($xreplenv) + | wrapEnv($xreplenv; $envexp.env.atoms) + } + # | . as $dot + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") + # | debug("INTERP \($src) = \(.expr | pr_str)") + ) // + jqmal_error("Unsupported function kind \(.kind)"); + \ No newline at end of file diff --git a/impls/jq/printer.jq b/impls/jq/printer.jq new file mode 100644 index 0000000000..703eb65056 --- /dev/null +++ b/impls/jq/printer.jq @@ -0,0 +1,29 @@ +# {key: string, value: {kkind: kind, value: value}} -> [{kind: value.kkind, value: key}, value.value] +def _reconstruct_hash: + map([{ + kind: .value.kkind, + value: .key + }, + .value.value]); + +def pr_str(env; opt): + (select(.kind == "symbol") | .value) // + (select(.kind == "string") | .value | if opt.readable then tojson else . end) // + (select(.kind == "keyword") | ":\(.value)") // + (select(.kind == "number") | .value | tostring) // + (select(.kind == "list") | .value | map(pr_str(env; opt)) | join(" ") | "(\(.))") // + (select(.kind == "vector") | .value | map(pr_str(env; opt)) | join(" ") | "[\(.)]") // + (select(.kind == "hashmap") | .value | to_entries | _reconstruct_hash | add // [] | map(pr_str(env; opt)) | join(" ") | "{\(.)}") // + (select(.kind == "nil") | "nil") // + (select(.kind == "true") | "true") // + (select(.kind == "false") | "false") // + (select(.kind == "fn") | "#") // + (select(.kind == "function")| "#") // + (select(.kind == "atom") | "(atom \(env.atoms[.identity] | pr_str(env; opt)))") // + "#"; + +def pr_str(env): + pr_str(env; {readable: true}); + +def pr_str: + pr_str(null); # for stepX where X<6 \ No newline at end of file diff --git a/impls/jq/reader.jq b/impls/jq/reader.jq new file mode 100644 index 0000000000..639f8b946f --- /dev/null +++ b/impls/jq/reader.jq @@ -0,0 +1,311 @@ +include "utils"; + +def tokenize: + [ . | scan("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") | select(.|length > 0)[0] | select(.[0:1] != ";") ]; + +def read_str: + tokenize; + +def escape_control: + (select(. == "\u0000") | "\\u0000") // + (select(. == "\u0001") | "\\u0001") // + (select(. == "\u0002") | "\\u0002") // + (select(. == "\u0003") | "\\u0003") // + (select(. == "\u0004") | "\\u0004") // + (select(. == "\u0005") | "\\u0005") // + (select(. == "\u0006") | "\\u0006") // + (select(. == "\u0007") | "\\u0007") // + (select(. == "\u0008") | "\\u0008") // + (select(. == "\u0009") | "\\u0009") // + (select(. == "\u0010") | "\\u0010") // + (select(. == "\u0011") | "\\u0011") // + (select(. == "\u0012") | "\\u0012") // + (select(. == "\u0013") | "\\u0013") // + (select(. == "\u0014") | "\\u0014") // + (select(. == "\u0015") | "\\u0015") // + (select(. == "\u0016") | "\\u0016") // + (select(. == "\u0017") | "\\u0017") // + (select(. == "\u0018") | "\\u0018") // + (select(. == "\u0019") | "\\u0019") // + (select(. == "\u0020") | "\\u0020") // + (select(. == "\u0021") | "\\u0021") // + (select(. == "\u0022") | "\\u0022") // + (select(. == "\u0023") | "\\u0023") // + (select(. == "\u0024") | "\\u0024") // + (select(. == "\u0025") | "\\u0025") // + (select(. == "\u0026") | "\\u0026") // + (select(. == "\u0027") | "\\u0027") // + (select(. == "\u0028") | "\\u0028") // + (select(. == "\u0029") | "\\u0029") // + (select(. == "\u0030") | "\\u0030") // + (select(. == "\u0031") | "\\u0031") // + (select(. == "\n") | "\\n") // + .; + +def read_string: + gsub("(?[\u0000-\u001f])"; "\(.z | escape_control)") | fromjson; + +def extract_string: + . as $val | if ["keyword", "symbol", "string"] | contains([$val.kind]) then + $val.value + else + jqmal_error("assoc called with non-string key of type \($val.kind)") + end; + +# stuff comes in as {tokens: [...], } +def read_atom: + (.tokens | first) as $lookahead | . | ( + if $lookahead == "nil" then + { + tokens: .tokens[1:], + value: { + kind: "nil" + } + } + else if $lookahead == "true" then + { + tokens: .tokens[1:], + value: { + kind: "true" + } + } + else if $lookahead == "false" then + { + tokens: .tokens[1:], + value: { + kind: "false" + } + } + else if $lookahead | test("^\"") then + if $lookahead | test("^\"(?:\\\\.|[^\\\\\"])*\"$") then + { + tokens: .tokens[1:], + value: { + kind: "string", + value: $lookahead | read_string + } + } + else + jqmal_error("EOF while reading string") + end + else if $lookahead | test("^:") then + { + tokens: .tokens[1:], + value: { + kind: "keyword", + value: $lookahead[1:] + } + } + else if $lookahead | test("^-?[0-9]+(?:\\.[0-9]+)?$") then + { + tokens: .tokens[1:], + value: { + kind: "number", + value: $lookahead | tonumber + } + } + else if [")", "]", "}"] | contains([$lookahead]) then # this isn't our business + empty + else + { + tokens: .tokens[1:], + value: { + kind: "symbol", + value: $lookahead + } + } + end end end end end end end + ); + +def read_form_(depth): + (.tokens | first) as $lookahead | . | ( + if $lookahead == null then + null + # read_list + else + if $lookahead | test("^\\(") then + [ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish; + if try (.tokens | first | test("^\\)")) catch true then + .finish |= true + else + . as $orig | read_form_(depth+1) as $res | { + tokens: $res.tokens, + value: ($orig.value + [$res.value]), + finish: $orig.finish + } + end)) ] | map(select(.tokens)) | last as $result | + if $result.tokens | first != ")" then + jqmal_error("unbalanced parentheses in \($result.tokens)") + else + { + tokens: $result.tokens[1:], + value: { + kind: "list", + value: $result.value + }, + } + end + # read_list '[' + else if $lookahead | test("^\\[") then + [ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish; + if try (.tokens | first | test("^\\]")) catch true then + .finish |= true + else + . as $orig | read_form_(depth+1) as $res | { + tokens: $res.tokens, + value: ($orig.value + [$res.value]), + finish: $orig.finish + } + end)) ] | map(select(.tokens)) | last as $result | + if $result.tokens | first != "]" then + jqmal_error("unbalanced brackets in \($result.tokens)") + else + { + tokens: $result.tokens[1:], + value: { + kind: "vector", + value: $result.value + }, + } + end + # read_list '{' + else if $lookahead | test("^\\{") then + [ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish; + if try (.tokens | first | test("^\\}")) catch true then + .finish |= true + else + . as $orig | read_form_(depth+1) as $res | { + tokens: $res.tokens, + value: ($orig.value + [$res.value]), + finish: $orig.finish + } + end)) ] | map(select(.tokens)) | last as $result | + if $result.tokens | first != "}" then + jqmal_error("unbalanced braces in \($result.tokens)") + else + if $result.value | length % 2 == 1 then + # odd number of elements not allowed + jqmal_error("Odd number of parameters to assoc") + else + { + tokens: $result.tokens[1:], + value: { + kind: "hashmap", + value: + [ $result.value | + nwise(2) | + try { + key: (.[0] | extract_string), + value: { + kkind: .[0].kind, + value: .[1] + } + } + ] | from_entries + } + } + end + end + # quote + else if $lookahead == "'" then + (.tokens |= .[1:]) | read_form_(depth+1) | ( + { + tokens: .tokens, + value: { + kind: "list", + value: [ + { + kind: "symbol", + value: "quote" + }, + .value + ] + } + }) + # quasiquote + else if $lookahead == "`" then + (.tokens |= .[1:]) | read_form_(depth+1) | ( + { + tokens: .tokens, + value: { + kind: "list", + value: [ + { + kind: "symbol", + value: "quasiquote" + }, + .value + ] + } + }) + # unquote + else if $lookahead == "~" then + (.tokens |= .[1:]) | read_form_(depth+1) | ( + { + tokens: .tokens, + value: { + kind: "list", + value: [ + { + kind: "symbol", + value: "unquote" + }, + .value + ] + } + }) + # split-unquote + else if $lookahead == "~@" then + (.tokens |= .[1:]) | read_form_(depth+1) | ( + { + tokens: .tokens, + value: { + kind: "list", + value: [ + { + kind: "symbol", + value: "splice-unquote" + }, + .value + ] + } + }) + # deref + else if $lookahead == "@" then + (.tokens |= .[1:]) | read_form_(depth+1) | ( + { + tokens: .tokens, + value: { + kind: "list", + value: [ + { + kind: "symbol", + value: "deref" + }, + .value + ] + } + }) + # with-meta + else if $lookahead == "^" then + (.tokens |= .[1:]) | read_form_(depth+1) as $meta | $meta | read_form_(depth+1) as $value | ( + { + tokens: $value.tokens, + value: { + kind: "list", + value: [ + { + kind: "symbol", + value: "with-meta" + }, + $value.value, + $meta.value + ] + } + }) + else + . as $prev | read_atom + end end end end end end end end end end); + +def read_form: + ({tokens: read_str} | read_form_(0).value) // {kind: "nil"}; diff --git a/impls/jq/run b/impls/jq/run new file mode 100755 index 0000000000..aad2862bdb --- /dev/null +++ b/impls/jq/run @@ -0,0 +1,52 @@ +#!/usr/bin/python3 +"""Spawn a jq subprocess and wrap some IO interactions for it. + +jq seems unable to + - open an arbitrary file (slurp) + - emit a string on stdout without new line (readline) +""" +from json import JSONDecodeError, dumps, loads +from os import environ +from os.path import dirname, join, realpath +from subprocess import PIPE, Popen +from sys import argv + +rundir = dirname(realpath(__file__)) +with Popen(args=['/usr/bin/jq', + '--argjson', 'DEBUG', 'false', + '-nrM', # --null-input --raw-output --monochrome-output + '-L', rundir, + '-f', join(rundir, environ.get('STEP', 'stepA_mal') + '.jq'), + '--args'] + argv[1:], + stdin=PIPE, stderr=PIPE, encoding='utf-8', + ) as proc: + assert proc.stderr is not None # for mypy + for received in proc.stderr: + try: + as_json = loads(received) + except JSONDecodeError: + print(f'JQ STDERR: {received}', end=None) + else: + match as_json: + case ['DEBUG:', ['display', str(message)]]: + # While at it, provide a way to immediately print to + # stdin for DEBUG-EVAL, println and prn (jq is able to + # output to stderr, but *we* are already piping it). + print(message) + # Jq waits for this signal to go on, so that its own + # output is not mixed with our one. + print('null', file=proc.stdin, flush=True) + case ['DEBUG:', ['readline', str(prompt)]]: + try: + data = input(prompt) + except EOFError: + break # Expected end of this script + print(dumps(data), file=proc.stdin, flush=True) + case ['DEBUG:', ['slurp', str(fname)]]: + with open(fname, 'r', encoding='utf-8') as file_handler: + data = file_handler.read() + print(dumps(data), file=proc.stdin, flush=True) + case _: + # Allow normal debugging information for other purposes. + print(f'JQ STDERR: {received}', end=None) +print() diff --git a/impls/jq/step0_repl.jq b/impls/jq/step0_repl.jq new file mode 100644 index 0000000000..e534b4f6ea --- /dev/null +++ b/impls/jq/step0_repl.jq @@ -0,0 +1,18 @@ +include "utils"; + +def READ: + .; + +def EVAL: + .; + +def PRINT: + .; + +def repl: + # Infinite generator, interrupted by ./run. + "user> " | __readline | + READ | EVAL | + PRINT, repl; + +repl diff --git a/impls/jq/step1_read_print.jq b/impls/jq/step1_read_print.jq new file mode 100644 index 0000000000..c253bfa9a4 --- /dev/null +++ b/impls/jq/step1_read_print.jq @@ -0,0 +1,26 @@ +include "reader"; +include "printer"; +include "utils"; + +def READ: + read_form; + +def EVAL: + .; + +def PRINT: + pr_str; + +def repl: + # Infinite generator, interrupted by an exception or ./run. + "user> " | __readline | + try ( + READ | EVAL | + PRINT, repl + ) catch if is_jqmal_error then + ., repl + else + halt_error + end; + +repl diff --git a/impls/jq/step2_eval.jq b/impls/jq/step2_eval.jq new file mode 100644 index 0000000000..83a0e6db6f --- /dev/null +++ b/impls/jq/step2_eval.jq @@ -0,0 +1,99 @@ +include "reader"; +include "printer"; +include "utils"; + +def READ: + read_form; + +def arg_check(args): + if .inputs != (args|length) then + jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") + else + . + end; + +def interpret(arguments; env): + (select(.kind == "fn") | + arg_check(arguments) | + ( + select(.function == "number_add") | + arguments | map(.value) | .[0] + .[1] | wrap("number") + ) // ( + select(.function == "number_sub") | + arguments | map(.value) | .[0] - .[1] | wrap("number") + ) // ( + select(.function == "number_mul") | + arguments | map(.value) | .[0] * .[1] | wrap("number") + ) // ( + select(.function == "number_div") | + arguments | map(.value) | .[0] / .[1] | wrap("number") + ) + ) // + jqmal_error("Unsupported native function kind \(.kind)"); + +def EVAL(env): + # ("EVAL: \(pr_str(env))" | _display | empty), + (select(.kind == "list") | + .value | select(length != 0) as $value | + map(EVAL(env)) | .[1:] as $args | first | interpret($args; env) + ) // + ( + select(.kind == "vector") | + { + kind: "vector", + value: .value|map(EVAL(env)) + } + ) // + ( + select(.kind == "hashmap") | + { + kind: "hashmap", + value: .value|map_values(.value |= EVAL(env)) + } + ) // + ( + select(.kind == "symbol") | + env[.value] // jqmal_error("'\(.)' not found") + ) // + .; + +def PRINT: + pr_str; + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + PRINT, ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +# The main program starts here. + { + "+": { + kind: "fn", # native function + inputs: 2, + function: "number_add" + }, + "-": { + kind: "fn", # native function + inputs: 2, + function: "number_sub" + }, + "*": { + kind: "fn", # native function + inputs: 2, + function: "number_mul" + }, + "/": { + kind: "fn", # native function + inputs: 2, + function: "number_div" + }, + } + | + repl diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq new file mode 100644 index 0000000000..8e074ba441 --- /dev/null +++ b/impls/jq/step3_env.jq @@ -0,0 +1,151 @@ +include "reader"; +include "printer"; +include "utils"; +include "env"; + +def READ: + read_form; + +# Environment Functions + +def env_set(env; $key; $value): + { + parent: env.parent, + environment: (env.environment + (env.environment | .[$key] |= $value)) # merge together, as .environment[key] |= value does not work + }; + +def arg_check(args): + if .inputs != (args|length) then + jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") + else + . + end; + +def interpret(arguments; env): + (select(.kind == "fn") | + arg_check(arguments) | + ( + select(.function == "number_add") | + arguments | map(.value) | .[0] + .[1] | wrap("number") + ) // ( + select(.function == "number_sub") | + arguments | map(.value) | .[0] - .[1] | wrap("number") + ) // ( + select(.function == "number_mul") | + arguments | map(.value) | .[0] * .[1] | wrap("number") + ) // ( + select(.function == "number_div") | + arguments | map(.value) | .[0] / .[1] | wrap("number") + ) + | {expr:., env:env} + ) // + jqmal_error("Unsupported native function kind \(.kind)"); + +def EVAL(env): + if "DEBUG-EVAL" | env_get(env) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) | + ( + select(.[0].value == "def!") | + .[1].value as $key | + .[2] | EVAL(env) | + .expr as $value | + .env |= env_set(.; $key; $value) + ) // + ( + select(.[0].value == "let*") | + (reduce (.[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:env, environment:{}, fallback:null}; + # Loop body + . as $env | $xvalue[1] | EVAL($env) | + env_set(.env; $xvalue[0].value; .expr) + )) as $env | + .[2] | {expr:EVAL($env).expr, env:env} + ) // + ( + reduce .[] as $elem ( + []; + . as $dot | $elem | EVAL(env) as $eval_env | + ($dot + [$eval_env.expr]) + ) | { expr: ., env: env } as $ev + | $ev.expr | first | + interpret($ev.expr[1:]; $ev.env) + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .expr |= {kind:"vector", value:.} + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .expr |= {kind:"hashmap", value:from_entries} + ) // + ( + select(.kind == "symbol") | + .value | + env_get(env) // jqmal_error("'\(.)' not found") | + {expr:., env:env} + ) // + {expr:., env:env}; + +def PRINT: + pr_str; + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + (.expr | PRINT), (.env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +# The main program starts here. + { + parent: null, + environment: { + "+": { + kind: "fn", # native function + inputs: 2, + function: "number_add" + }, + "-": { + kind: "fn", # native function + inputs: 2, + function: "number_sub" + }, + "*": { + kind: "fn", # native function + inputs: 2, + function: "number_mul" + }, + "/": { + kind: "fn", # native function + inputs: 2, + function: "number_div" + }, + } + } + | + repl diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq new file mode 100644 index 0000000000..a05612b902 --- /dev/null +++ b/impls/jq/step4_if_fn_do.jq @@ -0,0 +1,261 @@ +include "reader"; +include "printer"; +include "utils"; +include "env"; +include "core"; + +def READ: + read_form; + +# Environment Functions + +def env_set(env; $key; $value): + (if $value.kind == "function" or $value.kind == "atom" then + # inform the function/atom of its names + $value | (.names += [$key]) | (.names |= unique) | + if $value.kind == "atom" then + # check if the one we have is newer + ($key | env_get(env)) as $ours | + if $ours.last_modified > $value.last_modified then + $ours + else + # update modification timestamp + $value | .last_modified |= now + end + else + . + end + else + $value + end) as $value | { + parent: env.parent, + environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)), # merge together, as env.environment[key] |= value does not work + fallback: env.fallback + }; + +def _env_remove_references(refs): + if . != null then + { + environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries), + parent: (.parent | _env_remove_references(refs)), + fallback: (.fallback | _env_remove_references(refs)) + } + else . end; + +def env_remove_references(refs): + . as $env + | if has("replEnv") then + .currentEnv |= _env_remove_references(refs) + else + _env_remove_references(refs) + end; + +# Evaluation + +def arg_check(args): + if .inputs < 0 then + if (abs(.inputs) - 1) > (args | length) then + jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))") + else + . + end + else if .inputs != (args|length) then + jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") + else + . + end end; + +def addFrees(newEnv; frees): + . as $env + | reduce frees[] as $free ( + $env; + . as $dot + | ($free | env_get(newEnv)) as $lookup + | if $lookup != null then + env_set_(.; $free; $lookup) + else + . + end) + | . as $env + | $env; + +def interpret(arguments; env; _eval): + (if $DEBUG then debug("INTERP: \(. | pr_str(env))") else . end) | + (select(.kind == "fn") | + arg_check(arguments) | + core_interp(arguments; env) | {expr:., env:env} + ) // + (select(.kind == "function") as $fn | + # todo: arg_check + (.body | pr_str(env)) as $src | + # debug("INTERP " + $src) | + # debug("FREES " + ($fn.free_referencess | tostring)) | + .env | + addFrees(env; $fn.free_referencess) | + .fallback |= env | + childEnv($fn.binds; arguments) | + # tell it about its surroundings + (reduce $fn.free_referencess[] as $name ( + .; + . as $env | try env_set( + .; + $name; + $name | env_get(env) // jqmal_error("'\(.)' not found") | + . as $xvalue + | if $xvalue.kind == "function" then + setpath(["free_referencess"]; $fn.free_referencess) + else + $xvalue + end + ) catch $env)) | + # tell it about itself + env_multiset($fn) | + { + env: ., + expr: $fn.body + } + | . as $dot + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") + | _eval + | . as $envexp + | + { + expr: .expr, + env: env + } + # | . as $dot + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") + # | debug("INTERP \($src) = \(.expr | pr_str)") + ) // + jqmal_error("Unsupported function kind \(.kind)"); + +def EVAL(env): + def _eval_here: + .env as $env | .expr | EVAL($env); + + # EVAL starts here. + if "DEBUG-EVAL" | env_get(env) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + select(.[0].value == "def!") | + .[1].value as $key | + .[2] | EVAL(env) | + if .env.replEnv != null then + addToEnv($key) + else + .expr as $def_value | + .env |= env_set_(.; $key; $def_value) + end + ) // + ( + select(.[0].value == "let*") | + (reduce ($value[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:env, environment:{}, fallback:null}; + # Loop body + . as $env | $xvalue[1] | EVAL($env) as $expenv | + env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env + | $value[2] | { expr: EVAL($env).expr, env: env } + ) // + ( + select(.[0].value == "do") | + (reduce ($value[1:][]) as $xvalue ( + { env: env, expr: {kind:"nil"} }; + .env as $env | $xvalue | EVAL($env) + )) + ) // + ( + select(.[0].value == "if") | + $value[1] | EVAL(env) as $condenv | + if (["false", "nil"] | contains([$condenv.expr.kind])) then + ($value[3] // {kind:"nil"}) | EVAL($condenv.env) + else + $value[2] | EVAL($condenv.env) + end + ) // + ( + select(.[0].value == "fn*") | + # we can't do what the guide says, so we'll skip over this + # and ues the later implementation + # (fn* args body) + $value[1].value | map(.value) as $binds | + { + kind: "function", + binds: $binds, + env: env, + body: $value[2], + names: [], # we can't do that circular reference thing + free_referencess: $value[2] | find_free_references(env | env_dump_keys + $binds) # for dynamically scoped variables + } | {expr: ., env:env} + ) // + ( + reduce .[] as $elem ( + []; + . as $dot | $elem | EVAL(env) as $eval_env | + ($dot + [$eval_env.expr]) + ) | { expr: ., env: env } as $ev + | $ev.expr | first | + interpret($ev.expr[1:]; $ev.env; _eval_here) + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .expr |= {kind:"vector", value:.} + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .expr |= {kind:"hashmap", value:from_entries} + ) // + ( + select(.kind == "symbol") | + .value | + env_get(env) // jqmal_error("'\(.)' not found") | + {expr:., env:env} + ) // + {expr:., env:env}; + +def PRINT: + pr_str; + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + (.expr | PRINT), (.env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; + +# The main program starts here. + { + parent: null, + environment: core_identify, + fallback: null + } + | eval_ign("(def! not (fn* (a) (if a false true)))") + | + repl diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq new file mode 100644 index 0000000000..fdb22127c0 --- /dev/null +++ b/impls/jq/step5_tco.jq @@ -0,0 +1,295 @@ +include "reader"; +include "printer"; +include "utils"; +include "env"; +include "core"; + +def READ: + read_form; + +# Environment Functions + +def env_set(env; $key; $value): + (if $value.kind == "function" or $value.kind == "atom" then + # inform the function/atom of its names + $value | (.names += [$key]) | (.names |= unique) | + if $value.kind == "atom" then + # check if the one we have is newer + ($key | env_get(env)) as $ours | + if $ours.last_modified > $value.last_modified then + $ours + else + # update modification timestamp + $value | .last_modified |= now + end + else + . + end + else + $value + end) as $value | { + parent: env.parent, + environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)), # merge together, as env.environment[key] |= value does not work + fallback: env.fallback + }; + +def _env_remove_references(refs): + if . != null then + { + environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries), + parent: (.parent | _env_remove_references(refs)), + fallback: (.fallback | _env_remove_references(refs)) + } + else . end; + +def env_remove_references(refs): + . as $env + | if has("replEnv") then + .currentEnv |= _env_remove_references(refs) + else + _env_remove_references(refs) + end; + +# Evaluation + +def arg_check(args): + if .inputs < 0 then + if (abs(.inputs) - 1) > (args | length) then + jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))") + else + . + end + else if .inputs != (args|length) then + jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") + else + . + end end; + +def addFrees(newEnv; frees): + . as $env + | reduce frees[] as $free ( + $env; + . as $dot + | ($free | env_get(newEnv)) as $lookup + | if $lookup != null then + env_set_(.; $free; $lookup) + else + . + end) + | . as $env + | $env; + +def interpret(arguments; env; _eval): + (if $DEBUG then debug("INTERP: \(. | pr_str(env))") else . end) | + (select(.kind == "fn") | + arg_check(arguments) | + core_interp(arguments; env) | {expr:., env:env} + ) // + (select(.kind == "function") as $fn | + # todo: arg_check + (.body | pr_str(env)) as $src | + # debug("INTERP " + $src) | + # debug("FREES " + ($fn.free_referencess | tostring)) | + .env | + addFrees(env; $fn.free_referencess) | + .fallback |= env | + childEnv($fn.binds; arguments) | + # tell it about its surroundings + (reduce $fn.free_referencess[] as $name ( + .; + . as $env | try env_set( + .; + $name; + $name | env_get(env) // jqmal_error("'\(.)' not found") | + . as $xvalue + | if $xvalue.kind == "function" then + setpath(["free_referencess"]; $fn.free_referencess) + else + $xvalue + end + ) catch $env)) | + # tell it about itself + env_multiset($fn) | + { + env: ., + expr: $fn.body + } + | . as $dot + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") + | _eval + | . as $envexp + | + { + expr: .expr, + env: env + } + # | . as $dot + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") + # | debug("INTERP \($src) = \(.expr | pr_str)") + ) // + jqmal_error("Unsupported function kind \(.kind)"); + +def recurseflip(x; y): + recurse(y; x); + +def TCOWrap(env; retenv; continue): + { + ast: ., + env: env, + ret_env: retenv, + finish: (continue | not), + cont: true # set inside + }; + +def EVAL(env): + def _eval_here: + .env as $env | .expr | EVAL($env); + + . as $ast + | TCOWrap(env; null; true) + | [ recurseflip(.cont; + .env as $_menv + | if .finish then + .cont |= false + else + (.ret_env//.env) as $_retenv + | .ret_env as $_orig_retenv + | .ast + | + if "DEBUG-EVAL" | env_get($_menv) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + select(.[0].value == "def!") | + $value[2] | EVAL($_menv) | + ( + if .env.replEnv != null then + addToEnv($value[1].value) + else + .expr as $def_value | + .env |= env_set_(.; $value[1].value; $def_value) + end + ) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + (reduce ($value[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:$_menv, environment:{}, fallback:null}; + # Loop body + . as $env | $xvalue[1] | EVAL($env) as $expenv | + env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env + | $value[2] | TCOWrap($env; $_retenv; true) + ) // + ( + select(.[0].value == "do") | + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "if") | + $value[1] | EVAL(env) as $condenv | + (if (["false", "nil"] | contains([$condenv.expr.kind])) then + ($value[3] // {kind:"nil"}) + else + $value[2] + end) | TCOWrap($condenv.env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "fn*") | + # (fn* args body) + $value[1].value | map(.value) as $binds | + { + kind: "function", + binds: $binds, + env: $_menv, + body: $value[2], + names: [], # we can't do that circular reference thing + free_referencess: $value[2] | find_free_references($_menv | env_dump_keys + $binds) # for dynamically scoped variables + } | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + reduce .[] as $elem ( + []; + . as $dot | $elem | EVAL($_menv) as $eval_env | + ($dot + [$eval_env.expr]) + ) | . as $expr | first | + interpret($expr[1:]; $_menv; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "function") | + . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to + ) // + ( + select(.kind == "symbol") | + .value | env_get($_menv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + end + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; + +def PRINT: + pr_str; + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + (.expr | PRINT), (.env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; + +# The main program starts here. + { + parent: null, + environment: core_identify, + fallback: null + } + | eval_ign("(def! not (fn* (a) (if a false true)))") + | + repl diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq new file mode 100644 index 0000000000..8d2ed95627 --- /dev/null +++ b/impls/jq/step6_file.jq @@ -0,0 +1,192 @@ +include "reader"; +include "printer"; +include "utils"; +include "interp"; +include "env"; +include "core"; + +def READ: + read_form; + +def recurseflip(x; y): + recurse(y; x); + +def TCOWrap(env; retenv; continue): + { + ast: ., + env: env, + ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), + finish: (continue | not), + cont: true # set inside + }; + +def EVAL(env): + def _eval_here: + .env as $env | .expr | EVAL($env); + + . as $ast + | TCOWrap(env; null; true) + | [ recurseflip(.cont; + .env as $_menv + | if .finish then + .cont |= false + else + (.ret_env//.env) as $_retenv + | .ret_env as $_orig_retenv + | .ast + | . as $init + | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" + | $_menv | unwrapReplEnv as $replEnv # - + | $init + | + if "DEBUG-EVAL" | env_get($currentEnv) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + select(.[0].value == "def!") | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + (reduce ($value[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body + . as $env | $xvalue[1] | EVAL($env) as $expenv | + env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env + | $value[2] | TCOWrap($env; $_retenv; true) + ) // + ( + select(.[0].value == "do") | + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "if") | + $value[1] | EVAL($_menv) as $condenv | + (if (["false", "nil"] | contains([$condenv.expr.kind])) then + ($value[3] // {kind:"nil"}) + else + $value[2] + end) | TCOWrap($condenv.env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "fn*") | + # (fn* args body) + $value[1].value | map(.value) as $binds | + ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { + kind: "function", + binds: $binds, + env: ($_menv | env_remove_references($free_referencess)), + body: $value[2], + names: [], # we can't do that circular reference thing + free_referencess: $free_referencess, # for dynamically scoped variables + } | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . as $dot | $elem | EVAL($dot.env) as $eval_env | + ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | + {env: $_menv, val: ($dot.val + [$eval_env.expr])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "function") | + . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to + ) // + ( + select(.kind == "symbol") | + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + end + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; + +def PRINT(env): + pr_str(env); + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; + +# The main program starts here. + { + parent: null, + environment: core_identify, + fallback: null + } + | wrapEnv({}) + | eval_ign("(def! not (fn* (a) (if a false true)))") + | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | + if $ARGS.positional|length > 0 then + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty + else + repl + end diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq new file mode 100644 index 0000000000..5bd7b188db --- /dev/null +++ b/impls/jq/step7_quote.jq @@ -0,0 +1,235 @@ +include "reader"; +include "printer"; +include "utils"; +include "interp"; +include "env"; +include "core"; + +def READ: + read_form; + +def recurseflip(x; y): + recurse(y; x); + +def TCOWrap(env; retenv; continue): + { + ast: ., + env: env, + ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), + finish: (continue | not), + cont: true # set inside + }; + +def quasiquote: + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | .kind == "symbol" and .value == name) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} + ) // .; + +def EVAL(env): + def _eval_here: + .env as $env | .expr | EVAL($env); + + . as $ast + | TCOWrap(env; null; true) + | [ recurseflip(.cont; + .env as $_menv + | if .finish then + .cont |= false + else + (.ret_env//.env) as $_retenv + | .ret_env as $_orig_retenv + | .ast + | . as $init + | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" + | $_menv | unwrapReplEnv as $replEnv # - + | $init + | + if "DEBUG-EVAL" | env_get($currentEnv) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + select(.[0].value == "def!") | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + (reduce ($value[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body + . as $env | $xvalue[1] | EVAL($env) as $expenv | + env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env + | $value[2] | TCOWrap($env; $_retenv; true) + ) // + ( + select(.[0].value == "do") | + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "if") | + $value[1] | EVAL($_menv) as $condenv | + (if (["false", "nil"] | contains([$condenv.expr.kind])) then + ($value[3] // {kind:"nil"}) + else + $value[2] + end) | TCOWrap($condenv.env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "fn*") | + # (fn* args body) + $value[1].value | map(.value) as $binds | + ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { + kind: "function", + binds: $binds, + env: ($_menv | env_remove_references($free_referencess)), + body: $value[2], + names: [], # we can't do that circular reference thing + free_referencess: $free_referencess, # for dynamically scoped variables + } | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quote") | + $value[1] | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quasiquote") | + $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) + ) // + ( + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . as $dot | $elem | EVAL($dot.env) as $eval_env | + ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | + {env: $_menv, val: ($dot.val + [$eval_env.expr])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "function") | + . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to + ) // + ( + select(.kind == "symbol") | + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + end + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; + +def PRINT(env): + pr_str(env); + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; + +# The main program starts here. + { + parent: null, + environment: core_identify, + fallback: null + } + | wrapEnv({}) + | eval_ign("(def! not (fn* (a) (if a false true)))") + | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | + if $ARGS.positional|length > 0 then + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty + else + repl + end diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq new file mode 100644 index 0000000000..f57834d34c --- /dev/null +++ b/impls/jq/step8_macros.jq @@ -0,0 +1,256 @@ +include "reader"; +include "printer"; +include "utils"; +include "interp"; +include "env"; +include "core"; + +def READ: + read_form; + +def recurseflip(x; y): + recurse(y; x); + +def TCOWrap(env; retenv; continue): + { + ast: ., + env: env, + ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), + finish: (continue | not), + cont: true # set inside + }; + +def quasiquote: + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | .kind == "symbol" and .value == name) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} + ) // .; + +def set_macro_function: + if .kind != "function" then + jqmal_error("expected a function to be defined by defmacro!") + else + .is_macro |= true + end; + +def EVAL(env): + def _eval_here: + .env as $env | .expr | EVAL($env); + + . as $ast + | TCOWrap(env; null; true) + | [ recurseflip(.cont; + .env as $_menv + | if .finish then + .cont |= false + else + (.ret_env//.env) as $_retenv + | .ret_env as $_orig_retenv + | .ast + | . as $init + | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" + | $_menv | unwrapReplEnv as $replEnv # - + | $init + | + if "DEBUG-EVAL" | env_get($currentEnv) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + select(.[0].value == "def!") | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "defmacro!") | + $value[2] | EVAL($_menv) | + .expr |= set_macro_function | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + (reduce ($value[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body + . as $env | $xvalue[1] | EVAL($env) as $expenv | + env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env + | $value[2] | TCOWrap($env; $_retenv; true) + ) // + ( + select(.[0].value == "do") | + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "if") | + $value[1] | EVAL($_menv) as $condenv | + (if (["false", "nil"] | contains([$condenv.expr.kind])) then + ($value[3] // {kind:"nil"}) + else + $value[2] + end) | TCOWrap($condenv.env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "fn*") | + # (fn* args body) + $value[1].value | map(.value) as $binds | + ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { + kind: "function", + binds: $binds, + env: ($_menv | env_remove_references($free_referencess)), + body: $value[2], + names: [], # we can't do that circular reference thing + free_referencess: $free_referencess, # for dynamically scoped variables + is_macro: false + } | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quote") | + $value[1] | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quasiquote") | + $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) + ) // + ( + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + if $fn.kind == "function" and $fn.is_macro then + $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) + else + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . as $dot | $elem | EVAL($dot.env) as $eval_env | + ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | + {env: $_menv, val: ($dot.val + [$eval_env.expr])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + end + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "function") | + . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to + ) // + ( + select(.kind == "symbol") | + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + end + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; + +def PRINT(env): + pr_str(env); + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; + +# The main program starts here. + { + parent: null, + environment: core_identify, + fallback: null + } + | wrapEnv({}) + | eval_ign("(def! not (fn* (a) (if a false true)))") + | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") + | eval_ign("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | + if $ARGS.positional|length > 0 then + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty + else + repl + end diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq new file mode 100644 index 0000000000..d2d79543db --- /dev/null +++ b/impls/jq/step9_try.jq @@ -0,0 +1,284 @@ +include "reader"; +include "printer"; +include "utils"; +include "interp"; +include "env"; +include "core"; + +def READ: + read_form; + +def recurseflip(x; y): + recurse(y; x); + +def TCOWrap(env; retenv; continue): + { + ast: ., + env: env, + ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), + finish: (continue | not), + cont: true # set inside + }; + +def quasiquote: + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | .kind == "symbol" and .value == name) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} + ) // .; + +def set_macro_function: + if .kind != "function" then + jqmal_error("expected a function to be defined by defmacro!") + else + .is_macro |= true + end; + +def EVAL(env): + def _eval_here: + .env as $env | .expr | EVAL($env); + + . as $ast + | TCOWrap(env; null; true) + | [ recurseflip(.cont; + .env as $_menv + | if .finish then + .cont |= false + else + (.ret_env//.env) as $_retenv + | .ret_env as $_orig_retenv + | .ast + | . as $init + | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" + | $_menv | unwrapReplEnv as $replEnv # - + | $init + | + if "DEBUG-EVAL" | env_get($currentEnv) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + select(.[0].value == "def!") | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "defmacro!") | + $value[2] | EVAL($_menv) | + .expr |= set_macro_function | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + (reduce ($value[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body + . as $env | $xvalue[1] | EVAL($env) as $expenv | + env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env + | $value[2] | TCOWrap($env; $_retenv; true) + ) // + ( + select(.[0].value == "do") | + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "try*") | + if $value[2] + and ($value[2].value[0] | .kind == "symbol" and .value == "catch*") + then + try ( + $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) + ) catch ( . as $exc | + (if ($exc | is_jqmal_error) then + $exc[19:] as $ex | + try ( + $ex + | fromjson + ) catch ( + $ex | + wrap("string") + ) + else + $exc|wrap("string") + end) as $exc | + $value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex | + $ex.expr | TCOWrap($ex.env; $_retenv; false) + ) + else + $value[1] | EVAL($_menv) as $exp | + $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) + end + ) // + ( + select(.[0].value == "if") | + $value[1] | EVAL($_menv) as $condenv | + (if (["false", "nil"] | contains([$condenv.expr.kind])) then + ($value[3] // {kind:"nil"}) + else + $value[2] + end) | TCOWrap($condenv.env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "fn*") | + # (fn* args body) + $value[1].value | map(.value) as $binds | + ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { + kind: "function", + binds: $binds, + env: ($_menv | env_remove_references($free_referencess)), + body: $value[2], + names: [], # we can't do that circular reference thing + free_referencess: $free_referencess, # for dynamically scoped variables + is_macro: false + } | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quote") | + $value[1] | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quasiquote") | + $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) + ) // + ( + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + if $fn.kind == "function" and $fn.is_macro then + $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) + else + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . as $dot | $elem | EVAL($dot.env) as $eval_env | + ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | + {env: $_menv, val: ($dot.val + [$eval_env.expr])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + end + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "function") | + . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to + ) // + ( + select(.kind == "symbol") | + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + end + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; + +def PRINT(env): + pr_str(env); + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; + +# The main program starts here. + { + parent: null, + environment: core_identify, + fallback: null + } + | wrapEnv({}) + | eval_ign("(def! not (fn* (a) (if a false true)))") + | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") + | eval_ign("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | + if $ARGS.positional|length > 0 then + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty + else + repl + end diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq new file mode 100644 index 0000000000..59bcfb7841 --- /dev/null +++ b/impls/jq/stepA_mal.jq @@ -0,0 +1,293 @@ +include "reader"; +include "printer"; +include "utils"; +include "interp"; +include "env"; +include "core"; + +def READ: + read_form; + +def recurseflip(x; y): + recurse(y; x); + +def TCOWrap(env; retenv; continue): + { + ast: ., + env: env, + ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), + finish: (continue | not), + cont: true # set inside + }; + +def quasiquote: + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | .kind == "symbol" and .value == name) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} + ) // .; + +def set_macro_function: + if .kind != "function" then + jqmal_error("expected a function to be defined by defmacro!") + else + .is_macro |= true + end; + +def EVAL(env): + def _eval_here: + .env as $env | .expr | EVAL($env); + + . as $ast + | TCOWrap(env; null; true) + | [ recurseflip(.cont; + .env as $_menv + | (if $DEBUG then debug("EVAL: \($ast | pr_str($_menv))") else . end) + | (if $DEBUG then debug("ATOMS: \($_menv.atoms)") else . end) + | if .finish then + .cont |= false + else + (.ret_env//.env) as $_retenv + | .ret_env as $_orig_retenv + | .ast + | . as $init + | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" + | $_menv | unwrapReplEnv as $replEnv # - + | $init + | + if "DEBUG-EVAL" | env_get($currentEnv) | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + select(.[0].value == "atoms??") | + $_menv.atoms | keys | map(wrap("string")) | wrap("list") | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "def!") | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "defmacro!") | + $value[2] | EVAL($_menv) | + .expr |= set_macro_function | + addToEnv($value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + (reduce ($value[1].value | nwise(2)) as $xvalue ( + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body + . as $env | $xvalue[1] | EVAL($env) as $expenv | + env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env + | $value[2] | TCOWrap($env; $_retenv; true) + ) // + ( + select(.[0].value == "do") | + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "try*") | + if $value[2] + and ($value[2].value[0] | .kind == "symbol" and .value == "catch*") + then + try ( + $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) + ) catch ( . as $exc | + (if ($exc | is_jqmal_error) then + $exc[19:] as $ex | + try ( + $ex + | fromjson + ) catch ( + $ex | + wrap("string") + ) + else + $exc|wrap("string") + end) as $exc | + $value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex | + $ex.expr | TCOWrap($ex.env; $_retenv; false) + ) + else + $value[1] | EVAL($_menv) as $exp | + $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) + end + ) // + ( + select(.[0].value == "if") | + $value[1] | EVAL($_menv) as $condenv | + (if (["false", "nil"] | contains([$condenv.expr.kind])) then + ($value[3] // {kind:"nil"}) + else + $value[2] + end) | TCOWrap($condenv.env; $_orig_retenv; true) + ) // + ( + select(.[0].value == "fn*") | + # (fn* args body) + $value[1].value | map(.value) as $binds | + ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { + kind: "function", + binds: $binds, + env: ($_menv | env_remove_references($free_referencess)), + body: $value[2], + names: [], # we can't do that circular reference thing + free_referencess: $free_referencess, # for dynamically scoped variables + is_macro: false + } | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quote") | + $value[1] | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quasiquote") | + $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) + ) // + ( + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + if $fn.kind == "function" and $fn.is_macro then + $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) + else + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . as $dot | $elem | EVAL($dot.env) as $eval_env | + ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | + {env: $_menv, val: ($dot.val + [$eval_env.expr])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + end + ) + ) // + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) + ) // + ( + select(.kind == "function") | + . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to + ) // + ( + select(.kind == "symbol") | + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + end + | (if $DEBUG then debug("POSTEVAL: \($ast | pr_str($_menv)) = \(.ast | pr_str($_menv))") else . end) + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; + +def PRINT(env): + pr_str(env); + +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; + +# The main program starts here. + { + parent: null, + environment: core_identify, + fallback: null + } + | wrapEnv({}) + | eval_ign("(def! *host-language* \"jq\")") + | eval_ign("(def! not (fn* (a) (if a false true)))") + | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") + | eval_ign("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | + if $ARGS.positional|length > 0 then + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty + else + eval_ign("(println (str \"Mal [\" *host-language* \"]\"))") | + repl + end diff --git a/impls/jq/utils.jq b/impls/jq/utils.jq new file mode 100644 index 0000000000..6956eab813 --- /dev/null +++ b/impls/jq/utils.jq @@ -0,0 +1,82 @@ +def nwise(n): + def _nwise: + if length <= n then + . + else + .[0:n], (.[n:] | _nwise) + end; + _nwise; + +def abs(x): + if x < 0 then 0 - x else x end; + +def jqmal_error(e): + error("JqMAL Exception :: " + e); + +def is_jqmal_error: + startswith("JqMAL Exception :: "); + +def wrap(kind): + { + kind: kind, + value: . + }; + +def find_free_references(keys): + def _refs: + if . == null then [] else + . as $dot + | if .kind == "symbol" then + if keys | contains([$dot.value]) then [] else [$dot.value] end + else if "list" == $dot.kind then + if $dot.value|length == 0 then + [] + else + # if - scan args + # def! - scan body + # let* - add keys sequentially, scan body + # fn* - add keys, scan body + # quote - [] + # quasiquote - ??? + $dot.value[0] as $head + | if $head.kind == "symbol" then + ( + select($head.value == "if") | $dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x) + ) // ( + select($head.value == "def!") | $dot.value[2] | _refs + ) // ( + select($head.value == "let*") | $dot.value[2] | find_free_references(($dot.value[1].value as $value | ([ range(0; $value|length; 2) ] | map(select(. % 2 == 0) | $value[.].value))) + keys) + ) // ( + select($head.value == "fn*") | $dot.value[2] | find_free_references(($dot.value[1].value | map(.value)) + keys) + ) // ( + select($head.value == "quote") | [] + ) // ( + select($head.value == "quasiquote") | [] + ) // ($dot.value | map(_refs) | reduce .[] as $x ([]; . + $x)) + else + [ $dot.values[1:][] | _refs ] + end + end + else if "vector" == $dot.kind then + ($dot.value | map(_refs) | reduce .[] as $x ([]; . + $x)) + else if "hashmap" == $dot.kind then + ([$dot.value | to_entries[] | ({kind: .value.kkind, value: .key}, .value.value) ] | map(_refs) | reduce .[] as $x ([]; . + $x)) + else + [] + end end end end + end; + _refs | unique; + +# The following IO actions are implemented in rts.py. + +def __readline: + ["readline", .] | debug | input; + +# The output is not very interesting. +# 'input' here only ensures that the python process has printed the +# message before any further output by the jq process. +def _display: + ["display", .] | debug | input; + +def slurp: + ["slurp", .] | debug | input; diff --git a/impls/js/Dockerfile b/impls/js/Dockerfile new file mode 100644 index 0000000000..c189a1ac3f --- /dev/null +++ b/impls/js/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm + +ENV NPM_CONFIG_CACHE /mal/.npm diff --git a/impls/js/Makefile b/impls/js/Makefile new file mode 100644 index 0000000000..faef0bfe28 --- /dev/null +++ b/impls/js/Makefile @@ -0,0 +1,43 @@ + +TESTS = tests/types.js tests/reader.js + +SOURCES_BASE = node_readline.js types.js reader.js printer.js interop.js +SOURCES_LISP = env.js core.js stepA_mal.js +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) +WEB_SOURCES = $(SOURCES:node_readline.js=jq_readline.js) + +STEPS = step0_repl.js step1_read_print.js step2_eval.js step3_env.js \ + step4_if_fn_do.js step5_tco.js step6_file.js \ + step7_quote.js step8_macros.js step9_try.js stepA_mal.js + +all: node_modules + +dist: mal.js mal web/mal.js + +node_modules: + npm install + +$(STEPS): node_modules + +mal.js: $(SOURCES) + cat $+ | grep -v "= *require('./" >> $@ + +mal: mal.js + echo "#!/usr/bin/env node" > $@ + cat $< >> $@ + chmod +x $@ + +web/mal.js: $(WEB_SOURCES) + cat $+ | grep -v "= *require('./" > $@ + +clean: + rm -f mal.js web/mal.js + rm -rf node_modules + +.PHONY: tests $(TESTS) + +tests: $(TESTS) + +$(TESTS): + @echo "Running $@"; \ + node $@ || exit 1; \ diff --git a/js/core.js b/impls/js/core.js similarity index 79% rename from js/core.js rename to impls/js/core.js index d2be63b7ca..2df84831aa 100644 --- a/js/core.js +++ b/impls/js/core.js @@ -6,7 +6,8 @@ if (typeof module === 'undefined') { var types = require('./types'), readline = require('./node_readline'), reader = require('./reader'), - printer = require('./printer'); + printer = require('./printer'), + interop = require('./interop'); } // Errors/Exceptions @@ -94,15 +95,24 @@ function concat(lst) { lst = lst || []; return lst.concat.apply(lst, Array.prototype.slice.call(arguments, 1)); } +function vec(lst) { + if (types._list_Q(lst)) { + var v = Array.prototype.slice.call(lst, 0); + v.__isvector__ = true; + return v; + } else { + return lst; + } +} function nth(lst, idx) { if (idx < lst.length) { return lst[idx]; } else { throw new Error("nth: index out of range"); } } -function first(lst) { return lst[0]; } +function first(lst) { return (lst === null) ? null : lst[0]; } -function rest(lst) { return lst.slice(1); } +function rest(lst) { return (lst == null) ? [] : lst.slice(1); } function empty_Q(lst) { return lst.length === 0; } @@ -122,6 +132,21 @@ function conj(lst) { } } +function seq(obj) { + if (types._list_Q(obj)) { + return obj.length > 0 ? obj : null; + } else if (types._vector_Q(obj)) { + return obj.length > 0 ? Array.prototype.slice.call(obj, 0): null; + } else if (types._string_Q(obj)) { + return obj.length > 0 ? obj.split('') : null; + } else if (obj === null) { + return null; + } else { + throw new Error("seq: called on non-sequence"); + } +} + + function apply(f) { var args = Array.prototype.slice.call(arguments, 1); return f.apply(f, args.slice(0, args.length-1).concat(args[args.length-1])); @@ -159,6 +184,17 @@ function swap_BANG(atm, f) { return atm.val; } +function js_eval(str) { + return interop.js_to_mal(eval(str.toString())); +} + +function js_method_call(object_method_str) { + var args = Array.prototype.slice.call(arguments, 1), + r = interop.resolve_js(object_method_str), + obj = r[0], f = r[1]; + var res = f.apply(obj, args); + return interop.js_to_mal(res); +} // types.ns is namespace of type functions var ns = {'type': types._obj_type, @@ -167,10 +203,14 @@ var ns = {'type': types._obj_type, 'nil?': types._nil_Q, 'true?': types._true_Q, 'false?': types._false_Q, + 'number?': types._number_Q, + 'string?': types._string_Q, 'symbol': types._symbol, 'symbol?': types._symbol_Q, 'keyword': types._keyword, 'keyword?': types._keyword_Q, + 'fn?': types._fn_Q, + 'macro?': types._macro_Q, 'pr-str': pr_str, 'str': str, @@ -205,6 +245,7 @@ var ns = {'type': types._obj_type, 'sequential?': types._sequential_Q, 'cons': cons, 'concat': concat, + 'vec': vec, 'nth': nth, 'first': first, 'rest': rest, @@ -212,7 +253,9 @@ var ns = {'type': types._obj_type, 'count': count, 'apply': apply, 'map': map, + 'conj': conj, + 'seq': seq, 'with-meta': with_meta, 'meta': meta, @@ -220,6 +263,10 @@ var ns = {'type': types._obj_type, 'atom?': types._atom_Q, "deref": deref, "reset!": reset_BANG, - "swap!": swap_BANG}; + "swap!": swap_BANG, + + 'js-eval': js_eval, + '.': js_method_call +}; exports.ns = core.ns = ns; diff --git a/impls/js/env.js b/impls/js/env.js new file mode 100644 index 0000000000..45d9a28bbe --- /dev/null +++ b/impls/js/env.js @@ -0,0 +1,43 @@ +// Node vs browser behavior +var env = {}; +if (typeof module === 'undefined') { + var exports = env; +} + +// Env implementation +function Env(outer, binds, exprs) { + this.data = {}; + this.outer = outer || null; + + if (binds && exprs) { + // Returns a new Env with symbols in binds bound to + // corresponding values in exprs + // TODO: check types of binds and exprs and compare lengths + for (var i=0; i "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i "); + if (line === null) { break; } + if (line) { printer.println(rep(line)); } + } +} diff --git a/js/step1_read_print.js b/impls/js/step1_read_print.js similarity index 86% rename from js/step1_read_print.js rename to impls/js/step1_read_print.js index f1fb0269be..d712a2f2bd 100644 --- a/js/step1_read_print.js +++ b/impls/js/step1_read_print.js @@ -33,9 +33,9 @@ if (typeof require !== 'undefined' && require.main === module) { try { if (line) { printer.println(rep(line)); } } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } diff --git a/impls/js/step2_eval.js b/impls/js/step2_eval.js new file mode 100644 index 0000000000..1793127d35 --- /dev/null +++ b/impls/js/step2_eval.js @@ -0,0 +1,82 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function _EVAL(ast, env) { + // printer.println("EVAL:", printer._pr_str(ast, true)); + // Non-list types. + if (types._symbol_Q(ast)) { + if (ast.value in env) { + return env[ast.value]; + } else { + throw new Error("'" + ast.value + "' not found"); + } + } else if (types._list_Q(ast)) { + // Exit this switch. + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[k] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } + + if (ast.length === 0) { + return ast; + } + + // apply list + var f = EVAL(ast[0], env); + var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); + return f.apply(f, args); +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +repl_env = {}; +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +repl_env['+'] = function(a,b){return a+b;}; +repl_env['-'] = function(a,b){return a-b;}; +repl_env['*'] = function(a,b){return a*b;}; +repl_env['/'] = function(a,b){return a/b;}; + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/step3_env.js b/impls/js/step3_env.js new file mode 100644 index 0000000000..59f392fd57 --- /dev/null +++ b/impls/js/step3_env.js @@ -0,0 +1,104 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function _EVAL(ast, env) { + // Show a trace if DEBUG-EVAL is enabled. + var dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv !== null) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval !== null && dbgeval !== false) + printer.println("EVAL:", printer._pr_str(ast, true)); + } + // Non-list types. + if (types._symbol_Q(ast)) { + return env.get(ast.value); + } else if (types._list_Q(ast)) { + // Exit this switch. + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[k] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } + + if (ast.length === 0) { + return ast; + } + + // apply list + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + if (!a1.constructor || a1.constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + return env.set(a1.value, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); + } + return EVAL(a2, let_env); + default: + var f = EVAL(a0, env); + var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); + return f.apply(f, args); + } +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var repl_env = new Env(); +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +repl_env.set('+', function(a,b){return a+b;}); +repl_env.set('-', function(a,b){return a-b;}); +repl_env.set('*', function(a,b){return a*b;}); +repl_env.set('/', function(a,b){return a/b;}); + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/step4_if_fn_do.js b/impls/js/step4_if_fn_do.js new file mode 100644 index 0000000000..a3f00dccbc --- /dev/null +++ b/impls/js/step4_if_fn_do.js @@ -0,0 +1,122 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function _EVAL(ast, env) { + // Show a trace if DEBUG-EVAL is enabled. + var dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv !== null) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval !== null && dbgeval !== false) + printer.println("EVAL:", printer._pr_str(ast, true)); + } + // Non-list types. + if (types._symbol_Q(ast)) { + return env.get(ast.value); + } else if (types._list_Q(ast)) { + // Exit this switch. + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[k] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } + + if (ast.length === 0) { + return ast; + } + + // apply list + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + if (!a1.constructor || a1.constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + return env.set(a1.value, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); + } + return EVAL(a2, let_env); + case "do": + for (var i=1; i < ast.length - 1; i++) { + EVAL(ast[i], env); + } + return EVAL(ast[ast.length-1], env); + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + return typeof a3 !== "undefined" ? EVAL(a3, env) : null; + } else { + return EVAL(a2, env); + } + case "fn*": + return function() { + return EVAL(a2, new Env(env, a1, arguments)); + }; + default: + var f = EVAL(a0, env); + var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); + return f.apply(f, args); + } +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var repl_env = new Env(); +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +// core.js: defined using javascript +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/step5_tco.js b/impls/js/step5_tco.js new file mode 100644 index 0000000000..c1edd51d64 --- /dev/null +++ b/impls/js/step5_tco.js @@ -0,0 +1,132 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function _EVAL(ast, env) { + while (true) { + // Show a trace if DEBUG-EVAL is enabled. + var dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv !== null) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval !== null && dbgeval !== false) + printer.println("EVAL:", printer._pr_str(ast, true)); + } + // Non-list types. + if (types._symbol_Q(ast)) { + return env.get(ast.value); + } else if (types._list_Q(ast)) { + // Exit this switch. + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[k] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } + + if (ast.length === 0) { + return ast; + } + + // apply list + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + if (!a1.constructor || a1.constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + return env.set(a1.value, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); + } + ast = a2; + env = let_env; + break; + case "do": + for (var i=1; i < ast.length - 1; i++) { + EVAL(ast[i], env); + } + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; + } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var f = EVAL(a0, env); + var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); + if (f.__ast__) { + ast = f.__ast__; + env = f.__gen_env__(args); + } else { + return f.apply(f, args); + } + } + + } +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var repl_env = new Env(); +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +// core.js: defined using javascript +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/step6_file.js b/impls/js/step6_file.js new file mode 100644 index 0000000000..37c214b3f4 --- /dev/null +++ b/impls/js/step6_file.js @@ -0,0 +1,142 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function _EVAL(ast, env) { + while (true) { + // Show a trace if DEBUG-EVAL is enabled. + var dbgevalenv = env.find("DEBUG-EVAL"); + if (dbgevalenv !== null) { + var dbgeval = env.get("DEBUG-EVAL"); + if (dbgeval !== null && dbgeval !== false) + printer.println("EVAL:", printer._pr_str(ast, true)); + } + // Non-list types. + if (types._symbol_Q(ast)) { + return env.get(ast.value); + } else if (types._list_Q(ast)) { + // Exit this switch. + } else if (types._vector_Q(ast)) { + var v = ast.map(function(a) { return EVAL(a, env); }); + v.__isvector__ = true; + return v; + } else if (types._hash_map_Q(ast)) { + var new_hm = {}; + for (k in ast) { + new_hm[k] = EVAL(ast[k], env); + } + return new_hm; + } else { + return ast; + } + + if (ast.length === 0) { + return ast; + } + + // apply list + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + if (!a1.constructor || a1.constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + return env.set(a1.value, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { + throw new Error("env.get key must be a symbol") + } + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); + } + ast = a2; + env = let_env; + break; + case "do": + for (var i=1; i < ast.length - 1; i++) { + EVAL(ast[i], env); + } + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; + } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var f = EVAL(a0, env); + var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); + if (f.__ast__) { + ast = f.__ast__; + env = f.__gen_env__(args); + } else { + return f.apply(f, args); + } + } + + } +} + +function EVAL(ast, env) { + var result = _EVAL(ast, env); + return (typeof result !== "undefined") ? result : null; +} + +// print +function PRINT(exp) { + return printer._pr_str(exp, true); +} + +// repl +var repl_env = new Env(); +var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; + +// core.js: defined using javascript +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } +repl_env.set('eval', function(ast) { + return EVAL(ast, repl_env); }); +repl_env.set('*ARGV*', []); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + +if (typeof process !== 'undefined' && process.argv.length > 2) { + repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/step7_quote.js b/impls/js/step7_quote.js new file mode 100644 index 0000000000..1a9fc2affc --- /dev/null +++ b/impls/js/step7_quote.js @@ -0,0 +1,170 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; + } else { + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 2) { + repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/step8_macros.js b/impls/js/step8_macros.js new file mode 100644 index 0000000000..474c043547 --- /dev/null +++ b/impls/js/step8_macros.js @@ -0,0 +1,181 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; + } else { + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +if (typeof process !== 'undefined' && process.argv.length > 2) { + repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/step9_try.js b/impls/js/step9_try.js new file mode 100644 index 0000000000..cea5c961b3 --- /dev/null +++ b/impls/js/step9_try.js @@ -0,0 +1,192 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; + } else { + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +if (typeof process !== 'undefined' && process.argv.length > 2) { + repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/impls/js/stepA_mal.js b/impls/js/stepA_mal.js new file mode 100644 index 0000000000..e8bd61e68e --- /dev/null +++ b/impls/js/stepA_mal.js @@ -0,0 +1,194 @@ +if (typeof module !== 'undefined') { + var types = require('./types'); + var readline = require('./node_readline'); + var reader = require('./reader'); + var printer = require('./printer'); + var Env = require('./env').Env; + var core = require('./core'); +} + +// read +function READ(str) { + return reader.read_str(str); +} + +// eval +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; + } else { + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +if (typeof process !== 'undefined' && process.argv.length > 2) { + repl_env.set('*ARGV*', process.argv.slice(3)); + rep('(load-file "' + process.argv[2] + '")'); + process.exit(0); +} + +// repl loop +if (typeof require !== 'undefined' && require.main === module) { + // Synchronous node.js commandline mode + rep("(println (str \"Mal [\" *host-language* \"]\"))"); + while (true) { + var line = readline.readline("user> "); + if (line === null) { break; } + try { + if (line) { printer.println(rep(line)); } + } catch (exc) { + if (exc instanceof reader.BlankException) { continue } + if (exc instanceof Error) { console.warn(exc.stack) } + else { console.warn("Error: " + printer._pr_str(exc, true)) } + } + } +} diff --git a/js/tests/common.js b/impls/js/tests/common.js similarity index 100% rename from js/tests/common.js rename to impls/js/tests/common.js diff --git a/js/tests/node_modules b/impls/js/tests/node_modules similarity index 100% rename from js/tests/node_modules rename to impls/js/tests/node_modules diff --git a/js/tests/reader.js b/impls/js/tests/reader.js similarity index 100% rename from js/tests/reader.js rename to impls/js/tests/reader.js diff --git a/impls/js/tests/step5_tco.mal b/impls/js/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/js/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/js/tests/stepA_mal.mal b/impls/js/tests/stepA_mal.mal new file mode 100644 index 0000000000..54127682d9 --- /dev/null +++ b/impls/js/tests/stepA_mal.mal @@ -0,0 +1,39 @@ +;; Testing basic bash interop + +(js-eval "7") +;=>7 + +(js-eval "'7'") +;=>"7" + +(js-eval "[7,8,9]") +;=>(7 8 9) + +(js-eval "console.log('hello');") +;/hello +;=>nil + +(js-eval "foo=8;") +(js-eval "foo;") +;=>8 + +(js-eval "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") +;=>"XaY XbY XcY" + +(js-eval "[1,2,3].map(function(x){return 1+x})") +;=>(2 3 4) + +(js-eval (str "3 * " (* 4 5))) +;=>60 + +(. "console.log" "abc" 123 '(4 5 6) {"kk" "vv"} (= 1 1) nil) +;/abc 123 \[ 4, 5, 6 \] \{ kk: 'vv' \} true null +;=>nil + +(js-eval "myobj = { v: 10, myfunc: function(a,b,c) { return a * b * c * this.v; } }") +(. "myobj.myfunc" 2 3 4) +;=>240 + +(js-eval "myarray = [1,2,3,4,5]") +(. "myarray.join" "#") +;=>"1#2#3#4#5" diff --git a/js/tests/types.js b/impls/js/tests/types.js similarity index 100% rename from js/tests/types.js rename to impls/js/tests/types.js diff --git a/js/types.js b/impls/js/types.js similarity index 88% rename from js/types.js rename to impls/js/types.js index e3901b7dee..0fb324e711 100644 --- a/js/types.js +++ b/impls/js/types.js @@ -43,12 +43,9 @@ function _equal_Q (a, b) { } return true; case 'hash-map': - var akeys = Object.keys(a).sort(), - bkeys = Object.keys(b).sort(); - if (akeys.length !== bkeys.length) { return false; } - for (var i=0; i + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Julia +RUN apt-get -y install software-properties-common +RUN apt-add-repository -y ppa:staticfloat/juliareleases +RUN apt-get update -y +RUN apt-get -y install julia + diff --git a/impls/julia/Makefile b/impls/julia/Makefile new file mode 100644 index 0000000000..82fa2ef848 --- /dev/null +++ b/impls/julia/Makefile @@ -0,0 +1,4 @@ +all: + +clean: + diff --git a/impls/julia/core.jl b/impls/julia/core.jl new file mode 100644 index 0000000000..a210db292e --- /dev/null +++ b/impls/julia/core.jl @@ -0,0 +1,141 @@ +module core + +import types +import reader +using printer +import readline_mod + +export ns + +function string_Q(obj) + isa(obj,AbstractString) && (length(obj) == 0 || obj[1] != '\u029e') +end + +function keyword_Q(obj) + isa(obj,AbstractString) && (length(obj) > 0 && obj[1] == '\u029e') +end + +function concat(args...) + res = [] + for a=args + res = [res; Any[a...]] + end + res +end + +function do_apply(f, all_args...) + fn = isa(f,types.MalFunc) ? f.fn : f + args = concat(all_args[1:end-1], all_args[end]) + fn(args...) +end + +function do_map(a,b) + # map and convert to array/list + if isa(a,types.MalFunc) + collect(map(a.fn,b)) + else + collect(map(a,b)) + end +end + +function conj(seq, args...) + if isa(seq,Array) + concat(reverse(args), seq) + else + tuple(concat(seq, args)...) + end +end + +function do_seq(obj) + if isa(obj,Array) + length(obj) > 0 ? obj : nothing + elseif isa(obj,Tuple) + length(obj) > 0 ? Any[obj...] : nothing + elseif isa(obj,AbstractString) + length(obj) > 0 ? [string(c) for c=obj] : nothing + elseif obj == nothing + nothing + else + error("seq: called on non-sequence") + end +end + + +function with_meta(obj, meta) + new_obj = types.copy(obj) + new_obj.meta = meta + new_obj +end + +ns = Dict{Any,Any}( + symbol("=") => (a,b) -> types.equal_Q(a, b), + :throw => (a) -> throw(types.MalException(a)), + + symbol("nil?") => (a) -> a === nothing, + symbol("true?") => (a) -> a === true, + symbol("false?") => (a) -> a === false, + symbol("string?") => string_Q, + symbol("symbol") => (a) -> symbol(a), + symbol("symbol?") => (a) -> typeof(a) === Symbol, + symbol("keyword") => (a) -> a[1] == '\u029e' ? a : "\u029e$(a)", + symbol("keyword?") => keyword_Q, + symbol("number?") => (a) -> isa(a, AbstractFloat) || isa(a, Int64), + symbol("fn?") => (a) -> isa(a, Function) || (isa(a, types.MalFunc) && !a.ismacro), + symbol("macro?") => (a) -> isa(a, types.MalFunc) && a.ismacro, + + symbol("pr-str") => (a...) -> join(map((e)->pr_str(e, true),a)," "), + :str => (a...) -> join(map((e)->pr_str(e, false),a),""), + :prn => (a...) -> println(join(map((e)->pr_str(e, true),a)," ")), + :println => (a...) -> println(join(map((e)->pr_str(e, false),a)," ")), + symbol("read-string") => (a) -> reader.read_str(a), + :readline => readline_mod.do_readline, + :slurp => (a) -> readall(open(a)), + + :< => <, + :<= => <=, + :> => >, + :>= => >=, + :+ => +, + :- => -, + symbol("*") => *, + :/ => div, + symbol("time-ms") => () -> round(Int, time()*1000), + + :list => (a...) -> Any[a...], + symbol("list?") => (a) -> isa(a, Array), + :vector => (a...) -> tuple(a...), + symbol("vector?") => (a) -> isa(a, Tuple), + symbol("hash-map") => types.hash_map, + symbol("map?") => (a) -> isa(a, Dict), + :assoc => (a, b...) -> merge(a, types.hash_map(b...)), + :dissoc => (a, b...) -> foldl((x,y) -> delete!(x,y),copy(a), b), + :get => (a,b) -> a === nothing ? nothing : get(a,b,nothing), + symbol("contains?") => haskey, + :keys => (a) -> [keys(a)...], + :vals => (a) -> [values(a)...], + + symbol("sequential?") => types.sequential_Q, + :cons => (a,b) -> [Any[a]; Any[b...]], + :concat => concat, + :vec => (a) -> tuple(a...), + :nth => (a,b) -> b+1 > length(a) ? error("nth: index out of range") : a[b+1], + :first => (a) -> a === nothing || isempty(a) ? nothing : first(a), + :rest => (a) -> a === nothing ? Any[] : Any[a[2:end]...], + symbol("empty?") => isempty, + :count => (a) -> a == nothing ? 0 : length(a), + :apply => do_apply, + :map => do_map, + + :conj => conj, + :seq => do_seq, + + :meta => (a) -> isa(a,types.MalFunc) ? a.meta : nothing, + symbol("with-meta") => with_meta, + :atom => (a) -> types.Atom(a), + symbol("atom?") => (a) -> isa(a,types.Atom), + :deref => (a) -> a.val, + :reset! => (a,b) -> a.val = b, + :swap! => (a,b,c...) -> a.val = do_apply(b, a.val, c), + ) + +end diff --git a/impls/julia/env.jl b/impls/julia/env.jl new file mode 100644 index 0000000000..2451b51fa9 --- /dev/null +++ b/impls/julia/env.jl @@ -0,0 +1,55 @@ +module env + +export Env, env_set, env_find, env_get + +type Env + outer::Any + data::Dict{Symbol,Any} +end + +function Env() + Env(nothing, Dict()) +end + +function Env(outer) + Env(outer, Dict()) +end + +function Env(outer, binds, exprs) + e = Env(outer, Dict()) + for i=1:length(binds) + if binds[i] == :& + e.data[binds[i+1]] = exprs[i:end] + break + else + e.data[binds[i]] = exprs[i] + end + end + e +end + + +function env_set(env::Env, k::Symbol, v) + env.data[k] = v +end + +function env_find(env::Env, k::Symbol) + if haskey(env.data, k) + env + elseif env.outer != nothing + env_find(env.outer, k) + else + nothing + end +end + +function env_get(env::Env, k::Symbol) + e = env_find(env, k) + if e != nothing + e.data[k] + else + error("'$(string(k))' not found") + end +end + +end diff --git a/impls/julia/printer.jl b/impls/julia/printer.jl new file mode 100644 index 0000000000..44e0b1e850 --- /dev/null +++ b/impls/julia/printer.jl @@ -0,0 +1,40 @@ +module printer + +import types + +export pr_str + +function pr_str(obj, print_readably=true) + _r = print_readably + if isa(obj, Array) + "($(join([pr_str(o, _r) for o=obj], " ")))" + elseif isa(obj, Tuple) + "[$(join([pr_str(o, _r) for o=obj], " "))]" + elseif isa(obj, Dict) + "{$(join(["$(pr_str(o[1],_r)) $(pr_str(o[2],_r))" for o=obj], " "))}" + elseif isa(obj, AbstractString) + if length(obj) > 0 && obj[1] == '\u029e' + ":$(obj[3:end])" + elseif _r + str = replace(replace(replace(obj, + "\\", "\\\\"), + "\"", "\\\""), + "\n", "\\n") + "\"$(str)\"" + else + obj + end + elseif obj == nothing + "nil" + elseif typeof(obj) == types.MalFunc + "(fn* $(pr_str(obj.params,true)) $(pr_str(obj.ast,true)))" + elseif typeof(obj) == types.Atom + "(atom $(pr_str(obj.val,true)))" + elseif typeof(obj) == Function + "#" + else + string(obj) + end +end + +end diff --git a/impls/julia/reader.jl b/impls/julia/reader.jl new file mode 100644 index 0000000000..2a46cc4f57 --- /dev/null +++ b/impls/julia/reader.jl @@ -0,0 +1,132 @@ +module reader + +export read_str + +import types + +type Reader + tokens + position::Int64 +end + +function next(rdr::Reader) + if rdr.position > length(rdr.tokens) + return nothing + end + rdr.position += 1 + rdr.tokens[rdr.position-1] +end + +function peek(rdr::Reader) + if rdr.position > length(rdr.tokens) + return nothing + end + rdr.tokens[rdr.position] +end + + +function tokenize(str) + re = r"[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\.|[^\\\"])*\"?|;.*|[^\s\[\]{}('\"`,;)]*)" + tokens = map((m) -> m.captures[1], eachmatch(re, str)) + filter((t) -> t != "" && t[1] != ';', tokens) +end + +function read_atom(rdr) + token = next(rdr) + if ismatch(r"^-?[0-9]+$", token) + parse(Int,token) + elseif ismatch(r"^-?[0-9][0-9.]*$", token) + float(token) + elseif ismatch(r"^\"(?:\\.|[^\\\"])*\"$", token) + replace(token[2:end-1], r"\\.", (r) -> get(Dict("\\n"=>"\n", + "\\\""=>"\"", + "\\\\"=>"\\"), r, r)) + elseif ismatch(r"^\".*$", token) + error("expected '\"', got EOF") + elseif token[1] == ':' + "\u029e$(token[2:end])" + elseif token == "nil" + nothing + elseif token == "true" + true + elseif token == "false" + false + else + symbol(token) + end +end + +function read_list(rdr, start="(", last=")") + ast = Any[] + token = next(rdr) + if (token != start) + error("expected '$(start)'") + end + while ((token = peek(rdr)) != last) + if token == nothing + error("expected '$(last)', got EOF") + end + push!(ast, read_form(rdr)) + end + next(rdr) + ast +end + +function read_vector(rdr) + lst = read_list(rdr, "[", "]") + tuple(lst...) +end + +function read_hash_map(rdr) + lst = read_list(rdr, "{", "}") + types.hash_map(lst...) +end + +function read_form(rdr) + token = peek(rdr) + if token == "'" + next(rdr) + [[:quote]; Any[read_form(rdr)]] + elseif token == "`" + next(rdr) + [[:quasiquote]; Any[read_form(rdr)]] + elseif token == "~" + next(rdr) + [[:unquote]; Any[read_form(rdr)]] + elseif token == "~@" + next(rdr) + [[symbol("splice-unquote")]; Any[read_form(rdr)]] + elseif token == "^" + next(rdr) + meta = read_form(rdr) + [[symbol("with-meta")]; Any[read_form(rdr)]; Any[meta]] + elseif token == "@" + next(rdr) + [[symbol("deref")]; Any[read_form(rdr)]] + + elseif token == ")" + error("unexpected ')'") + elseif token == "(" + read_list(rdr) + elseif token == "]" + error("unexpected ']'") + elseif token == "[" + read_vector(rdr) + elseif token == "}" + error("unexpected '}'") + elseif token == "{" + read_hash_map(rdr) + else + read_atom(rdr) + end +end + +function read_str(str) + tokens = tokenize(str) + if length(tokens) == 0 + return nothing + end + read_form(Reader(tokens, 1)) +end + +end diff --git a/impls/julia/readline_mod.jl b/impls/julia/readline_mod.jl new file mode 100644 index 0000000000..94c47f762f --- /dev/null +++ b/impls/julia/readline_mod.jl @@ -0,0 +1,15 @@ +module readline_mod + +export do_readline + +function do_readline(prompt) + print(prompt) + flush(STDOUT) + line = readline(STDIN) + if line == "" + return nothing + end + chomp(line) +end + +end diff --git a/impls/julia/run b/impls/julia/run new file mode 100755 index 0000000000..dd149451f1 --- /dev/null +++ b/impls/julia/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec julia $(dirname $0)/${STEP:-stepA_mal}.jl "${@}" diff --git a/impls/julia/step0_repl.jl b/impls/julia/step0_repl.jl new file mode 100755 index 0000000000..049cde1418 --- /dev/null +++ b/impls/julia/step0_repl.jl @@ -0,0 +1,30 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod + +# READ +function READ(str) + str +end + +# EVAL +function EVAL(ast, env) + ast +end + +# PRINT +function PRINT(exp) + exp +end + +# REPL +function REP(str) + return PRINT(EVAL(READ(str), [])) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + println(REP(line)) +end diff --git a/impls/julia/step1_read_print.jl b/impls/julia/step1_read_print.jl new file mode 100755 index 0000000000..604b1f9c3d --- /dev/null +++ b/impls/julia/step1_read_print.jl @@ -0,0 +1,43 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function EVAL(ast, env) + ast +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +function REP(str) + return PRINT(EVAL(READ(str), [])) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + println() + end +end diff --git a/impls/julia/step2_eval.jl b/impls/julia/step2_eval.jl new file mode 100755 index 0000000000..b64ca9e17c --- /dev/null +++ b/impls/julia/step2_eval.jl @@ -0,0 +1,64 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function EVAL(ast, env) + # println("EVAL: $(printer.pr_str(ast,true))") + + if typeof(ast) == Symbol + return env[ast] + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + if isempty(ast) return ast end + + # apply + el = map((x) -> EVAL(x,env), ast) + f, args = el[1], el[2:end] + f(args...) +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = Dict{Any,Any}(:+ => +, + :- => -, + :* => *, + :/ => div) +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + println() + end +end diff --git a/impls/julia/step3_env.jl b/impls/julia/step3_env.jl new file mode 100755 index 0000000000..b1cdd6c595 --- /dev/null +++ b/impls/julia/step3_env.jl @@ -0,0 +1,82 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function EVAL(ast, env) + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + if isempty(ast) return ast end + + # apply + if :def! == ast[1] + env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + EVAL(ast[3], let_env) + else + el = map((x) -> EVAL(x,env), ast) + f, args = el[1], el[2:end] + f(args...) + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = Env(nothing, + Dict{Any,Any}(:+ => +, + :- => -, + :* => *, + :/ => div)) +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + println() + end +end diff --git a/impls/julia/step4_if_fn_do.jl b/impls/julia/step4_if_fn_do.jl new file mode 100755 index 0000000000..70334f4337 --- /dev/null +++ b/impls/julia/step4_if_fn_do.jl @@ -0,0 +1,102 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env +import core + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function EVAL(ast, env) + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + if isempty(ast) return ast end + + # apply + if :def! == ast[1] + env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + EVAL(ast[3], let_env) + elseif :do == ast[1] + map((x) -> EVAL(x,env), ast[2:end])[end] + elseif :if == ast[1] + cond = EVAL(ast[2], env) + if cond === nothing || cond === false + if length(ast) >= 4 + EVAL(ast[4], env) + else + nothing + end + else + EVAL(ast[3], env) + end + elseif symbol("fn*") == ast[1] + (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])) + else + el = map((x) -> EVAL(x,env), ast) + f, args = el[1], el[2:end] + f(args...) + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = nothing +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +# core.jl: defined using Julia +repl_env = Env(nothing, core.ns) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + if !isa(e, StackOverflowError) + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + end + println() + end +end diff --git a/impls/julia/step5_tco.jl b/impls/julia/step5_tco.jl new file mode 100755 index 0000000000..08ed0659cf --- /dev/null +++ b/impls/julia/step5_tco.jl @@ -0,0 +1,121 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env +import core +using types + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function EVAL(ast, env) + while true + + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + if isempty(ast) return ast end + + # apply + if :def! == ast[1] + return env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + env = let_env + ast = ast[3] + # TCO loop + elseif :do == ast[1] + map((x) -> EVAL(x,env), ast[2:end-1]) + ast = ast[end] + # TCO loop + elseif :if == ast[1] + cond = EVAL(ast[2], env) + if cond === nothing || cond === false + if length(ast) >= 4 + ast = ast[4] + # TCO loop + else + return nothing + end + else + ast = ast[3] + # TCO loop + end + elseif symbol("fn*") == ast[1] + return MalFunc( + (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), + ast[3], env, ast[2]) + else + el = map((x) -> EVAL(x,env), ast) + f, args = el[1], el[2:end] + if isa(f, MalFunc) + ast = f.ast + env = Env(f.env, f.params, args) + # TCO loop + else + return f(args...) + end + end + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = nothing +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +# core.jl: defined using Julia +repl_env = Env(nothing, core.ns) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + # TODO: show at least part of stack + if !isa(e, StackOverflowError) + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + end + println() + end +end diff --git a/impls/julia/step6_file.jl b/impls/julia/step6_file.jl new file mode 100755 index 0000000000..0c39d0516e --- /dev/null +++ b/impls/julia/step6_file.jl @@ -0,0 +1,129 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env +import core +using types + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function EVAL(ast, env) + while true + + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + if isempty(ast) return ast end + + # apply + if :def! == ast[1] + return env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + env = let_env + ast = ast[3] + # TCO loop + elseif :do == ast[1] + map((x) -> EVAL(x,env), ast[2:end-1]) + ast = ast[end] + # TCO loop + elseif :if == ast[1] + cond = EVAL(ast[2], env) + if cond === nothing || cond === false + if length(ast) >= 4 + ast = ast[4] + # TCO loop + else + return nothing + end + else + ast = ast[3] + # TCO loop + end + elseif symbol("fn*") == ast[1] + return MalFunc( + (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), + ast[3], env, ast[2]) + else + el = map((x) -> EVAL(x,env), ast) + f, args = el[1], el[2:end] + if isa(f, MalFunc) + ast = f.ast + env = Env(f.env, f.params, args) + # TCO loop + else + return f(args...) + end + end + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = nothing +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +# core.jl: defined using Julia +repl_env = Env(nothing, core.ns) +env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) +env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if length(ARGS) > 0 + REP("(load-file \"$(ARGS[1])\")") + exit(0) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + # TODO: show at least part of stack + if !isa(e, StackOverflowError) + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + end + println() + end +end diff --git a/impls/julia/step7_quote.jl b/impls/julia/step7_quote.jl new file mode 100755 index 0000000000..86148cfd67 --- /dev/null +++ b/impls/julia/step7_quote.jl @@ -0,0 +1,163 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env +import core +using types + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc +end + +function quasiquote(ast) + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] + else + ast + end +end + +function EVAL(ast, env) + while true + + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + if isempty(ast) return ast end + + # apply + if :def! == ast[1] + return env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + env = let_env + ast = ast[3] + # TCO loop + elseif :quote == ast[1] + return ast[2] + elseif :quasiquote == ast[1] + ast = quasiquote(ast[2]) + # TCO loop + elseif :do == ast[1] + map((x) -> EVAL(x,env), ast[2:end-1]) + ast = ast[end] + # TCO loop + elseif :if == ast[1] + cond = EVAL(ast[2], env) + if cond === nothing || cond === false + if length(ast) >= 4 + ast = ast[4] + # TCO loop + else + return nothing + end + else + ast = ast[3] + # TCO loop + end + elseif symbol("fn*") == ast[1] + return MalFunc( + (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), + ast[3], env, ast[2]) + else + el = map((x) -> EVAL(x,env), ast) + f, args = el[1], el[2:end] + if isa(f, MalFunc) + ast = f.ast + env = Env(f.env, f.params, args) + # TCO loop + else + return f(args...) + end + end + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = nothing +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +# core.jl: defined using Julia +repl_env = Env(nothing, core.ns) +env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) +env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if length(ARGS) > 0 + REP("(load-file \"$(ARGS[1])\")") + exit(0) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + # TODO: show at least part of stack + if !isa(e, StackOverflowError) + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + end + println() + end +end diff --git a/impls/julia/step8_macros.jl b/impls/julia/step8_macros.jl new file mode 100755 index 0000000000..5dee5a32e1 --- /dev/null +++ b/impls/julia/step8_macros.jl @@ -0,0 +1,174 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env +import core +using types + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc +end + +function quasiquote(ast) + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] + else + ast + end +end + +function EVAL(ast, env) + while true + + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + # apply + if isempty(ast) return ast end + + if :def! == ast[1] + return env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + env = let_env + ast = ast[3] + # TCO loop + elseif :quote == ast[1] + return ast[2] + elseif :quasiquote == ast[1] + ast = quasiquote(ast[2]) + # TCO loop + elseif :defmacro! == ast[1] + func = EVAL(ast[3], env) + func.ismacro = true + return env_set(env, ast[2], func) + elseif :do == ast[1] + map((x) -> EVAL(x,env), ast[2:end-1]) + ast = ast[end] + # TCO loop + elseif :if == ast[1] + cond = EVAL(ast[2], env) + if cond === nothing || cond === false + if length(ast) >= 4 + ast = ast[4] + # TCO loop + else + return nothing + end + else + ast = ast[3] + # TCO loop + end + elseif symbol("fn*") == ast[1] + return MalFunc( + (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), + ast[3], env, ast[2]) + else + f = EVAL(ast[1], env) + args = ast[2:end] + if isa(f, MalFunc) && f.ismacro + ast = f.fn(args...) + continue # TCO loop + end + args = map((x) -> EVAL(x,env), args) + if isa(f, MalFunc) + ast = f.ast + env = Env(f.env, f.params, args) + # TCO loop + else + return f(args...) + end + end + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = nothing +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +# core.jl: defined using Julia +repl_env = Env(nothing, core.ns) +env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) +env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +if length(ARGS) > 0 + REP("(load-file \"$(ARGS[1])\")") + exit(0) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + # TODO: show at least part of stack + if !isa(e, StackOverflowError) + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + end + println() + end +end diff --git a/impls/julia/step9_try.jl b/impls/julia/step9_try.jl new file mode 100755 index 0000000000..73c18d01df --- /dev/null +++ b/impls/julia/step9_try.jl @@ -0,0 +1,192 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env +import core +using types + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc +end + +function quasiquote(ast) + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] + else + ast + end +end + +function EVAL(ast, env) + while true + + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + # apply + if isempty(ast) return ast end + + if :def! == ast[1] + return env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + env = let_env + ast = ast[3] + # TCO loop + elseif :quote == ast[1] + return ast[2] + elseif :quasiquote == ast[1] + ast = quasiquote(ast[2]) + # TCO loop + elseif :defmacro! == ast[1] + func = EVAL(ast[3], env) + func.ismacro = true + return env_set(env, ast[2], func) + elseif symbol("try*") == ast[1] + try + return EVAL(ast[2], env) + catch exc + e = string(exc) + if isa(exc, MalException) + e = exc.malval + elseif isa(exc, ErrorException) + e = exc.msg + else + e = string(e) + end + if length(ast) > 2 && ast[3][1] == symbol("catch*") + return EVAL(ast[3][3], Env(env, Any[ast[3][2]], Any[e])) + else + rethrow(exc) + end + end + elseif :do == ast[1] + map((x) -> EVAL(x,env), ast[2:end-1]) + ast = ast[end] + # TCO loop + elseif :if == ast[1] + cond = EVAL(ast[2], env) + if cond === nothing || cond === false + if length(ast) >= 4 + ast = ast[4] + # TCO loop + else + return nothing + end + else + ast = ast[3] + # TCO loop + end + elseif symbol("fn*") == ast[1] + return MalFunc( + (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), + ast[3], env, ast[2]) + else + f = EVAL(ast[1], env) + args = ast[2:end] + if isa(f, MalFunc) && f.ismacro + ast = f.fn(args...) + continue # TCO loop + end + args = map((x) -> EVAL(x,env), args) + if isa(f, MalFunc) + ast = f.ast + env = Env(f.env, f.params, args) + # TCO loop + else + return f(args...) + end + end + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = nothing +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +# core.jl: defined using Julia +repl_env = Env(nothing, core.ns) +env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) +env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +if length(ARGS) > 0 + REP("(load-file \"$(ARGS[1])\")") + exit(0) +end + +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + # TODO: show at least part of stack + if !isa(e, StackOverflowError) + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + end + println() + end +end diff --git a/impls/julia/stepA_mal.jl b/impls/julia/stepA_mal.jl new file mode 100755 index 0000000000..efeabef3e6 --- /dev/null +++ b/impls/julia/stepA_mal.jl @@ -0,0 +1,194 @@ +#!/usr/bin/env julia + +push!(LOAD_PATH, pwd(), "/usr/share/julia/base") +import readline_mod +import reader +import printer +using env +import core +using types + +# READ +function READ(str) + reader.read_str(str) +end + +# EVAL +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc +end + +function quasiquote(ast) + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] + else + ast + end +end + +function EVAL(ast, env) + while true + + dbgenv = env_find(env, Symbol("DEBUG-EVAL")) + if dbgenv != nothing + dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end + + # apply + if isempty(ast) return ast end + + if :def! == ast[1] + return env_set(env, ast[2], EVAL(ast[3], env)) + elseif symbol("let*") == ast[1] + let_env = Env(env) + for i = 1:2:length(ast[2]) + env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) + end + env = let_env + ast = ast[3] + # TCO loop + elseif :quote == ast[1] + return ast[2] + elseif :quasiquote == ast[1] + ast = quasiquote(ast[2]) + # TCO loop + elseif :defmacro! == ast[1] + func = EVAL(ast[3], env) + func.ismacro = true + return env_set(env, ast[2], func) + elseif symbol("try*") == ast[1] + try + return EVAL(ast[2], env) + catch exc + e = string(exc) + if isa(exc, MalException) + e = exc.malval + elseif isa(exc, ErrorException) + e = exc.msg + else + e = string(e) + end + if length(ast) > 2 && ast[3][1] == symbol("catch*") + return EVAL(ast[3][3], Env(env, Any[ast[3][2]], Any[e])) + else + rethrow(exc) + end + end + elseif :do == ast[1] + map((x) -> EVAL(x,env), ast[2:end-1]) + ast = ast[end] + # TCO loop + elseif :if == ast[1] + cond = EVAL(ast[2], env) + if cond === nothing || cond === false + if length(ast) >= 4 + ast = ast[4] + # TCO loop + else + return nothing + end + else + ast = ast[3] + # TCO loop + end + elseif symbol("fn*") == ast[1] + return MalFunc( + (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), + ast[3], env, ast[2]) + else + f = EVAL(ast[1], env) + args = ast[2:end] + if isa(f, MalFunc) && f.ismacro + ast = f.fn(args...) + continue # TCO loop + end + args = map((x) -> EVAL(x,env), args) + if isa(f, MalFunc) + ast = f.ast + env = Env(f.env, f.params, args) + # TCO loop + else + return f(args...) + end + end + end +end + +# PRINT +function PRINT(exp) + printer.pr_str(exp) +end + +# REPL +repl_env = nothing +function REP(str) + return PRINT(EVAL(READ(str), repl_env)) +end + +# core.jl: defined using Julia +repl_env = Env(nothing, core.ns) +env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) +env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) + +# core.mal: defined using the language itself +REP("(def! *host-language* \"julia\")") +REP("(def! not (fn* (a) (if a false true)))") +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +if length(ARGS) > 0 + REP("(load-file \"$(ARGS[1])\")") + exit(0) +end + +REP("(println (str \"Mal [\" *host-language* \"]\"))") +while true + line = readline_mod.do_readline("user> ") + if line === nothing break end + try + println(REP(line)) + catch e + if isa(e, ErrorException) + println("Error: $(e.msg)") + else + println("Error: $(string(e))") + end + # TODO: show at least part of stack + if !isa(e, StackOverflowError) + bt = catch_backtrace() + Base.show_backtrace(STDERR, bt) + end + println() + end +end diff --git a/impls/julia/tests/step5_tco.mal b/impls/julia/tests/step5_tco.mal new file mode 100644 index 0000000000..087368335f --- /dev/null +++ b/impls/julia/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 100000)) +res1 +;=>nil diff --git a/impls/julia/types.jl b/impls/julia/types.jl new file mode 100644 index 0000000000..ba735784fa --- /dev/null +++ b/impls/julia/types.jl @@ -0,0 +1,81 @@ +module types + +export MalException, MalFunc, sequential_Q, equal_Q, hash_map, Atom + +import Base.copy + +type MalException <: Exception + malval +end + +type MalFunc + fn::Function + ast + env + params + ismacro + meta +end + +# ismacro default to false +function MalFunc(fn, ast, env, params) + MalFunc(fn, ast, env, params, false, nothing) +end + +function copy(f::MalFunc) + MalFunc(f.fn, f.ast, f.env, f.params, f.ismacro, f.meta) +end + +function sequential_Q(obj) + isa(obj, Array) || isa(obj, Tuple) +end + +function equal_Q(a, b) + ota = typeof(a) + otb = typeof(b) + if !(ota === otb || (sequential_Q(a) && sequential_Q(b))) + return false + end + + if sequential_Q(a) + if length(a) !== length(b) + return false + end + for (x, y) in zip(a,b) + if !equal_Q(x, y) + return false + end + end + return true + elseif isa(a,AbstractString) + a == b + elseif isa(a,Dict) + if length(a) !== length(b) + return false + end + for (k,v) in a + if !equal_Q(v,b[k]) + return false + end + end + return true + else + a === b + end +end + +function hash_map(lst...) + hm = Dict() + for i = 1:2:length(lst) + hm[lst[i]] = lst[i+1] + end + hm +end + +type Atom + val +end + +end + + diff --git a/impls/kotlin/Dockerfile b/impls/kotlin/Dockerfile new file mode 100644 index 0000000000..86857b2ce1 --- /dev/null +++ b/impls/kotlin/Dockerfile @@ -0,0 +1,34 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Java and Zip +RUN apt-get -y install openjdk-8-jdk +RUN apt-get -y install unzip + +RUN curl -O -J -L https://github.com/JetBrains/kotlin/releases/download/v1.0.6/kotlin-compiler-1.0.6.zip + +RUN mkdir -p /kotlin-compiler +RUN unzip kotlin-compiler-1.0.6.zip -d /kotlin-compiler + +ENV KOTLIN_HOME /kotlin-compiler/kotlinc +ENV PATH $KOTLIN_HOME/bin:$PATH diff --git a/impls/kotlin/Makefile b/impls/kotlin/Makefile new file mode 100644 index 0000000000..1a9a6dfee1 --- /dev/null +++ b/impls/kotlin/Makefile @@ -0,0 +1,23 @@ +SOURCES_BASE = reader.kt printer.kt types.kt env.kt core.kt readline.kt +SOURCES_LISP = step0_repl.kt step1_read_print.kt step2_eval.kt step3_env.kt step4_if_fn_do.kt \ + step5_tco.kt step6_file.kt step7_quote.kt step8_macros.kt step9_try.kt stepA_mal.kt + +JARS = $(SOURCES_LISP:%.kt=%.jar) + +all: $(JARS) + +dist: mal.jar mal + +mal.jar: stepA_mal.jar + cp $< $@ + +SHELL := bash +mal: mal.jar + cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ + chmod +x mal + +clean: + rm -vf $(JARS) mal.jar mal + +$(JARS): %.jar: src/mal/%.kt $(SOURCES_BASE:%.kt=src/mal/%.kt) + kotlinc src/mal/$(@:%.jar=%.kt) $(SOURCES_BASE:%.kt=src/mal/%.kt) -include-runtime -d $@ diff --git a/impls/kotlin/run b/impls/kotlin/run new file mode 100755 index 0000000000..c5a1f3c10f --- /dev/null +++ b/impls/kotlin/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec java -jar $(dirname $0)/${STEP:-stepA_mal}.jar "${@}" diff --git a/impls/kotlin/src/mal/core.kt b/impls/kotlin/src/mal/core.kt new file mode 100644 index 0000000000..e14b41502e --- /dev/null +++ b/impls/kotlin/src/mal/core.kt @@ -0,0 +1,242 @@ +package mal + +import java.io.File +import java.util.* + +val ns = hashMapOf( + envPair("+", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger + y as MalInteger }) }), + envPair("-", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger - y as MalInteger }) }), + envPair("*", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger * y as MalInteger }) }), + envPair("/", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger / y as MalInteger }) }), + + envPair("list", { a: ISeq -> MalList(a) }), + envPair("list?", { a: ISeq -> if (a.first() is MalList) TRUE else FALSE }), + envPair("empty?", { a: ISeq -> if (a.first() !is ISeq || !(a.first() as ISeq).seq().any()) TRUE else FALSE }), + envPair("count", { a: ISeq -> + if (a.first() is ISeq) MalInteger((a.first() as ISeq).count().toLong()) else MalInteger(0) + }), + + envPair("=", { a: ISeq -> pairwiseEquals(a) }), + envPair("<", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value < y.value }) }), + envPair("<=", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value <= y.value }) }), + envPair(">", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value > y.value }) }), + envPair(">=", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value >= y.value }) }), + + envPair("pr-str", { a: ISeq -> + MalString(a.seq().map({ it -> pr_str(it, print_readably = true) }).joinToString(" ")) + }), + envPair("str", { a: ISeq -> + MalString(a.seq().map({ it -> pr_str(it, print_readably = false) }).joinToString("")) + }), + envPair("prn", { a: ISeq -> + println(a.seq().map({ it -> pr_str(it, print_readably = true) }).joinToString(" ")) + NIL + }), + envPair("println", { a: ISeq -> + println(a.seq().map({ it -> pr_str(it, print_readably = false) }).joinToString(" ")) + NIL + }), + + envPair("read-string", { a: ISeq -> + val string = a.first() as? MalString ?: throw MalException("slurp requires a string parameter") + read_str(string.value) + }), + envPair("slurp", { a: ISeq -> + val name = a.first() as? MalString ?: throw MalException("slurp requires a filename parameter") + val text = File(name.value).readText() + MalString(text) + }), + + envPair("cons", { a: ISeq -> + val list = a.nth(1) as? ISeq ?: throw MalException("cons requires a list as its second parameter") + val mutableList = list.seq().toCollection(LinkedList()) + mutableList.addFirst(a.nth(0)) + MalList(mutableList) + }), + envPair("concat", { a: ISeq -> MalList(a.seq().flatMap({ it -> (it as ISeq).seq() }).toCollection(LinkedList())) }), + envPair("vec", { a: ISeq -> + val list = a.first() as? ISeq ?: throw MalException("vec requires a sequence") + MalVector(list) + }), + envPair("nth", { a: ISeq -> + val list = a.nth(0) as? ISeq ?: throw MalException("nth requires a list as its first parameter") + val index = a.nth(1) as? MalInteger ?: throw MalException("nth requires an integer as its second parameter") + if (index.value >= list.count()) throw MalException("index out of bounds") + list.nth(index.value.toInt()) + }), + envPair("first", { a: ISeq -> + if (a.nth(0) == NIL) NIL + else { + val list = a.nth(0) as? ISeq ?: throw MalException("first requires a list parameter") + if (list.seq().any()) list.first() else NIL + } + }), + envPair("rest", { a: ISeq -> + if (a.nth(0) == NIL) MalList() + else { + val list = a.nth(0) as? ISeq ?: throw MalException("rest requires a list parameter") + MalList(list.rest()) + } + }), + + envPair("throw", { a: ISeq -> + val throwable = a.nth(0) + throw MalCoreException(pr_str(throwable), throwable) + }), + + envPair("apply", { a: ISeq -> + val function = a.nth(0) as MalFunction + val params = MalList() + a.seq().drop(1).forEach({ it -> + if (it is ISeq) { + it.seq().forEach({ x -> params.conj_BANG(x) }) + } else { + params.conj_BANG(it) + } + }) + function.apply(params) + }), + + envPair("map", { a: ISeq -> + val function = a.nth(0) as MalFunction + MalList((a.nth(1) as ISeq).seq().map({ it -> + val params = MalList() + params.conj_BANG(it) + function.apply(params) + }).toCollection(LinkedList())) + }), + + envPair("nil?", { a: ISeq -> if (a.nth(0) == NIL) TRUE else FALSE }), + envPair("true?", { a: ISeq -> if (a.nth(0) == TRUE) TRUE else FALSE }), + envPair("false?", { a: ISeq -> if (a.nth(0) == FALSE) TRUE else FALSE }), + envPair("string?", { a: ISeq -> + if (a.nth(0) is MalString && !(a.nth(0) is MalKeyword)) TRUE else FALSE + }), + envPair("symbol?", { a: ISeq -> if (a.nth(0) is MalSymbol) TRUE else FALSE }), + + envPair("symbol", { a: ISeq -> MalSymbol((a.nth(0) as MalString).value) }), + envPair("keyword", { a: ISeq -> + val param = a.nth(0) + if (param is MalKeyword) param else MalKeyword((a.nth(0) as MalString).value) + }), + envPair("keyword?", { a: ISeq -> if (a.nth(0) is MalKeyword) TRUE else FALSE }), + envPair("number?", { a: ISeq -> if (a.nth(0) is MalInteger) TRUE else FALSE }), + envPair("fn?", { a: ISeq -> if ((a.nth(0) as? MalFunction)?.is_macro ?: true) FALSE else TRUE }), + envPair("macro?", { a: ISeq -> if ((a.nth(0) as? MalFunction)?.is_macro ?: false) TRUE else FALSE }), + + envPair("vector", { a: ISeq -> MalVector(a) }), + envPair("vector?", { a: ISeq -> if (a.nth(0) is MalVector) TRUE else FALSE }), + + envPair("hash-map", { a: ISeq -> + val map = MalHashMap() + pairwise(a).forEach({ it -> map.assoc_BANG(it.first as MalString, it.second) }) + map + }), + envPair("map?", { a: ISeq -> if (a.nth(0) is MalHashMap) TRUE else FALSE }), + envPair("assoc", { a: ISeq -> + val map = MalHashMap(a.first() as MalHashMap) + pairwise(a.rest()).forEach({ it -> map.assoc_BANG(it.first as MalString, it.second) }) + map + }), + envPair("dissoc", { a: ISeq -> + val map = MalHashMap(a.first() as MalHashMap) + a.rest().seq().forEach({ it -> map.dissoc_BANG(it as MalString) }) + map + }), + envPair("get", { a: ISeq -> + val map = a.nth(0) as? MalHashMap + val key = a.nth(1) as MalString + map?.elements?.get(key) ?: NIL + }), + envPair("contains?", { a: ISeq -> + val map = a.nth(0) as? MalHashMap + val key = a.nth(1) as MalString + if (map?.elements?.get(key) != null) TRUE else FALSE + }), + envPair("keys", { a: ISeq -> + val map = a.nth(0) as MalHashMap + MalList(map.elements.keys.toCollection(LinkedList())) + }), + envPair("vals", { a: ISeq -> + val map = a.nth(0) as MalHashMap + MalList(map.elements.values.toCollection(LinkedList())) + }), + envPair("count", { a: ISeq -> + val seq = a.nth(0) as? ISeq + if (seq != null) MalInteger(seq.count().toLong()) else ZERO + }), + envPair("sequential?", { a: ISeq -> if (a.nth(0) is ISeq) TRUE else FALSE }), + + envPair("with-meta", { a: ISeq -> + val obj = a.nth(0) + val metadata = a.nth(1) + obj.with_meta(metadata) + }), + envPair("meta", { a: ISeq -> a.first().metadata }), + + envPair("conj", { a: ISeq -> (a.first() as ISeq).conj(a.rest()) }), + envPair("seq", { a: ISeq -> + val obj = a.nth(0) + if (obj is ISeq) { + if (obj.count() == 0) NIL + else MalList(obj.seq().toCollection(LinkedList())) + } else if (obj is MalString && !(obj is MalKeyword)) { + if (obj.value.length == 0) NIL + else { + var strs = obj.value.map({ c -> MalString(c.toString()) }) + MalList(strs.toCollection(LinkedList())) + } + } else { + NIL + } + }), + + envPair("atom", { a: ISeq -> MalAtom(a.first()) }), + envPair("atom?", { a: ISeq -> if (a.first() is MalAtom) TRUE else FALSE }), + envPair("deref", { a: ISeq -> (a.first() as MalAtom).value }), + envPair("reset!", { a: ISeq -> + val atom = a.nth(0) as MalAtom + val value = a.nth(1) + atom.value = value + value + }), + envPair("swap!", { a: ISeq -> + val atom = a.nth(0) as MalAtom + val function = a.nth(1) as MalFunction + + val params = MalList() + params.conj_BANG(atom.value) + a.seq().drop(2).forEach({ it -> params.conj_BANG(it) }) + + val value = function.apply(params) + atom.value = value + + value + }), + + envPair("readline", { a: ISeq -> + val prompt = a.first() as MalString + try { + MalString(readline(prompt.value)) + } catch (e: java.io.IOException) { + throw MalException(e.message) + } catch (e: EofException) { + NIL + } + }), + + envPair("time-ms", { a: ISeq -> MalInteger(System.currentTimeMillis()) }) +) + +private fun envPair(k: String, v: (ISeq) -> MalType): Pair = Pair(MalSymbol(k), MalFunction(v)) + +private fun pairwise(s: ISeq): List> { + val (keys, vals) = s.seq().withIndex().partition({ it -> it.index % 2 == 0 }) + return keys.map({ it -> it.value }).zip(vals.map({ it -> it.value })) +} + +private fun pairwiseCompare(s: ISeq, pred: (MalInteger, MalInteger) -> Boolean): MalConstant = + if (pairwise(s).all({ it -> pred(it.first as MalInteger, it.second as MalInteger) })) TRUE else FALSE + +private fun pairwiseEquals(s: ISeq): MalConstant = + if (pairwise(s).all({ it -> it.first == it.second })) TRUE else FALSE diff --git a/impls/kotlin/src/mal/env.kt b/impls/kotlin/src/mal/env.kt new file mode 100644 index 0000000000..b95fba2a49 --- /dev/null +++ b/impls/kotlin/src/mal/env.kt @@ -0,0 +1,34 @@ +package mal + +import java.util.* + +class Env(val outer: Env?, binds: Sequence?, exprs: Sequence?) { + val data = HashMap() + + init { + if (binds != null && exprs != null) { + val itb = binds.iterator() + val ite = exprs.iterator() + while (itb.hasNext()) { + val b = itb.next() + if (b.value != "&") { + set(b, if (ite.hasNext()) ite.next() else NIL) + } else { + if (!itb.hasNext()) throw MalException("expected a symbol name for varargs") + set(itb.next(), MalList(ite.asSequence().toCollection(LinkedList()))) + break + } + } + } + } + + constructor() : this(null, null, null) + constructor(outer: Env?) : this(outer, null, null) + + fun set(key: MalSymbol, value: MalType): MalType { + data.put(key.value, value) + return value + } + + fun get(key: String): MalType? = data[key] ?: outer?.get(key) +} diff --git a/impls/kotlin/src/mal/printer.kt b/impls/kotlin/src/mal/printer.kt new file mode 100644 index 0000000000..25a2233ab6 --- /dev/null +++ b/impls/kotlin/src/mal/printer.kt @@ -0,0 +1,27 @@ +package mal + +fun pr_str(malType: MalType, print_readably: Boolean = false): String = + when (malType) { + is MalInteger -> malType.value.toString() + is MalKeyword -> ":" + malType.value.substring(1) + is MalString -> + if (print_readably) { + "\"" + malType.value.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") + "\"" + } else malType.value + is MalConstant -> malType.value + is MalSymbol -> malType.value + is MalFunction -> "#" + malType + is MalCoreException -> pr_str(malType.value, print_readably) + is MalException -> "\"" + (malType.message ?: "exception") + "\"" + is MalList -> pr_str(malType.elements, "(", ")", print_readably) + is MalVector -> pr_str(malType.elements, "[", "]", print_readably) + is MalHashMap -> malType.elements.map({ it -> pr_str(it, print_readably) }).joinToString(" ", "{", "}") + is MalAtom -> "(atom " + pr_str(malType.value, print_readably) + ")" + else -> throw MalPrinterException("Unrecognized MalType: " + malType) + } + +private fun pr_str(coll: Collection, start: String, end: String, print_readably: Boolean = false): String = + coll.map({ it -> pr_str(it, print_readably) }).joinToString(" ", start, end) + +private fun pr_str(mapEntry: Map.Entry, print_readably: Boolean = false): String = + pr_str(mapEntry.key, print_readably) + " " + pr_str(mapEntry.value, print_readably) diff --git a/impls/kotlin/src/mal/reader.kt b/impls/kotlin/src/mal/reader.kt new file mode 100644 index 0000000000..0d03f4aa02 --- /dev/null +++ b/impls/kotlin/src/mal/reader.kt @@ -0,0 +1,156 @@ +package mal + +import kotlin.text.Regex + +val TOKEN_REGEX = Regex("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") +val ATOM_REGEX = Regex("(^-?[0-9]+$)|(^nil$)|(^true$)|(^false$)|^\"((?:\\\\.|[^\\\\\"])*)\"$|^\"(.*)$|:(.*)|(^[^\"]*$)") + +class Reader(sequence: Sequence) { + val tokens = sequence.iterator() + var current = advance() + + fun next(): String? { + var result = current + current = advance() + return result + } + + fun peek(): String? = current + + private fun advance(): String? = if (tokens.hasNext()) tokens.next() else null +} + +fun read_str(input: String?): MalType { + val tokens = tokenizer(input) ?: return NIL + return read_form(Reader(tokens)) +} + +fun tokenizer(input: String?): Sequence? { + if (input == null) return null + + return TOKEN_REGEX.findAll(input) + .map({ it -> it.groups[1]?.value as String }) + .filter({ it != "" && !it.startsWith(";")}) +} + +fun read_form(reader: Reader): MalType = + when (reader.peek()) { + null -> throw MalContinue() + "(" -> read_list(reader) + ")" -> throw MalReaderException("expected form, got ')'") + "[" -> read_vector(reader) + "]" -> throw MalReaderException("expected form, got ']'") + "{" -> read_hashmap(reader) + "}" -> throw MalReaderException("expected form, got '}'") + "'" -> read_shorthand(reader, "quote") + "`" -> read_shorthand(reader, "quasiquote") + "~" -> read_shorthand(reader, "unquote") + "~@" -> read_shorthand(reader, "splice-unquote") + "^" -> read_with_meta(reader) + "@" -> read_shorthand(reader, "deref") + else -> read_atom(reader) + } + +fun read_list(reader: Reader): MalType = read_sequence(reader, MalList(), ")") +fun read_vector(reader: Reader): MalType = read_sequence(reader, MalVector(), "]") + +private fun read_sequence(reader: Reader, sequence: IMutableSeq, end: String): MalType { + reader.next() + + do { + val form = when (reader.peek()) { + null -> throw MalReaderException("expected '$end', got EOF") + end -> { reader.next(); null } + else -> read_form(reader) + } + + if (form != null) { + sequence.conj_BANG(form) + } + } while (form != null) + + return sequence +} + +fun read_hashmap(reader: Reader): MalType { + reader.next() + val hashMap = MalHashMap() + + do { + var value : MalType? = null; + val key = when (reader.peek()) { + null -> throw MalReaderException("expected '}', got EOF") + "}" -> { reader.next(); null } + else -> { + var key = read_form(reader) + if (key !is MalString) { + throw MalReaderException("hash-map keys must be strings or keywords") + } + value = when (reader.peek()) { + null -> throw MalReaderException("expected form, got EOF") + else -> read_form(reader) + } + key + } + } + + if (key != null) { + hashMap.assoc_BANG(key, value as MalType) + } + } while (key != null) + + return hashMap +} + +fun read_shorthand(reader: Reader, symbol: String): MalType { + reader.next() + + val list = MalList() + list.conj_BANG(MalSymbol(symbol)) + list.conj_BANG(read_form(reader)) + + return list +} + +fun read_with_meta(reader: Reader): MalType { + reader.next() + + val meta = read_form(reader) + val obj = read_form(reader) + + val list = MalList() + list.conj_BANG(MalSymbol("with-meta")) + list.conj_BANG(obj) + list.conj_BANG(meta) + + return list +} + +fun read_atom(reader: Reader): MalType { + val next = reader.next() ?: throw MalReaderException("Unexpected null token") + val groups = ATOM_REGEX.find(next)?.groups ?: throw MalReaderException("Unrecognized token: " + next) + + return if (groups[1]?.value != null) { + MalInteger(groups[1]?.value?.toLong() ?: throw MalReaderException("Error parsing number: " + next)) + } else if (groups[2]?.value != null) { + NIL + } else if (groups[3]?.value != null) { + TRUE + } else if (groups[4]?.value != null) { + FALSE + } else if (groups[5]?.value != null) { + MalString((groups[5]?.value as String).replace(Regex("""\\(.)""")) + { m: MatchResult -> + if (m.groups[1]?.value == "n") "\n" + else m.groups[1]?.value.toString() + }) + } else if (groups[6]?.value != null) { + throw MalReaderException("expected '\"', got EOF") + } else if (groups[7]?.value != null) { + MalKeyword(groups[7]?.value as String) + } else if (groups[8]?.value != null) { + MalSymbol(groups[8]?.value as String) + } else { + throw MalReaderException("Unrecognized token: " + next) + } +} diff --git a/impls/kotlin/src/mal/readline.kt b/impls/kotlin/src/mal/readline.kt new file mode 100644 index 0000000000..97902386fb --- /dev/null +++ b/impls/kotlin/src/mal/readline.kt @@ -0,0 +1,8 @@ +package mal + +class EofException : Exception("EOF") + +fun readline(prompt: String): String { + print(prompt) + return readLine() ?: throw EofException() +} diff --git a/impls/kotlin/src/mal/step0_repl.kt b/impls/kotlin/src/mal/step0_repl.kt new file mode 100644 index 0000000000..1ced37d3a8 --- /dev/null +++ b/impls/kotlin/src/mal/step0_repl.kt @@ -0,0 +1,19 @@ +package mal + +fun main(args: Array) { + fun read(input: String?): String? = input + fun eval(expression: String?): String? = expression + fun print(result: String?): String? = result + + while (true) { + val input = readline("user> ") + + try { + println(print(eval(read(input)))) + } catch (e: EofException) { + break + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + } + } +} diff --git a/impls/kotlin/src/mal/step1_read_print.kt b/impls/kotlin/src/mal/step1_read_print.kt new file mode 100644 index 0000000000..18ee081df1 --- /dev/null +++ b/impls/kotlin/src/mal/step1_read_print.kt @@ -0,0 +1,22 @@ +package mal + +fun main(args: Array) { + fun read(input: String?): MalType = read_str(input) + fun eval(expression: MalType): MalType = expression + fun print(result: MalType) = pr_str(result, print_readably = true) + + while (true) { + val input = readline("user> ") + + try { + println(print(eval(read(input)))) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + } + } +} diff --git a/impls/kotlin/src/mal/step2_eval.kt b/impls/kotlin/src/mal/step2_eval.kt new file mode 100644 index 0000000000..3a947a919b --- /dev/null +++ b/impls/kotlin/src/mal/step2_eval.kt @@ -0,0 +1,45 @@ +package mal + +fun read(input: String?): MalType = read_str(input) + +fun eval(ast: MalType, env: Map): MalType { + // println ("EVAL: ${print(ast)}") + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") + return (evaluated.first() as MalFunction).apply(evaluated.rest()) + } + is MalSymbol -> return env[ast.value] ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } +} + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun main(args: Array) { + val env = hashMapOf( + Pair("+", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger + y as MalInteger }) })), + Pair("-", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger - y as MalInteger }) })), + Pair("*", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger * y as MalInteger }) })), + Pair("/", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger / y as MalInteger }) })) + ) + + while (true) { + val input = readline("user> ") + + try { + println(print(eval(read(input), env))) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + } + } +} diff --git a/impls/kotlin/src/mal/step3_env.kt b/impls/kotlin/src/mal/step3_env.kt new file mode 100644 index 0000000000..7601692566 --- /dev/null +++ b/impls/kotlin/src/mal/step3_env.kt @@ -0,0 +1,66 @@ +package mal + +fun read(input: String?): MalType = read_str(input) + +fun eval(ast: MalType, env: Env): MalType { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + val first = ast.first() + if (first is MalSymbol && first.value == "def!") { + return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + } else if (first is MalSymbol && first.value == "let*") { + val child = Env(env) + val bindings = ast.nth(1) + if (bindings !is ISeq) throw MalException("expected sequence as the first parameter to let*") + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + val value = eval(it.next(), child) + child.set(key as MalSymbol, value) + } + return eval(ast.nth(2), child) + } else { + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") + return (evaluated.first() as MalFunction).apply(evaluated.rest()) + } + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } +} + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun main(args: Array) { + val env = Env() + env.set(MalSymbol("+"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger + y as MalInteger }) })) + env.set(MalSymbol("-"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger - y as MalInteger }) })) + env.set(MalSymbol("*"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger * y as MalInteger }) })) + env.set(MalSymbol("/"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger / y as MalInteger }) })) + + while (true) { + val input = readline("user> ") + + try { + println(print(eval(read(input), env))) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + } + } +} diff --git a/impls/kotlin/src/mal/step4_if_fn_do.kt b/impls/kotlin/src/mal/step4_if_fn_do.kt new file mode 100644 index 0000000000..f27c9451bf --- /dev/null +++ b/impls/kotlin/src/mal/step4_if_fn_do.kt @@ -0,0 +1,112 @@ +package mal + +fun read(input: String?): MalType = read_str(input) + +fun eval(ast: MalType, env: Env): MalType { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + val first = ast.first() + if (first is MalSymbol) { + when (first.value) { + "def!" -> return eval_def_BANG(ast, env) + "let*" -> return eval_let_STAR(ast, env) + "fn*" -> return eval_fn_STAR(ast, env) + "do" -> return eval_do(ast, env) + "if" -> return eval_if(ast, env) + } + } + return eval_function_call(ast, env) + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } +} + +private fun eval_def_BANG(ast: ISeq, env: Env): MalType = + env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + +private fun eval_let_STAR(ast: ISeq, env: Env): MalType { + val child = Env(env) + val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") + + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + + val value = eval(it.next(), child) + child.set(key as MalSymbol, value) + } + + return eval(ast.nth(2), child) +} + +private fun eval_fn_STAR(ast: ISeq, env: Env): MalType { + val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") + val symbols = binds.seq().filterIsInstance() + val body = ast.nth(2) + + return MalFunction({ s: ISeq -> + eval(body, Env(env, symbols, s.seq())) + }) +} + +private fun eval_do(ast: ISeq, env: Env): MalType { + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } + return eval(ast.seq().last(), env) +} + +private fun eval_if(ast: ISeq, env: Env): MalType { + val check = eval(ast.nth(1), env) + + return if (check != NIL && check != FALSE) { + eval(ast.nth(2), env) + } else if (ast.count() > 3) { + eval(ast.nth(3), env) + } else NIL +} + +private fun eval_function_call(ast: MalList, env: Env): MalType { + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + val first = evaluated.first() as? MalFunction ?: throw MalException("cannot execute non-function") + return first.apply(evaluated.rest()) +} + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun rep(input: String, env: Env): String = + print(eval(read(input), env)) + +fun main(args: Array) { + val repl_env = Env() + ns.forEach({ it -> repl_env.set(it.key, it.value) }) + + rep("(def! not (fn* (a) (if a false true)))", repl_env) + + while (true) { + val input = readline("user> ") + + try { + println(rep(input, repl_env)) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + t.printStackTrace() + } + } +} diff --git a/impls/kotlin/src/mal/step5_tco.kt b/impls/kotlin/src/mal/step5_tco.kt new file mode 100644 index 0000000000..ff8ff72545 --- /dev/null +++ b/impls/kotlin/src/mal/step5_tco.kt @@ -0,0 +1,108 @@ +package mal + +fun read(input: String?): MalType = read_str(input) + +fun eval(_ast: MalType, _env: Env): MalType { + var ast = _ast + var env = _env + + while (true) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { + "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + "let*" -> { + val childEnv = Env(env) + val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") + + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) + } + + env = childEnv + ast = ast.nth(2) + } + "fn*" -> return fn_STAR(ast, env) + "do" -> { + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } + ast = ast.seq().last() + } + "if" -> { + val check = eval(ast.nth(1), env) + + if (check !== NIL && check !== FALSE) { + ast = ast.nth(2) + } else if (ast.count() > 3) { + ast = ast.nth(3) + } else return NIL + } + else -> { + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + val firstEval = evaluated.first() + + when (firstEval) { + is MalFnFunction -> { + ast = firstEval.ast + env = Env(firstEval.env, firstEval.params, evaluated.rest().seq()) + } + is MalFunction -> return firstEval.apply(evaluated.rest()) + else -> throw MalException("cannot execute non-function") + } + } + } + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } + } +} + +private fun fn_STAR(ast: MalList, env: Env): MalType { + val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") + val params = binds.seq().filterIsInstance() + val body = ast.nth(2) + + return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) +} + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun rep(input: String, env: Env): String = + print(eval(read(input), env)) + +fun main(args: Array) { + val repl_env = Env() + ns.forEach({ it -> repl_env.set(it.key, it.value) }) + + rep("(def! not (fn* (a) (if a false true)))", repl_env) + + while (true) { + val input = readline("user> ") + + try { + println(rep(input, repl_env)) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + t.printStackTrace() + } + } +} diff --git a/impls/kotlin/src/mal/step6_file.kt b/impls/kotlin/src/mal/step6_file.kt new file mode 100644 index 0000000000..b049c9ad6d --- /dev/null +++ b/impls/kotlin/src/mal/step6_file.kt @@ -0,0 +1,119 @@ +package mal + +import java.util.* + +fun read(input: String?): MalType = read_str(input) + +fun eval(_ast: MalType, _env: Env): MalType { + var ast = _ast + var env = _env + + while (true) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { + "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + "let*" -> { + val childEnv = Env(env) + val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") + + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) + } + + env = childEnv + ast = ast.nth(2) + } + "fn*" -> return fn_STAR(ast, env) + "do" -> { + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } + ast = ast.seq().last() + } + "if" -> { + val check = eval(ast.nth(1), env) + + if (check !== NIL && check !== FALSE) { + ast = ast.nth(2) + } else if (ast.count() > 3) { + ast = ast.nth(3) + } else return NIL + } + else -> { + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + val firstEval = evaluated.first() + + when (firstEval) { + is MalFnFunction -> { + ast = firstEval.ast + env = Env(firstEval.env, firstEval.params, evaluated.rest().seq()) + } + is MalFunction -> return firstEval.apply(evaluated.rest()) + else -> throw MalException("cannot execute non-function") + } + } + } + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } + } +} + +private fun fn_STAR(ast: MalList, env: Env): MalType { + val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") + val params = binds.seq().filterIsInstance() + val body = ast.nth(2) + + return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) +} + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun rep(input: String, env: Env): String = + print(eval(read(input), env)) + +fun main(args: Array) { + val repl_env = Env() + ns.forEach({ it -> repl_env.set(it.key, it.value) }) + + repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) + repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) + + rep("(def! not (fn* (a) (if a false true)))", repl_env) + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + + if (args.any()) { + rep("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + val input = readline("user> ") + + try { + println(rep(input, repl_env)) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + t.printStackTrace() + } + } +} diff --git a/impls/kotlin/src/mal/step7_quote.kt b/impls/kotlin/src/mal/step7_quote.kt new file mode 100644 index 0000000000..a32b2c69fa --- /dev/null +++ b/impls/kotlin/src/mal/step7_quote.kt @@ -0,0 +1,159 @@ +package mal + +import java.util.* + +fun read(input: String?): MalType = read_str(input) + +fun eval(_ast: MalType, _env: Env): MalType { + var ast = _ast + var env = _env + + while (true) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { + "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + "let*" -> { + val childEnv = Env(env) + val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") + + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) + } + + env = childEnv + ast = ast.nth(2) + } + "fn*" -> return fn_STAR(ast, env) + "do" -> { + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } + ast = ast.seq().last() + } + "if" -> { + val check = eval(ast.nth(1), env) + + if (check !== NIL && check !== FALSE) { + ast = ast.nth(2) + } else if (ast.count() > 3) { + ast = ast.nth(3) + } else return NIL + } + "quote" -> return ast.nth(1) + "quasiquote" -> ast = quasiquote(ast.nth(1)) + else -> { + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + val firstEval = evaluated.first() + + when (firstEval) { + is MalFnFunction -> { + ast = firstEval.ast + env = Env(firstEval.env, firstEval.params, evaluated.rest().seq()) + } + is MalFunction -> return firstEval.apply(evaluated.rest()) + else -> throw MalException("cannot execute non-function") + } + } + } + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } + } +} + +private fun fn_STAR(ast: MalList, env: Env): MalType { + val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") + val params = binds.seq().filterIsInstance() + val body = ast.nth(2) + + return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) +} + +private fun quasiquote(ast: MalType): MalType { + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast + } +} + +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) + } + result.conj_BANG(acc) + return result +} + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun rep(input: String, env: Env): String = + print(eval(read(input), env)) + +fun main(args: Array) { + val repl_env = Env() + ns.forEach({ it -> repl_env.set(it.key, it.value) }) + + repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) + repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) + + rep("(def! not (fn* (a) (if a false true)))", repl_env) + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + + if (args.any()) { + rep("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + val input = readline("user> ") + + try { + println(rep(input, repl_env)) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + t.printStackTrace() + } + } +} diff --git a/impls/kotlin/src/mal/step8_macros.kt b/impls/kotlin/src/mal/step8_macros.kt new file mode 100644 index 0000000000..b2d5f8b8c7 --- /dev/null +++ b/impls/kotlin/src/mal/step8_macros.kt @@ -0,0 +1,171 @@ +package mal + +import java.util.* + +fun read(input: String?): MalType = read_str(input) + +fun eval(_ast: MalType, _env: Env): MalType { + var ast = _ast + var env = _env + + while (true) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { + "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + "let*" -> { + val childEnv = Env(env) + val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") + + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) + } + + env = childEnv + ast = ast.nth(2) + } + "fn*" -> return fn_STAR(ast, env) + "do" -> { + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } + ast = ast.seq().last() + } + "if" -> { + val check = eval(ast.nth(1), env) + + if (check !== NIL && check !== FALSE) { + ast = ast.nth(2) + } else if (ast.count() > 3) { + ast = ast.nth(3) + } else return NIL + } + "quote" -> return ast.nth(1) + "quasiquote" -> ast = quasiquote(ast.nth(1)) + "defmacro!" -> return defmacro(ast, env) + else -> { + val firstEval = eval(ast.first(), env) + if (firstEval is MalFunction && firstEval.is_macro) { + ast = firstEval.apply(ast.rest()) + } else { + val args = ast.elements.drop(1).fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + when (firstEval) { + is MalFnFunction -> { + ast = firstEval.ast + env = Env(firstEval.env, firstEval.params, args.seq()) + } + is MalFunction -> return firstEval.apply(args) + else -> throw MalException("cannot execute non-function") + } + } + } + } + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } + } +} + +private fun fn_STAR(ast: MalList, env: Env): MalType { + val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") + val params = binds.seq().filterIsInstance() + val body = ast.nth(2) + + return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) +} + +private fun quasiquote(ast: MalType): MalType { + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast + } +} + +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) + } + result.conj_BANG(acc) + return result +} + +private fun defmacro(ast: MalList, env: Env): MalType { + val macro = eval(ast.nth(2), env) as MalFunction + macro.is_macro = true + + return env.set(ast.nth(1) as MalSymbol, macro) +} + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun rep(input: String, env: Env): String = + print(eval(read(input), env)) + +fun main(args: Array) { + val repl_env = Env() + ns.forEach({ it -> repl_env.set(it.key, it.value) }) + + repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) + repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) + + rep("(def! not (fn* (a) (if a false true)))", repl_env) + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if (args.any()) { + rep("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + val input = readline("user> ") + + try { + println(rep(input, repl_env)) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + t.printStackTrace() + } + } +} diff --git a/impls/kotlin/src/mal/step9_try.kt b/impls/kotlin/src/mal/step9_try.kt new file mode 100644 index 0000000000..7185a9c00e --- /dev/null +++ b/impls/kotlin/src/mal/step9_try.kt @@ -0,0 +1,187 @@ +package mal + +import java.util.* + +fun read(input: String?): MalType = read_str(input) + +fun eval(_ast: MalType, _env: Env): MalType { + var ast = _ast + var env = _env + + while (true) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { + "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + "let*" -> { + val childEnv = Env(env) + val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") + + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) + } + + env = childEnv + ast = ast.nth(2) + } + "fn*" -> return fn_STAR(ast, env) + "do" -> { + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } + ast = ast.seq().last() + } + "if" -> { + val check = eval(ast.nth(1), env) + + if (check !== NIL && check !== FALSE) { + ast = ast.nth(2) + } else if (ast.count() > 3) { + ast = ast.nth(3) + } else return NIL + } + "quote" -> return ast.nth(1) + "quasiquote" -> ast = quasiquote(ast.nth(1)) + "defmacro!" -> return defmacro(ast, env) + "try*" -> return try_catch(ast, env) + else -> { + val firstEval = eval(ast.first(), env) + if (firstEval is MalFunction && firstEval.is_macro) { + ast = firstEval.apply(ast.rest()) + } else { + val args = ast.elements.drop(1).fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + when (firstEval) { + is MalFnFunction -> { + ast = firstEval.ast + env = Env(firstEval.env, firstEval.params, args.seq()) + } + is MalFunction -> return firstEval.apply(args) + else -> throw MalException("cannot execute non-function") + } + } + } + } + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } + } +} + +private fun fn_STAR(ast: MalList, env: Env): MalType { + val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") + val params = binds.seq().filterIsInstance() + val body = ast.nth(2) + + return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) +} + +private fun quasiquote(ast: MalType): MalType { + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast + } +} + +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) + } + result.conj_BANG(acc) + return result +} + +private fun defmacro(ast: MalList, env: Env): MalType { + val macro = eval(ast.nth(2), env) as MalFunction + macro.is_macro = true + + return env.set(ast.nth(1) as MalSymbol, macro) +} + +private fun try_catch(ast: MalList, env: Env): MalType = + try { + eval(ast.nth(1), env) + } catch (e: Exception) { + if (ast.count() < 3) { throw e } + val thrown = if (e is MalException) e else MalException(e.message) + val symbol = (ast.nth(2) as MalList).nth(1) as MalSymbol + + val catchBody = (ast.nth(2) as MalList).nth(2) + val catchEnv = Env(env) + catchEnv.set(symbol, thrown) + + eval(catchBody, catchEnv) + } + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun rep(input: String, env: Env): String = + print(eval(read(input), env)) + +fun main(args: Array) { + val repl_env = Env() + ns.forEach({ it -> repl_env.set(it.key, it.value) }) + + repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) + repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) + + rep("(def! not (fn* (a) (if a false true)))", repl_env) + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if (args.any()) { + rep("(load-file \"${args[0]}\")", repl_env) + return + } + + while (true) { + val input = readline("user> ") + + try { + println(rep(input, repl_env)) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + t.printStackTrace() + } + } +} diff --git a/impls/kotlin/src/mal/stepA_mal.kt b/impls/kotlin/src/mal/stepA_mal.kt new file mode 100644 index 0000000000..93d9a9f7f1 --- /dev/null +++ b/impls/kotlin/src/mal/stepA_mal.kt @@ -0,0 +1,189 @@ +package mal + +import java.util.* + +fun read(input: String?): MalType = read_str(input) + +fun eval(_ast: MalType, _env: Env): MalType { + var ast = _ast + var env = _env + + while (true) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { + "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) + "let*" -> { + val childEnv = Env(env) + val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") + + val it = bindings.seq().iterator() + while (it.hasNext()) { + val key = it.next() + if (!it.hasNext()) throw MalException("odd number of binding elements in let*") + childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) + } + + env = childEnv + ast = ast.nth(2) + } + "fn*" -> return fn_STAR(ast, env) + "do" -> { + for (i in 1..ast.count() - 2) { + eval(ast.nth(i), env) + } + ast = ast.seq().last() + } + "if" -> { + val check = eval(ast.nth(1), env) + + if (check !== NIL && check !== FALSE) { + ast = ast.nth(2) + } else if (ast.count() > 3) { + ast = ast.nth(3) + } else return NIL + } + "quote" -> return ast.nth(1) + "quasiquote" -> ast = quasiquote(ast.nth(1)) + "defmacro!" -> return defmacro(ast, env) + "try*" -> return try_catch(ast, env) + else -> { + val firstEval = eval(ast.first(), env) + if (firstEval is MalFunction && firstEval.is_macro) { + ast = firstEval.apply(ast.rest()) + } else { + val args = ast.elements.drop(1).fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) + when (firstEval) { + is MalFnFunction -> { + ast = firstEval.ast + env = Env(firstEval.env, firstEval.params, args.seq()) + } + is MalFunction -> return firstEval.apply(args) + else -> throw MalException("cannot execute non-function") + } + } + } + } + } + is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) + is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) + else -> return ast + } + } +} + +private fun fn_STAR(ast: MalList, env: Env): MalType { + val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") + val params = binds.seq().filterIsInstance() + val body = ast.nth(2) + + return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) +} + +private fun quasiquote(ast: MalType): MalType { + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast + } +} + +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) + } + result.conj_BANG(acc) + return result +} + +private fun defmacro(ast: MalList, env: Env): MalType { + val f = eval(ast.nth(2), env) as MalFunction + val macro = MalFunction(f.lambda) + macro.is_macro = true + + return env.set(ast.nth(1) as MalSymbol, macro) +} + +private fun try_catch(ast: MalList, env: Env): MalType = + try { + eval(ast.nth(1), env) + } catch (e: Exception) { + if (ast.count() < 3) { throw e } + val thrown = if (e is MalException) e else MalException(e.message) + val symbol = (ast.nth(2) as MalList).nth(1) as MalSymbol + + val catchBody = (ast.nth(2) as MalList).nth(2) + val catchEnv = Env(env) + catchEnv.set(symbol, thrown) + + eval(catchBody, catchEnv) + } + +fun print(result: MalType) = pr_str(result, print_readably = true) + +fun rep(input: String, env: Env): String = + print(eval(read(input), env)) + +fun main(args: Array) { + val repl_env = Env() + ns.forEach({ it -> repl_env.set(it.key, it.value) }) + + repl_env.set(MalSymbol("*host-language*"), MalString("kotlin")) + repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) + repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) + + rep("(def! not (fn* (a) (if a false true)))", repl_env) + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if (args.any()) { + rep("(load-file \"${args[0]}\")", repl_env) + return + } + + rep("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) + while (true) { + val input = readline("user> ") + try { + println(rep(input, repl_env)) + } catch (e: EofException) { + break + } catch (e: MalContinue) { + } catch (e: MalException) { + println("Error: " + e.message) + } catch (t: Throwable) { + println("Uncaught " + t + ": " + t.message) + t.printStackTrace() + } + } +} diff --git a/impls/kotlin/src/mal/types.kt b/impls/kotlin/src/mal/types.kt new file mode 100644 index 0000000000..a981f4ecb1 --- /dev/null +++ b/impls/kotlin/src/mal/types.kt @@ -0,0 +1,222 @@ +package mal + +import java.util.* + +open class MalException(message: String?) : Exception(message), MalType { + override var metadata: MalType = NIL + override fun with_meta(meta: MalType): MalType { + val exception = MalException(message) + exception.metadata = meta + return exception + } +} + +class MalContinue() : MalException("continue") +class MalReaderException(message: String) : MalException(message) +class MalPrinterException(message: String) : MalException(message) + +class MalCoreException(message: String, val value: MalType) : MalException(message) { + override fun with_meta(meta: MalType): MalType { + val exception = MalCoreException(message as String, value) + exception.metadata = meta + return exception + } +} + +interface MalType { + var metadata: MalType + fun with_meta(meta: MalType): MalType +} + +open class MalConstant(val value: String) : MalType { + override var metadata: MalType = NIL + + override fun equals(other: Any?): Boolean = other is MalConstant && value.equals(other.value) + override fun hashCode(): Int = value.hashCode() + + override fun with_meta(meta: MalType): MalType { + val obj = MalConstant(value) + obj.metadata = meta + return obj + } +} + +class MalInteger(val value: Long) : MalType { + override var metadata: MalType = NIL + + operator fun plus(a: MalInteger): MalInteger = MalInteger(value + a.value) + operator fun minus(a: MalInteger): MalInteger = MalInteger(value - a.value) + operator fun times(a: MalInteger): MalInteger = MalInteger(value * a.value) + operator fun div(a: MalInteger): MalInteger = MalInteger(value / a.value) + operator fun compareTo(a: MalInteger): Int = value.compareTo(a.value) + + override fun equals(other: Any?): Boolean = other is MalInteger && value.equals(other.value) + + override fun with_meta(meta: MalType): MalType { + val obj = MalInteger(value) + obj.metadata = meta + return obj + } +} + +class MalSymbol(val value: String) : MalType { + override var metadata: MalType = NIL + + override fun equals(other: Any?): Boolean = other is MalSymbol && value.equals(other.value) + + override fun with_meta(meta: MalType): MalType { + val obj = MalSymbol(value) + obj.metadata = meta + return obj + } +} + +open class MalString(value: String) : MalConstant(value) { + override fun with_meta(meta: MalType): MalType { + val obj = MalString(value) + obj.metadata = meta + return obj + } +} + +class MalKeyword(value: String) : MalString("\u029E" + value) { + override fun with_meta(meta: MalType): MalType { + val obj = MalKeyword(value) + obj.metadata = meta + return obj + } +} + +interface ILambda : MalType { + fun apply(seq: ISeq): MalType +} + +open class MalFunction(val lambda: (ISeq) -> MalType) : MalType, ILambda { + var is_macro: Boolean = false + override var metadata: MalType = NIL + + override fun apply(seq: ISeq): MalType = lambda(seq) + + override fun with_meta(meta: MalType): MalType { + val obj = MalFunction(lambda) + obj.metadata = meta + return obj + } +} + +class MalFnFunction(val ast: MalType, val params: Sequence, val env: Env, lambda: (ISeq) -> MalType) : MalFunction(lambda) { + override fun with_meta(meta: MalType): MalType { + val obj = MalFnFunction(ast, params, env, lambda) + obj.metadata = meta + return obj + } +} + +interface ISeq : MalType { + fun seq(): Sequence + fun first(): MalType + fun rest(): ISeq + fun nth(n: Int): MalType + fun count(): Int + fun slice(fromIndex: Int, toIndex: Int): ISeq + fun conj(s: ISeq): ISeq +} + +interface IMutableSeq : ISeq { + fun conj_BANG(form: MalType) +} + +abstract class MalSequence(val elements: MutableList) : MalType, IMutableSeq { + override var metadata: MalType = NIL + + override fun seq(): Sequence = elements.asSequence() + override fun first(): MalType = elements.first() + override fun nth(n: Int): MalType = elements.elementAt(n) + override fun count(): Int = elements.count() + + override fun conj_BANG(form: MalType) { + elements.add(form) + } + + override fun equals(other: Any?): Boolean = + (other is ISeq) + && elements.size == other.count() + && elements.asSequence().zip(other.seq()).all({ it -> it.first == it.second }) +} + +class MalList(elements: MutableList) : MalSequence(elements) { + constructor() : this(LinkedList()) + constructor(s: ISeq) : this(s.seq().toCollection(LinkedList())) + + override fun rest(): ISeq = MalList(elements.drop(1).toCollection(LinkedList())) + + override fun slice(fromIndex: Int, toIndex: Int): MalList = + MalList(elements.subList(fromIndex, toIndex)) + + override fun conj(s: ISeq): ISeq { + val list = LinkedList(elements) + s.seq().forEach({ it -> list.addFirst(it) }) + return MalList(list) + } + + override fun with_meta(meta: MalType): MalType { + val obj = MalList(elements) + obj.metadata = meta + return obj + } +} + +class MalVector(elements: MutableList) : MalSequence(elements) { + override var metadata: MalType = NIL + + constructor() : this(ArrayList()) + constructor(s: ISeq) : this(s.seq().toCollection(ArrayList())) + + override fun rest(): ISeq = MalVector(elements.drop(1).toCollection(ArrayList())) + + override fun slice(fromIndex: Int, toIndex: Int): MalVector = + MalVector(elements.subList(fromIndex, toIndex)) + + override fun conj(s: ISeq): ISeq = MalVector(elements.plus(s.seq()).toCollection(ArrayList())) + + override fun with_meta(meta: MalType): MalType { + val obj = MalVector(elements) + obj.metadata = meta + return obj + } +} + +class MalHashMap() : MalType { + override var metadata: MalType = NIL + + val elements = HashMap() + + constructor(other: MalHashMap) : this() { + other.elements.forEach({ it -> assoc_BANG(it.key, it.value) }) + } + + fun assoc_BANG(key: MalString, value: MalType) = elements.put(key, value) + + fun dissoc_BANG(key: MalString) { + elements.remove(key) + } + + override fun with_meta(meta: MalType): MalType { + val obj = MalHashMap(this) + obj.metadata = meta + return obj + } + + override fun equals(other: Any?): Boolean = + (other is MalHashMap) && elements.equals(other.elements) +} + +class MalAtom(var value: MalType) : MalType { + override var metadata: MalType = NIL + override fun with_meta(meta: MalType): MalType = throw UnsupportedOperationException() +} + +val NIL = MalConstant("nil") +val TRUE = MalConstant("true") +val FALSE = MalConstant("false") +val ZERO = MalInteger(0) diff --git a/impls/kotlin/tests/step5_tco.mal b/impls/kotlin/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/kotlin/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/latex3/Dockerfile b/impls/latex3/Dockerfile new file mode 100644 index 0000000000..26c8534771 --- /dev/null +++ b/impls/latex3/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install texlive-latex-base diff --git a/impls/latex3/Makefile b/impls/latex3/Makefile new file mode 100644 index 0000000000..399a4e44bb --- /dev/null +++ b/impls/latex3/Makefile @@ -0,0 +1,3 @@ +all: +clean: + rm -f *~ *.aux *.dvi *.log argv diff --git a/impls/latex3/core.sty b/impls/latex3/core.sty new file mode 100644 index 0000000000..ff9c6df6c4 --- /dev/null +++ b/impls/latex3/core.sty @@ -0,0 +1,512 @@ +\ProvidesExplPackage {core} {2023/01/01} {0.0.1} {MAL~core~functions} +\RequirePackage{types} +\RequirePackage{printer} +\RequirePackage{reader} + +\cs_new:Nn \mal_def_builtin:nN + { \prop_put:Nxn \l_mal_repl_env_prop { y \tl_to_str:n { #1 } } { b n #2 } } +\cs_generate_variant:Nn \mal_def_builtin:nN { nc } +\cs_new:Nn \mal_def_builtin:nnn + { + \cs_new:cn { mal_ #2 :n } { #3 } + \mal_def_builtin:nc { #1 } { mal_ #2 :n } + } + +% Integer operations + +\cs_new:Nn \mal_int_op:nnN + { + % \iow_term:n {int_op~left=#1~right=#2~operator=#3} + \tl_set:Nx \l_tmpa_tl + { i \int_eval:n { \use_none:n #1 #3 \use_none:n #2 } } + } + +\mal_def_builtin:nnn { + } { add } { \mal_int_op:nnN #1 + } +\mal_def_builtin:nnn { - } { sub } { \mal_int_op:nnN #1 - } +\mal_def_builtin:nnn { * } { mul } { \mal_int_op:nnN #1 * } +\mal_def_builtin:nnn { / } { div } { \mal_int_op:nnN #1 / } + +% Integer comparisons + +\cs_new:Nn \mal_int_comp:nnNnn + { + \tl_set:Nx \l_tmpa_tl + { \int_compare:oNoTF { \use_none:n #1 } #3 { \use_none:n #2 } #4 #5 } + } + +\mal_def_builtin:nnn { < } { lt} { \mal_int_comp:nnNnn #1 < { t } { f } } +\mal_def_builtin:nnn { > } { gt} { \mal_int_comp:nnNnn #1 > { t } { f } } +\mal_def_builtin:nnn { <= } { le} { \mal_int_comp:nnNnn #1 > { f } { t } } +\mal_def_builtin:nnn { >= } { ge} { \mal_int_comp:nnNnn #1 < { f } { t } } + +% Type tests + +\cs_new:Nn \mal_type_p:nN + { + \tl_set:Nx \l_tmpa_tl { \tl_if_head_eq_charcode:nNTF {#1} #2 { t } { f } } + } + +\mal_def_builtin:nnn { list? } { list_p } { \mal_type_p:nN #1 l } +\mal_def_builtin:nnn { atom? } { atom_p } { \mal_type_p:nN #1 a } +\mal_def_builtin:nnn { nil? } { nil_p } { \mal_type_p:nN #1 n } +\mal_def_builtin:nnn { true? } { true_p } { \mal_type_p:nN #1 t } +\mal_def_builtin:nnn { false? } { false_p } { \mal_type_p:nN #1 f } +\mal_def_builtin:nnn { symbol? } { symbol_p } { \mal_type_p:nN #1 y } +\mal_def_builtin:nnn { keyword? } { keyword_p } { \mal_type_p:nN #1 k } +\mal_def_builtin:nnn { vector? } { vector_p } { \mal_type_p:nN #1 v } +\mal_def_builtin:nnn { map? } { map_p } { \mal_type_p:nN #1 m } +\mal_def_builtin:nnn { string? } { string_p } { \mal_type_p:nN #1 s } +\mal_def_builtin:nnn { number? } { number_p } { \mal_type_p:nN #1 i } +\mal_def_builtin:nnn { macro? } { macro_p } { \mal_type_p:nN #1 c } +\mal_def_builtin:nnn { fn? } { fn_p } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN #1 b } + { \tl_if_head_eq_charcode_p:nN #1 u } + { \tl_set:Nn \l_tmpa_tl { t } } + { \tl_set:Nn \l_tmpa_tl { f } } + } +\mal_def_builtin:nnn { sequential? } { sequential_p } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN #1 l } + { \tl_if_head_eq_charcode_p:nN #1 v } + { \tl_set:Nn \l_tmpa_tl { t } } + { \tl_set:Nn \l_tmpa_tl { f } } + } + +% Other functions, in the order of the process guide. + +\mal_def_builtin:nnn { prn } { prn } + { + \iow_term:x { \mal_printer_tl:nVN {#1} \c_space_tl \c_true_bool } + \tl_set:Nn \l_tmpa_tl { n } + } + +\mal_def_builtin:nnn { list } { list } { \tl_set:Nn \l_tmpa_tl { l n #1 } } + +\cs_new:Nn \mal_empty_p_aux:n + { + \tl_set:Nx \l_tmpa_tl + { \tl_if_empty:oTF { \use_none:nn #1 } { t } { f } } + } +\mal_def_builtin:nnn { empty? } { empty_p } { \mal_empty_p_aux:n #1 } + +\cs_new:Nn \mal_equal_token_lists:nn + { + % \iow_term:n {equal_token_lists~#1~#2} + \tl_if_empty:nTF {#1} + { + \tl_if_empty:nTF {#2} + { \tl_set:Nn \l_tmpa_tl { t } } + { \tl_set:Nn \l_tmpa_tl { f } } + } + { + \tl_if_empty:nTF {#2} + { \tl_set:Nn \l_tmpa_tl { f } } + { + \mal_equal_form:xx { \tl_head:n {#1} } { \tl_head:n {#2} } + \tl_if_head_eq_charcode:VNT \l_tmpa_tl t + { + \mal_equal_token_lists:oo + { \use_none:n #1 } + { \use_none:n #2 } + } + % nothing to do if already false + } + } + } +\cs_generate_variant:Nn \mal_equal_token_lists:nn { oo } + +\cs_new:Nn \mal_equal_map:nn + { + \prop_set_eq:Nc \l_tmpa_prop { #1 } + \prop_set_eq:Nc \l_tmpb_prop { #2 } + \prop_remove:Nn \l_tmpa_prop { __meta__ } + \prop_remove:Nn \l_tmpb_prop { __meta__ } + \tl_if_eq:xxTF + { \prop_count:N \l_tmpa_prop } + { \prop_count:N \l_tmpb_prop } + { + \prop_if_empty:NTF \l_tmpa_prop + { \tl_set:Nn \l_tmpa_tl { t } } + { + \prop_map_inline:Nn \l_tmpa_prop + { + \prop_get:NnNTF \l_tmpb_prop {##1} \l_tmpb_tl + { + \mal_equal_form:Vn \l_tmpb_tl {##2} + \tl_if_head_eq_charcode:VNT \l_tmpa_tl f + { \prop_map_break: } + } + { + \tl_set:Nn \l_tmpa_tl { f } + \prop_map_break: + } + } + % Finish with true if not interrupted + } + } + { \tl_set:Nn \l_tmpa_tl { f } } + } + +\cs_new:Nn \mal_equal_form:nn + { + % \iow_term:n {equal_form~#1~#2} + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN {#1} l } + { \tl_if_head_eq_charcode_p:nN {#1} v } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN {#2} l } + { \tl_if_head_eq_charcode_p:nN {#2} v } + { \mal_equal_token_lists:oo { \use_none:nn #1 } { \use_none:nn #2 } } + { \tl_set:Nn \l_tmpa_tl { f } } + } + { + % \iow_term:n {not~a~sequence} + \tl_if_head_eq_charcode:nNTF {#1} m + { + \tl_if_head_eq_charcode:nNTF {#2} m + { \mal_equal_map:nn { #1 } { #2 } } + { \tl_set:Nn \l_tmpa_tl { f } } + } + { + % \iow_term:n {neither~a~sequence~nor~a~map} + \str_if_eq:nnTF {#1} {#2} + { \tl_set:Nn \l_tmpa_tl { t } } + { \tl_set:Nn \l_tmpa_tl { f } } + } + } + } +\cs_generate_variant:Nn \mal_equal_form:nn { Vn, xx } + +\mal_def_builtin:nnn { = } { equal_p } { \mal_equal_form:nn #1 } + +\mal_def_builtin:nnn { count } { count } + { + \tl_if_head_eq_charcode:nNTF #1 n + { \tl_set:Nn \l_tmpa_tl { i 0 } } + { \tl_set:Nx \l_tmpa_tl { i \int_eval:n { \tl_count:n #1 - 2 } } } + } + +\mal_def_builtin:nnn { pr-str } { pr_str } + { + % \iow_term:n {pr_str~#1} + \tl_set:Nx \l_tmpa_tl + { s \mal_printer_tl:nVN { #1 } \c_space_tl \c_true_bool } + } + +\mal_def_builtin:nnn { str } { str } + { \tl_set:Nx \l_tmpa_tl { s \mal_printer_tl:nnN { #1 } { } \c_false_bool } } + +\mal_def_builtin:nnn { println } { println } + { + \iow_term:x { \mal_printer_tl:nVN {#1} \c_space_tl \c_false_bool } + \tl_set:Nn \l_tmpa_tl n + } + +\cs_new:Nn \mal_read_string_aux:n + { + \tl_set:No \l_tmpa_str { \use_none:n #1 } + \mal_read_str: + } +\mal_def_builtin:nnn { read-string } { read_string } + { \mal_read_string_aux:n #1 } + +\cs_new:Nn \mal_slurp_aux:n + { + \tl_set:Nn \l_tmpa_tl { s } + \ior_open:Nx \g_tmpa_ior { \use_none:n #1 } + \ior_str_map_inline:Nn \g_tmpa_ior + { + \tl_put_right:Nn \l_tmpa_tl { ##1 } + \tl_put_right:NV \l_tmpa_tl \c_new_line_str + } + \ior_close:N \g_tmpa_ior + } +\mal_def_builtin:nnn { slurp } { slurp } { \mal_slurp_aux:n #1 } + +\mal_def_builtin:nnn { atom } { atom } + { + % \iow_term:n {atom~#1} + \int_incr:N \l_mal_object_counter_int + \tl_set:Nx \l_tmpa_tl { atom_ \int_use:N \l_mal_object_counter_int } + \tl_new:c \l_tmpa_tl + \tl_set:cn \l_tmpa_tl #1 + } + +\mal_def_builtin:nnn { deref } { deref } { \tl_set_eq:Nc \l_tmpa_tl #1 } + +\cs_new:Nn \mal_reset_aux:Nn + { + \tl_set:Nn #1 { #2 } + \tl_set:Nn \l_tmpa_tl { #2 } + } +\cs_generate_variant:Nn \mal_reset_aux:Nn { cn } +\mal_def_builtin:nnn { reset! } { reset } { \mal_reset_aux:cn #1 } + +\mal_def_builtin:nnn { swap! } { swap } + { + % \iow_term:n {swap~#1} + \mal_fn_apply:xx { \tl_item:nn { #1 }{ 2 } } + { { \exp_not:v { \tl_head:n { #1 } } } \exp_not:o { \use_none:nn #1 } } + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \tl_set_eq:cN { \tl_head:n { #1 } } \l_tmpa_tl } + } + +\cs_new:Nn \mal_cons_aux:nn + { + % \iow_term:n {cons~#1~#2} + \tl_set:No \l_tmpa_tl { \use_none:nn #2 } + \tl_put_left:Nn \l_tmpa_tl { l n {#1} } + } +\mal_def_builtin:nnn { cons } { cons } { \mal_cons_aux:nn #1 } + +\cs_new:Nn \mal_concat_fn:n { \use_none:nn #1 } +\mal_def_builtin:nnn { concat } { concat } + { \tl_set:Nx \l_tmpa_tl { l n \tl_map_function:nN {#1} \mal_concat_fn:n } } + +\cs_new:Nn \mal_vec_aux:n + { + % \iow_term:n {vec~#1} + \tl_set:No \l_tmpa_tl { \use_none:nn #1 } + \tl_put_left:Nn \l_tmpa_tl { v n } + } +\mal_def_builtin:nnn { vec } { vec } { \mal_vec_aux:n #1 } + +\cs_new:Nn \mal_nth_aux:nn + { + % \iow_term:n {nth~#1~#2} + \int_set:Nn \l_tmpa_int { 3 + \use_none:n #2 } + \tl_set:Nx \l_tmpa_tl { \tl_item:nV {#1} \l_tmpa_int } + \tl_if_empty:VT \l_tmpa_tl + { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n {nth:~index~out~of~range} } } + } +\mal_def_builtin:nnn { nth } { nth } { \mal_nth_aux:nn #1 } + +\mal_def_builtin:nnn { first } { first } + { + % \iow_term:n {first~#1} + \tl_set:Nx \l_tmpa_tl { \tl_item:nn #1 {3} } + \tl_if_empty:NT \l_tmpa_tl + { \tl_set:Nn \l_tmpa_tl {n} } + } + +% This returns () for nil (unlike \use_none:nnn). +\mal_def_builtin:nnn { rest } { rest } + { \tl_set:Nx \l_tmpa_tl { l n \tl_range:nnn #1 4 {-1} } } + +\mal_def_builtin:nnn { throw } { throw } + { + % \iow_term:n {throw~#1} + \tl_set:Nn \l_tmpa_tl #1 + \tl_put_left:Nn \l_tmpa_tl {e} + } + +\mal_def_builtin:nnn { apply } { apply } + { + % \iow_term:n {apply~#1} + \tl_set:Nx \l_tmpb_tl { \tl_item:nn { #1 } { -1 } } % mal sequence + \mal_fn_apply:xx + { \tl_head:n { #1 } } + { + \tl_range:nnn { #1 } { 2 } { -2 } + \tl_range:Vnn \l_tmpb_tl { 3 } { -1 } % the same as a tl + } + } + +\cs_new:Nn \mal_map_rec:nnn + { + % \iow_term:n {map~acc=#1~forms=#2~func=#3} + \tl_if_empty:nTF {#2} + { \tl_set:Nn \l_tmpa_tl {#1} } + { + \mal_fn_apply:nx { #3 } { { \tl_head:n {#2} } } + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \mal_map_rec:xon + { \exp_not:n {#1} { \exp_not:V \l_tmpa_tl } } + { \use_none:n #2 } + { #3 } + } + } + } +\cs_generate_variant:Nn \mal_map_rec:nnn { non, xon } +\cs_new:Nn \mal_map_aux:nn + { \mal_map_rec:non { l n } { \use_none:nn #2 } { #1 } } +\mal_def_builtin:nnn { map } { map } { \mal_map_aux:nn #1 } + +\cs_new:Nn \mal_symbol_aux:n { \tl_set:Nx \l_tmpa_tl { y \use_none:n #1 } } +\mal_def_builtin:nnn { symbol } { symbol } { \mal_symbol_aux:n #1 } + +\cs_new:Nn \mal_keyword_aux:n { \tl_set:Nx \l_tmpa_tl { k \use_none:n #1 } } +\mal_def_builtin:nnn { keyword } { keyword } { \mal_keyword_aux:n #1 } + +\mal_def_builtin:nnn { vector } { vector } { \tl_set:Nn \l_tmpa_tl { v n #1 } } + +\mal_def_builtin:nN { hash-map } \mal_hash_map:n + +\mal_def_builtin:nnn { assoc } { assoc } + { + % \iow_term:n {assoc~#1} + \mal_map_new: + \prop_set_eq:cc \l_tmpa_tl { \tl_head:n { #1 } } + \mal_assoc_internal:o { \use_none:n #1 } + } + +\mal_def_builtin:nnn { dissoc } { dissoc } + { + % \iow_term:n {dissoc~prop=#1~keys=#2} + \mal_map_new: + \prop_set_eq:cc \l_tmpa_tl { \tl_head:n { #1 } } + \tl_map_inline:on { \use_none:n #1 } { \prop_remove:cn \l_tmpa_tl { ##1 } } + } + +\cs_new:Nn \mal_get_aux:nn + { + % \iow_term:n {get~#1~#2} + \tl_if_head_eq_charcode:nNTF { #1 } n + { \tl_set:Nn \l_tmpa_tl { n } } + { + \prop_get:cnNF { #1 } { #2 } \l_tmpa_tl + { \tl_set:Nn \l_tmpa_tl { n } } + } + } +\mal_def_builtin:nnn { get } { get } { \mal_get_aux:nn #1 } + +\mal_def_builtin:nnn { contains? } { contains } + { + % \iow_term:n {contains?~#1~#2} + \prop_if_in:cnTF #1 + { \tl_set:Nn \l_tmpa_tl { t } } + { \tl_set:Nn \l_tmpa_tl { f } } + } + +\cs_new:Nn \mal_keys_fn:nn + { \str_if_eq:nnF { #1 } { __meta__ } { \exp_not:n { { #1 } } } } +\mal_def_builtin:nnn { keys } { keys } + { \tl_set:Nx \l_tmpa_tl { l n \prop_map_function:cN #1 \mal_keys_fn:nn } } + +\cs_new:Nn \mal_vals_fn:nn + { \str_if_eq:nnF { #1 } { __meta__ } { \exp_not:n { { #2 } } } } +\mal_def_builtin:nnn { vals } { vals } + { \tl_set:Nx \l_tmpa_tl { l n \prop_map_function:cN #1 \mal_vals_fn:nn } } + +\mal_def_builtin:nnn { readline } { readline } + { + % \iow_term:n {readline:~|#1|} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \str_set:Nx \l_tmpa_str { \str_tail:V \l_tmpa_tl } + \iow_term:V \l_tmpa_str + \ior_str_get_term:nN {} \l_tmpa_str + \tl_set:Nx \l_tmpa_tl { s \l_tmpa_str } + } + +% Seconds since the UNIX epoch * on first call to time-ms *. +\int_gzero_new:N \g_mal_first_epoch_int + +\mal_def_builtin:nnn { time-ms } { time_ms } + { + % Seconds are not accurate enough for MAL tests, so use %s%N. + % The raw nanosecond count overflows LaTeX integers. + % Even the millisecond count since 2024 overflows. + \iow_term:n {MAL_LATEX3_STRIP_ON} + \sys_get_shell:xnN { date ~ + \c_percent_str s \c_percent_str N} {} + \l_tmpa_str + \iow_term:n {MAL_LATEX3_STRIP_OFF} + % Extract the digits representing seconds. + \int_set:Nx \l_tmpa_int { \tl_range:Vnn \l_tmpa_str 1 { -10 } } + % If this is the first time this function is called, + \int_if_zero:VTF \g_mal_first_epoch_int { + % then store the seconds since the epoch for later use + \int_gset_eq:NN \g_mal_first_epoch_int \l_tmpa_int + % and return 0 seconds + \int_zero:N \l_tmpa_int + } { + % else return the duration in seconds since first call + \int_set:Nn \l_tmpa_int { \l_tmpa_int - \g_mal_first_epoch_int } + } + % ... in both cases, append the three digits for millisecond. + \tl_set:Nx \l_tmpa_tl { i \int_to_arabic:V \l_tmpa_int + \tl_range:Vnn \l_tmpa_str { -9 } { -7 } } + } + +\mal_def_builtin:nnn { meta } { meta } + { + % \iow_term:n {meta~#1} + \tl_if_head_eq_charcode:nNTF #1 m + { + \prop_get:cnNF #1 { __meta__ } \l_tmpa_tl + { \tl_set:Nx \l_tmpa_tl { n } } + } + { \tl_set:Nx \l_tmpa_tl { \tl_item:nn #1 { 2 } } } + } + +\cs_new:Nn \mal_with_meta_aux:nn + { + % \iow_term:n {with-meta~#1~#2} + \tl_if_head_eq_charcode:nNTF { #1 } m + { + \mal_map_new: + \prop_set_eq:cc \l_tmpa_tl { #1 } + \prop_put:cnn \l_tmpa_tl { __meta__ } { #2 } + } + { + \tl_set:Nx \l_tmpa_tl + { + \tl_head:n { #1 } + \exp_not:n { { #2 } } + \exp_not:o { \use_none:nn #1 } + } + } + } +\mal_def_builtin:nnn { with-meta } { with_meta } { \mal_with_meta_aux:nn #1 } + +\cs_new:Nn \mal_seq_fn:N { { s #1 } } +\cs_new:Nn \mal_seq_aux:n + { + % \iow_term:n {seq:~#1} + \exp_args:Nx \token_case_charcode:Nn { \tl_head:n {#1} } + { + n + { \tl_clear:N \l_tmpa_tl } + l + { \tl_set:No \l_tmpa_tl { \use_none:nn #1 } } + v + { \tl_set:No \l_tmpa_tl { \use_none:nn #1 } } + s + { + \tl_set:Nx \l_tmpa_tl + { \str_map_function:oN { \use_none:n #1 } \mal_seq_fn:N } + } + } + \tl_if_empty:NTF \l_tmpa_tl + { \tl_set:Nn \l_tmpa_tl n } + { \tl_put_left:Nn \l_tmpa_tl { l n } } + } +\mal_def_builtin:nnn { seq } { seq } { \mal_seq_aux:n #1 } + +\mal_def_builtin:nnn { conj } { conj } + { + % \iow_term:n {conj~#1} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \tl_set:Nx \l_tmpb_tl { \tl_tail:n {#1} } + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl v + { + \tl_set:Nx \l_tmpa_tl + { + v n + \tl_range:Vnn \l_tmpa_tl 3 {-1} + \exp_not:V \l_tmpb_tl + } + } + { + \tl_set:Nx \l_tmpa_tl + { + l n + \tl_reverse:V \l_tmpb_tl + \tl_range:Vnn \l_tmpa_tl 3 {-1} + } + } + } diff --git a/impls/latex3/env.sty b/impls/latex3/env.sty new file mode 100644 index 0000000000..f1a5f42adc --- /dev/null +++ b/impls/latex3/env.sty @@ -0,0 +1,61 @@ +\ProvidesExplPackage {env} {2023/01/01} {0.0.1} {MAL~environments} +\RequirePackage{types} + +\prop_new:N \l_mal_repl_env_prop + +% Scratch variable containing the name of an enviromnent as a token +% list, intended to be used with :c expansion. +\tl_new:N \l_mal_tmp_env_prop + +% Note that __outer__ is not a valid key. + +% The new environment is returned in \l_mal_tmp_env_prop. +\cs_new:Nn \mal_env_new:N + { + % \iow_term:n {env_new:~outer=#1} + \int_incr:N \l_mal_object_counter_int + \tl_set:Nx \l_mal_tmp_env_prop { env_ \int_use:N \l_mal_object_counter_int } + \prop_new:c \l_mal_tmp_env_prop + \prop_put:cnn \l_mal_tmp_env_prop { __outer__ } { #1 } + } + +% \prop_put:Nnn is OK for a single assignment. + +% Shortcut for repeated '\prop_put:cnn \l_mal_tmp_env_prop' assignments, +% with special handling of & variable arguments. + +\tl_const:Nx \c_ampersand_symbol { y \tl_to_str:n { & } } + +\cs_new:Nn \mal_env_set_keys_values:nn + { + % \iow_term:n {apply_loop:~keys=#1~vals=#2} + \tl_if_empty:nF { #1 } + { + \tl_set:Nx \l_tmpb_tl { \tl_head:n { #1 } } + \tl_if_eq:NNTF \l_tmpb_tl \c_ampersand_symbol + { \prop_put:cxn \l_mal_tmp_env_prop { \tl_item:nn { #1 } { 2 } } + { l n #2 } } + { + \prop_put:cVx \l_mal_tmp_env_prop \l_tmpb_tl { \tl_head:n { #2 } } + \mal_env_set_keys_values:oo { \use_none:n #1 } { \use_none:n #2 } + } + } + } +\cs_generate_variant:Nn \mal_env_set_keys_values:nn { on, oo } + +\cs_new:Nn \mal_env_get:NnTF + { + % \iow_term:n {env_get:~env=#1~key=#2} + \prop_get:NnNTF #1 { #2 } \l_tmpa_tl + { #3 } + { + \prop_get:NnNTF #1 { __outer__ } \l_tmpa_tl + { \exp_args:NV \mal_env_get:NnTF \l_tmpa_tl { #2 } { #3 } { #4 } } + { #4 } + } + } +% This one is useful for macroexpand, but may disappear once it is removed. +\cs_generate_variant:Nn \mal_env_get:NnTF { NxTF } +\cs_new:Nn \mal_env_get:NnT { \mal_env_get:NnTF #1 { #2 } { #3 } { } } +\cs_new:Nn \mal_env_get:NnF { \mal_env_get:NnTF #1 { #2 } { } { #3 } } +\cs_generate_variant:Nn \mal_env_get:NnT { NVT } diff --git a/impls/latex3/printer.sty b/impls/latex3/printer.sty new file mode 100644 index 0000000000..104e95dab4 --- /dev/null +++ b/impls/latex3/printer.sty @@ -0,0 +1,111 @@ +\ProvidesExplPackage {printer} {2023/01/01} {0.0.1} {MAL~printer} +\RequirePackage{types} + +\str_const:Nx \c_new_line_str { \char_generate:nn {10} {12} } + +% \str_map_function:oN { \use_none:n #1 } skips space characters bug? +% It does not in core.sty... why? +% \str_map_inline does not, but is not expandable. +\cs_new:Nn \mal_printer_string:n + { + \tl_if_empty:nF { #1 } + { + \tl_if_head_is_space:nTF { #1 } + { \c_space_tl } + { + \exp_args:NnV \tl_if_head_eq_charcode:nNTF { #1 } \c_new_line_str + { \c_backslash_str \tl_to_str:n { n } } + { + \bool_lazy_or:nnT + { \tl_if_head_eq_charcode_p:nN { #1 } " } + { \exp_args:NnV \tl_if_head_eq_charcode_p:nN { #1 } \c_backslash_str } + { \c_backslash_str } + \tl_head:n { #1 } + } + } + \mal_printer_string:e { \str_tail:n { #1 } } + } + } + +\cs_generate_variant:Nn \mal_printer_string:n { e, o } + +\cs_new:Nn \mal_printer_pr_str_flip:Nn { \mal_printer_pr_str:nN { #2 } #1 } + +\cs_new:Nn \mal_printer_tl:nnN + { + % \iow_term:n {printer_tl~forms=#1~separator=#2~readably=#3} + \tl_if_empty:nF {#1} + { + \mal_printer_pr_str:fN { \tl_head:n { #1 } } #3 + \tl_map_tokens:on { \use_none:n #1 } + { #2 \mal_printer_pr_str_flip:Nn #3 } + } + } +\cs_generate_variant:Nn \mal_printer_tl:nnN { nVN, oVN, VVN, eVN } + +\cs_new:Nn \mal_printer_map_fn:nn + { \str_if_eq:nnF { #1 } { __meta__ } { \exp_not:n { { #1 } { #2 } } } } + +\cs_new:Nn \mal_printer_pr_str:nN + { + \exp_args:Nf \token_case_charcode:NnF { \tl_head:n {#1} } + { + n { \tl_to_str:n { nil } } + f { \tl_to_str:n { false } } + t { \tl_to_str:n { true } } + + i { \int_to_arabic:o { \use_none:n #1 } } + + y { \use_none:n #1 } + k { \c_colon_str \use_none:n #1 } + s + { + \bool_if:NTF #2 + { " \mal_printer_string:o { \use_none:n #1 } " } + { \use_none:n #1 } + } + + l { ( \mal_printer_tl:oVN { \use_none:nn #1 } \c_space_tl #2 ) } + v { [ \mal_printer_tl:oVN { \use_none:nn #1 } \c_space_tl #2 ] } + m + { + \c_left_brace_str + \mal_printer_tl:eVN + { \prop_map_function:cN { #1 } \mal_printer_map_fn:nn } + \c_space_tl #2 + \c_right_brace_str + } + + b { \tl_to_str:n { } } + u { \tl_to_str:n { } } + c { \tl_to_str:n { } } + a { \tl_to_str:n { (atom~ } \mal_printer_pr_str:vN { #1 } #2 ) } + e + { \tl_to_str:n { Error:~ } \mal_printer_pr_str:oN { \use_none:n #1 } #2 } + } + { \tl_to_str:n { Error:~invalid~print~argument~#1 } } + } +\cs_generate_variant:Nn \mal_printer_pr_str:nN { fN, oN, VN, vN } + +%% \mal_printer_pr_str:nN { n } \c_true_bool +%% \mal_printer_pr_str:nN { i 23 } \c_true_bool +%% \mal_printer_pr_str:oN { y \tl_to_str:n { symbol } } \c_true_bool +%% \mal_printer_pr_str:oN { k \tl_to_str:n { keyword } } \c_true_bool +%% \mal_printer_pr_str:nN { s } \c_false_bool +%% \mal_printer_pr_str:oN { s \tl_to_str:n { unreadable"string } } \c_false_bool +%% \mal_printer_pr_str:nN { l n } \c_true_bool +%% \mal_printer_pr_str:nN { l n n t } \c_true_bool +%% \mal_printer_pr_str:nN { l n { i 1 } { i 2 } } \c_true_bool +%% \mal_printer_pr_str:nN { v n { i 1 } { i 2 } } \c_true_bool +%% \mal_printer_pr_str:nN { l n { l n { i 1 } { i 2 } } t } \c_true_bool +%% \mal_printer_pr_str:oN { s \tl_to_str:n { d " q } } \c_true_bool +%% \mal_printer_pr_str:oN { s \tl_to_str:n { b } \c_backslash_str \tl_to_str:n { s } } \c_true_bool +%% \mal_printer_pr_str:oN { s \tl_to_str:n { n } \c_new_line_str \tl_to_str:n { l } } \c_true_bool + +%% \tl_set:Nn \l_tmpa_tl { i 3 } +%% \mal_printer_pr_str:nN { a \l_tmpa_tl } \c_true_bool + +%% \prop_clear:N \l_tmpa_prop +%% \prop_put:Nxn \l_tmpa_prop { k \tl_to_str:n {a} } { i 12 } +%% \prop_put:Nxn \l_tmpa_prop { s \tl_to_str:n {b} } { n } +%% \mal_printer_pr_str:xN { m n \exp_not:V \l_tmpa_prop } \c_true_bool diff --git a/impls/latex3/reader.sty b/impls/latex3/reader.sty new file mode 100644 index 0000000000..d68d8fa946 --- /dev/null +++ b/impls/latex3/reader.sty @@ -0,0 +1,205 @@ +\ProvidesExplPackage {reader} {2023/01/01} {0.0.1} {MAL~reader} +\RequirePackage{types} + +% It would be convenient to output the forms in a list directly, but +% this would require a fully expandable read_str. \prop_set and +% \regex_replace_once are too convenient. + +% \l_tmpa_str is used as a common buffer for the remaining input. + +% Compile the regular expressions once and for all. +\regex_const:Nn \c_mal_space_regex { ^ (?: \s | , | ; \N* \n )* } +\regex_const:Nn \c_mal_unescape_cr_regex { \\ n } +\regex_const:Nn \c_mal_unescape_regex { \\ ([^n]) } +\regex_const:Nn \c_mal_number_regex + { ^ ( -? \d+ ) (.*) } +\regex_const:Nn \c_mal_symbol_regex + { ^ ( [^ " ' \( \) , ; @ \[ \] ^ ` \{ \} \~ \s ] + ) (.*) } +\regex_const:Nn \c_mal_keyword_regex + { ^ : ( [^ " ' \( \) , : ; @ \[ \] ^ ` \{ \} \~ \s ] + ) (.*) } +\regex_const:Nn \c_mal_string_regex + { ^ " ( (?: [^ \\ "] | \\ . )* ) " (.*) } + +\cs_new:Nn \mal_skip_spaces: + { \regex_replace_once:NnN \c_mal_space_regex {} \l_tmpa_str } + +\cs_new:Nn \mal_skip_char: + { \tl_set:Nx \l_tmpa_str { \tl_tail:V \l_tmpa_str } } + +% Read forms until a closing brace #1. +% Return a tl of MAL forms or an error in \l_tmpa_tl. +% accumulator closing brace +\cs_new:Nn \mal_reader_seq_loop:nN + { + % \iow_term:n {reader_seq_loop~#1~#2} + \mal_skip_spaces: + \tl_if_head_eq_charcode:VNTF \l_tmpa_str #2 + { + \mal_skip_char: + \tl_set:Nn \l_tmpa_tl { #1 } + } + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_reader_seq_loop:xN { \exp_not:n {#1} { \exp_not:V \l_tmpa_tl } } #2 } + } + } +\cs_generate_variant:Nn \mal_reader_seq_loop:nN { xN } + +% #1: a token list without leading y +\cs_new:Nn \mal_reader_quote:n + { + % \iow_term:n {quote~#1} + \mal_skip_char: + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:Nx \l_tmpa_tl + { + l n + { y \tl_to_str:n { #1 } } + { \exp_not:V \l_tmpa_tl } } + } + } + +% The only purpose of this macro is to store #1 during read_str. +\cs_new:Nn \mal_reader_with_meta:n + { + % \iow_term:n {with_meta~#1} + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:Nx \l_tmpa_tl { + l n + { y \tl_to_str:n { with-meta } } + { \exp_not:V \l_tmpa_tl } + \exp_not:n { { #1 } } + } + } + } +\cs_generate_variant:Nn \mal_reader_with_meta:n { V } + +% Input in \l_tmpa str (modified) +% Write the MAL form to \l_tmpa_tl. +\cs_new:Nn \mal_read_str: + { + % \iow_term:x {reader_read_str~\l_tmpa_str} + \mal_skip_spaces: + \str_case_e:nnF { \str_head:V \l_tmpa_str } + { + { ' } + { \mal_reader_quote:n { quote } } + { @ } + { \mal_reader_quote:n { deref } } + { ` } + { \mal_reader_quote:n { quasiquote } } + { ( } + { + \mal_skip_char: + \mal_reader_seq_loop:nN { l n } ) + } + { [ } + { + \mal_skip_char: + \mal_reader_seq_loop:nN { v n } ] + } + \c_left_brace_str + { + \mal_skip_char: + \exp_args:NnV \mal_reader_seq_loop:nN { } \c_right_brace_str + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_hash_map:V \l_tmpa_tl } + } + \c_tilde_str + { + \str_if_eq:xnTF { \str_item:Vn \l_tmpa_str 2 } { @ } + { + \mal_skip_char: + \mal_reader_quote:n { splice-unquote } + } + { \mal_reader_quote:n { unquote } } + } + { ^ } + { + \mal_skip_char: + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_reader_with_meta:V \l_tmpa_tl } + } + } + { + \regex_extract_once:NVNTF \c_mal_string_regex \l_tmpa_str \l_tmpa_seq + { + \seq_get_right:NN \l_tmpa_seq \l_tmpa_str + \tl_set:Nx \l_tmpa_tl { s \seq_item:Nn \l_tmpa_seq 2 } + \regex_replace_case_all:nN + { + \c_mal_unescape_cr_regex { \n } + \c_mal_unescape_regex { \1 } + } + \l_tmpa_tl + } + { + \regex_extract_once:NVNTF \c_mal_keyword_regex \l_tmpa_str \l_tmpa_seq + { + \seq_get_right:NN \l_tmpa_seq \l_tmpa_str + \tl_set:Nx \l_tmpa_tl { k \seq_item:Nn \l_tmpa_seq 2 } + } + { + \regex_extract_once:NVNTF \c_mal_number_regex \l_tmpa_str \l_tmpa_seq + { + \seq_get_right:NN \l_tmpa_seq \l_tmpa_str + \tl_set:Nx \l_tmpa_tl { i \seq_item:Nn \l_tmpa_seq 2 } + } + { + \regex_extract_once:NVNTF \c_mal_symbol_regex \l_tmpa_str \l_tmpa_seq + { + \seq_get_right:NN \l_tmpa_seq \l_tmpa_str + \tl_set:Nx \l_tmpa_tl { \seq_item:Nn \l_tmpa_seq 2 } + \str_case:NnF \l_tmpa_tl + { + { nil } { \tl_set:Nn \l_tmpa_tl { n } } + { false } { \tl_set:Nn \l_tmpa_tl { f } } + { true } { \tl_set:Nn \l_tmpa_tl { t } } + } + { \tl_put_left:Nn \l_tmpa_tl { y } } % catcode is already Ok + } + { + \tl_set:Nn \l_tmpa_tl { e s unbalanced~expression } + } + } + } + } + } + % \iow_term:n {__ read_str~returns} + % \iow_term:V \l_tmpa_tl + } + +% \str_set:Nn \l_tmpa_str { ~, } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { ~12~a } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { -12 } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { ab } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { nil } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { :ab } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { "ab"w } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { (,) } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { (nil~:a) } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { (nil,[:a]) } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { 'a } \mal_read_str: \iow_term:V \l_tmpa_tl +% \str_set:Nn \l_tmpa_str { ^a~b } \mal_read_str: \iow_term:V \l_tmpa_tl + +% \str_set:Nx \l_tmpa_str { \c_left_brace_str "a"~1~:b~2 \c_right_brace_str } +% \mal_read_str: +% \iow_term:V \l_tmpa_tl + +% \str_set:Nx \l_tmpa_str +% { +% \c_left_brace_str +% "a"~1 +% ~:b~\c_left_brace_str +% :c~3 +% \c_right_brace_str +% \c_right_brace_str +% } +% \mal_read_str: +% \iow_term:V \l_tmpa_tl diff --git a/impls/latex3/run b/impls/latex3/run new file mode 100755 index 0000000000..7a05291e20 --- /dev/null +++ b/impls/latex3/run @@ -0,0 +1,45 @@ +#!/bin/sh +set -Cefu + +# LaTeX creates temporary files in the current directory. +cd $(dirname $0) + +# There is no way to directly provide command line arguments to LaTeX, +# use an intermediate file. +for arg; do + echo "$arg" +done >| argv + +# max_print_line: prevent TeX from wrapping lines written to the +# terminal (the default is around 80 columns). + +# Shell escapes are necessary for time-ms in core.sty. +# time-ms also requires to strip the output caused by accessing a subshell. + +# Halt on error... should be the default. + +# Remove the normal TeX initial and final output. The > characters +# confuse the test runner, especially in the *ARGV* test. + +# There is no way in latex3 to check if the terminal receives an +# END_OF_FILE character, handle Emergency stop as a normal ending. + +# When debugging, set DEBUG=1 to see the actual output. + +max_print_line=1000 \ +latex \ + -shell-escape \ + -halt-on-error \ + ${STEP:-stepA_mal}.tex \ + | { + if [ -n "${DEBUG:-}" ]; then + cat + else + sed ' + 1,/^MAL_LATEX3_START_OF_OUTPUT$/ d + /^MAL_LATEX3_END_OF_OUTPUT$/,$ d + /^MAL_LATEX3_STRIP_ON/,/MAL_LATEX3_STRIP_OFF/ d + /^! Emergency stop[.]$/,$ d + ' + fi +} diff --git a/impls/latex3/step0_repl.tex b/impls/latex3/step0_repl.tex new file mode 100644 index 0000000000..7575cbb4b5 --- /dev/null +++ b/impls/latex3/step0_repl.tex @@ -0,0 +1,41 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \iow_term:V \l_tmpa_str + } + \repl_loop: + } + } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\repl_loop: + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step1_read_print.tex b/impls/latex3/step1_read_print.tex new file mode 100644 index 0000000000..b96c7c95b5 --- /dev/null +++ b/impls/latex3/step1_read_print.tex @@ -0,0 +1,44 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\repl_loop: + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step2_eval.tex b/impls/latex3/step2_eval.tex new file mode 100644 index 0000000000..f815a70cba --- /dev/null +++ b/impls/latex3/step2_eval.tex @@ -0,0 +1,173 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \prop_get:NnNF #2 { #1 } \l_tmpa_tl + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { oN, VN, xN } + +% REPL + +\prop_new:N \l_mal_repl_env_prop +\cs_new:Nn \mal_int_op:nnN + { + \tl_set:Nx \l_tmpa_tl + { i \int_eval:n { \use_none:n #1 #3 \use_none:n #2 } } + } +\cs_new:Nn \mal_add:n { \mal_int_op:nnN #1 + } +\cs_new:Nn \mal_sub:n { \mal_int_op:nnN #1 - } +\cs_new:Nn \mal_mul:n { \mal_int_op:nnN #1 * } +\cs_new:Nn \mal_div:n { \mal_int_op:nnN #1 / } +\prop_put:Nnn \l_mal_repl_env_prop { y + } { b n \mal_add:n } +\prop_put:Nnn \l_mal_repl_env_prop { y - } { b n \mal_sub:n } +\prop_put:Nnn \l_mal_repl_env_prop { y * } { b n \mal_mul:n } +\prop_put:Nnn \l_mal_repl_env_prop { y / } { b n \mal_div:n } + + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\repl_loop: + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step3_env.tex b/impls/latex3/step3_env.tex new file mode 100644 index 0000000000..9aa083f212 --- /dev/null +++ b/impls/latex3/step3_env.tex @@ -0,0 +1,222 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\usepackage{env} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% Step 3 + +\tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } +\tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } +\tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } + +\cs_new:Nn \mal_eval_let_loop:nNn + { + % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} + \tl_if_empty:nTF { #1 } + { \mal_eval:nN { #3 } #2 } + { + \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl + \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } + } + } + } +\cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } + +\cs_new:Nn \mal_eval_let:nnnN + { + % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} + \mal_env_new:N #4 + \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } + } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } + { + \mal_eval:oN { \use_iii:nnn #1 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } + \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } + { \mal_eval_let:nnnN #1 #2 } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \mal_env_get:NVT #2 \c_debug_eval_symbol + { + \bool_lazy_or:nnF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } + } + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \mal_env_get:NnF #2 { #1 } + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } + +% REPL + +\cs_new:Nn \mal_int_op:nnN + { + \tl_set:Nx \l_tmpa_tl + { i \int_eval:n { \use_none:n #1 #3 \use_none:n #2 } } + } +\cs_new:Nn \mal_add:n { \mal_int_op:nnN #1 + } +\cs_new:Nn \mal_sub:n { \mal_int_op:nnN #1 - } +\cs_new:Nn \mal_mul:n { \mal_int_op:nnN #1 * } +\cs_new:Nn \mal_div:n { \mal_int_op:nnN #1 / } +\prop_put:Nnn \l_mal_repl_env_prop { y + } { b n \mal_add:n } +\prop_put:Nnn \l_mal_repl_env_prop { y - } { b n \mal_sub:n } +\prop_put:Nnn \l_mal_repl_env_prop { y * } { b n \mal_mul:n } +\prop_put:Nnn \l_mal_repl_env_prop { y / } { b n \mal_div:n } + + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\repl_loop: + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step4_if_fn_do.tex b/impls/latex3/step4_if_fn_do.tex new file mode 100644 index 0000000000..cc88332e67 --- /dev/null +++ b/impls/latex3/step4_if_fn_do.tex @@ -0,0 +1,293 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\usepackage{env} +\usepackage{core} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% Step 3 + +\tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } +\tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } +\tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } + +\cs_new:Nn \mal_eval_let_loop:nNn + { + % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} + \tl_if_empty:nTF { #1 } + { \mal_eval:nN { #3 } #2 } + { + \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl + \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } + } + } + } +\cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } + +\cs_new:Nn \mal_eval_let:nnnN + { + % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} + \mal_env_new:N #4 + \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } + } + +% Step 4 + +\tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } +\tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } +\tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } + +\cs_new:Nn \mal_eval_if:nnnN + { + % \iow_term:n {if~test=#2~then=#3~env=#4} + \mal_eval:nN {#2} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \tl_set:Nn \l_tmpa_tl { n } } + { \mal_eval:nN {#3} #4 } + } + } + +\cs_new:Nn \mal_eval_if:nnnnN + { + % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} + \mal_eval:nN {#2} #5 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \mal_eval:nN { #4 } #5 } + { \mal_eval:nN { #3 } #5 } + } + } + +\cs_new:Nn \mal_fn:nnnN + { + % \iow_term:n {fn*~params=#2~implem=#3~env=#4} + \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } + % \iow_term:V \l_tmpa_tl + } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \tl_if_head_eq_charcode:nNTF { #1 } u + { + \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } + \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } + \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop + } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } + { + \mal_eval:oN { \use_iii:nnn #1 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } + \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } + { \mal_eval_let:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } + { + \tl_if_empty:oTF { \use_none:nnn #1 } + { \mal_eval_if:nnnN #1 #2 } + { \mal_eval_if:nnnnN #1 #2 } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } + { + \tl_map_inline:on { \use_none:n #1 } + { + \mal_eval:nN { ##1 } #2 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } + { \mal_fn:nnnN #1 #2 } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \mal_env_get:NVT #2 \c_debug_eval_symbol + { + \bool_lazy_or:nnF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } + } + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \mal_env_get:NnF #2 { #1 } + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +\cs_new:Nn \mal_re:n + { + % \iow_term:n {re:~#1} + \str_set:Nn \l_tmpa_str {#1} + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { + \iow_term:n {error~during~startup~#1} + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + Trigger a missing begin document error + } + } + +\mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\repl_loop: + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step6_file.tex b/impls/latex3/step6_file.tex new file mode 100644 index 0000000000..188165cbe7 --- /dev/null +++ b/impls/latex3/step6_file.tex @@ -0,0 +1,314 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\usepackage{env} +\usepackage{core} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% Step 3 + +\tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } +\tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } +\tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } + +\cs_new:Nn \mal_eval_let_loop:nNn + { + % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} + \tl_if_empty:nTF { #1 } + { \mal_eval:nN { #3 } #2 } + { + \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl + \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } + } + } + } +\cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } + +\cs_new:Nn \mal_eval_let:nnnN + { + % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} + \mal_env_new:N #4 + \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } + } + +% Step 4 + +\tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } +\tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } +\tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } + +\cs_new:Nn \mal_eval_if:nnnN + { + % \iow_term:n {if~test=#2~then=#3~env=#4} + \mal_eval:nN {#2} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \tl_set:Nn \l_tmpa_tl { n } } + { \mal_eval:nN {#3} #4 } + } + } + +\cs_new:Nn \mal_eval_if:nnnnN + { + % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} + \mal_eval:nN {#2} #5 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \mal_eval:nN { #4 } #5 } + { \mal_eval:nN { #3 } #5 } + } + } + +\cs_new:Nn \mal_fn:nnnN + { + % \iow_term:n {fn*~params=#2~implem=#3~env=#4} + \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } + % \iow_term:V \l_tmpa_tl + } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \tl_if_head_eq_charcode:nNTF { #1 } u + { + \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } + \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } + \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop + } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } + { + \mal_eval:oN { \use_iii:nnn #1 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } + \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } + { \mal_eval_let:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } + { + \tl_if_empty:oTF { \use_none:nnn #1 } + { \mal_eval_if:nnnN #1 #2 } + { \mal_eval_if:nnnnN #1 #2 } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } + { + \tl_map_inline:on { \use_none:n #1 } + { + \mal_eval:nN { ##1 } #2 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } + { \mal_fn:nnnN #1 #2 } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \mal_env_get:NVT #2 \c_debug_eval_symbol + { + \bool_lazy_or:nnF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } + } + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \mal_env_get:NnF #2 { #1 } + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +\cs_new:Nn \mal_re:n + { + % \iow_term:n {re:~#1} + \str_set:Nn \l_tmpa_str {#1} + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { + \iow_term:n {error~during~startup~#1} + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + Trigger a missing begin document error + } + } +\cs_generate_variant:Nn \mal_re:n { x } + +\mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } +\mal_re:x { (def!~load-file~(fn*~(f) + ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) +} + +\mal_def_builtin:nnn { eval } { eval_builtin } + { \mal_eval:nN #1 \l_mal_repl_env_prop } + +\tl_clear:N \l_tmpa_tl +\ior_open:Nn \g_tmpa_ior {argv} +\ior_str_map_inline:Nn \g_tmpa_ior { + \tl_put_right:Nn \l_tmpa_tl { { s #1 } } +} +\ior_close:N \g_tmpa_ior +\prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } + { l n \tl_tail:V \l_tmpa_tl } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\tl_if_empty:NTF \l_tmpa_tl { + \repl_loop: +} { + \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } + \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s +} + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step7_quote.tex b/impls/latex3/step7_quote.tex new file mode 100644 index 0000000000..1851d83b76 --- /dev/null +++ b/impls/latex3/step7_quote.tex @@ -0,0 +1,374 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\usepackage{env} +\usepackage{core} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% Step 3 + +\tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } +\tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } +\tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } + +\cs_new:Nn \mal_eval_let_loop:nNn + { + % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} + \tl_if_empty:nTF { #1 } + { \mal_eval:nN { #3 } #2 } + { + \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl + \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } + } + } + } +\cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } + +\cs_new:Nn \mal_eval_let:nnnN + { + % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} + \mal_env_new:N #4 + \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } + } + +% Step 4 + +\tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } +\tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } +\tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } + +\cs_new:Nn \mal_eval_if:nnnN + { + % \iow_term:n {if~test=#2~then=#3~env=#4} + \mal_eval:nN {#2} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \tl_set:Nn \l_tmpa_tl { n } } + { \mal_eval:nN {#3} #4 } + } + } + +\cs_new:Nn \mal_eval_if:nnnnN + { + % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} + \mal_eval:nN {#2} #5 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \mal_eval:nN { #4 } #5 } + { \mal_eval:nN { #3 } #5 } + } + } + +\cs_new:Nn \mal_fn:nnnN + { + % \iow_term:n {fn*~params=#2~implem=#3~env=#4} + \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } + % \iow_term:V \l_tmpa_tl + } + +% Step 7 + +\tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } +\tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } +\tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } +\tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } + +\cs_new:Nn \mal_quasiquote_item:n + { + \bool_lazy_and:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } l } + { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } + { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } + { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } + } +\cs_generate_variant:Nn \mal_quasiquote_item:n { e } + +\cs_new:Nn \mal_qq_loop:n + { + l n + \tl_if_empty:nF {#1} + { + \mal_quasiquote_item:e { \tl_head:n { #1 } } + { \mal_qq_loop:o { \use_none:n #1 } } + } + } +\cs_generate_variant:Nn \mal_qq_loop:n { o } + +\cs_new:Nn \mal_quasiquote:n + { + \tl_if_head_eq_charcode:nNTF { #1 } l + { + \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol + { \exp_not:o { \use_iv:nnnn #1 } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \tl_if_head_eq_charcode:nNTF { #1 } v + { + l n { y \tl_to_str:n { vec } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } m } + { \tl_if_head_eq_charcode_p:nN { #1 } y } + { l n { \c_quote_symbol } { \exp_not:n { #1 } } } + { \exp_not:n { #1 } } + } + } + } + +\cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \tl_if_head_eq_charcode:nNTF { #1 } u + { + \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } + \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } + \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop + } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } + { + \mal_eval:oN { \use_iii:nnn #1 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } + \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } + { \mal_eval_let:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } + { + \tl_if_empty:oTF { \use_none:nnn #1 } + { \mal_eval_if:nnnN #1 #2 } + { \mal_eval_if:nnnnN #1 #2 } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } + { + \tl_map_inline:on { \use_none:n #1 } + { + \mal_eval:nN { ##1 } #2 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } + { \mal_fn:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } + { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } + { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \mal_env_get:NVT #2 \c_debug_eval_symbol + { + \bool_lazy_or:nnF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } + } + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \mal_env_get:NnF #2 { #1 } + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +\cs_new:Nn \mal_re:n + { + % \iow_term:n {re:~#1} + \str_set:Nn \l_tmpa_str {#1} + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { + \iow_term:n {error~during~startup~#1} + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + Trigger a missing begin document error + } + } +\cs_generate_variant:Nn \mal_re:n { x } + +\mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } +\mal_re:x { (def!~load-file~(fn*~(f) + ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) +} + +\mal_def_builtin:nnn { eval } { eval_builtin } + { \mal_eval:nN #1 \l_mal_repl_env_prop } + +\tl_clear:N \l_tmpa_tl +\ior_open:Nn \g_tmpa_ior {argv} +\ior_str_map_inline:Nn \g_tmpa_ior { + \tl_put_right:Nn \l_tmpa_tl { { s #1 } } +} +\ior_close:N \g_tmpa_ior +\prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } + { l n \tl_tail:V \l_tmpa_tl } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\tl_if_empty:NTF \l_tmpa_tl { + \repl_loop: +} { + \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } + \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s +} + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step8_macros.tex b/impls/latex3/step8_macros.tex new file mode 100644 index 0000000000..dd7b139475 --- /dev/null +++ b/impls/latex3/step8_macros.tex @@ -0,0 +1,407 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\usepackage{env} +\usepackage{core} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% Step 3 + +\tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } +\tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } +\tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } + +\cs_new:Nn \mal_eval_let_loop:nNn + { + % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} + \tl_if_empty:nTF { #1 } + { \mal_eval:nN { #3 } #2 } + { + \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl + \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } + } + } + } +\cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } + +\cs_new:Nn \mal_eval_let:nnnN + { + % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} + \mal_env_new:N #4 + \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } + } + +% Step 4 + +\tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } +\tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } +\tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } + +\cs_new:Nn \mal_eval_if:nnnN + { + % \iow_term:n {if~test=#2~then=#3~env=#4} + \mal_eval:nN {#2} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \tl_set:Nn \l_tmpa_tl { n } } + { \mal_eval:nN {#3} #4 } + } + } + +\cs_new:Nn \mal_eval_if:nnnnN + { + % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} + \mal_eval:nN {#2} #5 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \mal_eval:nN { #4 } #5 } + { \mal_eval:nN { #3 } #5 } + } + } + +\cs_new:Nn \mal_fn:nnnN + { + % \iow_term:n {fn*~params=#2~implem=#3~env=#4} + \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } + % \iow_term:V \l_tmpa_tl + } + +% Step 7 + +\tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } +\tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } +\tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } +\tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } + +\cs_new:Nn \mal_quasiquote_item:n + { + \bool_lazy_and:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } l } + { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } + { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } + { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } + } +\cs_generate_variant:Nn \mal_quasiquote_item:n { e } + +\cs_new:Nn \mal_qq_loop:n + { + l n + \tl_if_empty:nF {#1} + { + \mal_quasiquote_item:e { \tl_head:n { #1 } } + { \mal_qq_loop:o { \use_none:n #1 } } + } + } +\cs_generate_variant:Nn \mal_qq_loop:n { o } + +\cs_new:Nn \mal_quasiquote:n + { + \tl_if_head_eq_charcode:nNTF { #1 } l + { + \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol + { \exp_not:o { \use_iv:nnnn #1 } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \tl_if_head_eq_charcode:nNTF { #1 } v + { + l n { y \tl_to_str:n { vec } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } m } + { \tl_if_head_eq_charcode_p:nN { #1 } y } + { l n { \c_quote_symbol } { \exp_not:n { #1 } } } + { \exp_not:n { #1 } } + } + } + } + +\cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } + +% Step 8 + +\tl_const:Nx \c_defmacro_symbol { y \tl_to_str:n { defmacro! } } + +\cs_new:Nn \mal_eval_defmacro:nnnN + { + % \iow_term:n {defmacro~#2~#3~#4} + \mal_eval:nN {#3} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:Nx \l_tmpa_tl { c n \tl_range:Vnn \l_tmpa_tl { 3 } { -1 } } + \prop_put:NnV #4 {#2} \l_tmpa_tl + } + % \iow_term:V \l_tmpa_tl + } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } u } + { \tl_if_head_eq_charcode_p:nN { #1 } c } + { + \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } + \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } + \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop + } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } + { + \mal_eval:oN { \use_iii:nnn #1 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } + \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } + { \mal_eval_let:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } + { + \tl_if_empty:oTF { \use_none:nnn #1 } + { \mal_eval_if:nnnN #1 #2 } + { \mal_eval_if:nnnnN #1 #2 } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } + { + \tl_map_inline:on { \use_none:n #1 } + { + \mal_eval:nN { ##1 } #2 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } + { \mal_fn:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } + { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } + { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_defmacro_symbol } + { \mal_eval_defmacro:nnnN #1 #2 } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl c + { + \mal_fn_apply:Vo \l_tmpa_tl { \use_none:n #1 } + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl #2 } + } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \mal_env_get:NVT #2 \c_debug_eval_symbol + { + \bool_lazy_or:nnF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } + } + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \mal_env_get:NnF #2 { #1 } + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +\cs_new:Nn \mal_re:n + { + % \iow_term:n {re:~#1} + \str_set:Nn \l_tmpa_str {#1} + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { + \iow_term:n {error~during~startup~#1} + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + Trigger a missing begin document error + } + } +\cs_generate_variant:Nn \mal_re:n { x } + +\mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } +\mal_re:x { (def!~load-file~(fn*~(f) + ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) +} +\mal_re:n { (defmacro!~cond~(fn*~(&~xs) + ~(if~(>~(count~xs)~0)~(list~'if~(first~xs)~(if~(>~(count~xs)~1) + ~(nth~xs~1)~(throw~"odd~number~of~forms~to~cond")) + ~(cons~'cond~(rest~(rest~xs))))))) } + +\mal_def_builtin:nnn { eval } { eval_builtin } + { \mal_eval:nN #1 \l_mal_repl_env_prop } + +\tl_clear:N \l_tmpa_tl +\ior_open:Nn \g_tmpa_ior {argv} +\ior_str_map_inline:Nn \g_tmpa_ior { + \tl_put_right:Nn \l_tmpa_tl { { s #1 } } +} +\ior_close:N \g_tmpa_ior +\prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } + { l n \tl_tail:V \l_tmpa_tl } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\tl_if_empty:NTF \l_tmpa_tl { + \repl_loop: +} { + \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } + \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s +} + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/step9_try.tex b/impls/latex3/step9_try.tex new file mode 100644 index 0000000000..23ca1ee713 --- /dev/null +++ b/impls/latex3/step9_try.tex @@ -0,0 +1,435 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\usepackage{env} +\usepackage{core} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% Step 3 + +\tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } +\tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } +\tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } + +\cs_new:Nn \mal_eval_let_loop:nNn + { + % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} + \tl_if_empty:nTF { #1 } + { \mal_eval:nN { #3 } #2 } + { + \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl + \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } + } + } + } +\cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } + +\cs_new:Nn \mal_eval_let:nnnN + { + % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} + \mal_env_new:N #4 + \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } + } + +% Step 4 + +\tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } +\tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } +\tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } + +\cs_new:Nn \mal_eval_if:nnnN + { + % \iow_term:n {if~test=#2~then=#3~env=#4} + \mal_eval:nN {#2} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \tl_set:Nn \l_tmpa_tl { n } } + { \mal_eval:nN {#3} #4 } + } + } + +\cs_new:Nn \mal_eval_if:nnnnN + { + % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} + \mal_eval:nN {#2} #5 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \mal_eval:nN { #4 } #5 } + { \mal_eval:nN { #3 } #5 } + } + } + +\cs_new:Nn \mal_fn:nnnN + { + % \iow_term:n {fn*~params=#2~implem=#3~env=#4} + \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } + % \iow_term:V \l_tmpa_tl + } + +% Step 7 + +\tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } +\tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } +\tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } +\tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } + +\cs_new:Nn \mal_quasiquote_item:n + { + \bool_lazy_and:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } l } + { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } + { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } + { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } + } +\cs_generate_variant:Nn \mal_quasiquote_item:n { e } + +\cs_new:Nn \mal_qq_loop:n + { + l n + \tl_if_empty:nF {#1} + { + \mal_quasiquote_item:e { \tl_head:n { #1 } } + { \mal_qq_loop:o { \use_none:n #1 } } + } + } +\cs_generate_variant:Nn \mal_qq_loop:n { o } + +\cs_new:Nn \mal_quasiquote:n + { + \tl_if_head_eq_charcode:nNTF { #1 } l + { + \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol + { \exp_not:o { \use_iv:nnnn #1 } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \tl_if_head_eq_charcode:nNTF { #1 } v + { + l n { y \tl_to_str:n { vec } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } m } + { \tl_if_head_eq_charcode_p:nN { #1 } y } + { l n { \c_quote_symbol } { \exp_not:n { #1 } } } + { \exp_not:n { #1 } } + } + } + } + +\cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } + +% Step 8 + +\tl_const:Nx \c_defmacro_symbol { y \tl_to_str:n { defmacro! } } + +\cs_new:Nn \mal_eval_defmacro:nnnN + { + % \iow_term:n {defmacro~#2~#3~#4} + \mal_eval:nN {#3} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:Nx \l_tmpa_tl { c n \tl_range:Vnn \l_tmpa_tl { 3 } { -1 } } + \prop_put:NnV #4 {#2} \l_tmpa_tl + } + % \iow_term:V \l_tmpa_tl + } + +% Step 9 + +\tl_const:Nx \c_try_symbol { y \tl_to_str:n { try* } } + +\cs_new:Nn \mal_eval_catch:nnnnnnN + { + % \iow_term:n {catch~exception=#1~l=#2~meta=#3~catch*=#4~symbol=#5~handler=#6~env=#7} + \mal_env_new:N #7 + \prop_put:cno \l_mal_tmp_env_prop { #5 } { \use_none:n #1 } + \mal_eval:nc { #6 } \l_mal_tmp_env_prop + } +\cs_generate_variant:Nn \mal_eval_catch:nnnnnnN { VnnnnnN } + +\cs_new:Nn \mal_eval_try:nnnN + { + % \iow_term:n {try~try*=#1~tested=#2~catch_list=#3~env=#4} + \mal_eval:nN { #2 } #4 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { \mal_eval_catch:VnnnnnN \l_tmpa_tl #3 #4 } + } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } u } + { \tl_if_head_eq_charcode_p:nN { #1 } c } + { + \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } + \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } + \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop + } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } + { + \mal_eval:oN { \use_iii:nnn #1 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } + \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } + { \mal_eval_let:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } + { + \tl_if_empty:oTF { \use_none:nnn #1 } + { \mal_eval_if:nnnN #1 #2 } + { \mal_eval_if:nnnnN #1 #2 } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } + { + \tl_map_inline:on { \use_none:n #1 } + { + \mal_eval:nN { ##1 } #2 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } + { \mal_fn:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } + { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } + { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_defmacro_symbol } + { \mal_eval_defmacro:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_try_symbol } + { + \tl_if_empty:oTF { \use_none:nn #1 } + { \mal_eval:oN { \use_ii:nn #1 } #2 } + { \mal_eval_try:nnnN #1 #2 } + } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl c + { + \mal_fn_apply:Vo \l_tmpa_tl { \use_none:n #1 } + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl #2 } + } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \mal_env_get:NVT #2 \c_debug_eval_symbol + { + \bool_lazy_or:nnF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } + } + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \mal_env_get:NnF #2 { #1 } + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +\cs_new:Nn \mal_re:n + { + % \iow_term:n {re:~#1} + \str_set:Nn \l_tmpa_str {#1} + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { + \iow_term:n {error~during~startup~#1} + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + Trigger a missing begin document error + } + } +\cs_generate_variant:Nn \mal_re:n { x } + +\mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } +\mal_re:x { (def!~load-file~(fn*~(f) + ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) +} +\mal_re:n { (defmacro!~cond~(fn*~(&~xs) + ~(if~(>~(count~xs)~0)~(list~'if~(first~xs)~(if~(>~(count~xs)~1) + ~(nth~xs~1)~(throw~"odd~number~of~forms~to~cond")) + ~(cons~'cond~(rest~(rest~xs))))))) } + +\mal_def_builtin:nnn { eval } { eval_builtin } + { \mal_eval:nN #1 \l_mal_repl_env_prop } + +\tl_clear:N \l_tmpa_tl +\ior_open:Nn \g_tmpa_ior {argv} +\ior_str_map_inline:Nn \g_tmpa_ior { + \tl_put_right:Nn \l_tmpa_tl { { s #1 } } +} +\ior_close:N \g_tmpa_ior +\prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } + { l n \tl_tail:V \l_tmpa_tl } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\tl_if_empty:NTF \l_tmpa_tl { + \repl_loop: +} { + \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } + \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s +} + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/stepA_mal.tex b/impls/latex3/stepA_mal.tex new file mode 100644 index 0000000000..28d5bb8c53 --- /dev/null +++ b/impls/latex3/stepA_mal.tex @@ -0,0 +1,439 @@ +\documentclass{article} +\usepackage +% Uncomment this and \debug_on below when debugging. +% [enable-debug] + {expl3} +\usepackage{types} +\usepackage{printer} +\usepackage{reader} +\usepackage{env} +\usepackage{core} +\ExplSyntaxOn + +% Slow but quite useful. +% \debug_on:n { all } + +% Step 2 + +\cs_new:Nn \mal_eval_map:nN + { + % \iow_term:n {eval_map~ast=#1~env=#2} + \mal_map_new: + \prop_map_inline:cn { #1 } + { + \str_if_eq:nnF { ##1 } { __meta__ } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##2 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \prop_map_break: } + { + \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl + \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl + } + } + } + } + +\cs_new:Nn \mal_eval_iterate_tl:nN + { + % The evaluated elements are appended to \l_tmpa_tl. + % \iow_term:n {eval_tl:~forms=#1~env=#2} + \tl_map_inline:nn { #1 } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \mal_eval:nN { ##1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e + { \tl_map_break: } + { + \tl_set:Nx \l_tmpa_tl + { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } + } + } + } +\cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } + +% Step 3 + +\tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } +\tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } +\tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } + +\cs_new:Nn \mal_eval_let_loop:nNn + { + % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} + \tl_if_empty:nTF { #1 } + { \mal_eval:nN { #3 } #2 } + { + \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl + \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } + } + } + } +\cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } + +\cs_new:Nn \mal_eval_let:nnnN + { + % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} + \mal_env_new:N #4 + \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } + } + +% Step 4 + +\tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } +\tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } +\tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } + +\cs_new:Nn \mal_eval_if:nnnN + { + % \iow_term:n {if~test=#2~then=#3~env=#4} + \mal_eval:nN {#2} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \tl_set:Nn \l_tmpa_tl { n } } + { \mal_eval:nN {#3} #4 } + } + } + +\cs_new:Nn \mal_eval_if:nnnnN + { + % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} + \mal_eval:nN {#2} #5 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \mal_eval:nN { #4 } #5 } + { \mal_eval:nN { #3 } #5 } + } + } + +\cs_new:Nn \mal_fn:nnnN + { + % \iow_term:n {fn*~params=#2~implem=#3~env=#4} + \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } + % \iow_term:V \l_tmpa_tl + } + +% Step 7 + +\tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } +\tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } +\tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } +\tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } + +\cs_new:Nn \mal_quasiquote_item:n + { + \bool_lazy_and:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } l } + { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } + { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } + { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } + } +\cs_generate_variant:Nn \mal_quasiquote_item:n { e } + +\cs_new:Nn \mal_qq_loop:n + { + l n + \tl_if_empty:nF {#1} + { + \mal_quasiquote_item:e { \tl_head:n { #1 } } + { \mal_qq_loop:o { \use_none:n #1 } } + } + } +\cs_generate_variant:Nn \mal_qq_loop:n { o } + +\cs_new:Nn \mal_quasiquote:n + { + \tl_if_head_eq_charcode:nNTF { #1 } l + { + \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol + { \exp_not:o { \use_iv:nnnn #1 } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \tl_if_head_eq_charcode:nNTF { #1 } v + { + l n { y \tl_to_str:n { vec } } + { \mal_qq_loop:o { \use_none:nn #1 } } + } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } m } + { \tl_if_head_eq_charcode_p:nN { #1 } y } + { l n { \c_quote_symbol } { \exp_not:n { #1 } } } + { \exp_not:n { #1 } } + } + } + } + +\cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } + +% Step 8 + +\tl_const:Nx \c_defmacro_symbol { y \tl_to_str:n { defmacro! } } + +\cs_new:Nn \mal_eval_defmacro:nnnN + { + % \iow_term:n {defmacro~#2~#3~#4} + \mal_eval:nN {#3} #4 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:Nx \l_tmpa_tl { c n \tl_range:Vnn \l_tmpa_tl { 3 } { -1 } } + \prop_put:NnV #4 {#2} \l_tmpa_tl + } + % \iow_term:V \l_tmpa_tl + } + +% Step 9 + +\tl_const:Nx \c_try_symbol { y \tl_to_str:n { try* } } + +\cs_new:Nn \mal_eval_catch:nnnnnnN + { + % \iow_term:n {catch~exception=#1~l=#2~meta=#3~catch*=#4~symbol=#5~handler=#6~env=#7} + \mal_env_new:N #7 + \prop_put:cno \l_mal_tmp_env_prop { #5 } { \use_none:n #1 } + \mal_eval:nc { #6 } \l_mal_tmp_env_prop + } +\cs_generate_variant:Nn \mal_eval_catch:nnnnnnN { VnnnnnN } + +\cs_new:Nn \mal_eval_try:nnnN + { + % \iow_term:n {try~try*=#1~tested=#2~catch_list=#3~env=#4} + \mal_eval:nN { #2 } #4 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { \mal_eval_catch:VnnnnnN \l_tmpa_tl #3 #4 } + } + +% EVAL + +\cs_new:Nn \mal_fn_apply:nn + { + % \iow_term:n {fn_apply:~func=#1~args=#2} + \tl_if_head_eq_charcode:nNTF { #1 } b + { \use_none:nn #1 { #2 } } + { + \bool_lazy_or:nnTF + { \tl_if_head_eq_charcode_p:nN { #1 } u } + { \tl_if_head_eq_charcode_p:nN { #1 } c } + { + \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } + \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } + \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop + } + { + \tl_set:Nx \l_tmpa_tl + { e s \tl_to_str:n { can~only~apply~functions } } + } + } + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } + +\cs_new:Nn \mal_eval_list:nN + { + % \iow_term:n {eval_mal_list~tl=#1~env=#2} + \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } + \bool_case_true:nF + { + { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } + { \tl_set:Nn \l_tmpa_tl { l n } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } + { + \mal_eval:oN { \use_iii:nnn #1 } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } + \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } + { \mal_eval_let:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } + { + \tl_if_empty:oTF { \use_none:nnn #1 } + { \mal_eval_if:nnnN #1 #2 } + { \mal_eval_if:nnnnN #1 #2 } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } + { + \tl_map_inline:on { \use_none:n #1 } + { + \mal_eval:nN { ##1 } #2 + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } + } + } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } + { \mal_fn:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } + { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } + { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_defmacro_symbol } + { \mal_eval_defmacro:nnnN #1 #2 } + + { \tl_if_eq_p:NN \l_tmpa_tl \c_try_symbol } + { + \tl_if_empty:oTF { \use_none:nn #1 } + { \mal_eval:oN { \use_ii:nn #1 } #2 } + { \mal_eval_try:nnnN #1 #2 } + } + } + { + % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} + \mal_eval:xN { \tl_head:n { #1 } } #2 + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { + \tl_if_head_eq_charcode:VNTF \l_tmpa_tl c + { + \mal_fn_apply:Vo \l_tmpa_tl { \use_none:n #1 } + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl #2 } + } + { + \seq_push:NV \l_mal_stack_seq \l_tmpa_tl + \tl_clear:N \l_tmpa_tl + \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 + \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } + } + } + } + } +\cs_generate_variant:Nn \mal_eval_list:nN { oN } + +\cs_new:Nn \mal_eval:nN + { + % \iow_term:n {EVAL:~ast=#1~env=#2} + \mal_env_get:NVT #2 \c_debug_eval_symbol + { + \bool_lazy_or:nnF + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } + { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } + { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } + } + \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } + { + l + { \mal_eval_list:oN { \use_none:nn #1 } #2 } + y + { + \mal_env_get:NnF #2 { #1 } + { + \tl_set:Nx \l_tmpa_tl + { e s \use_none:n #1 \tl_to_str:n { ~not~found } } + } + } + v + { + \tl_set:Nn \l_tmpa_tl { v n } + \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 + } + m + { \mal_eval_map:nN { #1 } #2 } + } + { \tl_set:Nn \l_tmpa_tl {#1} } + % \iow_term:n {EVAL:~ast=#1~returns} + % \iow_term:V \l_tmpa_tl + } +\cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } + +% REPL + +\cs_new:Nn \repl_loop: + { + % \ior_str_get_term is able to display a prompt on the same line, + % but this would make ./run far more complex for little benefit. + \iow_term:n {user>~} + \ior_str_get_term:nN {} \l_tmpa_str + \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run + { + % Ignore empty lines, the MAL self-hosting relies on this + % *not* triggering an error. + \str_if_eq:VnF \l_tmpa_str {} + { + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + } + \repl_loop: + } + } + +\cs_new:Nn \mal_re:n + { + % \iow_term:n {re:~#1} + \str_set:Nn \l_tmpa_str {#1} + \mal_read_str: + \tl_if_head_eq_charcode:VNF \l_tmpa_tl e + { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } + \tl_if_head_eq_charcode:VNT \l_tmpa_tl e + { + \iow_term:n {error~during~startup~#1} + \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } + Trigger a missing begin document error + } + } +\cs_generate_variant:Nn \mal_re:n { x } + +\mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } +\mal_re:x { (def!~load-file~(fn*~(f) + ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) +} +\mal_re:n { (defmacro!~cond~(fn*~(&~xs) + ~(if~(>~(count~xs)~0)~(list~'if~(first~xs)~(if~(>~(count~xs)~1) + ~(nth~xs~1)~(throw~"odd~number~of~forms~to~cond")) + ~(cons~'cond~(rest~(rest~xs))))))) } + +\mal_def_builtin:nnn { eval } { eval_builtin } + { \mal_eval:nN #1 \l_mal_repl_env_prop } + +\prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *host-language* } } + { s \tl_to_str:n { LaTeX3 } } + +\tl_clear:N \l_tmpa_tl +\ior_open:Nn \g_tmpa_ior {argv} +\ior_str_map_inline:Nn \g_tmpa_ior { + \tl_put_right:Nn \l_tmpa_tl { { s #1 } } +} +\ior_close:N \g_tmpa_ior +\prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } + { l n \tl_tail:V \l_tmpa_tl } + +% ./run removes the normal LaTeX output. +\iow_term:n {MAL_LATEX3_START_OF_OUTPUT} + +\tl_if_empty:NTF \l_tmpa_tl { + \mal_re:n { (println (str "Mal [" *host-language* "]")) } + \repl_loop: +} { + \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } + \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s +} + +\iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run + +\ExplSyntaxOff +\begin{document} +\end{document} diff --git a/impls/latex3/types.sty b/impls/latex3/types.sty new file mode 100644 index 0000000000..c5e2fb6545 --- /dev/null +++ b/impls/latex3/types.sty @@ -0,0 +1,92 @@ +\ProvidesExplPackage {types} {2023/01/01} {0.0.1} {MAL~types} + +% This file is included almost everywhere, it seems a good place to +% define the variants we need. + +\cs_generate_variant:Nn \int_compare:nNnTF { oNoTF } +\cs_generate_variant:Nn \int_const:Nn { NV } +\cs_generate_variant:Nn \int_if_zero:nTF { VTF } +\cs_generate_variant:Nn \int_set:Nn { Nx } +\cs_generate_variant:Nn \int_to_alph:n { V } +\cs_generate_variant:Nn \int_to_arabic:n { o, V } +\cs_generate_variant:Nn \ior_open:Nn {Nx} +\cs_generate_variant:Nn \iow_term:n { x, V } +\cs_generate_variant:Nn \prop_put:Nnn { cxn, Nxn, NxV } +\cs_generate_variant:Nn \regex_extract_once:NnNTF {NVNTF} +\cs_generate_variant:Nn \str_head:n { V } +\cs_generate_variant:Nn \str_if_eq:nnTF { eVTF, xnTF } +\cs_generate_variant:Nn \str_if_eq_p:nn { eV } +\cs_generate_variant:Nn \str_item:nn { Vn } +\cs_generate_variant:Nn \str_map_function:nN { oN } +\cs_generate_variant:Nn \str_map_inline:nn { on } +\cs_generate_variant:Nn \str_set:Nn { Nx } +\cs_generate_variant:Nn \str_tail:n { V} +\cs_generate_variant:Nn \sys_get_shell:nnN { xnN } +\cs_generate_variant:Nn \tl_const:Nn { cx } +\cs_generate_variant:Nn \tl_if_eq:nnTF { xxTF } +\cs_generate_variant:Nn \tl_if_head_eq_charcode:nNF { VNF } +\cs_generate_variant:Nn \tl_if_head_eq_charcode:nNT { VNT } +\cs_generate_variant:Nn \tl_if_head_eq_charcode:nNTF { VNTF } +\cs_generate_variant:Nn \tl_if_head_eq_charcode_p:nN { VN } +\cs_generate_variant:Nn \tl_item:nn { nV } +\cs_generate_variant:Nn \tl_map_inline:nn { on } +\cs_generate_variant:Nn \tl_map_tokens:nn { on } +\cs_generate_variant:Nn \tl_range:nnn { Vnn } +\cs_generate_variant:Nn \tl_tail:n { V } + +% A global stack is convenient for storage of local variables during +% recursive computations. +\seq_new:N \l_mal_stack_seq +% TeX usually uses local assignments for this, but the number of +% groups is limited to 255, which is not enough for MAL recursions. + +% A mal form is represented by a token list starting with a letter +% defining the type (this sometimes allows f expansion). + +% n nil +% f false +% t true +% y .. symbol the rest is a str +% s .. string the rest is a str +% k .. keyword the rest is a str +% i .. number the rest is a tl/str of digits +% l meta elt elt.. list +% v meta elt elt.. vector +% map_... map \map_.. is a prop (may contain __meta__) +% atom_.. atom \atom_.. tl var contains a mal form +% e .. exception the rest is a mal form +% u meta impl env arg arg.. function the argument is a tl of mal forms +% c meta impl env arg arg.. macro (see function) +% b n \mal_..:n built-in function, expecting a tl of mal forms + +% Global counter used to create unique control sequences for atoms (in +% core.sty) and environments (in env.sty). +\int_new:N \l_mal_object_counter_int + +\cs_new:Nn \mal_map_new: + { + \int_incr:N \l_mal_object_counter_int + \tl_set:Nx \l_tmpa_tl { map_ \int_use:N \l_mal_object_counter_int } + \prop_new:c \l_tmpa_tl + } + +% Put keys and values read from a tl of MAL forms into \l_tmpa_tl, +% which must be a prop variable. +% Defined here because it is used by core.sty and reader.sty. +\cs_new:Nn \mal_assoc_internal:n + { + % \iow_term:n {assoc_internal~#1} + \tl_if_empty:nF { #1 } + { + \prop_put:cxx \l_tmpa_tl { \tl_head:n { #1 } } { \tl_item:nn { #1 } 2 } + \mal_assoc_internal:o { \use_none:nn #1 } + } + } +\cs_generate_variant:Nn \mal_assoc_internal:n { o } + +\cs_new:Nn \mal_hash_map:n + { + \mal_map_new: + \mal_assoc_internal:n { #1 } + } +\cs_generate_variant:Nn \mal_hash_map:n { V } diff --git a/impls/lib/README.md b/impls/lib/README.md new file mode 100644 index 0000000000..e04c6526cf --- /dev/null +++ b/impls/lib/README.md @@ -0,0 +1,32 @@ +This directory contains general-purpose reusable code that does not +fit in the process. + +The split in small files is motivated by implementations too limited +to load a single big file, but MAL has no proper module management. + +However, here are some guidelines. + +- Begin with an one-line ;; short description + +- Describe the restrictions on each parameter in comments. + +- Define private symbols in hidden environments when possible. If this + is not possible, for example for macros, give them a name starting + with an underscore. + +If a module provides tests, you may run against an implementation IMPL +with these commands. +``` +make IMPL^stepA +cd tests +python ../runtest.py lib/MODULE.mal ../IMPL/run +``` + +Users and implementors should use the following syntax in order to +ensure that the same file is only loaded once. + +``` +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/foo.mal") +(load-file-once "../lib/bar.mal") +``` diff --git a/impls/lib/alias-hacks.mal b/impls/lib/alias-hacks.mal new file mode 100644 index 0000000000..5d2ac87336 --- /dev/null +++ b/impls/lib/alias-hacks.mal @@ -0,0 +1,22 @@ +;; aliases for common clojure names to mal builtins +;; NOTE: this is a hack + +;; Origin: https://github.com/chr15m/frock + +; TODO: re-implement as actually useful macros: +; destructuring, arg checking, etc. + +(def! _alias_add_implicit + (fn* [special added] + (fn* [x & xs] + (list special x (cons added xs))))) + +(defmacro! let (_alias_add_implicit 'let* 'do)) +(defmacro! when (_alias_add_implicit 'if 'do)) +(defmacro! def (_alias_add_implicit 'def! 'do)) +(defmacro! fn (_alias_add_implicit 'fn* 'do)) +(defmacro! defn (_alias_add_implicit 'def! 'fn)) + +(def! partial (fn* [pfn & args] + (fn* [& args-inner] + (apply pfn (concat args args-inner))))) diff --git a/impls/lib/benchmark.mal b/impls/lib/benchmark.mal new file mode 100644 index 0000000000..8ea2d2ae6e --- /dev/null +++ b/impls/lib/benchmark.mal @@ -0,0 +1,15 @@ +;; An alternative approach, to complement perf.mal +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/trivial.mal") ; gensym inc + +(def! benchmark* (fn* [f n results] + (if (< 0 n) + (let* [start-ms (time-ms) + _ (f) + end-ms (time-ms)] + (benchmark* f (- n 1) (conj results (- end-ms start-ms)))) + results))) + +(defmacro! benchmark (fn* [expr n] + `(benchmark* (fn* [] ~expr) ~n []))) + diff --git a/impls/lib/equality.mal b/impls/lib/equality.mal new file mode 100644 index 0000000000..90ca5287aa --- /dev/null +++ b/impls/lib/equality.mal @@ -0,0 +1,77 @@ +;; equality.mal + +;; This file checks whether the `=` function correctly implements equality of +;; hash-maps and sequences (lists and vectors). If not, it redefines the `=` +;; function with a pure mal (recursive) implementation that only relies on the +;; native original `=` function for comparing scalars (integers, booleans, +;; symbols, strings, keywords, atoms, nil). + +;; Save the original (native) `=` as scalar-equal? +(def! scalar-equal? =) + +;; A faster `and` macro which doesn't use `=` internally. +(defmacro! bool-and ; boolean + (fn* [& xs] ; interpreted as logical values + (if (empty? xs) + true + `(if ~(first xs) (bool-and ~@(rest xs)) false)))) +(defmacro! bool-or ; boolean + (fn* [& xs] ; interpreted as logical values + (if (empty? xs) + false + `(if ~(first xs) true (bool-or ~@(rest xs)))))) + +(def! starts-with? + (fn* [a b] + (bool-or (empty? a) + (bool-and (mal-equal? (first a) (first b)) + (starts-with? (rest a) (rest b)))))) + +(def! hash-map-vals-equal? + (fn* [a b map-keys] + (bool-or (empty? map-keys) + (let* [key (first map-keys)] + (bool-and (contains? b key) + (mal-equal? (get a key) (get b key)) + (hash-map-vals-equal? a b (rest map-keys))))))) + +;; This implements = in pure mal (using only scalar-equal? as native impl) +(def! mal-equal? + (fn* [a b] + (cond + + (sequential? a) + (bool-and (sequential? b) + (scalar-equal? (count a) (count b)) + (starts-with? a b)) + + (map? a) + (let* [keys-a (keys a)] + (bool-and (map? b) + (scalar-equal? (count keys-a) (count (keys b))) + (hash-map-vals-equal? a b keys-a))) + + true + (scalar-equal? a b)))) + +(def! hash-map-equality-correct? + (fn* [] + (try* + (bool-and (= {:a 1} {:a 1}) + (not (= {:a 1} {:a 1 :b 2}))) + (catch* _ false)))) + +(def! sequence-equality-correct? + (fn* [] + (try* + (bool-and (= [:a :b] (list :a :b)) + (not (= [:a :b] [:a :b :c]))) + (catch* _ false)))) + +;; If the native `=` implementation doesn't support sequences or hash-maps +;; correctly, replace it with the pure mal implementation +(if (not (bool-and (hash-map-equality-correct?) + (sequence-equality-correct?))) + (do + (def! = mal-equal?) + (println "equality.mal: Replaced = with pure mal implementation"))) diff --git a/impls/lib/load-file-once.mal b/impls/lib/load-file-once.mal new file mode 100644 index 0000000000..2d7ac0c115 --- /dev/null +++ b/impls/lib/load-file-once.mal @@ -0,0 +1,16 @@ +;; Like load-file, but will never load the same path twice. + +;; This file is normally loaded with `load-file`, so it needs a +;; different mechanism to neutralize multiple inclusions of +;; itself. Moreover, the file list should never be reset. + +(def! load-file-once + (try* + load-file-once + (catch* _ + (let* [seen (atom {"../lib/load-file-once.mal" nil})] + (fn* [filename] + (if (not (contains? @seen filename)) + (do + (swap! seen assoc filename nil) + (load-file filename)))))))) diff --git a/impls/lib/memoize.mal b/impls/lib/memoize.mal new file mode 100644 index 0000000000..ca3a47957f --- /dev/null +++ b/impls/lib/memoize.mal @@ -0,0 +1,25 @@ +;; Memoize any function. + +;; Implement `memoize` using an atom (`mem`) which holds the memoized results +;; (hash-map from the arguments to the result). When the function is called, +;; the hash-map is checked to see if the result for the given argument was already +;; calculated and stored. If this is the case, it is returned immediately; +;; otherwise, it is calculated and stored in `mem`. + +;; For recursive functions, take care to store the wrapper under the +;; same name than the original computation with an assignment like +;; `(def! f (memoize f))`, so that intermediate results are memorized. + +;; Adapted from http://clojure.org/atoms + +(def! memoize + (fn* [f] + (let* [mem (atom {})] + (fn* [& args] + (let* [key (str args)] + (if (contains? @mem key) + (get @mem key) + (let* [ret (apply f args)] + (do + (swap! mem assoc key ret) + ret)))))))) diff --git a/impls/lib/perf.mal b/impls/lib/perf.mal new file mode 100644 index 0000000000..32a3189f72 --- /dev/null +++ b/impls/lib/perf.mal @@ -0,0 +1,41 @@ +;; Mesure performances. + +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/trivial.mal") ; gensym inc + +;; Evaluate an expression, but report the time spent +(defmacro! time + (fn* (exp) + (let* [start (gensym) + ret (gensym)] + `(let* (~start (time-ms) + ~ret ~exp) + (do + (println "Elapsed time:" (- (time-ms) ~start) "msecs") + ~ret))))) + +;; Count evaluations of a function during a given time frame. +(def! run-fn-for + + (let* [ + run-fn-for* (fn* [fn max-ms acc-ms last-iters] + (let* [start (time-ms) + _ (fn) + elapsed (- (time-ms) start) + iters (inc last-iters) + new-acc-ms (+ acc-ms elapsed)] + ;; (do (prn "new-acc-ms:" new-acc-ms "iters:" iters)) + (if (>= new-acc-ms max-ms) + last-iters + (run-fn-for* fn max-ms new-acc-ms iters)))) + ] + + (fn* [fn max-secs] + ;; fn : function without parameters + ;; max-secs : number (seconds) + ;; return : number (iterations) + (do + ;; Warm it up first + (run-fn-for* fn 1000 0 0) + ;; Now do the test + (run-fn-for* fn (* 1000 max-secs) 0 0))))) diff --git a/impls/lib/pprint.mal b/impls/lib/pprint.mal new file mode 100644 index 0000000000..73efde77dd --- /dev/null +++ b/impls/lib/pprint.mal @@ -0,0 +1,43 @@ +;; Pretty printer a MAL object. + +(def! pprint + + (let* [ + + spaces- (fn* [indent] + (if (> indent 0) + (str " " (spaces- (- indent 1))) + "")) + + pp-seq- (fn* [obj indent] + (let* [xindent (+ 1 indent)] + (apply str (pp- (first obj) 0) + (map (fn* [x] (str "\n" (spaces- xindent) + (pp- x xindent))) + (rest obj))))) + + pp-map- (fn* [obj indent] + (let* [ks (keys obj) + kindent (+ 1 indent) + kwidth (count (seq (str (first ks)))) + vindent (+ 1 (+ kwidth kindent))] + (apply str (pp- (first ks) 0) + " " + (pp- (get obj (first ks)) 0) + (map (fn* [k] (str "\n" (spaces- kindent) + (pp- k kindent) + " " + (pp- (get obj k) vindent))) + (rest ks))))) + + pp- (fn* [obj indent] + (cond + (list? obj) (str "(" (pp-seq- obj indent) ")") + (vector? obj) (str "[" (pp-seq- obj indent) "]") + (map? obj) (str "{" (pp-map- obj indent) "}") + :else (pr-str obj))) + + ] + + (fn* [obj] + (println (pp- obj 0))))) diff --git a/impls/lib/protocols.mal b/impls/lib/protocols.mal new file mode 100644 index 0000000000..4bd8b80bdc --- /dev/null +++ b/impls/lib/protocols.mal @@ -0,0 +1,95 @@ +;; A sketch of Clojure-like protocols, implemented in Mal + +;; By chouser (Chris Houser) +;; Original: https://gist.github.com/Chouser/6081ea66d144d13e56fc + +;; This function maps a MAL value to a keyword representing its type. +;; Most applications will override the default with an explicit value +;; for the `:type` key in the metadata. +(def! find-type (fn* [obj] + (cond + (symbol? obj) :mal/symbol + (keyword? obj) :mal/keyword + (atom? obj) :mal/atom + (nil? obj) :mal/nil + (true? obj) :mal/boolean + (false? obj) :mal/boolean + (number? obj) :mal/number + (string? obj) :mal/string + (macro? obj) :mal/macro + true + (let* [metadata (meta obj) + type (if (map? metadata) (get metadata :type))] + (cond + (keyword? type) type + (list? obj) :mal/list + (vector? obj) :mal/vector + (map? obj) :mal/map + (fn? obj) :mal/function + true (throw "unknown MAL value in protocols")))))) + +;; A protocol (abstract class, interface..) is represented by a symbol. +;; It describes methods (abstract functions, contracts, signals..). +;; Each method is described by a sequence of two elements. +;; First, a symbol setting the name of the method. +;; Second, a vector setting its formal parameters. +;; The first parameter is required, plays a special role. +;; It is usually named `this` (`self`..). +;; For example, +;; (defprotocol protocol +;; (method1 [this]) +;; (method2 [this argument])) +;; can be thought as: +;; (def! method1 (fn* [this]) ..) +;; (def! method2 (fn* [this argument]) ..) +;; (def! protocol ..) +;; The return value is the new protocol. +(defmacro! defprotocol (fn* [proto-name & methods] + ;; A protocol is an atom mapping a type extending the protocol to + ;; another map from method names as keywords to implementations. + (let* [ + drop2 (fn* [args] + (if (= 2 (count args)) + () + (cons (first args) (drop2 (rest args))))) + rewrite (fn* [method] + (let* [ + name (first method) + args (nth method 1) + argc (count args) + varargs? (if (<= 2 argc) (= '& (nth args (- argc 2)))) + dispatch `(get (get @~proto-name + (find-type ~(first args))) + ~(keyword (str name))) + body (if varargs? + `(apply ~dispatch ~@(drop2 args) ~(nth args (- argc 1))) + (cons dispatch args)) + ] + (list 'def! name (list 'fn* args body)))) + ] + `(do + ~@(map rewrite methods) + (def! ~proto-name (atom {})))))) + +;; A type (concrete class..) extends (is a subclass of, implements..) +;; a protocol when it provides implementations for the required methods. +;; (extend type protocol { +;; :method1 (fn* [this] ..) +;; :method2 (fn* [this arg1 arg2])}) +;; Additionnal protocol/methods pairs are equivalent to successive +;; calls with the same type. +;; The return value is `nil`. +(def! extend (fn* [type proto methods & more] + (do + (swap! proto assoc type methods) + (if (first more) + (apply extend type more))))) + +;; An object satisfies a protocol when its type extends the protocol, +;; that is if the required methods can be applied to the object. +(def! satisfies? (fn* [protocol obj] + (contains? @protocol (find-type obj)))) +;; If `(satisfies protocol obj)` with the protocol below +;; then `(method1 obj)` and `(method2 obj 1 2)` +;; dispatch to the concrete implementation provided by the exact type. +;; Should the type evolve, the calling code needs not change. diff --git a/impls/lib/reducers.mal b/impls/lib/reducers.mal new file mode 100644 index 0000000000..f8e6dc7fe3 --- /dev/null +++ b/impls/lib/reducers.mal @@ -0,0 +1,32 @@ +;; Left and right folds. + +;; Left fold (f (.. (f (f init x1) x2) ..) xn) +(def! reduce + (fn* (f init xs) + ;; f : Accumulator Element -> Accumulator + ;; init : Accumulator + ;; xs : sequence of Elements x1 x2 .. xn + ;; return : Accumulator + (if (empty? xs) + init + (reduce f (f init (first xs)) (rest xs))))) + +;; Right fold (f x1 (f x2 (.. (f xn init)) ..)) +;; The natural implementation for `foldr` is not tail-recursive, and +;; the one based on `reduce` constructs many intermediate functions, so we +;; rely on efficient `nth` and `count`. +(def! foldr + + (let* [ + rec (fn* [f xs acc index] + (if (< index 0) + acc + (rec f xs (f (nth xs index) acc) (- index 1)))) + ] + + (fn* [f init xs] + ;; f : Element Accumulator -> Accumulator + ;; init : Accumulator + ;; xs : sequence of Elements x1 x2 .. xn + ;; return : Accumulator + (rec f xs init (- (count xs) 1))))) diff --git a/impls/lib/test_cascade.mal b/impls/lib/test_cascade.mal new file mode 100644 index 0000000000..d2d81e7747 --- /dev/null +++ b/impls/lib/test_cascade.mal @@ -0,0 +1,67 @@ +;; Iteration on evaluations interpreted as boolean values. + +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/trivial.mal") ; gensym + +;; `(cond test1 result1 test2 result2 .. testn resultn)` +;; is rewritten (in the step files) as +;; `(if test1 result1 (if test2 result2 (.. (if testn resultn nil))))` +;; It is common that `testn` is `"else"`, `:else`, `true` or similar. + +;; `(or x1 x2 .. xn x)` +;; is almost rewritten as +;; `(if x1 x1 (if x2 x2 (.. (if xn xn x))))` +;; except that each argument is evaluated at most once. +;; Without arguments, returns `nil`. +(defmacro! or (fn* [& xs] + (if (< (count xs) 2) + (first xs) + (let* [r (gensym)] + `(let* (~r ~(first xs)) (if ~r ~r (or ~@(rest xs)))))))) + +;; Conjonction of predicate values (pred x1) and .. and (pred xn) +;; Evaluate `pred x` for each `x` in turn. Return `false` if a result +;; is `nil` or `false`, without evaluating the predicate for the +;; remaining elements. If all test pass, return `true`. +(def! every? + (fn* (pred xs) + ;; pred : Element -> interpreted as a logical value + ;; xs : sequence of Elements x1 x2 .. xn + ;; return : boolean + (cond (empty? xs) true + (pred (first xs)) (every? pred (rest xs)) + true false))) + +;; Disjonction of predicate values (pred x1) or .. (pred xn) +;; Evaluate `(pred x)` for each `x` in turn. Return the first result +;; that is neither `nil` nor `false`, without evaluating the predicate +;; for the remaining elements. If all tests fail, return nil. +(def! some + (fn* (pred xs) + ;; pred : Element -> interpreted as a logical value + ;; xs : sequence of Elements x1 x2 .. xn + ;; return : boolean + (if (empty? xs) + nil + (or (pred (first xs)) + (some pred (rest xs)))))) + +;; Search for first evaluation returning `nil` or `false`. +;; Rewrite `x1 x2 .. xn x` as +;; (let* [r1 x1] +;; (if r1 test1 +;; (let* [r2 x2] +;; .. +;; (if rn +;; x +;; rn) ..) +;; r1)) +;; Without arguments, returns `true`. +(defmacro! and + (fn* (& xs) + ;; Arguments and the result are interpreted as boolean values. + (cond (empty? xs) true + (= 1 (count xs)) (first xs) + true (let* (condvar (gensym)) + `(let* (~condvar ~(first xs)) + (if ~condvar (and ~@(rest xs)) ~condvar)))))) diff --git a/impls/lib/threading.mal b/impls/lib/threading.mal new file mode 100644 index 0000000000..36bf468f9a --- /dev/null +++ b/impls/lib/threading.mal @@ -0,0 +1,34 @@ +;; Composition of partially applied functions. + +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/reducers.mal") ; reduce + +;; Rewrite x (a a1 a2) .. (b b1 b2) as +;; (b (.. (a x a1 a2) ..) b1 b2) +;; If anything else than a list is found were `(a a1 a2)` is expected, +;; replace it with a list with one element, so that `-> x a` is +;; equivalent to `-> x (list a)`. +(defmacro! -> + (fn* (x & xs) + (reduce _iter-> x xs))) + +(def! _iter-> + (fn* [acc form] + (if (list? form) + `(~(first form) ~acc ~@(rest form)) + (list form acc)))) + +;; Like `->`, but the arguments describe functions that are partially +;; applied with *left* arguments. The previous result is inserted at +;; the *end* of the new argument list. +;; Rewrite x ((a a1 a2) .. (b b1 b2)) as +;; (b b1 b2 (.. (a a1 a2 x) ..)). +(defmacro! ->> + (fn* (x & xs) + (reduce _iter->> x xs))) + +(def! _iter->> + (fn* [acc form] + (if (list? form) + `(~(first form) ~@(rest form) ~acc) + (list form acc)))) diff --git a/impls/lib/trivial.mal b/impls/lib/trivial.mal new file mode 100644 index 0000000000..aa2169104b --- /dev/null +++ b/impls/lib/trivial.mal @@ -0,0 +1,20 @@ +;; Trivial but convenient functions. + +;; Integer predecessor (number -> number) +(def! inc (fn* [a] (+ a 1))) + +;; Integer predecessor (number -> number) +(def! dec (fn* (a) (- a 1))) + +;; Integer nullity test (number -> boolean) +(def! zero? (fn* (n) (= 0 n))) + +;; Returns the unchanged argument. +(def! identity (fn* (x) x)) + +;; Generate a hopefully unique symbol. See section "Plugging the Leaks" +;; of http://www.gigamonkeys.com/book/macros-defining-your-own.html +(def! gensym + (let* [counter (atom 0)] + (fn* [] + (symbol (str "G__" (swap! counter inc)))))) diff --git a/impls/livescript/Dockerfile b/impls/livescript/Dockerfile new file mode 100644 index 0000000000..e919063973 --- /dev/null +++ b/impls/livescript/Dockerfile @@ -0,0 +1,25 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive \ + apt-get -y install libreadline-dev libedit-dev livescript npm + +ENV NPM_CONFIG_CACHE /mal/.npm diff --git a/impls/livescript/Makefile b/impls/livescript/Makefile new file mode 100644 index 0000000000..1afe00026f --- /dev/null +++ b/impls/livescript/Makefile @@ -0,0 +1,31 @@ +SOURCES_BASE = reader.ls printer.ls env.ls core.ls utils.ls +SOURCES_STEPS = step0_repl.ls step1_read_print.ls step2_eval.ls \ + step4_if_fn_do.ls step5_tco.ls step6_file.ls step7_quote.ls \ + step8_macros.ls step9_try.ls stepA_mal.ls +SOURCES = $(SOURCES_BASE) $(SOURCES_STEPS) + +BINS = $(SOURCES:%.ls=%.js) + +LSC = lsc + +all: node_modules $(BINS) + +node_modules: + npm install + +%.js: %.ls node_modules + $(LSC) -d -c $(@:%.js=%.ls) + +step1_read_print.js: utils.js reader.js printer.js +step2_eval.js: utils.js reader.js printer.js +step3_env.js: utils.js reader.js printer.js env.js +step4_if_fn_do.js: utils.js reader.js printer.js env.js core.js +step5_tco.js: utils.js reader.js printer.js env.js core.js +step6_file.js: utils.js reader.js printer.js env.js core.js +step7_quote.js: utils.js reader.js printer.js env.js core.js +step8_macros.js: utils.js reader.js printer.js env.js core.js +step9_try.js: utils.js reader.js printer.js env.js core.js +stepA_mal.js: utils.js reader.js printer.js env.js core.js + +clean: + rm -f $(BINS) diff --git a/impls/livescript/core.ls b/impls/livescript/core.ls new file mode 100644 index 0000000000..8bbf1b4a67 --- /dev/null +++ b/impls/livescript/core.ls @@ -0,0 +1,350 @@ + +{ + zip, map, apply, and-list, join, Obj, concat, all, + pairs-to-obj, obj-to-pairs, reject, keys, values, + difference, empty, reverse, chars +} = require 'prelude-ls' +{pr_str} = require './printer' +{read_str, list-to-map, map-keyword, keyword-prefix} = require './reader' +fs = require 'fs' +{readline} = require './node_readline' + + +export runtime-error = (msg) -> throw new Error msg + +export unpack-tco = (ast) -> + if ast.type == \tco + then ast.eval! + else ast + +fn = (body) -> {type: \function, value: body} +const-nil = -> {type: \const, value: \nil} +const-int = (int) -> {type: \int, value: int} +const-bool = (bool) -> {type: \const, value: if bool then \true else \false} +const-str = (str) -> {type: \string, value: str} + +list-or-vector = ({type}) -> type in [\list \vector] + +are-lists-equal = (equals-fn, a, b) -> + if a.length != b.length then false + else zip a, b |> map (apply equals-fn) |> and-list + +deep-equals = (a, b) -> + if (list-or-vector a) and (list-or-vector b) then + are-lists-equal deep-equals, a.value, b.value + else if a.type == \map and b.type == \map then + a-keys = keys a.value + b-keys = keys b.value + if a-keys.length == b-keys.length and \ + empty (difference a-keys, b-keys) + #if are-lists-equal (==), a-keys, b-keys + a-keys |> map (key) -> [a.value[key], b.value[key]] + |> map (apply deep-equals) + |> and-list + else false + else if a.type != b.type then false + else a.value == b.value + + +check-param = (name, idx, test, expected, actual) -> + if not test + runtime-error "'#{name}' expected parameter #{idx} + to be #{expected}, got #{actual}" + + +check-type = (name, idx, expected, actual) -> + check-param name, idx, expected == actual, expected, actual + + +export ns = do + '+': fn (a, b) -> const-int a.value + b.value + '-': fn (a, b) -> const-int a.value - b.value + '*': fn (a, b) -> const-int a.value * b.value + '/': fn (a, b) -> const-int parseInt (a.value / b.value) + + 'list': fn (...list) -> {type: \list, value: list} + 'list?': fn (param) -> const-bool param.type == \list + + 'empty?': fn ({type, value}) -> + switch type + | \const => + if value == \nil + then const-bool true + else runtime-error "'empty?' is not supported on #{value}" + | \list, \vector => + const-bool value.length == 0 + | \map => + const-bool Obj.empty value + | otherwise => + runtime-error "'empty?' is not supported on type #{type}" + + 'count': fn ({type, value}) -> + switch type + | \const => + if value == \nil + then const-int 0 + else runtime-error "'count' is not supported on #{value}" + | \list, \vector => + const-int value.length + | \map => + value |> Obj.keys |> (.length) |> const-int + | otherwise => + runtime-error "'count' is not supported on type #{type}" + + '=': fn (a, b) -> const-bool (deep-equals a, b) + '<': fn (a, b) -> const-bool a.value < b.value + '>': fn (a, b) -> const-bool a.value > b.value + '<=': fn (a, b) -> const-bool a.value <= b.value + '>=': fn (a, b) -> const-bool a.value >= b.value + + 'pr-str': fn (...params) -> + params |> map (p) -> pr_str p, print_readably=true + |> join ' ' + |> const-str + + 'str': fn (...params) -> + params |> map (p) -> pr_str p, print_readably=false + |> join '' + |> const-str + + 'prn': fn (...params) -> + params |> map (p) -> pr_str p, print_readably=true + |> join ' ' + |> console.log + |> const-nil + + 'println': fn (...params) -> + params |> map (p) -> pr_str p, print_readbly=false + |> join ' ' + |> console.log + |> const-nil + + 'read-string': fn ({type, value}) -> + check-type 'read-string', 0, \string, type + read_str value + + 'slurp': fn (filename) -> + if filename.type != \string + runtime-error "'slurp' expected the first parameter + to be a string, got a #{filename.type}" + + const-str <| fs.readFileSync filename.value, 'utf8' + + 'atom': fn (value) -> {type: \atom, value: value} + 'atom?': fn (atom) -> const-bool atom.type == \atom + 'deref': fn (atom) -> + check-type 'deref', 0, \atom, atom.type + atom.value + + 'reset!': fn (atom, value) -> + check-type 'reset!', 0, \atom, atom.type + atom.value = value + + 'swap!': fn (atom, fn, ...args) -> + check-type 'swap!', 0, \atom, atom.type + if fn.type != \function + runtime-error "'swap!' expected the second parameter + to be a function, got a #{fn.type}" + + atom.value = unpack-tco (fn.value.apply @, [atom.value] ++ args) + + 'cons': fn (value, list) -> + check-param 'cons', 1, (list-or-vector list), + 'list or vector', list.type + + {type: \list, value: [value] ++ list.value} + + 'concat': fn (...params) -> + if not all list-or-vector, params + runtime-error "'concat' expected all parameters to be a list or vector" + + {type: \list, value: params |> map (.value) |> concat} + + 'vec': fn (sequence) -> + check-param 'vec', 0, (list-or-vector sequence), + 'list or vector', sequence.type + + {type: \vector, value: sequence.value} + + 'nth': fn (list, index) -> + check-param 'nth', 0, (list-or-vector list), + 'list or vector', list.type + check-param 'nth', 1, index.type == \int, + 'int', index.type + + if index.value < 0 or index.value >= list.value.length + runtime-error 'list index out of bounds' + + list.value[index.value] + + 'first': fn (list) -> + if list.type == \const and list.value == \nil + return const-nil! + + check-param 'first', 0, (list-or-vector list), + 'list or vector', list.type + + if list.value.length == 0 + then const-nil! + else list.value[0] + + 'rest': fn (list) -> + if list.type == \const and list.value == \nil + return {type: \list, value: []} + + check-param 'rest', 0, (list-or-vector list), + 'list or vector', list.type + + {type: \list, value: list.value.slice 1} + + 'throw': fn (value) -> throw value + + 'apply': fn (fn, ...params, list) -> + check-type 'apply', 0, \function, fn.type + if not list then runtime-error "apply expected at least two parameters" + check-param 'apply', params.length+1, (list-or-vector list), + 'list or vector', list.type + + unpack-tco fn.value.apply @, params ++ list.value + + 'map': fn (fn, list) -> + check-type 'map', 0, \function, fn.type + check-param 'map', 1, (list-or-vector list), + 'list or vector', list.type + + mapped-list = list.value |> map (value) -> + unpack-tco fn.value.apply @, [value] + + {type: \list, value: mapped-list} + + 'nil?': fn (ast) -> const-bool (ast.type == \const and ast.value == \nil) + 'true?': fn (ast) -> const-bool (ast.type == \const and ast.value == \true) + 'false?': fn (ast) -> const-bool (ast.type == \const and ast.value == \false) + 'symbol?': fn (ast) -> const-bool ast.type == \symbol + + 'symbol': fn (str) -> + check-type 'symbol', 0, \string, str.type + {type: \symbol, value: str.value} + + 'keyword': fn (str) -> + if str.type == \keyword then return str + check-type 'keyword', 0, \string, str.type + {type: \keyword, value: ':' + str.value} + + 'keyword?': fn (ast) -> const-bool ast.type == \keyword + + 'number?': fn (ast) -> const-bool ast.type == \int + 'fn?': fn (ast) -> const-bool (ast.type == \function and not ast.is_macro) + 'macro?': fn (ast) -> const-bool (ast.type == \function and ast.is_macro) + + 'vector': fn (...params) -> {type: \vector, value: params} + 'vector?': fn (ast) -> const-bool ast.type == \vector + + 'hash-map': fn (...params) -> list-to-map params + + 'map?': fn (ast) -> const-bool ast.type == \map + + 'assoc': fn (m, ...params) -> + check-type 'assoc', 0, \map, m.type + + # Turn the params into a map, this is kind of hacky. + params-map = list-to-map params + + # Copy the map by cloning (prototyping). + new-map = ^^m.value + + for k, v of params-map.value + new-map[k] = v + + {type: \map, value: new-map} + + 'dissoc': fn (m, ...keys) -> + check-type 'dissoc', 0, \map, m.type + + # Convert keyword to map key strings. + str-keys = keys |> map map-keyword + + new-map = m.value + |> obj-to-pairs + |> reject ([key, value]) -> key in str-keys + |> pairs-to-obj + + {type: \map, value: new-map} + + 'get': fn (m, key) -> + if m.type == \const and m.value == \nil + then return const-nil! + + check-type 'get', 0, \map, m.type + str-key = map-keyword key + value = m.value[str-key] + if value then value else const-nil! + + 'contains?': fn (m, key) -> + check-type 'contains?', 0, \map, m.type + str-key = map-keyword key + const-bool (str-key of m.value) + + 'keys': fn (m) -> + check-type 'keys', 0, \map, m.type + result = keys m.value |> map (key) -> + if key.startsWith keyword-prefix + then {type: \keyword, value: key.substring 1} + else {type: \string, value: key} + {type: \list, value: result} + + 'vals': fn (m) -> + check-type 'vals', 0, \map, m.type + {type: \list, value: values m.value} + + 'sequential?': fn (ast) -> const-bool list-or-vector ast + + 'with-meta': fn (ast, m) -> + ast with {meta: m} + + 'meta': fn (ast) -> + if ast.meta + then ast.meta + else const-nil! + + 'readline': fn (prompt) -> + check-type 'readline', 0, \string, prompt.type + result = readline prompt.value + if result? + then const-str result + else const-nil! + + 'time-ms': fn -> + const-int (new Date).getTime! + + 'conj': fn (list, ...params) -> + check-param 'conj', 0, (list-or-vector list), + 'list or vector', list.type + + if list.type == \list + type: \list + value: (reverse params) ++ list.value + else + type: \vector + value: list.value ++ params + + 'string?': fn (ast) -> const-bool ast.type == \string + + 'seq': fn (seq) -> + switch seq.type + | \list => + if seq.value.length + then seq + else const-nil! + | \vector => + if seq.value.length + then {type: \list, value: seq.value} + else const-nil! + | \string => + if seq.value.length + then {type: \list, value: chars seq.value |> map const-str} + else const-nil! + | otherwise => + if seq.type == \const and seq.value == \nil + then const-nil! + else runtime-error "unsupported type for 'seq': #{seq.type}" diff --git a/impls/livescript/env.ls b/impls/livescript/env.ls new file mode 100644 index 0000000000..b0d9840809 --- /dev/null +++ b/impls/livescript/env.ls @@ -0,0 +1,11 @@ +export class Env + (outer = null, data = {}) -> + @outer = outer + @data = data + + set: (symbol, ast) -> + @data[symbol] = ast + + get: (symbol) -> + if symbol of @data then @data[symbol] + else if @outer? then @outer.get symbol diff --git a/impls/livescript/error.ls b/impls/livescript/error.ls new file mode 100644 index 0000000000..e69de29bb2 diff --git a/impls/livescript/node_readline.js b/impls/livescript/node_readline.js new file mode 100644 index 0000000000..bc04f92bde --- /dev/null +++ b/impls/livescript/node_readline.js @@ -0,0 +1,50 @@ +// IMPORTANT: choose one +var RL_LIB = "libreadline.so"; // NOTE: libreadline is GPL +//var RL_LIB = "libedit.so"; + +var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); + +var rlwrap = {}; // namespace for this module in web context + +var koffi = require('koffi'), + fs = require('fs'); + +var koffi_rl = koffi.load(RL_LIB) + +var rllib = { + readline: koffi_rl.func("char *readline(char *prompt)"), + add_history: koffi_rl.func("int add_history(char *line)") +} + +var rl_history_loaded = false; + +exports.readline = rlwrap.readline = function(prompt) { + prompt = typeof prompt !== 'undefined' ? prompt : "user> "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i + switch type + | \const => value + | \int => value + | \string => + if print_readably + then encode-string value + else value + | \symbol => value + | \keyword => value + | \list => '(' + (pr_list value, print_readably) + ')' + | \vector => '[' + (pr_list value, print_readably) + ']' + | \map => '{' + (pr_map value, print_readably) + '}' + | \function => '#' + | \atom => '(atom ' + (pr_str value) + ')' + + +encode-string = (str) -> + str |> (.replace /[\n\"\\]/g, + (ch) -> switch ch + | '\n' => '\\n' + | '"' => '\\"' + | '\\' => '\\\\') + |> (enc) -> "\"#{enc}\"" + + +pr_list = (list, print_readably) -> + list |> map (ast) -> pr_str ast, print_readably + |> join ' ' + + +pr_map_key = (key, print_readably) -> + if key.startsWith keyword-prefix + key.substring 1 + else if print_readably + encode-string key + else + key + +pr_map = (obj, print_readably) -> + obj |> obj-to-pairs + |> map ([key, value]) -> + key_str = pr_map_key key, print_readably + value_str = pr_str value, print_readably + key_str + ' ' + value_str + |> join ' ' diff --git a/impls/livescript/reader.ls b/impls/livescript/reader.ls new file mode 100644 index 0000000000..425df01bec --- /dev/null +++ b/impls/livescript/reader.ls @@ -0,0 +1,179 @@ +readline = require 'readline' +{id, map, pairs-to-obj} = require 'prelude-ls' +{list-to-pairs} = require './utils' + +export class OnlyComment + +parse-error = (msg) -> throw new Error msg + +class Reader + (tokens) -> + @tokens = tokens + @pos = 0 + + # returns the token at the current position + # and increments position. + next: -> + result = @peek! + if result? then @pos += 1 + result + + # just returns the token at the current position. + peek: -> + if @pos < @tokens.length + @tokens[@pos] + + +eof-or-comment = (reader) -> + token = reader.peek! + if token? and not token.startsWith ';' + then parse-error "expected EOF, got '#{token}'" + + +export read_str = (str) -> + str + |> tokenizer + |> (tokens) -> new Reader tokens + |> (reader) -> + result = read_form reader + if token? then parse-error "expected EOF, got '#{token}'" + result + + +# This function will take a single string and return an array/list +# of all the tokens (strings) in it. +tokenizer = (str) -> + re = // + [\s,]* # whitespace or commas + ( ~@ # special two-char ~@ + | [\[\]{}()'`~^@] # special single char one of []{}'`~^@ + | "(?:\\.| [^\\"])*"? # double-quoted string + | ;.* # any seq of chars starting ; + | [^\s\[\]{}('"`,;)]+ # seq of non-special chars: symbols, numbers, + ) # "true", "false" and "nil". + //y + + tokens = [] + while re.lastIndex < str.length + idx = re.lastIndex + m = re.exec str + if not m + # Allow whitespace or commas at the end of the input. + break if /[\s,]+/.exec str.substring idx + parse-error "parse error at character #{idx}" + + tok = m[1] + # Ignore comments. + if tok[0] != ';' then tokens.push m[1] + + tokens + +read_form = (reader) -> + switch reader.peek! + | '(' => read_list reader, ')' + | '[' => read_list reader, ']' + | '{' => read_list reader, '}' + | '\'' => read-macro 'quote', reader + | '\`' => read-macro 'quasiquote', reader + | '~' => read-macro 'unquote', reader + | '~@' => read-macro 'splice-unquote', reader + | '@' => read-macro 'deref', reader # todo only symbol? + | '^' => read-with-meta reader + | otherwise => + if that? then read_atom reader + else parse-error 'expected a form, got EOF' + + +read_list = (reader, end) -> + list = [] + reader.next! # accept '(', '[' or '{' + loop + token = reader.peek! + if not token? + parse-error "expected '#{end}', got EOF" + else if token == end + reader.next! + break + + list.push read_form reader + + switch end + | ')' => {type: \list, value: list} + | ']' => {type: \vector, value: list} + | '}' => list-to-map list + + +special_chars = '[]{}\'`~^@' +constants = [\true \false \nil] + + +read_atom = (reader) -> + token = reader.peek! + if token in constants + {type: \const, value: reader.next!} + else if token.match /^"(?:\\.|[^\\"])*"$/ + {type: \string, value: decode-string reader.next!} + else if token[0] == '"' + parse-error "expected '\"', got EOF" + else if token.match /^-?\d+$/ + {type: \int, value: parseInt reader.next!} + else if token != '~@' and token not in special_chars + if token.startsWith ':' + {type: \keyword, value: reader.next!} + else + {type: \symbol, value: reader.next!} + else + parse-error "expected an atom, got #{token}" + + +decode-string = (str) -> + str |> (.slice 1, -1) + |> (.replace /\\[\"\\n]/g, + (esc) -> switch esc + | '\\n' => '\n' + | '\\"' => '"' + | '\\\\' => '\\') + + +export keyword-prefix = '\u029e' + +export map-keyword = (key) -> + switch key.type + | \string => key.value + | \keyword => keyword-prefix + key.value + | otherwise => + parse-error "#{key.type} can't be a map key" + +export list-to-map = (list) -> + if list.length % 2 != 0 + parse-error "map should have an even number + of elements, got #{list.length}" + + list-to-pairs list + |> map ([key, value]) -> [(map-keyword key), value] + |> pairs-to-obj + |> (obj) -> {type: \map, value: obj} + + +read-macro = (symbol, reader) -> + reader.next! # accept macro start token + + do + type: \list + value: + * {type: \symbol, value: symbol} + * read_form reader + + +read-with-meta = (reader) -> + reader.next! # accept ^ + + meta = read_form reader + form = read_form reader + + do + type: \list + value: + * {type: \symbol, value: 'with-meta'} + * form + * meta diff --git a/impls/livescript/run b/impls/livescript/run new file mode 100755 index 0000000000..1148122a23 --- /dev/null +++ b/impls/livescript/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" diff --git a/impls/livescript/step0_repl.ls b/impls/livescript/step0_repl.ls new file mode 100644 index 0000000000..0395fc9a23 --- /dev/null +++ b/impls/livescript/step0_repl.ls @@ -0,0 +1,28 @@ +readline = require './node_readline' +{id} = require 'prelude-ls' + + +READ = id +EVAL = id +PRINT = id + +rep = (line) -> PRINT EVAL READ line + +loop + line = readline.readline 'user> ' + break if not line? or line == '' + console.log rep line + +# rl = readline.createInterface do +# input : process.stdin +# output : process.stdout +# prompt: 'user> ' + +# rl.prompt! + +# rl.on 'line', (line) -> +# console.log rep line +# rl.prompt! + +# rl.on 'close', -> +# process.exit 0 diff --git a/impls/livescript/step1_read_print.ls b/impls/livescript/step1_read_print.ls new file mode 100644 index 0000000000..1c15955a16 --- /dev/null +++ b/impls/livescript/step1_read_print.ls @@ -0,0 +1,18 @@ +readline = require './node_readline' +{id} = require 'prelude-ls' +{read_str, OnlyComment} = require './reader' +{pr_str} = require './printer' + + +EVAL = id + +rep = (line) -> pr_str EVAL read_str line + +loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch {message}: ex + if ex not instanceof OnlyComment + console.log message diff --git a/impls/livescript/step2_eval.ls b/impls/livescript/step2_eval.ls new file mode 100644 index 0000000000..af898262b1 --- /dev/null +++ b/impls/livescript/step2_eval.ls @@ -0,0 +1,56 @@ +readline = require './node_readline' +{id, map, Obj} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' + +repl_env = do + '+': + type: \function + value: (a, b) -> {type: \int, value: a.value + b.value} + '-': + type: \function + value: (a, b) -> {type: \int, value: a.value - b.value} + '*': + type: \function + value: (a, b) -> {type: \int, value: a.value * b.value} + '/': + type: \function + value: (a, b) -> {type: \int, value: parseInt(a.value / b.value)} + +eval_ast = (repl_env, {type, value}: ast) --> + + # console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => + result = repl_env[value] + if not result? then throw new Error 'symbol not found: ', value + result + | \list, \vector => + result = value |> map eval_ast repl_env + if type == \list and result.length != 0 + fn = result[0] + if fn.type != \function + throw new Error fn.value, ' is not a function' + fn.value.apply repl_env, result.slice 1 + else + {type: type, value: result} + | \map => + {type: \map, value: value |> Obj.map eval_ast repl_env} + | otherwise => + ast + + +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> pr_str + +loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch {message} + console.error message diff --git a/impls/livescript/step3_env.ls b/impls/livescript/step3_env.ls new file mode 100644 index 0000000000..8ff6aad67f --- /dev/null +++ b/impls/livescript/step3_env.ls @@ -0,0 +1,132 @@ +readline = require './node_readline' +{id, map, Obj, each} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' + +repl_env = new Env null, do + '+': + type: \function + value: (a, b) -> {type: \int, value: a.value + b.value} + '-': + type: \function + value: (a, b) -> {type: \int, value: a.value - b.value} + '*': + type: \function + value: (a, b) -> {type: \int, value: a.value * b.value} + '/': + type: \function + value: (a, b) -> {type: \int, value: parseInt(a.value / b.value)} + + +is-symbol = ({type, value}: ast, name) -> + type == \symbol and value == name + + +list-to-pairs = (list) -> + [0 to (list.length - 2) by 2] \ + |> map (idx) -> [list[idx], list[idx+1]] + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +eval_ast = (env, {type, value}: ast) --> + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return {type: \vector, value: value |> map eval_ast env} + | \map => return {type: \map, value: value |> Obj.map eval_ast env} + | otherwise => return ast + + if value.length == 0 then ast + else if value[0].type == \symbol + params = value[1 to] + switch value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | otherwise => eval_apply env, value + else + eval_apply env, value + + +check_params = (name, params, expected) -> + if params.length != expected + throw new Error "#{name} expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + throw new Error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + throw new Error "expected 1st parameter of let* to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + throw new Error "binding list of let* must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + throw new Error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Evaluate the 'body' of let* with the new environment. + eval_ast let_env, params[1] + + +eval_apply = (env, list) -> + [fn, ...args] = list |> map eval_ast env + if fn.type != \function + throw new Error fn.value, ' is not a function' + fn.value.apply env, args + + +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> pr_str + + +loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/step4_if_fn_do.ls b/impls/livescript/step4_if_fn_do.ls new file mode 100644 index 0000000000..5e6dcff786 --- /dev/null +++ b/impls/livescript/step4_if_fn_do.ls @@ -0,0 +1,203 @@ +readline = require './node_readline' +{id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' +{runtime-error, ns} = require './core' +{list-to-pairs} = require './utils' + + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +fmap-ast = (fn, {type, value}: ast) --> + {type: type, value: fn value} + + +eval_ast = (env, {type, value}: ast) --> + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return (ast |> fmap-ast map eval_ast env) + | \map => return (ast |> fmap-ast Obj.map eval_ast env) + | otherwise => return ast + + if value.length == 0 then ast + else if value[0].type == \symbol + params = value[1 to] + switch value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | 'do' => eval_do env, params + | 'if' => eval_if env, params + | 'fn*' => eval_fn env, params + | otherwise => eval_apply env, value + else + eval_apply env, value + + +check_params = (name, params, expected) -> + if params.length != expected + runtime-error "'#{name}' expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + runtime-error "expected 1st parameter of 'let*' to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + runtime-error "binding list of 'let*' must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + runtime-error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Evaluate the 'body' of let* with the new environment. + eval_ast let_env, params[1] + + +eval_do = (env, params) -> + if params.length == 0 + runtime-error "'do' expected at least one parameter" + + params |> map eval_ast env |> last + + +eval_if = (env, params) -> + if params.length < 2 + runtime-error "'if' expected at least 2 parameters" + else if params.length > 3 + runtime-error "'if' expected at most 3 parameters" + + cond = eval_ast env, params[0] + if is-thruthy cond + eval_ast env, params[1] + else if params.length > 2 + eval_ast env, params[2] + else + {type: \const, value: \nil} + + +eval_fn = (env, params) -> + check_params 'fn*', params, 2 + + if params[0].type not in [\list \vector] + runtime-error "'fn*' expected first parameter to be a list or vector." + + if not all (.type == \symbol), params[0].value + runtime-error "'fn*' expected only symbols in the parameters list." + + binds = params[0].value |> map (.value) + vargs = null + + # Parse variadic bind. + if binds.length >= 2 + [...rest, amper, name] = binds + if amper == '&' and name != '&' + binds = rest + vargs = name + + if elem-index '&', binds + runtime-error "'fn*' invalid usage of variadic parameters." + + if (unique binds).length != binds.length + runtime-error "'fn*' duplicate symbols in parameters list." + + body = params[1] + + fn_instance = (...values) -> + if not vargs and values.length != binds.length + runtime-error "function expected #{binds.length} parameters, + got #{values.length}" + else if vargs and values.length < binds.length + runtime-error "function expected at least + #{binds.length} parameters, + got #{values.length}" + + # Set binds to values in the new env. + fn_env = new Env env + + for [name, value] in (zip binds, values) + fn_env.set name, value + + if vargs + fn_env.set vargs, do + type: \list + value: values.slice binds.length + + # Evaluate the function body with the new environment. + eval_ast fn_env, body + + {type: \function, value: fn_instance} + + +eval_apply = (env, list) -> + [fn, ...args] = list |> map eval_ast env + if fn.type != \function + runtime-error "#{fn.value} is not a function, got a #{fn.type}" + + fn.value.apply env, args + + +repl_env = new Env +for symbol, value of ns + repl_env.set symbol, value + + +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> (ast) -> pr_str ast, print_readably=true + + +# Define not. +rep '(def! not (fn* (x) (if x false true)))' + +loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/step5_tco.ls b/impls/livescript/step5_tco.ls new file mode 100644 index 0000000000..f759ee5253 --- /dev/null +++ b/impls/livescript/step5_tco.ls @@ -0,0 +1,221 @@ +readline = require './node_readline' +{id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' +{runtime-error, ns} = require './core' +{list-to-pairs} = require './utils' + + +defer-tco = (env, ast) -> + type: \tco + env: env + ast: ast + + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +fmap-ast = (fn, {type, value}: ast) --> + {type: type, value: fn value} + + +eval_ast = (env, {type, value}: ast) --> + loop + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return (ast |> fmap-ast map eval_ast env) + | \map => return (ast |> fmap-ast Obj.map eval_ast env) + | otherwise => return ast + + if value.length == 0 + return ast + else + + result = if value[0].type == \symbol + params = value[1 to] + switch value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | 'do' => eval_do env, params + | 'if' => eval_if env, params + | 'fn*' => eval_fn env, params + | otherwise => eval_apply env, value + else + eval_apply env, value + + if result.type == \tco + env = result.env + {type, value}: ast = result.ast + else + return result + + +check_params = (name, params, expected) -> + if params.length != expected + runtime-error "'#{name}' expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + runtime-error "expected 1st parameter of 'let*' to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + runtime-error "binding list of 'let*' must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + runtime-error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Defer evaluation of let* body with TCO. + defer-tco let_env, params[1] + + +eval_do = (env, params) -> + if params.length == 0 + runtime-error "'do' expected at least one parameter" + + [...rest, last-param] = params + rest |> each eval_ast env + defer-tco env, last-param + + +eval_if = (env, params) -> + if params.length < 2 + runtime-error "'if' expected at least 2 parameters" + else if params.length > 3 + runtime-error "'if' expected at most 3 parameters" + + cond = eval_ast env, params[0] + if is-thruthy cond + defer-tco env, params[1] + else if params.length > 2 + defer-tco env, params[2] + else + {type: \const, value: \nil} + + +eval_fn = (env, params) -> + check_params 'fn*', params, 2 + + if params[0].type not in [\list \vector] + runtime-error "'fn*' expected first parameter to be a list or vector." + + if not all (.type == \symbol), params[0].value + runtime-error "'fn*' expected only symbols in the parameters list." + + binds = params[0].value |> map (.value) + vargs = null + + # Parse variadic bind. + if binds.length >= 2 + [...rest, amper, name] = binds + if amper == '&' and name != '&' + binds = rest + vargs = name + + if elem-index '&', binds + runtime-error "'fn*' invalid usage of variadic parameters." + + if (unique binds).length != binds.length + runtime-error "'fn*' duplicate symbols in parameters list." + + body = params[1] + + fn_instance = (...values) -> + if not vargs and values.length != binds.length + runtime-error "function expected #{binds.length} parameters, + got #{values.length}" + else if vargs and values.length < binds.length + runtime-error "function expected at least + #{binds.length} parameters, + got #{values.length}" + + # Set binds to values in the new env. + fn_env = new Env env + + for [name, value] in (zip binds, values) + fn_env.set name, value + + if vargs + fn_env.set vargs, do + type: \list + value: values.slice binds.length + + # Defer evaluation of the function body to TCO. + defer-tco fn_env, body + + {type: \function, value: fn_instance} + + +eval_apply = (env, list) -> + [fn, ...args] = list |> map eval_ast env + if fn.type != \function + runtime-error "#{fn.value} is not a function, got a #{fn.type}" + + fn.value.apply env, args + + +repl_env = new Env +for symbol, value of ns + repl_env.set symbol, value + + +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> (ast) -> pr_str ast, print_readably=true + + +# Define not. +rep '(def! not (fn* (x) (if x false true)))' + +loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/step6_file.ls b/impls/livescript/step6_file.ls new file mode 100644 index 0000000000..0acaf58c96 --- /dev/null +++ b/impls/livescript/step6_file.ls @@ -0,0 +1,251 @@ +readline = require './node_readline' +{id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' +{runtime-error, ns} = require './core' +{list-to-pairs} = require './utils' + + +defer-tco = (env, ast) -> + type: \tco + env: env + ast: ast + eval: -> eval_ast env, ast + + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +fmap-ast = (fn, {type, value}: ast) --> + {type: type, value: fn value} + + +eval_ast = (env, {type, value}: ast) --> + loop + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return (ast |> fmap-ast map eval_ast env) + | \map => return (ast |> fmap-ast Obj.map eval_ast env) + | otherwise => return ast + + if value.length == 0 + return ast + else + + result = if value[0].type == \symbol + params = value[1 to] + switch value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | 'do' => eval_do env, params + | 'if' => eval_if env, params + | 'fn*' => eval_fn env, params + | otherwise => eval_apply env, value + else + eval_apply env, value + + if result.type == \tco + env = result.env + {type, value}: ast = result.ast + else + return result + + +check_params = (name, params, expected) -> + if params.length != expected + runtime-error "'#{name}' expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + runtime-error "expected 1st parameter of 'let*' to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + runtime-error "binding list of 'let*' must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + runtime-error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Defer evaluation of let* body with TCO. + defer-tco let_env, params[1] + + +eval_do = (env, params) -> + if params.length == 0 + runtime-error "'do' expected at least one parameter" + + [...rest, last-param] = params + rest |> each eval_ast env + defer-tco env, last-param + + +eval_if = (env, params) -> + if params.length < 2 + runtime-error "'if' expected at least 2 parameters" + else if params.length > 3 + runtime-error "'if' expected at most 3 parameters" + + cond = eval_ast env, params[0] + if is-thruthy cond + defer-tco env, params[1] + else if params.length > 2 + defer-tco env, params[2] + else + {type: \const, value: \nil} + + +eval_fn = (env, params) -> + check_params 'fn*', params, 2 + + if params[0].type not in [\list \vector] + runtime-error "'fn*' expected first parameter to be a list or vector." + + if not all (.type == \symbol), params[0].value + runtime-error "'fn*' expected only symbols in the parameters list." + + binds = params[0].value |> map (.value) + vargs = null + + # Parse variadic bind. + if binds.length >= 2 + [...rest, amper, name] = binds + if amper == '&' and name != '&' + binds = rest + vargs = name + + if elem-index '&', binds + runtime-error "'fn*' invalid usage of variadic parameters." + + if (unique binds).length != binds.length + runtime-error "'fn*' duplicate symbols in parameters list." + + body = params[1] + + fn_instance = (...values) -> + if not vargs and values.length != binds.length + runtime-error "function expected #{binds.length} parameters, + got #{values.length}" + else if vargs and values.length < binds.length + runtime-error "function expected at least + #{binds.length} parameters, + got #{values.length}" + + # Set binds to values in the new env. + fn_env = new Env env + + for [name, value] in (zip binds, values) + fn_env.set name, value + + if vargs + fn_env.set vargs, do + type: \list + value: values.slice binds.length + + # Defer evaluation of the function body to TCO. + defer-tco fn_env, body + + {type: \function, value: fn_instance} + + +eval_apply = (env, list) -> + [fn, ...args] = list |> map eval_ast env + if fn.type != \function + runtime-error "#{fn.value} is not a function, got a #{fn.type}" + + fn.value.apply env, args + + +repl_env = new Env +for symbol, value of ns + repl_env.set symbol, value + +# Evil eval. +repl_env.set 'eval', do + type: \function + value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). + + +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> (ast) -> pr_str ast, print_readably=true + + +# Define not. +rep '(def! not (fn* (x) (if x false true)))' + +# Define load-file. +rep ' +(def! load-file + (fn* (f) + (eval + (read-string + (str "(do " (slurp f) "\nnil)")))))' + +# Parse program arguments. +# The first two (exe and core-file) are, respectively, +# the interpreter executable (nodejs or lsc) and the +# source file being executed (stepX_*.(ls|js)). +[exe, core-file, mal-file, ...argv] = process.argv + +repl_env.set '*ARGV*', do + type: \list + value: argv |> map (arg) -> + type: \string + value: arg + +if mal-file + rep "(load-file \"#{mal-file}\")" +else + # REPL. + loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/step7_quote.ls b/impls/livescript/step7_quote.ls new file mode 100644 index 0000000000..867e4b67f6 --- /dev/null +++ b/impls/livescript/step7_quote.ls @@ -0,0 +1,313 @@ +readline = require './node_readline' +{id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' +{runtime-error, ns} = require './core' +{list-to-pairs} = require './utils' + + +defer-tco = (env, ast) -> + type: \tco + env: env + ast: ast + eval: -> eval_ast env, ast + + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +fmap-ast = (fn, {type, value}: ast) --> + {type: type, value: fn value} + + +make-symbol = (name) -> {type: \symbol, value: name} +make-list = (value) -> {type: \list, value: value} +make-call = (name, params) -> make-list [make-symbol name] ++ params +is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name + + +eval_ast = (env, {type, value}: ast) --> + loop + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return (ast |> fmap-ast map eval_ast env) + | \map => return (ast |> fmap-ast Obj.map eval_ast env) + | otherwise => return ast + + if value.length == 0 + return ast + else + + result = if value[0].type == \symbol + params = value[1 to] + switch value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | 'do' => eval_do env, params + | 'if' => eval_if env, params + | 'fn*' => eval_fn env, params + | 'quote' => eval_quote env, params + | 'quasiquote' => eval_quasiquote env, params + | otherwise => eval_apply env, value + else + eval_apply env, value + + if result.type == \tco + env = result.env + {type, value}: ast = result.ast + else + return result + + +check_params = (name, params, expected) -> + if params.length != expected + runtime-error "'#{name}' expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + runtime-error "expected 1st parameter of 'let*' to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + runtime-error "binding list of 'let*' must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + runtime-error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Defer evaluation of let* body with TCO. + defer-tco let_env, params[1] + + +eval_do = (env, params) -> + if params.length == 0 + runtime-error "'do' expected at least one parameter" + + [...rest, last-param] = params + rest |> each eval_ast env + defer-tco env, last-param + + +eval_if = (env, params) -> + if params.length < 2 + runtime-error "'if' expected at least 2 parameters" + else if params.length > 3 + runtime-error "'if' expected at most 3 parameters" + + cond = eval_ast env, params[0] + if is-thruthy cond + defer-tco env, params[1] + else if params.length > 2 + defer-tco env, params[2] + else + {type: \const, value: \nil} + + +eval_fn = (env, params) -> + check_params 'fn*', params, 2 + + if params[0].type not in [\list \vector] + runtime-error "'fn*' expected first parameter to be a list or vector." + + if not all (.type == \symbol), params[0].value + runtime-error "'fn*' expected only symbols in the parameters list." + + binds = params[0].value |> map (.value) + vargs = null + + # Parse variadic bind. + if binds.length >= 2 + [...rest, amper, name] = binds + if amper == '&' and name != '&' + binds = rest + vargs = name + + if elem-index '&', binds + runtime-error "'fn*' invalid usage of variadic parameters." + + if (unique binds).length != binds.length + runtime-error "'fn*' duplicate symbols in parameters list." + + body = params[1] + + fn_instance = (...values) -> + if not vargs and values.length != binds.length + runtime-error "function expected #{binds.length} parameters, + got #{values.length}" + else if vargs and values.length < binds.length + runtime-error "function expected at least + #{binds.length} parameters, + got #{values.length}" + + # Set binds to values in the new env. + fn_env = new Env env + + for [name, value] in (zip binds, values) + fn_env.set name, value + + if vargs + fn_env.set vargs, + make-list values.slice binds.length + + # Defer evaluation of the function body to TCO. + defer-tco fn_env, body + + {type: \function, value: fn_instance} + + +eval_apply = (env, list) -> + [fn, ...args] = list |> map eval_ast env + if fn.type != \function + runtime-error "#{fn.value} is not a function, got a #{fn.type}" + + fn.value.apply env, args + + +eval_quote = (env, params) -> + if params.length != 1 + runtime-error "quote expected 1 parameter, got #{params.length}" + + params[0] + + +eval_quasiquoteexpand = (params) -> + if params.length != 1 + runtime-error "quasiquote expected 1 parameter, got #{params.length}" + + ast = params[0] + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] + make-call 'quote', [ast] + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' + ast.value[1] + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' + make-call 'concat', [ + elt.value[1] + acc + ] + else + make-call 'cons', [ + quasiquote elt + acc + ] + + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params + defer-tco env, new-ast + + +repl_env = new Env +for symbol, value of ns + repl_env.set symbol, value + +# Evil eval. +repl_env.set 'eval', do + type: \function + value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). + + +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> (ast) -> pr_str ast, print_readably=true + + +# Define not. +rep '(def! not (fn* (x) (if x false true)))' + +# Define load-file. +rep ' +(def! load-file + (fn* (f) + (eval + (read-string + (str "(do " (slurp f) "\nnil)")))))' + +# Parse program arguments. +# The first two (exe and core-file) are, respectively, +# the interpreter executable (nodejs or lsc) and the +# source file being executed (stepX_*.(ls|js)). +[exe, core-file, mal-file, ...argv] = process.argv + +repl_env.set '*ARGV*', do + type: \list + value: argv |> map (arg) -> + type: \string + value: arg + +if mal-file + rep "(load-file \"#{mal-file}\")" +else + # REPL. + loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/step8_macros.ls b/impls/livescript/step8_macros.ls new file mode 100644 index 0000000000..19690e36f5 --- /dev/null +++ b/impls/livescript/step8_macros.ls @@ -0,0 +1,350 @@ +readline = require './node_readline' +{id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' +{runtime-error, ns, unpack-tco} = require './core' +{list-to-pairs} = require './utils' + + +defer-tco = (env, ast) -> + type: \tco + env: env + ast: ast + eval: -> eval_ast env, ast + + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +fmap-ast = (fn, {type, value}: ast) --> + {type: type, value: fn value} + + +make-symbol = (name) -> {type: \symbol, value: name} +make-list = (value) -> {type: \list, value: value} +make-call = (name, params) -> make-list [make-symbol name] ++ params +is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name + + +eval_ast = (env, {type, value}: ast) --> + loop + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return (ast |> fmap-ast map eval_ast env) + | \map => return (ast |> fmap-ast Obj.map eval_ast env) + | otherwise => return ast + + if value.length == 0 + return ast + else + + result = if ast.value[0].type == \symbol + params = ast.value[1 to] + switch ast.value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | 'do' => eval_do env, params + | 'if' => eval_if env, params + | 'fn*' => eval_fn env, params + | 'quote' => eval_quote env, params + | 'quasiquote' => eval_quasiquote env, params + | 'defmacro!' => eval_defmacro env, params + | otherwise => eval_apply env, ast.value + else + eval_apply env, ast.value + + if result.type == \tco + env = result.env + {type, value}: ast = result.ast + else + return result + + +check_params = (name, params, expected) -> + if params.length != expected + runtime-error "'#{name}' expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + runtime-error "expected 1st parameter of 'let*' to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + runtime-error "binding list of 'let*' must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + runtime-error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Defer evaluation of let* body with TCO. + defer-tco let_env, params[1] + + +eval_do = (env, params) -> + if params.length == 0 + runtime-error "'do' expected at least one parameter" + + [...rest, last-param] = params + rest |> each eval_ast env + defer-tco env, last-param + + +eval_if = (env, params) -> + if params.length < 2 + runtime-error "'if' expected at least 2 parameters" + else if params.length > 3 + runtime-error "'if' expected at most 3 parameters" + + cond = eval_ast env, params[0] + if is-thruthy cond + defer-tco env, params[1] + else if params.length > 2 + defer-tco env, params[2] + else + {type: \const, value: \nil} + + +eval_fn = (env, params) -> + check_params 'fn*', params, 2 + + if params[0].type not in [\list \vector] + runtime-error "'fn*' expected first parameter to be a list or vector." + + if not all (.type == \symbol), params[0].value + runtime-error "'fn*' expected only symbols in the parameters list." + + binds = params[0].value |> map (.value) + vargs = null + + # Parse variadic bind. + if binds.length >= 2 + [...rest, amper, name] = binds + if amper == '&' and name != '&' + binds = rest + vargs = name + + if elem-index '&', binds + runtime-error "'fn*' invalid usage of variadic parameters." + + if (unique binds).length != binds.length + runtime-error "'fn*' duplicate symbols in parameters list." + + body = params[1] + + fn_instance = (...values) -> + if not vargs and values.length != binds.length + runtime-error "function expected #{binds.length} parameters, + got #{values.length}" + else if vargs and values.length < binds.length + runtime-error "function expected at least + #{binds.length} parameters, + got #{values.length}" + + # Set binds to values in the new env. + fn_env = new Env env + + for [name, value] in (zip binds, values) + fn_env.set name, value + + if vargs + fn_env.set vargs, + make-list values.slice binds.length + + # Defer evaluation of the function body to TCO. + defer-tco fn_env, body + + {type: \function, value: fn_instance, is_macro: false} + + +eval_apply = (env, list) -> + [first, ...raw_args] = list + fn = first |> eval_ast env + if fn.type != \function + runtime-error "#{fn.value} is not a function, got a #{fn.type}" + + if fn.is_macro + return (defer-tco env, (unpack-tco (fn.value.apply env, raw_args))) + args = raw_args |> map eval_ast env + fn.value.apply env, args + + +eval_quote = (env, params) -> + if params.length != 1 + runtime-error "quote expected 1 parameter, got #{params.length}" + + params[0] + + +eval_quasiquoteexpand = (params) -> + if params.length != 1 + runtime-error "quasiquote expected 1 parameter, got #{params.length}" + + ast = params[0] + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] + make-call 'quote', [ast] + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' + ast.value[1] + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' + make-call 'concat', [ + elt.value[1] + acc + ] + else + make-call 'cons', [ + quasiquote elt + acc + ] + + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params + defer-tco env, new-ast + + +eval_defmacro = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of defmacro!, got a #{name.type}" + + # Evaluate the second parameter. + fn = eval_ast env, params[1] + if fn.type != \function + runtime-error "expected a function for the second parameter + of defmacro!, got a #{fn.type}" + + # Copy fn and mark the function as a macro. + macro_fn = fn with is_macro: true + env.set name.value, macro_fn + + +repl_env = new Env +for symbol, value of ns + repl_env.set symbol, value + +# Evil eval. +repl_env.set 'eval', do + type: \function + value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). + +# Read, Evaluate, Print +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> (ast) -> pr_str ast, print_readably=true + + +# Define not. +rep '(def! not (fn* (x) (if x false true)))' + +# Define load-file. +rep ' +(def! load-file + (fn* (f) + (eval + (read-string + (str "(do " (slurp f) "\nnil)")))))' + +# Define cond. +rep ' +(defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list \'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons \'cond (rest (rest xs)))))))' + +# Parse program arguments. +# The first two (exe and core-file) are, respectively, +# the interpreter executable (nodejs or lsc) and the +# source file being executed (stepX_*.(ls|js)). +[exe, core-file, mal-file, ...argv] = process.argv + +repl_env.set '*ARGV*', do + type: \list + value: argv |> map (arg) -> + type: \string + value: arg + + +if mal-file + rep "(load-file \"#{mal-file}\")" +else + # REPL. + loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/step9_try.ls b/impls/livescript/step9_try.ls new file mode 100644 index 0000000000..240cc845bc --- /dev/null +++ b/impls/livescript/step9_try.ls @@ -0,0 +1,381 @@ +readline = require './node_readline' +{id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' +{runtime-error, ns, unpack-tco} = require './core' +{list-to-pairs} = require './utils' + + +defer-tco = (env, ast) -> + type: \tco + env: env + ast: ast + eval: -> eval_ast env, ast + + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +fmap-ast = (fn, {type, value}: ast) --> + {type: type, value: fn value} + + +make-symbol = (name) -> {type: \symbol, value: name} +make-list = (value) -> {type: \list, value: value} +make-call = (name, params) -> make-list [make-symbol name] ++ params +is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name + + +eval_ast = (env, {type, value}: ast) --> + loop + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return (ast |> fmap-ast map eval_ast env) + | \map => return (ast |> fmap-ast Obj.map eval_ast env) + | otherwise => return ast + + if value.length == 0 + return ast + else + + result = if ast.value[0].type == \symbol + params = ast.value[1 to] + switch ast.value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | 'do' => eval_do env, params + | 'if' => eval_if env, params + | 'fn*' => eval_fn env, params + | 'quote' => eval_quote env, params + | 'quasiquote' => eval_quasiquote env, params + | 'defmacro!' => eval_defmacro env, params + | 'try*' => eval_try env, params + | otherwise => eval_apply env, ast.value + else + eval_apply env, ast.value + + if result.type == \tco + env = result.env + {type, value}: ast = result.ast + else + return result + + +check_params = (name, params, expected) -> + if params.length != expected + runtime-error "'#{name}' expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + runtime-error "expected 1st parameter of 'let*' to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + runtime-error "binding list of 'let*' must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + runtime-error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Defer evaluation of let* body with TCO. + defer-tco let_env, params[1] + + +eval_do = (env, params) -> + if params.length == 0 + runtime-error "'do' expected at least one parameter" + + [...rest, last-param] = params + rest |> each eval_ast env + defer-tco env, last-param + + +eval_if = (env, params) -> + if params.length < 2 + runtime-error "'if' expected at least 2 parameters" + else if params.length > 3 + runtime-error "'if' expected at most 3 parameters" + + cond = eval_ast env, params[0] + if is-thruthy cond + defer-tco env, params[1] + else if params.length > 2 + defer-tco env, params[2] + else + {type: \const, value: \nil} + + +eval_fn = (env, params) -> + check_params 'fn*', params, 2 + + if params[0].type not in [\list \vector] + runtime-error "'fn*' expected first parameter to be a list or vector." + + if not all (.type == \symbol), params[0].value + runtime-error "'fn*' expected only symbols in the parameters list." + + binds = params[0].value |> map (.value) + vargs = null + + # Parse variadic bind. + if binds.length >= 2 + [...rest, amper, name] = binds + if amper == '&' and name != '&' + binds = rest + vargs = name + + if elem-index '&', binds + runtime-error "'fn*' invalid usage of variadic parameters." + + if (unique binds).length != binds.length + runtime-error "'fn*' duplicate symbols in parameters list." + + body = params[1] + + fn_instance = (...values) -> + if not vargs and values.length != binds.length + runtime-error "function expected #{binds.length} parameters, + got #{values.length}" + else if vargs and values.length < binds.length + runtime-error "function expected at least + #{binds.length} parameters, + got #{values.length}" + + # Set binds to values in the new env. + fn_env = new Env env + + for [name, value] in (zip binds, values) + fn_env.set name, value + + if vargs + fn_env.set vargs, + make-list values.slice binds.length + + # Defer evaluation of the function body to TCO. + defer-tco fn_env, body + + {type: \function, value: fn_instance, is_macro: false} + + +eval_apply = (env, list) -> + [first, ...raw_args] = list + fn = first |> eval_ast env + if fn.type != \function + runtime-error "#{fn.value} is not a function, got a #{fn.type}" + + if fn.is_macro + return (defer-tco env, (unpack-tco (fn.value.apply env, raw_args))) + args = raw_args |> map eval_ast env + fn.value.apply env, args + + +eval_quote = (env, params) -> + if params.length != 1 + runtime-error "quote expected 1 parameter, got #{params.length}" + + params[0] + + +eval_quasiquoteexpand = (params) -> + if params.length != 1 + runtime-error "quasiquote expected 1 parameter, got #{params.length}" + + ast = params[0] + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] + make-call 'quote', [ast] + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' + ast.value[1] + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' + make-call 'concat', [ + elt.value[1] + acc + ] + else + make-call 'cons', [ + quasiquote elt + acc + ] + + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params + defer-tco env, new-ast + + +eval_defmacro = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of defmacro!, got a #{name.type}" + + # Evaluate the second parameter. + fn = eval_ast env, params[1] + if fn.type != \function + runtime-error "expected a function for the second parameter + of defmacro!, got a #{fn.type}" + + # Copy fn and mark the function as a macro. + macro_fn = fn with is_macro: true + env.set name.value, macro_fn + + +eval_try = (env, params) -> + if params.length > 2 + runtime-error "'try*' expected 1 or 2 parameters, + got #{params.length}" + try-form = params[0] + if params.length == 1 + return eval_ast env, try-form + + catch-clause = params[1] + if catch-clause.type != \list or + catch-clause.value.length != 3 or + not (is-symbol catch-clause.value[0], 'catch*') or + catch-clause.value[1].type != \symbol + runtime-error "'try*' expected the second parameter to be + of the form (catch* A B)" + + try + eval_ast env, try-form + catch error + error-symbol = catch-clause.value[1].value + error-value = \ + if error.message + then {type: \string, value: error.message} + else error + + catch-env = new Env env + catch-env.set error-symbol, error-value + eval_ast catch-env, catch-clause.value[2] + + +repl_env = new Env +for symbol, value of ns + repl_env.set symbol, value + +# Evil eval. +repl_env.set 'eval', do + type: \function + value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). + +# Read, Evaluate, Print +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> (ast) -> pr_str ast, print_readably=true + + +# Define not. +rep '(def! not (fn* (x) (if x false true)))' + +# Define load-file. +rep ' +(def! load-file + (fn* (f) + (eval + (read-string + (str "(do " (slurp f) "\nnil)")))))' + +# Define cond. +rep ' +(defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list \'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons \'cond (rest (rest xs)))))))' + +# Parse program arguments. +# The first two (exe and core-file) are, respectively, +# the interpreter executable (nodejs or lsc) and the +# source file being executed (stepX_*.(ls|js)). +[exe, core-file, mal-file, ...argv] = process.argv + +repl_env.set '*ARGV*', do + type: \list + value: argv |> map (arg) -> + type: \string + value: arg + + +if mal-file + rep "(load-file \"#{mal-file}\")" +else + # REPL. + loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/stepA_mal.ls b/impls/livescript/stepA_mal.ls new file mode 100644 index 0000000000..81357dfc73 --- /dev/null +++ b/impls/livescript/stepA_mal.ls @@ -0,0 +1,385 @@ +readline = require './node_readline' +{id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' +{read_str} = require './reader' +{pr_str} = require './printer' +{Env} = require './env' +{runtime-error, ns, unpack-tco} = require './core' +{list-to-pairs} = require './utils' + + +defer-tco = (env, ast) -> + type: \tco + env: env + ast: ast + eval: -> eval_ast env, ast + + +is-thruthy = ({type, value}) -> + type != \const or value not in [\nil \false] + + +fmap-ast = (fn, {type, value}: ast) --> + {type: type, value: fn value} + + +make-symbol = (name) -> {type: \symbol, value: name} +make-list = (value) -> {type: \list, value: value} +make-call = (name, params) -> make-list [make-symbol name] ++ params +is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name + + +eval_ast = (env, {type, value}: ast) --> + loop + + dbgeval = env.get "DEBUG-EVAL" + if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" + + switch type + | \symbol => return (env.get value + or throw new Error "'#{value}' not found") + | \list => + # Proceed after this switch + | \vector => return (ast |> fmap-ast map eval_ast env) + | \map => return (ast |> fmap-ast Obj.map eval_ast env) + | otherwise => return ast + + if value.length == 0 + return ast + else + + result = if ast.value[0].type == \symbol + params = ast.value[1 to] + switch ast.value[0].value + | 'def!' => eval_def env, params + | 'let*' => eval_let env, params + | 'do' => eval_do env, params + | 'if' => eval_if env, params + | 'fn*' => eval_fn env, params + | 'quote' => eval_quote env, params + | 'quasiquote' => eval_quasiquote env, params + | 'defmacro!' => eval_defmacro env, params + | 'try*' => eval_try env, params + | otherwise => eval_apply env, ast.value + else + eval_apply env, ast.value + + if result.type == \tco + env = result.env + {type, value}: ast = result.ast + else + return result + + +check_params = (name, params, expected) -> + if params.length != expected + runtime-error "'#{name}' expected #{expected} parameters, + got #{params.length}" + + +eval_def = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of def!, got a #{name.type}" + + # Evaluate the second parameter and store + # it under name in the env. + env.set name.value, (eval_ast env, params[1]) + + +eval_let = (env, params) -> + check_params 'let*', params, 2 + + binding_list = params[0] + if binding_list.type not in [\list \vector] + runtime-error "expected 1st parameter of 'let*' to + be a binding list (or vector), + got a #{binding_list.type}" + else if binding_list.value.length % 2 != 0 + runtime-error "binding list of 'let*' must have an even + number of parameters" + + # Make a new environment with the + # current environment as outer. + let_env = new Env env + + # Evaluate all binding values in the + # new environment. + binding_list.value + |> list-to-pairs + |> each ([binding_name, binding_value]) -> + if binding_name.type != \symbol + runtime-error "expected a symbol as binding name, + got a #{binding_name.type}" + + let_env.set binding_name.value, (eval_ast let_env, binding_value) + + # Defer evaluation of let* body with TCO. + defer-tco let_env, params[1] + + +eval_do = (env, params) -> + if params.length == 0 + runtime-error "'do' expected at least one parameter" + + [...rest, last-param] = params + rest |> each eval_ast env + defer-tco env, last-param + + +eval_if = (env, params) -> + if params.length < 2 + runtime-error "'if' expected at least 2 parameters" + else if params.length > 3 + runtime-error "'if' expected at most 3 parameters" + + cond = eval_ast env, params[0] + if is-thruthy cond + defer-tco env, params[1] + else if params.length > 2 + defer-tco env, params[2] + else + {type: \const, value: \nil} + + +eval_fn = (env, params) -> + check_params 'fn*', params, 2 + + if params[0].type not in [\list \vector] + runtime-error "'fn*' expected first parameter to be a list or vector." + + if not all (.type == \symbol), params[0].value + runtime-error "'fn*' expected only symbols in the parameters list." + + binds = params[0].value |> map (.value) + vargs = null + + # Parse variadic bind. + if binds.length >= 2 + [...rest, amper, name] = binds + if amper == '&' and name != '&' + binds = rest + vargs = name + + if elem-index '&', binds + runtime-error "'fn*' invalid usage of variadic parameters." + + if (unique binds).length != binds.length + runtime-error "'fn*' duplicate symbols in parameters list." + + body = params[1] + + fn_instance = (...values) -> + if not vargs and values.length != binds.length + runtime-error "function expected #{binds.length} parameters, + got #{values.length}" + else if vargs and values.length < binds.length + runtime-error "function expected at least + #{binds.length} parameters, + got #{values.length}" + + # Set binds to values in the new env. + fn_env = new Env env + + for [name, value] in (zip binds, values) + fn_env.set name, value + + if vargs + fn_env.set vargs, + make-list values.slice binds.length + + # Defer evaluation of the function body to TCO. + defer-tco fn_env, body + + {type: \function, value: fn_instance, is_macro: false} + + +eval_apply = (env, list) -> + [first, ...raw_args] = list + fn = first |> eval_ast env + if fn.type != \function + runtime-error "#{fn.value} is not a function, got a #{fn.type}" + + if fn.is_macro + return (defer-tco env, (unpack-tco (fn.value.apply env, raw_args))) + args = raw_args |> map eval_ast env + fn.value.apply env, args + + +eval_quote = (env, params) -> + if params.length != 1 + runtime-error "quote expected 1 parameter, got #{params.length}" + + params[0] + + +eval_quasiquoteexpand = (params) -> + if params.length != 1 + runtime-error "quasiquote expected 1 parameter, got #{params.length}" + + ast = params[0] + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] + make-call 'quote', [ast] + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' + ast.value[1] + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' + make-call 'concat', [ + elt.value[1] + acc + ] + else + make-call 'cons', [ + quasiquote elt + acc + ] + + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params + defer-tco env, new-ast + + +eval_defmacro = (env, params) -> + check_params 'def!', params, 2 + + # Name is in the first parameter, and is not evaluated. + name = params[0] + if name.type != \symbol + runtime-error "expected a symbol for the first parameter + of defmacro!, got a #{name.type}" + + # Evaluate the second parameter. + fn = eval_ast env, params[1] + if fn.type != \function + runtime-error "expected a function for the second parameter + of defmacro!, got a #{fn.type}" + + # Copy fn and mark the function as a macro. + macro_fn = fn with is_macro: true + env.set name.value, macro_fn + + +eval_try = (env, params) -> + if params.length > 2 + runtime-error "'try*' expected 1 or 2 parameters, + got #{params.length}" + try-form = params[0] + if params.length == 1 + return eval_ast env, try-form + + catch-clause = params[1] + if catch-clause.type != \list or + catch-clause.value.length != 3 or + not (is-symbol catch-clause.value[0], 'catch*') or + catch-clause.value[1].type != \symbol + runtime-error "'try*' expected the second parameter to be + of the form (catch* A B)" + + try + eval_ast env, try-form + catch error + error-symbol = catch-clause.value[1].value + error-value = \ + if error.message + then {type: \string, value: error.message} + else error + + catch-env = new Env env + catch-env.set error-symbol, error-value + eval_ast catch-env, catch-clause.value[2] + + +repl_env = new Env +for symbol, value of ns + repl_env.set symbol, value + +# Evil eval. +repl_env.set 'eval', do + type: \function + value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). + +# Read, Evaluate, Print +rep = (line) -> + line + |> read_str + |> eval_ast repl_env + |> (ast) -> pr_str ast, print_readably=true + + +# Define not. +rep '(def! not (fn* (x) (if x false true)))' + +# Define load-file. +rep ' +(def! load-file + (fn* (f) + (eval + (read-string + (str "(do " (slurp f) "\nnil)")))))' + +# Define cond. +rep ' +(defmacro! cond + (fn* (& xs) + (if (> (count xs) 0) + (list \'if (first xs) + (if (> (count xs) 1) + (nth xs 1) + (throw "odd number of forms to cond")) + (cons \'cond (rest (rest xs)))))))' + +# Parse program arguments. +# The first two (exe and core-file) are, respectively, +# the interpreter executable (nodejs or lsc) and the +# source file being executed (stepX_*.(ls|js)). +[exe, core-file, mal-file, ...argv] = process.argv + +repl_env.set '*ARGV*', do + type: \list + value: argv |> map (arg) -> + type: \string + value: arg + +repl_env.set '*host-language*', + {type: \string, value: 'livescript'} + + +if mal-file + rep "(load-file \"#{mal-file}\")" +else + # REPL. + rep '(println (str "Mal [" *host-language* "]"))' + loop + line = readline.readline 'user> ' + break if not line? or line == '' + try + console.log rep line + catch error + if error.message + then console.error error.message + else console.error "Error:", pr_str error, print_readably=true diff --git a/impls/livescript/utils.ls b/impls/livescript/utils.ls new file mode 100644 index 0000000000..21d1ac3c22 --- /dev/null +++ b/impls/livescript/utils.ls @@ -0,0 +1,6 @@ +{map} = require 'prelude-ls' + + +export list-to-pairs = (list) -> + [0 to (list.length - 2) by 2] \ + |> map (idx) -> [list[idx], list[idx+1]] diff --git a/impls/logo/Dockerfile b/impls/logo/Dockerfile new file mode 100644 index 0000000000..f6cdfd00dc --- /dev/null +++ b/impls/logo/Dockerfile @@ -0,0 +1,44 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Rebuild ucblogo. +# * without X libraries so that the executable starts in text mode. +# * Add the timems function implemented in C + +RUN apt -y install autoconf autoconf-archive automake dpkg-dev g++ libncurses-dev + +RUN sed -i 's/Types: deb$/Types: deb deb-src/' /etc/apt/sources.list.d/ubuntu.sources +RUN apt-get -y update + +RUN cd /tmp \ + && apt-get source ucblogo \ + && cd /tmp/ucblogo-* \ + && autoreconf -f -i \ + && ./configure --disable-docs --disable-x11 \ + && echo "extern NODE *ltimems(NODE *);" >> globals.h \ + && echo "NODE *ltimems(NODE *args) { struct timeval tv; gettimeofday(&tv, NULL); return(make_floatnode(((FLONUM)tv.tv_sec) * 1000.0 + (tv.tv_usec / 1000))); }" >> coms.c \ + && sed -i -e 's/^\(.*lthrow.*\)$/\1 {"timems", 0, 0, 0, PREFIX_PRIORITY, ltimems},/' init.c \ + && make \ + && make install \ + && cd /tmp \ + && rm -rf /tmp/ucblogo* + +ENV HOME /mal diff --git a/impls/logo/Makefile b/impls/logo/Makefile new file mode 100644 index 0000000000..bb1b747413 --- /dev/null +++ b/impls/logo/Makefile @@ -0,0 +1,21 @@ +SOURCES_BASE = readline.lg types.lg reader.lg printer.lg +SOURCES_LISP = env.lg core.lg stepA_mal.lg +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +.PHONY: all dist clean + +all: + @true + +dist: mal.lg mal + +mal.lg: $(SOURCES) + cat $+ | grep -v "^load " > $@ + +mal: mal.lg + echo "#!/usr/bin/env logo" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.lg mal diff --git a/impls/logo/core.lg b/impls/logo/core.lg new file mode 100644 index 0000000000..25c1e48854 --- /dev/null +++ b/impls/logo/core.lg @@ -0,0 +1,342 @@ +make "global_exception [] + +to equal_q :a :b +case obj_type :a [ + [[list vector] + if not memberp obj_type :b [list vector] [output "false] + make "a seq_val :a + make "b seq_val :b + if notequalp count :a count :b [output "false] + (foreach :a :b [if not equal_q ?1 ?2 [output "false]]) + output "true + ] + [[map] + if "map <> obj_type :b [output "false] + localmake "ka map_keys :a + localmake "kb map_keys :b + if notequalp count :ka count :kb [output "false] + (foreach :ka map_vals :a [if not equal_q map_get :b ?1 ?2 [output "false]]) + output "true + ] + [else output :a = :b] +] +end + +to |mal_=| :a :b +output bool_to_mal equal_q :a :b +end + +to mal_throw :a +make "global_exception :a +(throw "error "_mal_exception_) +end + +to mal_nil? :a +output bool_to_mal ((obj_type :a) = "nil) +end + +to mal_true? :a +output bool_to_mal ((obj_type :a) = "true) +end + +to mal_false? :a +output bool_to_mal ((obj_type :a) = "false) +end + +to mal_string? :a +output bool_to_mal ((obj_type :a) = "string) +end + +to mal_symbol :a +output symbol_new string_val :a +end + +to mal_symbol? :a +output bool_to_mal ((obj_type :a) = "symbol) +end + +to mal_keyword :a +output ifelse "keyword = obj_type :a ":a [keyword_new string_val :a] +end + +to mal_keyword? :a +output bool_to_mal ((obj_type :a) = "keyword) +end + +to mal_number? :a +output bool_to_mal ((obj_type :a) = "number) +end + +to mal_fn? :a +output bool_to_mal memberp obj_type :a [fn nativefn] +end + +to mal_macro? :a +output bool_to_mal "macro = obj_type :a +end + +to |mal_pr-str| [:args] +output string_new pr_seq :args "true "| | +end + +to mal_str [:args] +output string_new pr_seq :args "false " +end + +to mal_prn [:args] +print pr_seq :args "true "| | +output nil_new +end + +to mal_println [:args] +print pr_seq :args "false "| | +output nil_new +end + +to |mal_read-string| :str +output read_str string_val :str +end + +to mal_readline :prompt +localmake "line readline string_val :prompt +if :line=[] [output nil_new] +output string_new :line +end + +to mal_slurp :str +localmake "filename string_val :str +openread :filename +setread :filename +localmake "content " +until [eofp] [ + make "content word :content readchar +] +close :filename +output string_new :content +end + +to |mal_<| :a :b +output bool_to_mal lessp number_val :a number_val :b +end + +to |mal_<=| :a :b +output bool_to_mal lessequalp number_val :a number_val :b +end + +to |mal_>| :a :b +output bool_to_mal greaterp number_val :a number_val :b +end + +to |mal_>=| :a :b +output bool_to_mal greaterequalp number_val :a number_val :b +end + +to |mal_+| :a :b +output number_new sum number_val :a number_val :b +end + +to |mal_-| :a :b +output number_new difference number_val :a number_val :b +end + +to |mal_*| :a :b +output number_new product number_val :a number_val :b +end + +to |mal_/| :a :b +output number_new quotient number_val :a number_val :b +end + +to |mal_time-ms| +; Native function timems is added to coms.c (see Dockerfile) +output number_new timems +end + +to mal_list [:args] +output list_new :args +end + +to mal_list? :a +output bool_to_mal ((obj_type :a) = "list) +end + +to mal_vector [:args] +output vector_new :args +end + +to mal_vector? :a +output bool_to_mal ((obj_type :a) = "vector) +end + +to |mal_hash-map| [:pairs] +output map_assoc :map_empty :pairs +end + +to mal_map? :a +output bool_to_mal "map = obj_type :a +end + +to mal_assoc :map [:args] +output map_assoc :map :args +end + +to mal_get :map :key +if "nil = obj_type :map [output nil_new] +localmake "val map_get :map :key +if "notfound = obj_type :val [output nil_new] +output :val +end + +to mal_contains? :m :k +output bool_to_mal "notfound <> obj_type map_get :m :k +end + +to mal_keys :map +output list_new map_keys :map +end + +to mal_vals :map +output list_new map_vals :map +end + +to mal_sequential? :a +output bool_to_mal memberp obj_type :a [list vector] +end + +to mal_cons :a :b +output list_new fput :a seq_val :b +end + +to mal_concat [:args] +output list_new map.se "seq_val :args +end + +to mal_vec :s +output vector_new seq_val :s +end + +to mal_nth :a :i +make "a seq_val :a +make "i number_val :i +if or (:i < 0) (:i >= count :a) [(throw "error [nth: index out of range])] +output item (:i + 1) :a +end + +to mal_first :a +if "nil = obj_type :a [output nil_new] +make "a seq_val :a +output ifelse emptyp :a "nil_new [first :a] +end + +to mal_rest :a +if "nil = obj_type :a [output list_new []] +make "a seq_val :a +output list_new ifelse emptyp :a [[]] [butfirst :a] +end + +to mal_empty? :a +output bool_to_mal emptyp seq_val :a +end + +to mal_count :a +output number_new ifelse "nil = obj_type :a 0 [count seq_val :a] +end + +to mal_apply :f [:args] +localmake "callargs map.se [ifelse emptyp ?rest [seq_val ?] [(list ?)]] :args +output invoke_fn :f :callargs +end + +to mal_map :f :seq +output list_new map [invoke_fn :f (list ?)] seq_val :seq +end + +to mal_conj :a0 [:rest] +case obj_type :a0 [ + [[list] localmake "newlist seq_val :a0 + foreach :rest [make "newlist fput ? :newlist] + output list_new :newlist] + [[vector] output vector_new sentence seq_val :a0 :rest] + [else (throw "error [conj requires list or vector]) ] +] +end + +to mal_seq :a +case obj_type :a [ + [[string] + make "a string_val :a + if emptyp :a [output nil_new] + localmake "chars [] + for [i [count :a] 1 -1] [ make "chars fput string_new item :i :a :chars ] + output list_new :chars ] + [[list] + if emptyp seq_val :a [output nil_new] + output :a ] + [[vector] + make "a seq_val :a + if emptyp :a [output nil_new] + output list_new :a ] + [[nil] output nil_new ] + [else (throw "error [seq requires string or list or vector or nil]) ] +] +end + +to mal_atom? :a +output bool_to_mal ((obj_type :a) = "atom) +end + +to invoke_fn :f :callargs +output case obj_type :f [ + [[nativefn] + nativefn_apply :f :callargs ] + [[fn] + fn_apply :f :callargs ] + [[macro] + macro_apply :f :callargs ] + [else + (throw "error [Wrong type for apply])] +] +end + +to mal_swap! :atom :f [:args] +localmake "callargs fput mal_deref :atom :args +output mal_reset! :atom invoke_fn :f :callargs +end + +to logo_to_mal :a +output cond [ + [[memberp :a [true false]] bool_to_mal :a] + [[numberp :a] number_new :a] + [[wordp :a] string_new :a] + [[listp :a] list_new map "logo_to_mal :a] + [else nil_new] +] +end + +to |mal_logo-eval| :str +localmake "res runresult string_val :str +if emptyp :res [output nil_new] +output logo_to_mal first :res +end + +make "core_ns [ + = throw + + nil? true? false? string? symbol symbol? keyword keyword? number? + fn? macro? + + pr-str str prn println read-string readline slurp + + < <= > >= + - * / time-ms + + list list? vector vector? hash-map map? assoc dissoc get contains? + keys vals + + sequential? cons concat vec nth first rest empty? count apply map + + conj seq + + meta with-meta atom atom? deref reset! swap! + + logo-eval mal_logo_eval +] diff --git a/impls/logo/env.lg b/impls/logo/env.lg new file mode 100644 index 0000000000..d23279fcde --- /dev/null +++ b/impls/logo/env.lg @@ -0,0 +1,22 @@ +to env_new :outer :binds :exprs +output listtoarray (list :outer :binds :exprs) +end + +to env_keys :env +output item 2 :env +end + +to env_get :env :key +; Start with the quick memberp built-in, and only iterate slowly in +; LOGO once a match is found. +until [memberp :key item 2 :env] [ + make "env item 1 :env + if emptyp :env [output notfound_new] +] +foreach item 2 :env [if ? = :key [output item # item 3 :env]] +end + +to env_set :env :key :val +.setitem 2 :env fput :key item 2 :env +.setitem 3 :env fput :val item 3 :env +end diff --git a/impls/logo/examples/tree.mal b/impls/logo/examples/tree.mal new file mode 100644 index 0000000000..5813ad3257 --- /dev/null +++ b/impls/logo/examples/tree.mal @@ -0,0 +1,25 @@ +; Draw a tree +; +; The classic Logo demo for recursive functions - now in Mal! + +; White background with blue pen +(logo-eval "setbackground 7") +(logo-eval "setpencolor 1") + +; Initialize turtle location +(logo-eval "penup setxy 0 -100 pendown") + +; Expose Logo drawing functions to Mal code +(def! fd (fn* [size] (logo-eval (str "fd " size)))) +(def! bk (fn* [size] (logo-eval (str "bk " size)))) +(def! lt (fn* [size] (logo-eval (str "lt " size)))) +(def! rt (fn* [size] (logo-eval (str "rt " size)))) + +; Tree parts +(def! leaf (fn* [size] (do (fd size) (bk size)))) +(def! branch (fn* [size] (do (fd size) (draw-tree size) (bk size)))) +(def! two-branches (fn* [size] (do (lt 10) (branch size) (rt 40) (branch size) (lt 30)))) +(def! draw-tree (fn* [size] (if (< size 5) (leaf size) (two-branches (/ size 2))))) + +; Draw it +(draw-tree 250) diff --git a/impls/logo/printer.lg b/impls/logo/printer.lg new file mode 100644 index 0000000000..ab310bc3be --- /dev/null +++ b/impls/logo/printer.lg @@ -0,0 +1,44 @@ +to pr_str :exp :readable +output case obj_type :exp [ + [[nil] "nil] + [[true] "true] + [[false] "false] + [[number] number_val :exp] + [[symbol] symbol_value :exp] + [[keyword] word ": keyword_val :exp] + [[string] print_string string_val :exp :readable] + [[list] (word "\( pr_seq seq_val :exp :readable "| | "\) ) ] + [[vector] (word "\[ pr_seq seq_val :exp :readable "| | "\] ) ] + [[map] (word "\{ pr_seq (map.se [list ?1 ?2] map_keys :exp + map_vals :exp) :readable "| | "\} ) ] + [[atom] (word "|(atom | pr_str mal_deref :exp "true "\) ) ] + [[nativefn] "#] + [[fn] "# ] + [[macro] "# ] + [else (throw "error (sentence [unknown type] obj_type :exp))] +] +end + +to escape_string :s +output map [ + case rawascii ? [ + [[34 92] word "\\ ?] + [[10] "\\n] + [else ?] + ] + ] :s +end + +to print_string :exp :readable +ifelse :readable [ + output (word "\" escape_string :exp "\" ) +] [ + output :exp +] +end + +to pr_seq :seq :readable :delim_char +output apply "word map [ + ifelse # = 1 [pr_str ? :readable] [word :delim_char pr_str ? :readable] +] :seq +end diff --git a/impls/logo/reader.lg b/impls/logo/reader.lg new file mode 100644 index 0000000000..4b19e93c78 --- /dev/null +++ b/impls/logo/reader.lg @@ -0,0 +1,121 @@ +; LOGO, variables defined in a procedure are visible from called +; procedures. Use this quirk to pass the current parser status. +; str: the parsed string (constant) +; cnt: its length (constant) +; idx: the currently parsed index, or cnt + 1 + +make "new_line_char char 10 +make "forbidden_chars (word :new_line_char char 13 "| "(),;[\\]{}|) +make "separator_chars (word :new_line_char "| ,|) + +to read_allowed_chars +localmake "res " +while [:idx <= :cnt] [ + localmake "c item :idx :str + if memberp :c :forbidden_chars [output :res] + make "idx :idx + 1 + make "res word :res :c +] +output :res +end + +to skip_separators +while [:idx <= :cnt] [ + localmake "c item :idx :str + cond [ + [[:c = "|;|] + do.until [ + make "idx :idx + 1 + if :cnt < :idx "stop + ] [:new_line_char = item :idx :str] + ] + [[not memberp :c :separator_chars] stop] + ] + make "idx :idx + 1 +] +end + +to read_string +localmake "res " +while [:idx <= :cnt] [ + localmake "c item :idx :str + make "idx :idx + 1 + if :c = "" [output :res] + if :c = "\\ [ + if :cnt < :idx [(throw "error [unbalananced ""])] + make "c item :idx :str + make "idx :idx + 1 + if :c = "n [make "c :new_line_char] + ] + make "res word :res :c +] +(throw "error [unbalanced ""]) +end + +to read_symbol +localmake "token word :c read_allowed_chars +output cond [ + [[:token = "nil] nil_new] + [[memberp :token [false true]] bool_to_mal :token] + [[numberp :token] number_new :token] + [else symbol_new :token] +] +end + +to read_seq :end_char +localmake "res [] +forever [ + skip_separators + if :cnt < :idx [(throw "error (sentence "EOF, "expected :end_char))] + if :end_char = item :idx :str [ + make "idx :idx + 1 + ; reversing once is more efficient than successive lputs. + output reverse :res + ] + make "res fput read_form :res +] +end + +to reader_macro :symbol_name +output list_new list symbol_new :symbol_name read_form +end + +to with_meta_reader_macro +localmake "meta read_form +output list_new (list symbol_new "with-meta read_form :meta) +end + +to read_unquote +if :idx <= :cnt [if "@ = item :idx :str [ + make "idx :idx + 1 + output reader_macro "splice-unquote +]] +output reader_macro "unquote +end + +to read_form +skip_separators +if :cnt < :idx [(throw "error [EOF, expected a form])] +localmake "c item :idx :str +make "idx :idx + 1 +output case :c [ + [' reader_macro "quote ] + [` reader_macro "quasiquote ] + [~ read_unquote ] + [^ with_meta_reader_macro ] + [@ reader_macro "deref ] + [|(| list_new read_seq "|)|] + [|[| vector_new read_seq "|]|] + [|{| map_assoc :map_empty read_seq "|}|] + [|)]}| (throw "error (sentence "unexpected "' :c "'))] + [" string_new read_string] + [: keyword_new read_allowed_chars] + [else read_symbol ] +] +end + +to read_str :str +localmake "idx 1 +localmake "cnt count :str +output read_form +end diff --git a/impls/logo/readline.lg b/impls/logo/readline.lg new file mode 100644 index 0000000000..59e7766c83 --- /dev/null +++ b/impls/logo/readline.lg @@ -0,0 +1,25 @@ +make "backspace_char char 8 + +to readline :prompt +type :prompt +wait 0 ; flush standard output +localmake "line " +forever [ + localmake "c readchar + ifelse emptyp :c [ + output [] + ] [ + case rawascii :c [ + [[4] output []] + [[10] type :c + output :line] + [[127] if not emptyp :line [ + (type :backspace_char "| | :backspace_char) + make "line butlast :line + ]] + [else type :c + make "line word :line :c] + ] + ] +] +end diff --git a/impls/logo/run b/impls/logo/run new file mode 100755 index 0000000000..f4a73d98c1 --- /dev/null +++ b/impls/logo/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec ucblogo $(dirname $0)/${STEP:-stepA_mal}.lg - "${@}" diff --git a/impls/logo/step0_repl.lg b/impls/logo/step0_repl.lg new file mode 100644 index 0000000000..97b0254d52 --- /dev/null +++ b/impls/logo/step0_repl.lg @@ -0,0 +1,30 @@ +load "../logo/readline.lg + +to _read :str +output :str +end + +to _eval :ast +output :ast +end + +to _print :exp +output :exp +end + +to rep :str +output _print _eval _read :str +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + print rep :line + ] +] [:line = []] +(print) +end + +repl +bye diff --git a/impls/logo/step1_read_print.lg b/impls/logo/step1_read_print.lg new file mode 100644 index 0000000000..b7dfcdabd5 --- /dev/null +++ b/impls/logo/step1_read_print.lg @@ -0,0 +1,40 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg + +to _read :str +output read_str :str +end + +to _eval :ast +output :ast +end + +to _print :exp +output pr_str :exp "true +end + +to rep :str +output _print _eval _read :str +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +repl +bye diff --git a/impls/logo/step2_eval.lg b/impls/logo/step2_eval.lg new file mode 100644 index 0000000000..73b1e50dd2 --- /dev/null +++ b/impls/logo/step2_eval.lg @@ -0,0 +1,87 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg + +to _read :str +output read_str :str +end + +to _eval :ast :env +; (print "EVAL: _print :ast) + +case obj_type :ast [ + + [[symbol] + localmake "val map_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + localmake "f _eval :a0 :env + output nativefn_apply :f map [_eval ? :env] :ast ] + + [else output :ast] +] +end + +to _print :exp +output pr_str :exp "true +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to mal_add :a :b +output number_new ((number_val :a) + (number_val :b)) +end + +to mal_sub :a :b +output number_new ((number_val :a) - (number_val :b)) +end + +to mal_mul :a :b +output number_new ((number_val :a) * (number_val :b)) +end + +to mal_div :a :b +output number_new ((number_val :a) / (number_val :b)) +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +make "repl_env map_assoc :map_empty (list + symbol_new "+ nativefn_new "mal_add + symbol_new "- nativefn_new "mal_sub + symbol_new "* nativefn_new "mal_mul + symbol_new "/ nativefn_new "mal_div) + +repl +bye diff --git a/impls/logo/step3_env.lg b/impls/logo/step3_env.lg new file mode 100644 index 0000000000..2ddd38471f --- /dev/null +++ b/impls/logo/step3_env.lg @@ -0,0 +1,108 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg + +to _read :str +output read_str :str +end + +to _eval :ast :env +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + output _eval item 2 :ast :letenv ] + + [else + localmake "f _eval :a0 :env + output nativefn_apply :f map [_eval ? :env] :ast ] + ] + ] + [else output :ast] +] +end + +to _print :exp +output pr_str :exp "true +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to mal_add :a :b +output number_new ((number_val :a) + (number_val :b)) +end + +to mal_sub :a :b +output number_new ((number_val :a) - (number_val :b)) +end + +to mal_mul :a :b +output number_new ((number_val :a) * (number_val :b)) +end + +to mal_div :a :b +output number_new ((number_val :a) / (number_val :b)) +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +make "repl_env env_new [] map "symbol_new [+ - * / ] ~ + map "nativefn_new [mal_add mal_sub mal_mul mal_div] + +repl +bye diff --git a/impls/logo/step4_if_fn_do.lg b/impls/logo/step4_if_fn_do.lg new file mode 100644 index 0000000000..03f15a6b29 --- /dev/null +++ b/impls/logo/step4_if_fn_do.lg @@ -0,0 +1,131 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg +load "../logo/core.lg + +to _read :str +output read_str :str +end + +to _eval :ast :env +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + output _eval item 2 :ast :letenv ] + + [[do] + foreach :ast [ + ifelse emptyp ?rest [output _eval ? :env] [ignore _eval ? :env] + ] + ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + output _eval item 3 :ast :env + ] [ + output nil_new + ]] + [else output _eval item 2 :ast :env] + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + output _eval fn_body :f fn_gen_env :f map [_eval ? :env] :ast ] + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] +] +end + +to _print :exp +output pr_str :exp "true +end + +to re :str +ignore _eval _read :str :repl_env +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +; core_ns +make "repl_env env_new [] [] [] +foreach :core_ns [ + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? +] + +; core.mal: defined using the language itself +re "|(def! not (fn* (a) (if a false true)))| + +repl +bye diff --git a/impls/logo/step5_tco.lg b/impls/logo/step5_tco.lg new file mode 100644 index 0000000000..443fceac88 --- /dev/null +++ b/impls/logo/step5_tco.lg @@ -0,0 +1,135 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg +load "../logo/core.lg + +to _read :str +output read_str :str +end + +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] + ] + ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO + ] [ + output nil_new + ]] + [else make "ast item 2 :ast] ; TCO + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + make "env fn_gen_env :f map [_eval ? :env] :ast + make "ast fn_body :f ] ; TCO + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] +] +] +end + +to _print :exp +output pr_str :exp "true +end + +to re :str +ignore _eval _read :str :repl_env +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +; core_ns +make "repl_env env_new [] [] [] +foreach :core_ns [ + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? +] + +; core.mal: defined using the language itself +re "|(def! not (fn* (a) (if a false true)))| + +repl +bye diff --git a/impls/logo/step6_file.lg b/impls/logo/step6_file.lg new file mode 100644 index 0000000000..387aa32c13 --- /dev/null +++ b/impls/logo/step6_file.lg @@ -0,0 +1,157 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg +load "../logo/core.lg + +to _read :str +output read_str :str +end + +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] + ] + ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO + ] [ + output nil_new + ]] + [else make "ast item 2 :ast] ; TCO + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + make "env fn_gen_env :f map [_eval ? :env] :ast + make "ast fn_body :f ] ; TCO + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] +] +] +end + +to _print :exp +output pr_str :exp "true +end + +to re :str +ignore _eval _read :str :repl_env +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + localmake "e item 2 :exception + ifelse :e = "_mal_exception_ [ + (print "Error: pr_str :global_exception "false) + ] [ + (print "Error: :e) + ] +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +to mal_eval :a +output _eval :a :repl_env +end + +to argv_list +localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] +output list_new map "string_new :argv +end + +make "repl_env env_new [] [] [] +foreach :core_ns [ + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? +] +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list + +; core.mal: defined using the language itself +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| + +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] + print_exception error +] + +bye diff --git a/impls/logo/step7_quote.lg b/impls/logo/step7_quote.lg new file mode 100644 index 0000000000..8428d5c7c8 --- /dev/null +++ b/impls/logo/step7_quote.lg @@ -0,0 +1,192 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg +load "../logo/core.lg + +to _read :str +output read_str :str +end + +to quasiquote :ast +case obj_type :ast [ + [[list] localmake "xs seq_val ast + if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ + output item 2 :xs + ]] + output qq_seq :xs] + [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] + [[map symbol] output list_new (list symbol_new "quote :ast)] + [else output :ast] +] +end + +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result +end + +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ]] +] +output list_new (list symbol_new "cons quasiquote :elt :acc) +end + +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[quote] + output first :ast] + + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO + + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] + ] + ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO + ] [ + output nil_new + ]] + [else make "ast item 2 :ast] ; TCO + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + make "env fn_gen_env :f map [_eval ? :env] :ast + make "ast fn_body :f ] ; TCO + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] +] +] +end + +to _print :exp +output pr_str :exp "true +end + +to re :str +ignore _eval _read :str :repl_env +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + localmake "e item 2 :exception + ifelse :e = "_mal_exception_ [ + (print "Error: pr_str :global_exception "false) + ] [ + (print "Error: :e) + ] +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +to mal_eval :a +output _eval :a :repl_env +end + +to argv_list +localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] +output list_new map "string_new :argv +end + +make "repl_env env_new [] [] [] +foreach :core_ns [ + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? +] +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list + +; core.mal: defined using the language itself +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| + +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] + print_exception error +] + +bye diff --git a/impls/logo/step8_macros.lg b/impls/logo/step8_macros.lg new file mode 100644 index 0000000000..572a91ec50 --- /dev/null +++ b/impls/logo/step8_macros.lg @@ -0,0 +1,202 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg +load "../logo/core.lg + +to _read :str +output read_str :str +end + +to quasiquote :ast +case obj_type :ast [ + [[list] localmake "xs seq_val ast + if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ + output item 2 :xs + ]] + output qq_seq :xs] + [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] + [[map symbol] output list_new (list symbol_new "quote :ast)] + [else output :ast] +] +end + +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result +end + +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ]] +] +output list_new (list symbol_new "cons quasiquote :elt :acc) +end + +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[quote] + output first :ast] + + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO + + [[defmacro!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "macro_fn macro_new _eval :a2 :env + env_set :env :a1 :macro_fn + output :macro_fn ] + + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] + ] + ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO + ] [ + output nil_new + ]] + [else make "ast item 2 :ast] ; TCO + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + make "env fn_gen_env :f map [_eval ? :env] :ast + make "ast fn_body :f ] ; TCO + [[macro] + make "ast macro_apply :f :ast ] ; TCO + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] +] +] +end + +to _print :exp +output pr_str :exp "true +end + +to re :str +ignore _eval _read :str :repl_env +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + localmake "e item 2 :exception + ifelse :e = "_mal_exception_ [ + (print "Error: pr_str :global_exception "false) + ] [ + (print "Error: :e) + ] +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +to mal_eval :a +output _eval :a :repl_env +end + +to argv_list +localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] +output list_new map "string_new :argv +end + +make "repl_env env_new [] [] [] +foreach :core_ns [ + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? +] +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list + +; core.mal: defined using the language itself +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))| + +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] + print_exception error +] + +bye diff --git a/impls/logo/step9_try.lg b/impls/logo/step9_try.lg new file mode 100644 index 0000000000..e72c27f04c --- /dev/null +++ b/impls/logo/step9_try.lg @@ -0,0 +1,224 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg +load "../logo/core.lg + +to _read :str +output read_str :str +end + +to quasiquote :ast +case obj_type :ast [ + [[list] localmake "xs seq_val ast + if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ + output item 2 :xs + ]] + output qq_seq :xs] + [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] + [[map symbol] output list_new (list symbol_new "quote :ast)] + [else output :ast] +] +end + +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result +end + +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ]] +] +output list_new (list symbol_new "cons quasiquote :elt :acc) +end + +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[quote] + output first :ast] + + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO + + [[defmacro!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "macro_fn macro_new _eval :a2 :env + env_set :env :a1 :macro_fn + output :macro_fn ] + + [[try*] + localmake "a1 first :ast + ifelse 1 = count :ast [ + make "ast :a1 ; TCO + ] [ + localmake "result nil_new + localmake "result nil_new + catch "error [make "result _eval :a1 :env] + localmake "exception error + ifelse emptyp :exception [ + output :result + ] [ + localmake "e item 2 :exception + localmake "exception_obj ifelse :e = "_mal_exception_ ":global_exception [string_new :e] + localmake "a2 seq_val item 2 :ast + localmake "catchenv env_new :env [] [] + env_set :catchenv item 2 :a2 :exception_obj + make "env :catchenv + make "ast item 3 :a2 ; TCO + ] ] + ] + + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] + ] + ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO + ] [ + output nil_new + ]] + [else make "ast item 2 :ast] ; TCO + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + make "env fn_gen_env :f map [_eval ? :env] :ast + make "ast fn_body :f ] ; TCO + [[macro] + make "ast macro_apply :f :ast ] ; TCO + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] +] +] +end + +to _print :exp +output pr_str :exp "true +end + +to re :str +ignore _eval _read :str :repl_env +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + localmake "e item 2 :exception + ifelse :e = "_mal_exception_ [ + (print "Error: pr_str :global_exception "false) + ] [ + (print "Error: :e) + ] +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +to mal_eval :a +output _eval :a :repl_env +end + +to argv_list +localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] +output list_new map "string_new :argv +end + +make "repl_env env_new [] [] [] +foreach :core_ns [ + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? +] +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list + +; core.mal: defined using the language itself +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))| + +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] + print_exception error +] + +bye diff --git a/impls/logo/stepA_mal.lg b/impls/logo/stepA_mal.lg new file mode 100644 index 0000000000..4244e6a880 --- /dev/null +++ b/impls/logo/stepA_mal.lg @@ -0,0 +1,226 @@ +load "../logo/readline.lg +load "../logo/reader.lg +load "../logo/printer.lg +load "../logo/types.lg +load "../logo/env.lg +load "../logo/core.lg + +to _read :str +output read_str :str +end + +to quasiquote :ast +case obj_type :ast [ + [[list] localmake "xs seq_val ast + if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ + output item 2 :xs + ]] + output qq_seq :xs] + [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] + [[map symbol] output list_new (list symbol_new "quote :ast)] + [else output :ast] +] +end + +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result +end + +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ]] +] +output list_new (list symbol_new "cons quasiquote :elt :acc) +end + +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[quote] + output first :ast] + + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO + + [[defmacro!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "macro_fn macro_new _eval :a2 :env + env_set :env :a1 :macro_fn + output :macro_fn ] + + [[try*] + localmake "a1 first :ast + ifelse 1 = count :ast [ + make "ast :a1 ; TCO + ] [ + localmake "result nil_new + localmake "result nil_new + catch "error [make "result _eval :a1 :env] + localmake "exception error + ifelse emptyp :exception [ + output :result + ] [ + localmake "e item 2 :exception + localmake "exception_obj ifelse :e = "_mal_exception_ ":global_exception [string_new :e] + localmake "a2 seq_val item 2 :ast + localmake "catchenv env_new :env [] [] + env_set :catchenv item 2 :a2 :exception_obj + make "env :catchenv + make "ast item 3 :a2 ; TCO + ] ] + ] + + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] + ] + ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO + ] [ + output nil_new + ]] + [else make "ast item 2 :ast] ; TCO + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + make "env fn_gen_env :f map [_eval ? :env] :ast + make "ast fn_body :f ] ; TCO + [[macro] + make "ast macro_apply :f :ast ] ; TCO + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] +] +] +end + +to _print :exp +output pr_str :exp "true +end + +to re :str +ignore _eval _read :str :repl_env +end + +to rep :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + localmake "e item 2 :exception + ifelse :e = "_mal_exception_ [ + (print "Error: pr_str :global_exception "false) + ] [ + (print "Error: :e) + ] +] +end + +to repl +do.until [ + localmake "line readline "|user> | + if not emptyp :line [ + catch "error [print rep :line] + print_exception error + ] +] [:line = []] +(print) +end + +to mal_eval :a +output _eval :a :repl_env +end + +to argv_list +localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] +output list_new map "string_new :argv +end + +make "repl_env env_new [] [] [] +foreach :core_ns [ + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? +] +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list + +; core.mal: defined using the language itself +re "|(def! *host-language* "logo")| +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))| + +ifelse emptyp :command.line [ + re "|(println (str "Mal [" *host-language* "]"))| + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] + print_exception error +] + +bye diff --git a/impls/logo/tests/stepA_mal.mal b/impls/logo/tests/stepA_mal.mal new file mode 100644 index 0000000000..7e1cdb7a93 --- /dev/null +++ b/impls/logo/tests/stepA_mal.mal @@ -0,0 +1,30 @@ +;; Testing basic Logo interop + +(logo-eval "7") +;=>7 + +(logo-eval "\"hello") +;=>"hello" + +(logo-eval "[7 8 9]") +;=>(7 8 9) + +(logo-eval "123 = 123") +;=>true + +(logo-eval "not emptyp []") +;=>false + +(logo-eval "print [hello world]") +;/hello world +;=>nil + +(logo-eval "make \"foo 8") +(logo-eval ":foo") +;=>8 + +(logo-eval "apply \"word map \"reverse [Abc Abcd Abcde]") +;=>"cbAdcbAedcbA" + +(logo-eval "map [1 + ?] [1 2 3]") +;=>(2 3 4) diff --git a/impls/logo/types.lg b/impls/logo/types.lg new file mode 100644 index 0000000000..947d6dcb50 --- /dev/null +++ b/impls/logo/types.lg @@ -0,0 +1,203 @@ +; Make Logo's string-comparison case sensitive +make "caseignoredp "false + +; Load the 'case' library macro +case "dummy [] + +; Redefine 'case' macro to not override caseignoredp +.macro case :case.value :case.clauses +catch "case.error [output case.helper :case.value :case.clauses] +(throw "error [Empty CASE clause]) +end + +; For efficiency of env_get and map_get, ensure that MAL equality +; (equal_q) and LOGO equality (equalp/=) return the same result when +; an argument is neither a list, map, vector or atom. + +to obj_type :obj +output ifelse wordp :obj ""number [item 1 :obj] +end + +to list_new :val +output list "list :val +end + +to vector_new :val +output list "vector :val +end + +to seq_val :obj +output item 2 :obj +end + +to |mal_with-meta| :obj :meta +output (listtoarray fput :meta ifelse listp :obj [ + :obj +] [ + butfirst arraytolist :obj +] 0) +end + +to mal_meta :obj +output ifelse listp :obj "nil_new [item 0 :obj] +end + +; Convenient for map_get and env_get. + +make "global_notfound [notfound] + +to notfound_new +output :global_notfound +end + +make "global_nil [nil] + +to nil_new +output :global_nil +end + +make "global_false [false] +make "global_true [true] + +to bool_to_mal :bool +output ifelse :bool ":global_true ":global_false +end + +to number_new :val +output :val +end + +to number_val :obj +output :obj +end + +to symbol_new :name +output list "symbol :name +end + +to symbol_value :obj +output item 2 :obj +end + +to keyword_new :val +output list "keyword :val +end + +to keyword_val :obj +output item 2 :obj +end + +to string_new :val +output list "string :val +end + +to string_val :obj +output item 2 :obj +end + +to nativefn_new :f +output list "nativefn :f +end + +to nativefn_apply :fn :args +output apply item 2 :fn :args +end + +make "map_empty [map [] []] + +to map_get :map :key +foreach item 2 :map [if ? = :key [output item # item 3 :map]] +output notfound_new +end + +; Returns a new list with the key-val pair set +to map_assoc :map :pairs +foreach :pairs [ + if 1 = modulo # 2 [ + if memberp ? item 2 :map [make "map (mal_dissoc :map ?)] + make "map (list "map fput ? item 2 :map fput first ?rest item 3 :map) + ] +] +output :map +end + +; Returns a new list without the key-val pair set +to mal_dissoc :map [:removals] +localmake "keys [] +localmake "vals [] +(foreach item 2 :map item 3 :map [ + if not memberp ?1 :removals [ + make "keys fput ?1 :keys + make "vals fput ?2 :vals + ] +]) +output (list "map :keys :vals) +end + +to map_keys :map +output item 2 :map +end + +to map_vals :map +output item 3 :map +end + +to map_map :fn :map +output (list "map item 2 :map map :fn item 3 :map) +end + +to fn_new :args :env :body +localmake "i difference count :args 1 +if 0 < :i [if equalp symbol_new "& item :i :args [ + output (list "fn :env :body :i filter [# <> :i] :args) +]] +output (list "fn :env :body 0 :args) +end + +to fn_gen_env :fn :args +localmake "varargs item 4 :fn +if :varargs = 0 [output env_new item 2 :fn item 5 :fn :args] +if :varargs = 1 [output env_new item 2 :fn item 5 :fn (list list_new :args)] +localmake "new_args array :varargs +foreach :args [ + .setitem # :new_args ? + if :varargs = # + 1 [ + .setitem :varargs :new_args list_new ?rest + output env_new item 2 :fn item 5 :fn :new_args + ] +] +(throw "error [not enough arguments for vararg function]) +end + +to fn_apply :fn :args +output _eval item 3 :fn fn_gen_env :fn :args +end + +to fn_env :fn +output item 2 :fn +end + +to fn_body :fn +output item 3 :fn +end + +to macro_new :fn +output list "macro :fn +end + +to macro_apply :fn :args +output fn_apply item 2 :fn :args +end + +to mal_atom :value +output listtoarray list "atom :value +end + +to mal_deref :a +output item 2 :a +end + +to mal_reset! :a :val +.setitem 2 :a :val +output :val +end diff --git a/impls/lua/Dockerfile b/impls/lua/Dockerfile new file mode 100644 index 0000000000..d8d4e6cd5d --- /dev/null +++ b/impls/lua/Dockerfile @@ -0,0 +1,30 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# luarocks 3.8.0+dfsg1-1 only supports 5.1 5.2 5.3, +# and its dependencies default on 5.1 if no version is available. +# Explicitly install the desired version before luarocks. +RUN apt-get -y install liblua5.3-dev lua5.3 + +RUN apt-get -y install gcc libpcre3-dev luarocks + +# luarocks .cache directory is relative to HOME +ENV HOME /mal diff --git a/impls/lua/Makefile b/impls/lua/Makefile new file mode 100644 index 0000000000..2ed77e5c41 --- /dev/null +++ b/impls/lua/Makefile @@ -0,0 +1,34 @@ +SOURCES_BASE = utils.lua types.lua reader.lua printer.lua +SOURCES_LISP = env.lua core.lua stepA_mal.lua +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +libraries := linenoise.so rex_pcre.so +linenoise.so_package := linenoise +rex_pcre.so_package := lrexlib-pcre + +all: $(libraries) + +dist: mal.lua mal + +SOURCE_NAMES = $(patsubst %.lua,%,$(SOURCES)) +mal.lua: $(SOURCES) + echo "local $(foreach n,$(SOURCE_NAMES),$(n),) M" > $@ + echo "M={} $(foreach n,$(SOURCE_NAMES),$(n)=M);" >> $@ + cat $+ | grep -v -e "return M$$" \ + -e "return Env" \ + -e "local M =" \ + -e "^#!" \ + $(foreach n,$(SOURCE_NAMES),-e "require('$(n)')") >> $@ + +mal: mal.lua + echo "#!/usr/bin/env lua" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f $(libraries) mal.lua mal + rm -rf lib + +$(libraries): + luarocks install --tree=./ $($@_package) + find . -name $@ | xargs ln -s diff --git a/impls/lua/core.lua b/impls/lua/core.lua new file mode 100644 index 0000000000..0fa324bf4c --- /dev/null +++ b/impls/lua/core.lua @@ -0,0 +1,317 @@ +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local readline = require('readline') + +local Nil, List, HashMap, _pr_str = types.Nil, types.List, types.HashMap, printer._pr_str + +local M = {} + +-- string functions + +function pr_str(...) + return printer._pr_seq(table.pack(...), true, " ") +end + +function str(...) + return printer._pr_seq(table.pack(...), false, "") +end + +function prn(...) + print(printer._pr_seq(table.pack(...), true, " ")) + io.flush() + return Nil +end + +function println(...) + print(printer._pr_seq(table.pack(...), false, " ")) + io.flush() + return Nil +end + +function slurp(file) + local lines = {} + for line in io.lines(file) do + lines[#lines+1] = line + end + return table.concat(lines, "\n") .. "\n" +end + +function do_readline(prompt) + local line = readline.readline(prompt) + if line == nil then + return Nil + else + return line + end +end + +-- hash map functions + +function assoc(hm, ...) + return types._assoc_BANG(types.copy(hm), ...) +end + +function dissoc(hm, ...) + return types._dissoc_BANG(types.copy(hm), ...) +end + +function get(hm, key) + local res = hm[key] + if res == nil then return Nil end + return res +end + +function keys(hm) + local res = {} + for k,v in pairs(hm) do + res[#res+1] = k + end + return List:new(res) +end + +function vals(hm) + local res = {} + for k,v in pairs(hm) do + res[#res+1] = v + end + return List:new(res) +end + +-- sequential functions + +function cons(a,lst) + local new_lst = lst:slice(1) + table.insert(new_lst, 1, a) + return List:new(new_lst) +end + +function concat(...) + local arg = table.pack(...) + local new_lst = {} + for i = 1, #arg do + for j = 1, #arg[i] do + table.insert(new_lst, arg[i][j]) + end + end + return List:new(new_lst) +end + +function vec(a) + return types.Vector:new(types.copy(a)) +end + +function nth(seq, idx) + if idx+1 <= #seq then + return seq[idx+1] + else + types.throw("nth: index out of range") + end +end + +function first(a) + if #a == 0 then + return Nil + else + return a[1] + end +end + +function rest(a) + if a == Nil then + return List:new() + else + return List:new(a:slice(2)) + end +end + +function apply(f, ...) + local arg = table.pack(...) + if types._malfunc_Q(f) then + f = f.fn + end + local args = concat(types.slice(arg, 1, #arg-1), + arg[#arg]) + return f(table.unpack(args)) +end + +function map(f, lst) + if types._malfunc_Q(f) then + f = f.fn + end + return List:new(utils.map(f, lst)) +end + +-- metadata functions + +function meta(obj) + local m = getmetatable(obj) + if m == nil or m.meta == nil then return Nil end + return m.meta +end + +function with_meta(obj, meta) + local new_obj = types.copy(obj) + getmetatable(new_obj).meta = meta + return new_obj +end + +-- atom functions + +function swap_BANG(atm,f,...) + if types._malfunc_Q(f) then + f = f.fn + end + local args = List:new(table.pack(...)) + table.insert(args, 1, atm.val) + atm.val = f(table.unpack(args)) + return atm.val +end + +local function conj(obj, ...) + local arg = table.pack(...) + local new_obj = types.copy(obj) + if types._list_Q(new_obj) then + for i, v in ipairs(arg) do + table.insert(new_obj, 1, v) + end + else + for i, v in ipairs(arg) do + table.insert(new_obj, v) + end + end + return new_obj +end + +local function seq(obj, ...) + if obj == Nil or #obj == 0 then + return Nil + elseif types._list_Q(obj) then + return obj + elseif types._vector_Q(obj) then + return List:new(obj) + elseif types._string_Q(obj) then + local chars = {} + for i = 1, #obj do + chars[#chars+1] = string.sub(obj,i,i) + end + return List:new(chars) + end + return Nil +end + +local function lua_to_mal(a) + if a == nil then + return Nil + elseif type(a) == "boolean" or type(a) == "number" or type(a) == "string" then + return a + elseif type(a) == "table" then + local first_key, _ = next(a) + if first_key == nil then + return List:new({}) + elseif type(first_key) == "number" then + local list = {} + for i, v in ipairs(a) do + list[i] = lua_to_mal(v) + end + return List:new(list) + else + local hashmap = {} + for k, v in pairs(a) do + hashmap[lua_to_mal(k)] = lua_to_mal(v) + end + return HashMap:new(hashmap) + end + end + return tostring(a) +end + +local function lua_eval(str) + local f, err = load("return "..str) + if err then + types.throw("lua-eval: can't load code: "..err) + end + return lua_to_mal(f()) +end + +M.ns = { + ['='] = types._equal_Q, + throw = types.throw, + + ['nil?'] = function(a) return a==Nil end, + ['true?'] = function(a) return a==true end, + ['false?'] = function(a) return a==false end, + ['number?'] = function(a) return types._number_Q(a) end, + symbol = function(a) return types.Symbol:new(a) end, + ['symbol?'] = function(a) return types._symbol_Q(a) end, + ['string?'] = function(a) return types._string_Q(a) end, + keyword = function(a) + if types._keyword_Q(a) then + return a + else + return types._keyword_from_lua_string(a) + end + end, + ['keyword?'] = function(a) return types._keyword_Q(a) end, + ['fn?'] = function(a) return types._fn_Q(a) end, + ['macro?'] = function(a) return types._macro_Q(a) end, + + ['pr-str'] = pr_str, + str = str, + prn = prn, + println = println, + ['read-string'] = reader.read_str, + readline = do_readline, + slurp = slurp, + + ['<'] = function(a,b) return a'] = function(a,b) return a>b end, + ['>='] = function(a,b) return a>=b end, + ['+'] = function(a,b) return a+b end, + ['-'] = function(a,b) return a-b end, + ['*'] = function(a,b) return a*b end, + ['/'] = function(a,b) return math.floor(a/b) end, + ['time-ms'] = function() return math.floor(os.clock()*1000000) end, + + list = function(...) return List:new(table.pack(...)) end, + ['list?'] = function(a) return types._list_Q(a) end, + vector = function(...) return types.Vector:new(table.pack(...)) end, + ['vector?'] = types._vector_Q, + ['hash-map'] = types.hash_map, + ['map?'] = types._hash_map_Q, + assoc = assoc, + dissoc = dissoc, + get = get, + ['contains?'] = function(a,b) return a[b] ~= nil end, + keys = keys, + vals = vals, + + ['sequential?'] = types._sequential_Q, + cons = cons, + concat = concat, + vec = vec, + nth = nth, + first = first, + rest = rest, + ['empty?'] = function(a) return a==Nil or #a == 0 end, + count = function(a) return #a end, + apply = apply, + map = map, + conj = conj, + seq = seq, + + meta = meta, + ['with-meta'] = with_meta, + atom = function(a) return types.Atom:new(a) end, + ['atom?'] = types._atom_Q, + deref = function(a) return a.val end, + ['reset!'] = function(a,b) a.val = b; return b end, + ['swap!'] = swap_BANG, + + ['lua-eval'] = lua_eval, +} + +return M + diff --git a/impls/lua/env.lua b/impls/lua/env.lua new file mode 100644 index 0000000000..4b318e5b4f --- /dev/null +++ b/impls/lua/env.lua @@ -0,0 +1,56 @@ +local table = require('table') +local types = require('types') +local printer = require('printer') + +local Env = {} + +function Env:new(outer, binds, exprs) + -- binds is a MAL sequence of MAL symbols + -- exprs is an LUA table of MAL forms + local data = {} + local newObj = {outer = outer, data = data} + self.__index = self + if binds then + for i, b in ipairs(binds) do + if binds[i].val == '&' then + data[binds[i+1].val] = types.List.slice(exprs, i) + break + end + data[binds[i].val] = exprs[i] + end + end + return setmetatable(newObj, self) +end + +function Env:get(sym) + -- sym is an LUA string + -- returns nil if the key is not found + local env = self + local result + while true do + result = env.data[sym] + if result ~= nil then return result end + env = env.outer + if env == nil then return nil end + end +end + +function Env:set(sym,val) + -- sym is an LUA string + self.data[sym] = val + return val +end + +function Env:debug() + local env = self + while env.outer ~=nil do + line = ' ENV:' + for k, v in pairs(env.data) do + line = line .. ' ' .. k .. '=' .. printer._pr_str(v) + end + print(line) + env = env.outer + end +end + +return Env diff --git a/impls/lua/printer.lua b/impls/lua/printer.lua new file mode 100644 index 0000000000..1892fba3ef --- /dev/null +++ b/impls/lua/printer.lua @@ -0,0 +1,57 @@ +local string = require('string') +local table = require('table') +local types = require('types') +local utils = require('utils') + +local M = {} + +function M._pr_str(obj, print_readably) + if utils.instanceOf(obj, types.Symbol) then + return obj.val + elseif types._list_Q(obj) then + return "(" .. M._pr_seq(obj, print_readably, " ") .. ")" + elseif types._vector_Q(obj) then + return "[" .. M._pr_seq(obj, print_readably, " ") .. "]" + elseif types._hash_map_Q(obj) then + local res = {} + for k,v in pairs(obj) do + res[#res+1] = M._pr_str(k, print_readably) + res[#res+1] = M._pr_str(v, print_readably) + end + return "{".. table.concat(res, " ").."}" + elseif types._keyword_Q(obj) then + return ':' .. types._lua_string_from_keyword(obj) + elseif types._string_Q(obj) then + if print_readably then + local sval = obj:gsub('\\', '\\\\') + sval = sval:gsub('"', '\\"') + sval = sval:gsub('\n', '\\n') + return '"' .. sval .. '"' + else + return obj + end + elseif obj == types.Nil then + return "nil" + elseif obj == true then + return "true" + elseif obj == false then + return "false" + elseif types._malfunc_Q(obj) then + return "(fn* "..M._pr_str(obj.params).." "..M._pr_str(obj.ast)..")" + elseif types._atom_Q(obj) then + return "(atom "..M._pr_str(obj.val)..")" + elseif type(obj) == 'function' or types._functionref_Q(obj) then + return "#" + else + return string.format("%s", obj) + end +end + +function M._pr_seq(obj, print_readably, separator) + return table.concat( + utils.map(function(e) return M._pr_str(e,print_readably) end, + obj), + separator) +end + +return M diff --git a/lua/reader.lua b/impls/lua/reader.lua similarity index 89% rename from lua/reader.lua rename to impls/lua/reader.lua index 2d29a52088..d2e780f970 100644 --- a/lua/reader.lua +++ b/impls/lua/reader.lua @@ -24,7 +24,7 @@ end function M.tokenize(str) local results = {} local re_pos = 1 - local re = rex.new("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)", rex.flags().EXTENDED) + local re = rex.new("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)", rex.flags().EXTENDED) while true do local s, e, t = re:exec(str, re_pos) if not s or s > e then break end @@ -40,16 +40,21 @@ end function M.read_atom(rdr) local int_re = rex.new("^-?[0-9]+$") local float_re = rex.new("^-?[0-9][0-9.]*$") + local string_re = rex.new("^\"(?:\\\\.|[^\\\\\"])*\"$") local token = rdr:next() if int_re:exec(token) then return tonumber(token) elseif float_re:exec(token) then return tonumber(token) - elseif string.sub(token,1,1) == '"' then + elseif string_re:exec(token) then local sval = string.sub(token,2,string.len(token)-1) + sval = string.gsub(sval, '\\\\', '\u{029e}') sval = string.gsub(sval, '\\"', '"') sval = string.gsub(sval, '\\n', '\n') + sval = string.gsub(sval, '\u{029e}', '\\') return sval + elseif string.sub(token,1,1) == '"' then + throw("expected '\"', got EOF") elseif string.sub(token,1,1) == ':' then - return "\177" .. string.sub(token,2) + return types._keyword_from_lua_string(string.sub(token,2)) elseif token == "nil" then return Nil elseif token == "true" then return true elseif token == "false" then return false @@ -82,7 +87,7 @@ end function M.read_hash_map(rdr) local seq = M.read_sequence(rdr, '{', '}') - return types._assoc_BANG(types.HashMap:new(), unpack(seq)) + return types.hash_map(table.unpack(seq)) end function M.read_form(rdr) diff --git a/impls/lua/readline.lua b/impls/lua/readline.lua new file mode 100644 index 0000000000..ba390a7f7b --- /dev/null +++ b/impls/lua/readline.lua @@ -0,0 +1,41 @@ +local LN = require('linenoise') + +local M = {} + +local history_loaded = false +local history_file = os.getenv("HOME") .. "/.mal-history" + +M.raw = false + +function M.readline(prompt) + if not history_loaded then + history_loaded = true + xpcall(function() + for line in io.lines(history_file) do + LN.historyadd(line) + end + end, function(exc) + return true -- ignore the error + end) + end + + if M.raw then + io.write(prompt); io.flush(); + line = io.read() + else + line = LN.linenoise(prompt) + end + if line then + LN.historyadd(line) + xpcall(function() + local f = io.open(history_file, "a") + f:write(line.."\n") + f:close() + end, function(exc) + return true -- ignore the error + end) + end + return line +end + +return M diff --git a/impls/lua/run b/impls/lua/run new file mode 100755 index 0000000000..a53fbc60ba --- /dev/null +++ b/impls/lua/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec lua $(dirname $0)/${STEP:-stepA_mal}.lua "${@}" diff --git a/lua/step0_repl.lua b/impls/lua/step0_repl.lua similarity index 83% rename from lua/step0_repl.lua rename to impls/lua/step0_repl.lua index 24584d2e82..bb082a599d 100755 --- a/lua/step0_repl.lua +++ b/impls/lua/step0_repl.lua @@ -18,6 +18,10 @@ function rep(str) return PRINT(EVAL(READ(str),"")) end +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true +end + while true do line = readline.readline("user> ") if not line then break end diff --git a/lua/step1_read_print.lua b/impls/lua/step1_read_print.lua similarity index 96% rename from lua/step1_read_print.lua rename to impls/lua/step1_read_print.lua index 46d71f5cac..78cde8c1fe 100755 --- a/lua/step1_read_print.lua +++ b/impls/lua/step1_read_print.lua @@ -1,7 +1,7 @@ #!/usr/bin/env lua local readline = require('readline') -local utils = require('utils') +local types = require('types') local reader = require('reader') local printer = require('printer') diff --git a/lua/step2_eval.lua b/impls/lua/step2_eval.lua similarity index 80% rename from lua/step2_eval.lua rename to impls/lua/step2_eval.lua index 22ac8cffc9..0bb44d2a26 100755 --- a/lua/step2_eval.lua +++ b/impls/lua/step2_eval.lua @@ -15,33 +15,32 @@ function READ(str) end -- eval -function eval_ast(ast, env) + +function EVAL(ast, env) + + -- print("EVAL: " .. printer._pr_str(ast, true)) + if types._symbol_Q(ast) then if env[ast.val] == nil then types.throw("'"..ast.val.."' not found") end return env[ast.val] - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) + new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) - else + elseif not types._list_Q(ast) or #ast == 0 then return ast end -end -function EVAL(ast, env) - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - return f(unpack(args)) + local f = EVAL(ast[1], env) + local args = types.slice(ast, 2) + args = utils.map(function(x) return EVAL(x,env) end, args) + return f(table.unpack(args)) end -- print diff --git a/impls/lua/step3_env.lua b/impls/lua/step3_env.lua new file mode 100755 index 0000000000..297083deed --- /dev/null +++ b/impls/lua/step3_env.lua @@ -0,0 +1,98 @@ +#!/usr/bin/env lua + +local table = require('table') + +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval + +function EVAL(ast, env) + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + local a0,a1,a2 = ast[1], ast[2],ast[3] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + return EVAL(a2, let_env) + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + args = utils.map(function(x) return EVAL(x,env) end, args) + return f(table.unpack(args)) + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +repl_env:set('+', function(a,b) return a+b end) +repl_env:set('-', function(a,b) return a-b end) +repl_env:set('*', function(a,b) return a*b end) +repl_env:set('/', function(a,b) return math.floor(a/b) end) + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true +end + +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() + print(rep(line)) + end, function(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end + end) +end diff --git a/impls/lua/step4_if_fn_do.lua b/impls/lua/step4_if_fn_do.lua new file mode 100755 index 0000000000..f69c2379ed --- /dev/null +++ b/impls/lua/step4_if_fn_do.lua @@ -0,0 +1,116 @@ +#!/usr/bin/env lua + +local table = require('table') + +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local core = require('core') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval + +function EVAL(ast, env) + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + return EVAL(a2, let_env) + elseif 'do' == a0sym then + local el = utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2)) + return el[#el] + elseif 'if' == a0sym then + local cond = EVAL(a1, env) + if cond == types.Nil or cond == false then + if #ast > 3 then return EVAL(a3, env) else return types.Nil end + else + return EVAL(a2, env) + end + elseif 'fn*' == a0sym then + return function(...) + return EVAL(a2, Env:new(env, a1, table.pack(...))) + end + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + args = utils.map(function(x) return EVAL(x,env) end, args) + return f(table.unpack(args)) + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +-- core.lua: defined using Lua +for k,v in pairs(core.ns) do + repl_env:set(k, v) +end + +-- core.mal: defined using mal +rep("(def! not (fn* (a) (if a false true)))") + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true +end + +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() + print(rep(line)) + end, function(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end + end) +end diff --git a/impls/lua/step5_tco.lua b/impls/lua/step5_tco.lua new file mode 100755 index 0000000000..923a148357 --- /dev/null +++ b/impls/lua/step5_tco.lua @@ -0,0 +1,124 @@ +#!/usr/bin/env lua + +local table = require('table') + +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local core = require('core') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval + +function EVAL(ast, env) + while true do + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + env = let_env + ast = a2 -- TCO + elseif 'do' == a0sym then + utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) + ast = ast[#ast] -- TCO + elseif 'if' == a0sym then + local cond = EVAL(a1, env) + if cond == types.Nil or cond == false then + if #ast > 3 then ast = a3 else return types.Nil end -- TCO + else + ast = a2 -- TCO + end + elseif 'fn*' == a0sym then + return types.MalFunc:new(function(...) + return EVAL(a2, Env:new(env, a1, table.pack(...))) + end, a2, env, a1) + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + args = utils.map(function(x) return EVAL(x,env) end, args) + if types._malfunc_Q(f) then + ast = f.ast + env = Env:new(f.env, f.params, args) -- TCO + else + return f(table.unpack(args)) + end + end + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +-- core.lua: defined using Lua +for k,v in pairs(core.ns) do + repl_env:set(k, v) +end + +-- core.mal: defined using mal +rep("(def! not (fn* (a) (if a false true)))") + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true +end + +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() + print(rep(line)) + end, function(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end + end) +end diff --git a/impls/lua/step6_file.lua b/impls/lua/step6_file.lua new file mode 100755 index 0000000000..2f5abf7d57 --- /dev/null +++ b/impls/lua/step6_file.lua @@ -0,0 +1,134 @@ +#!/usr/bin/env lua + +local table = require('table') + +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local core = require('core') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval + +function EVAL(ast, env) + while true do + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + env = let_env + ast = a2 -- TCO + elseif 'do' == a0sym then + utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) + ast = ast[#ast] -- TCO + elseif 'if' == a0sym then + local cond = EVAL(a1, env) + if cond == types.Nil or cond == false then + if #ast > 3 then ast = a3 else return types.Nil end -- TCO + else + ast = a2 -- TCO + end + elseif 'fn*' == a0sym then + return types.MalFunc:new(function(...) + return EVAL(a2, Env:new(env, a1, table.pack(...))) + end, a2, env, a1) + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + args = utils.map(function(x) return EVAL(x,env) end, args) + if types._malfunc_Q(f) then + ast = f.ast + env = Env:new(f.env, f.params, args) -- TCO + else + return f(table.unpack(args)) + end + end + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +-- core.lua: defined using Lua +for k,v in pairs(core.ns) do + repl_env:set(k, v) +end +repl_env:set('eval', + function(ast) return EVAL(ast, repl_env) end) +repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) + +-- core.mal: defined using mal +rep("(def! not (fn* (a) (if a false true)))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true + table.remove(arg,1) +end + +if #arg > 0 then + rep("(load-file \""..arg[1].."\")") + os.exit(0) +end + +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() + print(rep(line)) + end, function(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end + end) +end diff --git a/impls/lua/step7_quote.lua b/impls/lua/step7_quote.lua new file mode 100755 index 0000000000..67de77665f --- /dev/null +++ b/impls/lua/step7_quote.lua @@ -0,0 +1,170 @@ +#!/usr/bin/env lua + +local table = require('table') + +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local core = require('core') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc +end + +function quasiquote(ast) + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then + return types.List:new({types.Symbol:new("quote"), ast}) + else + return ast + end +end + +function EVAL(ast, env) + while true do + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + env = let_env + ast = a2 -- TCO + elseif 'quote' == a0sym then + return a1 + elseif 'quasiquote' == a0sym then + ast = quasiquote(a1) -- TCO + elseif 'do' == a0sym then + utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) + ast = ast[#ast] -- TCO + elseif 'if' == a0sym then + local cond = EVAL(a1, env) + if cond == types.Nil or cond == false then + if #ast > 3 then ast = a3 else return types.Nil end -- TCO + else + ast = a2 -- TCO + end + elseif 'fn*' == a0sym then + return types.MalFunc:new(function(...) + return EVAL(a2, Env:new(env, a1, table.pack(...))) + end, a2, env, a1) + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + args = utils.map(function(x) return EVAL(x,env) end, args) + if types._malfunc_Q(f) then + ast = f.ast + env = Env:new(f.env, f.params, args) -- TCO + else + return f(table.unpack(args)) + end + end + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +-- core.lua: defined using Lua +for k,v in pairs(core.ns) do + repl_env:set(k, v) +end +repl_env:set('eval', + function(ast) return EVAL(ast, repl_env) end) +repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) + +-- core.mal: defined using mal +rep("(def! not (fn* (a) (if a false true)))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true + table.remove(arg,1) +end + +if #arg > 0 then + rep("(load-file \""..arg[1].."\")") + os.exit(0) +end + +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() + print(rep(line)) + end, function(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end + end) +end diff --git a/impls/lua/step8_macros.lua b/impls/lua/step8_macros.lua new file mode 100755 index 0000000000..ce12dc864e --- /dev/null +++ b/impls/lua/step8_macros.lua @@ -0,0 +1,181 @@ +#!/usr/bin/env lua + +local table = require('table') + +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local core = require('core') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc +end + +function quasiquote(ast) + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then + return types.List:new({types.Symbol:new("quote"), ast}) + else + return ast + end +end + +function EVAL(ast, env) + while true do + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + -- apply list + + local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + env = let_env + ast = a2 -- TCO + elseif 'quote' == a0sym then + return a1 + elseif 'quasiquote' == a0sym then + ast = quasiquote(a1) -- TCO + elseif 'defmacro!' == a0sym then + local mac = types.copy(EVAL(a2, env)) + mac.ismacro = true + return env:set(a1.val, mac) + elseif 'do' == a0sym then + utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) + ast = ast[#ast] -- TCO + elseif 'if' == a0sym then + local cond = EVAL(a1, env) + if cond == types.Nil or cond == false then + if #ast > 3 then ast = a3 else return types.Nil end -- TCO + else + ast = a2 -- TCO + end + elseif 'fn*' == a0sym then + return types.MalFunc:new(function(...) + return EVAL(a2, Env:new(env, a1, table.pack(...))) + end, a2, env, a1) + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + if types._macro_Q(f) then + ast = f.fn(table.unpack(args)) -- TCO + else + args = utils.map(function(x) return EVAL(x,env) end, args) + if types._malfunc_Q(f) then + ast = f.ast + env = Env:new(f.env, f.params, args) -- TCO + else + return f(table.unpack(args)) + end + end + end + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +-- core.lua: defined using Lua +for k,v in pairs(core.ns) do + repl_env:set(k, v) +end +repl_env:set('eval', + function(ast) return EVAL(ast, repl_env) end) +repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) + +-- core.mal: defined using mal +rep("(def! not (fn* (a) (if a false true)))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true + table.remove(arg,1) +end + +if #arg > 0 then + rep("(load-file \""..arg[1].."\")") + os.exit(0) +end + +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() + print(rep(line)) + end, function(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end + end) +end diff --git a/impls/lua/step9_try.lua b/impls/lua/step9_try.lua new file mode 100755 index 0000000000..a6fe507d5f --- /dev/null +++ b/impls/lua/step9_try.lua @@ -0,0 +1,202 @@ +#!/usr/bin/env lua + +local table = require('table') + +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local core = require('core') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc +end + +function quasiquote(ast) + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then + return types.List:new({types.Symbol:new("quote"), ast}) + else + return ast + end +end + +function EVAL(ast, env) + while true do + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + -- apply list + + local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + env = let_env + ast = a2 -- TCO + elseif 'quote' == a0sym then + return a1 + elseif 'quasiquote' == a0sym then + ast = quasiquote(a1) -- TCO + elseif 'defmacro!' == a0sym then + local mac = types.copy(EVAL(a2, env)) + mac.ismacro = true + return env:set(a1.val, mac) + elseif 'try*' == a0sym then + if a2 == nil or a2[1].val ~= 'catch*' then + ast = a1 -- TCO + else + local exc, result = nil, nil + xpcall(function() + result = EVAL(a1, env) + end, function(err) + exc = err + end) + if exc == nil then + return result + else + if types._malexception_Q(exc) then + exc = exc.val + end + ast, env = a2[3], Env:new(env, {a2[2]}, {exc}) -- TCO + end + end + elseif 'do' == a0sym then + utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) + ast = ast[#ast] -- TCO + elseif 'if' == a0sym then + local cond = EVAL(a1, env) + if cond == types.Nil or cond == false then + if #ast > 3 then ast = a3 else return types.Nil end -- TCO + else + ast = a2 -- TCO + end + elseif 'fn*' == a0sym then + return types.MalFunc:new(function(...) + return EVAL(a2, Env:new(env, a1, table.pack(...))) + end, a2, env, a1) + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + if types._macro_Q(f) then + ast = f.fn(table.unpack(args)) -- TCO + else + args = utils.map(function(x) return EVAL(x,env) end, args) + if types._malfunc_Q(f) then + ast = f.ast + env = Env:new(f.env, f.params, args) -- TCO + else + return f(table.unpack(args)) + end + end + end + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +-- core.lua: defined using Lua +for k,v in pairs(core.ns) do + repl_env:set(k, v) +end +repl_env:set('eval', + function(ast) return EVAL(ast, repl_env) end) +repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) + +-- core.mal: defined using mal +rep("(def! not (fn* (a) (if a false true)))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +function print_exception(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end +end + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true + table.remove(arg,1) +end + +if #arg > 0 then + xpcall(function() rep("(load-file \""..arg[1].."\")") end, + print_exception) + os.exit(0) +end + +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() print(rep(line)) end, + print_exception) +end diff --git a/impls/lua/stepA_mal.lua b/impls/lua/stepA_mal.lua new file mode 100755 index 0000000000..242b1cdda4 --- /dev/null +++ b/impls/lua/stepA_mal.lua @@ -0,0 +1,205 @@ +#!/usr/bin/env lua + +local table = require('table') + +package.path = '../lua/?.lua;' .. package.path +local readline = require('readline') +local utils = require('utils') +local types = require('types') +local reader = require('reader') +local printer = require('printer') +local Env = require('env') +local core = require('core') +local List, Vector, HashMap = types.List, types.Vector, types.HashMap + +-- read +function READ(str) + return reader.read_str(str) +end + +-- eval +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc +end + +function quasiquote(ast) + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then + return types.List:new({types.Symbol:new("quote"), ast}) + else + return ast + end +end + +function EVAL(ast, env) + while true do + + local dbgeval = env:get("DEBUG-EVAL") + if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then + print("EVAL: " .. printer._pr_str(ast, true)) + env:debug() + end + + if types._symbol_Q(ast) then + local result = env:get(ast.val) + if result == nil then + types.throw("'" .. ast.val .. "' not found") + end + return result + elseif types._vector_Q(ast) then + return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) + elseif types._hash_map_Q(ast) then + local new_hm = {} + for k,v in pairs(ast) do + new_hm[k] = EVAL(v, env) + end + return HashMap:new(new_hm) + elseif not types._list_Q(ast) or #ast == 0 then + return ast + end + + -- apply list + + local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] + local a0sym = types._symbol_Q(a0) and a0.val or "" + if 'def!' == a0sym then + return env:set(a1.val, EVAL(a2, env)) + elseif 'let*' == a0sym then + local let_env = Env:new(env) + for i = 1,#a1,2 do + let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) + end + env = let_env + ast = a2 -- TCO + elseif 'quote' == a0sym then + return a1 + elseif 'quasiquote' == a0sym then + ast = quasiquote(a1) -- TCO + elseif 'defmacro!' == a0sym then + local mac = types.copy(EVAL(a2, env)) + mac.ismacro = true + return env:set(a1.val, mac) + elseif 'try*' == a0sym then + if a2 == nil or a2[1].val ~= 'catch*' then + ast = a1 -- TCO + else + local exc, result = nil, nil + xpcall(function() + result = EVAL(a1, env) + end, function(err) + exc = err + end) + if exc == nil then + return result + else + if types._malexception_Q(exc) then + exc = exc.val + end + ast, env = a2[3], Env:new(env, {a2[2]}, {exc}) -- TCO + end + end + elseif 'do' == a0sym then + utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) + ast = ast[#ast] -- TCO + elseif 'if' == a0sym then + local cond = EVAL(a1, env) + if cond == types.Nil or cond == false then + if #ast > 3 then ast = a3 else return types.Nil end -- TCO + else + ast = a2 -- TCO + end + elseif 'fn*' == a0sym then + return types.MalFunc:new(function(...) + return EVAL(a2, Env:new(env, a1, table.pack(...))) + end, a2, env, a1) + else + local f = EVAL(a0, env) + local args = types.slice(ast, 2) + if types._macro_Q(f) then + ast = f.fn(table.unpack(args)) -- TCO + else + args = utils.map(function(x) return EVAL(x,env) end, args) + if types._malfunc_Q(f) then + ast = f.ast + env = Env:new(f.env, f.params, args) -- TCO + else + return f(table.unpack(args)) + end + end + end + end +end + +-- print +function PRINT(exp) + return printer._pr_str(exp, true) +end + +-- repl +local repl_env = Env:new() +function rep(str) + return PRINT(EVAL(READ(str),repl_env)) +end + +-- core.lua: defined using Lua +for k,v in pairs(core.ns) do + repl_env:set(k, v) +end +repl_env:set('eval', + function(ast) return EVAL(ast, repl_env) end) +repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) + +-- core.mal: defined using mal +rep("(def! *host-language* \"lua\")") +rep("(def! not (fn* (a) (if a false true)))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +function print_exception(exc) + if exc then + if types._malexception_Q(exc) then + exc = printer._pr_str(exc.val, true) + end + print("Error: " .. exc) + print(debug.traceback()) + end +end + +if #arg > 0 and arg[1] == "--raw" then + readline.raw = true + table.remove(arg,1) +end + +if #arg > 0 then + xpcall(function() rep("(load-file \""..arg[1].."\")") end, + print_exception) + os.exit(0) +end + +rep("(println (str \"Mal [\" *host-language* \"]\"))") +while true do + line = readline.readline("user> ") + if not line then break end + xpcall(function() print(rep(line)) end, + print_exception) +end diff --git a/impls/lua/tests/step5_tco.mal b/impls/lua/tests/step5_tco.mal new file mode 100644 index 0000000000..087368335f --- /dev/null +++ b/impls/lua/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 100000)) +res1 +;=>nil diff --git a/impls/lua/tests/stepA_mal.mal b/impls/lua/tests/stepA_mal.mal new file mode 100644 index 0000000000..70a142315d --- /dev/null +++ b/impls/lua/tests/stepA_mal.mal @@ -0,0 +1,38 @@ +;; Testing basic Lua interop + +;;; lua-eval adds the string "return " to the beginning of the evaluated string +;;; and supplies that to Lua's loadstring(). If complex programs are needed, +;;; those can be wrapped by an anonymous function which is called immediately +;;; (see the foo = 8 example below). + +(lua-eval "7") +;=>7 + +(lua-eval "'7'") +;=>"7" + +(lua-eval "123 == 123") +;=>true + +(lua-eval "123 == 456") +;=>false + +(lua-eval "{7,8,9}") +;=>(7 8 9) + +(lua-eval "{abc = 789}") +;=>{"abc" 789} + +(lua-eval "print('hello')") +;/hello +;=>nil + +(lua-eval "(function() foo = 8 end)()") +(lua-eval "foo") +;=>8 + +(lua-eval "string.gsub('This sentence has five words', '%w+', function(w) return '*'..#w..'*' end)") +;=>"*4* *8* *3* *4* *5*" + +(lua-eval "table.concat({3, 'a', 45, 'b'}, '|')") +;=>"3|a|45|b" diff --git a/impls/lua/types.lua b/impls/lua/types.lua new file mode 100644 index 0000000000..9ee00e4950 --- /dev/null +++ b/impls/lua/types.lua @@ -0,0 +1,241 @@ +local utils = require('utils') + +local M = {} + +-- type functions + +function M._sequential_Q(obj) + return M._list_Q(obj) or M._vector_Q(obj) +end + +function M._equal_Q(a,b) + if M._symbol_Q(a) and M._symbol_Q(b) then + return a.val == b.val + elseif M._sequential_Q(a) and M._sequential_Q(b) then + if #a ~= #b then return false end + for i, v in ipairs(a) do + if not M._equal_Q(v,b[i]) then return false end + end + return true + elseif M._hash_map_Q(a) and M._hash_map_Q(b) then + if #a ~= #b then return false end + for k, v in pairs(a) do + if not M._equal_Q(v,b[k]) then return false end + end + return true + else + return a == b + end +end + +function M.copy(obj) + if type(obj) == "function" then + return M.FunctionRef:new(obj) + end + if type(obj) ~= "table" then return obj end + + -- copy object data + local new_obj = {} + for k,v in pairs(obj) do + new_obj[k] = v + end + + -- copy metatable and link to original + local old_mt = getmetatable(obj) + if old_mt ~= nil then + local new_mt = {} + for k,v in pairs(old_mt) do + new_mt[k] = v + end + setmetatable(new_mt, old_mt) + setmetatable(new_obj, new_mt) + end + + return new_obj +end + +function M.slice(lst, start, last) + if last == nil then last = #lst end + local new_lst = {} + if start <= last then + for i = start, last do + new_lst[#new_lst+1] = lst[i] + end + end + return new_lst +end + +-- Error/exceptions + +M.MalException = {} +function M.MalException:new(val) + local newObj = {val = val} + self.__index = self + return setmetatable(newObj, self) +end +function M._malexception_Q(obj) + return utils.instanceOf(obj, M.MalException) +end + +function M.throw(val) + error(M.MalException:new(val)) +end + +-- Nil + +local NilType = {} +function NilType:new(val) + local newObj = {} + self.__index = self + return setmetatable(newObj, self) +end +M.Nil = NilType:new() +function M._nil_Q(obj) + return obj == Nil +end + +-- Numbers +function M._number_Q(obj) + return type(obj) == "number" +end + +-- Strings +function M._string_Q(obj) + return type(obj) == "string" and "\u{029e}" ~= string.sub(obj,1,2) +end + +-- Symbols + +M.Symbol = {} +function M.Symbol:new(val) + local newObj = {val = val} + self.__index = self + return setmetatable(newObj, self) +end +function M._symbol_Q(obj) + return utils.instanceOf(obj, M.Symbol) +end + +-- Keywords +-- 5.1 does not support unicode escapes. Their length vary between 5.3 and 5.4. +_keyword_mark = "\u{029e}" -- Two bytes. +_keyword_mark_len = string.len(_keyword_mark) + +function M._keyword_Q(obj) + return type(obj) == "string" and _keyword_mark == string.sub(obj,1,_keyword_mark_len) +end + +function M._keyword_from_lua_string(value) + return _keyword_mark .. value +end + +function M._lua_string_from_keyword(obj) + return string.sub(obj, _keyword_mark_len + 1) +end + + +-- Lists + +M.List = {} +function M.List:new(lst) + local newObj = lst and lst or {} + self.__index = self + return setmetatable(newObj, self) +end +function M._list_Q(obj) + return utils.instanceOf(obj, M.List) +end +function M.List:slice(start,last) + return M.List:new(M.slice(self,start,last)) +end + +-- Vectors + +M.Vector = {} +function M.Vector:new(lst) + local newObj = lst and lst or {} + self.__index = self + return setmetatable(newObj, self) +end +function M._vector_Q(obj) + return utils.instanceOf(obj, M.Vector) +end +function M.Vector:slice(start,last) + return M.Vector:new(M.slice(self,start,last)) +end + +-- Hash Maps +-- +M.HashMap = {} +function M.HashMap:new(val) + local newObj = val and val or {} + self.__index = self + return setmetatable(newObj, self) +end +function M.hash_map(...) + return M._assoc_BANG(M.HashMap:new(), ...) +end +function M._hash_map_Q(obj) + return utils.instanceOf(obj, M.HashMap) +end +function M._assoc_BANG(hm, ...) + local arg = table.pack(...) + for i = 1, #arg, 2 do + hm[arg[i]] = arg[i+1] + end + return hm +end +function M._dissoc_BANG(hm, ...) + local arg = table.pack(...) + for i = 1, #arg do + hm[arg[i]] = nil + end + return hm +end + +-- Functions + +M.MalFunc = {} +function M.MalFunc:new(fn, ast, env, params) + local newObj = {fn = fn, ast = ast, env = env, + params = params, ismacro = false} + self.__index = self + return setmetatable(newObj, self) +end +function M._malfunc_Q(obj) + return utils.instanceOf(obj, M.MalFunc) +end +function M._fn_Q(obj) + return type(obj) == "function" or (M._malfunc_Q(obj) and not obj.ismacro) +end +function M._macro_Q(obj) + return M._malfunc_Q(obj) and obj.ismacro +end + +-- Atoms + +M.Atom = {} +function M.Atom:new(val) + local newObj = {val = val} + self.__index = self + return setmetatable(newObj, self) +end +function M._atom_Q(obj) + return utils.instanceOf(obj, M.Atom) +end + +-- FunctionRefs + +M.FunctionRef = {} +function M.FunctionRef:new(fn) + local newObj = {fn = fn} + return setmetatable(newObj, self) +end +function M._functionref_Q(obj) + return utils.instanceOf(obj, M.FunctionRef) +end +function M.FunctionRef:__call(...) + return self.fn(...) +end + +return M diff --git a/lua/utils.lua b/impls/lua/utils.lua similarity index 100% rename from lua/utils.lua rename to impls/lua/utils.lua diff --git a/impls/make/Dockerfile b/impls/make/Dockerfile new file mode 100644 index 0000000000..aa240653b3 --- /dev/null +++ b/impls/make/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Nothing additional needed for make diff --git a/impls/make/Makefile b/impls/make/Makefile new file mode 100644 index 0000000000..f8a16ebb1c --- /dev/null +++ b/impls/make/Makefile @@ -0,0 +1,31 @@ + +TESTS = tests/types.mk tests/reader.mk tests/stepA_mal.mk + +SOURCES_BASE = util.mk numbers.mk readline.mk gmsl.mk types.mk \ + reader.mk printer.mk +SOURCES_LISP = env.mk core.mk stepA_mal.mk +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.mk mal + +mal.mk: $(SOURCES) + cat $+ | grep -v "^include " > $@ + +mal: mal.mk + echo "#!/usr/bin/make -f" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.mk mal + +.PHONY: tests $(TESTS) + +tests: $(TESTS) + +$(TESTS): + @echo "Running $@"; \ + make -f $@ || exit 1; \ diff --git a/impls/make/README b/impls/make/README new file mode 100644 index 0000000000..09ee22b55d --- /dev/null +++ b/impls/make/README @@ -0,0 +1,11 @@ +It is often useful to add $(warning /$0/ /$1/ /$2/ /$3/) at the very +start of each interesting macro. + +Recal that foreach does nothing when the list only contains spaces, +and adds spaces between the results even if some results are empty. + +If debugging the reader: +# export READER_DEBUG=1 + +In order to get the equivalent of DEBUG_EVAL in step2: +# export EVAL_DEBUG=1 diff --git a/impls/make/core.mk b/impls/make/core.mk new file mode 100644 index 0000000000..1442f049dd --- /dev/null +++ b/impls/make/core.mk @@ -0,0 +1,201 @@ +# +# mal (Make a Lisp) Core functions +# + +ifndef __mal_core_included +__mal_core_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk + + +# General functions + +$(encoded_equal) = $(if $(call _equal?,$(firstword $1),$(lastword $1)),$(__true),$(__false)) + + +# Scalar functions +nil? = $(if $(_nil?),$(__true),$(__false)) +true? = $(if $(_true?),$(__true),$(__false)) +false? = $(if $(_false?),$(__true),$(__false)) + + +# Symbol functions +symbol = $(call _symbol,$(_string_val)) +symbol? = $(if $(_symbol?),$(__true),$(__false)) + +# Keyword functions +keyword = $(if $(_keyword?),$1,$(call _keyword,$(_string_val))) +keyword? = $(if $(_keyword?),$(__true),$(__false)) + + +# Number functions +number? = $(if $(_number?),$(__true),$(__false)) + +define < +$(if $(call int_lt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define <$(encoded_equal) +$(if $(call int_lte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define > +$(if $(call int_gt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define >$(encoded_equal) +$(if $(call int_gte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef + ++ = $(call _number,$(call int_add,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +- = $(call _number,$(call int_sub,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +* = $(call _number,$(call int_mult,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +/ = $(call _number,$(call int_div,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) + +time-ms = $(call _number,$(shell date +%s%3N)) + +# String functions + +string? = $(if $(_string?),$(__true),$(__false)) + +pr-str = $(call _string,$(call _pr_str_mult,$1,yes,$(_SP))) +str = $(call _string,$(_pr_str_mult)) +prn = $(__nil)$(call print,$(call _pr_str_mult,$1,yes,$(_SP))) +println = $(__nil)$(call print,$(call _pr_str_mult,$1,,$(_SP))) + +readline = $(or $(foreach res,$(call READLINE,$(_string_val))\ + ,$(call _string,$(res:ok=)))\ + ,$(__nil)) +read-string = $(call READ_STR,$(_string_val)) +slurp = $(call _string,$(call _read_file,$(_string_val))) + + + +# Function functions +fn? = $(if $(_fn?),$(__true),$(__false)) +macro? = $(if $(_macro?),$(__true),$(__false)) + + +# List functions +list? = $(if $(_list?),$(__true),$(__false)) + + +# Vector functions +vector? = $(if $(_vector?),$(__true),$(__false)) + +vec = $(if $(_list?)\ + ,$(call vector,$(_seq_vals))$(rem \ +),$(if $(_vector?)\ + ,$1$(rem \ +),$(call _error,vec$(encoded_colon)$(_SP)called$(_SP)on$(_SP)non-sequence))) + + +# Hash map (associative array) functions +hash-map = $(call _map_new,,$1) +map? = $(if $(_hash_map?),$(__true),$(__false)) + +# set a key/value in a copy of the hash map +assoc = $(call _map_new,$(firstword $1),$(_rest)) + +# unset keys in a copy of the hash map +dissoc = $(call _map_new,$(firstword $1),,$(_rest)) + +keys = $(call list,$(_keys)) + +vals = $(call list,$(foreach k,$(_keys),$(call _get,$1,$k))) + +# retrieve the value of a string key object from the hash map, or +# return nil if the key is not found. +get = $(or $(call _get,$(firstword $1),$(lastword $1)),$(__nil)) + +contains? = $(if $(call _get,$(firstword $1),$(lastword $1)),$(__true),$(__false)) + + +# sequence operations + +sequential? = $(if $(_sequential?),$(__true),$(__false)) + +# Strip in case seq_vals is empty. +cons = $(call list,$(strip $(firstword $1) $(call _seq_vals,$(lastword $1)))) + +# Strip in case foreach introduces a space after an empty argument. +concat = $(call list,$(strip $(foreach l,$1,$(call _seq_vals,$l)))) + +nth = $(or $(word $(call int_add,1,$(call _number_val,$(lastword $1))),\ + $(call _seq_vals,$(firstword $1)))\ + ,$(call _error,nth: index out of range)) + +first = $(or $(if $(_sequential?),$(firstword $(_seq_vals))),$(__nil)) + +empty? = $(if $(_seq_vals),$(__false),$(__true)) + +count = $(call _number,$(words $(if $(_sequential?),$(_seq_vals)))) + +# Creates a new vector/list of the everything after but the first +# element +rest = $(call list,$(if $(_sequential?),$(call _rest,$(_seq_vals)))) + +# Takes a space separated arguments and invokes the first argument +# (function object) using the remaining arguments. +# Strip in case wordlist or _seq_vals is empty. +apply = $(call _apply,$(firstword $1),$(strip \ + $(wordlist 2,$(call int_sub,$(words $1),1),$1) \ + $(call _seq_vals,$(lastword $1)))) + +# Map a function object over a list object +map = $(call list,$(foreach e,$(call _seq_vals,$(lastword $1))\ + ,$(call _apply,$(firstword $1),$e))) + +conj = $(foreach seq,$(firstword $1)\ + ,$(call conj_$(call _obj_type,$(seq)),$(call _seq_vals,$(seq)),$(_rest))) +# Strip in case $1 or $2 is empty. +# Also, _reverse introduces blanks. +conj_vector = $(call vector,$(strip $1 $2)) +conj_list = $(call list,$(strip $(call _reverse,$2) $1)) + +seq = $(or $(seq_$(_obj_type))\ + ,$(call _error,seq: called on non-sequence)) +seq_list = $(if $(_seq_vals),$1,$(__nil)) +seq_vector = $(if $(_seq_vals),$(call list,$(_seq_vals)),$(__nil)) +seq_nil = $1 +seq_string = $(if $(_string_val)\ + ,$(call list,$(foreach c,$(call str_encode,$(_string_val))\ + ,$(call _string,$(call str_decode,$c))))$(rem \ + ),$(__nil)) + +# Metadata functions + +# are implemented in types.mk. + + +# Atom functions + +atom? = $(if $(_atom?),$(__true),$(__false)) + +reset! = $(foreach v,$(lastword $1),$(call _reset,$(firstword $1),$v)$v) + +swap! = $(foreach a,$(firstword $1)\ + ,$(call reset!,$a $(call _apply,$(word 2,$1),$(call deref,$a) $(_rest2)))) + + + + +# Namespace of core functions + +core_ns := $(encoded_equal) throw nil? true? false? string? symbol \ + symbol? keyword keyword? number? fn? macro? \ + pr-str str prn println readline read-string slurp \ < \ + <$(encoded_equal) > >$(encoded_equal) + - * / time-ms \ + list list? vector vector? hash-map map? assoc dissoc get \ + contains? keys vals \ + sequential? cons concat vec nth first rest empty? count apply map \ + conj seq \ + with-meta meta atom atom? deref reset! swap! + +endif diff --git a/impls/make/env.mk b/impls/make/env.mk new file mode 100644 index 0000000000..67719d4543 --- /dev/null +++ b/impls/make/env.mk @@ -0,0 +1,34 @@ +# +# mal (Make Lisp) Object Types and Functions +# + +ifndef __mal_env_included +__mal_env_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)types.mk + +# +# ENV +# + +# An ENV environment is a hash-map with an __outer__ reference to an +# outer environment + +# Keys are stored as Make variables named $(env)_$(key). The outer +# environment is the content of the variable itself. + +# 1: outer environment, or "" -> new environment +ENV = $(call __new_obj,env,$1) + +# 1:env 2:key -> value or "" +ENV_GET = $(if $1,$(or $($1_$2),$(call ENV_GET,$($1),$2))) + +# 1:env 2:key 3:value +ENV_SET = $(eval $1_$2 := $3) + +# 1:env -> (encoded) keys +env_keys = $(foreach k,$(patsubst $1_%,%,$(filter $1_%,$(.VARIABLES)))\ + ,$(call _symbol_val,$k)) + +endif diff --git a/make/gmsl.mk b/impls/make/gmsl.mk similarity index 91% rename from make/gmsl.mk rename to impls/make/gmsl.mk index adfb953582..a6374fa05f 100644 --- a/make/gmsl.mk +++ b/impls/make/gmsl.mk @@ -55,8 +55,4 @@ gmsl_characters += 0 1 2 3 4 5 6 7 8 9 gmsl_characters += ` ~ ! @ \# $$ % ^ & * ( ) - _ = + gmsl_characters += { } [ ] \ : ; ' " < > , . / ? | -gmsl_pairmap = $(strip \ - $(if $2$3,$(call $1,$(word 1,$2),$(word 1,$3)) \ - $(call gmsl_pairmap,$1,$(wordlist 2,$(words $2),$2),$(wordlist 2,$(words $3),$3)))) - endif diff --git a/impls/make/numbers.mk b/impls/make/numbers.mk new file mode 100644 index 0000000000..ad87b77d78 --- /dev/null +++ b/impls/make/numbers.mk @@ -0,0 +1,516 @@ +# +# mal (Make a Lisp) number types +# + +ifndef __mal_numbers_included +__mal_numbers_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk + +LIST20_X := x x x x x x x x x x x x x x x x x x x x +LIST100_X := $(foreach x,$(LIST20_X),X X X X X) +LIST100_0 := $(foreach x,$(LIST20_X),0 0 0 0 0) +LIST100_9 := $(foreach x,$(LIST20_X),9 9 9 9 9) + +### +### general numeric utility functions +### + +int_encode = $(strip $(call _reverse,\ + $(eval __temp := $(1))\ + $(foreach a,- 0 1 2 3 4 5 6 7 8 9,\ + $(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp))) + +int_decode = $(subst $(SPACE),,$(_reverse)) + +# trim extaneous zero digits off the end (front of number) +_trim_zeros = $(if $(call _EQ,0,$(strip $(1))),0,$(if $(call _EQ,0,$(word 1,$(1))),$(call _trim_zeros,$(wordlist 2,$(words $(1)),$(1))),$(1))) +trim_zeros = $(strip \ + $(if $(call _EQ,0,$(strip $(filter-out -,$(1)))),\ + $(filter-out -,$(1)),\ + $(call _reverse,$(call _trim_zeros,$(call _reverse,$(filter-out -,$(1))))))\ + $(if $(filter -,$(1)), -,)) + +# drop the last element of a list of words/digits +drop_last = $(call _reverse,$(wordlist 2,$(words $(1)),$(call _reverse,$(1)))) + +### utility function tests + +#$(info $(filter-out 1,$(filter 1%,1 132 456))) +#$(info (int_encode 13): [$(call int_encode,13)]) +#$(info (int_encode 156463): [$(call int_encode,156463)]) +#$(info (int_encode -156463): [$(call int_encode,-156463)]) +#$(info (int_decode (int_encode 156463)): [$(call int_decode,$(call int_encode,156463))]) + +#$(info trim_zeros(0 0 0): [$(call trim_zeros,0 0 0)]) +#$(info trim_zeros(0 0 0 -): [$(call trim_zeros,0 0 0 -)]) + + +### +### comparisons +### + +# compare two digits and return 'true' if digit 1 is less than or +# equal to digit 2 +_lte_digit = $(strip \ + $(if $(call _EQ,$(1),$(2)),\ + true,\ + $(if $(call _EQ,0,$(1)),\ + true,\ + $(if $(wordlist $(1),$(2),$(LIST20_X)),\ + true,\ + )))) + +# compare two lists of digits (MSB->LSB) of equal length and return +# 'true' if number 1 is less than number 2 +_lte_digits = $(strip \ + $(if $(strip $(1)),\ + $(if $(call _EQ,$(word 1,$(1)),$(word 1,$(2))),\ + $(call _lte_digits,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),\ + $(if $(call _lte_digit,$(word 1,$(1)),$(word 1,$(2))),true,)),\ + true)) + +### lte/less than or equal to + +_int_lte_encoded = $(strip \ + $(foreach len1,$(words $(1)),$(foreach len2,$(words $(2)),\ + $(if $(call _EQ,$(len1),$(len2)),\ + $(call _lte_digits,$(call _reverse,$(1)),$(call _reverse,$(2))),\ + $(if $(wordlist $(len1),$(len2),$(LIST100_X)),\ + true,\ + ))))) + +int_lte_encoded = $(strip \ + $(if $(filter -,$(1)),\ + $(if $(filter -,$(2)),\ + $(call _int_lte_encoded,$(filter-out -,$(2)),$(filter-out -,$(1))),\ + true),\ + $(if $(filter -,$(2)),\ + ,\ + $(call _int_lte_encoded,$(1),$(2))))) + +int_lte = $(call int_lte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) + +### lt/less than + +int_lt_encoded = $(strip \ + $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ + ,\ + $(call int_lte_encoded,$(1),$(2)))) + +int_lt = $(call int_lt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) + +### gte/greater than or equal to + +int_gte_encoded = $(strip \ + $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ + true,\ + $(if $(call int_lte_encoded,$(1),$(2)),,true))) + +int_gte = $(call int_gte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) + +### gt/greater than + +int_gt_encoded = $(strip \ + $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ + ,\ + $(call int_gte_encoded,$(1),$(2)))) + +int_gt = $(call int_gt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) + +#$(info _lte_digit,7,8: [$(call _lte_digit,7,8)]) +#$(info _lte_digit,8,8: [$(call _lte_digit,8,8)]) +#$(info _lte_digit,2,1: [$(call _lte_digit,2,1)]) +#$(info _lte_digit,0,0: [$(call _lte_digit,0,0)]) +#$(info _lte_digit,0,1: [$(call _lte_digit,0,1)]) +#$(info _lte_digit,1,0: [$(call _lte_digit,1,0)]) + +#$(info _lte_digits,1 2 3,1 2 4: [$(call _lte_digits,1 2 3,1 2 4)]) +#$(info _lte_digits,1 2 4,1 2 4: [$(call _lte_digits,1 2 4,1 2 4)]) +#$(info _lte_digits,1 2 5,1 2 4: [$(call _lte_digits,1 2 5,1 2 4)]) +#$(info _lte_digits,4 1,9 0: [$(call _lte_digits,4 1,9 0)]) + +# The main comparison operator (others are built on this) +#$(info int_lte_encoded,1,1: [$(call int_lte_encoded,1,1)]) +#$(info int_lte_encoded,1,2: [$(call int_lte_encoded,1,2)]) +#$(info int_lte_encoded,2,1: [$(call int_lte_encoded,2,1)]) +#$(info int_lte_encoded,0,3: [$(call int_lte_encoded,0,3)]) +#$(info int_lte_encoded,3,0: [$(call int_lte_encoded,3,0)]) +#$(info int_lte_encoded,1 4,0 9: [$(call int_lte_encoded,1 4,0 9)]) +#$(info int_lte_encoded,4 3 2 1,4 3 2 1: [$(call int_lte_encoded,4 3 2 1,4 3 2 1)]) +#$(info int_lte_encoded,5 3 2 1,4 3 2 1: [$(call int_lte_encoded,5 3 2 1,4 3 2 1)]) +#$(info int_lte_encoded,4 3 2 1,5 3 2 1: [$(call int_lte_encoded,4 3 2 1,5 3 2 1)]) +# negative numbers +#$(info int_lte_encoded,7 -,7: [$(call int_lte_encoded,7 -,7)]) +#$(info int_lte_encoded,7,7 -: [$(call int_lte_encoded,7,7 -)]) +#$(info int_lte_encoded,7 -,7 -: [$(call int_lte_encoded,7 -,7 -)]) +#$(info int_lte_encoded,1 7 -,0 7: [$(call int_lte_encoded,1 7 -,0 7)]) +#$(info int_lte_encoded,1 7,0 7 -: [$(call int_lte_encoded,1 7,0 7 -)]) +#$(info int_lte_encoded,1 7 -,0 7 -: [$(call int_lte_encoded,1 7 -,0 7 -)]) +#$(info int_lte_encoded,4 3 2 1 -,4 3 2 1: [$(call int_lte_encoded,4 3 2 1 -,4 3 2 1)]) +#$(info int_lte_encoded,4 3 2 1,4 3 2 1 -: [$(call int_lte_encoded,4 3 2 1,4 3 2 1 -)]) +#$(info int_lte_encoded,4 3 2 1 -,4 3 2 1 -: [$(call int_lte_encoded,4 3 2 1 -,4 3 2 1 -)]) + +#$(info int_lte,1,1: [$(call int_lte,1,1)]) +#$(info int_lte,1,2: [$(call int_lte,1,2)]) +#$(info int_lte,2,1: [$(call int_lte,2,1)]) +#$(info int_lte,0,3: [$(call int_lte,0,3)]) +#$(info int_lte,3,0: [$(call int_lte,3,0)]) +#$(info int_lte,1234,1234: [$(call int_lte,1234,1234)]) +#$(info int_lte,1235,1234: [$(call int_lte,1235,1234)]) +#$(info int_lte,1234,1235: [$(call int_lte,1234,1235)]) +#$(info int_lte,-1234,1235: [$(call int_lte,-1234,1235)]) +#$(info int_lte,1234,-1235: [$(call int_lte,1234,-1235)]) +#$(info int_lte,-1234,-1235: [$(call int_lte,-1234,-1235)]) + +#$(info int_lt,1,1: [$(call int_lt,1,1)]) +#$(info int_lt,1,2: [$(call int_lt,1,2)]) +#$(info int_lt,2,1: [$(call int_lt,2,1)]) +#$(info int_lt,0,3: [$(call int_lt,0,3)]) +#$(info int_lt,3,0: [$(call int_lt,3,0)]) +#$(info int_lt,1234,1234: [$(call int_lt,1234,1234)]) +#$(info int_lt,1235,1234: [$(call int_lt,1235,1234)]) +#$(info int_lt,1234,1235: [$(call int_lt,1234,1235)]) +# +#$(info int_gte,1,1: [$(call int_gte,1,1)]) +#$(info int_gte,1,2: [$(call int_gte,1,2)]) +#$(info int_gte,2,1: [$(call int_gte,2,1)]) +#$(info int_gte,0,3: [$(call int_gte,0,3)]) +#$(info int_gte,3,0: [$(call int_gte,3,0)]) +#$(info int_gte,1234,1234: [$(call int_gte,1234,1234)]) +#$(info int_gte,1235,1234: [$(call int_gte,1235,1234)]) +#$(info int_gte,1234,1235: [$(call int_gte,1234,1235)]) +# +#$(info int_gt,1,1: [$(call int_gt,1,1)]) +#$(info int_gt,1,2: [$(call int_gt,1,2)]) +#$(info int_gt,2,1: [$(call int_gt,2,1)]) +#$(info int_gt,0,3: [$(call int_gt,0,3)]) +#$(info int_gt,3,0: [$(call int_gt,3,0)]) +#$(info int_gt,1234,1234: [$(call int_gt,1234,1234)]) +#$(info int_gt,1235,1234: [$(call int_gt,1235,1234)]) +#$(info int_gt,1234,1235: [$(call int_gt,1234,1235)]) +#$(info int_gt,-1234,1235: [$(call int_gt,-1234,1235)]) +#$(info int_gt,-1234,-1235: [$(call int_gt,-1234,-1235)]) + + +### +### addition +### + + +# add_digits_with_carry +_add_digit = $(words $(if $(strip $(1)),$(wordlist 1,$(1),$(LIST20_X)),) \ + $(if $(strip $(2)),$(wordlist 1,$(2),$(LIST20_X)),)) + +# add one to a single digit +_inc_digit = $(words $(wordlist 1,$(if $(1),$(1),0),$(LIST20_X)) x) + +# add two encoded numbers digit by digit without resolving carries +# (each digit will be larger than 9 if there is a carry value) +_add = $(if $(1)$(2),$(call _add_digit,$(word 1,$(1)),$(word 1,$(2))) $(call _add,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),) + +# take the result of _add and resolve the carry values digit by digit +_resolve_carries = $(strip \ + $(if $(1),\ + $(foreach num,$(word 1,$(1)),\ + $(if $(filter-out 1,$(filter 1%,$(num))),\ + $(call _resolve_carries,$(call _inc_digit,$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1)),$(2) $(patsubst 1%,%,$(num))),\ + $(call _resolve_carries,$(wordlist 2,$(words $(1)),$(1)),$(2) $(num)))),\ + $(2))) + +_negate = $(strip \ + $(if $(call _EQ,0,$(strip $(1))),\ + 0,\ + $(if $(filter -,$(1)),$(filter-out -,$(1)),$(1) -))) + +# add two encoded numbers, returns encoded number +_int_add_encoded = $(call _resolve_carries,$(call _add,$(1),$(2))) + +int_add_encoded = $(strip \ + $(if $(filter -,$(1)),\ + $(if $(filter -,$(2)),\ + $(call _negate,$(call _int_add_encoded,$(filter-out -,$(1)),$(filter-out -,$(2)))),\ + $(call int_sub_encoded,$(2),$(filter-out -,$(1)))),\ + $(if $(filter -,$(2)),\ + $(call int_sub_encoded,$(1),$(filter-out -,$(2))),\ + $(call _int_add_encoded,$(1),$(2))))) + +# add two unencoded numbers, returns unencoded number +int_add = $(call int_decode,$(call int_add_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) + +### addition tests + +#$(info _add_digit(7,6,1): [$(call _add_digit,7,6,1)]) +#$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)]) +#$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)]) +#$(info _carries(12 14 15): [$(call _carries,12 14 15)]) +#$(info _inc_digit(0): $(call _inc_digit,0)) +#$(info _inc_digit(1): $(call _inc_digit,1)) +#$(info _inc_digit(9): $(call _inc_digit,9)) +#$(info _inc_digit(18): $(call _inc_digit,18)) +#$(info int_add_encoded(0,0): [$(call int_add_encoded,0,0)]) + +#$(info int_add(1,2): [$(call int_add,1,2)]) +#$(info int_add(9,9): [$(call int_add,9,9)]) +#$(info int_add(0,9): [$(call int_add,0,9)]) +#$(info int_add(9,0): [$(call int_add,9,0)]) +#$(info int_add(0,0): [$(call int_add,0,0)]) +#$(info int_add(123,456): [$(call int_add,123,456)]) +#$(info int_add(678,789): [$(call int_add,678,789)]) +#$(info int_add(1,12): [$(call int_add,1,12)]) +#$(info int_add(123,5): [$(call int_add,123,5)]) +#$(info int_add(123456,9): [$(call int_add,123456,9)]) +#$(info int_add(999999991,9): [$(call int_add,999999991,9)]) +# negative numbers +#$(info int_add(-2,2): [$(call int_add,-2,2)]) +#$(info int_add(-1,2): [$(call int_add,-1,2)]) +#$(info int_add(1,-2): [$(call int_add,1,-2)]) +#$(info int_add(-1,-2): [$(call int_add,-1,-2)]) + +### +### subtraction +### + +_get_zeros = $(if $(call _EQ,0,$(word 1,$(1))),$(call _get_zeros,$(wordlist 2,$(words $(1)),$(1)),$(2) 0),$(2)) + +# return a 9's complement of a single digit +_complement9 = $(strip \ + $(if $(call _EQ,0,$(1)),9,\ + $(if $(call _EQ,1,$(1)),8,\ + $(if $(call _EQ,2,$(1)),7,\ + $(if $(call _EQ,3,$(1)),6,\ + $(if $(call _EQ,4,$(1)),5,\ + $(if $(call _EQ,5,$(1)),4,\ + $(if $(call _EQ,6,$(1)),3,\ + $(if $(call _EQ,7,$(1)),2,\ + $(if $(call _EQ,8,$(1)),1,\ + $(if $(call _EQ,9,$(1)),0))))))))))) + +# return a 10's complement of a single digit +_complement10 = $(call _inc_digit,$(call _complement9,$(1))) + +# +_complement_rest = $(if $(strip $(1)),\ + $(strip \ + $(call _complement10,$(word 1,$(1))) \ + $(foreach digit,$(wordlist 2,$(words $(1)),$(1)),\ + $(call _complement9,$(digit)))),) + +# return the complement of a number +_complement = $(strip $(call _get_zeros,$(1)) \ + $(call _complement_rest,$(wordlist $(call _inc_digit,$(words $(call _get_zeros,$(1)))),$(words $(1)),$(1)))) + +# subtracted encoded number 2 from encoded number 1 and return and +# encoded number result. both numbers must be positive but may have +# a negative result +__int_sub_encoded = $(strip \ + $(call trim_zeros,\ + $(call drop_last,\ + $(call int_add_encoded,\ + $(1),\ + $(wordlist 1,$(words $(1)),$(call _complement,$(2)) $(LIST100_9)))))) + +_int_sub_encoded = $(strip \ + $(if $(call _EQ,0,$(strip $(2))),\ + $(1),\ + $(if $(call _int_lte_encoded,$(2),$(1)),\ + $(call __int_sub_encoded,$(1),$(2)),\ + $(call _negate,$(call __int_sub_encoded,$(2),$(1)))))) + +int_sub_encoded = $(strip \ + $(if $(filter -,$(1)),\ + $(if $(filter -,$(2)),\ + $(call _int_sub_encoded,$(filter-out -,$(2)),$(filter-out -,$(1))),\ + $(call _negate,$(call _int_add_encoded,$(filter-out -,$(1)),$(2)))),\ + $(if $(filter -,$(2)),\ + $(call _int_add_encoded,$(1),$(filter-out -,$(2))),\ + $(call _int_sub_encoded,$(1),$(2))))) + +# subtract unencoded number 2 from unencoded number 1 and return +# unencoded result +int_sub = $(call int_decode,$(call int_sub_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) + +### subtraction tests + +#$(info _get_zeros(5 7): [$(call _get_zeros,5 7)]) +#$(info _get_zeros(0 0 0 2): [$(call _get_zeros,0 0 0 2)]) +#$(info _get_zeros(0 0 0 2 5): [$(call _get_zeros,0 0 0 2 5)]) + +#$(info _complement(0): [$(call _complement,0)]) +#$(info _complement(1): [$(call _complement,1)]) +#$(info _complement(9): [$(call _complement,9)]) +#$(info _complement(5 7): [$(call _complement,5 7)]) +#$(info _complement(0 0 0 2): [$(call _complement,0 0 0 2)]) +#$(info _complement(0 0 0 5 4 3 2 1): [$(call _complement,0 0 0 5 4 3 2 1)]) + +#$(info int_sub_encoded(0 0 1, 3 1): [$(call int_sub_encoded,0 0 1,3 1)]) +#$(info int_sub_encoded(2, 2): [$(call int_sub_encoded,2,2)]) + +#$(info int_sub(2,1): [$(call int_sub,2,1)]) +#$(info int_sub(2,0): [$(call int_sub,2,0)]) +#$(info int_sub(2,2): [$(call int_sub,2,2)]) +#$(info int_sub(100,13): [$(call int_sub,100,13)]) +#$(info int_sub(100,99): [$(call int_sub,100,99)]) +#$(info int_sub(91,19): [$(call int_sub,91,19)]) +# negative numbers +#$(info int_sub(1,2): [$(call int_sub,1,2)]) +#$(info int_sub(-1,2): [$(call int_sub,-1,2)]) +#$(info int_sub(1,-2): [$(call int_sub,1,-2)]) +#$(info int_sub(-1,-2): [$(call int_sub,-1,-2)]) +#$(info int_sub(-2,-1): [$(call int_sub,-2,-1)]) +#$(info int_sub(19,91): [$(call int_sub,19,91)]) +#$(info int_sub(91,-19): [$(call int_sub,91,-19)]) +#$(info int_sub(-91,19): [$(call int_sub,-91,19)]) +#$(info int_sub(-91,-19): [$(call int_sub,-91,-19)]) + + +### +### multiplication +### + +# multiply two digits +#_mult_digit = $(words $(foreach x,$(1),$(2))) +_mult_digit = $(strip \ + $(words $(foreach x,$(wordlist 1,$(1),$(LIST20_X)),\ + $(wordlist 1,$(2),$(LIST20_X))))) + +# multipy every digit of number 1 with number 2 +# params: digits, digit, indent_zeros, results +_mult_row = $(if $(strip $(1)),$(call _mult_row,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)0,$(4) $(call _mult_digit,$(word 1,$(1)),$(2))$(3)),$(4)) + +# multiply every digit of number 2 with every digit of number 1 adding +# correct zero padding to the end of each result +# params: digits, digits, indent_zeros, results +_mult_each = $(if $(strip $(2)),$(call _mult_each,$(1),$(wordlist 2,$(words $(2)),$(2)),$(3)0,$(4) $(call _mult_row,$(1),$(word 1,$(2)),$(3))),$(4)) + +# add up a bunch of unencoded numbers. Basically reduce into the first number +_add_many = $(if $(word 2,$(1)),$(call _add_many,$(call int_add,$(word 1,$(1)),$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1))),$(1)) + +# multiply two encoded numbers, returns encoded number +_int_mult_encoded = $(call trim_zeros,$(call int_encode,$(call _add_many,$(call _mult_each,$(1),$(2))))) + +int_mult_encoded = $(strip \ + $(if $(filter -,$(1)),\ + $(if $(filter -,$(2)),\ + $(call _int_mult_encoded,$(filter-out -,$(1)),$(filter-out -,$(2))),\ + $(call _negate,$(call _int_mult_encoded,$(filter-out -,$(1)),$(2)))),\ + $(if $(filter -,$(2)),\ + $(call _negate,$(call _int_mult_encoded,$(1),$(filter-out -,$(2)))),\ + $(call _int_mult_encoded,$(1),$(2))))) + +# multiply two unencoded numbers, returns unencoded number +int_mult = $(call int_decode,$(call int_mult_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) + +#$(info _mult_digit(8,6): [$(call _mult_digit,8,6)]) +#$(info _mult_digit(7,6): [$(call _mult_digit,7,6)]) +#$(info _mult_row(8,6): [$(call _mult_row,8,6)]) +#$(info _mult_row(8 7,6): [$(call _mult_row,8 7,6)]) +#$(info _mult_row(8 7 3,6): [$(call _mult_row,8 7 3,6)]) +#$(info _mult_each(8 7 6, 4 3 2): [$(call _mult_each,8 7 6,4 3 2)]) +#$(info _add_many(123 234 345 456): [$(call _add_many,123 234 345 456)]) + +#$(info int_mult_encoded(8 7 3,6): [$(call int_mult_encoded,8 7 3,6)]) +#$(info int_mult_encoded(8 7 3,0): [$(call int_mult_encoded,8 7 3,0)]) + +#$(info int_mult(378,6): [$(call int_mult,378,6)]) +#$(info int_mult(678,234): [$(call int_mult,678,234)]) +#$(info int_mult(1,23456): [$(call int_mult,1,23456)]) +#$(info int_mult(0,23456): [$(call int_mult,0,23456)]) +#$(info int_mult(0,0): [$(call int_mult,0,0)]) +# negative numbers +#$(info int_mult(-378,6): [$(call int_mult,-378,6)]) +#$(info int_mult(678,-234): [$(call int_mult,678,-234)]) +#$(info int_mult(-1,-23456): [$(call int_mult,-1,-23456)]) +#$(info int_mult(0,-23456): [$(call int_mult,0,-23456)]) + +### +### division +### + +# return list of zeros needed to pad number 2 to the same length as number 1 +_zero_pad = $(strip $(wordlist 1,$(call int_sub,$(words $(1)),$(words $(2))),$(LIST100_0))) + +# num1, num2, zero pad, result_accumulator +# algorithm: +# - B = pad with zeros to make same digit length as A +# - loop +# - if (B <= A) +# - A = subtract B from A +# - C = C + 10^(B pad.length) +# - else +# - if B.length < origin B.length: break +# - chop least significant digit of B +_div = $(strip \ + $(if $(call int_lte_encoded,$(3) $(2),$(1)),\ + $(call _div,$(call int_sub_encoded,$(1),$(3) $(2)),$(2),$(3),$(call int_add_encoded,$(4),$(3) 1)),\ + $(if $(3),\ + $(call _div,$(1),$(2),$(wordlist 2,$(words $(3)),$(3)),$(4)),\ + $(4)))) + +# divide two encoded numbers, returns encoded number +_int_div_encoded = $(strip \ + $(if $(call _EQ,0,$(1)),\ + 0,\ + $(if $(call _EQ,$(1),$(2)),\ + 1,\ + $(if $(call int_gt_encoded,$(2),$(1)),\ + 0,\ + $(call _div,$(1),$(2),$(call _zero_pad,$(1),$(2)),0))))) + +int_div_encoded = $(strip \ + $(if $(filter -,$(1)),\ + $(if $(filter -,$(2)),\ + $(call _int_div_encoded,$(filter-out -,$(1)),$(filter-out -,$(2))),\ + $(call _negate,$(call _int_div_encoded,$(filter-out -,$(1)),$(2)))),\ + $(if $(filter -,$(2)),\ + $(call _negate,$(call _int_div_encoded,$(1),$(filter-out -,$(2)))),\ + $(call _int_div_encoded,$(1),$(2))))) + +# divide two unencoded numbers, returns unencoded number +int_div = $(call int_decode,$(call int_div_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) + +### division tests + +#$(info _zero_pad(1 2 3 4,1 3): [$(call _zero_pad,1 2 3 4,1 3)]) +#$(info _zero_pad(1 2,1 3): [$(call _zero_pad,1 2,1 3)]) +#$(info _zero_pad(2,1 3): [$(call _zero_pad,1 2,1 3)]) +# +#$(info int_div_encoded(2,1): [$(call int_div_encoded,2,1)]) +#$(info int_div_encoded(3,1): [$(call int_div_encoded,3,1)]) +#$(info int_div_encoded(3,2): [$(call int_div_encoded,3,2)]) +#$(info int_div_encoded(0,7): [$(call int_div_encoded,0,7)]) +#$(info int_div_encoded(0 3,0 2): [$(call int_div_encoded,0 3,0 2)]) +#$(info int_div_encoded(0 3,5): [$(call int_div_encoded,0 3,5)]) +# +#$(info int_div(5,1): [$(call int_div,5,1)]) +#$(info int_div(5,2): [$(call int_div,5,2)]) +#$(info int_div(123,7): [$(call int_div,123,7)]) +#$(info int_div(100,7): [$(call int_div,100,7)]) +# negative numbers +#$(info int_div(-5,1): [$(call int_div,-5,1)]) +#$(info int_div(5,-2): [$(call int_div,5,-2)]) +#$(info int_div(-123,-7): [$(call int_div,-123,-7)]) + + +### combination tests + +# (/ (- (+ 515 (* 222 311)) 300) 41) = 1689 +#$(info int_mult,222,311: [$(call int_mult,222,311)]) +#$(info int_add(515,69042): [$(call int_add,515,69042)]) +#$(info int_sub(69557,300): [$(call int_sub,69557,300)]) +#$(info int_div(69257,41): [$(call int_div,69257,41)]) +# (/ (- (+ 515 (* -222 311)) 300) 41) = -1678 +#$(info int_mult,-222,311: [$(call int_mult,-222,311)]) +#$(info int_add(515,-69042): [$(call int_add,515,-69042)]) +#$(info int_sub(-68527,300): [$(call int_sub,-68527,300)]) +#$(info int_div(-68827,41): [$(call int_div,-68827,41)]) + +############################################################### + +all: + @true + +endif + +# vim: ts=2 et diff --git a/impls/make/printer.mk b/impls/make/printer.mk new file mode 100644 index 0000000000..0187424d7f --- /dev/null +++ b/impls/make/printer.mk @@ -0,0 +1,55 @@ +# +# mal (Make a Lisp) printer +# + +ifndef __mal_printer_included +__mal_printer_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk + +# return a printable form of the argument, the second parameter is +# 'print_readably' which backslashes quotes in string values +_pr_str = $(call $(_obj_type)_pr_str,$1,$2) + +# Like _pr_str but takes multiple values in first argument, the second +# parameter is 'print_readably' which backslashes quotes in string +# values, the third parameter is the delimeter to use between each +# _pr_str'd value +_pr_str_mult = $(subst $(SPACE),$3,$(foreach f,$1,$(call _pr_str,$f,$2))) + + +# Type specific printing + +nil_pr_str := nil +true_pr_str := true +false_pr_str := false + +number_pr_str = $(_number_val) + +symbol_pr_str = $(_symbol_val) + +keyword_pr_str = $(encoded_colon)$(_keyword_val) + +string_pr_str = $(if $2\ + ,"$(subst $(_NL),$(encoded_slash)n,$(rem \ + )$(subst ",$(encoded_slash)",$(rem \ + )$(subst $(encoded_slash),$(encoded_slash)$(encoded_slash),$(rem \ + )$(_string_val))))"$(rem \ +else \ + ),$(_string_val)) + +corefn_pr_str := +function_pr_str := +macro_pr_str := + +list_pr_str = $(_LP)$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))$(_RP) + +vector_pr_str = [$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))] + +map_pr_str = {$(call _pr_str_mult,$(foreach k,$(_keys),$k $(call _get,$1,$k)),$2,$(_SP))} + +atom_pr_str = $(_LP)atom$(_SP)$(call _pr_str,$(deref),$2)$(_RP) + +endif diff --git a/impls/make/reader.mk b/impls/make/reader.mk new file mode 100755 index 0000000000..602464ccd6 --- /dev/null +++ b/impls/make/reader.mk @@ -0,0 +1,130 @@ +# +# mal (Make Lisp) Parser/Reader +# + +ifndef __mal_reader_included +__mal_reader_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk + +READER_DEBUG ?= + +_TOKEN_DELIMS := ; , " ` $(_SP) $(_NL) { } $(_LP) $(_RP) [ ] #`" + +reader_init = $(eval __reader_temp := $(str_encode)) +reader_next = $(firstword $(__reader_temp)) +reader_drop = $(eval __reader_temp := $(call _rest,$(__reader_temp))) +reader_log = $(if $(READER_DEBUG),$(info READER: $1 from $(__reader_temp))) + +define READ_NUMBER +$(call reader_log,number)$(rem \ +)$(if $(filter 0 1 2 3 4 5 6 7 8 9,$(reader_next))\ + ,$(reader_next)$(reader_drop)$(call READ_NUMBER)) +endef + +define READ_STRING +$(call reader_log,string)$(rem \ +)$(if $(filter ",$(reader_next))\ + ,$(reader_drop)$(rem "\ +),$(if $(filter $(encoded_slash),$(reader_next))\ + ,$(reader_drop)$(rem \ + )$(if $(filter n,$(reader_next)),$(_NL),$(reader_next))$(rem \ + )$(reader_drop)$(call READ_STRING)$(rem \ +),$(if $(reader_next)\ + ,$(reader_next)$(reader_drop)$(call READ_STRING)$(rem \ +),$(call _error,Expected '"'$(COMMA) got EOF)))) +endef + +define READ_SYMBOL +$(call reader_log,symbol or keyword)$(rem \ +)$(if $(filter-out $(_TOKEN_DELIMS),$(reader_next))\ + ,$(reader_next)$(reader_drop)$(call READ_SYMBOL)) +endef + +# read and return tokens until $1 found +# The last element if any is followed by a space. +define READ_UNTIL +$(call reader_log,until $1)$(rem \ +)$(READ_SPACES)$(rem \ +)$(if $(filter $1,$(reader_next))\ + ,$(reader_drop)$(rem \ +),$(if $(reader_next)\ + ,$(call READ_FORM) $(call READ_UNTIL,$1)$(rem \ +),$(call _error,Expected '$1'$(COMMA) got EOF))) +endef + +define READ_COMMENT +$(call reader_log,comment)$(rem \ +)$(if $(filter-out $(_NL),$(reader_next))\ + ,$(reader_drop)$(call READ_COMMENT)) +endef + +define READ_SPACES +$(call reader_log,spaces)$(rem \ +)$(if $(filter $(_SP) $(_NL) $(COMMA),$(reader_next))\ + ,$(reader_drop)$(call READ_SPACES)$(rem \ +),$(if $(filter ;,$(reader_next))\ + ,$(READ_COMMENT))) +endef + +define READ_FORM +$(call reader_log,form)$(rem \ +)$(READ_SPACES)$(rem \ +)$(if $(filter-out undefined,$(flavor READ_FORM_$(reader_next)))\ + ,$(call READ_FORM_$(reader_next)$(reader_drop))$(rem \ +),$(foreach sym,$(READ_SYMBOL)\ + ,$(if $(filter false nil true,$(sym))\ + ,$(__$(sym))$(rem \ + ),$(call _symbol,$(sym))))) +endef + +READ_FORM_ = $(call _error,expected a form$(COMMA) found EOF) + +# Reader macros +READ_FORM_@ = $(call list,$(call _symbol,deref) $(call READ_FORM)) +READ_FORM_' = $(call list,$(call _symbol,quote) $(call READ_FORM))#' +READ_FORM_` = $(call list,$(call _symbol,quasiquote) $(call READ_FORM))#` +READ_FORM_^ = $(call list,$(call _symbol,with-meta) $(foreach m,\ + $(call READ_FORM),$(call READ_FORM) $m)) + +READ_FORM_~ = $(call list,$(if $(filter @,$(reader_next))\ + ,$(reader_drop)$(call _symbol,splice-unquote)$(rem \ + ),$(call _symbol,unquote)) $(call READ_FORM)) + +# Lists, vectors and maps +# _map_new accepts a leading space, list and vector require )strip. +READ_FORM_{ = $(call _map_new,,$(strip $(call READ_UNTIL,}))) +READ_FORM_$(_LP) = $(call list,$(strip $(call READ_UNTIL,$(_RP)))) +READ_FORM_[ = $(call vector,$(strip $(call READ_UNTIL,]))) +READ_FORM_} = $(call _error,Unexpected '}') +READ_FORM_$(_RP) = $(call _error,Unexpected '$(_RP)') +READ_FORM_] = $(call _error,Unexpected ']') + +# Numbers +define READ_FORM_- +$(if $(filter 0 1 2 3 4 5 6 7 8 9,$(reader_next))\ + ,$(call _number,-$(READ_NUMBER))$(rem \ + ),$(call _symbol,-$(READ_SYMBOL))) +endef +READ_FORM_0 = $(call _number,0$(READ_NUMBER)) +READ_FORM_1 = $(call _number,1$(READ_NUMBER)) +READ_FORM_2 = $(call _number,2$(READ_NUMBER)) +READ_FORM_3 = $(call _number,3$(READ_NUMBER)) +READ_FORM_4 = $(call _number,4$(READ_NUMBER)) +READ_FORM_5 = $(call _number,5$(READ_NUMBER)) +READ_FORM_6 = $(call _number,6$(READ_NUMBER)) +READ_FORM_7 = $(call _number,7$(READ_NUMBER)) +READ_FORM_8 = $(call _number,8$(READ_NUMBER)) +READ_FORM_9 = $(call _number,9$(READ_NUMBER)) + +# Strings +READ_FORM_" = $(call _string,$(call str_decode,$(READ_STRING)))#" + +# Keywords +READ_FORM_$(encoded_colon) = $(call _keyword,$(READ_SYMBOL)) + +READ_STR = $(reader_init)$(or $(READ_FORM),$(__nil)) + +endif diff --git a/impls/make/readline.mk b/impls/make/readline.mk new file mode 100644 index 0000000000..ab4e287134 --- /dev/null +++ b/impls/make/readline.mk @@ -0,0 +1,26 @@ +# +# mal (Make Lisp) shell readline wrapper +# + +ifndef __mal_readline_included +__mal_readline_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk + +# Call bash read/readline. Since each call is in a separate shell +# instance we need to restore and save after each call in order to +# have readline history. +READLINE_HISTORY_FILE := $${HOME}/.mal-history + +# Either empty (if EOF) or an encoded string with the 'ok' suffix. +READLINE = $(call str_encode_nospace,$(shell \ + history -r $(READLINE_HISTORY_FILE); \ + read -u 0 -r -e -p '$(str_decode_nospace)' line && \ + history -s -- "$${line}" && \ + echo "$${line}ok" ; \ + history -a $(READLINE_HISTORY_FILE) 2>/dev/null || \ + true \ +)) + +endif diff --git a/make/rules.mk b/impls/make/rules.mk similarity index 100% rename from make/rules.mk rename to impls/make/rules.mk diff --git a/impls/make/run b/impls/make/run new file mode 100755 index 0000000000..43b9344665 --- /dev/null +++ b/impls/make/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec make --no-print-directory -f $(dirname $0)/${STEP:-stepA_mal}.mk "${@}" diff --git a/impls/make/step0_repl.mk b/impls/make/step0_repl.mk new file mode 100644 index 0000000000..aecaf10bb5 --- /dev/null +++ b/impls/make/step0_repl.mk @@ -0,0 +1,38 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk + +SHELL := /usr/bin/env bash + +define READ +$1 +endef + +define EVAL +$1 +endef + +define PRINT +$1 +endef + +REP = $(call PRINT,$(call EVAL,$(READ))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Call the read-eval-print loop +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step1_read_print.mk b/impls/make/step1_read_print.mk new file mode 100644 index 0000000000..dee4bb321d --- /dev/null +++ b/impls/make/step1_read_print.mk @@ -0,0 +1,49 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: just return the input +define EVAL +$(if $(__ERROR)\ +,,$1) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: read, eval, print, loop + +REP = $(call PRINT,$(call EVAL,$(READ))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# repl loop +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step2_eval.mk b/impls/make/step2_eval.mk new file mode 100644 index 0000000000..4e8a877a50 --- /dev/null +++ b/impls/make/step2_eval.mk @@ -0,0 +1,87 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash +EVAL_DEBUG ?= + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call _get,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL +$(if $(__ERROR)\ +,,$(if $(EVAL_DEBUG),\ + $(call print,EVAL: $(call _pr_str,$1,yes)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call hash-map,$(foreach f,+ - * /\ + ,$(call _symbol,$f) $(call _corefn,$f))) + +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# repl loop +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step3_env.mk b/impls/make/step3_env.mk new file mode 100644 index 0000000000..384dfebdc7 --- /dev/null +++ b/impls/make/step3_env.mk @@ -0,0 +1,108 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +define EVAL +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Setup the environment +$(foreach f,+ - * /\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +# repl loop +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step4_if_fn_do.mk b/impls/make/step4_if_fn_do.mk new file mode 100644 index 0000000000..bd6be7dc73 --- /dev/null +++ b/impls/make/step4_if_fn_do.mk @@ -0,0 +1,130 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +define EVAL +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef + +# core.mk: defined using Make +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +# core.mal: defined in terms of the language itself +$(call RE, (def! not (fn* (a) (if a false true))) ) + +# repl loop +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step6_file.mk b/impls/make/step6_file.mk new file mode 100644 index 0000000000..92639ec48e --- /dev/null +++ b/impls/make/step6_file.mk @@ -0,0 +1,142 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +define EVAL +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef + +# core.mk: defined using Make +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) + +# core.mal: defined in terms of the language itself +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) + +ifneq (,$(MAKECMDGOALS)) +# Load and eval any files specified on the command line +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else +# repl loop +$(REPL) +endif + +# Do not complain that there is no target. +.PHONY: none $(MAKECMDGOALS) +none $(MAKECMDGOALS): + @true diff --git a/impls/make/step7_quote.mk b/impls/make/step7_quote.mk new file mode 100644 index 0000000000..ec250eec72 --- /dev/null +++ b/impls/make/step7_quote.mk @@ -0,0 +1,178 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + +# elt, accumulator list -> new accumulator list +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) + +# list or vector source -> right folded list +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +define EVAL +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef + +# core.mk: defined using Make +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) + +# core.mal: defined in terms of the language itself +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) + +ifneq (,$(MAKECMDGOALS)) +# Load and eval any files specified on the command line +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else +# repl loop +$(REPL) +endif + +# Do not complain that there is no target. +.PHONY: none $(MAKECMDGOALS) +none $(MAKECMDGOALS): + @true diff --git a/impls/make/step8_macros.mk b/impls/make/step8_macros.mk new file mode 100644 index 0000000000..9813fbdeed --- /dev/null +++ b/impls/make/step8_macros.mk @@ -0,0 +1,186 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + +# elt, accumulator list -> new accumulator list +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) + +# list or vector source -> right folded list +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +endef + +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +define EVAL +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef + +# core.mk: defined using Make +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) + +# core.mal: defined in terms of the language itself +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) + +ifneq (,$(MAKECMDGOALS)) +# Load and eval any files specified on the command line +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else +# repl loop +$(REPL) +endif + +# Do not complain that there is no target. +.PHONY: none $(MAKECMDGOALS) +none $(MAKECMDGOALS): + @true diff --git a/impls/make/step9_try.mk b/impls/make/step9_try.mk new file mode 100644 index 0000000000..4dd859eb19 --- /dev/null +++ b/impls/make/step9_try.mk @@ -0,0 +1,202 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + +# elt, accumulator list -> new accumulator list +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) + +# list or vector source -> right folded list +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +endef + +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +# EVAL may fail and return nothing, so the first foreach may execute +# nothing, so we need to duplicate the test for error. +# The second foreach deliberately does nothing when there is no +# catch_list. +define EVAL_special_try* +$(foreach res,$(call EVAL,$(firstword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)))$(rem \ +)$(if $(__ERROR)\ + ,$(foreach catch_list,$(word 2,$1)\ + ,$(foreach env,$(call ENV,$2)\ + ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ + )$(eval __ERROR :=)$(rem \ + )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) +endef + +define EVAL +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef + +# core.mk: defined using Make +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) + +# core.mal: defined in terms of the language itself +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) + +ifneq (,$(MAKECMDGOALS)) +# Load and eval any files specified on the command line +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else +# repl loop +$(REPL) +endif + +# Do not complain that there is no target. +.PHONY: none $(MAKECMDGOALS) +none $(MAKECMDGOALS): + @true diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk new file mode 100644 index 0000000000..eda4d1f824 --- /dev/null +++ b/impls/make/stepA_mal.mk @@ -0,0 +1,209 @@ +# +# mal (Make Lisp) +# +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)types.mk +include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk + +SHELL := /usr/bin/env bash + +# READ: read and parse input +define READ +$(READ_STR) +endef + +# EVAL: evaluate the parameter + +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + +# elt, accumulator list -> new accumulator list +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) + +# list or vector source -> right folded list +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +endef + +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +# EVAL may fail and return nothing, so the first foreach may execute +# nothing, so we need to duplicate the test for error. +# The second foreach deliberately does nothing when there is no +# catch_list. +define EVAL_special_try* +$(foreach res,$(call EVAL,$(firstword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)))$(rem \ +)$(if $(__ERROR)\ + ,$(foreach catch_list,$(word 2,$1)\ + ,$(foreach env,$(call ENV,$2)\ + ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ + )$(eval __ERROR :=)$(rem \ + )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) +endef + +define EVAL_special_make* +$(eval __result := $(call str_decode_nospace,$(_string_val)))$(rem \ +)$(call _string,$(call str_encode_nospace,$(__result))) +endef + +define EVAL +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) +endef + + +# PRINT: +define PRINT +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) +endef + +# REPL: +REPL_ENV := $(call ENV) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef + +# core.mk: defined using Make +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) + +# core.mal: defined in terms of the language itself +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) +$(call RE, (def! *host-language* "make") ) + +ifneq (,$(MAKECMDGOALS)) +# Load and eval any files specified on the command line +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else +# repl loop +$(call RE, (println (str "Mal [" *host-language* "]")) ) +$(REPL) +endif + +# Do not complain that there is no target. +.PHONY: none $(MAKECMDGOALS) +none $(MAKECMDGOALS): + @true diff --git a/impls/make/tests/stepA_mal.mal b/impls/make/tests/stepA_mal.mal new file mode 100644 index 0000000000..ed5551cacf --- /dev/null +++ b/impls/make/tests/stepA_mal.mal @@ -0,0 +1,19 @@ +;; Testing basic make interop + +(make* "7") +;=>"7" + +(make* "$(info foo)") +;/foo +;=>"" + +(make* "$(eval foo := 8)") +(make* "$(foo)") +;=>"8" + +(make* "$(foreach v,a b c,X$(v)Y)") +;=>"XaY XbY XcY" + +(read-string (make* "($(foreach v,1 2 3,$(call int_add,1,$(v))))")) +;=>(2 3 4) + diff --git a/impls/make/types.mk b/impls/make/types.mk new file mode 100644 index 0000000000..cae9184f0e --- /dev/null +++ b/impls/make/types.mk @@ -0,0 +1,207 @@ +# +# mal (Make a Lisp) object types +# + +ifndef __mal_types_included +__mal_types_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)gmsl.mk +include $(_TOP_DIR)util.mk +include $(_TOP_DIR)numbers.mk + + +# Low-level type implemenation + +# magic is \u2344 \u204a +__obj_magic := â„⊠+# \u2256 +__obj_hash_code := 0 + + +# 1:type 2:optional content -> variable name +define __new_obj +$(eval __obj_hash_code := $(call int_add,1,$(__obj_hash_code)))$(rem \ +)$(foreach obj,$(__obj_magic)_$(__obj_hash_code)_$1\ + ,$(obj)$(if $2,$(eval $(obj) := $2))) +endef + + +# Visualize Objects in memory +_visualize_memory = $(foreach v,$(sort $(filter $(__obj_magic)_%,$(.VARIABLES)))\ + ,$(info $v $($v))) + + +# Errors/Exceptions +__ERROR := +throw = $(eval __ERROR := $1) +_error = $(call throw,$(call _string,$(str_encode_nospace))) + + +# Constant atomic values +__nil := _nil +__true := _true +__false := _false + + +# General functions + +_obj_type = $(lastword $(subst _, ,$1)) + +_clone_obj = $(_clone_obj_$(_obj_type)) +_clone_obj_list = $(call list,$($1)) +_clone_obj_vector = $(call vector,$($1)) +_clone_obj_map = $(_map_new) +_clone_obj_function = $(call __new_obj,function,$($1)) +_clone_obj_corefn = $(call _corefn,$($1)) + +define _hash_equal? +$(if $3\ + ,$(and $(call _equal?,$($1_$(firstword $3)),$($2_$(firstword $3))),\ + $(call _hash_equal?,$1,$2,$(call _rest,$3)))$(rem \ + ),true) +endef + +define _equal?_seq_loop +$(if $1\ + ,$(and $2,\ + $(call _equal?,$(firstword $1),$(firstword $2)),\ + $(call _equal?_seq_loop,$(_rest),$(call _rest,$2)))$(rem \ + ),$(if $2,,true)) +endef + +define _equal? +$(or $(filter $1,$2),\ + $(and $(filter %_list %_vector,$1),\ + $(filter %_list %_vector,$2),\ + $(call _equal?_seq_loop,$($1),$($2))),\ + $(and $(filter %_map,$1),\ + $(filter %_map,$2),\ + $(call _EQ,$(_keys),$(call _keys,$2)),\ + $(call _hash_equal?,$1,$2,$(_keys)))) +endef + +_nil? = $(filter $(__nil),$1) + +_true? = $(filter $(__true),$1) + +_false? = $(filter $(__false),$1) + +# Conveniently for DEBUG-EVAL, returns false if $1 is empty. +truthy? = $(filter-out _nil _false,$1) + + +# Symbols +_symbol = $1_symbol +_symbol_val = $(1:_symbol=) +_symbol? = $(filter %_symbol,$1) + + +# Keywords +_keyword = $1_keyword +_keyword? = $(filter %_keyword,$1) +_keyword_val = $(1:_keyword=) + + +# Numbers +_number = $1_number +_number? = $(filter %_number,$1) +_number_val = $(1:_number=) + + +# Strings +_string = $1_string +_string? = $(filter %_string,$1) +_string_val = $(1:_string=) + +# Functions + +_corefn = $(call __new_obj,corefn,$1) +_function = $(call __new_obj,function,$2 $3 $1) +_as_macro = $(call __new_obj,macro,$($1)) +_fn? = $(filter %_corefn %_function,$1) +_macro? = $(filter %_macro,$1) + +# 1:env 2:formal parameters 3:actual parameters +define _function_set_env +$(if $2\ + ,$(if $(filter &_symbol,$(firstword $2))\ + ,$(call ENV_SET,$1,$(lastword $2),$(call list,$3)),$(rem \ + else \ + $(call ENV_SET,$1,$(firstword $2),$(firstword $3)) + $(call _function_set_env,$1,$(call _rest,$2),$(call _rest,$3))))) +endef + +# Takes a function object and a list object of arguments and invokes +# the function with space separated arguments +define _apply +$(if $(filter %_corefn,$1)\ + ,$(call $($1),$2)$(rem \ +),$(if $(filter %_function %_macro,$1)\ + ,$(foreach env,$(call ENV,$(word 2,$($1)))\ + ,$(call _function_set_env,$(env),$(call _rest2,$($1)),$2)$(rem \ + )$(call EVAL,$(firstword $($1)),$(env)))$(rem \ +),$(call _error,cannot apply non-function))) +endef + + +# Lists +list = $(if $1,$(call __new_obj,list,$1),empty_list) +_list? = $(filter %_list,$1) + +_seq_vals = $($1) + + +# Vectors (same as lists for now) +vector = $(if $1,$(call __new_obj,vector,$1),empty_vector) +_vector? = $(filter %_vector,$1) + + +# Hash maps (associative arrays) +# 1:optional source map 2:optional key/value pairs 3:optional removals +define _map_new +$(foreach obj,$(call __new_obj,map,$(filter-out $3,$(if $1,$($1))))\ +,$(obj)$(rem \ +$(foreach k,$($(obj))\ + ,$(eval $(obj)_$k := $($1_$k)))\ +$(call _foreach2,$2\ + ,$$(call _assoc!,$(obj),$$k,$$v)))) +endef + +_hash_map? = $(filter %_map,$1) + + +# set a key/value in the hash map +# map key val +# sort removes duplicates. +_assoc! = $(eval $1_$2 := $3)$(eval $1 := $(sort $($1) $2)) + +_keys = $($1) + +# retrieve the value of a plain string key from the hash map, or +# return the empty string if the key is missing +_get = $($1_$2) + + +# sequence operations + +_sequential? = $(filter %_list %_vector,$1) + + +# Metadata functions + +with-meta = $(foreach obj,$(call _clone_obj,$(firstword $1))\ + ,$(obj)$(eval $(obj)_meta := $(lastword $1))) + +meta = $(or $($1_meta),$(__nil)) + + +# atoms + +atom = $(call __new_obj,atom,$1) +_atom? = $(filter %_atom,$1) +deref = $($1) +_reset = $(eval $1 = $2) + + +endif diff --git a/impls/make/util.mk b/impls/make/util.mk new file mode 100644 index 0000000000..898e9ed28d --- /dev/null +++ b/impls/make/util.mk @@ -0,0 +1,110 @@ +# +# mal (Make Lisp) utility functions/definitions +# + +ifndef __mal_util_included +__mal_util_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)gmsl.mk + +encoded_equal := Ξ +encoded_colon := κ +encoded_slash := λ +raw_hash := \# +encoded_hash := η + +COMMA := , +COLON := : +LPAREN := ( +RPAREN := ) +SLASH := $(strip \ ) +SPACE := +SPACE := $(SPACE) $(SPACE) +define NEWLINE + + +endef + +# \u00ab +_LP := « +# \u00bb +_RP := » +## \u00a7 +_SP := § +## \u00ae +_DOL := Åž +## \u00b6 +_NL := ¶ + + +# +# Utility functions +# + +_EQ = $(if $(subst x$1,,x$2)$(subst x$2,,x$1),,true) + +# reverse list of words +_reverse = $(if $1,$(call _reverse,$(_rest)) $(firstword $1)) + + +#$(info reverse(1 2 3 4 5): $(call reverse,1 2 3 4 5)) + +# str_encode: take a string and return an encoded version of it with +# every character separated by a space and special characters replaced +# with special Unicode characters +define str_encode +$(eval __temp := $1)$(rem \ +)$(foreach a,$(encoded_slash) $(_DOL) $(_LP) $(_RP) $(_NL) \ + $(encoded_hash) $(encoded_colon) $(_SP) $(encoded_equal) $(gmsl_characters)\ + ,$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(rem \ +)$(__temp) +endef + +# str_decode: take an encoded string an return an unencoded version of +# it by replacing the special Unicode charactes with the real +# characters and with all characters joined into a regular string +str_decode = $(subst $(SPACE),,$1) + +define str_encode_nospace +$(subst $(SLASH),$(encoded_slash),$(rem \ +)$(subst $$,$(_DOL),$(rem \ +)$(subst $(LPAREN),$(_LP),$(rem \ +)$(subst $(RPAREN),$(_RP),$(rem \ +)$(subst $(NEWLINE),$(_NL),$(rem \ +)$(subst $(raw_hash),$(encoded_hash),$(rem \ +)$(subst $(COLON),$(encoded_colon),$(rem \ +)$(subst $(SPACE),$(_SP),$(rem \ +)$(subst =,$(encoded_equal),$(rem \ +)$1))))))))) +endef + +define str_decode_nospace +$(subst $(encoded_slash),$(SLASH),$(rem \ +)$(subst $(_DOL),$$,$(rem \ +)$(subst $(_LP),$(LPAREN),$(rem \ +)$(subst $(_RP),$(RPAREN),$(rem \ +)$(subst $(_NL),$(NEWLINE),$(rem \ +)$(subst $(encoded_hash),$(raw_hash),$(rem \ +)$(subst $(encoded_colon),$(COLON),$(rem \ +)$(subst $(_SP),$(SPACE),$(rem \ +)$(subst $(encoded_equal),=,$1))))))))) +endef + +# Read a whole file substituting newlines with $(_NL) +_read_file = $(call str_encode_nospace,$(shell \ + sed -z 's/\n/$(_NL)/g' '$(str_decode_nospace)')) + +print = $(info $(str_decode_nospace)) + +_rest = $(wordlist 2,$(words $1),$1) +_rest2 = $(wordlist 3,$(words $1),$1) + +# Evaluate $2 repeatedly with $k and $v set to key/value pairs from $1. +define _foreach2 +$(foreach k,$(firstword $1)\ + ,$(foreach v,$(word 2,$1)\ + ,$(eval $2)$(call _foreach2,$(_rest2),$2))) +endef + +endif diff --git a/impls/mal/Dockerfile b/impls/mal/Dockerfile new file mode 100644 index 0000000000..f7677e91c8 --- /dev/null +++ b/impls/mal/Dockerfile @@ -0,0 +1,34 @@ +FROM ubuntu:18.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# For building node modules +RUN apt-get -y install g++ + +# Add nodesource apt repo config for 10.x stable +RUN apt-get -y install gnupg +RUN curl -sL https://deb.nodesource.com/setup_10.x | bash - + +# Install nodejs +RUN apt-get -y install nodejs + +ENV NPM_CONFIG_CACHE /mal/.npm diff --git a/impls/mal/Makefile b/impls/mal/Makefile new file mode 100644 index 0000000000..13b82f790f --- /dev/null +++ b/impls/mal/Makefile @@ -0,0 +1,10 @@ +all: mal.mal + +mal.mal: stepA_mal.mal + cp $< $@ + +%.mal: + @true + +clean: + rm -f mal.mal diff --git a/impls/mal/core.mal b/impls/mal/core.mal new file mode 100644 index 0000000000..b00de25641 --- /dev/null +++ b/impls/mal/core.mal @@ -0,0 +1,6 @@ +(def! core_ns '[* + - / < <= = > >= apply assoc atom atom? concat conj + cons contains? count deref dissoc empty? false? first fn? get + hash-map keys keyword keyword? list list? macro? map map? meta nil? + nth number? pr-str println prn read-string readline reset! rest seq + sequential? slurp str string? swap! symbol symbol? throw time-ms + true? vals vec vector vector? with-meta]) diff --git a/impls/mal/env.mal b/impls/mal/env.mal new file mode 100644 index 0000000000..dc0ee2ef75 --- /dev/null +++ b/impls/mal/env.mal @@ -0,0 +1,55 @@ +;; An environment is an atom referencing a map where keys are strings +;; instead of symbols. The outer environment is the value associated +;; with the normally invalid :outer key. + +;; Private helper for new-env. +(def! bind-env (fn* [env b e] + (if (empty? b) + (if (empty? e) + env + (throw "too many arguments in function call")) + (let* [b0 (first b)] + (if (= '& b0) + (if (= 2 (count b)) + (if (symbol? (nth b 1)) + (assoc env (str (nth b 1)) e) + (throw "formal parameters must be symbols")) + (throw "misplaced '&' construct")) + (if (empty? e) + (throw "too few arguments in function call") + (if (symbol? b0) + (bind-env (assoc env (str b0) (first e)) (rest b) (rest e)) + (throw "formal parameters must be symbols")))))))) + +(def! new-env (fn* [& args] + (if (<= (count args) 1) + (atom {:outer (first args)}) + (atom (apply bind-env {:outer (first args)} (rest args)))))) + +(def! env-as-map (fn* [env] + (dissoc @env :outer))) + +(def! env-get-or-nil (fn* [env k] + (let* [ks (str k) + e (env-find-str env ks)] + (if e + (get @e ks))))) + +;; Private helper for env-get and env-get-or-nil. +(def! env-find-str (fn* [env ks] + (if env + (let* [data @env] + (if (contains? data ks) + env + (env-find-str (get data :outer) ks)))))) + +(def! env-get (fn* [env k] + (let* [ks (str k) + e (env-find-str env ks)] + (if e + (get @e ks) + (throw (str "'" ks "' not found")))))) + +;; The return value must be ignored. +(def! env-set (fn* [env k v] + (swap! env assoc (str k) v))) diff --git a/impls/mal/run b/impls/mal/run new file mode 100755 index 0000000000..3bf6b5b09c --- /dev/null +++ b/impls/mal/run @@ -0,0 +1,9 @@ +#!/usr/bin/env bash +MAL_FILE=../mal/${STEP:-stepA_mal}.mal +export STEP=stepA_mal # force MAL_IMPL to use stepA +case ${MAL_IMPL} in +*-mal) + MAL_IMPL=${MAL_IMPL%%-mal} + MAL_FILE="../mal/stepA_mal.mal ${MAL_FILE}" ;; +esac +exec ./../${MAL_IMPL:-js}/run ${MAL_FILE} "${@}" diff --git a/impls/mal/step0_repl.mal b/impls/mal/step0_repl.mal new file mode 100644 index 0000000000..837a5fc65e --- /dev/null +++ b/impls/mal/step0_repl.mal @@ -0,0 +1,25 @@ +;; read +(def! READ (fn* [strng] + strng)) + +;; eval +(def! EVAL (fn* [ast] + ast)) + +;; print +(def! PRINT (fn* [exp] exp)) + +;; repl +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng))))) + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (println (rep line))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(repl-loop "") diff --git a/impls/mal/step1_read_print.mal b/impls/mal/step1_read_print.mal new file mode 100644 index 0000000000..dd541faa9d --- /dev/null +++ b/impls/mal/step1_read_print.mal @@ -0,0 +1,28 @@ +;; read +(def! READ read-string) + + +;; eval +(def! EVAL (fn* [ast] + ast)) + +;; print +(def! PRINT pr-str) + +;; repl +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng))))) + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (println "Uncaught exception:" exc)))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(repl-loop "") diff --git a/impls/mal/step2_eval.mal b/impls/mal/step2_eval.mal new file mode 100644 index 0000000000..123e43604d --- /dev/null +++ b/impls/mal/step2_eval.mal @@ -0,0 +1,68 @@ +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval +(def! EVAL (fn* [ast env] + ;; (do (prn "EVAL:" ast)) + (try* + (cond + (symbol? ast) + (let* [res (get env (str ast))] + (if res res (throw (str ast " not found")))) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast) + f (EVAL a0 env) + args (rest ast)] + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc)))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env {"+" + + "-" - + "*" * + "/" /}) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(repl-loop "") diff --git a/impls/mal/step3_env.mal b/impls/mal/step3_env.mal new file mode 100644 index 0000000000..c3a627d3c9 --- /dev/null +++ b/impls/mal/step3_env.mal @@ -0,0 +1,97 @@ +(load-file "../mal/env.mal") + +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval +(def! LET (fn* [env binds form] + (if (empty? binds) + (EVAL form env) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) + +(def! EVAL (fn* [ast env] + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (println "EVAL:" (pr-str ast (env-as-map env)))) + (try* + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] + (do + (env-set env (nth ast 1) val) + val)) + (throw "bad arguments")) + + (= 'let* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc))))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +(env-set repl-env '+ +) +(env-set repl-env '- -) +(env-set repl-env '* *) +(env-set repl-env '/ /) + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(repl-loop "") diff --git a/impls/mal/step4_if_fn_do.mal b/impls/mal/step4_if_fn_do.mal new file mode 100644 index 0000000000..3c9067395b --- /dev/null +++ b/impls/mal/step4_if_fn_do.mal @@ -0,0 +1,117 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval +(def! LET (fn* [env binds form] + (if (empty? binds) + (EVAL form env) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) + +(def! EVAL (fn* [ast env] + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (println "EVAL:" (pr-str ast (env-as-map env)))) + (try* + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] + (do + (env-set env (nth ast 1) val) + val)) + (throw "bad arguments")) + + (= 'let* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) + + (= 'do a0) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) + + (= 'if a0) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) + + (= 'fn* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc))))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [sym] (env-set repl-env sym (eval sym))) core_ns) + +;; core.mal: defined using the new language itself +(rep "(def! not (fn* [a] (if a false true)))") + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(repl-loop "") diff --git a/impls/mal/step6_file.mal b/impls/mal/step6_file.mal new file mode 100644 index 0000000000..41e0d6e286 --- /dev/null +++ b/impls/mal/step6_file.mal @@ -0,0 +1,122 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval +(def! LET (fn* [env binds form] + (if (empty? binds) + (EVAL form env) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) + +(def! EVAL (fn* [ast env] + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (println "EVAL:" (pr-str ast (env-as-map env)))) + (try* + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] + (do + (env-set env (nth ast 1) val) + val)) + (throw "bad arguments")) + + (= 'let* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) + + (= 'do a0) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) + + (= 'if a0) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) + + (= 'fn* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc))))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [sym] (env-set repl-env sym (eval sym))) core_ns) +(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (rest *ARGV*)) + +;; core.mal: defined using the new language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(if (empty? *ARGV*) + (repl-loop "") + (rep (str "(load-file \"" (first *ARGV*) "\")"))) diff --git a/impls/mal/step7_quote.mal b/impls/mal/step7_quote.mal new file mode 100644 index 0000000000..b1c6fb8f43 --- /dev/null +++ b/impls/mal/step7_quote.mal @@ -0,0 +1,154 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval + +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + () + (qq-loop (first xs) (qq-foldr (rest xs)))))) +(def! QUASIQUOTE (fn* [ast] + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) + "else" (qq-foldr ast)))) + +(def! LET (fn* [env binds form] + (if (empty? binds) + (EVAL form env) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) + +(def! EVAL (fn* [ast env] + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (println "EVAL:" (pr-str ast (env-as-map env)))) + (try* + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] + (do + (env-set env (nth ast 1) val) + val)) + (throw "bad arguments")) + + (= 'let* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) + + (= 'quote a0) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) + + (= 'quasiquote a0) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) + + (= 'do a0) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) + + (= 'if a0) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) + + (= 'fn* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc))))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [sym] (env-set repl-env sym (eval sym))) core_ns) +(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (rest *ARGV*)) + +;; core.mal: defined using the new language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(if (empty? *ARGV*) + (repl-loop "") + (rep (str "(load-file \"" (first *ARGV*) "\")"))) diff --git a/impls/mal/step8_macros.mal b/impls/mal/step8_macros.mal new file mode 100644 index 0000000000..e1c88392b2 --- /dev/null +++ b/impls/mal/step8_macros.mal @@ -0,0 +1,168 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval + +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + () + (qq-loop (first xs) (qq-foldr (rest xs)))))) +(def! QUASIQUOTE (fn* [ast] + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) + "else" (qq-foldr ast)))) + +(def! LET (fn* [env binds form] + (if (empty? binds) + (EVAL form env) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) + +(def! EVAL (fn* [ast env] + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (println "EVAL:" (pr-str ast (env-as-map env)))) + (try* + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] + (do + (env-set env (nth ast 1) val) + val)) + (throw "bad arguments")) + + (= 'let* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) + + (= 'quote a0) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) + + (= 'quasiquote a0) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) + + (= 'defmacro! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [f (EVAL (nth ast 2) env)] + (if (fn? f) + (let* [m (defmacro! _ f)] + (do + (env-set env (nth ast 1) m) + m)) + (throw "a macro must be constructed from a function"))) + (throw "bad arguments")) + + (= 'do a0) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) + + (= 'if a0) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) + + (= 'fn* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (macro? f) + (EVAL (apply f args) env) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions"))))))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc))))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [sym] (env-set repl-env sym (eval sym))) core_ns) +(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (rest *ARGV*)) + +;; core.mal: defined using the new language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(if (empty? *ARGV*) + (repl-loop "") + (rep (str "(load-file \"" (first *ARGV*) "\")"))) diff --git a/impls/mal/step9_try.mal b/impls/mal/step9_try.mal new file mode 100644 index 0000000000..54403bfd4a --- /dev/null +++ b/impls/mal/step9_try.mal @@ -0,0 +1,186 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval + +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + () + (qq-loop (first xs) (qq-foldr (rest xs)))))) +(def! QUASIQUOTE (fn* [ast] + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) + "else" (qq-foldr ast)))) + +(def! LET (fn* [env binds form] + (if (empty? binds) + (EVAL form env) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) + +(def! EVAL (fn* [ast env] + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (println "EVAL:" (pr-str ast (env-as-map env)))) + (try* + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] + (do + (env-set env (nth ast 1) val) + val)) + (throw "bad arguments")) + + (= 'let* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) + + (= 'quote a0) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) + + (= 'quasiquote a0) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) + + (= 'defmacro! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [f (EVAL (nth ast 2) env)] + (if (fn? f) + (let* [m (defmacro! _ f)] + (do + (env-set env (nth ast 1) m) + m)) + (throw "a macro must be constructed from a function"))) + (throw "bad arguments")) + + (= 'try* a0) + (if (= 2 (count ast)) + (EVAL (nth ast 1) env) + (if (= 3 (count ast)) + (let* [a2 (nth ast 2)] + (if (if (list? a2) + (if (= 3 (count a2)) + (if (= 'catch* (first a2)) + (symbol? (nth a2 1))))) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (do + (reset! trace "") + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))) + (throw "invalid catch* list"))) + (throw "bad argument count"))) + + (= 'do a0) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) + + (= 'if a0) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) + + (= 'fn* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (macro? f) + (EVAL (apply f args) env) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions"))))))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc))))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [sym] (env-set repl-env sym (eval sym))) core_ns) +(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (rest *ARGV*)) + +;; core.mal: defined using the new language itself +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(if (empty? *ARGV*) + (repl-loop "") + (rep (str "(load-file \"" (first *ARGV*) "\")"))) diff --git a/impls/mal/stepA_mal.mal b/impls/mal/stepA_mal.mal new file mode 100644 index 0000000000..43f69409b1 --- /dev/null +++ b/impls/mal/stepA_mal.mal @@ -0,0 +1,187 @@ +(load-file "../mal/env.mal") +(load-file "../mal/core.mal") + +;; EVAL extends this stack trace when propagating exceptions. If the +;; exception reaches the REPL loop, the full trace is printed. +(def! trace (atom "")) + +;; read +(def! READ read-string) + + +;; eval + +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + () + (qq-loop (first xs) (qq-foldr (rest xs)))))) +(def! QUASIQUOTE (fn* [ast] + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) + "else" (qq-foldr ast)))) + +(def! LET (fn* [env binds form] + (if (empty? binds) + (EVAL form env) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) + +(def! EVAL (fn* [ast env] + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (println "EVAL:" (pr-str ast (env-as-map env)))) + (try* + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= 'def! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] + (do + (env-set env (nth ast 1) val) + val)) + (throw "bad arguments")) + + (= 'let* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) + + (= 'quote a0) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) + + (= 'quasiquote a0) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) + + (= 'defmacro! a0) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [f (EVAL (nth ast 2) env)] + (if (fn? f) + (let* [m (defmacro! _ f)] + (do + (env-set env (nth ast 1) m) + m)) + (throw "a macro must be constructed from a function"))) + (throw "bad arguments")) + + (= 'try* a0) + (if (= 2 (count ast)) + (EVAL (nth ast 1) env) + (if (= 3 (count ast)) + (let* [a2 (nth ast 2)] + (if (if (list? a2) + (if (= 3 (count a2)) + (if (= 'catch* (first a2)) + (symbol? (nth a2 1))))) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (do + (reset! trace "") + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))) + (throw "invalid catch* list"))) + (throw "bad argument count"))) + + (= 'do a0) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) + + (= 'if a0) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) + + (= 'fn* a0) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (macro? f) + (EVAL (apply f args) env) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions"))))))) + + "else" + ast) + + (catch* exc + (do + (swap! trace str "\n in mal EVAL: " ast) + (throw exc))))))) + +;; print +(def! PRINT pr-str) + +;; repl +(def! repl-env (new-env)) +(def! rep (fn* [strng] + (PRINT (EVAL (READ strng) repl-env)))) + +;; core.mal: defined directly using mal +(map (fn* [sym] (env-set repl-env sym (eval sym))) core_ns) +(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (rest *ARGV*)) + +;; core.mal: defined using the new language itself +(rep (str "(def! *host-language* \"" *host-language* "-mal\")")) +(rep "(def! not (fn* [a] (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +;; repl loop +(def! repl-loop (fn* [line] + (if line + (do + (if (not (= "" line)) + (try* + (println (rep line)) + (catch* exc + (do + (println "Uncaught exception:" exc @trace) + (reset! trace ""))))) + (repl-loop (readline "mal-user> ")))))) + +;; main +(if (empty? *ARGV*) + (repl-loop "(println (str \"Mal [\" *host-language* \"]\"))") + (rep (str "(load-file \"" (first *ARGV*) "\")"))) diff --git a/matlab/+types/Atom.m b/impls/matlab/+types/Atom.m similarity index 100% rename from matlab/+types/Atom.m rename to impls/matlab/+types/Atom.m diff --git a/matlab/+types/Function.m b/impls/matlab/+types/Function.m similarity index 89% rename from matlab/+types/Function.m rename to impls/matlab/+types/Function.m index 9270ed15bd..bbbcc9ad7f 100644 --- a/matlab/+types/Function.m +++ b/impls/matlab/+types/Function.m @@ -4,8 +4,8 @@ ast env params - is_macro = false - meta = types.nil; + is_macro = false; + meta = type_utils.nil; end methods function f = Function(fn, ast, env, params) diff --git a/impls/matlab/+types/HashMap.m b/impls/matlab/+types/HashMap.m new file mode 100644 index 0000000000..ab5e76ce56 --- /dev/null +++ b/impls/matlab/+types/HashMap.m @@ -0,0 +1,66 @@ +classdef HashMap < handle + properties + data + meta = type_utils.nil; + end + methods + function obj = HashMap(varargin) + if nargin == 0 + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + obj.data = Dict(); + else + obj.data = containers.Map(); + end + else + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + obj.data = Dict(); + for i=1:2:length(varargin) + obj.data(varargin{i}) = varargin{i+1}; + end + else + obj.data = containers.Map(varargin(1:2:end), ... + varargin(2:2:end)); + end + end + end + + function len = length(obj) + len = length(obj.data); + end + + function ret = get(obj, key) + ret = obj.data(key); + end + + function ret = set(obj, key, val) + obj.data(key) = val; + ret = val; + end + + function ret = keys(obj) + ret = obj.data.keys(); + end + + function ret = values(obj) + ret = obj.data.values(); + end + + function ret = clone(obj) + ret = types.HashMap(); + if length(obj) > 0 + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + ret.data = Dict(obj.data.keys(), obj.data.values()); + else + ret.data = containers.Map(obj.data.keys(), obj.data.values()); + end + else + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + ret.data = Dict(); + else + ret.data = containers.Map(); + end + end + ret.meta = obj.meta; + end + end +end diff --git a/matlab/+types/List.m b/impls/matlab/+types/List.m similarity index 95% rename from matlab/+types/List.m rename to impls/matlab/+types/List.m index 1a9571c41d..f96ae4cddd 100644 --- a/matlab/+types/List.m +++ b/impls/matlab/+types/List.m @@ -1,11 +1,12 @@ classdef List < handle properties - data = {} - meta = types.nil; + data + meta = type_utils.nil; end methods function obj = List(varargin) obj.data = varargin; + meta = type_utils.nil; end function len = length(obj) diff --git a/matlab/+types/MalException.m b/impls/matlab/+types/MalException.m similarity index 100% rename from matlab/+types/MalException.m rename to impls/matlab/+types/MalException.m diff --git a/matlab/+types/Nil.m b/impls/matlab/+types/Nil.m similarity index 100% rename from matlab/+types/Nil.m rename to impls/matlab/+types/Nil.m diff --git a/matlab/+types/Reader.m b/impls/matlab/+types/Reader.m similarity index 100% rename from matlab/+types/Reader.m rename to impls/matlab/+types/Reader.m diff --git a/matlab/+types/Symbol.m b/impls/matlab/+types/Symbol.m similarity index 100% rename from matlab/+types/Symbol.m rename to impls/matlab/+types/Symbol.m diff --git a/matlab/+types/Vector.m b/impls/matlab/+types/Vector.m similarity index 93% rename from matlab/+types/Vector.m rename to impls/matlab/+types/Vector.m index f5dea9cd11..f75ae8470c 100644 --- a/matlab/+types/Vector.m +++ b/impls/matlab/+types/Vector.m @@ -2,6 +2,7 @@ methods function obj = Vector(varargin) obj.data = varargin; + meta = type_utils.nil; end function ret = slice(obj, start, last) diff --git a/impls/matlab/.dockerignore b/impls/matlab/.dockerignore new file mode 100644 index 0000000000..1f682026d7 --- /dev/null +++ b/impls/matlab/.dockerignore @@ -0,0 +1 @@ +octave-4.0.0* diff --git a/impls/matlab/Dict.m b/impls/matlab/Dict.m new file mode 100644 index 0000000000..f0f15ec60e --- /dev/null +++ b/impls/matlab/Dict.m @@ -0,0 +1,61 @@ +% Implement containers.Map like structure +% This only applies to GNU Octave and will break in Matlab when +% arbitrary string keys are used. +classdef Dict < handle + properties + data + end + methods + function dict = Dict(keys, values) + dict.data = struct(); + + if nargin > 0 + for i=1:length(keys) + dict.data.(keys{i}) = values{i}; + end + end + end + + function ret = subsasgn(dict, ind, val) + dict.data.(ind(1).subs{1}) = val; + ret = dict; + end + function ret = subsref(dict, ind) + if strcmp('.', ind(1).type) + % Function call + switch ind(1).subs + case 'isKey' + if numel(ind) > 1 + ret = isfield(dict.data, ind(2).subs{1}); + else + error('Dict:invalidArgs', ... + sprintf('''%s'' called with no arguments', ind(1).subs)); + end + case 'keys' + ret = fieldnames(dict.data); + case 'values' + ret = {}; + keys = fieldnames(dict.data); + for i=1:length(keys) + ret{end+1} = dict.data.(keys{i}); + end + case 'remove' + if numel(ind) > 1 + if numel(ind(2).subs) > 0 + dict.data = rmfield(dict.data, ind(2).subs{1}); + end + else + error('Dict:invalidArgs', ... + sprintf('''%s'' called with no arguments', ind(1).subs)); + end + otherwise + error('Dict:notfound', ... + sprintf('''%s'' not found', ind(1).subs)); + end + else + % Key lookup + ret = dict.data.(ind(1).subs{1}); + end + end + end +end diff --git a/impls/matlab/Dockerfile b/impls/matlab/Dockerfile new file mode 100644 index 0000000000..a7d6026dae --- /dev/null +++ b/impls/matlab/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install octave + +ENV HOME /mal diff --git a/impls/matlab/Env.m b/impls/matlab/Env.m new file mode 100644 index 0000000000..dcc64b2735 --- /dev/null +++ b/impls/matlab/Env.m @@ -0,0 +1,53 @@ +classdef Env < handle + properties + data + outer + end + methods + function env = Env(outer, binds, exprs) + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + env.data = Dict(); + else + env.data = containers.Map(); + end + + if nargin == 0 + env.outer = false; + else + % Workaround Octave calling bug when the first + % argument is the same type as the class (the class is + % not properly initialized in that case) + env.outer = outer{1}; + end + + if nargin > 1 + %env = Env(outer); + for i=1:length(binds) + k = binds.get(i).name; + if strcmp(k, '&') + env.data(binds.get(i+1).name) = exprs.slice(i); + break; + else + env.data(k) = exprs.get(i); + end + end + end + end + + function ret = set(env, k, v) + env.data(k.name) = v; + ret = v; + end + + function ret = get(env, k) + while ~env.data.isKey(k) + env = env.outer; + if islogical(env) + ret = {}; + return; + end + end + ret = env.data(k); + end + end +end diff --git a/impls/matlab/Makefile b/impls/matlab/Makefile new file mode 100644 index 0000000000..82fa2ef848 --- /dev/null +++ b/impls/matlab/Makefile @@ -0,0 +1,4 @@ +all: + +clean: + diff --git a/impls/matlab/core.m b/impls/matlab/core.m new file mode 100644 index 0000000000..44c0ba4e90 --- /dev/null +++ b/impls/matlab/core.m @@ -0,0 +1,304 @@ +classdef core + methods(Static) + function ret = throw(obj) + ret = type_utils.nil; + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + % Until Octave has MException objects, we need to + % store the error object globally to be able to pass + % it to the error handler. + global error_object; + error_object = obj; + exc = struct('identifier', 'MalException:object',... + 'message', 'MalException'); + rethrow(exc); + else + throw(types.MalException(obj)); + end + end + + function str = pr_str(varargin) + strs = cellfun(@(s) printer.pr_str(s,true), varargin, ... + 'UniformOutput', false); + str = strjoin(strs, ' '); + end + function str = do_str(varargin) + strs = cellfun(@(s) printer.pr_str(s,false), varargin, ... + 'UniformOutput', false); + str = strjoin(strs, ''); + end + function ret = prn(varargin) + strs = cellfun(@(s) printer.pr_str(s,true), varargin, ... + 'UniformOutput', false); + fprintf('%s\n', strjoin(strs, ' ')); + ret = type_utils.nil; + end + function ret = println(varargin) + strs = cellfun(@(s) printer.pr_str(s,false), varargin, ... + 'UniformOutput', false); + fprintf('%s\n', strjoin(strs, ' ')); + ret = type_utils.nil; + end + + function ret = time_ms() + secs = now-repmat(datenum('1970-1-1 00:00:00'),size(now)); + ret = floor(secs.*repmat(24*3600.0*1000,size(now))); + end + + function new_hm = assoc(hm, varargin) + new_hm = clone(hm); + for i=1:2:length(varargin) + new_hm.set(varargin{i}, varargin{i+1}); + end + end + + function new_hm = dissoc(hm, varargin) + new_hm = clone(hm); + ks = intersect(hm.keys(),varargin); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + new_hm.data.remove(ks); + else + remove(new_hm.data, ks); + end + end + + function ret = get(hm, key) + if isa(hm, 'types.Nil') + ret = type_utils.nil; + elseif hm.data.isKey(key) + ret = hm.data(key); + else + ret = type_utils.nil; + end + end + + function ret = keys(hm) + ks = hm.keys(); + ret = types.List(ks{:}); + end + + function ret = vals(hm) + vs = hm.values(); + ret = types.List(vs{:}); + end + + function ret = cons(a, seq) + cella = [{a}, seq.data]; + ret = types.List(cella{:}); + end + + function ret = concat(varargin) + if nargin == 0 + cella = {}; + else + cells = cellfun(@(x) x.data, varargin, ... + 'UniformOutput', false); + cella = cat(2,cells{:}); + end + ret = types.List(cella{:}); + end + + function ret = first(seq) + if isa(seq, 'types.Nil') + ret = type_utils.nil; + elseif length(seq) < 1 + ret = type_utils.nil; + else + ret = seq.get(1); + end + end + + function ret = rest(seq) + if isa(seq, 'types.Nil') + ret = types.List(); + else + cella = seq.data(2:end); + ret = types.List(cella{:}); + end + end + + function ret = nth(seq, idx) + if idx+1 > length(seq) + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('Range:nth', ... + 'nth: index out of range'); + else + throw(MException('Range:nth', ... + 'nth: index out of range')) + end + end + ret = seq.get(idx+1); + end + + function ret = apply(varargin) + f = varargin{1}; + if isa(f, 'types.Function') + f = f.fn; + end + first_args = varargin(2:end-1); + rest_args = varargin{end}.data; + args = [first_args rest_args]; + ret = f(args{:}); + end + + function ret = map(f, lst) + if isa(f, 'types.Function') + f = f.fn; + end + cells = cellfun(@(x) f(x), lst.data, 'UniformOutput', false); + ret = types.List(cells{:}); + end + + function ret = conj(varargin) + seq = varargin{1}; + args = varargin(2:end); + if type_utils.list_Q(seq) + cella = [fliplr(args), seq.data]; + ret = types.List(cella{:}); + else + cella = [seq.data, args]; + ret = types.Vector(cella{:}); + end + end + + function ret = seq(obj) + if type_utils.list_Q(obj) + if length(obj) > 0 + ret = obj; + else + ret = type_utils.nil; + end + elseif type_utils.vector_Q(obj) + if length(obj) > 0 + ret = types.List(obj.data{:}); + else + ret = type_utils.nil; + end + elseif type_utils.string_Q(obj) + if length(obj) > 0 + cells = cellfun(@(c) char(c),... + num2cell(double(obj)),... + 'UniformOutput', false); + ret = types.List(cells{:}); + else + ret = type_utils.nil; + end + elseif isa(obj, 'types.Nil') + ret = type_utils.nil; + else + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('Type:seq', ... + 'seq: called on non-sequence'); + else + throw(MException('Type:seq',... + 'seq: called on non-sequence')) + end + end + end + + function new_obj = with_meta(obj, meta) + new_obj = clone(obj); + new_obj.meta = meta; + end + + function meta = meta(obj) + switch class(obj) + case {'types.List', 'types.Vector', + 'types.HashMap', 'types.Function'} + meta = obj.meta; + otherwise + meta = type_utils.nil; + end + end + + function ret = reset_BANG(atm, val) + atm.val = val; + ret = val; + end + + function ret = swap_BANG(atm, f, varargin) + args = [{atm.val} varargin]; + if isa(f, 'types.Function') + f = f.fn; + end + atm.val = f(args{:}); + ret = atm.val; + end + + function n = ns() + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + n = Dict(); + else + n = containers.Map(); + end + n('=') = @(a,b) type_utils.equal(a,b); + n('throw') = @(a) core.throw(a); + n('nil?') = @(a) isa(a, 'types.Nil'); + n('true?') = @(a) isa(a, 'logical') && a == true; + n('false?') = @(a) isa(a, 'logical') && a == false; + n('string?') = @(a) type_utils.string_Q(a); + n('symbol') = @(a) types.Symbol(a); + n('symbol?') = @(a) isa(a, 'types.Symbol'); + n('keyword') = @(a) type_utils.keyword(a); + n('keyword?') = @(a) type_utils.keyword_Q(a); + n('number?') = @(a) type_utils.number_Q(a); + n('fn?') = @(a) type_utils.fn_Q(a); + n('macro?') = @(a) type_utils.macro_Q(a); + + n('pr-str') = @(varargin) core.pr_str(varargin{:}); + n('str') = @(varargin) core.do_str(varargin{:}); + n('prn') = @(varargin) core.prn(varargin{:}); + n('println') = @(varargin) core.println(varargin{:}); + n('read-string') = @(a) reader.read_str(a); + n('readline') = @(p) input(p, 's'); + n('slurp') = @(a) fileread(a); + + n('<') = @(a,b) a') = @(a,b) a>b; + n('>=') = @(a,b) a>=b; + n('+') = @(a,b) a+b; + n('-') = @(a,b) a-b; + n('*') = @(a,b) a*b; + n('/') = @(a,b) floor(a/b); + n('time-ms') = @() core.time_ms(); + + n('list') = @(varargin) types.List(varargin{:}); + n('list?') = @(a) type_utils.list_Q(a); + n('vector') = @(varargin) types.Vector(varargin{:}); + n('vector?') = @(a) type_utils.vector_Q(a); + n('hash-map') = @(varargin) types.HashMap(varargin{:}); + n('map?') = @(a) type_utils.hash_map_Q(a); + n('assoc') = @(varargin) core.assoc(varargin{:}); + n('dissoc') = @(varargin) core.dissoc(varargin{:}); + n('get') = @(a,b) core.get(a,b); + n('contains?') = @(a,b) a.data.isKey(b); + n('keys') = @(a) core.keys(a); + n('vals') = @(a) core.vals(a); + + n('sequential?') = @(a) type_utils.sequential_Q(a); + n('cons') = @(a,b) core.cons(a,b); + n('concat') = @(varargin) core.concat(varargin{:}); + n('vec') = @(a) types.Vector(a.data{:}); + n('nth') = @(a,b) core.nth(a,b); + n('first') = @(a) core.first(a); + n('rest') = @(a) core.rest(a); + n('empty?') = @(a) length(a) == 0; + % workaround Octave always giving length(a) of 1 + n('count') = @(a) 0 + length(a); + n('apply') = @(varargin) core.apply(varargin{:}); + n('map') = @(varargin) core.map(varargin{:}); + + n('conj') = @(varargin) core.conj(varargin{:}); + n('seq') = @(a) core.seq(a); + + n('with-meta') = @(a,b) core.with_meta(a,b); + n('meta') = @(a) core.meta(a); + n('atom') = @(a) types.Atom(a); + n('atom?') = @(a) isa(a, 'types.Atom'); + n('deref') = @(a) a.val; + n('reset!') = @(a,b) core.reset_BANG(a,b); + n('swap!') = @(varargin) core.swap_BANG(varargin{:}); + end + end +end + diff --git a/impls/matlab/printer.m b/impls/matlab/printer.m new file mode 100644 index 0000000000..91c8f0d372 --- /dev/null +++ b/impls/matlab/printer.m @@ -0,0 +1,55 @@ +% this is just being used as a namespace +classdef printer + methods (Static = true) + function str = pr_str(obj, print_readably) + switch class(obj) + case 'types.Symbol' + str = obj.name; + case 'double' + str = num2str(obj); + case 'char' + if type_utils.keyword_Q(obj) + str = sprintf(':%s', obj(2:end)); + else + if print_readably + str = strrep(obj, '\', '\\'); + str = strrep(str, '"', '\"'); + str = strrep(str, char(10), '\n'); + str = sprintf('"%s"', str); + else + str = obj; + end + end + case 'types.List' + strs = cellfun(@(x) printer.pr_str(x, print_readably), ... + obj.data, 'UniformOutput', false); + str = sprintf('(%s)', strjoin(strs, ' ')); + case 'types.Vector' + strs = cellfun(@(x) printer.pr_str(x, print_readably), ... + obj.data, 'UniformOutput', false); + str = sprintf('[%s]', strjoin(strs, ' ')); + case 'types.HashMap' + strs = {}; + ks = obj.keys(); + for i=1:length(ks) + k = ks{i}; + strs{end+1} = printer.pr_str(k, print_readably); + strs{end+1} = printer.pr_str(obj.get(k), print_readably); + end + str = sprintf('{%s}', strjoin(strs, ' ')); + case 'types.Nil' + str = 'nil'; + case 'logical' + if eq(obj, true) + str = 'true'; + else + str = 'false'; + end + case 'types.Atom' + str = sprintf('(atom %s)', printer.pr_str(obj.val,true)); + otherwise + str = '#'; + end + end + end +end diff --git a/impls/matlab/reader.m b/impls/matlab/reader.m new file mode 100644 index 0000000000..55d672c28b --- /dev/null +++ b/impls/matlab/reader.m @@ -0,0 +1,131 @@ +% this is just being used as a namespace +classdef reader + methods (Static = true) + function tokens = tokenize(str) + re = '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"?|;[^\n]*|[^\s\[\]{}(''"`,;)]*)'; + % extract the capture group (to ignore spaces and commas) + tokens = cellfun(@(x) x(1), regexp(str, re, 'tokens')); + comments = cellfun(@(x) length(x) > 0 && x(1) == ';', tokens); + tokens = tokens(~comments); + end + + function atm = read_atom(rdr) + token = rdr.next(); + %fprintf('in read_atom: %s\n', token); + if not(isempty(regexp(token, '^-?[0-9]+$', 'match'))) + atm = str2double(token); + elseif not(isempty(regexp(token, '^"(?:\\.|[^\\"])*"$', 'match'))) + atm = token(2:length(token)-1); + % If overlaps is enabled here then only the first '\\' + % is replaced. Probably an GNU Octave bug since the + % other repeated pairs are substituted correctly. + atm = strrep(atm, '\\', char(255), 'overlaps', false); + atm = strrep(atm, '\"', '"'); + atm = strrep(atm, '\n', char(10)); + atm = strrep(atm, char(255), '\'); + elseif strcmp(token(1), '"') + error('expected ''"'', got EOF'); + elseif strcmp(token(1), ':') + s = token(2:end); + atm = type_utils.keyword(s); + elseif strcmp(token, 'nil') + atm = type_utils.nil; + elseif strcmp(token, 'true') + atm = true; + elseif strcmp(token, 'false') + atm = false; + else + atm = types.Symbol(token); + end + end + + function seq = read_seq(rdr, start, last) + %fprintf('in read_seq\n'); + seq = {}; + token = rdr.next(); + if not(strcmp(token, start)) + error(sprintf('expected ''%s'', got EOF', start)); + end + token = rdr.peek(); + while true + if eq(token, false) + error(sprintf('expected ''%s'', got EOF', last)); + end + if strcmp(token, last), break, end + seq{end+1} = reader.read_form(rdr); + token = rdr.peek(); + end + rdr.next(); + end + + function lst = read_list(rdr) + seq = reader.read_seq(rdr, '(', ')'); + lst = types.List(seq{:}); + end + + function vec = read_vector(rdr) + seq = reader.read_seq(rdr, '[', ']'); + vec = types.Vector(seq{:}); + end + + function map = read_hash_map(rdr) + seq = reader.read_seq(rdr, '{', '}'); + map = types.HashMap(seq{:}); + end + + function ast = read_form(rdr) + %fprintf('in read_form\n'); + token = rdr.peek(); + switch token + case '''' + rdr.next(); + ast = types.List(types.Symbol('quote'), ... + reader.read_form(rdr)); + case '`' + rdr.next(); + ast = types.List(types.Symbol('quasiquote'), ... + reader.read_form(rdr)); + case '~' + rdr.next(); + ast = types.List(types.Symbol('unquote'), ... + reader.read_form(rdr)); + case '~@' + rdr.next(); + ast = types.List(types.Symbol('splice-unquote'), ... + reader.read_form(rdr)); + case '^' + rdr.next(); + meta = reader.read_form(rdr); + ast = types.List(types.Symbol('with-meta'), ... + reader.read_form(rdr), meta); + case '@' + rdr.next(); + ast = types.List(types.Symbol('deref'), ... + reader.read_form(rdr)); + + case ')' + error('unexpected '')'''); + case '(' + ast = reader.read_list(rdr); + case ']' + error('unexpected '']'''); + case '[' + ast = reader.read_vector(rdr); + case '}' + error('unexpected ''}'''); + case '{' + ast = reader.read_hash_map(rdr); + otherwise + ast = reader.read_atom(rdr); + end + end + + function ast = read_str(str) + %fprintf('in read_str\n'); + tokens = reader.tokenize(str); + %disp(tokens); + rdr = types.Reader(tokens); + ast = reader.read_form(rdr); + end + end +end diff --git a/impls/matlab/run b/impls/matlab/run new file mode 100755 index 0000000000..332c5903de --- /dev/null +++ b/impls/matlab/run @@ -0,0 +1,21 @@ +#!/bin/sh + +args= +for x; do + args="$args${args:+, }'$x'" +done + +case "$matlab_MODE" in + matlab) + options='-nodisplay -nosplash -nodesktop -nojvm -r' + ;; + octave) + options='-q --no-gui --no-history --eval' + ;; + *) + echo "Bad matlab_MODE: $matlab_MODE" + exit 1 + ;; +esac + +exec $matlab_MODE $options "${STEP:-stepA_mal}($args);quit;" diff --git a/matlab/step0_repl.m b/impls/matlab/step0_repl.m similarity index 100% rename from matlab/step0_repl.m rename to impls/matlab/step0_repl.m diff --git a/impls/matlab/step1_read_print.m b/impls/matlab/step1_read_print.m new file mode 100644 index 0000000000..06dcc57924 --- /dev/null +++ b/impls/matlab/step1_read_print.m @@ -0,0 +1,39 @@ +function step1_read_print(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = EVAL(ast, env) + ret = ast; +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, '')); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step2_eval.m b/impls/matlab/step2_eval.m new file mode 100644 index 0000000000..c493da9dcf --- /dev/null +++ b/impls/matlab/step2_eval.m @@ -0,0 +1,89 @@ +function step2_eval(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = EVAL(ast, env) + + % fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + + switch class(ast) + case 'types.Symbol' + ret = env(ast.name); + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + ret = f(args.data{:}); + +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + repl_env = Dict(); + else + repl_env = containers.Map(); + end + repl_env('+') = @(a,b) a+b; + repl_env('-') = @(a,b) a-b; + repl_env('*') = @(a,b) a*b; + repl_env('/') = @(a,b) floor(a/b); + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step3_env.m b/impls/matlab/step3_env.m new file mode 100644 index 0000000000..1c2de94acf --- /dev/null +++ b/impls/matlab/step3_env.m @@ -0,0 +1,113 @@ +function step3_env(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = EVAL(ast, env) + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + ret = EVAL(ast.get(3), let_env); + otherwise + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + ret = f(args.data{:}); + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + repl_env.set(types.Symbol('+'), @(a,b) a+b); + repl_env.set(types.Symbol('-'), @(a,b) a-b); + repl_env.set(types.Symbol('*'), @(a,b) a*b); + repl_env.set(types.Symbol('/'), @(a,b) floor(a/b)); + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step4_if_fn_do.m b/impls/matlab/step4_if_fn_do.m new file mode 100644 index 0000000000..f128c1b7c1 --- /dev/null +++ b/impls/matlab/step4_if_fn_do.m @@ -0,0 +1,138 @@ +function step4_if_fn_do(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = EVAL(ast, env) + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + ret = EVAL(ast.get(3), let_env); + case 'do' + for i=2:length(ast) + ret = EVAL(ast.get(i), env); + end + case 'if' + cond = EVAL(ast.get(2), env); + if strcmp(class(cond), 'types.Nil') || ... + (islogical(cond) && cond == false) + if length(ast) > 3 + ret = EVAL(ast.get(4), env); + else + ret = type_utils.nil; + end + else + ret = EVAL(ast.get(3), env); + end + case 'fn*' + ret = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... + types.List(varargin{:}))); + otherwise + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + ret = f(args.data{:}); + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + + % core.m: defined using matlab + ns = core.ns(); ks = ns.keys(); + for i=1:length(ks) + k = ks{i}; + repl_env.set(types.Symbol(k), ns(k)); + end + + % core.mal: defined using the langauge itself + rep('(def! not (fn* (a) (if a false true)))', repl_env); + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step5_tco.m b/impls/matlab/step5_tco.m new file mode 100644 index 0000000000..e092ac92f3 --- /dev/null +++ b/impls/matlab/step5_tco.m @@ -0,0 +1,152 @@ +function step5_tco(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + return; + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + env = let_env; + ast = ast.get(3); % TCO + case 'do' + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end + ast = ast.get(length(ast)); % TCO + case 'if' + cond = EVAL(ast.get(2), env); + if strcmp(class(cond), 'types.Nil') || ... + (islogical(cond) && cond == false) + if length(ast) > 3 + ast = ast.get(4); % TCO + else + ret = type_utils.nil; + return; + end + else + ast = ast.get(3); % TCO + end + case 'fn*' + fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... + types.List(varargin{:}))); + ret = types.Function(fn, ast.get(3), env, ast.get(2)); + return; + otherwise + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + if isa(f, 'types.Function') + env = Env({f.env}, f.params, args); + ast = f.ast; % TCO + else + ret = f(args.data{:}); + return + end + end + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + + % core.m: defined using matlab + ns = core.ns(); ks = ns.keys(); + for i=1:length(ks) + k = ks{i}; + repl_env.set(types.Symbol(k), ns(k)); + end + + % core.mal: defined using the langauge itself + rep('(def! not (fn* (a) (if a false true)))', repl_env); + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step6_file.m b/impls/matlab/step6_file.m new file mode 100644 index 0000000000..b5d69f8c63 --- /dev/null +++ b/impls/matlab/step6_file.m @@ -0,0 +1,161 @@ +function step6_file(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + return; + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + env = let_env; + ast = ast.get(3); % TCO + case 'do' + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end + ast = ast.get(length(ast)); % TCO + case 'if' + cond = EVAL(ast.get(2), env); + if strcmp(class(cond), 'types.Nil') || ... + (islogical(cond) && cond == false) + if length(ast) > 3 + ast = ast.get(4); % TCO + else + ret = type_utils.nil; + return; + end + else + ast = ast.get(3); % TCO + end + case 'fn*' + fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... + types.List(varargin{:}))); + ret = types.Function(fn, ast.get(3), env, ast.get(2)); + return; + otherwise + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + if isa(f, 'types.Function') + env = Env({f.env}, f.params, args); + ast = f.ast; % TCO + else + ret = f(args.data{:}); + return + end + end + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + + % core.m: defined using matlab + ns = core.ns(); ks = ns.keys(); + for i=1:length(ks) + k = ks{i}; + repl_env.set(types.Symbol(k), ns(k)); + end + repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); + rest_args = args(2:end); + repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); + + % core.mal: defined using the langauge itself + rep('(def! not (fn* (a) (if a false true)))', repl_env); + rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); + + if ~isempty(args) + rep(sprintf('(load-file "%s")', args{1}), repl_env); + quit; + end + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step7_quote.m b/impls/matlab/step7_quote.m new file mode 100644 index 0000000000..ef5a9a7c02 --- /dev/null +++ b/impls/matlab/step7_quote.m @@ -0,0 +1,203 @@ +function step7_quote(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end +end + +function ret = quasiquote(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} + ret = types.List(types.Symbol('quote'), ast); + otherwise + ret = ast; + end +end + +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + return; + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + env = let_env; + ast = ast.get(3); % TCO + case 'quote' + ret = ast.get(2); + return; + case 'quasiquote' + ast = quasiquote(ast.get(2)); % TCO + case 'do' + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end + ast = ast.get(length(ast)); % TCO + case 'if' + cond = EVAL(ast.get(2), env); + if strcmp(class(cond), 'types.Nil') || ... + (islogical(cond) && cond == false) + if length(ast) > 3 + ast = ast.get(4); % TCO + else + ret = type_utils.nil; + return; + end + else + ast = ast.get(3); % TCO + end + case 'fn*' + fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... + types.List(varargin{:}))); + ret = types.Function(fn, ast.get(3), env, ast.get(2)); + return; + otherwise + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + if isa(f, 'types.Function') + env = Env({f.env}, f.params, args); + ast = f.ast; % TCO + else + ret = f(args.data{:}); + return + end + end + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + + % core.m: defined using matlab + ns = core.ns(); ks = ns.keys(); + for i=1:length(ks) + k = ks{i}; + repl_env.set(types.Symbol(k), ns(k)); + end + repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); + rest_args = args(2:end); + repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); + + % core.mal: defined using the langauge itself + rep('(def! not (fn* (a) (if a false true)))', repl_env); + rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); + + if ~isempty(args) + rep(sprintf('(load-file "%s")', args{1}), repl_env); + quit; + end + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step8_macros.m b/impls/matlab/step8_macros.m new file mode 100644 index 0000000000..9693e69f0d --- /dev/null +++ b/impls/matlab/step8_macros.m @@ -0,0 +1,212 @@ +function step8_macros(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end +end + +function ret = quasiquote(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} + ret = types.List(types.Symbol('quote'), ast); + otherwise + ret = ast; + end +end + +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + return; + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + env = let_env; + ast = ast.get(3); % TCO + case 'quote' + ret = ast.get(2); + return; + case 'quasiquote' + ast = quasiquote(ast.get(2)); % TCO + case 'defmacro!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); + ret.is_macro = true; + return; + case 'do' + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end + ast = ast.get(length(ast)); % TCO + case 'if' + cond = EVAL(ast.get(2), env); + if strcmp(class(cond), 'types.Nil') || ... + (islogical(cond) && cond == false) + if length(ast) > 3 + ast = ast.get(4); % TCO + else + ret = type_utils.nil; + return; + end + else + ast = ast.get(3); % TCO + end + case 'fn*' + fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... + types.List(varargin{:}))); + ret = types.Function(fn, ast.get(3), env, ast.get(2)); + return; + otherwise + f = EVAL(ast.get(1), env); + if isa(f,'types.Function') && f.is_macro + ast = f.fn(ast.slice(2).data{:}); % TCO + else + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + if isa(f, 'types.Function') + env = Env({f.env}, f.params, args); + ast = f.ast; % TCO + else + ret = f(args.data{:}); + return + end + end + end + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + + % core.m: defined using matlab + ns = core.ns(); ks = ns.keys(); + for i=1:length(ks) + k = ks{i}; + repl_env.set(types.Symbol(k), ns(k)); + end + repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); + rest_args = args(2:end); + repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); + + % core.mal: defined using the langauge itself + rep('(def! not (fn* (a) (if a false true)))', repl_env); + rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); + rep('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))', repl_env); + + if ~isempty(args) + rep(sprintf('(load-file "%s")', args{1}), repl_env); + quit; + end + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + fprintf('Error: %s\n', err.message); + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/step9_try.m b/impls/matlab/step9_try.m new file mode 100644 index 0000000000..eaa35ac60a --- /dev/null +++ b/impls/matlab/step9_try.m @@ -0,0 +1,245 @@ +function step9_try(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end +end + +function ret = quasiquote(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} + ret = types.List(types.Symbol('quote'), ast); + otherwise + ret = ast; + end +end + +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + return; + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + env = let_env; + ast = ast.get(3); % TCO + case 'quote' + ret = ast.get(2); + return; + case 'quasiquote' + ast = quasiquote(ast.get(2)); % TCO + case 'defmacro!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); + ret.is_macro = true; + return; + case 'try*' + try + ret = EVAL(ast.get(2), env); + return; + catch e + if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*') + if strcmp(e.identifier, 'MalException:object') + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + global error_object; + exc = error_object; + else + exc = e.obj; + end + else + exc = e.message; + end + catch_env = Env({env}, types.List(ast.get(3).get(2)), ... + types.List(exc)); + ret = EVAL(ast.get(3).get(3), catch_env); + return; + else + rethrow(e); + end + end + case 'do' + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end + ast = ast.get(length(ast)); % TCO + case 'if' + cond = EVAL(ast.get(2), env); + if strcmp(class(cond), 'types.Nil') || ... + (islogical(cond) && cond == false) + if length(ast) > 3 + ast = ast.get(4); % TCO + else + ret = type_utils.nil; + return; + end + else + ast = ast.get(3); % TCO + end + case 'fn*' + fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... + types.List(varargin{:}))); + ret = types.Function(fn, ast.get(3), env, ast.get(2)); + return; + otherwise + f = EVAL(ast.get(1), env); + if isa(f,'types.Function') && f.is_macro + ast = f.fn(ast.slice(2).data{:}); % TCO + else + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + if isa(f, 'types.Function') + env = Env({f.env}, f.params, args); + ast = f.ast; % TCO + else + ret = f(args.data{:}); + return + end + end + end + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + + % core.m: defined using matlab + ns = core.ns(); ks = ns.keys(); + for i=1:length(ks) + k = ks{i}; + repl_env.set(types.Symbol(k), ns(k)); + end + repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); + rest_args = args(2:end); + repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); + + % core.mal: defined using the langauge itself + rep('(def! not (fn* (a) (if a false true)))', repl_env); + rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); + rep('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))', repl_env); + + if ~isempty(args) + rep(sprintf('(load-file "%s")', args{1}), repl_env); + quit; + end + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + if strcmp('MalException:object', err.identifier) + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + global error_object; + fprintf('Error: %s\n', printer.pr_str(error_object, true)); + else + fprintf('Error: %s\n', printer.pr_str(err.obj, true)); + end + else + fprintf('Error: %s\n', err.message); + end + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/stepA_mal.m b/impls/matlab/stepA_mal.m new file mode 100644 index 0000000000..77dbb3374a --- /dev/null +++ b/impls/matlab/stepA_mal.m @@ -0,0 +1,247 @@ +function stepA_mal(varargin), main(varargin), end + +% read +function ret = READ(str) + ret = reader.read_str(str); +end + +% eval +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end +end + +function ret = quasiquote(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} + ret = types.List(types.Symbol('quote'), ast); + otherwise + ret = ast; + end +end + +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + + switch class(ast) + case 'types.Symbol' + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end + end + return; + case 'types.List' + % Proceed after this switch. + case 'types.Vector' + ret = types.Vector(); + for i=1:length(ast) + ret.append(EVAL(ast.get(i), env)); + end + return; + case 'types.HashMap' + ret = types.HashMap(); + ks = ast.keys(); + for i=1:length(ks) + k = ks{i}; + ret.set(k, EVAL(ast.get(k), env)); + end + return; + otherwise + ret = ast; + return; + end + + % apply + if length(ast) == 0 + ret = ast; + return; + end + + if isa(ast.get(1),'types.Symbol') + a1sym = ast.get(1).name; + else + a1sym = '_@$fn$@_'; + end + switch (a1sym) + case 'def!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env)); + return; + case 'let*' + let_env = Env({env}); + for i=1:2:length(ast.get(2)) + let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); + end + env = let_env; + ast = ast.get(3); % TCO + case 'quote' + ret = ast.get(2); + return; + case 'quasiquote' + ast = quasiquote(ast.get(2)); % TCO + case 'defmacro!' + ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); + ret.is_macro = true; + return; + case 'try*' + try + ret = EVAL(ast.get(2), env); + return; + catch e + if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*') + if strcmp(e.identifier, 'MalException:object') + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + global error_object; + exc = error_object; + else + exc = e.obj; + end + else + exc = e.message; + end + catch_env = Env({env}, types.List(ast.get(3).get(2)), ... + types.List(exc)); + ret = EVAL(ast.get(3).get(3), catch_env); + return; + else + rethrow(e); + end + end + case 'do' + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end + ast = ast.get(length(ast)); % TCO + case 'if' + cond = EVAL(ast.get(2), env); + if strcmp(class(cond), 'types.Nil') || ... + (islogical(cond) && cond == false) + if length(ast) > 3 + ast = ast.get(4); % TCO + else + ret = type_utils.nil; + return; + end + else + ast = ast.get(3); % TCO + end + case 'fn*' + fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... + types.List(varargin{:}))); + ret = types.Function(fn, ast.get(3), env, ast.get(2)); + return; + otherwise + f = EVAL(ast.get(1), env); + if isa(f,'types.Function') && f.is_macro + ast = f.fn(ast.slice(2).data{:}); % TCO + else + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + if isa(f, 'types.Function') + env = Env({f.env}, f.params, args); + ast = f.ast; % TCO + else + ret = f(args.data{:}); + return + end + end + end + end +end + +% print +function ret = PRINT(ast) + ret = printer.pr_str(ast, true); +end + +% REPL +function ret = rep(str, env) + ret = PRINT(EVAL(READ(str), env)); +end + +function main(args) + repl_env = Env(); + + % core.m: defined using matlab + ns = core.ns(); ks = ns.keys(); + for i=1:length(ks) + k = ks{i}; + repl_env.set(types.Symbol(k), ns(k)); + end + repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); + rest_args = args(2:end); + repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); + + % core.mal: defined using the langauge itself + rep('(def! *host-language* "matlab")', repl_env); + rep('(def! not (fn* (a) (if a false true)))', repl_env); + rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); + rep('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))', repl_env); + + if ~isempty(args) + rep(sprintf('(load-file "%s")', args{1}), repl_env); + quit; + end + + %cleanObj = onCleanup(@() disp('*** here1 ***')); + rep('(println (str "Mal [" *host-language* "]"))', repl_env); + while (true) + try + line = input('user> ', 's'); + catch err + return + end + if strcmp(strtrim(line),''), continue, end + try + fprintf('%s\n', rep(line, repl_env)); + catch err + if strcmp('MalException:object', err.identifier) + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + global error_object; + fprintf('Error: %s\n', printer.pr_str(error_object, true)); + else + fprintf('Error: %s\n', printer.pr_str(err.obj, true)); + end + else + fprintf('Error: %s\n', err.message); + end + type_utils.print_stack(err); + end + end +end diff --git a/impls/matlab/type_utils.m b/impls/matlab/type_utils.m new file mode 100644 index 0000000000..939df5260e --- /dev/null +++ b/impls/matlab/type_utils.m @@ -0,0 +1,104 @@ +classdef type_utils + properties (Constant = true) + nil = types.Nil(); + end + + methods(Static) + function ret = equal(a,b) + ret = false; + ota = class(a); otb = class(b); + if ~(strcmp(ota,otb) || ... + (type_utils.sequential_Q(a) && type_utils.sequential_Q(b))) + return; + end + switch (ota) + case {'types.List', 'types.Vector'} + if ~(length(a) == length(b)) + return; + end + for i=1:length(a) + if ~(type_utils.equal(a.get(i), b.get(i))) + return; + end + end + ret = true; + case 'types.HashMap' + if ~(length(a) == length(b)) + return; + end + ks1 = a.keys(); + for i=1:length(ks1) + k = ks1{i}; + if ~(b.data.isKey(k)) + return; + end + if ~(type_utils.equal(a.data(k), b.data(k))) + return; + end + end + ret = true; + case 'char' + ret = strcmp(a,b); + otherwise + ret = a == b; + end + end + + function ret = sequential_Q(obj) + ret = strcmp(class(obj), 'types.List') || ... + strcmp(class(obj), 'types.Vector'); + end + + function ret = list_Q(obj) + ret = strcmp(class(obj), 'types.List'); + end + function ret = vector_Q(obj) + ret = strcmp(class(obj), 'types.Vector'); + end + function ret = hash_map_Q(obj) + ret = strcmp(class(obj), 'types.HashMap'); + end + + function ret = keyword(str) + if type_utils.keyword_Q(str) + ret = str; + else + ret = sprintf('%c%s', 255, str); + end + end + function ret = keyword_Q(obj) + ret = length(obj) > 1 && strcmp(obj(1), sprintf('%c', 255)); + end + + function ret = string_Q(obj) + ret = strcmp(class(obj), 'char') && ~type_utils.keyword_Q(obj); + end + + function ret = number_Q(obj) + ret = strcmp(class(obj), 'double'); + end + + function ret = fn_Q(obj) + ret = isa(obj,'function_handle') || ... + (isa(obj,'types.Function') && ~obj.is_macro); + end + + function ret = macro_Q(obj) + ret = isa(obj,'types.Function') && obj.is_macro; + end + + function print_stack(err) + for i=1:numel(err.stack) + stack = err.stack(i); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + fprintf(' %s at line %d column %d (%s)\n', ... + stack.name, stack.line, stack.column, stack.file); + else + fprintf(' %s at line %d (%s)\n', ... + stack.name, stack.line, stack.file); + end + end + end + end +end + diff --git a/matlab/types b/impls/matlab/types similarity index 100% rename from matlab/types rename to impls/matlab/types diff --git a/impls/miniMAL/Dockerfile b/impls/miniMAL/Dockerfile new file mode 100644 index 0000000000..b6a4873b81 --- /dev/null +++ b/impls/miniMAL/Dockerfile @@ -0,0 +1,30 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin +LABEL org.opencontainers.image.source=https://github.com/kanaka/mal +LABEL org.opencontainers.image.description="mal test container: miniMAL" + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# For building node modules +RUN apt-get -y install g++ libreadline-dev nodejs npm + +ENV NPM_CONFIG_CACHE /mal/.npm + +# install miniMAL itself +RUN npm install -g minimal-lisp@1.2.2 diff --git a/impls/miniMAL/Makefile b/impls/miniMAL/Makefile new file mode 100644 index 0000000000..4d5a808de2 --- /dev/null +++ b/impls/miniMAL/Makefile @@ -0,0 +1,30 @@ + +SOURCES_BASE = node_readline.js miniMAL-core.json \ + types.json reader.json printer.json +SOURCES_LISP = env.json core.json stepA_mal.json +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) +FFI_STEPS = step4_if_fn_do step5_tco step6_file \ + step7_quote step8_macros step9_try stepA_mal + +all: node_modules + +node_modules: + npm install + +$(foreach S,$(FFI_STEPS),$(S).json): node_modules + +dist: mal.json mal + +mal.json: $(filter-out %.js,$(SOURCES)) + echo '["do",' >> $@ + $(foreach f,$+,\ + cat $(f) | egrep -v '^ *[[]"load-file"' >> $@; \ + echo "," >> $@;) + echo 'null]' >> $@ + +mal: mal.json + echo '#!/usr/bin/env miniMAL' > $@ + cat $< >> $@ + chmod +x $@ + +clean: diff --git a/impls/miniMAL/core.json b/impls/miniMAL/core.json new file mode 100644 index 0000000000..3ad9bd0926 --- /dev/null +++ b/impls/miniMAL/core.json @@ -0,0 +1,200 @@ +["do", + +["def", "_path", ["require", ["`", "path"]]], + +["def", "_node_readline", ["require", [".", "_path", ["`", "resolve"], + ["`", "."], + ["`", "node_readline.js"]]]], + +["def", "_string?", ["fn", ["s"], + ["and", ["string?", "s"], + ["not", ["=", ["`", "\u029e"], ["get", "s", 0]]]]]], + +["def", "_function?", ["fn", ["a"], + ["isa", "a", "Function"]]], + +["def", "_number?", ["fn", ["a"], + ["=", ["`", "[object Number]"], ["classOf", "a"]]]], + +["def", "div", ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]], + +["def", "time-ms", ["fn", [], + [".", ["new", "Date"], ["`", "getTime"]]]], + + +["def", "assoc", ["fn", ["src-hm", "&", "kvs"], + ["let", ["hm", ["clone", "src-hm"]], + ["assocs!", "hm", "kvs"]]]], + +["def", "dissoc", ["fn", ["src-hm", "&", "ks"], + ["let", ["hm", ["clone", "src-hm"]], + ["do", + ["map", ["fn", ["k"], ["del", "hm", "k"]], "ks"], + "hm"]]]], + +["def", "_get", ["fn", ["obj", "key"], + ["if", ["null?", "obj"], + null, + ["if", ["contains?", "obj", "key"], + ["get", "obj", "key"], + null]]]], + +["def", "_count", ["fn", ["a"], + ["if", ["=", null, "a"], + 0, + ["count", "a"]]]], + +["def", "_nth", ["fn", ["seq", "idx"], + ["if", [">=", "idx", ["count", "seq"]], + ["throw", "nth: index out of range"], + ["nth", "seq", "idx"]]]], + +["def", "_first", ["fn", ["seq"], + ["if", ["empty?", "seq"], + null, + ["first", "seq"]]]], + +["def", "_rest", ["fn", ["seq"], + ["if", ["empty?", "seq"], + ["`", []], + ["rest", "seq"]]]], + +["def", "_apply", ["fn", ["f", "&", "args"], + ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"], + "fargs", ["concat", ["slice", "args", 0, ["-", ["count", "args"], 1]], + ["nth", "args", ["-", ["count", "args"], 1]]]], + ["apply", "fn", "fargs"]]]], + +["def", "_map", ["fn", ["f", "seq"], + ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"]], + ["map", "fn", "seq"]]]], + +["def", "_conj", ["fn", ["seq", "&", "a"], + ["if", ["list?", "seq"], + [".", [".", "a", ["`", "reverse"]], ["`", "concat"], "seq"], + ["vectorl", [".", "seq", ["`", "concat"], "a"]]]]], + +["def", "_seq", ["fn", ["obj"], + ["if", ["list?", "obj"], + ["if", [">", ["count", "obj"], 0], "obj", null], + ["if", ["vector?", "obj"], + ["if", [">", ["count", "obj"], 0], ["slice", "obj", 0], null], + ["if", ["string?", "obj"], + ["if", [">", ["count", "obj"], 0], + [".", "obj", ["`", "split"], ["`", ""]], + null], + ["if", ["null?", "obj"], + null, + ["throw", "seq: called on non-sequence"] + ]]]]]], + +["def", "with_meta", ["fn", ["obj", "m"], + ["let", ["new-obj", ["clone", "obj"]], + ["do", + ["set", "new-obj", ["`", "__meta__"], "m"], + "new-obj"]]]], + +["def", "meta", ["fn", ["obj"], + ["if", ["or", ["sequential?", "obj"], + ["map?", "obj"], + ["malfunc?", "obj"]], + ["if", ["contains?", "obj", ["`", "__meta__"]], + ["get", "obj", ["`", "__meta__"]], + null], + null]]], + +["def", "reset!", ["fn", ["atm", "val"], + ["do", ["set", "atm", ["`", "val"], "val"], "val"]]], + +["def", "swap!", ["fn", ["atm", "f", "&", "args"], + ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"], + "fargs", ["cons", ["get", "atm", ["`", "val"]], "args"], + "val", ["apply", "fn", "fargs"]], + ["do", + ["set", "atm", ["`", "val"], "val"], + "val"]]]], + +["def", "core-ns", + ["hash-map", + ["`", "="], "equal?", + ["`", "throw"], "throw", + + ["`", "nil?"], "null?", + ["`", "true?"], "true?", + ["`", "false?"], "false?", + ["`", "string?"], "_string?", + ["`", "symbol"], "symbol", + ["`", "symbol?"], "symbol?", + ["`", "keyword"], "keyword", + ["`", "keyword?"], "keyword?", + ["`", "number?"], "_number?", + ["`", "fn?"], ["fn", ["a"], + ["or", ["_function?", "a"], + ["and", ["malfunc?", "a"], + ["not", ["get", "a", ["`", "macro?"]]]]]], + ["`", "macro?"], ["fn", ["a"], + ["and", ["malfunc?", "a"], + ["get", "a", ["`", "macro?"]]]], + + ["`", "pr-str"], ["fn", ["&", "a"], ["pr-list", "a", true, ["`", " "]]], + ["`", "str"], ["fn", ["&", "a"], ["pr-list", "a", false, ["`", ""]]], + ["`", "prn"], ["fn", ["&", "a"], + ["do", + ["println", ["pr-list", "a", true, ["`", " "]]], + null]], + ["`", "println"], ["fn", ["&", "a"], + ["do", + ["println", ["pr-list", "a", false, ["`", " "]]], + null]], + ["`", "read-string"], "read-str", + ["`", "readline"], ["fn", ["p"], + [".", "_node_readline", ["`", "readline"], "p"]], + ["`", "slurp"], "slurp", + + ["`", "<"], "<", + ["`", "<="], "<=", + ["`", ">"], ">", + ["`", ">="], ">=", + ["`", "+"], "+", + ["`", "-"], "-", + ["`", "*"], "*", + ["`", "/"], "div", + ["`", "time-ms"], "time-ms", + + ["`", "list"], "list", + ["`", "list?"], "list?", + ["`", "vector"], "vector", + ["`", "vector?"], "vector?", + ["`", "hash-map"], "hash-map", + ["`", "assoc"], "assoc", + ["`", "dissoc"], "dissoc", + ["`", "map?"], "map?", + ["`", "get"], "_get", + ["`", "contains?"], "contains?", + ["`", "keys"], "keys", + ["`", "vals"], "vals", + + ["`", "sequential?"], "sequential?", + ["`", "cons"], "cons", + ["`", "concat"], "concat", + ["`", "vec"], "vectorl", + ["`", "nth"], "_nth", + ["`", "first"], "_first", + ["`", "rest"], "_rest", + ["`", "empty?"], "empty?", + ["`", "count"], "_count", + ["`", "apply"], "_apply", + ["`", "map"], "_map", + + ["`", "conj"], "_conj", + ["`", "seq"], "_seq", + + ["`", "with-meta"], "with_meta", + ["`", "meta"], "meta", + ["`", "atom"], "atom", + ["`", "atom?"], "atom?", + ["`", "deref"], ["fn", ["a"], ["get", "a", ["`", "val"]]], + ["`", "reset!"], "reset!", + ["`", "swap!"], "swap!"]], + +null] diff --git a/miniMAL/env.json b/impls/miniMAL/env.json similarity index 100% rename from miniMAL/env.json rename to impls/miniMAL/env.json diff --git a/impls/miniMAL/miniMAL-core.json b/impls/miniMAL/miniMAL-core.json new file mode 100644 index 0000000000..d430c1fdae --- /dev/null +++ b/impls/miniMAL/miniMAL-core.json @@ -0,0 +1,21 @@ +["do", + +["def", "repl", ["fn",["prompt", "rep"], + ["let", ["readline", ["require", ["`", "readline"]], + "opts", ["new", "Object"], + "_", ["set", "opts", ["`", "input"], [".-", "process", ["`", "stdin"]]], + "_", ["set", "opts", ["`", "output"], [".-", "process", ["`", "stdout"]]], + "_", ["set", "opts", ["`", "terminal"], false], + "rl", [".", "readline", ["`", "createInterface"], "opts"], + "evl", ["fn", ["line"], + ["do", + ["println", ["rep", "line"]], + [".", "rl", ["`", "prompt"]]]]], + ["do", + [".", "rl", ["`", "setPrompt"], "prompt"], + [".", "rl", ["`", "prompt"]], + [".", "rl", ["`", "on"], ["`", "line"], "evl"]]]]], + +null +] + diff --git a/impls/miniMAL/node_readline.js b/impls/miniMAL/node_readline.js new file mode 100644 index 0000000000..3a4bbf4852 --- /dev/null +++ b/impls/miniMAL/node_readline.js @@ -0,0 +1,52 @@ +// IMPORTANT: choose one +var RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL +//var RL_LIB = "libedit.so.2"; + +var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); + +var rlwrap = {}; // namespace for this module in web context + +var koffi = require('koffi'), + fs = require('fs'); + +var rllib = null; +try { + rllib = koffi.load(RL_LIB); +} catch (e) { + console.error('ERROR loading RL_LIB:', RL_LIB, e); + throw e; +} +var readlineFunc = rllib.func('char *readline(char *)'); +var addHistoryFunc = rllib.func('int add_history(char *)'); + +var rl_history_loaded = false; + +exports.readline = rlwrap.readline = function(prompt) { + prompt = typeof prompt !== 'undefined' ? prompt : "user> "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i "], "rep"], + +null + +] diff --git a/impls/miniMAL/step1_read_print.json b/impls/miniMAL/step1_read_print.json new file mode 100644 index 0000000000..c8e3d6129a --- /dev/null +++ b/impls/miniMAL/step1_read_print.json @@ -0,0 +1,27 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], + +["def", "READ", ["fn", ["strng"], + ["read-str", "strng"]]], + +["def", "EVAL", ["fn", ["ast", "env"], + "ast"]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], null]], + ["catch", "exc", + ["str", ["`", "Error: "], "exc"]]]]], + +["repl", ["`", "user> "], "rep"], + +null + +] diff --git a/impls/miniMAL/step2_eval.json b/impls/miniMAL/step2_eval.json new file mode 100644 index 0000000000..30193ecfff --- /dev/null +++ b/impls/miniMAL/step2_eval.json @@ -0,0 +1,57 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], + +["def", "READ", ["fn", ["strng"], + ["read-str", "strng"]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["if", ["symbol?", "ast"], + ["let", ["sym", ["get", "ast", ["`", "val"]]], + ["if", ["contains?", "env", "sym"], + ["get", "env", "sym"], + ["throw", ["str", ["`", "'"], "sym", ["`", "' not found"]]]]], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], + "f", ["first", "el"], + "args", ["rest", "el"]], + ["apply", "f", "args"]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", + ["hash-map", + ["`", "+"], "+", + ["`", "-"], "-", + ["`", "*"], "*", + ["`", "/"], ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], + +["repl", ["`", "user> "], "rep"], + +null + +] diff --git a/impls/miniMAL/step3_env.json b/impls/miniMAL/step3_env.json new file mode 100644 index 0000000000..a8c56a535e --- /dev/null +++ b/impls/miniMAL/step3_env.json @@ -0,0 +1,79 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], + +["def", "READ", ["fn", ["strng"], + ["read-str", "strng"]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], + "f", ["first", "el"], + "args", ["rest", "el"]], + ["apply", "f", "args"]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], +["env-set", "repl-env", ["symbol", ["`", "+"]], "+"], +["env-set", "repl-env", ["symbol", ["`", "-"]], "-"], +["env-set", "repl-env", ["symbol", ["`", "*"]], "*"], +["def", "div", ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]], +["env-set", "repl-env", ["symbol", ["`", "/"]], "div"], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], + +["repl", ["`", "user> "], "rep"], + +null + +] diff --git a/impls/miniMAL/step4_if_fn_do.json b/impls/miniMAL/step4_if_fn_do.json new file mode 100644 index 0000000000..3d91c581fb --- /dev/null +++ b/impls/miniMAL/step4_if_fn_do.json @@ -0,0 +1,100 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], +["load", ["`", "core.json"]], + +["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["if", ["=", ["`", "do"], "a0"], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["rest", "ast"]]], + ["nth", "el", ["-", ["count", "el"], 1]]], + ["if", ["=", ["`", "if"], "a0"], + ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["or", ["=", "cond", null], ["=", "cond", false]], + ["if", [">", ["count", "ast"], 3], + ["EVAL", ["nth", "ast", 3], "env"], + null], + ["EVAL", ["nth", "ast", 2], "env"]]], + ["if", ["=", ["`", "fn*"], "a0"], + ["fn", ["&", "args"], + ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], + ["EVAL", ["nth", "ast", 2], "e"]]], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], + "f", ["first", "el"], + "args", ["rest", "el"]], + ["apply", "f", "args"]]]]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], + ["if", ["isa", "exc", "Error"], + [".", "exc", ["`", "toString"]], + ["pr-str", "exc", true]]]]]]], + +["`", "core.mal: defined using miniMAL"], +["map", ["fn", ["k"], ["env-set", "repl-env", + ["symbol", "k"], + ["get", "core-ns", "k"]]], + ["keys", "core-ns"]], + +["`", "core.mal: defined using mal itself"], +["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], + +["repl", ["`", "user> "], "rep"], + +null + +] diff --git a/impls/miniMAL/step5_tco.json b/impls/miniMAL/step5_tco.json new file mode 100644 index 0000000000..babf6b0166 --- /dev/null +++ b/impls/miniMAL/step5_tco.json @@ -0,0 +1,108 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], +["load", ["`", "core.json"]], + +["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["if", ["=", ["`", "do"], "a0"], + ["do", + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], + ["if", ["=", ["`", "if"], "a0"], + ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["or", ["=", "cond", null], ["=", "cond", false]], + ["if", [">", ["count", "ast"], 3], + ["EVAL", ["nth", "ast", 3], "env"], + null], + ["EVAL", ["nth", "ast", 2], "env"]]], + ["if", ["=", ["`", "fn*"], "a0"], + ["malfunc", + ["fn", ["&", "args"], + ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], + ["EVAL", ["nth", "ast", 2], "e"]]], + ["nth", "ast", 2], "env", ["nth", "ast", 1]], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], + "f", ["first", "el"], + "args", ["rest", "el"]], + ["if", ["malfunc?", "f"], + ["EVAL", ["get", "f", ["`", "ast"]], + ["env-new", ["get", "f", ["`", "env"]], + ["get", "f", ["`", "params"]], + "args"]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], + ["if", ["isa", "exc", "Error"], + [".", "exc", ["`", "toString"]], + ["pr-str", "exc", true]]]]]]], + +["`", "core.mal: defined using miniMAL"], +["map", ["fn", ["k"], ["env-set", "repl-env", + ["symbol", "k"], + ["get", "core-ns", "k"]]], + ["keys", "core-ns"]], + +["`", "core.mal: defined using mal itself"], +["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], + +["repl", ["`", "user> "], "rep"], + +null + +] diff --git a/impls/miniMAL/step6_file.json b/impls/miniMAL/step6_file.json new file mode 100644 index 0000000000..1e954c740c --- /dev/null +++ b/impls/miniMAL/step6_file.json @@ -0,0 +1,115 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], +["load", ["`", "core.json"]], + +["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["if", ["=", ["`", "do"], "a0"], + ["do", + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], + ["if", ["=", ["`", "if"], "a0"], + ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["or", ["=", "cond", null], ["=", "cond", false]], + ["if", [">", ["count", "ast"], 3], + ["EVAL", ["nth", "ast", 3], "env"], + null], + ["EVAL", ["nth", "ast", 2], "env"]]], + ["if", ["=", ["`", "fn*"], "a0"], + ["malfunc", + ["fn", ["&", "args"], + ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], + ["EVAL", ["nth", "ast", 2], "e"]]], + ["nth", "ast", 2], "env", ["nth", "ast", 1]], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], + "f", ["first", "el"], + "args", ["rest", "el"]], + ["if", ["malfunc?", "f"], + ["EVAL", ["get", "f", ["`", "ast"]], + ["env-new", ["get", "f", ["`", "env"]], + ["get", "f", ["`", "params"]], + "args"]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], + ["if", ["isa", "exc", "Error"], + [".", "exc", ["`", "toString"]], + ["pr-str", "exc", true]]]]]]], + +["`", "core.mal: defined using miniMAL"], +["map", ["fn", ["k"], ["env-set", "repl-env", + ["symbol", "k"], + ["get", "core-ns", "k"]]], + ["keys", "core-ns"]], +["env-set", "repl-env", ["symbol", ["`", "eval"]], + ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], +["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], + ["slice", "argv", 1]], + +["`", "core.mal: defined using mal itself"], +["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], +["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], + +["if", ["not", ["empty?", "argv"]], + ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], + ["repl", ["`", "user> "], "rep"]], + +null + +] diff --git a/impls/miniMAL/step7_quote.json b/impls/miniMAL/step7_quote.json new file mode 100644 index 0000000000..e11f1d7fce --- /dev/null +++ b/impls/miniMAL/step7_quote.json @@ -0,0 +1,146 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], +["load", ["`", "core.json"]], + +["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], + +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], + +["def", "quasiquote", ["fn", ["ast"], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], + ["list", ["symbol", ["`", "quote"]], "ast"], + "ast"]]]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["if", ["=", ["`", "quote"], "a0"], + ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquote"], "a0"], + ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], + ["if", ["=", ["`", "do"], "a0"], + ["do", + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], + ["if", ["=", ["`", "if"], "a0"], + ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["or", ["=", "cond", null], ["=", "cond", false]], + ["if", [">", ["count", "ast"], 3], + ["EVAL", ["nth", "ast", 3], "env"], + null], + ["EVAL", ["nth", "ast", 2], "env"]]], + ["if", ["=", ["`", "fn*"], "a0"], + ["malfunc", + ["fn", ["&", "args"], + ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], + ["EVAL", ["nth", "ast", 2], "e"]]], + ["nth", "ast", 2], "env", ["nth", "ast", 1]], + ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], + "f", ["first", "el"], + "args", ["rest", "el"]], + ["if", ["malfunc?", "f"], + ["EVAL", ["get", "f", ["`", "ast"]], + ["env-new", ["get", "f", ["`", "env"]], + ["get", "f", ["`", "params"]], + "args"]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], + ["if", ["isa", "exc", "Error"], + [".", "exc", ["`", "toString"]], + ["pr-str", "exc", true]]]]]]], + +["`", "core.mal: defined using miniMAL"], +["map", ["fn", ["k"], ["env-set", "repl-env", + ["symbol", "k"], + ["get", "core-ns", "k"]]], + ["keys", "core-ns"]], +["env-set", "repl-env", ["symbol", ["`", "eval"]], + ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], +["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], + ["slice", "argv", 1]], + +["`", "core.mal: defined using mal itself"], +["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], +["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], + +["if", ["not", ["empty?", "argv"]], + ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], + ["repl", ["`", "user> "], "rep"]], + +null + +] diff --git a/impls/miniMAL/step8_macros.json b/impls/miniMAL/step8_macros.json new file mode 100644 index 0000000000..d4b54576c1 --- /dev/null +++ b/impls/miniMAL/step8_macros.json @@ -0,0 +1,153 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], +["load", ["`", "core.json"]], + +["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], + +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], + +["def", "quasiquote", ["fn", ["ast"], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], + ["list", ["symbol", ["`", "quote"]], "ast"], + "ast"]]]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["if", ["=", ["`", "quote"], "a0"], + ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquote"], "a0"], + ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], + ["if", ["=", ["`", "defmacro!"], "a0"], + ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], + ["do", + ["set", "func", ["`", "macro?"], true], + ["env-set", "env", ["nth", "ast", 1], "func"]]], + ["if", ["=", ["`", "do"], "a0"], + ["do", + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], + ["if", ["=", ["`", "if"], "a0"], + ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["or", ["=", "cond", null], ["=", "cond", false]], + ["if", [">", ["count", "ast"], 3], + ["EVAL", ["nth", "ast", 3], "env"], + null], + ["EVAL", ["nth", "ast", 2], "env"]]], + ["if", ["=", ["`", "fn*"], "a0"], + ["malfunc", + ["fn", ["&", "args"], + ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], + ["EVAL", ["nth", "ast", 2], "e"]]], + ["nth", "ast", 2], "env", ["nth", "ast", 1]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], + ["if", ["malfunc?", "f"], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], + ["env-new", ["get", "f", ["`", "env"]], + ["get", "f", ["`", "params"]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], + ["if", ["isa", "exc", "Error"], + [".", "exc", ["`", "toString"]], + ["pr-str", "exc", true]]]]]]], + +["`", "core.mal: defined using miniMAL"], +["map", ["fn", ["k"], ["env-set", "repl-env", + ["symbol", "k"], + ["get", "core-ns", "k"]]], + ["keys", "core-ns"]], +["env-set", "repl-env", ["symbol", ["`", "eval"]], + ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], +["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], + ["slice", "argv", 1]], + +["`", "core.mal: defined using mal itself"], +["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], +["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], +["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], + +["if", ["not", ["empty?", "argv"]], + ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], + ["repl", ["`", "user> "], "rep"]], + +null + +] diff --git a/impls/miniMAL/step9_try.json b/impls/miniMAL/step9_try.json new file mode 100644 index 0000000000..05090ab9f8 --- /dev/null +++ b/impls/miniMAL/step9_try.json @@ -0,0 +1,166 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], +["load", ["`", "core.json"]], + +["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], + +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], + +["def", "quasiquote", ["fn", ["ast"], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], + ["list", ["symbol", ["`", "quote"]], "ast"], + "ast"]]]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["if", ["=", ["`", "quote"], "a0"], + ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquote"], "a0"], + ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], + ["if", ["=", ["`", "defmacro!"], "a0"], + ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], + ["do", + ["set", "func", ["`", "macro?"], true], + ["env-set", "env", ["nth", "ast", 1], "func"]]], + ["if", ["=", ["`", "try*"], "a0"], + ["if", ["and", [">", ["count", "ast"], 2], + ["=", ["`", "catch*"], + ["get", ["nth", ["nth", "ast", 2], 0], + ["`", "val"]]]], + ["try", + ["EVAL", ["nth", "ast", 1], "env"], + ["catch", "exc", + ["EVAL", ["nth", ["nth", "ast", 2], 2], + ["env-new", "env", + ["list", ["nth", ["nth", "ast", 2], 1]], + ["list", "exc"]]]]], + ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["=", ["`", "do"], "a0"], + ["do", + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], + ["if", ["=", ["`", "if"], "a0"], + ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["or", ["=", "cond", null], ["=", "cond", false]], + ["if", [">", ["count", "ast"], 3], + ["EVAL", ["nth", "ast", 3], "env"], + null], + ["EVAL", ["nth", "ast", 2], "env"]]], + ["if", ["=", ["`", "fn*"], "a0"], + ["malfunc", + ["fn", ["&", "args"], + ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], + ["EVAL", ["nth", "ast", 2], "e"]]], + ["nth", "ast", 2], "env", ["nth", "ast", 1]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], + ["if", ["malfunc?", "f"], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], + ["env-new", ["get", "f", ["`", "env"]], + ["get", "f", ["`", "params"]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], + ["if", ["isa", "exc", "Error"], + [".", "exc", ["`", "toString"]], + ["pr-str", "exc", true]]]]]]], + +["`", "core.mal: defined using miniMAL"], +["map", ["fn", ["k"], ["env-set", "repl-env", + ["symbol", "k"], + ["get", "core-ns", "k"]]], + ["keys", "core-ns"]], +["env-set", "repl-env", ["symbol", ["`", "eval"]], + ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], +["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], + ["slice", "argv", 1]], + +["`", "core.mal: defined using mal itself"], +["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], +["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], +["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], + +["if", ["not", ["empty?", "argv"]], + ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], + ["repl", ["`", "user> "], "rep"]], + +null + +] diff --git a/impls/miniMAL/stepA_mal.json b/impls/miniMAL/stepA_mal.json new file mode 100644 index 0000000000..0f068a4e2a --- /dev/null +++ b/impls/miniMAL/stepA_mal.json @@ -0,0 +1,169 @@ +["do", + +["load", ["`", "miniMAL-core.json"]], +["load", ["`", "types.json"]], +["load", ["`", "reader.json"]], +["load", ["`", "printer.json"]], +["load", ["`", "env.json"]], +["load", ["`", "core.json"]], + +["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], + +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], + +["def", "quasiquote", ["fn", ["ast"], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], + ["list", ["symbol", ["`", "quote"]], "ast"], + "ast"]]]]], + +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], + ["do", + ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], + "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], + ["if", ["not", ["=", "debug-eval-env", null]], + ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], + ["if", ["not", ["or", ["=", "debug-eval", null], + ["=", "debug-eval", false]]], + ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], + ["if", ["symbol?", "ast"], + ["env-get", "env", "ast"], + ["if", ["vector?", "ast"], + ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], + ["if", ["map?", "ast"], + ["let", ["new-hm", ["hash-map"]], + ["do", + ["map", ["fn", ["k"], ["set", "new-hm", + "k", + ["EVAL", ["get", "ast", "k"], "env"]]], + ["keys", "ast"]], + "new-hm"]], + ["if", ["not", ["list?", "ast"]], + "ast", + ["if", ["empty?", "ast"], + "ast", + ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], + ["if", ["=", ["`", "def!"], "a0"], + ["env-set", "env", ["nth", "ast", 1], + ["EVAL", ["nth", "ast", 2], "env"]], + ["if", ["=", ["`", "let*"], "a0"], + ["let", ["let-env", ["env-new", "env"]], + ["do", + ["LET", "let-env", ["nth", "ast", 1]], + ["EVAL", ["nth", "ast", 2], "let-env"]]], + ["if", ["=", ["`", "quote"], "a0"], + ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquote"], "a0"], + ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], + ["if", ["=", ["`", "defmacro!"], "a0"], + ["let", ["func", ["_clone", ["EVAL", ["nth", "ast", 2], "env"]]], + ["do", + ["set", "func", ["`", "macro?"], true], + ["env-set", "env", ["nth", "ast", 1], "func"]]], + ["if", ["=", ["`", "try*"], "a0"], + ["if", ["and", [">", ["count", "ast"], 2], + ["=", ["`", "catch*"], + ["get", ["nth", ["nth", "ast", 2], 0], + ["`", "val"]]]], + ["try", + ["EVAL", ["nth", "ast", 1], "env"], + ["catch", "exc", + ["EVAL", ["nth", ["nth", "ast", 2], 2], + ["env-new", "env", + ["list", ["nth", ["nth", "ast", 2], 1]], + ["list", "exc"]]]]], + ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["=", ["`", "do"], "a0"], + ["do", + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], + ["if", ["=", ["`", "if"], "a0"], + ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], + ["if", ["or", ["=", "cond", null], ["=", "cond", false]], + ["if", [">", ["count", "ast"], 3], + ["EVAL", ["nth", "ast", 3], "env"], + null], + ["EVAL", ["nth", "ast", 2], "env"]]], + ["if", ["=", ["`", "fn*"], "a0"], + ["malfunc", + ["fn", ["&", "args"], + ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], + ["EVAL", ["nth", "ast", 2], "e"]]], + ["nth", "ast", 2], "env", ["nth", "ast", 1]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], + ["if", ["malfunc?", "f"], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], + ["env-new", ["get", "f", ["`", "env"]], + ["get", "f", ["`", "params"]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]]], + +["def", "PRINT", ["fn", ["exp"], + ["pr-str", "exp", true]]], + + +["def", "repl-env", ["env-new"]], + +["def", "rep", ["fn", ["strng"], + ["try", + ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], + ["catch", "exc", + ["str", ["`", "Error: "], + ["if", ["isa", "exc", "Error"], + [".", "exc", ["`", "toString"]], + ["pr-str", "exc", true]]]]]]], + +["`", "core.mal: defined using miniMAL"], +["map", ["fn", ["k"], ["env-set", "repl-env", + ["symbol", "k"], + ["get", "core-ns", "k"]]], + ["keys", "core-ns"]], +["env-set", "repl-env", ["symbol", ["`", "eval"]], + ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], +["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], + ["slice", "argv", 1]], + +["`", "core.mal: defined using mal itself"], +["rep", ["`", "(def! *host-language* \"miniMAL\")"]], +["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], +["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], +["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], + +["if", ["not", ["empty?", "argv"]], + ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], + ["do", + ["rep", ["`", "(println (str \"Mal [\" *host-language* \"]\"))"]], + ["repl", ["`", "user> "], "rep"]]], + +null + +] diff --git a/impls/miniMAL/tests/step5_tco.mal b/impls/miniMAL/tests/step5_tco.mal new file mode 100644 index 0000000000..c5ab084ce6 --- /dev/null +++ b/impls/miniMAL/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; miniMAL skipping non-TCO recursion +;; Reason: Unrecoverable stack overflow at 10,000 diff --git a/miniMAL/types.json b/impls/miniMAL/types.json similarity index 83% rename from miniMAL/types.json rename to impls/miniMAL/types.json index 372dff9c57..3d3e22d7bb 100644 --- a/miniMAL/types.json +++ b/impls/miniMAL/types.json @@ -10,14 +10,33 @@ ["_cmp_seqs", ["rest", "a"], ["rest", "b"]], false]]]]], +["def", "_check_hash_map_keys", ["fn", ["ks", "a", "b"], + ["if", ["empty?", "ks"], + true, + ["let", ["k", ["first", "ks"]], + ["if", ["equal?", ["get", "a", "k"], ["get", "b", "k"]], + ["_check_hash_map_keys", ["rest", "ks"], "a", "b"], + false]]]]], +["def", "_cmp_hash_maps", ["fn", ["a", "b"], + ["let", ["aks", ["keys", "a"]], + ["if", ["not", ["=", ["count", "aks"], ["count", ["keys", "b"]]]], + false, + ["_check_hash_map_keys", "aks", "a", "b"]]]]], + ["def", "equal?", ["fn", ["a", "b"], ["if", ["sequential?", "a"], ["if", ["sequential?", "b"], ["_cmp_seqs", "a", "b"], false], + ["if", ["map?", "a"], + ["if", ["map?", "b"], + ["_cmp_hash_maps", "a", "b"], + false], ["if", ["symbol?", "a"], - ["=", ["get", "a", ["`", "val"]], ["get", "b", ["`", "val"]]], - ["=", "a", "b"]]]]], + ["if", ["symbol?", "b"], + ["=", ["get", "a", ["`", "val"]], ["get", "b", ["`", "val"]]], + false], + ["=", "a", "b"]]]]]], ["def", "_clone", ["fn", ["obj"], ["if", ["list?", "obj"], @@ -72,7 +91,9 @@ ["def", "keyword", ["fn", ["name"], - ["str", ["`", "\u029e"], "name"]]], + ["if", ["keyword?", "name"], + "name", + ["str", ["`", "\u029e"], "name"]]]], ["def", "keyword?", ["fn", ["kw"], ["and", ["=", ["`", "[object String]"], ["classOf", "kw"]], diff --git a/impls/nasm/Dockerfile b/impls/nasm/Dockerfile new file mode 100644 index 0000000000..2927d80c03 --- /dev/null +++ b/impls/nasm/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Install nasm and ld +RUN apt-get -y install nasm binutils diff --git a/impls/nasm/Makefile b/impls/nasm/Makefile new file mode 100644 index 0000000000..a3cf08c0aa --- /dev/null +++ b/impls/nasm/Makefile @@ -0,0 +1,17 @@ + +STEPS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal + +COMPONENTS = env.asm core.asm reader.asm printer.asm types.asm system.asm exceptions.asm + + +all: $(STEPS) + +%.o: %.asm $(COMPONENTS) + nasm -felf64 $< + +%: %.o + ld -o $@ $< + +.PHONY: clean +clean: + rm -f $(STEPS) $(STEPS:%=%.o) diff --git a/impls/nasm/README.md b/impls/nasm/README.md new file mode 100644 index 0000000000..170a7c2c58 --- /dev/null +++ b/impls/nasm/README.md @@ -0,0 +1,30 @@ +# x86_64 NASM implementation + +Notes and known issues: + +* No library dependencies, only Linux system calls + +* Simple readline implemented, just supporting backspace for editing + +* Reference counting used for memory management. No attempt is made + to find circular references, so leaks are possible. In particular + defining a function with def! creates a circular reference loop. + +* The exception/error handling just resets the stack and jumps to a handler, + so does not release memory + +* Memory is allocated by two fixed-size allocators (`Cons` and `Array` objects) + which have limits specified in types.asm. If more memory is needed + then this must currently be done at compile-time, but adding sys_brk + calls could be done. + +* The hash map implementation is just a list of key-value pairs. + Moving symbols around in the core environment makes a significant difference + (20-30%) to the performance test. A simple optimisation could be to + move items when found to the start of the list so that frequently + searched keys are nearer the front. + +* `conj` function not yet implemented + +* `*env*` symbol evaluates to current Environment. + diff --git a/impls/nasm/core.asm b/impls/nasm/core.asm new file mode 100644 index 0000000000..544aab4380 --- /dev/null +++ b/impls/nasm/core.asm @@ -0,0 +1,3350 @@ +;; Core functions +;; +;; + +%include "macros.mac" + +section .data + +;; Symbols for comparison + static core_add_symbol, db "+" + static core_sub_symbol, db "-" + static core_mul_symbol, db "*" + static core_div_symbol, db "/" + + static core_listp_symbol, db "list?" + static core_emptyp_symbol, db "empty?" + + static core_equal_symbol, db "=" + static core_gt_symbol, db ">" + static core_lt_symbol, db "<" + static core_ge_symbol, db ">=" + static core_le_symbol, db "<=" + + static core_count_symbol, db "count" + static core_keys_symbol, db "keys" + static core_vals_symbol, db "vals" + + static core_list_symbol, db "list" + + static core_pr_str_symbol, db "pr-str" + static core_prn_symbol, db "prn" + static core_str_symbol, db "str" + static core_println_symbol, db "println" + + static core_read_string_symbol, db "read-string" + static core_slurp_symbol, db "slurp" + static core_eval_symbol, db "eval" + + static core_atom_symbol, db "atom" + static core_deref_symbol, db "deref" + static core_atomp_symbol, db "atom?" + static core_reset_symbol, db "reset!" + static core_swap_symbol, db "swap!" + + static core_cons_symbol, db "cons" + static core_concat_symbol, db "concat" + static core_vec_symbol, db "vec" + + static core_first_symbol, db "first" + static core_rest_symbol, db "rest" + static core_nth_symbol, db "nth" + + static core_nilp_symbol, db "nil?" + static core_truep_symbol, db "true?" + static core_falsep_symbol, db "false?" + static core_numberp_symbol, db "number?" + + static core_symbolp_symbol, db "symbol?" + static core_stringp_symbol, db "string?" + static core_fnp_symbol, db "fn?" + static core_macrop_symbol, db "macro?" + static core_keywordp_symbol, db "keyword?" + + static core_containsp_symbol, db "contains?" + static core_get_symbol, db "get" + static core_vectorp_symbol, db "vector?" + static core_mapp_symbol, db "map?" + static core_sequentialp_symbol, db "sequential?" + + static core_throw_symbol, db "throw" + + static core_map_symbol, db "map" + static core_apply_symbol, db "apply" + + static core_symbol_symbol, db "symbol" + static core_vector_symbol, db "vector" + static core_hashmap_symbol, db "hash-map" + static core_keyword_symbol, db "keyword" + + static core_assoc_symbol, db "assoc" + static core_dissoc_symbol, db "dissoc" + + static core_readline_symbol, db "readline" + + static core_meta_symbol, db "meta" + static core_with_meta_symbol, db "with-meta" + + static core_time_ms_symbol, db "time-ms" + + static core_seq_symbol, db "seq" + +;; Strings + + static core_arith_missing_args, db "integer arithmetic missing arguments" + static core_arith_not_int, db "non-integer argument to integer arithmetic" + + static core_emptyp_error_string, db "empty? expects a list, vector or map",10 + static core_count_error_string, db "count expects a list or vector",10 + + static core_keys_not_map, db "keys expects a map as first argument" + static core_vals_not_map, db "vals expects a map as first argument" + + static core_numeric_expect_ints, db "comparison operator expected two numbers",10 + + static core_deref_not_atom, db "Error: argument to deref is not an atom" + static core_reset_not_atom, db "Error: argument to reset is not an atom" + static core_reset_no_value, db "Error: missing value argument to reset" + + static core_swap_not_atom, db "Error: swap! expects atom as first argument" + static core_swap_no_function, db "Error: swap! expects function as second argument" + + static core_cons_missing_arg, db "Error: missing argument to cons" + static core_cons_not_vector, db "Error: cons expects a list or vector" + + static core_concat_not_list, db "Error: concat expects lists or vectors" + + static core_vec_wrong_arg, db "Error: vec expects a list or vector " + + static core_first_missing_arg, db "Error: missing argument to first" + static core_first_not_list, db "Error: first expects a list or vector" + + static core_rest_missing_arg, db "Error: missing argument to rest" + static core_rest_not_list, db "Error: rest expects a list or vector" + + static core_nth_missing_arg, db "Error: missing argument to nth" + static core_nth_not_list, db "Error: nth expects a list or vector as first argument" + static core_nth_not_int, db "Error: nth expects an integer as second argument" + static core_nth_out_of_range, db "Error: nth index out of range" + + static core_value_p_missing_args, db "Error: value predicate (nil/true/false) missing args" + + static core_containsp_not_map, db "Error: contains? expects map as first argument" + static core_containsp_no_key, db "Error: contains? missing key argument" + + static core_get_not_map, db "Error: get expects map as first argument" + static core_get_no_key, db "Error: get missing key argument" + + static core_map_missing_args, db "Error: map expects two arguments (function, list/vector)" + static core_map_not_function, db "Error: map expects a ufunction for first argument" + static core_map_not_seq, db "Error: map expects a list or vector as second argument" + + static core_apply_not_function, db "Error: apply expects function as first argument" + static core_apply_missing_args, db "Error: apply missing arguments" + static core_apply_not_seq, db "Error: apply last argument must be list or vector" + + static core_symbol_not_string, db "Error: symbol expects a string argument" + + static core_keyword_not_string, db "Error: keyword expects a string or keyword argument" + + static core_list_not_seq, db "Error: list expects a list or vector" + + static core_assoc_not_map, db "Error: assoc expects a map as first argument" + static core_assoc_missing_value, db "Error: assoc missing value" + + static core_dissoc_not_map, db "dissoc expects a map as first argument" + static core_dissoc_missing_value, db "Missing value in map passed to dissoc" + + static core_with_meta_no_function, db "with-meta expects a function as first argument" + static core_with_meta_no_value, db "with-meta expects a value as second argument" + + static core_seq_missing_arg, db "seq missing argument" + static core_seq_wrong_type, db "seq expects a list, vector, string or nil" + +section .text + +;; Add a native function to the core environment +;; This is used in core_environment +%macro core_env_native 2 + push rsi ; environment + mov rsi, %1 + mov edx, %1.len + call raw_to_symbol ; Symbol in RAX + push rax + + mov rsi, %2 + call native_function ; Function in RAX + + mov rcx, rax ; value (function) + pop rdi ; key (symbol) + pop rsi ; environment + call env_set +%endmacro + + +;; Create an Environment with core functions +;; +;; Returns Environment in RAX +;; +;; +core_environment: + ; Create the top-level environment + xor rsi, rsi ; Set outer to nil + call env_new + mov rsi, rax ; Environment in RSI + + core_env_native core_cons_symbol, core_cons + core_env_native core_concat_symbol, core_concat + core_env_native core_vec_symbol, core_vec + + core_env_native core_first_symbol, core_first + core_env_native core_rest_symbol, core_rest + core_env_native core_nth_symbol, core_nth + + core_env_native core_add_symbol, core_add + core_env_native core_sub_symbol, core_sub + core_env_native core_mul_symbol, core_mul + core_env_native core_div_symbol, core_div + + core_env_native core_listp_symbol, core_listp + core_env_native core_emptyp_symbol, core_emptyp + core_env_native core_count_symbol, core_count + + core_env_native core_equal_symbol, core_equalp + core_env_native core_gt_symbol, core_gt + core_env_native core_lt_symbol, core_lt + core_env_native core_ge_symbol, core_ge + core_env_native core_le_symbol, core_le + + core_env_native core_keys_symbol, core_keys + core_env_native core_vals_symbol, core_vals + + core_env_native core_list_symbol, core_list + + core_env_native core_pr_str_symbol, core_pr_str + core_env_native core_prn_symbol, core_prn + core_env_native core_str_symbol, core_str + core_env_native core_println_symbol, core_println + + core_env_native core_read_string_symbol, core_read_string + core_env_native core_slurp_symbol, core_slurp + core_env_native core_eval_symbol, core_eval + + core_env_native core_atom_symbol, core_atom + core_env_native core_deref_symbol, core_deref + core_env_native core_atomp_symbol, core_atomp + core_env_native core_reset_symbol, core_reset + core_env_native core_swap_symbol, core_swap + + core_env_native core_nilp_symbol, core_nilp + core_env_native core_truep_symbol, core_truep + core_env_native core_falsep_symbol, core_falsep + core_env_native core_numberp_symbol, core_numberp + + core_env_native core_symbolp_symbol, core_symbolp + core_env_native core_stringp_symbol, core_stringp + core_env_native core_fnp_symbol, core_fnp + core_env_native core_macrop_symbol, core_macrop + core_env_native core_keywordp_symbol, core_keywordp + + core_env_native core_containsp_symbol, core_containsp + core_env_native core_get_symbol, core_get + + core_env_native core_vectorp_symbol, core_vectorp + core_env_native core_mapp_symbol, core_mapp + core_env_native core_sequentialp_symbol, core_sequentialp + + core_env_native core_throw_symbol, core_throw + + core_env_native core_map_symbol, core_map + core_env_native core_apply_symbol, core_apply + + core_env_native core_symbol_symbol, core_symbol + core_env_native core_vector_symbol, core_vector + core_env_native core_hashmap_symbol, core_hashmap + core_env_native core_keyword_symbol, core_keyword + + core_env_native core_assoc_symbol, core_assoc + core_env_native core_dissoc_symbol, core_dissoc + + core_env_native core_readline_symbol, core_readline + + core_env_native core_meta_symbol, core_meta + core_env_native core_with_meta_symbol, core_with_meta + + core_env_native core_time_ms_symbol, core_time_ms + + core_env_native core_seq_symbol, core_seq + + ; ----------------- + ; Put the environment in RAX + mov rax, rsi + ret + +;; ---------------------------------------------------- + +;; Jumped to from many core functions, with +;; string address in RSI and length in EDX +core_throw_str: + call raw_to_string + mov rsi, rax + jmp error_throw + +;; ---------------------------------------------------- + + + +;; Integer arithmetic operations +;; +;; Adds a list of numbers, address in RSI +;; Returns the sum as a number object with address in RAX +;; Since most of the code is common to all operators, +;; RBX is used to jump to the required instruction +core_add: + mov rbx, core_arithmetic.do_addition + jmp core_arithmetic +core_sub: + mov rbx, core_arithmetic.do_subtraction + jmp core_arithmetic +core_mul: + mov rbx, core_arithmetic.do_multiply + jmp core_arithmetic +core_div: + mov rbx, core_arithmetic.do_division + ; Fall through to core_arithmetic +core_arithmetic: + ; Check that the first object is a number + mov cl, BYTE [rsi] + mov ch, cl + and ch, block_mask + cmp ch, block_cons + jne .missing_args + + mov ch, cl + and ch, content_mask + cmp ch, content_empty + je .missing_args + + cmp ch, content_int + jne .not_int + + ; Put the starting value in rax + mov rax, [rsi + Cons.car] + +.add_loop: + ; Fetch the next value + mov cl, [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .finished ; Nothing let + + mov rsi, [rsi + Cons.cdr] ; Get next cons + + ; Check that it is an integer + mov cl, BYTE [rsi] + and cl, content_mask + cmp cl, content_int + jne .not_int + + ; Jump to the required operation, address in RBX + jmp rbx + +.do_addition: + add rax, [rsi + Cons.car] + jmp .add_loop +.do_subtraction: + sub rax, [rsi + Cons.car] + jmp .add_loop +.do_multiply: + imul rax, [rsi + Cons.car] + jmp .add_loop +.do_division: + cqo ; Sign extend RAX into RDX + mov rcx, [rsi + Cons.car] + idiv rcx + jmp .add_loop + +.finished: + ; Value in rbx + push rax + ; Get a Cons object to put the result into + call alloc_cons + pop rbx + mov [rax], BYTE maltype_integer + mov [rax + Cons.car], rbx + ret + +.missing_args: + load_static core_arith_missing_args + jmp core_throw_str +.not_int: + load_static core_arith_not_int + jmp core_throw_str + +;; compare objects for equality +core_equalp: + ; Check that rsi contains a list + mov cl, BYTE [rsi] + cmp cl, maltype_empty_list + je .error + + and cl, block_mask + container_mask + cmp cl, block_cons + container_list + jne .error + + ; Check that the list has a second pointer + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .error + + ; move second pointer into rdi + mov rdi, [rsi + Cons.cdr] + + ; Remove next pointers + mov cl, BYTE [rsi + Cons.typecdr] + mov [rsi + Cons.typecdr], BYTE 0 + + mov bl, BYTE [rdi + Cons.typecdr] + mov [rdi + Cons.typecdr], BYTE 0 + + push rbx + push rcx + + ; Compare the objects recursively + call compare_objects_rec + + ; Restore next pointers + pop rcx + pop rbx + mov [rsi + Cons.typecdr], BYTE cl + mov [rdi + Cons.typecdr], BYTE bl + + je .true + + +.false: + call alloc_cons + mov [rax], BYTE maltype_false + ret +.true: + call alloc_cons + mov [rax], BYTE maltype_true + ret +.error: + push rsi + print_str_mac error_string ; print 'Error: ' + pop rsi + jmp error_throw + +;; ----------------------------------------------------------------- +;; Numerical comparisons + + +core_gt: + mov rcx, core_compare_num.gt + jmp core_compare_num +core_lt: + mov rcx, core_compare_num.lt + jmp core_compare_num +core_ge: + mov rcx, core_compare_num.ge + jmp core_compare_num +core_le: + mov rcx, core_compare_num.le + ;jmp core_compare_num +core_compare_num: + ; The first argument should be an int + mov al, BYTE [rsi] + and al, content_mask + cmp al, maltype_integer + jne .error + + ; Check that there's a second argument + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .error + mov rax, [rsi + Cons.car] + mov rdi, [rsi + Cons.cdr] + + ; The second arg should also be an int + mov bl, BYTE [rdi] + and bl, content_mask + cmp bl, maltype_integer + jne .error + + mov rbx, [rdi + Cons.car] + + cmp rax, rbx + jmp rcx ; Address set above +.gt: + jg .true + jmp .false +.lt: + jl .true + jmp .false +.ge: + jge .true + jmp .false +.le: + jle .true + ;jmp .false +.false: + call alloc_cons + mov [rax], BYTE maltype_false + ret +.true: + call alloc_cons + mov [rax], BYTE maltype_true + ret +.error: + push rsi + print_str_mac error_string ; print 'Error: ' + print_str_mac core_numeric_expect_ints + pop rsi + jmp error_throw + +;; Test if a given object is a list +;; Input list in RSI +;; Returns true or false in RAX +core_listp: + mov bl, (block_cons + container_list) + jmp core_container_p +core_vectorp: + mov bl, (block_cons + container_vector) + jmp core_container_p +core_mapp: + mov bl, (block_cons + container_map) + ;jmp core_container_p +core_container_p: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .false ; Should be a pointer to a list + + mov rax, [rsi + Cons.car] + mov al, BYTE [rax] + and al, (block_mask + container_mask) + cmp al, bl + jne .false + + ; Is a list, return true + call alloc_cons + mov [rax], BYTE maltype_true + ret + +.false: + call alloc_cons + mov [rax], BYTE maltype_false + ret + +;; Return true if vector or list +core_sequentialp: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .false ; Should be a pointer + + mov rax, [rsi + Cons.car] + mov al, BYTE [rax] + and al, (block_mask + container_mask) + cmp al, container_list + je .true + cmp al, container_vector + jne .false +.true: + ; Is a list or vector, return true + call alloc_cons + mov [rax], BYTE maltype_true + ret + +.false: + call alloc_cons + mov [rax], BYTE maltype_false + ret + + + +;; Test if the given list, vector or map is empty +core_emptyp: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .error ; Expected a container + mov rax, [rsi + Cons.car] + mov al, BYTE [rax] + cmp al, maltype_empty_list + je .true + cmp al, maltype_empty_vector + je .true + cmp al, maltype_empty_map + je .true + + ; false + call alloc_cons + mov [rax], BYTE maltype_false + ret +.true: + call alloc_cons + mov [rax], BYTE maltype_true + ret +.error: + push rsi + print_str_mac error_string + print_str_mac core_emptyp_error_string + pop rsi + jmp error_throw + +;; Count the number of elements in given list or vector +core_count: + mov al, BYTE [rsi] + and al, content_mask + + cmp al, content_nil + je .zero + + cmp al, content_pointer + jne .error ; Expected a container + + mov rsi, [rsi + Cons.car] + mov al, BYTE [rsi] + + mov ah, al + and ah, (block_mask + container_mask) + cmp ah, (block_cons + container_list) + je .start_count + cmp ah, (block_cons + container_vector) + je .start_count + + jmp .error ; Not a list or vector + +.start_count: + + xor rbx,rbx + mov ah, al + and ah, content_mask + cmp ah, content_empty + je .done ; Empty list or vector + +.loop: + inc rbx + + ; Check if there's another + mov al, [rsi + Cons.typecdr] + cmp al, content_pointer + jne .done + + mov rsi, [rsi + Cons.cdr] + jmp .loop + +.zero: ; Return zero count + mov rbx, 0 +.done: ; Count is in RBX + + push rbx + call alloc_cons + pop rbx + mov [rax], BYTE maltype_integer + mov [rax + Cons.car], rbx + ret + +.error: + push rsi + print_str_mac error_string + print_str_mac core_count_error_string + pop rsi + jmp error_throw + + +;; Given a map, returns a list of keys +;; Input: List in RSI with one Map element +;; Returns: List in RAX +core_keys: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_map + + mov rsi, [rsi + Cons.car] + call map_keys + ret +.not_map: + load_static core_keys_not_map + jmp core_throw_str + +;; Get a list of values from a map +core_vals: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_map + + mov rsi, [rsi + Cons.car] + call map_vals + ret +.not_map: + load_static core_vals_not_map + jmp core_throw_str + +;; Given a map and a key, return true if the key is in the map +;; +core_containsp: + ; Check the type of the first argument + mov bl, BYTE [rsi] + and bl, content_mask + cmp bl, content_pointer + jne .not_map + + mov rcx, [rsi + Cons.car] ; Map in RCX + mov bl, BYTE [rcx] + and bl, (block_mask + container_mask) + cmp bl, container_map + jne .not_map + + ; Check second argument + mov bl, BYTE [rsi + Cons.typecdr] + cmp bl, content_pointer + jne .no_key + mov rsi, [rsi + Cons.cdr] + mov dl, BYTE [rsi] + and dl, content_mask + cmp dl, content_pointer + jne .key_value + + ; Pointer, so put into RDI + mov rdi, [rsi + Cons.car] + jmp .find + +.key_value: + ; A value + mov [rsi], BYTE dl + mov rdi, rsi ; Value in RDI + +.find: + mov rsi, rcx ; Map + call map_find + je .true + + ; false + call alloc_cons + mov [rax], BYTE maltype_false + ret +.true: + call alloc_cons + mov [rax], BYTE maltype_true + ret + +.not_map: + load_static core_containsp_not_map + jmp core_throw_str +.no_key: + load_static core_containsp_no_key + jmp core_throw_str + + +;; Given a map and a key, return the value in the map +;; or nil if not found +;; +core_get: + ; Check the type of the first argument + mov bl, BYTE [rsi] + + and bl, content_mask + + cmp bl, content_nil + je .not_found + + cmp bl, content_pointer + jne .not_map + + mov rcx, [rsi + Cons.car] ; Map in RCX + mov bl, BYTE [rcx] + and bl, (block_mask + container_mask) + cmp bl, container_map + jne .not_map + + ; Check second argument + mov bl, BYTE [rsi + Cons.typecdr] + cmp bl, content_pointer + jne .no_key + mov rsi, [rsi + Cons.cdr] + + mov dl, BYTE [rsi] + and dl, content_mask + cmp dl, content_pointer + jne .key_value + + ; Pointer, so put into RDI + mov rdi, [rsi + Cons.car] + jmp .find + +.key_value: + ; A value + mov [rsi], BYTE dl + mov rdi, rsi ; Value in RDI + +.find: + mov rsi, rcx ; Map + call map_get ; Value in RAX + je .found + +.not_found: + ; Not found + call alloc_cons + mov [rax], BYTE maltype_nil + ret +.found: + ret + +.not_map: + load_static core_get_not_map + jmp core_throw_str +.no_key: + load_static core_get_no_key + jmp core_throw_str + + +;; Return arguments as a list +;; +core_list: + call incref_object + mov rax, rsi + ret + +;; Convert arguments into a vector +core_vector: + ; Copy first element and mark as vector + call alloc_cons ; in RAX + mov bl, BYTE [rsi] + and bl, content_mask + mov bh, bl ; store content for comparison + or bl, container_vector + mov [rax], BYTE bl ; Set type + + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx ; Set content + + ; Check if the first element is a pointer + cmp bh, content_pointer + jne .done_car + + ; A pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.done_car: + ; Copy the CDR type and content + mov bl, [rsi + Cons.typecdr] + mov [rax + Cons.typecdr], bl + + mov rdx, [rsi + Cons.cdr] + mov [rax + Cons.cdr], rdx + + cmp bl, content_pointer + jne .done + + ; A pointer + mov bx, WORD [rdx + Cons.refcount] + inc bx + mov [rdx + Cons.refcount], WORD bx + +.done: + ret + + +;; Convert arguments into a map +core_hashmap: + ; Copy first element and mark as map + call alloc_cons ; in RAX + mov bl, BYTE [rsi] + and bl, content_mask + mov bh, bl ; store content for comparison + or bl, container_map + mov [rax], BYTE bl ; Set type + + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx ; Set content + + ; Check if the first element is a pointer + cmp bh, content_pointer + jne .done_car + + ; A pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.done_car: + ; Copy the CDR type and content + mov bl, [rsi + Cons.typecdr] + mov [rax + Cons.typecdr], bl + + mov rdx, [rsi + Cons.cdr] + mov [rax + Cons.cdr], rdx + + cmp bl, content_pointer + jne .done + + ; A pointer + mov bx, WORD [rdx + Cons.refcount] + inc bx + mov [rdx + Cons.refcount], WORD bx + +.done: + ret + +;; ------------------------------------------------ +;; String functions + +;; Convert arguments to a readable string, separated by a space +;; +core_pr_str: + mov rdi, 3 ; print_readably & separator + jmp core_str_functions +core_str: + xor rdi, rdi + jmp core_str_functions +core_str_sep: + mov rdi, 2 ; separator + +core_str_functions: + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_empty + je .empty ; Nothing to print + + xor r8, r8 ; Return string in r8 + +.loop: + cmp ah, content_pointer + je .got_pointer + + ; A value. Remove list container + xchg ah, al + mov [rsi], BYTE al + xchg ah, al + push rsi + push rax + push r8 + call pr_str + pop r8 + pop rbx + pop rsi + mov [rsi], BYTE bl ; restore type + jmp .got_string + +.got_pointer: + push rsi + push r8 + mov rsi, [rsi + Cons.car] ; Address pointed to + call pr_str + pop r8 + pop rsi + +.got_string: + ; String now in rax + + cmp r8, 0 + jne .append + + ; first string. Since this string will be + ; appended to, it needs to be a copy + push rsi ; input + + push rax ; string to copy + mov rsi, rax + call string_copy ; New string in RAX + pop rsi ; copied string + + push rax ; the copy + call release_object ; release the copied string + pop r8 ; the copy + + pop rsi ; input + + jmp .next + +.append: + push r8 + push rsi + push rax + + mov rsi, r8 ; Output string + mov rdx, rax ; String to be copied + call string_append_string + + pop rsi ; Was in rax, temporary string + call release_array ; Release the string + + pop rsi ; Restore input + pop r8 ; Output string +.next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .done + + ; More inputs + mov rsi, [rsi + Cons.cdr] ; pointer + + test rdi, 2 ; print_readably + jz .end_append_char ; No separator + + ; Add separator + push r8 + push rsi + mov rsi, r8 + mov cl, ' ' + call string_append_char + pop rsi + pop r8 +.end_append_char: + + ; Get the type in ah for comparison at start of loop + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + + jmp .loop +.done: + ; No more input, so return + mov rax, r8 + ret + +.empty: + call string_new ; An empty string + ret + +;; Print arguments readably, return nil +core_prn: + call core_pr_str + jmp core_prn_functions +core_println: + call core_str_sep +core_prn_functions: + mov rsi, rax + + ; Put newline at the end + push rsi + mov cl, 10 ; newline + call string_append_char + pop rsi + + ; print the string + push rsi ; Save the string address + call print_string + pop rsi + call release_array ; Release the string + + ; Return nil + call alloc_cons + mov [rax], BYTE maltype_nil + ret + +;; Given a string, calls read_str to get an AST +core_read_string: + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + jne .no_string + + mov rsi, [rsi + Cons.car] + mov al, BYTE [rsi] + cmp al, maltype_string + jne .no_string + + call read_str + ret + +.no_string: + ; Didn't get a string input + call alloc_cons + mov [rax], BYTE maltype_nil + ret + + +;; Reads a file into a string +core_slurp: + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + jne .no_string + + mov rsi, [rsi + Cons.car] + mov al, BYTE [rsi] + cmp al, maltype_string + jne .no_string + + call read_file + ret + +.no_string: + ; Didn't get a string input + call alloc_cons + mov [rax], BYTE maltype_nil + ret + +;; Evaluate an expression in the REPL environment +;; +core_eval: + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .pointer + + ; Just a value, so return it + call incref_object + + mov al, BYTE [rsi] + and al, content_mask + mov [rsi], BYTE al ; Removes list + mov rax, rsi + ret + +.pointer: + ; A pointer, so need to eval + mov rdi, [rsi + Cons.car] + + mov rsi, [repl_env] ; Environment + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval + ret + +;; Create an atom +core_atom: + push rsi + call alloc_cons ; To hold the pointer + pop rsi + mov [rax], BYTE maltype_atom + + ; Check the type of the first argument + mov bl, BYTE [rsi] + mov bh, bl + and bh, content_mask + cmp bh, content_pointer + je .pointer + + ; A value + + ; make a copy + push rax + push rsi + push rbx + call alloc_cons + pop rbx + + mov bl, bh + mov [rax], BYTE bl ; Set type + + mov rbx, rax + pop rsi + pop rax + + mov rcx, [rsi + Cons.car] + mov [rbx + Cons.car], rcx ; Set value + + ; Set the atom to point to it + mov [rax + Cons.car], rbx + + ret + +.pointer: + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx + + push rax + mov rsi, rbx + call incref_object ; Storing in atom + pop rax + ret + +;; Get the value from the atom +core_deref: + ; Check the type of the first argument + mov bl, BYTE [rsi] + mov bh, bl + and bh, content_mask + cmp bh, content_pointer + jne .not_atom + + ; Get the atom + mov rsi, [rsi + Cons.car] + mov bl, BYTE [rsi] + cmp bl, maltype_atom + jne .not_atom + + ; Return what it points to + mov rsi, [rsi + Cons.car] + call incref_object + mov rax, rsi + ret + +.not_atom: + ; Not an atom, so throw an error + mov rsi, core_deref_not_atom + mov edx, core_deref_not_atom.len + call raw_to_symbol + mov rsi, rax + jmp error_throw + +;; Test if given object is an atom +core_atomp: + mov al, maltype_atom + jmp core_pointer_type_p +core_symbolp: + mov al, maltype_symbol + jmp core_pointer_type_p +core_stringp: + mov al, maltype_string + jmp core_pointer_type_p +core_fnp: + mov al, maltype_function + jmp core_pointer_type_p +core_macrop: + mov al, maltype_macro + jmp core_pointer_type_p + +core_pointer_type_p: + mov bl, BYTE [rsi] + mov bh, bl + and bh, content_mask + cmp bh, content_pointer + jne .false + + mov rsi, [rsi + Cons.car] + mov bl, BYTE [rsi] + cmp bl, al + jne .false + + ; Check for keyword (not symbol) + cmp al, maltype_symbol + jne .true + + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .false ; a keyword + +.true: + ; Return true + call alloc_cons + mov [rax], BYTE maltype_true + ret + +.false: + call alloc_cons + mov [rax], BYTE maltype_false + ret + +;; Tests if argument is a keyword +core_keywordp: + mov bl, BYTE [rsi] + mov bh, bl + and bh, content_mask + cmp bh, content_pointer + jne .false + + mov rsi, [rsi + Cons.car] + mov bl, BYTE [rsi] + cmp bl, maltype_symbol + jne .false + + ; Check if first character is ':' + mov bl, BYTE [rsi + Array.data] + cmp bl, ':' + jne .false + + ; Return true + call alloc_cons + mov [rax], BYTE maltype_true + ret + +.false: + call alloc_cons + mov [rax], BYTE maltype_false + ret + +;; Change the value of an atom +core_reset: + ; Check the type of the first argument + mov bl, BYTE [rsi] + mov bh, bl + and bh, content_mask + cmp bh, content_pointer + jne .not_atom + + ; Get the atom + mov rax, [rsi + Cons.car] ; Atom in RAX + mov bl, BYTE [rax] + cmp bl, maltype_atom + jne .not_atom + + ; Get the next argument + mov bl, BYTE [rsi + Cons.typecdr] + cmp bl, content_pointer + jne .no_value + + mov rsi, [rsi + Cons.cdr] + + ; Got something in RSI + ; release the current value of the atom + push rax + push rsi + + mov rsi, [rax + Cons.car] ; The value the atom points to + call release_object + + pop rsi + pop rax + + ; Check the type of the first argument + mov bl, BYTE [rsi] + mov bh, bl + and bh, content_mask + cmp bh, content_pointer + je .pointer + + ; A value + + ; make a copy + push rax + push rsi + push rbx + call alloc_cons + pop rbx + + mov bl, bh + mov [rax], BYTE bl ; Set type + + mov rbx, rax + pop rsi + pop rax + + mov rcx, [rsi + Cons.car] + mov [rbx + Cons.car], rcx ; Set value + + ; Set the atom to point to it + mov [rax + Cons.car], rbx + + ; Increment refcount since return value will be released + mov rsi, rbx + call incref_object + mov rax, rsi + ret + +.pointer: + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx + + mov rsi, rbx + call incref_object ; Storing in atom + call incref_object ; Returning + mov rax, rsi + ret + +.not_atom: + ; Not an atom, so throw an error + mov rsi, core_reset_not_atom + mov edx, core_reset_not_atom.len + call raw_to_symbol + mov rsi, rax + jmp error_throw + +.no_value: + ; No value given + mov rsi, core_reset_no_value + mov edx, core_reset_no_value.len + call raw_to_symbol + mov rsi, rax + jmp error_throw + +;; Applies a function to an atom, along with optional arguments +;; +;; In RSI should be a list consisting of +;; [ atom, pointer->Function , args...] +;; +;; The atom is dereferenced, and inserted into the list: +;; +;; [ pointer->Function , atom value , args...] +;; +;; This is then passed to eval.list_exec +;; which executes the function +;; +core_swap: + ; Check the type of the first argument (an atom) + mov bl, BYTE [rsi] + mov bh, bl + and bh, content_mask + cmp bh, content_pointer + jne .not_atom + + ; Get the atom + mov r9, [rsi + Cons.car] ; Atom in R9 + mov bl, BYTE [r9] + cmp bl, maltype_atom + jne .not_atom + + ; Get the second argument (a function) + mov bl, BYTE [rsi + Cons.typecdr] + cmp bl, content_pointer + jne .no_function + + mov rsi, [rsi + Cons.cdr] ; List with function first + + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .no_function + + mov r8, [rsi + Cons.car] ; Function in R8 + mov al, BYTE [r8] + cmp al, maltype_function + jne .no_function + + ; Get a new Cons + ; containing the value in the atom + call alloc_cons ; In RAX + + ; Prepend to the list + mov bl, BYTE [rsi + Cons.typecdr] + mov [rax + Cons.typecdr], bl + cmp bl, content_pointer + jne .done_prepend + + ; A pointer to more args, + + mov rcx, [rsi + Cons.cdr] + mov [rax + Cons.cdr], rcx + + ; increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.done_prepend: + + ; Now get the value in the atom + mov rdx, [r9 + Cons.car] ; The object pointed to + + ; Check what it is + mov bl, BYTE [rdx] + mov bh, bl + and bh, (block_mask + container_mask) + jz .atom_value ; Just a value + + ; Not a simple value, so point to it + mov [rax + Cons.car], rdx + mov [rax], BYTE (container_list + content_pointer) + + ; Since the list will be released after eval + ; we need to increment the reference count + mov bx, WORD [rdx + Cons.refcount] + inc bx + mov [rdx + Cons.refcount], WORD bx + + jmp .run + +.atom_value: + ; Copy the value + mov rcx, [rdx + Cons.car] + mov [rax + Cons.car], rcx + and bl, content_mask ; keep just the content + or bl, container_list ; mark as part of a list + mov [rax], BYTE bl + +.run: + mov rsi, rax + + ; Here have function in R8, args in RSI + ; Check whether the function is built-in or user + mov rax, [r8 + Cons.car] + cmp rax, apply_fn + je .user_function + + ; A built-in function + push r9 ; atom + push rsi ; Args + + call rax + ; Result in RAX + + pop rsi + pop r9 + + push rax + call release_object ; Release arguments + pop rax + + jmp .got_return + +.user_function: + ; a user-defined function, so need to evaluate + ; RSI - Args + + mov rdi, r8 ; Function in RDI + mov rdx, rsi ; Release args after binding + + mov rsi, r15 ; Environment + call incref_object ; Released by eval + call incref_object ; also released from R13 + mov r13, r15 + + mov rsi, rdx + + push r9 + call apply_fn ; Result in RAX + pop r9 + +.got_return: + ; Have a return result in RAX + + ; release the current value of the atom + push rax ; The result + mov rsi, [r9 + Cons.car] + call release_object + pop rax + + ; Put into atom + mov [r9 + Cons.car], rax + + ; Increase reference of new object + ; because when it is returned it will be released + mov bx, WORD [rax + Cons.refcount] + inc bx + mov [rax + Cons.refcount], WORD bx + + ret + +.not_atom: + load_static core_swap_not_atom + jmp core_throw_str +.no_function: + load_static core_swap_no_function + jmp core_throw_str + + +;; Takes two arguments, and prepends the first argument onto the second +;; The second argument can be a list or a vector, but the return is always +;; a list +core_cons: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_empty + je .missing_args + + mov r8, rsi ; The object to prepend + + ; Check if there's a second argument + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .missing_args + + mov rsi, [rsi + Cons.cdr] + + ; Check that the second argument is a list or vector + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_vector + + mov r9, [rsi + Cons.car] ; Should be a list or vector + mov al, BYTE [r9] + and al, container_mask + cmp al, container_list + je .got_args + cmp al, container_vector + je .got_args + jmp .not_vector + +.got_args: + ; Got an object in R8 and list/vector in R9 + + call alloc_cons ; new Cons in RAX + + ; Mark as the same content in a list container + mov bl, BYTE [r8] + and bl, content_mask + mov bh, bl ; Save content in BH for checking if pointer later + or bl, block_cons + container_list + mov [rax], BYTE bl + + ; Copy the content + mov rcx, [r8 + Cons.car] ; Content in RCX + mov [rax + Cons.car], rcx + + ; Check if R9 is empty + mov dl, BYTE [r9] + and dl, content_mask + cmp dl, content_empty + je .end_append ; Don't append the list + + ; Put the list into CDR + mov [rax + Cons.cdr], r9 + ; mark CDR as a pointer + mov [rax + Cons.typecdr], BYTE content_pointer + + ; Increment reference count + push rax + mov rsi, r9 + call incref_object + pop rax + +.end_append: + ; Check if the new Cons contains a pointer + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .done + + ; A pointer, so increment number of references + push rax + mov rsi, rcx + call incref_object + pop rax +.done: + ret + +.missing_args: + load_static core_cons_missing_arg + jmp core_throw_str + +.not_vector: + load_static core_cons_not_vector + jmp core_throw_str + + +;; Concatenate lists, returning a new list +;; +;; Notes: +;; * The last list does not need to be copied, but all others do +;; +core_concat: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_empty + je .missing_args + + cmp al, content_pointer + jne .not_list + + ; Check if there is only one argument + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + je .start_loop ; Start copy loop + + ; Only one input. + mov rsi, [rsi + Cons.car] + + ; Check if it's a list or vector + mov al, BYTE [rsi] + mov cl, al + and al, container_mask + cmp al, (block_cons + container_list) + je .single_list + + cmp al, (block_cons + container_vector) + jne .not_list ; not a list or vector + + ; A vector. Need to create a new Cons + ; for the first element, to mark it as a list + + call alloc_cons + and cl, content_mask + or cl, container_list + mov [rax], BYTE cl ; Set type + + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; Set content + + ; Check if CAR is a pointer + cmp cl, (container_list + content_pointer) + jne .single_done_car + + ; a pointer, so increment reference count + mov cx, WORD [rbx + Cons.refcount] + inc cx + mov [rbx + Cons.refcount], WORD cx + +.single_done_car: + mov dl, BYTE [rsi + Cons.typecdr] + mov [rax + Cons.typecdr], BYTE dl ; CDR type + + mov rbx, [rsi + Cons.cdr] + mov [rax + Cons.cdr], rbx ; Set CDR content + + ; Check if CDR is a pointer + cmp dl, content_pointer + je .single_vector_incref + ; not a pointer, just return + ret + +.single_vector_incref: + ; increment the reference count of object pointed to + mov r12, rax ; The return Cons + mov rsi, rbx ; The object address + call incref_object + mov rax, r12 + ret + +.single_list: + ; Just increment reference count and return + + call incref_object + mov rax, rsi + ret + +.start_loop: ; Have at least two inputs + xor r11, r11 ; Head of list. Start in R12 + +.loop: + + ; Check the type + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_list + + ; Check if this is the last + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .last + + ; Check if the list is empty + mov rbx, [rsi + Cons.car] ; The list + mov al, BYTE [rbx] + and al, content_mask + cmp al, content_empty ; If empty list or vector + je .next ; Skip to next + + ; not the last list, so need to copy + + push rsi + mov rsi, rbx ; The list + call cons_seq_copy ; Copy in RAX, last Cons in RBX + pop rsi + + ; Check if this is the first + test r11, r11 + jnz .append + + ; First list + mov r11, rbx ; Last Cons in list + mov r12, rax ; Output list + jmp .next +.append: + ; End of previous list points to start of new list + mov [r11 + Cons.cdr], rax + mov [r11 + Cons.typecdr], BYTE content_pointer + ; Put end of new list into R11 + mov r11, rbx + +.next: + mov rsi, [rsi + Cons.cdr] + jmp .loop + +.last: + ; last list, so can just append + mov rsi, [rsi + Cons.car] + + ; Check if the list is empty + mov al, BYTE [rsi] + mov ah, al + and al, content_mask + cmp al, content_empty ; If empty list or vector + je .done ; Omit the empty list + + call incref_object + + mov [r11 + Cons.cdr], rsi + mov [r11 + Cons.typecdr], BYTE content_pointer +.done: + ; Check there is anything to return + test r11, r11 + jz .empty_list + + ; Make sure that return is a list + mov bl, BYTE [r12] + and bl, content_mask + or bl, container_list + mov [r12], BYTE bl + mov rax, r12 ; output list + + ret + +.empty_list: + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + +.missing_args: + ; Return empty list + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + +.not_list: + ; Got an argument which is not a list + mov rsi, core_concat_not_list + mov edx, core_concat_not_list.len + +.throw: + call raw_to_string + mov rsi, rax + jmp error_throw + +;; Convert a sequence to vector +core_vec: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .error + mov rsi, [rsi + Cons.car] + + mov al, BYTE [rsi] + and al, block_mask + container_mask + + ;; delegate lists to `vector` built-in + cmp al, container_list + je core_vector + + ;; expect a sequence + cmp al, container_vector + jne .error + + ;; return vectors unchanged + call incref_object + mov rax, rsi + ret + +.error + push rsi + print_str_mac error_string + print_str_mac core_vec_wrong_arg + pop rsi + jmp error_throw + +;; Returns the first element of a list +;; +core_first: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_empty + je .missing_args + + cmp al, content_nil + je .return_nil + + cmp al, content_pointer + jne .not_list + + ; Get the list + mov rsi, [rsi + Cons.car] + + mov al, BYTE [rsi] + + ; Check for nil + cmp al, maltype_nil + je .return_nil + + mov ah, al + and ah, (block_mask + container_mask) + cmp ah, container_list + je .got_list + cmp ah, container_vector + jne .not_list ; Not a list or vector + +.got_list: + ; Check if list is empty + and al, content_mask + cmp al, content_empty + je .return_nil + + cmp al, content_pointer + je .return_pointer + + ; Returning a value, so need to copy + mov cl, al + call alloc_cons + mov [rax], BYTE cl ; Set type + + ; Copy value + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + ret + +.return_pointer: + mov rsi, [rsi + Cons.car] + call incref_object + mov rax, rsi + ret + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + ret + +.missing_args: + mov rsi, core_first_missing_arg + mov edx, core_first_missing_arg.len + jmp .throw + +.not_list: + mov rsi, core_first_not_list + mov edx, core_first_not_list.len +.throw: + call raw_to_string + mov rsi, rax + jmp error_throw + + +;; Return a list with the first element removed +core_rest: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_empty + je .missing_args + + cmp al, content_nil + je .empty_list + + cmp al, content_pointer + jne .not_list + + ; Get the list + mov rsi, [rsi + Cons.car] + + mov al, BYTE [rsi] + + ; Check for nil + cmp al, maltype_nil + je .return_nil + + mov ah, al + and ah, (block_mask + container_mask) + cmp ah, container_list + je .got_list + cmp ah, container_vector + jne .not_list ; Not a list or vector + +.got_list: + ; Check if list or vector is empty + and al, content_mask + cmp al, content_empty + je .empty_list + + ; Check if there is more in the list + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + je .return_rest + + ; No more list, so return empty list +.empty_list: + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + +.return_rest: + + mov rsi, [rsi + Cons.cdr] + + + + ; Check if this is a list or a vector + mov cl, BYTE [rsi] + mov ch, cl + and ch, container_mask + cmp ch, container_list + je .return_list + + ; Need to allocate a new Cons to replace this first element + call alloc_cons + and cl, content_mask + mov ch, cl ; Save CAR content type in ch + or cl, container_list ; Keep content type, set container type to list + mov [rax], BYTE cl + + mov dl, BYTE [rsi + Cons.typecdr] ; CDR type in DL + mov [rax + Cons.typecdr], BYTE dl + + ; Copy content of CAR + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx + + ; Check if car contains a pointer + cmp ch, content_pointer + jne .check_cdr + + ; CAR contains a pointer, so increment reference count + + mov r8, rax ; Save return Cons + mov r9, rsi ; Save input list + mov rsi, rbx ; Content of CAR + call incref_object + mov rax, r8 ; Restore return Cons + mov rsi, r9 ; Restore input list + +.check_cdr: + ; Copy content of CDR + + mov rcx, [rsi + Cons.cdr] + mov [rax + Cons.cdr], rcx ; Note: Might be pointer + + ; Check if cdr contains a pointer + cmp dl, content_pointer + jne .return ; Not a pointer, so just return + + ; A pointer, so increment its reference count + mov rbx, rax ; Save the return Cons + mov rsi, rcx ; The pointer in CDR + call incref_object + mov rax, rbx ; Restore the return Cons + ret + +.return_list: + call incref_object + mov rax, rsi +.return: + ret + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + ret + +.missing_args: + mov rsi, core_rest_missing_arg + mov edx, core_rest_missing_arg.len + jmp .throw + +.not_list: + mov rsi, core_rest_not_list + mov edx, core_rest_not_list.len +.throw: + call raw_to_string + mov rsi, rax + jmp error_throw + + +;; Return the nth element of a list or vector +core_nth: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_empty + je .missing_args + + cmp al, content_nil + je .return_nil + + cmp al, content_pointer + jne .not_list + + ; Get the list into R8 + mov r8, [rsi + Cons.car] + + ; Check if we have a second argument + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .missing_args + + mov r9, [rsi + Cons.cdr] + + ; Check that it is a number + mov al, BYTE [r9] + and al, content_mask + cmp al, content_int + jne .not_int + + ; Get the number in RBX + mov rbx, [r9 + Cons.car] + + ; Now loop through the list, moving along n elements +.loop: + test rbx, rbx ; Test if zero + jz .done + + ; Move along next element + + mov al, BYTE [r8 + Cons.typecdr] + cmp al, content_pointer + jne .out_of_range ; No element + + mov r8, [r8 + Cons.cdr] + dec rbx + jmp .loop + +.done: + ; Take the head of the list in R8 + mov al, BYTE [r8] + and al, content_mask + cmp al, content_pointer + je .return_pointer + + ; Copy a value + mov cl, al + call alloc_cons + mov [rax], BYTE cl + mov rcx, [r8 + Cons.car] + mov [rax + Cons.car], rcx + ret + +.return_pointer: + mov rsi, [r8 + Cons.car] + call incref_object + mov rax, rsi + ret + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + ret + +.missing_args: + mov rsi, core_nth_missing_arg + mov edx, core_nth_missing_arg.len + jmp .throw + +.not_list: + mov rsi, core_nth_not_list + mov edx, core_nth_not_list.len + jmp .throw + +.not_int: + mov rsi, core_nth_not_int + mov edx, core_nth_not_int.len + jmp .throw + +.out_of_range: + mov rsi, core_nth_out_of_range + mov edx, core_nth_out_of_range.len + +.throw: + call raw_to_string + mov rsi, rax + jmp error_throw + +;; Check if the argument is a given value type +core_nilp: + mov al, BYTE content_nil + jmp core_value_type_p +core_truep: + mov al, BYTE content_true + jmp core_value_type_p +core_falsep: + mov al, BYTE content_false + jmp core_value_type_p +core_numberp: + mov al, BYTE content_int +;; predicates for nil, true, false and number jump here +core_value_type_p: + mov bl, BYTE [rsi] + and bl, content_mask + cmp bl, content_empty + je .missing_args + + cmp al, bl + je .true + + ; false + call alloc_cons + mov [rax], BYTE maltype_false + ret +.true: + call alloc_cons + mov [rax], BYTE maltype_true + ret + +.missing_args: + mov rsi, core_value_p_missing_args + mov edx, core_value_p_missing_args.len + + call raw_to_string + mov rsi, rax + jmp error_throw + +;; Throws an exception +core_throw: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_empty + je .throw_nil ; No arguments + + cmp al, content_pointer + je .throw_pointer + + ; A value. Remove list content type + mov [rsi], BYTE al + jmp error_throw + +.throw_pointer: + mov rsi, [rsi + Cons.car] + jmp error_throw + +.throw_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov rsi, rax + jmp error_throw + +;; Applies a function to a list or vector +;; +;; Uses registers +;; R8 - function +;; R9 - Input list/vector +;; R10 - Current end of return list (for appending) +core_map: + xor r10,r10 ; Zero, signal no list + + ; First argument should be a function + mov bl, BYTE [rsi] + and bl, content_mask + cmp bl, content_empty + je .missing_args + + ; Check the first argument is a pointer + cmp bl, content_pointer + jne .not_function + + mov r8, [rsi + Cons.car] ; Function in R8 + mov bl, BYTE [r8] + cmp bl, maltype_function + jne .not_function + + ; Check for second argument + mov bl, BYTE [rsi + Cons.typecdr] + cmp bl, content_pointer + jne .missing_args + + mov rsi, [rsi + Cons.cdr] + + ; Should be a pointer to a list or vector + mov bl, BYTE [rsi] + and bl, content_mask + cmp bl, content_pointer + jne .not_seq + + mov r9, [rsi + Cons.car] ; List or vector in R9 + + mov bl, BYTE [r9] + + mov bh, bl + and bh, content_mask + cmp bh, content_empty + je .empty_list + + and bl, (block_mask + container_mask) + cmp bl, container_list + je .start + cmp bl, container_vector + je .start + + ; not list or vector + jmp .not_seq + +.start: + ; Got function in R8, list or vector in R9 + + mov cl, BYTE [r9] + and cl, content_mask + mov ch, cl + or cl, container_list + + call alloc_cons + mov [rax], BYTE cl ; set content type + mov rbx, [r9 + Cons.car] + mov [rax + Cons.car], rbx ; Copy content + mov rsi, rax + + cmp ch, content_pointer + jne .run + + ; A pointer, so increment ref count + + mov rcx, rsi + mov rsi, rbx + call incref_object + mov rsi, rcx + +.run: + ; Here have function in R8, args in RSI + ; Check whether the function is built-in or user + mov rax, [r8 + Cons.car] + cmp rax, apply_fn + je .user_function + + ; A built-in function + push r8 ; function + push r9 ; input list/vector + push r10 ; End of return list + push rsi + + call rax + ; Result in RAX + + pop rsi + pop r10 + pop r9 + pop r8 + + push rax + call release_object ; Release arguments + pop rax + + jmp .got_return + +.user_function: + ; a user-defined function, so need to evaluate + ; RSI - Args + + mov rdi, r8 ; Function in RDI + mov rdx, rsi ; Release args after binding + + mov rsi, r15 ; Environment + call incref_object ; Released by eval + call incref_object ; also released from R13 + mov r13, r15 + + mov rsi, rdx + + push r8 + push r9 + push r10 + push r15 + call apply_fn ; Result in RAX + pop r15 + pop r10 + pop r9 + pop r8 + +.got_return: + ; Have a return result in RAX + + ; Check if it's a value type + mov bl, BYTE [rax] + mov bh, bl + and bl, (block_mask + container_mask) + jz .return_value + + ; A more complicated type, point to it + mov rcx, rax + call alloc_cons ; Create a Cons for address + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.car], rcx + jmp .update_return + +.return_value: + ; Check if this value is shared (e.g. in an atom) + mov cx, WORD [rax + Cons.refcount] + dec cx + jz .return_value_modify ; If reference count is 1 + + ; Need to copy to avoid modifying + push rsi + mov rsi, rax ; Original in RSI + + mov cl, bh ; Type + call alloc_cons + and cl, content_mask + or cl, container_list + mov [rax], BYTE cl ; mark as a list + + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy content + + ; Release original + push rax + call release_object + pop rax + pop rsi + + jmp .update_return + +.return_value_modify: + ; Only one reference, + ; so can change the container type to list. + ; Original type in bh + mov bl, bh + and bl, content_mask + or bl, container_list + mov [rax], BYTE bl + +.update_return: + ; Now append to result list + test r10,r10 + jnz .append + + ; First value + mov r10, rax ; End of list + push r10 ; popped before return + jmp .next +.append: + mov [r10 + Cons.cdr], rax ; Point to new Cons + mov [r10 + Cons.typecdr], BYTE content_pointer + mov r10, rax +.next: + ; Check if there is another value + mov al, [r9 + Cons.typecdr] + cmp al, content_pointer + jne .done ; no more + + mov r9, [r9 + Cons.cdr] ; next + jmp .start + +.done: + pop rax ; Pushed in .update_return + ret + +.empty_list: + ; Got an empty list, so return an empty list + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + +.missing_args: + ; Either zero or one args, expect two + load_static core_map_missing_args + jmp core_throw_str +.not_function: + ; First argument not a function + load_static core_map_not_function + jmp core_throw_str +.not_seq: + ; Second argument not list or vector + load_static core_map_not_seq + jmp core_throw_str + + +;; Applies a function to a list of arguments, concatenated with +;; a final list of args +;; (function, ..., []) +core_apply: + ; First argument should be a function + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_function + + mov r8, [rsi + Cons.car] ; function in R8 + mov al, BYTE [r8] + cmp al, maltype_function + je .function_or_macro + cmp al, maltype_macro + jne .not_function +.function_or_macro: + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .missing_args + + xor r9,r9 + ; Optional args, followed by final list/vector +.loop: + mov rsi, [rsi + Cons.cdr] + + ; Check if this is the last + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .last + + ; Not the last, so copy + call alloc_cons ; New Cons in RAX + mov bl, BYTE [rsi] + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + + and bl, content_mask + cmp bl, content_pointer + jne .got_value + + ; A pointer, so increment reference + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.got_value: + ; Now append this Cons to the list + test r9,r9 + jnz .append + + ; First + mov r9, rax ; Start of the list + mov r10, rax ; End of the list + jmp .loop + +.append: + mov [r10 + Cons.typecdr], BYTE content_pointer + mov [r10 + Cons.cdr], rax + mov r10, rax + jmp .loop + +.last: + ; Check that it's a list or vector + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_seq + + mov rsi, [rsi + Cons.car] ; Vector/list in RSI + mov al, BYTE [rsi] + and al, container_mask + cmp al, container_list + je .last_seq + cmp al, container_vector + jne .not_seq + +.last_seq: + ; Check if there were any previous args + test r9, r9 + jnz .last_append + + ; R9 is zero, so no previous args + + ; check that this is a list + ; and convert vector to list + + mov r9, rsi + + ; Check if R9 is a list + mov al, BYTE [r9] + mov cl, al + and al, container_mask + cmp al, container_list + jne .last_convert_to_list + + ; Already a list, just increment reference count + mov rsi, r9 + call incref_object + jmp .run + +.last_convert_to_list: + ; Convert vector to list by copying first element + + call alloc_cons + and cl, content_mask + or cl, container_list + mov [rax], BYTE cl + mov rdx, [r9 + Cons.car] + mov [rax + Cons.car], rdx + + ; check if contains a pointer + cmp cl, (container_list + content_pointer) + jne .copy_cdr + + ; A pointer, so increment reference + mov bx, WORD [rdx + Cons.refcount] + inc bx + mov [rdx + Cons.refcount], WORD bx + +.copy_cdr: + mov bl, BYTE [r9 + Cons.typecdr] + mov rcx, [r9 + Cons.cdr] + mov [rax + Cons.typecdr], BYTE bl + mov [rax + Cons.cdr], rcx + + ; Replace R9 with this new element + mov r9, rax + + cmp bl, content_pointer + jne .run + + ; A pointer, so increment reference + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + + jmp .run + +.last_append: + ; Append RSI to the end of the list [R9]...[R10] + mov [r10 + Cons.typecdr], BYTE content_pointer + mov [r10 + Cons.cdr], rsi + call incref_object + +.run: + ; Have arguments list in R9 + mov rsi, r9 + ; Here have function in R8, args in RSI + ; Check whether the function is built-in or user + mov rax, [r8 + Cons.car] + cmp rax, apply_fn + je .user_function + + ; A built-in function + push r8 ; function + push r9 ; input list/vector + push r10 ; End of return list + push rsi + + call rax + ; Result in RAX + + pop rsi + pop r10 + pop r9 + pop r8 + + push rax + call release_object ; Release arguments + pop rax + + ret + +.user_function: + ; a user-defined function, so need to evaluate + ; RSI - Args + + mov rdi, r8 ; Function in RDI + mov rdx, rsi ; Release args after binding + + mov rsi, r15 ; Environment + call incref_object ; Released by eval + call incref_object ; also released from R13 + mov r13, r15 + + mov rsi, rdx + + push r8 + push r9 + push r10 + call apply_fn ; Result in RAX + pop r10 + pop r9 + pop r8 + + ret + +.not_function: + load_static core_apply_not_function + jmp core_throw_str + +.missing_args: + load_static core_apply_missing_args + jmp core_throw_str + +.not_seq: + load_static core_apply_not_seq + jmp core_throw_str + +;; Converts a string to a symbol +core_symbol: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_string + + mov rsi, [rsi + Cons.car] + mov al, BYTE [rsi] + cmp al, maltype_string + jne .not_string + + ; Copy the string + call string_copy ; result in RAX + + mov [rax], BYTE maltype_symbol + ret + +.not_string: + load_static core_symbol_not_string + jmp core_throw_str + +;; Converts a string to a keyword +core_keyword: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .error + + mov r8, [rsi + Cons.car] ; String in R8 + mov al, BYTE [r8] + cmp al, maltype_string + jne .not_string + + call string_new ; String in RAX + mov rsi, rax + mov cl, ':' + call string_append_char ; Puts ':' first + + mov rdx, r8 + call string_append_string ; append + + ; Mark as keyword + mov [rsi], BYTE maltype_symbol + + mov rax, rsi + ret + +.not_string: + cmp al, maltype_symbol + jne .error + ; Check if first character is ':' + mov al, BYTE [r8 + Array.data] + cmp al, ':' + jne .error + ;; This is already a keyword, return it unchanged. + mov rsi, r8 + call incref_object + mov rax, rsi + ret +.error: + load_static core_keyword_not_string + jmp core_throw_str + +;; Sets values in a map +core_assoc: + ; check first arg + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_map + + mov r8, [rsi + Cons.car] ; map in R8 + mov al, BYTE [r8] + and al, container_mask + cmp al, container_map + jne .not_map + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + je .start + + ; No keys to set, so just increment and return + mov rsi, r8 + call incref_object + mov rax, rsi + ret + +.start: + mov r11, [rsi + Cons.cdr] ; List of keys/values in R11 + + ; Copy the original list + mov rsi, r8 + call map_copy + mov rsi, rax ; new map in RSI + +.loop: + ; Get key then value from R11 list + + mov cl, BYTE [r11] + and cl, content_mask + cmp cl, content_pointer + je .key_pointer + + ; Key is a value, so copy into a Cons + call alloc_cons + mov [rax], BYTE cl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + mov rdi, rax ; Key in RDI + jmp .get_value + +.key_pointer: + mov rdi, [r11 + Cons.car] + ; increment reference count because the key will be + ; released after setting (to allow value Cons to be + ; freed) + + mov bx, WORD [rdi + Cons.refcount] + inc bx + mov [rdi + Cons.refcount], WORD bx + +.get_value: + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .missing_value + + mov r11, [r11 + Cons.cdr] + + ; Check if value is a pointer + mov cl, BYTE [r11] + and cl, content_mask + cmp cl, content_pointer + je .value_pointer + + ; Value is a value, so copy into a Cons + call alloc_cons + mov [rax], BYTE cl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + mov rcx, rax ; Key in RCX + jmp .set_pair + +.value_pointer: + mov rcx, [r11 + Cons.car] + ; increment reference count because the value will be + ; released after setting (to allow value Cons to be + ; freed) + + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.set_pair: + ; Here have: + ; map in RSI + ; key in RDI + ; value in RCX + + call map_set + + mov r8, rsi ; map + mov rsi, rdi ; key + call release_object + mov rsi, rcx ; value + call release_object + mov rsi, r8 ; map + + ; Check if there's another pair + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .done + + ; got another pair + mov r11, [r11 + Cons.cdr] + jmp .loop + +.done: + mov rax, rsi ; new map + ret + +.not_map: + load_static core_assoc_not_map + jmp core_throw_str + +.missing_value: + load_static core_assoc_missing_value + jmp core_throw_str + + +;; Removes keys from a map by making +;; a copy of a map without the given keys +core_dissoc: + ; Check that the first argument is a map + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .not_map + + mov r8, [rsi + Cons.car] ; Map in R8 + mov al, BYTE [r8] + mov ah, al + and al, container_mask + cmp al, container_map + jne .not_map + + ; Check if the map is empty + cmp ah, maltype_empty_map + je .inc_and_return + + ; Now check if there are other arguments + + mov al, [rsi + Cons.typecdr] + cmp al, content_pointer + je .start + +.inc_and_return: + ; No keys to remove + ; just increment the map reference count and return + mov rsi, r8 + call incref_object + mov rax, rsi + ret + +.start: + ; Some keys to remove + mov r9, [rsi + Cons.cdr] + + ; R9 now contains a list of keys + ; R8 contains the map to copy + + xor r11, r11 ; Head of list to return + ; R12 contains tail + +.loop: + ; Check the key in R8 against the list in R9 + mov r10, r9 ; point in list being searched + + ; loop through the list in R10 + ; comparing each element against R8 +.search_loop: + mov rsi, r8 + mov rdi, r10 + call compare_objects + test rax, rax + jz .found ; objects are equal + + ; Not found so check next in list + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .not_found ; End of list + + mov r10, [r10 + Cons.cdr] ; next + jmp .search_loop + +.found: + ; Removing this key, so skip + mov al, BYTE [r8 + Cons.typecdr] + cmp al, content_pointer + jne .missing_value + + mov r8, [r8 + Cons.cdr] ; now a value + jmp .next + +.not_found: + ; Key not in list, so keeping + ; Create a Cons to copy + call alloc_cons + mov bl, [r8] + mov rcx, [r8 + Cons.car] + + mov [rax], BYTE bl + mov [rax + Cons.car], rcx + + ; Check if a pointer or value + and bl, content_mask + cmp bl, content_pointer + jne .done_key ; A value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.done_key: + ; append to list + + test r11, r11 + jnz .key_append + + ; First one + mov r11, rax + mov r12, rax + jmp .copy_value +.key_append: + + mov [r12 + Cons.typecdr], BYTE content_pointer + mov [r12 + Cons.cdr], rax + mov r12, rax + +.copy_value: + + ; Check there is a value + mov al, BYTE [r8 + Cons.typecdr] + cmp al, content_pointer + jne .missing_value + + mov r8, [r8 + Cons.cdr] ; Value + + ; Same as for key; create a Cons and copy + call alloc_cons + mov bl, [r8] + mov rcx, [r8 + Cons.car] + + mov [rax], BYTE bl + mov [rax + Cons.car], rcx + + ; Check if a pointer or value + and bl, content_mask + cmp bl, content_pointer + jne .done_value ; A value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.done_value: + ; append to list + mov [r12 + Cons.typecdr], BYTE content_pointer + mov [r12 + Cons.cdr], rax + mov r12, rax + +.next: + ; Here R8 contains a value + + ; Check if there's another key + mov al, [r8 + Cons.typecdr] + cmp al, content_pointer + jne .done + + ; Still more + + mov r8, [r8 + Cons.cdr] + jmp .loop + +.done: + ; Check if the map is empty + test r11, r11 + jz .return_empty + + ; not empty, so return + mov rax, r11 + ret + +.return_empty: + call alloc_cons + mov [rax], BYTE maltype_empty_map + ret + +.not_map: + load_static core_dissoc_not_map + jmp core_throw_str + +.missing_value: + load_static core_dissoc_missing_value + jmp core_throw_str + + +;; Takes a string prompt for the user, and returns +;; a string or nil +core_readline: + ; Check the input + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .no_prompt + + mov rsi, [rsi + Cons.car] + mov al, BYTE [rsi] + cmp al, maltype_string + jne .no_prompt + + ; Got a string in RSI + call print_string + +.no_prompt: + + ; Get string from user + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .return_nil + + ; return the string in RAX + ret + +.return_nil: + ; release string in RAX + mov rsi, rax + call release_array + + call alloc_cons + mov [rax], BYTE maltype_nil + ret + + +;; Return the meta data associated with a given function +core_meta: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.car] + mov al, BYTE [rsi] + cmp al, (block_cons + container_function + content_function) + jne .return_nil + + ; Here got a function + mov rsi, [rsi + Cons.cdr] + + ; RSI should now contain the meta data + mov cl, BYTE [rsi] + and cl, content_mask + cmp cl, content_pointer + je .pointer + + ; A value, so copy + call alloc_cons + mov [rax], BYTE cl + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx + ret + +.pointer: + ; A pointer, so increment reference count and return + mov rsi, [rsi + Cons.car] + call incref_object + mov rax, rsi + ret + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + ret + + +;; Associates a value with a function (native or user) +core_with_meta: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .no_function + + mov r8, [rsi + Cons.car] ; Function in R8 + mov al, BYTE [r8] + cmp al, (block_cons + container_function + content_function) + jne .no_function + + mov bl, BYTE [rsi + Cons.typecdr] + cmp bl, content_pointer + jne .no_value + + mov rsi, [rsi + Cons.cdr] + + ; Function in R8, new value in RSI + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) ; Type + mov rbx, [r8 + Cons.car] + mov [rax + Cons.car], rbx ; Function address + + mov r10, rax ; Return address + + ; Copy the meta data + + mov r8, [r8 + Cons.cdr] ; R8 now old meta data (not used) + + call alloc_cons + + mov cl, BYTE [rsi] + and cl, content_mask + mov ch, cl + or cl, container_function + mov [rax], BYTE cl ; Set type + + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; Copy value + + ; append to function + mov [r10 + Cons.typecdr], BYTE content_pointer + mov [r10 + Cons.cdr], rax + mov r11, rax + + ; Check if meta is a value or pointer + cmp ch, content_pointer + jne .copy_rest + + ; increment reference count of meta + mov cx, WORD [rbx + Cons.refcount] + inc cx + mov [rbx + Cons.refcount], WORD cx + +.copy_rest: + ; Copy remainder of function (if any) + ; If a user function, has (env binds body) + mov al, [r8 + Cons.typecdr] + cmp al, content_pointer + jne .done + + ; Still more to copy + mov r8, [r8 + Cons.cdr] + + call alloc_cons + mov bl, BYTE [r8] + mov [rax], BYTE bl ; Copy type + mov rcx, [r8 + Cons.car] + mov [rax + Cons.car], rcx ; Copy value + + ; append + mov [r11 + Cons.typecdr], BYTE content_pointer + mov [r11 + Cons.cdr], rax + mov r11, rax + + ; Check if it's a pointer + and bl, content_mask + cmp bl, content_pointer + jne .copy_rest + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + jmp .copy_rest + +.done: + mov rax, r10 + ret + +.no_function: + load_static core_with_meta_no_function + jmp core_throw_str + +.no_value: + load_static core_with_meta_no_value + jmp core_throw_str + + +;; Returns the current time in ms +core_time_ms: + call clock_time_ms + mov rsi, rax + + call alloc_cons + mov [rax], BYTE maltype_integer + mov [rax + Cons.car], rsi + ret + +;; Convert sequences, including strings, into lists +core_seq: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + je .pointer + + cmp al, content_empty + je .missing_arg + + cmp al, content_nil + jne .wrong_type + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + ret + +.pointer: + mov r8, [rsi + Cons.car] + mov al, BYTE [r8] + + cmp al, maltype_string + je .string + + mov ah, al + and ah, (block_mask + content_mask) + cmp ah, (block_cons + content_empty) + je .return_nil + + and al, (block_mask + container_mask) + + cmp al, (block_cons + container_list) + je .list + + cmp al, (block_cons + container_vector) + jne .wrong_type + + ; Convert vector to list by replacing the first Cons + call alloc_cons + mov bl, BYTE [r8] + and bl, content_mask + or bl, container_list + mov [rax], BYTE bl ; Set type + + mov rcx, [r8 + Cons.car] + mov [rax + Cons.car], rcx + + ; Check if it's a pointer + cmp bl, (container_list + content_pointer) + jne .copy_cdr + + ; Increment reference count + mov bx, WORD [rcx + Cons.refcount] ; Same for Array + inc bx + mov [rcx + Cons.refcount], WORD bx + +.copy_cdr: + mov rcx, [r8 + Cons.cdr] + mov [rax + Cons.cdr], rcx + + mov bl, [r8 + Cons.typecdr] + mov [rax + Cons.typecdr], bl + + cmp bl, content_pointer + jne .return + + ; Increment reference count + mov bx, WORD [rcx + Cons.refcount] ; Same for Array + inc bx + mov [rcx + Cons.refcount], WORD bx + +.return: + ret + +.list: + ; Return list unchanged + mov rsi, r8 + call incref_object + mov rax, r8 + ret + +.string: + ; Split a string into characters + ; Input string in R8 + + mov ebx, DWORD [r8 + Array.length] + test ebx,ebx + jz .return_nil ; empty string + + ; Not empty, so allocate first Cons + call alloc_cons + mov r9, rax ; Return Cons in R9 + mov r10, rax ; End of list in R10 + +.loop: + mov ebx, DWORD [r8 + Array.length] + mov r11, r8 + add r11, Array.data ; Start of string data in R11 + mov r12, r11 + add r12, rbx ; End of string data in R12 + +.inner_loop: + ; Get a new string + call string_new ; in RAX + mov bl, BYTE [r11] ; Get the next character + mov [rax + Array.data], BYTE bl + mov [rax + Array.length], DWORD 1 + + ; Put string into Cons at end of list + mov [r10 + Cons.car], rax + + ; Set type + mov [r10], BYTE (container_list + content_pointer) + + inc r11 + cmp r11, r12 + je .inner_done + + ; more characters, so allocate another Cons + call alloc_cons + + mov [r10 + Cons.typecdr], BYTE content_pointer + mov [r10 + Cons.cdr], rax + mov r10, rax + jmp .inner_loop + +.inner_done: + ; No more characters in this Array + ; check if there are more + mov r8, QWORD [r8 + Array.next] ; Get the next Array address + test r8, r8 ; Test if it's null + jz .string_finished + + ; Another chunk in the string + + call alloc_cons + mov [r10 + Cons.typecdr], BYTE content_pointer + mov [r10 + Cons.cdr], rax + mov r10, rax + jmp .loop + +.string_finished: + mov rax, r9 + ret + +.missing_arg: + ; No arguments + load_static core_seq_missing_arg + jmp core_throw_str + +.wrong_type: + ; Not a list, vector, string or nil + load_static core_seq_wrong_type + jmp core_throw_str + diff --git a/impls/nasm/env.asm b/impls/nasm/env.asm new file mode 100644 index 0000000000..95c96deb9d --- /dev/null +++ b/impls/nasm/env.asm @@ -0,0 +1,309 @@ + +%include "macros.mac" + +;; ------------------------------------------------------------ +;; Environment type +;; +;; These are lists of maps. The head of the list is the +;; current environment, and CDR points to the outer environment +;; +;; ( {} {} ... ) + +section .data + +;; Symbols used for comparison + static_symbol env_symbol, '*env*' + static_symbol ampersand_symbol, '&' + +;; Error message strings + + static env_binds_error_string, db "Env expecting symbol in binds list",10 + static env_binds_missing_string, db "Env missing expression in bind",10 + static env_missing_symbol_after_amp_string, db "Env missing symbol after &",10 + +section .text + +;; Create a new Environment +;; +;; Input: outer Environment in RSI. +;; - If zero, then nil outer. +;; - If not zero, increments reference count +;; +;; Return a new Environment type in RAX +;; +;; Modifies registers: +;; RAX +;; RBX +env_new: + call map_new ; map in RAX + push rax + call alloc_cons ; Cons in RAX + pop rbx ; map in RBX + + mov [rax], BYTE (block_cons + container_list + content_pointer) + ; CDR type already set to nil in alloc_cons + mov [rax + Cons.car], rbx + + cmp rsi, 0 + jne .set_outer + ret ; No outer, just return +.set_outer: + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rsi + + ; increment reference counter of outer + mov rbx, rax ; because incref_object modifies rax + call incref_object + mov rax, rbx + ret + +;; Create a new environment using a binding list +;; +;; Input: RSI - Outer environment +;; RDI - Binds, a list of symbols +;; RCX - Exprs, a list of values to bind each symbol to +;; +;; Modifies registers +;; RBX +;; RDX +;; R8 +;; R9 +;; R10 +;; R11 +;; R12 +;; R13 +env_new_bind: + mov r11, rdi ; binds list in R11 + mov r12, rcx ; expr list in R12 + + call env_new + mov r13, rax ; New environment in R13 + +.bind_loop: + ; Check the type in the bind list + mov bl, BYTE [r11] + and bl, content_mask + cmp bl, content_empty + je .done ; No bindings + + cmp bl, content_pointer + jne .bind_not_symbol + + mov rdi, [r11 + Cons.car] ; Symbol object? + mov bl, BYTE [rdi] + cmp bl, maltype_symbol + jne .bind_not_symbol + + ; RDI now contains a symbol + + ; Check if it is '&' + mov rsi, ampersand_symbol + push rdi + call compare_char_array ; Compares RSI and RDI + pop rdi + cmp rax, 0 + je .variadic ; Bind rest of args to following symbol + + ; Check the type in expr + + mov bl, BYTE [r12] + mov bh, bl + and bh, content_mask + + cmp bh, content_empty + je .bind_missing_expr ; No expression + + cmp bh, content_pointer + je .value_pointer + + ; A value. Need to remove the container type + xchg bl,bh + mov [r12], BYTE bl + xchg bl,bh + mov rcx, r12 ; Value + mov rsi, r13 ; Env + push rbx + call env_set + pop rbx + ; Restore original type + mov [r12], BYTE bl + jmp .next + +.value_pointer: + ; A pointer to something, so just pass address to env_set + mov rcx, [r12 + Cons.car] + mov rsi, r13 + call env_set + ; Fall through to next +.next: + ; Check if there is a next symbol + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .done + + ; Got another symbol + mov r11, [r11 + Cons.cdr] ; Next symbol + + ; Check if there's an expression to bind to + mov bl, BYTE [r12 + Cons.typecdr] + cmp bl, content_pointer + jne .next_no_expr ; No expr, but symbol could be & + + mov r12, [r12 + Cons.cdr] ; Next expression + jmp .bind_loop + +.next_no_expr: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov r12, rax + + jmp .bind_loop +.done: + mov rax, r13 ; Env + ret + +.variadic: + ; R11 Cons contains '&' symbol + ; Bind next symbol to the rest of the list in R12 + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .missing_symbol_after_amp + + mov r11, [r11 + Cons.cdr] + + mov bl, BYTE [r11] + and bl, content_mask + cmp bl, content_pointer + jne .bind_not_symbol + + mov rdi, [r11 + Cons.car] ; Symbol object? + mov bl, BYTE [rdi] + cmp bl, maltype_symbol + jne .bind_not_symbol + + ; Bind symbol in RDI to R12 + mov rcx, r12 ; Value + mov rsi, r13 ; Env + call env_set + jmp .done + +.missing_symbol_after_amp: + push r12 + + ; Release the environment + mov rsi, r13 + call release_object + + print_str_mac error_string ; print 'Error: ' + print_str_mac env_missing_symbol_after_amp_string + pop rsi + jmp error_throw + +.bind_not_symbol: ; Expecting a symbol + push r11 ; Binds list + + ; Release the environment + mov rsi, r13 + call release_object + + print_str_mac error_string ; print 'Error: ' + + print_str_mac env_binds_error_string + + pop rsi ; Throw binds list + jmp error_throw + +.bind_missing_expr: + ; Have a symbol, but no expression. + + push r11 ; Binds list + + ; Release the environment + mov rsi, r13 + call release_object + + print_str_mac error_string ; print 'Error: ' + + print_str_mac env_binds_missing_string + + pop rsi ; Throw binds list + jmp error_throw + + +;; Environment set +;; +;; Sets a key-value pair in an environment +;; +;; Inputs: RSI - env [not modified] +;; RDI - key [not modified] +;; RCX - value [not modified] +;; +;; Increments reference counts of key and value +;; if pointers to them are created +;; +;; Modifies registers: +;; R8 +;; R9 +;; R10 +env_set: + push rsi + ; Get the first CAR, which should be a map + mov rsi, [rsi + Cons.car] + call map_set + pop rsi + ret + +;; Environment get +;; +;; Get a value from an environment, incrementing the reference count +;; of the object returned +;; +;; Inputs: RSI - environment +;; RDI - key +;; +;; Returns: If found, Zero Flag is set and address in RAX +;; If not found, Zero Flag cleared +env_get: + push rsi + + ; Check special variable *env* + mov rsi, env_symbol + call compare_char_array + pop rsi + cmp rax, 0 + jne .not_env_symbol + + ; Env symbol, so return this environment + call incref_object + lahf ; flags in AH + or ah, 64 ; set zero flag + sahf + mov rax, rsi + ret + +.not_env_symbol: + push rsi + ; Get the map in CAR + mov rsi, [rsi + Cons.car] + call map_get + pop rsi + je .found + + ; Not found, so try outer + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .not_found + + mov rsi, [rsi + Cons.cdr] ; outer + jmp env_get +.found: + ret + +.not_found: + lahf ; flags in AH + and ah, 255-64 ; clear zero flag + sahf + ret + + diff --git a/impls/nasm/exceptions.asm b/impls/nasm/exceptions.asm new file mode 100644 index 0000000000..8630761c11 --- /dev/null +++ b/impls/nasm/exceptions.asm @@ -0,0 +1,138 @@ + +;; ---------------------------------------------- +;; +;; Error handling +;; +;; A handler consists of: +;; - A stack pointer address to reset to +;; - An address to jump to +;; - An optional data structure to pass +;; +;; When jumped to, an error handler will be given: +;; - the object thrown in RSI +;; - the optional data structure in RDI +;; + +section .bss + +;; Error handler list +error_handler: resq 1 + +section .text + +;; Add an error handler to the front of the list +;; +;; Input: RSI - Stack pointer +;; RDI - Address to jump to +;; RCX - Data structure. Set to zero for none. +;; If not zero, reference count incremented +;; +;; Modifies registers: +;; RAX +;; RBX +error_handler_push: + call alloc_cons + ; car will point to a list (stack, addr, data) + ; cdr will point to the previous handler + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov rbx, [error_handler] + cmp rbx, 0 ; Check if previous handler was zero + je .create_handler ; Zero, so leave null + ; Not zero, so create pointer to it + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rbx + + ; note: not incrementing reference count, since + ; we're replacing one reference with another +.create_handler: + mov [error_handler], rax ; new error handler + + mov rdx, rax + call alloc_cons + mov [rdx + Cons.car], rax + ; Store stack pointer + mov [rax], BYTE (block_cons + container_list + content_function) + mov [rax + Cons.car], rsi ; stack pointer + + mov rdx, rax + call alloc_cons + mov [rdx + Cons.typecdr], BYTE content_pointer + mov [rdx + Cons.cdr], rax + ; Store function pointer to jump to + ; Note: This can't use content_pointer or release + ; will try to release this memory address + mov [rax], BYTE (block_cons + container_list + content_function) + mov [rax + Cons.car], rdi + + ; Check if there is an object to pass to handler + cmp rcx, 0 + je .done + + ; Set the final CDR to point to the object + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rcx + + mov rsi, rcx + call incref_object + +.done: + ret + + +;; Removes an error handler from the list +;; +;; Modifies registers: +;; RSI +;; RAX +;; RCX +error_handler_pop: + ; get the address + mov rsi, [error_handler] + cmp rsi, 0 + je .done ; Nothing to remove + + push rsi + mov rsi, [rsi + Cons.cdr] ; next handler + mov [error_handler], rsi + ;call incref_object ; needed because releasing soon + + pop rsi ; handler being removed + mov [rsi + Cons.typecdr], BYTE 0 + call release_cons + +.done: + ret + + +;; Throw an error +;; Object to pass to handler should be in RSI +error_throw: + ; Get the next error handler + mov rax, [error_handler] + cmp rax, 0 + je .no_handler + + ; Got a handler + mov rax, [rax + Cons.car] ; handler + mov rbx, [rax + Cons.car] ; stack pointer + mov rax, [rax + Cons.cdr] + mov rcx, [rax + Cons.car] ; function + mov rdi, [rax + Cons.cdr] ; data structure + + ; Reset stack + mov rsp, rbx + + ; Jump to the handler + jmp rcx + +.no_handler: + ; Print the object in RSI then quit + cmp rsi, 0 + je .done ; nothing to print + mov rdi, 1 ; print_readably + call pr_str + mov rsi, rax + call print_string +.done: + jmp quit_error + diff --git a/impls/nasm/macros.mac b/impls/nasm/macros.mac new file mode 100644 index 0000000000..8adac59e30 --- /dev/null +++ b/impls/nasm/macros.mac @@ -0,0 +1,49 @@ +;; Some useful macros + +%ifndef MACROS_MAC +%define MACROS_MAC + +;; Define a static data value +;; +;; static label value +;; +%macro static 2+ + %1: %2 + %1.len: equ $ - %1 +%endmacro + +;; Puts address of data in RSI, length in EDX +%macro load_static 1 + mov rsi, %1 + mov edx, %1.len +%endmacro + +;; Define a symbol which can be compared against +;; +;; static_symbol name, string +;; +;; Example: +;; +;; static_symbol def_symbol, 'def!' +;; +%macro static_symbol 2 + %strlen slen %2 ; length of string + + %1: ISTRUC Array + AT Array.type, db maltype_symbol + AT Array.refcount, dw 1 + AT Array.length, dd slen + AT Array.data, db %2 + IEND +%endmacro + +;; Macro for printing raw string +;; +%macro print_str_mac 1 + mov rsi, %1 ; String address + mov rdx, %1.len ; Length of string + call print_rawstring +%endmacro + +%endif + diff --git a/impls/nasm/printer.asm b/impls/nasm/printer.asm new file mode 100644 index 0000000000..8973f908b3 --- /dev/null +++ b/impls/nasm/printer.asm @@ -0,0 +1,544 @@ +;;; Turns forms (lists, values/atoms) into strings +;;; +;;; + +%include "macros.mac" + +section .data + + ; Constant strings for printing + static unknown_type_string, db "#" + static unknown_value_string, db "#" + static function_type_string, db "#" + static macro_type_string, db "#" + static nil_value_string, db "nil" + static true_value_string, db "true" + static false_value_string, db "false" + +section .text + +;; Input: Address of object in RSI +;; print_readably in RDI. First bit set to zero for false +;; +;; Output: Address of string in RAX +;; +;; Modifies: +;; RCX +;; R8 +;; R12 +;; R13 +;; R14 +;; Calls: raw_to_string, +;; +;; +pr_str: + + ; Get the type + mov cl, BYTE [rsi] + + ; Check if it's already a string + cmp cl, maltype_string + + jne .not_string + + ; --------------------------- + ; Handle string + + test rdi, 1 + jz .string_not_readable + + ; printing readably, so escape characters + + call string_new ; Output string in rax + + mov r12, rax + add r12, Array.data ; Output data + mov r13, rsi + add r13, Array.data ; Input data + mov r14d, DWORD [rsi + Array.length] + add r14, Array.data + add r14, rsi ; End of input data + + ; Put " at start of output string + mov [r12], BYTE '"' + inc r12 + + ; Loop through the input string, escaping characters + +.string_loop: + cmp r13, r14 + je .string_finished + + mov cl, BYTE [r13] ; Get next character + inc r13 + + cmp cl, '"' ; + je .string_escape_char + + cmp cl, 92 ; Escape '\' + je .string_escape_char + + cmp cl, 10 ; Newline + je .string_newline + + ; No special case, just copy the byte + mov [r12], BYTE cl + inc r12 + jmp .string_loop + +.string_newline: + mov cl, 'n' + ;jmp .string_escape_char + +.string_escape_char: ; Add a '\' before char in cl + mov [r12], BYTE 92 ; Escape '\' + inc r12 + mov [r12], BYTE cl + inc r12 + jmp .string_loop + +.string_finished: + + + + mov [r12], BYTE '"' ; At the end + inc r12 + ; Calculate length of string + sub r12, rax + sub r12, Array.data + + mov [rax + Array.length], DWORD r12d + + ret + +.string_not_readable: + ; Just return the string + call incref_object + mov rax, rsi + ret + + ; ---------------------------- +.not_string: + ; Now test the container type (value, list, map, vector) + + mov ch, cl + + and ch, container_mask + jz .value + + cmp ch, container_list + je .list + + cmp ch, container_symbol + je .symbol + + cmp ch, container_map + je .map + + cmp ch, container_vector + je .vector + + cmp ch, container_function + je .function_or_macro + + cmp ch, container_atom + je .atom + + ; Unknown + mov rsi, unknown_type_string + mov edx, unknown_type_string.len + call raw_to_string ; Puts a String in RAX + ret + + ; -------------------------------- +.value: + mov ch, cl + and ch, content_mask + jz .value_nil + + cmp ch, content_int + je .value_int + + cmp ch, content_true + je .value_true + + cmp ch, content_false + je .value_false + + mov rsi, unknown_value_string + mov edx, unknown_value_string.len + call raw_to_string ; Puts a String in RAX + ret + + ; -------------------------------- +.value_nil: + mov rsi, nil_value_string + mov edx, nil_value_string.len + call raw_to_string + ret + +.value_true: + mov rsi, true_value_string + mov edx, true_value_string.len + call raw_to_string + ret + +.value_false: + mov rsi, false_value_string + mov edx, false_value_string.len + call raw_to_string + ret + + ; -------------------------------- +.value_int: + mov rax, [rsi + Cons.car] + call itostring + ret + + ; -------------------------------- +.list: + + mov r12, rsi ; Input list + + call string_new ; String in rax + mov r13, rax ; Output string in r13 + + ; Put '(' onto string + mov rsi, rax + mov cl, '(' + call string_append_char + + ; loop through list +.list_loop: + + ; Extract values and print + + mov rsi, r12 + mov cl, BYTE [rsi] ; Get type + + ; Check if it's a pointer (address) + mov ch, cl + and ch, content_mask + cmp ch, content_pointer + je .list_loop_pointer + + cmp ch, content_empty + je .list_check_end + + ; A value (nil, int etc. or function) + mov ch, cl ; Save type, container + and cl, content_mask ; Remove list type -> value + mov BYTE [rsi], cl + + push rcx + push r13 + push r12 + call pr_str ; String in rax + pop r12 + pop r13 + pop rcx + + mov cl, ch ; Restore list type + mov BYTE [r12], cl + jmp .list_loop_got_str +.list_loop_pointer: + mov rsi, [rsi + Cons.car] ; Address of object + push r13 + push r12 + call pr_str ; String in rax + pop r12 + pop r13 + +.list_loop_got_str: + ; concatenate strings in rax and rsi + mov rsi, r13 ; Output string + mov rdx, rax ; String to be copied + + push rsi ; Save output string + push rax ; save temporary string + call string_append_string + + ; Release the string + pop rsi ; Was in rax, temporary string + call release_array + + pop rsi ; restore output string +.list_check_end: + ; Check if this is the end of the list + mov cl, BYTE [r12 + Cons.typecdr] + cmp cl, content_pointer + jne .list_finished + + ; More left in the list + + ; Add space between values + mov cl, ' ' + mov rsi, r13 + call string_append_char + + ; Get next Cons + mov r12, [r12 + Cons.cdr] + jmp .list_loop + +.list_finished: + ; put ')' at the end of the string + mov cl, ')' + mov rsi, r13 + call string_append_char + + mov rax, rsi + ret + + ; -------------------------------- +.symbol: + ; Make a copy of the string + call string_new ; in rax + mov ebx, DWORD [rsi + Array.length] + mov [rax + Array.length], ebx + mov rcx, rsi + add rcx, Array.data ; Start of input data + mov rdx, rsi + add rdx, Array.size ; End of input data + mov r12, rax + add r12, Array.data ; Start of output data +.symbol_copy_loop: + ; Copy [rax] -> [r12] + mov rbx, [rcx] + mov [r12], rbx + add rcx, 8 ; Next 64 bits of input + cmp rcx, rdx + je .symbol_finished + + add r12, 8 ; Next 64 bits of output + jmp .symbol_copy_loop +.symbol_finished: + ret + + ; -------------------------------- +.map: + + mov r12, rsi ; Input map + + call string_new ; String in rax + mov r13, rax ; Output string in r13 + + ; Put '{' onto string + mov rsi, rax + mov cl, '{' + call string_append_char + + ; loop through map +.map_loop: + + ; Extract values and print + + mov rsi, r12 + mov cl, BYTE [rsi] ; Get type + + ; Check if it's a pointer (address) + mov ch, cl + and ch, content_mask + cmp ch, content_pointer + je .map_loop_pointer + + cmp ch, content_empty + je .map_check_end + + ; A value (nil, int etc. or function) + xchg ch, cl + mov [rsi], BYTE cl ; Remove map type -> value + xchg ch, cl + + push rcx + push r13 + push r12 + call pr_str ; String in rax + pop r12 + pop r13 + pop rcx + + mov cl, BYTE [r12] ; Restore map type + + jmp .map_loop_got_str +.map_loop_pointer: + mov rsi, [rsi + Cons.car] ; Address of object + push r13 + push r12 + call pr_str ; String in rax + pop r12 + pop r13 + +.map_loop_got_str: + ; concatenate strings in rax and rsi + mov rsi, r13 ; Output string + mov rdx, rax ; String to be copied + + push rsi ; Save output string + push rax ; save temporary string + call string_append_string + + ; Release the string + pop rsi ; Was in rax, temporary string + call release_array + + pop rsi ; restore output string +.map_check_end: + ; Check if this is the end of the map + mov cl, BYTE [r12 + Cons.typecdr] + cmp cl, content_nil + je .map_finished + + ; More left in the map + + ; Add space between values + mov cl, ' ' + mov rsi, r13 + call string_append_char + + ; Get next Cons + mov r12, [r12 + Cons.cdr] + jmp .map_loop + +.map_finished: + ; put '}' at the end of the string + mov cl, '}' + mov rsi, r13 + call string_append_char + + mov rax, rsi + ret + + ; -------------------------------- +.vector: + + mov r12, rsi ; Input vector + + call string_new ; String in rax + mov r13, rax ; Output string in r13 + + ; Put '[' onto string + mov rsi, rax + mov cl, '[' + call string_append_char + + ; loop through vector +.vector_loop: + + ; Extract values and print + + mov rsi, r12 + mov cl, BYTE [rsi] ; Get type + + ; Check if it's a pointer (address) + mov ch, cl + and ch, content_mask + cmp ch, content_pointer + je .vector_loop_pointer + + cmp ch, content_empty + je .vector_check_end + + ; A value (nil, int etc. or function) + mov ch, cl ; Save type, container + and cl, content_mask ; Remove vector type -> value + mov BYTE [rsi], cl + + push rcx + push r13 + push r12 + call pr_str ; String in rax + pop r12 + pop r13 + pop rcx + + mov cl, ch ; Restore vector type + mov BYTE [r12], cl + jmp .vector_loop_got_str +.vector_loop_pointer: + mov rsi, [rsi + Cons.car] ; Address of object + push r13 + push r12 + call pr_str ; String in rax + pop r12 + pop r13 + +.vector_loop_got_str: + ; concatenate strings in rax and rsi + mov rsi, r13 ; Output string + mov rdx, rax ; String to be copied + + push rsi ; Save output string + push rax ; save temporary string + call string_append_string + + ; Release the string + pop rsi ; Was in rax, temporary string + call release_array + + pop rsi ; restore output string +.vector_check_end: + ; Check if this is the end of the vector + mov cl, BYTE [r12 + Cons.typecdr] + cmp cl, content_pointer + jne .vector_finished + + ; More left in the vector + + ; Add space between values + mov cl, ' ' + mov rsi, r13 + call string_append_char + + ; Get next Cons + mov r12, [r12 + Cons.cdr] + jmp .vector_loop + +.vector_finished: + ; put ']' at the end of the string + mov cl, ']' + mov rsi, r13 + call string_append_char + + mov rax, rsi + ret + + ; -------------------------------- +.function_or_macro: + cmp cl, maltype_macro + je .macro + + ; a function + mov rsi, function_type_string + mov edx, function_type_string.len + call raw_to_string ; Puts a String in RAX + ret + +.macro: + mov rsi, macro_type_string + mov edx, macro_type_string.len + call raw_to_string ; Puts a String in RAX + ret + + ; -------------------------------- +.atom: + mov rsi, [rsi + Cons.car] ; What the atom points to + + call string_new ; String in rax + + ; Start string with '(atom' + mov rbx, '(atom ' + mov [rax + Array.data], rbx + mov [rax + Array.length], DWORD 6 + + push rax + call pr_str + mov rdx, rax ; string to be copied + pop rsi ; Output string + + call string_append_string + + ; closing bracket + mov cl, ')' + call string_append_char + mov rax, rsi + ret diff --git a/impls/nasm/reader.asm b/impls/nasm/reader.asm new file mode 100644 index 0000000000..d0dfe20966 --- /dev/null +++ b/impls/nasm/reader.asm @@ -0,0 +1,1118 @@ +%include "macros.mac" + +section .data + +;; Reader macro strings + + static quote_symbol_string, db "quote" + static quasiquote_symbol_string, db "quasiquote" + static unquote_symbol_string, db "unquote" + static splice_unquote_symbol_string, db "splice-unquote" + static deref_symbol_string, db "deref" + static with_meta_symbol_string, db "with-meta" + +;; Error message strings + + static error_string_unexpected_end, db "Error: Unexpected end of input (EOF). Could be a missing ) or ]", 10 + static error_string_bracket_not_brace, db "Error: Expecting '}' but got ')'" + +;; Symbols for comparison + + static_symbol nil_symbol, 'nil' + static_symbol true_symbol, 'true' + static_symbol false_symbol, 'false' + +section .text + +;; Read a string into memory as a form (nested lists and atoms) +;; Note: In this implementation the tokenizer is not done separately +;; +;; Input: Address of string (char array) in RSI +;; +;; Output: Address of object in RAX +;; +;; Uses registers: +;; R12 Address of the start of the current list (starts 0) +;; R13 Address of the current list tail +;; R14 Stack pointer at start. Used for unwinding on error +;; R15 Address of first list. Used for unwinding on error +;; +;; In addition, the tokenizer uses +;; +;; RAX (object return) +;; RBX +;; RCX (character return in CL) +;; RDX +;; R8 ** State must be preserved +;; R9 ** +;; R10 ** +;; R12 +;; R13 +;; R14 Original stack pointer on call +;; R15 Top-level list, so all can be released on error +;; +read_str: + ; Initialise tokenizer + call tokenizer_init + + ; Set current list to zero + mov r12, 0 + + ; Set first list to zero + mov r15, 0 + + ; Save stack pointer for unwinding + mov r14, rsp + +.read_loop: + + call tokenizer_next + cmp cl, 0 + jne .got_token + + ; Unexpected end of tokens + mov rdx, error_string_unexpected_end.len + mov rsi, error_string_unexpected_end + jmp .error + +.got_token: + + cmp cl, 'i' ; An integer. Cons object in RAX + je .finished + cmp cl, '"' ; A string. Array object in RAX + je .finished + cmp cl, 's' ; A symbol + je .symbol + + cmp cl, '(' + je .list_start + + cmp cl, ')' + je .return_nil ; Note: if reading a list, cl will be tested in the list reader + + cmp cl, '{' + je .map_start + + cmp cl, '}' ; cl tested in map reader + je .return_nil + + cmp cl, '[' + je .vector_start + + cmp cl, ']' ; cl tested in vector reader + je .return_nil + + cmp cl, 39 ; quote ' + je .handle_quote + cmp cl, '`' + je .handle_quasiquote + cmp cl, '~' + je .handle_unquote + cmp cl, 1 + je .handle_splice_unquote + cmp cl, '@' + je .handle_deref + + cmp cl, '^' + je .handle_with_meta + + ; Unknown + jmp .return_nil + + ; -------------------------------- + +.list_start: + + ; Get the first value + ; Note that we call rather than jmp because the first + ; value needs to be treated differently. There's nothing + ; to append to yet... + call .read_loop + + ; rax now contains the first object + cmp cl, ')' ; Check if it was end of list + jne .list_has_contents + mov cl, 0 ; so ')' doesn't propagate to nested lists + ; Set list to empty + mov [rax], BYTE maltype_empty_list + ret ; Returns 'nil' given "()" +.list_has_contents: + ; If this is a Cons then use it + ; If not, then need to allocate a Cons + mov cl, BYTE [rax] + mov ch, cl + and ch, (block_mask + container_mask) ; Tests block and container type + jz .list_is_value + + ; If here then not a simple value, so need to allocate + ; a Cons object + + ; Start new list + push rax + call alloc_cons ; Address in rax + pop rbx + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rbx + ; Now have Cons in RAX, containing pointer to object as car + +.list_is_value: + ; Cons in RAX + ; Make sure it's marked as a list + mov cl, BYTE [rax] + or cl, container_list + mov [rax], BYTE cl + + mov r12, rax ; Start of current list + mov r13, rax ; Set current list + cmp r15, 0 ; Test if first list + jne .list_read_loop + mov r15, rax ; Save the first, for unwinding + +.list_read_loop: + ; Repeatedly get the next value in the list + ; (which may be other lists) + ; until we get a ')' token + + push r12 + push r13 + call .read_loop ; object in rax + pop r13 + pop r12 + + cmp cl, ')' ; Check if it was end of list + je .list_done ; Have nil object in rax + + ; Test if this is a Cons value + mov cl, BYTE [rax] + mov ch, cl + and ch, (block_mask + container_mask) ; Tests block and container type + jz .list_loop_is_value + + ; If here then not a simple value, so need to allocate + ; a Cons object + + ; Start new list + push rax + call alloc_cons ; Address in rax + pop rbx + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rbx + ; Now have Cons in RAX, containing pointer to object as car + +.list_loop_is_value: + ; Cons in RAX + + ; Make sure it's marked as a list + mov cl, BYTE [rax] + or cl, container_list + mov [rax], BYTE cl + + ; Append to r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax ; Set current list + + jmp .list_read_loop + +.list_done: + ; Release nil object in rax + mov rsi, rax + call release_cons + + ; Terminate the list + mov [r13 + Cons.typecdr], BYTE content_nil + mov QWORD [r13 + Cons.cdr], QWORD 0 + mov rax, r12 ; Start of current list + + ret + + ; -------------------------------- + +.map_start: + + ; Get the first value + ; Note that we call rather than jmp because the first + ; value needs to be treated differently. There's nothing + ; to append to yet... + call .read_loop + + ; rax now contains the first object + cmp cl, '}' ; Check if it was end of map + jne .map_has_contents + mov cl, 0 ; so '}' doesn't propagate to nested maps + ; Set map to empty + mov [rax], BYTE maltype_empty_map + ret ; Returns 'nil' given "()" +.map_has_contents: + ; If this is a Cons then use it + ; If not, then need to allocate a Cons + mov cl, BYTE [rax] + mov ch, cl + and ch, (block_mask + container_mask) ; Tests block and container type + jz .map_is_value + + ; If here then not a simple value, so need to allocate + ; a Cons object + + ; Start new map + push rax + call alloc_cons ; Address in rax + pop rbx + mov [rax], BYTE (block_cons + container_map + content_pointer) + mov [rax + Cons.car], rbx + ; Now have Cons in RAX, containing pointer to object as car + +.map_is_value: + ; Cons in RAX + ; Make sure it's marked as a map + mov cl, BYTE [rax] + or cl, container_map + mov [rax], BYTE cl + + mov r12, rax ; Start of current map + mov r13, rax ; Set current map + cmp r15, 0 ; Test if first map + jne .map_read_loop + mov r15, rax ; Save the first, for unwinding + +.map_read_loop: + ; Repeatedly get the next value in the map + ; (which may be other maps) + ; until we get a '}' token + + push r12 + push r13 + call .read_loop ; object in rax + pop r13 + pop r12 + + cmp cl, '}' ; Check if it was end of map + je .map_done ; Have nil object in rax + + ; Test if this is a Cons value + mov cl, BYTE [rax] + mov ch, cl + and ch, (block_mask + container_mask) ; Tests block and container type + jz .map_loop_is_value + + ; If here then not a simple value, so need to allocate + ; a Cons object + + ; Start new map + push rax + call alloc_cons ; Address in rax + pop rbx + mov [rax], BYTE (block_cons + container_map + content_pointer) + mov [rax + Cons.car], rbx + ; Now have Cons in RAX, containing pointer to object as car + +.map_loop_is_value: + ; Cons in RAX + + ; Make sure it's marked as a map + mov cl, BYTE [rax] + or cl, container_map + mov [rax], BYTE cl + + ; Append to r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax ; Set current map + + jmp .map_read_loop + +.map_done: + ; Release nil object in rax + mov rsi, rax + call release_cons + + ; Terminate the map + mov [r13 + Cons.typecdr], BYTE content_nil + mov QWORD [r13 + Cons.cdr], QWORD 0 + mov rax, r12 ; Start of current map + + ret + + ; -------------------------------- + +.vector_start: + + ; Get the first value + ; Note that we call rather than jmp because the first + ; value needs to be treated differently. There's nothing + ; to append to yet... + call .read_loop + + ; rax now contains the first object + cmp cl, ']' ; Check if it was end of vector + jne .vector_has_contents + mov cl, 0 ; so ']' doesn't propagate to nested vectors + ; Set vector to empty + mov [rax], BYTE maltype_empty_vector + ret ; Returns 'nil' given "()" +.vector_has_contents: + ; If this is a Cons then use it + ; If not, then need to allocate a Cons + mov cl, BYTE [rax] + mov ch, cl + and ch, (block_mask + container_mask) ; Tests block and container type + jz .vector_is_value + + ; If here then not a simple value, so need to allocate + ; a Cons object + + ; Start new vector + push rax + call alloc_cons ; Address in rax + pop rbx + mov [rax], BYTE (block_cons + container_vector + content_pointer) + mov [rax + Cons.car], rbx + ; Now have Cons in RAX, containing pointer to object as car + +.vector_is_value: + ; Cons in RAX + ; Make sure it's marked as a vector + mov cl, BYTE [rax] + or cl, container_vector + mov [rax], BYTE cl + + mov r12, rax ; Start of current vector + mov r13, rax ; Set current vector + cmp r15, 0 ; Test if first vector + jne .vector_read_loop + mov r15, rax ; Save the first, for unwinding + +.vector_read_loop: + ; Repeatedly get the next value in the vector + ; (which may be other vectors) + ; until we get a ']' token + + push r12 + push r13 + call .read_loop ; object in rax + pop r13 + pop r12 + + cmp cl, ']' ; Check if it was end of vector + je .vector_done ; Have nil object in rax + + ; Test if this is a Cons value + mov cl, BYTE [rax] + mov ch, cl + and ch, (block_mask + container_mask) ; Tests block and container type + jz .vector_loop_is_value + + ; If here then not a simple value, so need to allocate + ; a Cons object + + ; Start new vector + push rax + call alloc_cons ; Address in rax + pop rbx + mov [rax], BYTE (block_cons + container_vector + content_pointer) + mov [rax + Cons.car], rbx + ; Now have Cons in RAX, containing pointer to object as car + +.vector_loop_is_value: + ; Cons in RAX + + ; Make sure it's marked as a vector + mov cl, BYTE [rax] + or cl, container_vector + mov [rax], BYTE cl + + ; Append to r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax ; Set current vector + + jmp .vector_read_loop + +.vector_done: + ; Release nil object in rax + mov rsi, rax + call release_cons + + ; Terminate the vector + mov [r13 + Cons.typecdr], BYTE content_nil + mov QWORD [r13 + Cons.cdr], QWORD 0 + mov rax, r12 ; Start of current vector + + ret + + ; -------------------------------- +.handle_quote: + ; Turn 'a into (quote a) + call alloc_cons ; Address in rax + mov r12, rax + + ; Get a symbol "quote" + push r8 + push r9 + mov rsi, quote_symbol_string + mov edx, quote_symbol_string.len + call raw_to_string ; Address in rax + pop r9 + pop r8 + +.wrap_next_object: + mov [rax], BYTE maltype_symbol + mov [r12], BYTE (block_cons + container_list + content_pointer) + mov [r12 + Cons.car], rax + + ; Get the next object + push r12 + call .read_loop ; object in rax + pop r12 + + mov r13, rax ; Put object to be quoted in r13 + + call alloc_cons ; Address in rax + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], r13 + mov [rax + Cons.typecdr], BYTE content_nil + + ; Cons object in rax. Append to object in r12 + mov [r12 + Cons.typecdr], BYTE content_pointer + mov [r12 + Cons.cdr], rax + + mov rax, r12 + ret + + ; -------------------------------- +.handle_quasiquote: + ; Turn `a into (quasiquote a) + call alloc_cons ; Address in rax + mov r12, rax + + ; Get a symbol "quasiquote" + push r8 + push r9 + mov rsi, quasiquote_symbol_string + mov edx, quasiquote_symbol_string.len + call raw_to_string ; Address in rax + pop r9 + pop r8 + jmp .wrap_next_object ; From there the same as handle_quote + + ; -------------------------------- +.handle_unquote: + ; Turn ~a into (unquote a) + call alloc_cons ; Address in rax + mov r12, rax + + ; Get a symbol "unquote" + push r8 + push r9 + mov rsi, unquote_symbol_string + mov edx, unquote_symbol_string.len + call raw_to_string ; Address in rax + pop r9 + pop r8 + jmp .wrap_next_object ; From there the same as handle_quote + + ; -------------------------------- +.handle_splice_unquote: + ; Turn ~@a into (unquote a) + call alloc_cons ; Address in rax + mov r12, rax + + ; Get a symbol "unquote" + push r8 + push r9 + mov rsi, splice_unquote_symbol_string + mov edx, splice_unquote_symbol_string.len + call raw_to_string ; Address in rax + pop r9 + pop r8 + jmp .wrap_next_object ; From there the same as handle_quote + + ; -------------------------------- + +.handle_deref: + ; Turn @a into (deref a) + + call alloc_cons ; Address in rax + mov r12, rax + + ; Get a symbol "deref" + push r8 + push r9 + mov rsi, deref_symbol_string + mov edx, deref_symbol_string.len + call raw_to_string ; Address in rax + pop r9 + pop r8 + jmp .wrap_next_object ; From there the same as handle_quote + + ; -------------------------------- + +.handle_with_meta: + ; Turn ^ a b into (with-meta b a) + + call alloc_cons ; Address in rax + mov r12, rax + + ; Get a symbol "with-meta" + push r8 + push r9 + mov rsi, with_meta_symbol_string + mov edx, with_meta_symbol_string.len + call raw_to_string ; Address in rax + pop r9 + pop r8 + + mov [rax], BYTE maltype_symbol + mov [r12], BYTE (block_cons + container_list + content_pointer) + mov [r12 + Cons.car], rax + + ; Get the next two objects + push r12 + call .read_loop ; object in rax + pop r12 + push rax + push r12 + call .read_loop ; in RAX + pop r12 + + mov r13, rax + + call alloc_cons ; Address in rax + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], r13 + + ; Cons object in rax. Append to object in r12 + mov [r12 + Cons.typecdr], BYTE content_pointer + mov [r12 + Cons.cdr], rax + + mov r13, rax + + call alloc_cons ; Address in rax + mov [rax], BYTE (block_cons + container_list + content_pointer) + + pop rdi ; First object + mov [rax + Cons.car], rdi + + ; Append to object in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + + mov rax, r12 + ret + + ; -------------------------------- +.symbol: + ; symbol is in RAX + ; Some symbols are have their own type + ; - nil, true, false + ; + + mov rsi, rax + mov rdi, nil_symbol + push rsi + call compare_char_array + pop rsi + cmp rax, 0 + je .symbol_nil + + mov rdi, true_symbol + push rsi + call compare_char_array + pop rsi + cmp rax, 0 + je .symbol_true + + mov rdi, false_symbol + push rsi + call compare_char_array + pop rsi + cmp rax, 0 + je .symbol_false + + ; not a special symbol, so return + mov rax, rsi + ret + +.symbol_nil: + ; symbol in rsi not needed + call release_array + + call alloc_cons + mov [rax], BYTE maltype_nil ; a nil type + ret + +.symbol_true: + call release_array + + call alloc_cons + mov [rax], BYTE maltype_true + ret + +.symbol_false: + call release_array + + call alloc_cons + mov [rax], BYTE maltype_false + ret + + ; -------------------------------- +.finished: + ret + +.error: + ; Jump here on error with raw string in RSI + ; and string length in rdx + push r14 + push r15 + call print_rawstring + pop r15 + pop r14 + + ; fall through to unwind +.unwind: + ; Jump to here cleans up + + mov rsp, r14 ; Rewind stack pointer + cmp r15, 0 ; Check if there is a list + je .return_nil + mov rsi, r15 + call release_cons ; releases everything recursively + ; fall through to return_nil +.return_nil: + ; Allocates a new Cons object with nil and returns + ; Cleanup should happen before jumping here + push rcx + call alloc_cons + pop rcx + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + + +;; Initialise the tokenizer +;; +;; Input: Address of string in RSI +;; +;; NOTE: This uses RSI, RAX and RBX, and expects these to be preserved +;; between calls to tokenizer_next_char +;; +;; R9 Address of string +;; R10 Position in data array +;; R11 End of data array +;; +tokenizer_init: + ; Save string to r9 + mov r9, rsi + ; Put start of data array into r10 + mov r10, rsi + add r10, Array.data + ; Put end of data array into r11 + mov r11d, [rsi + Array.length] ; Length of array, zero-extended + add r11, r10 + + ret + +;; Move onto the next chunk of the array +;; This is needed because strings are not stored in one +;; contiguous block of memory, but may use multiple Array +;; objects in a linked list +;; +;; If no chunks are left, then R10 = R11 +tokenizer_next_chunk: + mov r10, [r9 + Array.next] + cmp r10, 0 + je .no_more + ; More chunks left + push rsi ; Because symbol reading uses RSI (tokenizer_next.handle_symbol) + mov rsi, r10 + call tokenizer_init + pop rsi + ret +.no_more: + ; No more chunks left. R10 is zero + mov r11, r10 + ret + +;; Moves the next char into CL +;; If no more, puts 0 into CL +tokenizer_next_char: + ; Check if we have reached the end of this chunk + cmp r10, r11 + jne .chars_remain + + ; Hit the end. See if there is another chunk + call tokenizer_next_chunk + cmp r10, r11 + jne .chars_remain ; Success, got another + + ; No more chunks + mov cl, 0 ; Null char signals end + ret + +.chars_remain: + mov cl, BYTE [r10] + inc r10 ; point to next byte + ret + +;; Get the next token +;; Token code is in CL register. Could be: +;; - 0 : Nil, finished +;; - Characters ()[]()'`~^@ +;; - Pair '~@', represented by code 1 +;; - A string: " in CL, and address in RAX +;; - An integer: 'i' in CL +;; - A symbol: 's' in CL, address in RAX +;; +;; Address of object in RAX +;; +;; May use registers: +;; RBX +;; RCX +;; RDX +;; +tokenizer_next: + +.next_char: + ; Fetch the next char into CL + call tokenizer_next_char + + cmp cl, 0 + je .found ; End, no more tokens + + ; Here expect to have: + ; - The current character in CL + ; - Address of next data in r10 + ; - Address of data end in r11 + + ; Skip whitespace or commas + cmp cl, ' ' ; Space + je .next_char + cmp cl, ',' ; Comma + je .next_char + cmp cl, 9 ; Tab + je .next_char + cmp cl, 10 ; Line Feed + je .next_char + cmp cl, 13 ; Carriage Return + je .next_char + + ; Special characters. These are returned in CL as-is + cmp cl, '(' + je .found + cmp cl, ')' + je .found + cmp cl, '[' + je .found + cmp cl, ']' + je .found + cmp cl, '{' + je .found + cmp cl, '}' + je .found + cmp cl, 39 ; character ' + je .found + cmp cl, 96 ; character ` + je .found + cmp cl, '^' + je .found + cmp cl, '@' + je .found + cmp cl, '~' ; Could be followed by '@' + je .handle_tilde + + cmp cl, ';' ; Start of a comment + je .comment + + cmp cl, 34 ; Opening string quotes + je .handle_string + + ; Could be number or symbol + + cmp cl, '-' ; Minus sign + je .handle_minus + mov ch, 0 + + ; Check for a character 0-9 + cmp cl, '0' + jl .handle_symbol + cmp cl, '9' + jg .handle_symbol + + ; Here an integer + jmp .handle_integer + +.comment: + ; Start of a comment. Keep reading until a new line or end + + ; Fetch the next char into CL + call tokenizer_next_char + + cmp cl, 0 + je .found ; End, no more tokens + + cmp cl, 10 + je .next_char ; Next line, start reading again + + jmp .comment + +.handle_minus: + + ; Push current state of the tokenizer + push r9 + push r10 + push r11 + + ; Get the next character + call tokenizer_next_char + + ; Check if it is a number + cmp cl, '0' + jl .minus_not_number + cmp cl, '9' + jg .minus_not_number + + ; Here is a number + mov ch, '-' ; Put '-' in ch for later + + ; Discard old state by moving stack pointer + add rsp, 24 ; 3 * 8 bytes + + jmp .handle_integer + +.minus_not_number: + + ; Restore state + pop r11 + pop r10 + pop r9 + + mov cl, '-' ; Put back + + jmp .handle_symbol + +.handle_integer: + ; Start integer + ; accumulate in EDX + xor edx, edx + +.integer_loop: + ; Here have a char 0-9 in CL + sub cl, '0' ; Convert to number between 0 and 9 + movzx ebx, cl + add edx, ebx + + ; Push current state of the tokenizer + push r9 + push r10 + push r11 + + ; Peek at next character + call tokenizer_next_char ; Next char in CL + + cmp cl, '0' + jl .integer_finished + cmp cl, '9' + jg .integer_finished + + ; Discard old state by moving stack pointer + add rsp, 24 ; 3 * 8 bytes + + imul edx, 10 + + jmp .integer_loop + +.integer_finished: + ; Next char not an int + + ; Restore state of the tokenizer + pop r11 + pop r10 + pop r9 + + push rdx ; Save the integer + ; Get a Cons object to put the result into + call alloc_cons + + pop rdx ; Restore integer + + ; Check if the number should be negative + cmp ch, '-' + jne .integer_store + neg rdx + +.integer_store: + ; Address of Cons now in RAX + mov [rax], BYTE maltype_integer + + mov [rax + Cons.car], rdx + + mov cl, 'i' ; Mark as an integer + ret + + ; ------------------------------------------- +.handle_symbol: + ; Read characters until reaching whitespace, special character or end + + call string_new + mov rsi, rax ; Output string in rsi + +.symbol_loop: + ; Put the current character into the array + call string_append_char + + ; Push current state of the tokenizer + push r9 + push r10 + push r11 + + call tokenizer_next_char + cmp cl, 0 ; End of characters + je .symbol_finished + + cmp cl, ' ' ; Space + je .symbol_finished + cmp cl, ',' ; Comma + je .symbol_finished + cmp cl, 9 ; Tab + je .symbol_finished + cmp cl, 10 ; Line Feed + je .symbol_finished + cmp cl, 13 ; Carriage Return + je .symbol_finished + + cmp cl, '(' + je .symbol_finished + cmp cl, ')' + je .symbol_finished + cmp cl, '[' + je .symbol_finished + cmp cl, ']' + je .symbol_finished + cmp cl, '{' + je .symbol_finished + cmp cl, '}' + je .symbol_finished + cmp cl, 39 ; character ' + je .symbol_finished + cmp cl, 96 ; character ` + je .symbol_finished + cmp cl, '^' + je .symbol_finished + cmp cl, '@' + je .symbol_finished + cmp cl, '~' + je .symbol_finished + cmp cl, ';' ; Start of a comment + je .symbol_finished + cmp cl, 34 ; Opening string quotes + je .symbol_finished + + ; Keeping current character + ; Discard old state by moving stack pointer + add rsp, 24 ; 3 * 8 bytes + + jmp .symbol_loop ; Append to array + +.symbol_finished: + ; Not keeping current character + ; Restore state of the tokenizer + pop r11 + pop r10 + pop r9 + + mov rax, rsi + mov [rax], BYTE maltype_symbol ; Mark as a symbol + mov cl, 's' ; used by read_str + ret + + ; -------------------------------------------- +.handle_string: + ; Get an array to put the string into + + call string_new ; Array in RAX + + ; Put start of data array into rbx + mov rbx, rax + add rbx, Array.data + ; Put end of data array into rdx + mov edx, DWORD [rax + Array.length] ; Length of array, zero-extended + add rdx, rbx + + ; Now read chars from input string and push into output +.string_loop: + + call tokenizer_next_char + cmp cl, 0 ; End of characters + je .error + + cmp cl, 34 ; Finishing '"' + je .string_done ; Leave '"' in CL + + cmp cl, 92 ; Escape '\' + jne .end_string_escape + + ; Current character is a '\' + call tokenizer_next_char + cmp cl, 0 ; End of characters + je .error + + cmp cl, 'n' ; \n, newline + je .insert_newline + + ; Whatever is in cl is now put into string + ; including '"' + jmp .end_string_escape + +.insert_newline: + mov cl, 10 + jmp .end_string_escape + +.end_string_escape: + + ; Put CL onto result array + ; NOTE: this doesn't handle long strings (multiple memory blocks) + mov [rbx], cl + inc rbx + + jmp .string_loop + +.string_done: + ; Calculate the length from rbx + sub rbx, Array.data + sub rbx, rax + mov [rax+Array.length], DWORD ebx + ret + + ; --------------------------------- + +.handle_tilde: + ; Could have '~' or '~@'. Need to peek at the next char + + ; Push current state of the tokenizer + push r9 + push r10 + push r11 + call tokenizer_next_char ; Next char in CL + cmp cl, '@' + jne .tilde_no_amp ; Just '~', not '~@' + ; Got '~@' + mov cl, 1 ; Signals '~@' + + ; Discard old state by moving stack pointer + add rsp, 24 ; 3 * 8 bytes + ret + +.tilde_no_amp: + mov cl, '~' + ; Restore state of the tokenizer + pop r11 + pop r10 + pop r9 + ; fall through to .found +.found: + ret + +.error: + ret + diff --git a/impls/nasm/run b/impls/nasm/run new file mode 100755 index 0000000000..016cc72d79 --- /dev/null +++ b/impls/nasm/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" + diff --git a/impls/nasm/step0_repl.asm b/impls/nasm/step0_repl.asm new file mode 100644 index 0000000000..850f69ee81 --- /dev/null +++ b/impls/nasm/step0_repl.asm @@ -0,0 +1,82 @@ +;; +;; nasm -felf64 step0_repl.asm && ld step0_repl.o && ./a.out + +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "system.asm" ; System calls +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + +section .text + +;; Takes a string as input and processes it into a form +read: + mov rax, rsi ; Return the input + ret + +;; ---------------------------------------------- +;; Evaluates a form +eval: + mov rax, rsi ; Return the input + ret + +;; Prints the result +print: + mov rax, rsi ; Return the input + ret + +;; Read-Eval-Print in sequence +rep_seq: + ; ------------- + ; Read + call read + + ; ------------- + ; Eval + mov rsi, rax ; Output of read into input of eval + call eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + call print + + ret + + +_start: + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + mov rsi, rax ; Put into input of print_string + call print_string + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + diff --git a/impls/nasm/step1_read_print.asm b/impls/nasm/step1_read_print.asm new file mode 100644 index 0000000000..e02ebee968 --- /dev/null +++ b/impls/nasm/step1_read_print.asm @@ -0,0 +1,106 @@ +;; +;; nasm -felf64 step1_read_print.asm && ld step1_read_print.o && ./a.out + +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + +section .text + +;; Takes a string as input and processes it into a form +read: + jmp read_str ; In reader.asm + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; +eval: + mov rax, rsi ; Return the input + ret + +;; Prints the result +print: + mov rdi, 1 ; print readably + jmp pr_str + +;; Read-Eval-Print in sequence +rep_seq: + ; ------------- + ; Read + call read + push rax ; Save form + + ; ------------- + ; Eval + mov rsi, rax ; Output of read into input of eval + call eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + call print ; String in RAX + + mov r8, rax ; Save output + pop rsi ; Form returned by read + call release_object + mov rax, r8 + + ret + + +_start: + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + diff --git a/impls/nasm/step2_eval.asm b/impls/nasm/step2_eval.asm new file mode 100644 index 0000000000..119871bbaa --- /dev/null +++ b/impls/nasm/step2_eval.asm @@ -0,0 +1,683 @@ +;; +;; nasm -felf64 step2_eval.asm && ld step2_eval.o && ./a.out + +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + + static core_add_symbol, db "+" + static core_sub_symbol, db "-" + static core_mul_symbol, db "*" + static core_div_symbol, db "/" + +section .text + +;; Integer arithmetic operations +;; +;; Adds a list of numbers, address in RSI +;; Returns the sum as a number object with address in RAX +;; Since most of the code is common to all operators, +;; RBX is used to jump to the required instruction +core_add: + mov rbx, core_arithmetic.do_addition + jmp core_arithmetic +core_sub: + mov rbx, core_arithmetic.do_subtraction + jmp core_arithmetic +core_mul: + mov rbx, core_arithmetic.do_multiply + jmp core_arithmetic +core_div: + mov rbx, core_arithmetic.do_division + ; Fall through to core_arithmetic +core_arithmetic: + ; Check that the first object is a number + mov cl, BYTE [rsi] + mov ch, cl + and ch, block_mask + cmp ch, block_cons + jne .missing_args + + mov ch, cl + and ch, content_mask + cmp ch, content_empty + je .missing_args + + cmp ch, content_int + jne .not_int + + ; Put the starting value in rax + mov rax, [rsi + Cons.car] + +.add_loop: + ; Fetch the next value + mov cl, [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .finished ; Nothing let + + mov rsi, [rsi + Cons.cdr] ; Get next cons + + ; Check that it is an integer + mov cl, BYTE [rsi] + and cl, content_mask + cmp cl, content_int + jne .not_int + + ; Jump to the required operation, address in RBX + jmp rbx + +.do_addition: + add rax, [rsi + Cons.car] + jmp .add_loop +.do_subtraction: + sub rax, [rsi + Cons.car] + jmp .add_loop +.do_multiply: + imul rax, [rsi + Cons.car] + jmp .add_loop +.do_division: + cqo ; Sign extend RAX into RDX + mov rcx, [rsi + Cons.car] + idiv rcx + jmp .add_loop + +.finished: + ; Value in rbx + push rax + ; Get a Cons object to put the result into + call alloc_cons + pop rbx + mov [rax], BYTE maltype_integer + mov [rax + Cons.car], rbx + ret + +.missing_args: +.not_int: + jmp quit + +;; Add a native function to the core environment +;; This is used in core_environment +%macro core_env_native 2 + push rsi ; environment + mov rsi, %1 + mov edx, %1.len + call raw_to_symbol ; Symbol in RAX + push rax + + mov rsi, %2 + call native_function ; Function in RAX + + mov rcx, rax ; value (function) + pop rdi ; key (symbol) + pop rsi ; environment + call map_set +%endmacro + + + +;; Takes a string as input and processes it into a form +read: + jmp read_str ; In reader.asm + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; +eval_ast: + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; look in environment + mov rdi, rsi ; symbol is the key + mov rsi, [repl_env] ; Environment + call map_get + je .done ; result in RAX + + ; Not found, should raise an error + + ; Return nil + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + mov rsi, [rsi + Cons.car] ; Get the address + call eval ; Evaluate it, result in rax + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_append + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + ; Fall through to .list_append + +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + mov rsi, [r10 + Cons.car] ; Get the address + call eval ; Evaluate it, result in rax + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + mov rsi, [rsi + Cons.car] ; Get the address + call eval ; Evaluate it, result in rax + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_append_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_append_value: + or bl, container_vector + mov [rax], BYTE bl + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate +;; +;; Returns: Result in RAX +;; +eval: + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + ret + + ; -------------------- +.list: + ; A list + + ; Check if the first element is a symbol + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + push rsi + + ; Compare against def! + mov rsi, rbx + mov rdi, def_symbol + call compare_char_array + pop rsi + cmp rax, 0 + je .def_symbol + + push rsi + mov rdi, let_symbol + call compare_char_array + pop rsi + cmp rax, 0 + je .let_symbol + + ; Unrecognised + jmp .list_eval + +.def_symbol: + ; Define a new symbol in current environment + + jmp .list_not_function +.let_symbol: + ; Create a new environment + + jmp .list_not_function +.list_eval: + + call eval_ast + + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Call the function with the rest of the list in RSI + push rax + mov rsi, [rax + Cons.cdr] ; Rest of list + mov rdi, rbx ; Function object in RDI + call [rbx + Cons.car] ; Call function + ; Result in rax + pop rsi ; eval'ed list + push rax + call release_cons + pop rax + ret + +.list_not_function: + ; Not a function. Probably an error + ret + +.empty_list: + mov rax, rsi + ret + +;; Prints the result +print: + mov rdi, 1 ; print readably + jmp pr_str + +;; Read-Eval-Print in sequence +rep_seq: + ; ------------- + ; Read + call read + push rax ; Save form + + ; ------------- + ; Eval + mov rsi, rax ; Output of read into input of eval + call eval + push rax ; Save result + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + call print ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + pop rsi ; Form returned by read + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call map_new ; Environment in RAX + + mov [repl_env], rax ; store in memory + + mov rsi, rax ; Environment + + ; Add +,-,*,/ to environment + core_env_native core_add_symbol, core_add + core_env_native core_sub_symbol, core_sub + core_env_native core_mul_symbol, core_mul + core_env_native core_div_symbol, core_div + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + diff --git a/impls/nasm/step3_env.asm b/impls/nasm/step3_env.asm new file mode 100644 index 0000000000..70460bafae --- /dev/null +++ b/impls/nasm/step3_env.asm @@ -0,0 +1,1078 @@ +;; +;; nasm -felf64 step3_env.asm && ld step3_env.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + + static core_add_symbol, db "+" + static core_sub_symbol, db "-" + static core_mul_symbol, db "*" + static core_div_symbol, db "/" + +section .text + +;; Integer arithmetic operations +;; +;; Adds a list of numbers, address in RSI +;; Returns the sum as a number object with address in RAX +;; Since most of the code is common to all operators, +;; RBX is used to jump to the required instruction +core_add: + mov rbx, core_arithmetic.do_addition + jmp core_arithmetic +core_sub: + mov rbx, core_arithmetic.do_subtraction + jmp core_arithmetic +core_mul: + mov rbx, core_arithmetic.do_multiply + jmp core_arithmetic +core_div: + mov rbx, core_arithmetic.do_division + ; Fall through to core_arithmetic +core_arithmetic: + ; Check that the first object is a number + mov cl, BYTE [rsi] + mov ch, cl + and ch, block_mask + cmp ch, block_cons + jne .missing_args + + mov ch, cl + and ch, content_mask + cmp ch, content_empty + je .missing_args + + cmp ch, content_int + jne .not_int + + ; Put the starting value in rax + mov rax, [rsi + Cons.car] + +.add_loop: + ; Fetch the next value + mov cl, [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .finished ; Nothing let + + mov rsi, [rsi + Cons.cdr] ; Get next cons + + ; Check that it is an integer + mov cl, BYTE [rsi] + and cl, content_mask + cmp cl, content_int + jne .not_int + + ; Jump to the required operation, address in RBX + jmp rbx + +.do_addition: + add rax, [rsi + Cons.car] + jmp .add_loop +.do_subtraction: + sub rax, [rsi + Cons.car] + jmp .add_loop +.do_multiply: + imul rax, [rsi + Cons.car] + jmp .add_loop +.do_division: + cqo ; Sign extend RAX into RDX + mov rcx, [rsi + Cons.car] + idiv rcx + jmp .add_loop + +.finished: + ; Value in rbx + push rax + ; Get a Cons object to put the result into + call alloc_cons + pop rbx + mov [rax], BYTE maltype_integer + mov [rax + Cons.car], rbx + ret + +.missing_args: +.not_int: + jmp quit + +;; Add a native function to the core environment +;; This is used in core_environment +%macro core_env_native 2 + push rsi ; environment + mov rsi, %1 + mov edx, %1.len + call raw_to_symbol ; Symbol in RAX + push rax + + mov rsi, %2 + call native_function ; Function in RAX + + mov rcx, rax ; value (function) + pop rdi ; key (symbol) + pop rsi ; environment + call env_set +%endmacro + + + +;; Takes a string as input and processes it into a form +read: + jmp read_str ; In reader.asm + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; +eval_ast: + mov r15, rdi ; Save Env in r15 + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + push rsi + print_str_mac error_string ; print 'Error: ' + + pop rsi + push rsi + mov edx, [rsi + Array.length] + add rsi, Array.data + call print_rawstring ; print symbol + + print_str_mac not_found_string ; print ' not found' + pop rsi + + jmp error_throw + + ; ------------------------------ +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate +;; RDI Environment +;; +;; Returns: Result in RAX +;; +eval: + mov r15, rdi ; Env + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + ret + + ; -------------------- +.list: + ; A list + + ; Check if the first element is a symbol + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + ; Unrecognised + jmp .list_eval + +.def_symbol: + ; Define a new symbol in current environment + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + + push r8 ; the symbol + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + call eval + mov rsi, rax + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx ; Return the value + ret + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + mov rsi, [r12 + Cons.car] ; Get the address + mov rdi, r14 + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + mov rdi, r14 ; New environment + push r14 + call eval + pop r14 + +.let_done: + ; Release the environment + mov rsi, r14 + push rax + call release_object + pop rax + ret + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + call eval_ast ; List of evaluated forms in RAX + pop r15 + pop rsi + + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Call the function with the rest of the list in RSI + push rax + push r15 + mov rsi, [rax + Cons.cdr] ; Rest of list + mov rdi, rbx ; Function object in RDI + call [rbx + Cons.car] ; Call function + ; Result in rax + pop r15 + pop rsi ; eval'ed list + push rax + call release_cons + pop rax + ret + +.list_not_function: + ; Not a function. Probably an error + ret + +.empty_list: + mov rax, rsi + ret + +;; Prints the result +print: + mov rdi, 1 ; print readably + jmp pr_str + +;; Read-Eval-Print in sequence +rep_seq: + ; ------------- + ; Read + call read + push rax ; Save form + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + call eval + push rax ; Save result + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + call print ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + pop rsi ; Form returned by read + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call env_new ; Environment in RAX + + mov [repl_env], rax ; store in memory + + mov rsi, rax ; Environment + + ; Add +,-,*,/ to environment + core_env_native core_add_symbol, core_add + core_env_native core_sub_symbol, core_sub + core_env_native core_mul_symbol, core_mul + core_env_native core_div_symbol, core_div + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + diff --git a/impls/nasm/step4_if_fn_do.asm b/impls/nasm/step4_if_fn_do.asm new file mode 100644 index 0000000000..46507d7096 --- /dev/null +++ b/impls/nasm/step4_if_fn_do.asm @@ -0,0 +1,1382 @@ +;; +;; nasm -felf64 step4_if_fn_do.asm && ld step4_if_fn_do.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "core.asm" ; Core functions +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + static eval_list_not_function, db "list does not begin with a function",10 + + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + static_symbol do_symbol, 'do' + static_symbol if_symbol, 'if' + static_symbol fn_symbol, 'fn*' + +;; Startup string. This is evaluated on startup + static mal_startup_string, db "(def! not (fn* (a) (if a false true)))" + + +section .text + + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; +eval_ast: + mov r15, rdi ; Save Env in r15 + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; Check if first character of symbol is ':' + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .keyword + + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + push rsi + print_str_mac error_string ; print 'Error: ' + + pop rsi + push rsi + mov edx, [rsi + Array.length] + add rsi, Array.data + call print_rawstring ; print symbol + + print_str_mac not_found_string ; print ' not found' + pop rsi + + jmp error_throw + + ; ------------------------------ + +.keyword: + ; Just return keywords unaltered + call incref_object + mov rax, rsi + ret + + ; ------------------------------ +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate +;; RDI Environment +;; +;; Returns: Result in RAX +;; +eval: + mov r15, rdi ; Env + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + ret + + ; -------------------- +.list: + ; A list + + ; Check if the first element is a symbol + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + eval_cmp_symbol do_symbol ; do + je .do_symbol + + eval_cmp_symbol if_symbol ; if + je .if_symbol + + eval_cmp_symbol fn_symbol ; fn + je .fn_symbol + + ; Unrecognised + jmp .list_eval + + + ; ----------------------------- + +.def_symbol: + ; Define a new symbol in current environment + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + push r8 ; the symbol + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + call eval + mov rsi, rax + + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx ; Return the value + ret + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + mov rsi, [r12 + Cons.car] ; Get the address + mov rdi, r14 + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + mov rdi, r14 ; New environment + push r14 + call eval + pop r14 + +.let_done: + ; Release the environment + mov rsi, r14 + push rax + call release_object + pop rax + ret + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.do_symbol: + mov r11, rsi ; do form in RSI + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .do_no_body + mov r11, [r11 + Cons.cdr] + +.do_symbol_loop: + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_body_value + + ; A pointer, so evaluate + push r15 + push r11 + mov rsi, [r11 + Cons.car] ; Form + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Check if there is another form + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .do_done ; No more, so finished + + ; Another form. Discard the result of the last eval + mov rsi, rax + call release_object +.do_next: + mov r11, [r11 + Cons.cdr] ; Next in list + + jmp .do_symbol_loop + +.do_done: + ret ; Return result in RAX + +.do_body_value: + + ; Got a value in R11. + ; If this is the last form then return, + ; but if not then can ignore + + mov bl, BYTE [r11 + Cons.typecdr] + and bl, block_mask + content_mask + cmp bl, content_pointer + jne .do_body_value_return + + ; Not the last, so ignore + jmp .do_next + +.do_body_value_return: + ; Got a value as last form. Copy and return + + push rax + call alloc_cons + pop rbx ; type in BL + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + ret + +.do_no_body: + ; No expressions to evaluate. Return nil + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.if_symbol: + mov r11, rsi ; if form in R11 + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .if_no_condition + + mov r11, [r11 + Cons.cdr] ; Should be a condition + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .if_cond_value + + ; A pointer, so evaluate + + push r15 + push r11 + mov rsi, [r11 + Cons.car] ; Form + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Get type of result + mov bl, BYTE [rax] + + ; release value + push rbx + mov rsi, rax + call release_object + pop rbx + + ; Check type + cmp bl, maltype_nil + je .if_false + cmp bl, maltype_false + je .if_false + + jmp .if_true + +.if_cond_value: + + ; A value + cmp al, content_nil + je .if_false + cmp al, content_false + je .if_false + + jmp .if_true + +.if_false: + ; Skip the next item + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil + + mov r11, [r11 + Cons.cdr] + +.if_true: + ; Get the next item in the list and evaluate it + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; Nothing to return + + mov r11, [r11 + Cons.cdr] + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + je .if_got_pointer + +.if_got_value: + ; copy value in r11 + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + ret + +.if_got_pointer: + mov rsi, [r11 + Cons.car] ; Form + mov rdi, r15 ; Env + call eval + ret + +.if_no_condition: ; just (if) without a condition + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.fn_symbol: + mov r11, rsi ; fn form in R11 + ; Environment in R15 + + ; Get the binds and body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_empty + + mov r11, [r11 + Cons.cdr] + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_binds_not_list + + mov r12, [r11 + Cons.car] ; Should be binds list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + cmp al, (block_cons + container_list) + je .fn_got_binds ; Can be list + cmp al, (block_cons + container_vector) + je .fn_got_binds ; or vector + jmp .fn_binds_not_list + +.fn_got_binds: + + ; Next get the body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_no_body + + mov r11, [r11 + Cons.cdr] + ; Check value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_is_value ; Body in r11 + mov r11, [r11 + Cons.car] + jmp .fn_got_body + +.fn_is_value: + ; Body is just a value, no expression + mov [r11], BYTE al ; Mark as value, not list + +.fn_got_body: + + ; Now put into function type + ; Addr is "apply_fn", the address to call + ; Env in R15 + ; Binds in R12 + ; Body in R11 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) + mov rbx, apply_fn + mov [rax + Cons.car], rbx ; Address of apply function + mov [rax + Cons.typecdr], BYTE content_pointer + + mov r13, rax ; Return list in R13 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r15 ; Environment + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r13 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r15 + call incref_object + pop rax + + ; Binds + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r12 ; Binds list + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r12 + call incref_object + pop rax + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r11 ; Body of function + + mov [r14 + Cons.cdr], rax + + mov rsi, r11 + call incref_object + + mov rax, r13 + ret + +.fn_empty: +.fn_binds_not_list: +.fn_no_body: + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + call eval_ast ; List of evaluated forms in RAX + pop r15 + pop rsi + + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Check the rest of the args + mov cl, BYTE [rax + Cons.typecdr] + cmp cl, content_pointer + je .list_got_args + + ; No arguments + push rbx + call alloc_cons + mov [rax], BYTE maltype_empty_list + pop rbx + mov rsi, rax + jmp .list_function_call +.list_got_args: + mov rsi, [rax + Cons.cdr] ; Rest of list +.list_function_call: + ; Call the function with the rest of the list in RSI + push rax + push r15 + mov rdi, rbx ; Function object in RDI + call [rbx + Cons.car] ; Call function + ; Result in rax + pop r15 + pop rsi ; eval'ed list + push rax + call release_cons + pop rax + ret + +.list_not_function: + ; Not a function. Probably an error + push rsi + + mov rsi, rax + call release_object + + print_str_mac error_string + print_str_mac eval_list_not_function + pop rsi + jmp error_throw + +.empty_list: + mov rax, rsi + ret + + +;; Applies a user-defined function +;; +;; Input: RSI - Arguments to bind +;; RDI - Function object +;; +;; +;; Output: Result in RAX +;; +apply_fn: + push rsi + ; Extract values from the list in RDI + mov rax, [rdi + Cons.cdr] + mov rsi, [rax + Cons.car] ; Env + mov rax, [rax + Cons.cdr] + mov rdi, [rax + Cons.car] ; Binds + mov rax, [rax + Cons.cdr] + mov rax, [rax + Cons.car] ; Body + pop rcx ; Exprs + + ; Check the type of the body + mov bl, BYTE [rax] + and bl, block_mask + container_mask + jnz .bind + ; Just a value (in RAX). No eval needed + + push rax + mov rsi, rax + call incref_object + pop rax + ret +.bind: + ; Create a new environment, binding arguments + push rax + call env_new_bind + mov rdi, rax ; New environment in RDI + pop rsi ; Body + + ; Evaluate the function body + push rdi ; Environment + call eval + pop rsi + + ; Release the environment + push rax + call release_object + pop rax + + ret + + +;; Read-Eval-Print in sequence +;; +;; Input string in RSI +rep_seq: + ; ------------- + ; Read + call read_str + push rax ; Save form + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + call eval + push rax ; Save result + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + mov rdi, 1 ; print readably + call pr_str ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + pop rsi ; Form returned by read + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call core_environment ; Environment in RAX + + mov [repl_env], rax ; store in memory + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the startup string + + mov rsi, mal_startup_string + mov edx, mal_startup_string.len + call raw_to_string ; String in RAX + + push rax + mov rsi, rax + call read_str ; AST in RAX + pop rsi ; string + + push rax ; AST + call release_array ; string + pop rsi ; AST + + push rsi + mov rdi, [repl_env] ; Environment + call eval + pop rsi + + push rax + call release_object ; AST + pop rsi + call release_object ; Return from eval + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + diff --git a/impls/nasm/step5_tco.asm b/impls/nasm/step5_tco.asm new file mode 100644 index 0000000000..5162c83b38 --- /dev/null +++ b/impls/nasm/step5_tco.asm @@ -0,0 +1,1587 @@ +;; +;; nasm -felf64 step5_tco.asm && ld step5_tco.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "core.asm" ; Core functions +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + static eval_list_not_function, db "list does not begin with a function",10 + + static if_missing_condition_string, db "missing condition in if expression",10 + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + static_symbol do_symbol, 'do' + static_symbol if_symbol, 'if' + static_symbol fn_symbol, 'fn*' + +;; Startup string. This is evaluated on startup + static mal_startup_string, db "(def! not (fn* (a) (if a false true)))" + + +section .text + + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; +eval_ast: + mov r15, rdi ; Save Env in r15 + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; Check if first character of symbol is ':' + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .keyword + + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + push rsi + print_str_mac error_string ; print 'Error: ' + + pop rsi + push rsi + mov edx, [rsi + Array.length] + add rsi, Array.data + call print_rawstring ; print symbol + + print_str_mac not_found_string ; print ' not found' + pop rsi + + jmp error_throw + + ; ------------------------------ + +.keyword: + ; Just return keywords unaltered + call incref_object + mov rax, rsi + ret + + ; ------------------------------ +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate [ Released ] +;; RDI Environment [ Released ] +;; +;; Returns: Result in RAX +;; +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) +;; +eval: + mov r15, rdi ; Env + + push rsi ; AST pushed, must be popped before return + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + jmp .return ; Releases Env + + ; -------------------- +.list: + ; A list + + ; Check if the first element is a symbol + mov al, BYTE [rsi] + + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + eval_cmp_symbol do_symbol ; do + je .do_symbol + + eval_cmp_symbol if_symbol ; if + je .if_symbol + + eval_cmp_symbol fn_symbol ; fn + je .fn_symbol + + ; Unrecognised + jmp .list_eval + + + ; ----------------------------- + +.def_symbol: + ; Define a new symbol in current environment + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + push r8 ; the symbol + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call incref_object ; AST increment refs + + call eval + mov rsi, rax + + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx + jmp .return + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + mov rsi, r15 + call release_object ; Decrement R15 ref count + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + + mov rsi, r14 + call incref_object + mov rdi, r14 + + mov rsi, [r12 + Cons.car] ; Get the address + + call incref_object ; Increment ref count of AST + + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + call incref_object ; will be released by eval + + mov r11, rsi ; save new AST + pop rsi ; Old AST + call release_object + mov rsi, r11 ; New AST + + mov rdi, r14 ; New environment + + jmp eval ; Tail call + ; Note: eval will release the new environment on return + +.let_done: + ; Release the new environment + push rax + mov rsi, r14 + call release_object + pop rax + + ; Release the AST + pop rsi + push rax + call release_object + pop rax + ret ; already released env + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.do_symbol: + mov r11, rsi ; do form in RSI + ; Environment in R15 + + ; Check if there is a body + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .do_no_body ; error + + mov r11, [r11 + Cons.cdr] ; Body in R11 + +.do_symbol_loop: + + ; Need to test if this is the last form + ; so we can handle tail call + + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .do_body_last ; Last expression + + ; not the last expression + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_next ; A value, so skip + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + ; since eval will release Env + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increment ref count since eval will release + + mov rdi, r15 ; Env + call eval ; Result in RAX + + ; Another form after this. + ; Discard the result of the last eval + mov rsi, rax + call release_object + + pop r11 + pop r15 + +.do_next: + mov r11, [r11 + Cons.cdr] ; Next in list + + jmp .do_symbol_loop + +.do_body_last: + ; The last form is in R11, which will be returned + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_body_value_return + jmp .do_body_expr_return + +.do_body_value_return: + ; Got a value as last form (in R11). + ; Copy and return + + push rax ; Type of value to return + + ; release Env + mov rsi, r15 + call release_object + + ; Allocate a Cons object to hold value + call alloc_cons + pop rbx ; type in BL + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + ; release the AST + pop rsi + mov r15, rax ; not modified by release + call release_object + mov rax, r15 + + ret + +.do_body_expr_return: + ; An expression to evaluate as the last form + ; Tail call optimise, jumping to eval + ; Don't increment Env reference count + + mov rsi, [r11 + Cons.car] ; new AST form + call incref_object ; This will be released by eval + + mov r11, rsi ; Save new AST + pop rsi ; Remove old AST from stack + call release_object + mov rsi, r11 + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.do_no_body: + ; No expressions to evaluate. Return nil + + mov rsi, r15 + call release_object ; Release Env + + ; release the AST + pop rsi + call release_object + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.if_symbol: + mov r11, rsi ; if form in R11 + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .if_no_condition + + mov r11, [r11 + Cons.cdr] ; Should be a condition + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .if_cond_value + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increase Form/AST ref count + + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Get type of result + mov bl, BYTE [rax] + + ; release value + push rbx + mov rsi, rax + call release_object + pop rbx + + ; Check type + cmp bl, maltype_nil + je .if_false + cmp bl, maltype_false + je .if_false + + jmp .if_true + +.if_cond_value: + + ; A value + cmp al, content_nil + je .if_false + cmp al, content_false + je .if_false + + jmp .if_true + +.if_false: + ; Skip the next item + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil + + mov r11, [r11 + Cons.cdr] + +.if_true: + ; Get the next item in the list and evaluate it + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; Nothing to return + + mov r11, [r11 + Cons.cdr] + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + je .if_got_pointer + +.if_got_value: + ; copy value in r11 + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + jmp .return + +.if_got_pointer: + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Will be released by eval + + mov r11, rsi + pop rsi + call release_object ; Release old AST + mov rsi, r11 ; New AST + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.if_no_condition: ; just (if) without a condition + + print_str_mac error_string + print_str_mac if_missing_condition_string + + ; Release environment + mov rsi, r15 + call release_object + xor rsi, rsi ; No object to throw + jmp error_throw + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + +.return: + ; Release environment + mov rsi, r15 + mov r15, rax ; Save RAX (return value) + call release_object + + ; Release the AST + pop rsi ; Pushed at start of eval + call release_object + + mov rax, r15 ; return value + ret + + ; ----------------------------- + +.fn_symbol: + mov r11, rsi ; fn form in R11 + ; Environment in R15 + + ; Get the binds and body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_empty + + mov r11, [r11 + Cons.cdr] + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_binds_not_list + + mov r12, [r11 + Cons.car] ; Should be binds list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + cmp al, (block_cons + container_list) + je .fn_got_binds ; Can be list + cmp al, (block_cons + container_vector) + je .fn_got_binds ; or vector + jmp .fn_binds_not_list + +.fn_got_binds: + + ; Next get the body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_no_body + + mov r11, [r11 + Cons.cdr] + ; Check value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_is_value ; Body in r11 + mov r11, [r11 + Cons.car] + jmp .fn_got_body + +.fn_is_value: + ; Body is just a value, no expression + mov [r11], BYTE al ; Mark as value, not list + +.fn_got_body: + + ; Now put into function type + ; Addr is "apply_fn", the address to call + ; Env in R15 + ; Binds in R12 + ; Body in R11 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) + mov rbx, apply_fn + mov [rax + Cons.car], rbx ; Address of apply function + mov [rax + Cons.typecdr], BYTE content_pointer + + mov r13, rax ; Return list in R13 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r15 ; Environment + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r13 + Cons.cdr], rax ; Append to list + mov r14, rax ; R14 contains last cons in list + + push rax + mov rsi, r15 + call incref_object + pop rax + + ; Binds + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r12 ; Binds list + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r12 + call incref_object + pop rax + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r11 ; Body of function + + mov [r14 + Cons.cdr], rax + + mov rsi, r11 + call incref_object + + mov rax, r13 + jmp .return + +.fn_empty: +.fn_binds_not_list: +.fn_no_body: + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + jmp .return + + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + call eval_ast ; List of evaluated forms in RAX + pop r15 + pop rsi + +.list_exec: + ; This point can be called to run a function + ; used by swap! + ; + ; Inputs: RAX - List with function as first element + ; NOTE: This list is released + ; + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Check the rest of the args + mov cl, BYTE [rax + Cons.typecdr] + cmp cl, content_pointer + je .list_got_args + + ; No arguments + push rbx ; Function object + push rax ; List with function first + + ; Create an empty list for the arguments + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax ; Argument list into RSI + + pop rax ; list, function first + ;; Put new empty list onto end of original list + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rsi + + pop rbx + jmp .list_function_call +.list_got_args: + mov rsi, [rax + Cons.cdr] ; Rest of list +.list_function_call: + ; Call the function with the rest of the list in RSI + + mov rdx, rax ; List to release + mov rdi, rbx ; Function object in RDI + + mov rbx, [rbx + Cons.car] ; Call function + cmp rbx, apply_fn + je apply_fn_jmp ; Jump to user function apply + + ; A built-in function, so call (no recursion) + push rax + push r15 + + call rbx + + ; Result in rax + pop r15 + pop rsi ; eval'ed list + + push rax + call release_cons + pop rax + jmp .return ; Releases Env + +.list_not_function: + ; Not a function. Probably an error + push rsi + + mov rsi, rax + call release_object + + print_str_mac error_string + print_str_mac eval_list_not_function + pop rsi + jmp error_throw + +.empty_list: + mov rax, rsi + jmp .return + +;; Applies a user-defined function +;; +;; Input: RSI - Arguments to bind +;; RDI - Function object +;; RDX - list to release after binding +;; R15 - Env (will be released) +;; R13 - AST released before return +;; +;; +;; Output: Result in RAX +;; +;; This is jumped to from eval, so if it returns +;; then it will return to the caller of eval, not to eval +apply_fn_jmp: + ; This is jumped to from eval with AST on the stack + pop r13 +apply_fn: + push rsi + ; Extract values from the list in RDI + mov rax, [rdi + Cons.cdr] + mov rsi, [rax + Cons.car] ; Env + mov rax, [rax + Cons.cdr] + mov rdi, [rax + Cons.car] ; Binds + mov rax, [rax + Cons.cdr] + mov rax, [rax + Cons.car] ; Body + pop rcx ; Exprs + + ; Check the type of the body + mov bl, BYTE [rax] + and bl, block_mask + container_mask + jnz .bind + ; Just a value (in RAX). No eval needed + + mov r14, rax ; Save return value in R14 + + mov rsi, rax + call incref_object + + ; Release the list passed in RDX + mov rsi, rdx + call release_object + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the AST + mov rsi, r13 + call release_object + + mov rax, r14 + ret +.bind: + ; Create a new environment, binding arguments + push rax ; Body + + mov r14, r13 ; Old AST. R13 used by env_new_bind + + push rdx + call env_new_bind + pop rdx + + mov rdi, rax ; New environment in RDI + + ; Note: Need to increment the reference count + ; of the function body before releasing anything, + ; since if the function was defined in-place (lambda) + ; then the body may be released early + + pop rsi ; Body + call incref_object ; Will be released by eval + mov r8, rsi ; Body in R8 + + ; Release the list passed in RDX + mov rsi, rdx + call release_cons + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the old AST + mov rsi, r14 + call release_object + + mov rsi, r8 ; Body + + jmp eval ; Tail call + ; The new environment (in RDI) will be released by eval + + +;; Read-Eval-Print in sequence +;; +;; Input string in RSI +rep_seq: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call eval ; This releases Env and Form/AST + push rax ; Save result of eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + mov rdi, 1 ; print readably + call pr_str ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call core_environment ; Environment in RAX + + mov [repl_env], rax ; store in memory + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the startup string + + mov rsi, mal_startup_string + mov edx, mal_startup_string.len + call raw_to_string ; String in RAX + + push rax + mov rsi, rax + call read_str ; AST in RAX + pop rsi ; string + + push rax ; AST + call release_array ; string + pop rdi ; AST in RDI + + mov rsi, [repl_env] ; Environment in RSI + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call eval + + mov rsi, rax + call release_object ; Return from eval + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + diff --git a/impls/nasm/step6_file.asm b/impls/nasm/step6_file.asm new file mode 100644 index 0000000000..3b7156165d --- /dev/null +++ b/impls/nasm/step6_file.asm @@ -0,0 +1,1701 @@ +;; +;; nasm -felf64 step6_file.asm && ld step6_file.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "core.asm" ; Core functions +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + static eval_list_not_function, db "list does not begin with a function",10 + + static if_missing_condition_string, db "missing condition in if expression",10 + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + static_symbol do_symbol, 'do' + static_symbol if_symbol, 'if' + static_symbol fn_symbol, 'fn*' + + static_symbol argv_symbol, '*ARGV*' + +;; Startup string. This is evaluated on startup + static mal_startup_string, db "(do \ +(def! not (fn* (a) (if a false true))) \ +(def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ +)" + +;; Command to run, appending the name of the script to run + static run_script_string, db "(load-file ",34 +section .text + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; +eval_ast: + mov r15, rdi ; Save Env in r15 + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; Check if first character of symbol is ':' + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .keyword + + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + push rsi + print_str_mac error_string ; print 'Error: ' + + pop rsi + push rsi + mov edx, [rsi + Array.length] + add rsi, Array.data + call print_rawstring ; print symbol + + print_str_mac not_found_string ; print ' not found' + pop rsi + + jmp error_throw + + ; ------------------------------ + +.keyword: + ; Just return keywords unaltered + call incref_object + mov rax, rsi + ret + + ; ------------------------------ +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate [ Released ] +;; RDI Environment [ Released ] +;; +;; Returns: Result in RAX +;; +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) +;; +eval: + mov r15, rdi ; Env + + push rsi ; AST pushed, must be popped before return + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + jmp .return ; Releases Env + + ; -------------------- +.list: + ; A list + + ; Check if the first element is a symbol + mov al, BYTE [rsi] + + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + eval_cmp_symbol do_symbol ; do + je .do_symbol + + eval_cmp_symbol if_symbol ; if + je .if_symbol + + eval_cmp_symbol fn_symbol ; fn + je .fn_symbol + + ; Unrecognised + jmp .list_eval + + + ; ----------------------------- + +.def_symbol: + ; Define a new symbol in current environment + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + push r8 ; the symbol + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call incref_object ; AST increment refs + + call eval + mov rsi, rax + + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx + jmp .return + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + mov rsi, r15 + call release_object ; Decrement R15 ref count + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + + mov rsi, r14 + call incref_object + mov rdi, r14 + + mov rsi, [r12 + Cons.car] ; Get the address + + call incref_object ; Increment ref count of AST + + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + call incref_object ; will be released by eval + + mov r11, rsi ; save new AST + pop rsi ; Old AST + call release_object + mov rsi, r11 ; New AST + + mov rdi, r14 ; New environment + + jmp eval ; Tail call + ; Note: eval will release the new environment on return + +.let_done: + ; Release the new environment + push rax + mov rsi, r14 + call release_object + pop rax + + ; Release the AST + pop rsi + push rax + call release_object + pop rax + ret ; already released env + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.do_symbol: + mov r11, rsi ; do form in RSI + ; Environment in R15 + + ; Check if there is a body + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .do_no_body ; error + + mov r11, [r11 + Cons.cdr] ; Body in R11 + +.do_symbol_loop: + + ; Need to test if this is the last form + ; so we can handle tail call + + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .do_body_last ; Last expression + + ; not the last expression + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_next ; A value, so skip + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + ; since eval will release Env + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increment ref count since eval will release + + mov rdi, r15 ; Env + call eval ; Result in RAX + + ; Another form after this. + ; Discard the result of the last eval + mov rsi, rax + call release_object + + pop r11 + pop r15 + +.do_next: + mov r11, [r11 + Cons.cdr] ; Next in list + + jmp .do_symbol_loop + +.do_body_last: + ; The last form is in R11, which will be returned + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_body_value_return + jmp .do_body_expr_return + +.do_body_value_return: + ; Got a value as last form (in R11). + ; Copy and return + + push rax ; Type of value to return + + ; release Env + mov rsi, r15 + call release_object + + ; Allocate a Cons object to hold value + call alloc_cons + pop rbx ; type in BL + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + ; release the AST + pop rsi + mov r15, rax ; not modified by release + call release_object + mov rax, r15 + + ret + +.do_body_expr_return: + ; An expression to evaluate as the last form + ; Tail call optimise, jumping to eval + ; Don't increment Env reference count + + mov rsi, [r11 + Cons.car] ; new AST form + call incref_object ; This will be released by eval + + mov r11, rsi ; Save new AST + pop rsi ; Remove old AST from stack + call release_object + mov rsi, r11 + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.do_no_body: + ; No expressions to evaluate. Return nil + + mov rsi, r15 + call release_object ; Release Env + + ; release the AST + pop rsi + call release_object + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.if_symbol: + mov r11, rsi ; if form in R11 + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .if_no_condition + + mov r11, [r11 + Cons.cdr] ; Should be a condition + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .if_cond_value + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increase Form/AST ref count + + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Get type of result + mov bl, BYTE [rax] + + ; release value + push rbx + mov rsi, rax + call release_object + pop rbx + + ; Check type + cmp bl, maltype_nil + je .if_false + cmp bl, maltype_false + je .if_false + + jmp .if_true + +.if_cond_value: + + ; A value + cmp al, content_nil + je .if_false + cmp al, content_false + je .if_false + + jmp .if_true + +.if_false: + ; Skip the next item + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil + + mov r11, [r11 + Cons.cdr] + +.if_true: + ; Get the next item in the list and evaluate it + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; Nothing to return + + mov r11, [r11 + Cons.cdr] + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + je .if_got_pointer + +.if_got_value: + ; copy value in r11 + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + jmp .return + +.if_got_pointer: + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Will be released by eval + + mov r11, rsi + pop rsi + call release_object ; Release old AST + mov rsi, r11 ; New AST + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.if_no_condition: ; just (if) without a condition + + print_str_mac error_string + print_str_mac if_missing_condition_string + + ; Release environment + mov rsi, r15 + call release_object + xor rsi, rsi ; No object to throw + jmp error_throw + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + +.return: + ; Release environment + mov rsi, r15 + mov r15, rax ; Save RAX (return value) + call release_object + + ; Release the AST + pop rsi ; Pushed at start of eval + call release_object + + mov rax, r15 ; return value + ret + + ; ----------------------------- + +.fn_symbol: + mov r11, rsi ; fn form in R11 + ; Environment in R15 + + ; Get the binds and body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_empty + + mov r11, [r11 + Cons.cdr] + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_binds_not_list + + mov r12, [r11 + Cons.car] ; Should be binds list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + cmp al, (block_cons + container_list) + je .fn_got_binds ; Can be list + cmp al, (block_cons + container_vector) + je .fn_got_binds ; or vector + jmp .fn_binds_not_list + +.fn_got_binds: + + ; Next get the body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_no_body + + mov r11, [r11 + Cons.cdr] + ; Check value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_is_value ; Body in r11 + mov r11, [r11 + Cons.car] + jmp .fn_got_body + +.fn_is_value: + ; Body is just a value, no expression + mov [r11], BYTE al ; Mark as value, not list + +.fn_got_body: + + ; Now put into function type + ; Addr is "apply_fn", the address to call + ; Env in R15 + ; Binds in R12 + ; Body in R11 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) + mov rbx, apply_fn + mov [rax + Cons.car], rbx ; Address of apply function + mov [rax + Cons.typecdr], BYTE content_pointer + + mov r13, rax ; Return list in R13 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r15 ; Environment + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r13 + Cons.cdr], rax ; Append to list + mov r14, rax ; R14 contains last cons in list + + push rax + mov rsi, r15 + call incref_object + pop rax + + ; Binds + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r12 ; Binds list + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r12 + call incref_object + pop rax + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r11 ; Body of function + + mov [r14 + Cons.cdr], rax + + mov rsi, r11 + call incref_object + + mov rax, r13 + jmp .return + +.fn_empty: +.fn_binds_not_list: +.fn_no_body: + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + jmp .return + + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + call eval_ast ; List of evaluated forms in RAX + pop r15 + pop rsi + +.list_exec: + ; This point can be called to run a function + ; used by swap! + ; + ; Inputs: RAX - List with function as first element + ; NOTE: This list is released + ; + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Check the rest of the args + mov cl, BYTE [rax + Cons.typecdr] + cmp cl, content_pointer + je .list_got_args + + ; No arguments + push rbx ; Function object + push rax ; List with function first + + ; Create an empty list for the arguments + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax ; Argument list into RSI + + pop rax ; list, function first + ;; Put new empty list onto end of original list + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rsi + + pop rbx + jmp .list_function_call +.list_got_args: + mov rsi, [rax + Cons.cdr] ; Rest of list +.list_function_call: + ; Call the function with the rest of the list in RSI + + mov rdx, rax ; List to release + mov rdi, rbx ; Function object in RDI + + mov rbx, [rbx + Cons.car] ; Call function + cmp rbx, apply_fn + je apply_fn_jmp ; Jump to user function apply + + ; A built-in function, so call (no recursion) + push rax + push r15 + + call rbx + + ; Result in rax + pop r15 + pop rsi ; eval'ed list + + push rax + call release_cons + pop rax + jmp .return ; Releases Env + +.list_not_function: + ; Not a function. Probably an error + push rsi + + mov rsi, rax + call release_object + + print_str_mac error_string + print_str_mac eval_list_not_function + pop rsi + jmp error_throw + +.empty_list: + mov rax, rsi + jmp .return + +;; Applies a user-defined function +;; +;; Input: RSI - Arguments to bind +;; RDI - Function object +;; RDX - list to release after binding +;; R15 - Env (will be released) +;; R13 - AST released before return +;; +;; +;; Output: Result in RAX +;; +;; This is jumped to from eval, so if it returns +;; then it will return to the caller of eval, not to eval +apply_fn_jmp: + ; This is jumped to from eval with AST on the stack + pop r13 +apply_fn: + push rsi + ; Extract values from the list in RDI + mov rax, [rdi + Cons.cdr] + mov rsi, [rax + Cons.car] ; Env + mov rax, [rax + Cons.cdr] + mov rdi, [rax + Cons.car] ; Binds + mov rax, [rax + Cons.cdr] + mov rax, [rax + Cons.car] ; Body + pop rcx ; Exprs + + ; Check the type of the body + mov bl, BYTE [rax] + and bl, block_mask + container_mask + jnz .bind + ; Just a value (in RAX). No eval needed + + mov r14, rax ; Save return value in R14 + + mov rsi, rax + call incref_object + + ; Release the list passed in RDX + mov rsi, rdx + call release_object + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the AST + mov rsi, r13 + call release_object + + mov rax, r14 + ret +.bind: + ; Create a new environment, binding arguments + push rax ; Body + + mov r14, r13 ; Old AST. R13 used by env_new_bind + + push rdx + call env_new_bind + pop rdx + + mov rdi, rax ; New environment in RDI + + ; Note: Need to increment the reference count + ; of the function body before releasing anything, + ; since if the function was defined in-place (lambda) + ; then the body may be released early + + pop rsi ; Body + call incref_object ; Will be released by eval + mov r8, rsi ; Body in R8 + + ; Release the list passed in RDX + mov rsi, rdx + call release_cons + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the old AST + mov rsi, r14 + call release_object + + mov rsi, r8 ; Body + + jmp eval ; Tail call + ; The new environment (in RDI) will be released by eval + +;; Read and eval +read_eval: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + jmp eval ; This releases Env and Form/AST + + +;; Read-Eval-Print in sequence +;; +;; Input string in RSI +rep_seq: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call eval ; This releases Env and Form/AST + push rax ; Save result of eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + mov rdi, 1 ; print readably + call pr_str ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call core_environment ; Environment in RAX + + mov [repl_env], rax ; store in memory + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the startup string + + mov rsi, mal_startup_string + mov edx, mal_startup_string.len + call raw_to_string ; String in RAX + + push rax + mov rsi, rax + call read_str ; AST in RAX + pop rsi ; string + + push rax ; AST + call release_array ; string + pop rdi ; AST in RDI + + mov rsi, [repl_env] ; Environment in RSI + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call eval + + mov rsi, rax + call release_object ; Return from eval + + ; ----------------------------- + ; Check command-line arguments + + pop rax ; Number of arguments + cmp rax, 1 ; Always have at least one, the path to executable + jg run_script + + ; No extra arguments, so just set *ARGV* to an empty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov rcx, rax ; value (empty list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + + + +run_script: + ; Called with number of command-line arguments in RAX + mov r8, rax + pop rbx ; executable + dec r8 + + pop rsi ; Address of first arg + call cstring_to_string ; string in RAX + mov r9, rax + + ; get the rest of the args + xor r10, r10 ; Zero + dec r8 + jz .no_args + + ; Got some arguments +.arg_loop: + ; Got an argument left. + pop rsi ; Address of C string + call cstring_to_string ; String in RAX + mov r12, rax + + ;Make a Cons to point to the string + call alloc_cons ; in RAX + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], r12 + + test r10, r10 + jnz .append + + ; R10 zero, so first arg + mov r10, rax ; Head of list + mov r11, rax ; Tail of list + jmp .next +.append: + ; R10 not zero, so append to list tail + mov [r11 + Cons.cdr], rax + mov [r11 + Cons.typecdr], BYTE content_pointer + mov r11, rax +.next: + dec r8 + jnz .arg_loop + jmp .got_args + +.no_args: + ; No arguments. Create an emoty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov r10, rax + +.got_args: + push r9 ; File name string + + mov rcx, r10 ; value (list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + mov rsi, run_script_string ; load-file function + mov edx, run_script_string.len + call raw_to_string ; String in RAX + + mov rsi, rax + pop rdx ; File name string + call string_append_string + + mov cl, 34 ; " + call string_append_char + mov cl, ')' + call string_append_char ; closing brace + + ; Read-Eval "(load-file )" + call read_eval + + jmp quit diff --git a/impls/nasm/step7_quote.asm b/impls/nasm/step7_quote.asm new file mode 100644 index 0000000000..d65b4a5e55 --- /dev/null +++ b/impls/nasm/step7_quote.asm @@ -0,0 +1,2076 @@ +;; +;; nasm -felf64 step7_quote.asm && ld step7_quote.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "core.asm" ; Core functions +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + static eval_list_not_function, db "list does not begin with a function",10 + + static if_missing_condition_string, db "missing condition in if expression",10 + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + static_symbol do_symbol, 'do' + static_symbol if_symbol, 'if' + static_symbol fn_symbol, 'fn*' + + static_symbol argv_symbol, '*ARGV*' + + static_symbol quote_symbol, 'quote' + static_symbol quasiquote_symbol, 'quasiquote' + static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' + static_symbol unquote_symbol, 'unquote' + static_symbol splice_unquote_symbol, 'splice-unquote' + static_symbol concat_symbol, 'concat' + static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' + +;; Startup string. This is evaluated on startup + static mal_startup_string, db "(do \ +(def! not (fn* (a) (if a false true))) \ +(def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ +)" + +;; Command to run, appending the name of the script to run + static run_script_string, db "(load-file ",34 +section .text + + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; +eval_ast: + mov r15, rdi ; Save Env in r15 + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; Check if first character of symbol is ':' + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .keyword + + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + push rsi + print_str_mac error_string ; print 'Error: ' + + pop rsi + push rsi + mov edx, [rsi + Array.length] + add rsi, Array.data + call print_rawstring ; print symbol + + print_str_mac not_found_string ; print ' not found' + pop rsi + + jmp error_throw + + ; ------------------------------ + +.keyword: + ; Just return keywords unaltered + call incref_object + mov rax, rsi + ret + + ; ------------------------------ +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate [ Released ] +;; RDI Environment [ Released ] +;; +;; Returns: Result in RAX +;; +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) +;; +eval: + mov r15, rdi ; Env + + push rsi ; AST pushed, must be popped before return + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + jmp .return ; Releases Env + + ; -------------------- +.list: + ; A list + + ; Check if the first element is a symbol + mov al, BYTE [rsi] + + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + eval_cmp_symbol do_symbol ; do + je .do_symbol + + eval_cmp_symbol if_symbol ; if + je .if_symbol + + eval_cmp_symbol fn_symbol ; fn + je .fn_symbol + + eval_cmp_symbol quote_symbol ; quote + je .quote_symbol + + eval_cmp_symbol quasiquoteexpand_symbol + je .quasiquoteexpand_symbol + + eval_cmp_symbol quasiquote_symbol ; quasiquote + je .quasiquote_symbol + + ; Unrecognised + jmp .list_eval + + + ; ----------------------------- + +.def_symbol: + ; Define a new symbol in current environment + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + push r8 ; the symbol + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call incref_object ; AST increment refs + + call eval + mov rsi, rax + + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx + jmp .return + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + mov rsi, r15 + call release_object ; Decrement R15 ref count + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + + mov rsi, r14 + call incref_object + mov rdi, r14 + + mov rsi, [r12 + Cons.car] ; Get the address + + call incref_object ; Increment ref count of AST + + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + call incref_object ; will be released by eval + + mov r11, rsi ; save new AST + pop rsi ; Old AST + call release_object + mov rsi, r11 ; New AST + + mov rdi, r14 ; New environment + + jmp eval ; Tail call + ; Note: eval will release the new environment on return + +.let_done: + ; Release the new environment + push rax + mov rsi, r14 + call release_object + pop rax + + ; Release the AST + pop rsi + push rax + call release_object + pop rax + ret ; already released env + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.do_symbol: + mov r11, rsi ; do form in RSI + ; Environment in R15 + + ; Check if there is a body + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .do_no_body ; error + + mov r11, [r11 + Cons.cdr] ; Body in R11 + +.do_symbol_loop: + + ; Need to test if this is the last form + ; so we can handle tail call + + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .do_body_last ; Last expression + + ; not the last expression + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_next ; A value, so skip + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + ; since eval will release Env + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increment ref count since eval will release + + mov rdi, r15 ; Env + call eval ; Result in RAX + + ; Another form after this. + ; Discard the result of the last eval + mov rsi, rax + call release_object + + pop r11 + pop r15 + +.do_next: + mov r11, [r11 + Cons.cdr] ; Next in list + + jmp .do_symbol_loop + +.do_body_last: + ; The last form is in R11, which will be returned + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_body_value_return + jmp .do_body_expr_return + +.do_body_value_return: + ; Got a value as last form (in R11). + ; Copy and return + + push rax ; Type of value to return + + ; release Env + mov rsi, r15 + call release_object + + ; Allocate a Cons object to hold value + call alloc_cons + pop rbx ; type in BL + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + ; release the AST + pop rsi + mov r15, rax ; not modified by release + call release_object + mov rax, r15 + + ret + +.do_body_expr_return: + ; An expression to evaluate as the last form + ; Tail call optimise, jumping to eval + ; Don't increment Env reference count + + mov rsi, [r11 + Cons.car] ; new AST form + call incref_object ; This will be released by eval + + mov r11, rsi ; Save new AST + pop rsi ; Remove old AST from stack + call release_object + mov rsi, r11 + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.do_no_body: + ; No expressions to evaluate. Return nil + + mov rsi, r15 + call release_object ; Release Env + + ; release the AST + pop rsi + call release_object + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.if_symbol: + mov r11, rsi ; if form in R11 + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .if_no_condition + + mov r11, [r11 + Cons.cdr] ; Should be a condition + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .if_cond_value + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increase Form/AST ref count + + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Get type of result + mov bl, BYTE [rax] + + ; release value + push rbx + mov rsi, rax + call release_object + pop rbx + + ; Check type + cmp bl, maltype_nil + je .if_false + cmp bl, maltype_false + je .if_false + + jmp .if_true + +.if_cond_value: + + ; A value + cmp al, content_nil + je .if_false + cmp al, content_false + je .if_false + + jmp .if_true + +.if_false: + ; Skip the next item + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil + + mov r11, [r11 + Cons.cdr] + +.if_true: + ; Get the next item in the list and evaluate it + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; Nothing to return + + mov r11, [r11 + Cons.cdr] + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + je .if_got_pointer + +.if_got_value: + ; copy value in r11 + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + jmp .return + +.if_got_pointer: + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Will be released by eval + + mov r11, rsi + pop rsi + call release_object ; Release old AST + mov rsi, r11 ; New AST + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.if_no_condition: ; just (if) without a condition + + print_str_mac error_string + print_str_mac if_missing_condition_string + + ; Release environment + mov rsi, r15 + call release_object + xor rsi, rsi ; No object to throw + jmp error_throw + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + +.return: + ; Release environment + mov rsi, r15 + mov r15, rax ; Save RAX (return value) + call release_object + + ; Release the AST + pop rsi ; Pushed at start of eval + call release_object + + mov rax, r15 ; return value + ret + + ; ----------------------------- + +.fn_symbol: + mov r11, rsi ; fn form in R11 + ; Environment in R15 + + ; Get the binds and body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_empty + + mov r11, [r11 + Cons.cdr] + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_binds_not_list + + mov r12, [r11 + Cons.car] ; Should be binds list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + cmp al, (block_cons + container_list) + je .fn_got_binds ; Can be list + cmp al, (block_cons + container_vector) + je .fn_got_binds ; or vector + jmp .fn_binds_not_list + +.fn_got_binds: + + ; Next get the body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_no_body + + mov r11, [r11 + Cons.cdr] + ; Check value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_is_value ; Body in r11 + mov r11, [r11 + Cons.car] + jmp .fn_got_body + +.fn_is_value: + ; Body is just a value, no expression + mov [r11], BYTE al ; Mark as value, not list + +.fn_got_body: + + ; Now put into function type + ; Addr is "apply_fn", the address to call + ; Env in R15 + ; Binds in R12 + ; Body in R11 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) + mov rbx, apply_fn + mov [rax + Cons.car], rbx ; Address of apply function + mov [rax + Cons.typecdr], BYTE content_pointer + + mov r13, rax ; Return list in R13 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r15 ; Environment + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r13 + Cons.cdr], rax ; Append to list + mov r14, rax ; R14 contains last cons in list + + push rax + mov rsi, r15 + call incref_object + pop rax + + ; Binds + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r12 ; Binds list + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r12 + call incref_object + pop rax + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r11 ; Body of function + + mov [r14 + Cons.cdr], rax + + mov rsi, r11 + call incref_object + + mov rax, r13 + jmp .return + +.fn_empty: +.fn_binds_not_list: +.fn_no_body: + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + jmp .return + + ; ----------------------------- + +.quote_symbol: + ; Just return the arguments in rsi cdr + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quote empty, so return nil + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + call incref_object + mov rax, rsi + jmp .return + + ; ----------------------------- + +;;; Like quasiquote, but do not evaluate the result. +.quasiquoteexpand_symbol: + ;; Return nil if no cdr + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.cdr] + call car_and_incref + call quasiquote + jmp .return + + ; ----------------------------- + +.quasiquote_symbol: + ; call quasiquote function with first argument + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quasiquote empty, so return nil + + mov r11, rsi ; Save original AST in R11 + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quasiquote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quasiquote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + + push r15 ; Environment + ; Original AST already on stack + + call quasiquote + ; New AST in RAX + pop rdi ; Environment + pop rsi ; Old AST + + mov r11, rax ; New AST + call release_object ; Release old AST + mov rsi, r11 ; New AST in RSI + + jmp eval ; Tail call + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + call eval_ast ; List of evaluated forms in RAX + pop r15 + pop rsi + +.list_exec: + ; This point can be called to run a function + ; used by swap! + ; + ; Inputs: RAX - List with function as first element + ; NOTE: This list is released + ; + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Check the rest of the args + mov cl, BYTE [rax + Cons.typecdr] + cmp cl, content_pointer + je .list_got_args + + ; No arguments + push rbx ; Function object + push rax ; List with function first + + ; Create an empty list for the arguments + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax ; Argument list into RSI + + pop rax ; list, function first + ;; Put new empty list onto end of original list + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rsi + + pop rbx + jmp .list_function_call +.list_got_args: + mov rsi, [rax + Cons.cdr] ; Rest of list +.list_function_call: + ; Call the function with the rest of the list in RSI + + mov rdx, rax ; List to release + mov rdi, rbx ; Function object in RDI + + mov rbx, [rbx + Cons.car] ; Call function + cmp rbx, apply_fn + je apply_fn_jmp ; Jump to user function apply + + ; A built-in function, so call (no recursion) + push rax + push r15 + + call rbx + + ; Result in rax + pop r15 + pop rsi ; eval'ed list + + push rax + call release_cons + pop rax + jmp .return ; Releases Env + +.list_not_function: + ; Not a function. Probably an error + push rsi + + mov rsi, rax + call release_object + + print_str_mac error_string + print_str_mac eval_list_not_function + pop rsi + jmp error_throw + +.empty_list: + mov rax, rsi + jmp .return + +;; Applies a user-defined function +;; +;; Input: RSI - Arguments to bind +;; RDI - Function object +;; RDX - list to release after binding +;; R15 - Env (will be released) +;; R13 - AST released before return +;; +;; +;; Output: Result in RAX +;; +;; This is jumped to from eval, so if it returns +;; then it will return to the caller of eval, not to eval +apply_fn_jmp: + ; This is jumped to from eval with AST on the stack + pop r13 +apply_fn: + push rsi + ; Extract values from the list in RDI + mov rax, [rdi + Cons.cdr] + mov rsi, [rax + Cons.car] ; Env + mov rax, [rax + Cons.cdr] + mov rdi, [rax + Cons.car] ; Binds + mov rax, [rax + Cons.cdr] + mov rax, [rax + Cons.car] ; Body + pop rcx ; Exprs + + ; Check the type of the body + mov bl, BYTE [rax] + and bl, block_mask + container_mask + jnz .bind + ; Just a value (in RAX). No eval needed + + mov r14, rax ; Save return value in R14 + + mov rsi, rax + call incref_object + + ; Release the list passed in RDX + mov rsi, rdx + call release_object + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the AST + mov rsi, r13 + call release_object + + mov rax, r14 + ret +.bind: + ; Create a new environment, binding arguments + push rax ; Body + + mov r14, r13 ; Old AST. R13 used by env_new_bind + + push rdx + call env_new_bind + pop rdx + + mov rdi, rax ; New environment in RDI + + ; Note: Need to increment the reference count + ; of the function body before releasing anything, + ; since if the function was defined in-place (lambda) + ; then the body may be released early + + pop rsi ; Body + call incref_object ; Will be released by eval + mov r8, rsi ; Body in R8 + + ; Release the list passed in RDX + mov rsi, rdx + call release_cons + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the old AST + mov rsi, r14 + call release_object + + mov rsi, r8 ; Body + + jmp eval ; Tail call + ; The new environment (in RDI) will be released by eval + + +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX +quasiquote: + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged + call incref_object + mov rax, rsi + ret + +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr + + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr + + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + + ;; If so, return the argument. + mov rsi, [rsi + Cons.cdr] + call car_and_incref + mov rax, rsi + ret + +.map: +.symbol: + call incref_object + + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. + mov al, BYTE [rsi + Cons.typecdr] + +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then + mov rsi, [rsi + Cons.cdr] + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + mov rdx, rax + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, concat_symbol + call incref_object + + ;; rax := ('concat elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;; Read and eval +read_eval: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + jmp eval ; This releases Env and Form/AST + + +;; Read-Eval-Print in sequence +;; +;; Input string in RSI +rep_seq: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call eval ; This releases Env and Form/AST + push rax ; Save result of eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + mov rdi, 1 ; print readably + call pr_str ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call core_environment ; Environment in RAX + + mov [repl_env], rax ; store in memory + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the startup string + + mov rsi, mal_startup_string + mov edx, mal_startup_string.len + call raw_to_string ; String in RAX + + push rax + mov rsi, rax + call read_str ; AST in RAX + pop rsi ; string + + push rax ; AST + call release_array ; string + pop rdi ; AST in RDI + + mov rsi, [repl_env] ; Environment in RSI + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call eval + + mov rsi, rax + call release_object ; Return from eval + + ; ----------------------------- + ; Check command-line arguments + + pop rax ; Number of arguments + cmp rax, 1 ; Always have at least one, the path to executable + jg run_script + + ; No extra arguments, so just set *ARGV* to an empty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov rcx, rax ; value (empty list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + + + +run_script: + ; Called with number of command-line arguments in RAX + mov r8, rax + pop rbx ; executable + dec r8 + + pop rsi ; Address of first arg + call cstring_to_string ; string in RAX + mov r9, rax + + ; get the rest of the args + xor r10, r10 ; Zero + dec r8 + jz .no_args + + ; Got some arguments +.arg_loop: + ; Got an argument left. + pop rsi ; Address of C string + call cstring_to_string ; String in RAX + mov r12, rax + + ;Make a Cons to point to the string + call alloc_cons ; in RAX + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], r12 + + test r10, r10 + jnz .append + + ; R10 zero, so first arg + mov r10, rax ; Head of list + mov r11, rax ; Tail of list + jmp .next +.append: + ; R10 not zero, so append to list tail + mov [r11 + Cons.cdr], rax + mov [r11 + Cons.typecdr], BYTE content_pointer + mov r11, rax +.next: + dec r8 + jnz .arg_loop + jmp .got_args + +.no_args: + ; No arguments. Create an emoty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov r10, rax + +.got_args: + push r9 ; File name string + + mov rcx, r10 ; value (list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + mov rsi, run_script_string ; load-file function + mov edx, run_script_string.len + call raw_to_string ; String in RAX + + mov rsi, rax + pop rdx ; File name string + call string_append_string + + mov cl, 34 ; " + call string_append_char + mov cl, ')' + call string_append_char ; closing brace + + ; Read-Eval "(load-file )" + call read_eval + + jmp quit diff --git a/impls/nasm/step8_macros.asm b/impls/nasm/step8_macros.asm new file mode 100644 index 0000000000..ba4ee89705 --- /dev/null +++ b/impls/nasm/step8_macros.asm @@ -0,0 +1,2295 @@ +;; +;; nasm -felf64 step8_macros.asm && ld step8_macros.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "core.asm" ; Core functions +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static defmacro_expecting_function_string, db "defmacro expects function",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + static eval_list_not_function, db "list does not begin with a function",10 + + static if_missing_condition_string, db "missing condition in if expression",10 + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + static_symbol do_symbol, 'do' + static_symbol if_symbol, 'if' + static_symbol fn_symbol, 'fn*' + static_symbol defmacro_symbol, 'defmacro!' + static_symbol macroexpand_symbol, 'macroexpand' + + static_symbol argv_symbol, '*ARGV*' + + static_symbol quote_symbol, 'quote' + static_symbol quasiquote_symbol, 'quasiquote' + static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' + static_symbol unquote_symbol, 'unquote' + static_symbol splice_unquote_symbol, 'splice-unquote' + static_symbol concat_symbol, 'concat' + static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' + +;; Startup string. This is evaluated on startup + static mal_startup_string, db "(do \ +(def! not (fn* (a) (if a false true))) \ +(def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) \ +)" + +;; Command to run, appending the name of the script to run + static run_script_string, db "(load-file ",34 +section .text + + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; +eval_ast: + mov r15, rdi ; Save Env in r15 + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; Check if first character of symbol is ':' + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .keyword + + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + push rsi + print_str_mac error_string ; print 'Error: ' + + pop rsi + push rsi + mov edx, [rsi + Array.length] + add rsi, Array.data + call print_rawstring ; print symbol + + print_str_mac not_found_string ; print ' not found' + pop rsi + + jmp error_throw + + ; ------------------------------ + +.keyword: + ; Just return keywords unaltered + call incref_object + mov rax, rsi + ret + + ; ------------------------------ +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate [ Released ] +;; RDI Environment [ Released ] +;; +;; Returns: Result in RAX +;; +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) +;; +eval: + mov r15, rdi ; Env + + push rsi ; AST pushed, must be popped before return + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + jmp .return ; Releases Env + + ; -------------------- +.list: + ; A list + + ; Macro expand + pop rax ; Old AST, discard from stack + call macroexpand ; Replaces RSI + push rsi ; New AST + + ; Check if RSI is a list, and if + ; the first element is a symbol + mov al, BYTE [rsi] + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list_still_list + + ; Not a list, so call eval_ast on it + mov rdi, r15 ; Environment + call eval_ast + jmp .return + +.list_still_list: + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + eval_cmp_symbol do_symbol ; do + je .do_symbol + + eval_cmp_symbol if_symbol ; if + je .if_symbol + + eval_cmp_symbol fn_symbol ; fn + je .fn_symbol + + eval_cmp_symbol quote_symbol ; quote + je .quote_symbol + + eval_cmp_symbol quasiquoteexpand_symbol + je .quasiquoteexpand_symbol + + eval_cmp_symbol quasiquote_symbol ; quasiquote + je .quasiquote_symbol + + eval_cmp_symbol defmacro_symbol ; defmacro! + je .defmacro_symbol + + eval_cmp_symbol macroexpand_symbol ; macroexpand + je .macroexpand_symbol + + ; Unrecognised + jmp .list_eval + + + ; ----------------------------- + +.defmacro_symbol: + mov r9, 1 + jmp .def_common +.def_symbol: + xor r9, r9 ; Set R9 to 0 +.def_common: + ; Define a new symbol in current environment + ; If R9 is set to 1 then defmacro + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + + ; Test if this is defmacro! + test r9, r9 + jnz .defmacro_not_function + + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + push r8 ; the symbol + push r15 ; Env + push r9 + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call incref_object ; AST increment refs + + call eval + mov rsi, rax + + pop r9 + + ; If this is defmacro, and the object in RSI is a function, + ; then change to a macro + test r9, r9 + jz .def_not_macro ; Not defmacro + + ; Check RSI + mov al, BYTE [rsi] + cmp al, maltype_function + jne .defmacro_not_function + + ; Got a function, change to macro + mov [rsi], BYTE maltype_macro + +.def_not_macro: + + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx + jmp .return + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.defmacro_not_function: + mov rsi, defmacro_expecting_function_string + mov rdx, defmacro_expecting_function_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + mov rsi, r15 + call release_object ; Decrement R15 ref count + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + + mov rsi, r14 + call incref_object + mov rdi, r14 + + mov rsi, [r12 + Cons.car] ; Get the address + + call incref_object ; Increment ref count of AST + + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + call incref_object ; will be released by eval + + mov r11, rsi ; save new AST + pop rsi ; Old AST + call release_object + mov rsi, r11 ; New AST + + mov rdi, r14 ; New environment + + jmp eval ; Tail call + ; Note: eval will release the new environment on return + +.let_done: + ; Release the new environment + push rax + mov rsi, r14 + call release_object + pop rax + + ; Release the AST + pop rsi + push rax + call release_object + pop rax + ret ; already released env + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.do_symbol: + mov r11, rsi ; do form in RSI + ; Environment in R15 + + ; Check if there is a body + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .do_no_body ; error + + mov r11, [r11 + Cons.cdr] ; Body in R11 + +.do_symbol_loop: + + ; Need to test if this is the last form + ; so we can handle tail call + + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .do_body_last ; Last expression + + ; not the last expression + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_next ; A value, so skip + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + ; since eval will release Env + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increment ref count since eval will release + + mov rdi, r15 ; Env + call eval ; Result in RAX + + ; Another form after this. + ; Discard the result of the last eval + mov rsi, rax + call release_object + + pop r11 + pop r15 + +.do_next: + mov r11, [r11 + Cons.cdr] ; Next in list + + jmp .do_symbol_loop + +.do_body_last: + ; The last form is in R11, which will be returned + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_body_value_return + jmp .do_body_expr_return + +.do_body_value_return: + ; Got a value as last form (in R11). + ; Copy and return + + push rax ; Type of value to return + + ; release Env + mov rsi, r15 + call release_object + + ; Allocate a Cons object to hold value + call alloc_cons + pop rbx ; type in BL + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + ; release the AST + pop rsi + mov r15, rax ; not modified by release + call release_object + mov rax, r15 + + ret + +.do_body_expr_return: + ; An expression to evaluate as the last form + ; Tail call optimise, jumping to eval + ; Don't increment Env reference count + + mov rsi, [r11 + Cons.car] ; new AST form + call incref_object ; This will be released by eval + + mov r11, rsi ; Save new AST + pop rsi ; Remove old AST from stack + call release_object + mov rsi, r11 + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.do_no_body: + ; No expressions to evaluate. Return nil + + mov rsi, r15 + call release_object ; Release Env + + ; release the AST + pop rsi + call release_object + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.if_symbol: + mov r11, rsi ; if form in R11 + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .if_no_condition + + mov r11, [r11 + Cons.cdr] ; Should be a condition + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .if_cond_value + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increase Form/AST ref count + + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Get type of result + mov bl, BYTE [rax] + + ; release value + push rbx + mov rsi, rax + call release_object + pop rbx + + ; Check type + cmp bl, maltype_nil + je .if_false + cmp bl, maltype_false + je .if_false + + jmp .if_true + +.if_cond_value: + + ; A value + cmp al, content_nil + je .if_false + cmp al, content_false + je .if_false + + jmp .if_true + +.if_false: + ; Skip the next item + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil + + mov r11, [r11 + Cons.cdr] + +.if_true: + ; Get the next item in the list and evaluate it + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; Nothing to return + + mov r11, [r11 + Cons.cdr] + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + je .if_got_pointer + +.if_got_value: + ; copy value in r11 + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + jmp .return + +.if_got_pointer: + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Will be released by eval + + mov r11, rsi + pop rsi + call release_object ; Release old AST + mov rsi, r11 ; New AST + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.if_no_condition: ; just (if) without a condition + + print_str_mac error_string + print_str_mac if_missing_condition_string + + ; Release environment + mov rsi, r15 + call release_object + xor rsi, rsi ; No object to throw + jmp error_throw + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + +.return: + ; Release environment + mov rsi, r15 + mov r15, rax ; Save RAX (return value) + call release_object + + ; Release the AST + pop rsi ; Pushed at start of eval + call release_object + + mov rax, r15 ; return value + ret + + ; ----------------------------- + +.fn_symbol: + mov r11, rsi ; fn form in R11 + ; Environment in R15 + + ; Get the binds and body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_empty + + mov r11, [r11 + Cons.cdr] + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_binds_not_list + + mov r12, [r11 + Cons.car] ; Should be binds list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + cmp al, (block_cons + container_list) + je .fn_got_binds ; Can be list + cmp al, (block_cons + container_vector) + je .fn_got_binds ; or vector + jmp .fn_binds_not_list + +.fn_got_binds: + + ; Next get the body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_no_body + + mov r11, [r11 + Cons.cdr] + ; Check value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_is_value ; Body in r11 + mov r11, [r11 + Cons.car] + jmp .fn_got_body + +.fn_is_value: + ; Body is just a value, no expression + mov [r11], BYTE al ; Mark as value, not list + +.fn_got_body: + + ; Now put into function type + ; Addr is "apply_fn", the address to call + ; Env in R15 + ; Binds in R12 + ; Body in R11 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) + mov rbx, apply_fn + mov [rax + Cons.car], rbx ; Address of apply function + mov [rax + Cons.typecdr], BYTE content_pointer + + mov r13, rax ; Return list in R13 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r15 ; Environment + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r13 + Cons.cdr], rax ; Append to list + mov r14, rax ; R14 contains last cons in list + + push rax + mov rsi, r15 + call incref_object + pop rax + + ; Binds + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r12 ; Binds list + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r12 + call incref_object + pop rax + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r11 ; Body of function + + mov [r14 + Cons.cdr], rax + + mov rsi, r11 + call incref_object + + mov rax, r13 + jmp .return + +.fn_empty: +.fn_binds_not_list: +.fn_no_body: + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + jmp .return + + ; ----------------------------- + +.quote_symbol: + ; Just return the arguments in rsi cdr + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quote empty, so return nil + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + call incref_object + mov rax, rsi + jmp .return + + ; ----------------------------- + +;;; Like quasiquote, but do not evaluate the result. +.quasiquoteexpand_symbol: + ;; Return nil if no cdr + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.cdr] + call car_and_incref + call quasiquote + jmp .return + + ; ----------------------------- + +.quasiquote_symbol: + ; call quasiquote function with first argument + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quasiquote empty, so return nil + + mov r11, rsi ; Save original AST in R11 + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quasiquote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quasiquote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + + push r15 ; Environment + ; Original AST already on stack + + call quasiquote + ; New AST in RAX + pop rdi ; Environment + pop rsi ; Old AST + + mov r11, rax ; New AST + call release_object ; Release old AST + mov rsi, r11 ; New AST in RSI + + jmp eval ; Tail call + + ; ----------------------------- +.macroexpand_symbol: + ; Check if we have a second list element + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; No argument + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .macroexpand_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.macroexpand_pointer: + mov rsi, [rsi + Cons.car] + call incref_object ; Since RSI will be released + + call macroexpand ; May release and replace RSI + + mov rax, rsi + jmp .return ; Releases original AST + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + call eval_ast ; List of evaluated forms in RAX + pop r15 + pop rsi + +.list_exec: + ; This point can be called to run a function + ; used by swap! + ; + ; Inputs: RAX - List with function as first element + ; NOTE: This list is released + ; + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Check the rest of the args + mov cl, BYTE [rax + Cons.typecdr] + cmp cl, content_pointer + je .list_got_args + + ; No arguments + push rbx ; Function object + push rax ; List with function first + + ; Create an empty list for the arguments + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax ; Argument list into RSI + + pop rax ; list, function first + ;; Put new empty list onto end of original list + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rsi + + pop rbx + jmp .list_function_call +.list_got_args: + mov rsi, [rax + Cons.cdr] ; Rest of list +.list_function_call: + ; Call the function with the rest of the list in RSI + + mov rdx, rax ; List to release + mov rdi, rbx ; Function object in RDI + + mov rbx, [rbx + Cons.car] ; Call function + cmp rbx, apply_fn + je apply_fn_jmp ; Jump to user function apply + + ; A built-in function, so call (no recursion) + push rax + push r15 + + call rbx + + ; Result in rax + pop r15 + pop rsi ; eval'ed list + + push rax + call release_cons + pop rax + jmp .return ; Releases Env + +.list_not_function: + ; Not a function. Probably an error + push rsi + + mov rsi, rax + call release_object + + print_str_mac error_string + print_str_mac eval_list_not_function + pop rsi + jmp error_throw + +.empty_list: + mov rax, rsi + jmp .return + +;; Applies a user-defined function +;; +;; Input: RSI - Arguments to bind +;; RDI - Function object +;; RDX - list to release after binding +;; R15 - Env (will be released) +;; R13 - AST released before return +;; +;; +;; Output: Result in RAX +;; +;; This is jumped to from eval, so if it returns +;; then it will return to the caller of eval, not to eval +apply_fn_jmp: + ; This is jumped to from eval with AST on the stack + pop r13 +apply_fn: + push rsi + ; Extract values from the list in RDI + mov rax, [rdi + Cons.cdr] + mov rsi, [rax + Cons.car] ; Env + mov rax, [rax + Cons.cdr] + mov rdi, [rax + Cons.car] ; Binds + mov rax, [rax + Cons.cdr] + mov rax, [rax + Cons.car] ; Body + pop rcx ; Exprs + + ; Check the type of the body + mov bl, BYTE [rax] + and bl, block_mask + container_mask + jnz .bind + ; Just a value (in RAX). No eval needed + + mov r14, rax ; Save return value in R14 + + mov rsi, rax + call incref_object + + ; Release the list passed in RDX + mov rsi, rdx + call release_object + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the AST + mov rsi, r13 + call release_object + + mov rax, r14 + ret +.bind: + ; Create a new environment, binding arguments + push rax ; Body + + mov r14, r13 ; Old AST. R13 used by env_new_bind + + push rdx + call env_new_bind + pop rdx + + mov rdi, rax ; New environment in RDI + + ; Note: Need to increment the reference count + ; of the function body before releasing anything, + ; since if the function was defined in-place (lambda) + ; then the body may be released early + + pop rsi ; Body + call incref_object ; Will be released by eval + mov r8, rsi ; Body in R8 + + ; Release the list passed in RDX + mov rsi, rdx + call release_cons + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the old AST + mov rsi, r14 + call release_object + + mov rsi, r8 ; Body + + jmp eval ; Tail call + ; The new environment (in RDI) will be released by eval + + +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX +quasiquote: + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged + call incref_object + mov rax, rsi + ret + +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr + + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr + + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + + ;; If so, return the argument. + mov rsi, [rsi + Cons.cdr] + call car_and_incref + mov rax, rsi + ret + +.map: +.symbol: + call incref_object + + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. + mov al, BYTE [rsi + Cons.typecdr] + +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then + mov rsi, [rsi + Cons.cdr] + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + mov rdx, rax + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, concat_symbol + call incref_object + + ;; rax := ('concat elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;; Tests if an AST in RSI is a list containing +;; a macro defined in the ENV in R15 +;; +;; Inputs: AST in RSI (not modified) +;; ENV in R15 (not modified) +;; +;; Returns: Sets ZF if macro call. If set (true), +;; then the macro object is in RAX +;; +;; Modifies: +;; RAX +;; RBX +;; RCX +;; RDX +;; R8 +;; R9 +is_macro_call: + ; Test if RSI is a list which contains a pointer + mov al, BYTE [rsi] + cmp al, (block_cons + container_list + content_pointer) + jne .false + + ; Test if this is a symbol + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .false + + ; Look up symbol in Env + push rsi + push r15 + mov rdi, rbx ; symbol in RDI + mov rsi, r15 ; Environment in RSI + call env_get + pop r15 + pop rsi + jne .false ; Not in environment + + ; Object in RAX + ; If this is not a macro then needs to be released + mov dl, BYTE [rax] + + cmp dl, maltype_macro + je .true + + ; Not a macro, so release + mov r8, rsi + mov rsi, rax + call release_object + mov rsi, r8 + +.false: + lahf ; flags in AH + and ah, 255-64 ; clear zero flag + sahf + ret +.true: + mov rbx, rax ; Returning Macro object + lahf ; flags in AH + or ah, 64 ; set zero flag + sahf + mov rax, rbx + ret + +;; Expands macro calls +;; +;; Input: AST in RSI (released and replaced) +;; Env in R15 (not modified) +;; +;; Result: New AST in RSI +macroexpand: + push r15 + + call is_macro_call + jne .done + + mov r13, rsi + + mov rdi, rax ; Macro in RDI + + ; Check the rest of the args + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + je .got_args + + ; No arguments. Create an empty list + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rdx, rax + + mov rsi, rdx ; Arguments (empty list) + call incref_object + jmp .macro_call +.got_args: + mov rsi, [rsi + Cons.cdr] ; Rest of list + call incref_object + mov rdx, rsi ; Released +.macro_call: + ; Here have: + ; RSI - Arguments + ; RDI - Macro object + ; RDX - List to release + ; R15 - Environment + ; R13 - AST + + ; Increment reference for Environment + ; since this will be released by apply_fn + xchg rsi, r15 + call incref_object + xchg rsi, r15 + + call apply_fn + + mov rsi, rax ; Result in RSI + + pop r15 + jmp macroexpand +.done: + pop r15 + ret + +;; Read and eval +read_eval: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + jmp eval ; This releases Env and Form/AST + + +;; Read-Eval-Print in sequence +;; +;; Input string in RSI +rep_seq: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call eval ; This releases Env and Form/AST + push rax ; Save result of eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + mov rdi, 1 ; print readably + call pr_str ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call core_environment ; Environment in RAX + + mov [repl_env], rax ; store in memory + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the startup string + + mov rsi, mal_startup_string + mov edx, mal_startup_string.len + call raw_to_string ; String in RAX + + push rax + mov rsi, rax + call read_str ; AST in RAX + pop rsi ; string + + push rax ; AST + call release_array ; string + pop rdi ; AST in RDI + + mov rsi, [repl_env] ; Environment in RSI + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call eval + + mov rsi, rax + call release_object ; Return from eval + + ; ----------------------------- + ; Check command-line arguments + + pop rax ; Number of arguments + cmp rax, 1 ; Always have at least one, the path to executable + jg run_script + + ; No extra arguments, so just set *ARGV* to an empty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov rcx, rax ; value (empty list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + + + +run_script: + ; Called with number of command-line arguments in RAX + mov r8, rax + pop rbx ; executable + dec r8 + + pop rsi ; Address of first arg + call cstring_to_string ; string in RAX + mov r9, rax + + ; get the rest of the args + xor r10, r10 ; Zero + dec r8 + jz .no_args + + ; Got some arguments +.arg_loop: + ; Got an argument left. + pop rsi ; Address of C string + call cstring_to_string ; String in RAX + mov r12, rax + + ;Make a Cons to point to the string + call alloc_cons ; in RAX + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], r12 + + test r10, r10 + jnz .append + + ; R10 zero, so first arg + mov r10, rax ; Head of list + mov r11, rax ; Tail of list + jmp .next +.append: + ; R10 not zero, so append to list tail + mov [r11 + Cons.cdr], rax + mov [r11 + Cons.typecdr], BYTE content_pointer + mov r11, rax +.next: + dec r8 + jnz .arg_loop + jmp .got_args + +.no_args: + ; No arguments. Create an emoty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov r10, rax + +.got_args: + push r9 ; File name string + + mov rcx, r10 ; value (list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + mov rsi, run_script_string ; load-file function + mov edx, run_script_string.len + call raw_to_string ; String in RAX + + mov rsi, rax + pop rdx ; File name string + call string_append_string + + mov cl, 34 ; " + call string_append_char + mov cl, ')' + call string_append_char ; closing brace + + ; Read-Eval "(load-file )" + call read_eval + + jmp quit diff --git a/impls/nasm/step9_try.asm b/impls/nasm/step9_try.asm new file mode 100644 index 0000000000..54a3318946 --- /dev/null +++ b/impls/nasm/step9_try.asm @@ -0,0 +1,2541 @@ +;; +;; nasm -felf64 step9_try.asm && ld step9_try.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "core.asm" ; Core functions +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static defmacro_expecting_function_string, db "defmacro expects function",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + static eval_list_not_function, db "list does not begin with a function",10 + + static if_missing_condition_string, db "missing condition in if expression",10 + + static try_missing_catch, db "try* missing catch*" + static catch_missing_symbol, db "catch* missing symbol" + static catch_missing_form, db "catch* missing form" + +;; Symbols used for comparison + + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + static_symbol do_symbol, 'do' + static_symbol if_symbol, 'if' + static_symbol fn_symbol, 'fn*' + static_symbol defmacro_symbol, 'defmacro!' + static_symbol macroexpand_symbol, 'macroexpand' + static_symbol try_symbol, 'try*' + static_symbol catch_symbol, 'catch*' + + static_symbol argv_symbol, '*ARGV*' + + static_symbol quote_symbol, 'quote' + static_symbol quasiquote_symbol, 'quasiquote' + static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' + static_symbol unquote_symbol, 'unquote' + static_symbol splice_unquote_symbol, 'splice-unquote' + static_symbol concat_symbol, 'concat' + static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' + +;; Startup string. This is evaluated on startup + static mal_startup_string, db "(do \ +(def! not (fn* (a) (if a false true))) \ +(def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) \ +)" + +;; Command to run, appending the name of the script to run + static run_script_string, db "(load-file ",34 +section .text + + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; +eval_ast: + mov r15, rdi ; Save Env in r15 + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + ret + +.symbol: + ; Check if first character of symbol is ':' + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .keyword + + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + mov r11, rsi ; Symbol in R11 + + call string_new + mov rsi, rax ; New string in RSI + + mov cl, 39 ; quote ' + call string_append_char + + mov rdx, r11 ; symbol + call string_append_string + + mov cl, 39 + call string_append_char + + mov r11, rsi + + mov rsi, not_found_string + mov edx, not_found_string.len + call raw_to_string ; ' not found' + + mov r12, rax + + mov rdx, rax + mov rsi, r11 + call string_append_string + + mov r11, rsi + mov rsi, r12 + call release_array + mov rsi, r11 + + jmp error_throw + + ; ------------------------------ + +.keyword: + ; Just return keywords unaltered + call incref_object + mov rax, rsi + ret + + ; ------------------------------ +.list: + ; Evaluate each element of the list + ; + xor r8, r8 ; The list to return + ; r9 contains head of list + +.list_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .list_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_next + +.list_first: + mov r8, rax + mov r9, rax + ; fall through to .list_next + +.list_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + ret + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + ret + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + ret + +.map_error_missing_value: + mov rax, r12 + ret + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + ret + + ; --------------------- +.done: + ret + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + +;; ---------------------------------------------------- +;; Evaluates a form +;; +;; Input: RSI AST to evaluate [ Released ] +;; RDI Environment [ Released ] +;; +;; Returns: Result in RAX +;; +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) +;; +eval: + mov r15, rdi ; Env + + push rsi ; AST pushed, must be popped before return + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, container_mask + cmp al, container_list + je .list + + ; Not a list. Evaluate and return + call eval_ast + jmp .return ; Releases Env + + ; -------------------- +.list: + ; A list + + ; Macro expand + pop rax ; Old AST, discard from stack + call macroexpand ; Replaces RSI + push rsi ; New AST + + ; Check if RSI is a list, and if + ; the first element is a symbol + mov al, BYTE [rsi] + + ; Check type + mov al, BYTE [rsi] + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list_still_list + + ; Not a list, so call eval_ast on it + mov rdi, r15 ; Environment + call eval_ast + jmp .return + +.list_still_list: + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + eval_cmp_symbol do_symbol ; do + je .do_symbol + + eval_cmp_symbol if_symbol ; if + je .if_symbol + + eval_cmp_symbol fn_symbol ; fn + je .fn_symbol + + eval_cmp_symbol quote_symbol ; quote + je .quote_symbol + + eval_cmp_symbol quasiquoteexpand_symbol + je .quasiquoteexpand_symbol + + eval_cmp_symbol quasiquote_symbol ; quasiquote + je .quasiquote_symbol + + eval_cmp_symbol defmacro_symbol ; defmacro! + je .defmacro_symbol + + eval_cmp_symbol macroexpand_symbol ; macroexpand + je .macroexpand_symbol + + eval_cmp_symbol try_symbol ; try* + je .try_symbol + + ; Unrecognised + jmp .list_eval + + + ; ----------------------------- + +.defmacro_symbol: + mov r9, 1 + jmp .def_common +.def_symbol: + xor r9, r9 ; Set R9 to 0 +.def_common: + ; Define a new symbol in current environment + ; If R9 is set to 1 then defmacro + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + + ; Test if this is defmacro! + test r9, r9 + jnz .defmacro_not_function + + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + push r8 ; the symbol + push r15 ; Env + push r9 + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call incref_object ; AST increment refs + + call eval + mov rsi, rax + + pop r9 + + ; If this is defmacro, and the object in RSI is a function, + ; then change to a macro + test r9, r9 + jz .def_not_macro ; Not defmacro + + ; Check RSI + mov al, BYTE [rsi] + cmp al, maltype_function + jne .defmacro_not_function + + ; Got a function, change to macro + mov [rsi], BYTE maltype_macro + +.def_not_macro: + + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx + jmp .return + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.defmacro_not_function: + mov rsi, defmacro_expecting_function_string + mov rdx, defmacro_expecting_function_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + mov rsi, r15 + call release_object ; Decrement R15 ref count + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + + mov rsi, r14 + call incref_object + mov rdi, r14 + + mov rsi, [r12 + Cons.car] ; Get the address + + call incref_object ; Increment ref count of AST + + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + call incref_object ; will be released by eval + + mov r11, rsi ; save new AST + pop rsi ; Old AST + call release_object + mov rsi, r11 ; New AST + + mov rdi, r14 ; New environment + + jmp eval ; Tail call + ; Note: eval will release the new environment on return + +.let_done: + ; Release the new environment + push rax + mov rsi, r14 + call release_object + pop rax + + ; Release the AST + pop rsi + push rax + call release_object + pop rax + ret ; already released env + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.do_symbol: + mov r11, rsi ; do form in RSI + ; Environment in R15 + + ; Check if there is a body + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .do_no_body ; error + + mov r11, [r11 + Cons.cdr] ; Body in R11 + +.do_symbol_loop: + + ; Need to test if this is the last form + ; so we can handle tail call + + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .do_body_last ; Last expression + + ; not the last expression + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_next ; A value, so skip + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + ; since eval will release Env + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increment ref count since eval will release + + mov rdi, r15 ; Env + call eval ; Result in RAX + + ; Another form after this. + ; Discard the result of the last eval + mov rsi, rax + call release_object + + pop r11 + pop r15 + +.do_next: + mov r11, [r11 + Cons.cdr] ; Next in list + + jmp .do_symbol_loop + +.do_body_last: + ; The last form is in R11, which will be returned + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_body_value_return + jmp .do_body_expr_return + +.do_body_value_return: + ; Got a value as last form (in R11). + ; Copy and return + + push rax ; Type of value to return + + ; release Env + mov rsi, r15 + call release_object + + ; Allocate a Cons object to hold value + call alloc_cons + pop rbx ; type in BL + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + ; release the AST + pop rsi + mov r15, rax ; not modified by release + call release_object + mov rax, r15 + + ret + +.do_body_expr_return: + ; An expression to evaluate as the last form + ; Tail call optimise, jumping to eval + ; Don't increment Env reference count + + mov rsi, [r11 + Cons.car] ; new AST form + call incref_object ; This will be released by eval + + mov r11, rsi ; Save new AST + pop rsi ; Remove old AST from stack + call release_object + mov rsi, r11 + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.do_no_body: + ; No expressions to evaluate. Return nil + + mov rsi, r15 + call release_object ; Release Env + + ; release the AST + pop rsi + call release_object + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.if_symbol: + mov r11, rsi ; if form in R11 + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .if_no_condition + + mov r11, [r11 + Cons.cdr] ; Should be a condition + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .if_cond_value + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increase Form/AST ref count + + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Get type of result + mov bl, BYTE [rax] + + ; release value + push rbx + mov rsi, rax + call release_object + pop rbx + + ; Check type + cmp bl, maltype_nil + je .if_false + cmp bl, maltype_false + je .if_false + + jmp .if_true + +.if_cond_value: + + ; A value + cmp al, content_nil + je .if_false + cmp al, content_false + je .if_false + + jmp .if_true + +.if_false: + ; Skip the next item + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil + + mov r11, [r11 + Cons.cdr] + +.if_true: + ; Get the next item in the list and evaluate it + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; Nothing to return + + mov r11, [r11 + Cons.cdr] + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + je .if_got_pointer + +.if_got_value: + ; copy value in r11 + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + jmp .return + +.if_got_pointer: + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Will be released by eval + + mov r11, rsi + pop rsi + call release_object ; Release old AST + mov rsi, r11 ; New AST + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.if_no_condition: ; just (if) without a condition + + print_str_mac error_string + print_str_mac if_missing_condition_string + + ; Release environment + mov rsi, r15 + call release_object + xor rsi, rsi ; No object to throw + jmp error_throw + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + +.return: + ; Release environment + mov rsi, r15 + mov r15, rax ; Save RAX (return value) + call release_object + + ; Release the AST + pop rsi ; Pushed at start of eval + call release_object + + mov rax, r15 ; return value + ret + + ; ----------------------------- + +.fn_symbol: + mov r11, rsi ; fn form in R11 + ; Environment in R15 + + ; Get the binds and body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_empty + + mov r11, [r11 + Cons.cdr] + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_binds_not_list + + mov r12, [r11 + Cons.car] ; Should be binds list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + cmp al, (block_cons + container_list) + je .fn_got_binds ; Can be list + cmp al, (block_cons + container_vector) + je .fn_got_binds ; or vector + jmp .fn_binds_not_list + +.fn_got_binds: + + ; Next get the body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_no_body + + mov r11, [r11 + Cons.cdr] + ; Check value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_is_value ; Body in r11 + mov r11, [r11 + Cons.car] + jmp .fn_got_body + +.fn_is_value: + ; Body is just a value, no expression + mov [r11], BYTE al ; Mark as value, not list + +.fn_got_body: + + ; Now put into function type + ; Addr is "apply_fn", the address to call + ; Env in R15 + ; Binds in R12 + ; Body in R11 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) + mov rbx, apply_fn + mov [rax + Cons.car], rbx ; Address of apply function + mov [rax + Cons.typecdr], BYTE content_pointer + + mov r13, rax ; Return list in R13 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r15 ; Environment + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r13 + Cons.cdr], rax ; Append to list + mov r14, rax ; R14 contains last cons in list + + push rax + mov rsi, r15 + call incref_object + pop rax + + ; Binds + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r12 ; Binds list + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r12 + call incref_object + pop rax + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r11 ; Body of function + + mov [r14 + Cons.cdr], rax + + mov rsi, r11 + call incref_object + + mov rax, r13 + jmp .return + +.fn_empty: +.fn_binds_not_list: +.fn_no_body: + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + jmp .return + + ; ----------------------------- + +.quote_symbol: + ; Just return the arguments in rsi cdr + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quote empty, so return nil + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + call incref_object + mov rax, rsi + jmp .return + + ; ----------------------------- + +;;; Like quasiquote, but do not evaluate the result. +.quasiquoteexpand_symbol: + ;; Return nil if no cdr + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.cdr] + call car_and_incref + call quasiquote + jmp .return + + ; ----------------------------- + +.quasiquote_symbol: + ; call quasiquote function with first argument + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quasiquote empty, so return nil + + mov r11, rsi ; Save original AST in R11 + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quasiquote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quasiquote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + + push r15 ; Environment + ; Original AST already on stack + + call quasiquote + ; New AST in RAX + pop rdi ; Environment + pop rsi ; Old AST + + mov r11, rax ; New AST + call release_object ; Release old AST + mov rsi, r11 ; New AST in RSI + + jmp eval ; Tail call + + ; ----------------------------- +.macroexpand_symbol: + ; Check if we have a second list element + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; No argument + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .macroexpand_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.macroexpand_pointer: + mov rsi, [rsi + Cons.car] + call incref_object ; Since RSI will be released + + call macroexpand ; May release and replace RSI + + mov rax, rsi + jmp .return ; Releases original AST + + ; ----------------------------- + +.try_symbol: + ; Should have the form + ; + ; (try* A (catch* B C)) + ; + ; where B is a symbol, A and C are forms to evaluate + + ; Check first arg A + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; No argument + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .try_pointer + + ; RSI contains a value. Copy and return + mov cl, al + call alloc_cons + mov [rax], BYTE cl ; Set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx + jmp .return + +.try_pointer: + + mov r8, [rsi + Cons.car] ; form A in R8 + + ; Check second arg B + + mov al, BYTE [rsi + Cons.typecdr] + ; If nil (catchless try) + cmp al, content_nil + je .catchless_try + + cmp al, content_pointer + jne .try_missing_catch + + mov rsi, [rsi + Cons.cdr] + + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .try_missing_catch + + mov r9, [rsi + Cons.car] ; (catch* B C) in R9 + + mov al, BYTE [r9] + cmp al, (container_list + content_pointer) + jne .try_missing_catch + + mov rsi, [r9 + Cons.car] ; Should be catch* symbol + mov al, BYTE [rsi] + cmp al, maltype_symbol + jne .try_missing_catch + + mov rdi, catch_symbol + call compare_char_array + test rax, rax ; ZF set if rax = 0 (equal) + jnz .try_missing_catch + + ; Check that B is a symbol + mov al, [r9 + Cons.typecdr] + cmp al, content_pointer + jne .catch_missing_symbol + + mov r9, [r9 + Cons.cdr] ; (B C) in R9 + + mov al, BYTE [r9] + and al, content_mask + cmp al, content_pointer + jne .catch_missing_symbol + + mov r10, [r9 + Cons.car] ; B in R10 + mov al, BYTE [r10] + cmp al, maltype_symbol + jne .catch_missing_symbol + + mov al, BYTE [r9 + Cons.typecdr] + cmp al, content_pointer + jne .catch_missing_form + mov r9, [r9 + Cons.cdr] ; C in R9 + + ; Now have extracted from (try* A (catch* B C)) + ; A in R8 + ; B in R10 + ; C in R9 + + push R9 + push R10 + push r15 ; Env + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the form in R8 + mov rsi, r15 + call incref_object ; Env released by eval + mov rdi, r15 ; Env in RDI + + mov rsi, r8 ; The form to evaluate (A) + + call incref_object ; AST released by eval + + call eval + + mov r8, rax ; Result in R8 + + pop r15 ; Environment + ; Discard B and C + ;add rsi, 8 ; pop R10 and R9 + pop r10 + pop r9 + + ; Remove error handler + call error_handler_pop + mov rax, r8 + jmp .return + +.catchless_try: + ;; Evaluate the form in R8 + push r15 ; Environment + + mov rsi, r15 + call incref_object ; Env released by eval + mov rdi, r15 ; Env in RDI + + mov rsi, r8 ; The form to evaluate (A) + + call incref_object ; AST released by eval + + call eval ; Result in RAX + + pop r15 ; Environment + + jmp .return +.catch: + ; Jumps here on error + ; Value thrown in RSI + ; + + push rsi + call error_handler_pop + pop rsi + + pop r15 ; Env + pop r12 ; B (symbol to bind) + pop r13 ; C (form to evaluate) + + ; Check if C is a value or pointer + + mov cl, BYTE [r13] + and cl, content_mask + cmp cl, content_pointer + je .catch_C_pointer + + ; A value, so copy and return + call alloc_cons + mov [rax], BYTE cl ; Set type + mov rbx, [r13 + Cons.car] + mov [rax + Cons.car], rbx ; Set value + + jmp .return + +.catch_C_pointer: + + mov r11, rsi ; Value thrown in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + + mov rsi, rax ; New environment in RSI + mov rdi, r12 ; key (symbol) + mov rcx, r11 ; value + call env_set + + mov rdi, rsi ; Env in RDI (will be released) + mov rsi, [r13 + Cons.car] ; Form to evaluate + call incref_object ; will be released + + push r15 + call eval + pop r15 + + jmp .return + +.try_missing_catch: + load_static try_missing_catch + call raw_to_string + mov rsi, rax + jmp error_throw + +.catch_missing_symbol: + load_static catch_missing_symbol + call raw_to_string + mov rsi, rax + jmp error_throw + +.catch_missing_form: + load_static catch_missing_form + call raw_to_string + mov rsi, rax + jmp error_throw + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + call eval_ast ; List of evaluated forms in RAX + pop r15 + pop rsi + +.list_exec: + ; This point can be called to run a function + ; used by swap! + ; + ; Inputs: RAX - List with function as first element + ; NOTE: This list is released + ; + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Check the rest of the args + mov cl, BYTE [rax + Cons.typecdr] + cmp cl, content_pointer + je .list_got_args + + ; No arguments + push rbx ; Function object + push rax ; List with function first + + ; Create an empty list for the arguments + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax ; Argument list into RSI + + pop rax ; list, function first + ;; Put new empty list onto end of original list + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rsi + + pop rbx + jmp .list_function_call +.list_got_args: + mov rsi, [rax + Cons.cdr] ; Rest of list +.list_function_call: + ; Call the function with the rest of the list in RSI + + mov rdx, rax ; List to release + mov rdi, rbx ; Function object in RDI + + mov rbx, [rbx + Cons.car] ; Call function + cmp rbx, apply_fn + je apply_fn_jmp ; Jump to user function apply + + ; A built-in function, so call (no recursion) + push rax + push r15 + + call rbx + + ; Result in rax + pop r15 + pop rsi ; eval'ed list + + push rax + call release_cons + pop rax + jmp .return ; Releases Env + +.list_not_function: + ; Not a function. Probably an error + push rsi + + mov rsi, rax + call release_object + + print_str_mac error_string + print_str_mac eval_list_not_function + pop rsi + jmp error_throw + +.empty_list: + mov rax, rsi + jmp .return + +;; Applies a user-defined function +;; +;; Input: RSI - Arguments to bind +;; RDI - Function object +;; RDX - list to release after binding +;; R15 - Env (will be released) +;; R13 - AST released before return +;; +;; +;; Output: Result in RAX +;; +;; This is jumped to from eval, so if it returns +;; then it will return to the caller of eval, not to eval +apply_fn_jmp: + ; This is jumped to from eval with AST on the stack + pop r13 +apply_fn: + push rsi + ; Extract values from the list in RDI + mov rax, [rdi + Cons.cdr] + mov rsi, [rax + Cons.car] ; Env + mov rax, [rax + Cons.cdr] + mov rdi, [rax + Cons.car] ; Binds + mov rax, [rax + Cons.cdr] + mov rax, [rax + Cons.car] ; Body + pop rcx ; Exprs + + ; Check the type of the body + mov bl, BYTE [rax] + and bl, block_mask + container_mask + jnz .bind + ; Just a value (in RAX). No eval needed + + mov r14, rax ; Save return value in R14 + + mov rsi, rax + call incref_object + + ; Release the list passed in RDX + mov rsi, rdx + call release_object + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the AST + mov rsi, r13 + call release_object + + mov rax, r14 + ret +.bind: + ; Create a new environment, binding arguments + push rax ; Body + + mov r14, r13 ; Old AST. R13 used by env_new_bind + + push rdx + call env_new_bind + pop rdx + + mov rdi, rax ; New environment in RDI + + ; Note: Need to increment the reference count + ; of the function body before releasing anything, + ; since if the function was defined in-place (lambda) + ; then the body may be released early + + pop rsi ; Body + call incref_object ; Will be released by eval + mov r8, rsi ; Body in R8 + + ; Release the list passed in RDX + mov rsi, rdx + call release_cons + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the old AST + mov rsi, r14 + call release_object + + mov rsi, r8 ; Body + + jmp eval ; Tail call + ; The new environment (in RDI) will be released by eval + + +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX +quasiquote: + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged + call incref_object + mov rax, rsi + ret + +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr + + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr + + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + + ;; If so, return the argument. + mov rsi, [rsi + Cons.cdr] + call car_and_incref + mov rax, rsi + ret + +.map: +.symbol: + call incref_object + + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. + mov al, BYTE [rsi + Cons.typecdr] + +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then + mov rsi, [rsi + Cons.cdr] + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + mov rdx, rax + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, concat_symbol + call incref_object + + ;; rax := ('concat elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;; Tests if an AST in RSI is a list containing +;; a macro defined in the ENV in R15 +;; +;; Inputs: AST in RSI (not modified) +;; ENV in R15 (not modified) +;; +;; Returns: Sets ZF if macro call. If set (true), +;; then the macro object is in RAX +;; +;; Modifies: +;; RAX +;; RBX +;; RCX +;; RDX +;; R8 +;; R9 +is_macro_call: + ; Test if RSI is a list which contains a pointer + mov al, BYTE [rsi] + cmp al, (block_cons + container_list + content_pointer) + jne .false + + ; Test if this is a symbol + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .false + + ; Look up symbol in Env + push rsi + push r15 + mov rdi, rbx ; symbol in RDI + mov rsi, r15 ; Environment in RSI + call env_get + pop r15 + pop rsi + jne .false ; Not in environment + + ; Object in RAX + ; If this is not a macro then needs to be released + mov dl, BYTE [rax] + + cmp dl, maltype_macro + je .true + + ; Not a macro, so release + mov r8, rsi + mov rsi, rax + call release_object + mov rsi, r8 + +.false: + lahf ; flags in AH + and ah, 255-64 ; clear zero flag + sahf + ret +.true: + mov rbx, rax ; Returning Macro object + lahf ; flags in AH + or ah, 64 ; set zero flag + sahf + mov rax, rbx + ret + +;; Expands macro calls +;; +;; Input: AST in RSI (released and replaced) +;; Env in R15 (not modified) +;; +;; Result: New AST in RSI +macroexpand: + push r15 + + call is_macro_call + jne .done + + mov r13, rsi + + mov rdi, rax ; Macro in RDI + + ; Check the rest of the args + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + je .got_args + + ; No arguments. Create an empty list + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rdx, rax + + mov rsi, rdx ; Arguments (empty list) + call incref_object + jmp .macro_call +.got_args: + mov rsi, [rsi + Cons.cdr] ; Rest of list + call incref_object + mov rdx, rsi ; Released +.macro_call: + ; Here have: + ; RSI - Arguments + ; RDI - Macro object + ; RDX - List to release + ; R15 - Environment + ; R13 - AST + + ; Increment reference for Environment + ; since this will be released by apply_fn + xchg rsi, r15 + call incref_object + xchg rsi, r15 + + call apply_fn + + mov rsi, rax ; Result in RSI + + pop r15 + jmp macroexpand +.done: + pop r15 + ret + +;; Read and eval +read_eval: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + jmp eval ; This releases Env and Form/AST + + +;; Read-Eval-Print in sequence +;; +;; Input string in RSI +rep_seq: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call eval ; This releases Env and Form/AST + push rax ; Save result of eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + mov rdi, 1 ; print readably + call pr_str ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call core_environment ; Environment in RAX + + mov [repl_env], rax ; store in memory + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the startup string + + mov rsi, mal_startup_string + mov edx, mal_startup_string.len + call raw_to_string ; String in RAX + + push rax + mov rsi, rax + call read_str ; AST in RAX + pop rsi ; string + + push rax ; AST + call release_array ; string + pop rdi ; AST in RDI + + mov rsi, [repl_env] ; Environment in RSI + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call eval + + mov rsi, rax + call release_object ; Return from eval + + ; ----------------------------- + ; Check command-line arguments + + pop rax ; Number of arguments + cmp rax, 1 ; Always have at least one, the path to executable + jg run_script + + ; No extra arguments, so just set *ARGV* to an empty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov rcx, rax ; value (empty list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + + push rsi + print_str_mac error_string ; print 'Error: ' + pop rsi + + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + + + +run_script: + ; Called with number of command-line arguments in RAX + mov r8, rax + pop rbx ; executable + dec r8 + + pop rsi ; Address of first arg + call cstring_to_string ; string in RAX + mov r9, rax + + ; get the rest of the args + xor r10, r10 ; Zero + dec r8 + jz .no_args + + ; Got some arguments +.arg_loop: + ; Got an argument left. + pop rsi ; Address of C string + call cstring_to_string ; String in RAX + mov r12, rax + + ;Make a Cons to point to the string + call alloc_cons ; in RAX + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], r12 + + test r10, r10 + jnz .append + + ; R10 zero, so first arg + mov r10, rax ; Head of list + mov r11, rax ; Tail of list + jmp .next +.append: + ; R10 not zero, so append to list tail + mov [r11 + Cons.cdr], rax + mov [r11 + Cons.typecdr], BYTE content_pointer + mov r11, rax +.next: + dec r8 + jnz .arg_loop + jmp .got_args + +.no_args: + ; No arguments. Create an emoty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov r10, rax + +.got_args: + push r9 ; File name string + + mov rcx, r10 ; value (list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + mov rsi, run_script_string ; load-file function + mov edx, run_script_string.len + call raw_to_string ; String in RAX + + mov rsi, rax + pop rdx ; File name string + call string_append_string + + mov cl, 34 ; " + call string_append_char + mov cl, ')' + call string_append_char ; closing brace + + ; Read-Eval "(load-file )" + call read_eval + + jmp quit diff --git a/impls/nasm/stepA_mal.asm b/impls/nasm/stepA_mal.asm new file mode 100644 index 0000000000..3d7c5524db --- /dev/null +++ b/impls/nasm/stepA_mal.asm @@ -0,0 +1,2515 @@ +;; +;; nasm -felf64 stepA_mal.asm && ld stepA_mal.o && ./a.out +;; +;; Calling convention: Address of input is in RSI +;; Address of return value is in RAX +;; + +global _start + +%include "types.asm" ; Data types, memory +%include "env.asm" ; Environment type +%include "system.asm" ; System calls +%include "reader.asm" ; String -> Data structures +%include "core.asm" ; Core functions +%include "printer.asm" ; Data structures -> String +%include "exceptions.asm" ; Error handling + +section .bss + +;; Top-level (REPL) environment +repl_env:resq 1 + +section .data + +;; ------------------------------------------ +;; Fixed strings for printing + + static prompt_string, db 10,"user> " ; The string to print at the prompt + + static eval_debug_string, db "EVAL: " + static eval_debug_cr, db 10 + + static error_string, db 27,'[31m',"Error",27,'[0m',": " + + static not_found_string, db " not found" + + static def_missing_arg_string, db "missing argument to def!",10 + + static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 + + static defmacro_expecting_function_string, db "defmacro expects function",10 + + static let_missing_bindings_string, db "let* missing bindings",10 + + static let_bindings_list_string, db "let* expected a list or vector of bindings",10 + + static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 + + static let_bind_value_string, db "let* missing value in bindings list",10 + + static let_missing_body_string, db "let* missing body",10 + static eval_list_not_function, db "list does not begin with a function",10 + + static if_missing_condition_string, db "missing condition in if expression",10 + + static try_missing_catch, db "try* missing catch*" + static catch_missing_symbol, db "catch* missing symbol" + static catch_missing_form, db "catch* missing form" + +;; Symbols used for comparison + + static_symbol debug_eval, 'DEBUG-EVAL' + static_symbol def_symbol, 'def!' + static_symbol let_symbol, 'let*' + static_symbol do_symbol, 'do' + static_symbol if_symbol, 'if' + static_symbol fn_symbol, 'fn*' + static_symbol defmacro_symbol, 'defmacro!' + static_symbol try_symbol, 'try*' + static_symbol catch_symbol, 'catch*' + + static_symbol argv_symbol, '*ARGV*' + + static_symbol quote_symbol, 'quote' + static_symbol quasiquote_symbol, 'quasiquote' + static_symbol unquote_symbol, 'unquote' + static_symbol splice_unquote_symbol, 'splice-unquote' + static_symbol concat_symbol, 'concat' + static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' + +;; Startup string. This is evaluated on startup + static mal_startup_string, db "(do \ +(def! not (fn* (a) (if a false true))) \ +(def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) \ +(def! *host-language* ",34,"nasm",34,")\ +(def! conj nil)\ +)" + +;; Command to run, appending the name of the script to run + static run_script_string, db "(load-file ",34 + +;; Command to run at start of REPL + static mal_startup_header, db "(println (str ",34,"Mal [",34," *host-language* ",34,"]",34,"))" + +section .text + + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + +;; ---------------------------------------------- +;; Evaluates a form +;; +;; Inputs: RSI Form to evaluate +;; RDI Environment +;; Returns: Result in RAX +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) +;; +eval: + push rdi ; save environment + mov r15, rsi ; save form + + mov rsi, rdi ; look for DEBUG-EVAL in environment + mov rdi, debug_eval + call env_get + jne .debug_eval_finished + mov bl, BYTE [rax] ; Get type of result + mov cl, bl + and cl, content_mask + cmp cl, content_pointer + je .debug_eval_release_pointer + cmp bl, maltype_nil + je .debug_eval_finished + cmp bl, maltype_false + je .debug_eval_finished + + print_str_mac eval_debug_string ; -> rsi, rdx -> + mov rdi, 1 + mov rsi, r15 ; ast + call pr_str ; rdi, rsi -> rcx, r8, r12, r13, r14 -> rax + mov rsi, rax + call print_string ; rsi -> -> + call release_array ; rsi -> [rsi], rax, rbx -> + print_str_mac eval_debug_cr ; -> rsi, rdx -> + jmp .debug_eval_finished +.debug_eval_release_pointer: + mov rsi, rax + call release_object +.debug_eval_finished: + mov rsi, r15 ; restore form + pop rdi ; restore environment + + mov r15, rdi ; Save Env in r15 + + push rsi ; AST pushed, must be popped before return + + ; Check the type + mov al, BYTE [rsi] + + ; Check if this is a list + mov ah, al + and ah, container_mask + cmp ah, container_list + je .list + + cmp ah, container_map + je .map + + cmp ah, container_vector + je .vector + + ; Not a list, map or vector + cmp ah, container_symbol + je .symbol + + ; Not a symbol, list, map or vector + call incref_object ; Increment reference count + + mov rax, rsi + jmp .return + +.symbol: + ; Check if first character of symbol is ':' + mov al, BYTE [rsi + Array.data] + cmp al, ':' + je .keyword + + ; look in environment + push rsi + xchg rsi, rdi + ; symbol is the key in rdi + ; Environment in rsi + call env_get + pop rsi + je .done ; result in RAX + + ; Not found, throw an error + mov r11, rsi ; Symbol in R11 + + call string_new + mov rsi, rax ; New string in RSI + + mov cl, 39 ; quote ' + call string_append_char + + mov rdx, r11 ; symbol + call string_append_string + + mov cl, 39 + call string_append_char + + mov r11, rsi + + mov rsi, not_found_string + mov edx, not_found_string.len + call raw_to_string ; ' not found' + + mov r12, rax + + mov rdx, rax + mov rsi, r11 + call string_append_string + + mov r11, rsi + mov rsi, r12 + call release_array + mov rsi, r11 + + jmp error_throw + + ; ------------------------------ + +.keyword: + ; Just return keywords unaltered + call incref_object + mov rax, rsi + jmp .return + + ; ------------------------------ +.list_map_eval: + + ;; Some code is duplicated for the first element because + ;; the iteration must stop if its evaluation products a macro, + ;; else a new list must be constructed. + + ; Evaluate first element of the list + + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer_first + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append_first +.list_pointer_first: + ; List element is a pointer to something + push rsi + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + ;; If the evaluated first element is a macro, exit the loop. + cmp bl, maltype_macro + je macroexpand + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value_first + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append_first + +.list_eval_value_first: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + ; Fall through to .list_append_first +.list_append_first: + ; In RAX + ; r8 contains the head of the constructed list + ; append to r9 + mov r8, rax + mov r9, rax +.list_loop: + ; Evaluate each element of the remaining list + + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append + +.list_pointer: + ; List element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append + +.list_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + + ; Fall through to .list_append +.list_append: + ; In RAX + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .list_loop + +.list_done: + mov rax, r8 ; Return the list + jmp eval.return_from_list_map_eval + + ; --------------------- +.map: + ; Create a new map, evaluating all the values + + ; Check if the map is empty + cmp al, maltype_empty_map + jne .map_not_empty + + ; map empty. Just return it + call incref_object + mov rax, rsi + jmp .return + +.map_not_empty: + + mov r10, rsi ; input in R10 + xor r12, r12 ; New map in r12 + + ; Now loop through each key-value pair + ; NOTE: This method relies on the implementation + ; of map as a list + +.map_loop: + ; Copy the key + call alloc_cons ; New Cons in RAX + + mov bl, [r10 + Cons.typecar] ; Type in BL + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] ; Value in RCX + mov [rax + Cons.car], rcx + + ; Check the type of the key + and bl, content_mask + cmp bl, content_pointer + jne .map_got_key ; a value + + ; a pointer, so increment reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.map_got_key: + cmp r12,0 + jne .append_key + + ; First key + mov r12, rax + mov r13, rax + jmp .map_value + +.append_key: + ; Appending to previous value in r13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + +.map_value: + ; Check that we have a value + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_error_missing_value + mov r10, [r10 + Cons.cdr] + + ; Now got value in r10 + + ; Check the type of the value + mov bl, [r10 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .map_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r10 + Cons.typecar] + mov [rax + Cons.typecar], bl + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .map_got_value +.map_value_pointer: + ; A pointer, so need to evaluate + push r10 ; Input + push r12 ; start of result + push r13 ; Current head of result + push r15 ; Env + mov rsi, [r10 + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r13 + pop r12 + pop r10 + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + + jne .map_eval_pointer + + ; A value, so just change the type to a map + and bl, content_mask + add bl, (block_cons + container_map) + mov [rax], BYTE bl + jmp .map_got_value + +.map_eval_pointer: + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + +.map_got_value: + ; Append RAX to list in R13 + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax + mov r13, rax + + ; Check if there's another key + mov al, BYTE [r10 + Cons.typecdr] + cmp al, content_pointer + jne .map_done ; finished map + mov r10, [r10 + Cons.cdr] ; next in map + jmp .map_loop + +.map_done: + mov rax, r12 + jmp .return + +.map_error_missing_value: + mov rax, r12 + jmp .return + + ; ------------------------------ +.vector: + ; Evaluate each element of the vector + ; + xor r8, r8 ; The vector to return + ; r9 contains head of vector + +.vector_loop: + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .vector_pointer + + ; A value, so copy + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_vector) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .vector_append + +.vector_pointer: + ; Vector element is a pointer to something + push rsi + push r8 + push r9 + push r15 ; Env + mov rsi, [rsi + Cons.car] ; Get the address + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi + + call incref_object + + call eval ; Evaluate it, result in rax + pop r15 + pop r9 + pop r8 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .vector_eval_value + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_vector + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .vector_append + +.vector_eval_value: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_vector) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + +.vector_append: + ; In RAX + + cmp r8, 0 ; Check if this is the first + je .vector_first + + ; append to r9 + mov [r9 + Cons.cdr], rax + mov [r9 + Cons.typecdr], BYTE content_pointer + mov r9, rax + jmp .vector_next + +.vector_first: + mov r8, rax + mov r9, rax + ; fall through to .vector_next + +.vector_next: + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .vector_done ; finished vector + mov rsi, [rsi + Cons.cdr] ; next in vector + jmp .vector_loop + +.vector_done: + mov rax, r8 ; Return the vector + jmp .return + + ; --------------------- +.done: + jmp .return ; Releases Env + + + +;; Comparison of symbols for eval function +;; Compares the symbol in RSI with specified symbol +;; Preserves RSI and RBX +;; Modifies RDI +%macro eval_cmp_symbol 1 + push rsi + push rbx + mov rsi, rbx + mov rdi, %1 + call compare_char_array + pop rbx + pop rsi + test rax, rax ; ZF set if rax = 0 (equal) +%endmacro + + ; -------------------- +.list: + ; A list + + ; Check if + ; the first element is a symbol + cmp al, maltype_empty_list + je .empty_list ; empty list, return unchanged + + and al, content_mask + cmp al, content_pointer + jne .list_eval + + mov rbx, [rsi + Cons.car] + mov al, BYTE [rbx] + cmp al, maltype_symbol + jne .list_eval + + ; Is a symbol, address in RBX + + ; Compare against special form symbols + + eval_cmp_symbol def_symbol ; def! + je .def_symbol + + eval_cmp_symbol let_symbol ; let* + je .let_symbol + + eval_cmp_symbol do_symbol ; do + je .do_symbol + + eval_cmp_symbol if_symbol ; if + je .if_symbol + + eval_cmp_symbol fn_symbol ; fn + je .fn_symbol + + eval_cmp_symbol quote_symbol ; quote + je .quote_symbol + + eval_cmp_symbol quasiquote_symbol ; quasiquote + je .quasiquote_symbol + + eval_cmp_symbol defmacro_symbol ; defmacro! + je .defmacro_symbol + + eval_cmp_symbol try_symbol ; try* + je .try_symbol + + ; Unrecognised + jmp .list_eval + + + ; ----------------------------- + +.defmacro_symbol: + mov r9, 1 + jmp .def_common +.def_symbol: + xor r9, r9 ; Set R9 to 0 +.def_common: + ; Define a new symbol in current environment + ; If R9 is set to 1 then defmacro + + ; Next item should be a symbol + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Now should have a symbol + + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + jne .def_error_expecting_symbol + mov r8, [rsi + Cons.car] ; Symbol (?) + + mov al, BYTE [r8] + cmp al, maltype_symbol + jne .def_error_expecting_symbol + + ; R8 now contains a symbol + + ; expecting a value or pointer next + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .def_error_missing_arg + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a pointer + mov al, BYTE [rsi] + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .def_pointer + + ; A value, so copy + + ; Test if this is defmacro! + test r9, r9 + jnz .defmacro_not_function + + push rax + call alloc_cons + pop rbx ; BL now contains type + and bl, content_mask + add bl, (block_cons + container_value) + mov [rax], BYTE bl + mov rcx, [rsi + Cons.car] + mov [rax + Cons.car], rcx + mov rsi, rax + + jmp .def_got_value + +.def_pointer: + ; A pointer, so evaluate + + ; This may throw an error, so define a handler + + push r8 ; the symbol + push r15 ; Env + push r9 + mov rsi, [rsi + Cons.car] ; Pointer + mov rdi, r15 + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call incref_object ; AST increment refs + + call eval + mov rsi, rax + + pop r9 + + ; If this is defmacro, and the object in RSI is a function, + ; then change to a macro + test r9, r9 + jz .def_not_macro ; Not defmacro + + ; Check RSI + mov al, BYTE [rsi] + cmp al, maltype_function + jne .defmacro_not_function + + ; Got a function, change to macro + mov [rsi], BYTE maltype_macro + +.def_not_macro: + + pop r15 + pop r8 + +.def_got_value: + ; Symbol in R8, value in RSI + mov rdi, r8 ; key (symbol) + mov rcx, rsi ; Value + mov rsi, r15 ; Environment + call env_set + + mov rax, rcx + jmp .return + +.def_error_missing_arg: + mov rsi, def_missing_arg_string + mov rdx, def_missing_arg_string.len + jmp .def_handle_error + +.def_error_expecting_symbol: + mov rsi, def_expecting_symbol_string + mov rdx, def_expecting_symbol_string.len + jmp .def_handle_error + +.defmacro_not_function: + mov rsi, defmacro_expecting_function_string + mov rdx, defmacro_expecting_function_string.len + jmp .def_handle_error + +.def_handle_error: + push rsi + push rdx + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + xor rsi, rsi ; no object to throw + jmp error_throw ; No return + + ; ----------------------------- +.let_symbol: + ; Create a new environment + + mov r11, rsi ; Let form in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + mov r14, rax ; New environment in R14 + + mov rsi, r15 + call release_object ; Decrement R15 ref count + + ; Second element should be the bindings + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_bindings + mov r11, [r11 + Cons.cdr] + + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .let_error_bindings_list + + mov r12, [r11 + Cons.car] ; should be bindings list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + ; Can be either a list or vector + cmp al, block_cons + container_list + je .let_bind_loop + cmp al, block_cons + container_vector + je .let_bind_loop + + ; Not a list or vector + jmp .let_error_bindings_list + +.let_bind_loop: + ; R12 now contains a list with an even number of items + ; The first should be a symbol, then a value to evaluate + + ; Get the symbol + mov al, BYTE [r12] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_symbol + + mov r13, [r12 + Cons.car] ; Symbol (?) + mov al, BYTE [r13] + cmp al, maltype_symbol + jne .let_error_bind_symbol + + ; R13 now contains a symbol to bind + ; The next item in the bindings list (R12) + ; should be a value or expression to evaluate + + mov al, BYTE [r12 + Cons.typecdr] + and al, content_mask + cmp al, content_pointer + jne .let_error_bind_value + mov r12, [r12 + Cons.cdr] + + ; got value in R12 + + ; Check the type of the value + mov bl, [r12 + Cons.typecar] ; Type in BL + and bl, content_mask + cmp bl, content_pointer + je .let_value_pointer + + ; Not a pointer, so make a copy + call alloc_cons + mov bl, [r12 + Cons.typecar] + and bl, content_mask + ;or bl, (block_cons + container_value) ; 0 + mov [rax + Cons.typecar], bl + mov rcx, [r12 + Cons.car] + mov [rax + Cons.car], rcx + + jmp .let_got_value + +.let_value_pointer: + ; A pointer, so need to evaluate + push r11 ; let* form list + push r12 ; Position in bindings list + push r13 ; symbol to bind + push r14 ; new environment + + mov rsi, r14 + call incref_object + mov rdi, r14 + + mov rsi, [r12 + Cons.car] ; Get the address + + call incref_object ; Increment ref count of AST + + call eval ; Evaluate it, result in rax + pop r14 + pop r13 + pop r12 + pop r11 + +.let_got_value: + + mov rsi, r14 ; Env + mov rdi, r13 ; key + mov rcx, rax ; value + call env_set + + ; Release the value + mov rsi, rcx ; The value + call release_object + + ; Check if there are more bindings + mov al, BYTE [r12 + Cons.typecdr] + cmp al, content_pointer + jne .let_done_binding + mov r12, [r12 + Cons.cdr] ; Next + jmp .let_bind_loop + +.let_done_binding: + ; Done bindings. + ; Evaluate next item in let* form in new environment + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .let_error_missing_body + mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate + ; Check type of the value + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + je .body_pointer + + ; Just a value, so copy + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl ; set type + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx ; copy value + jmp .let_done + +.body_pointer: + ; Evaluate using new environment + + mov rsi, [r11 + Cons.car] ; Object pointed to + call incref_object ; will be released by eval + + mov r11, rsi ; save new AST + pop rsi ; Old AST + call release_object + mov rsi, r11 ; New AST + + mov rdi, r14 ; New environment + + jmp eval ; Tail call + ; Note: eval will release the new environment on return + +.let_done: + ; Release the new environment + push rax + mov rsi, r14 + call release_object + pop rax + + ; Release the AST + pop rsi + push rax + call release_object + pop rax + ret ; already released env + +.let_error_missing_bindings: + mov rsi, let_missing_bindings_string + mov rdx, let_missing_bindings_string.len + jmp .let_handle_error + +.let_error_bindings_list: ; expected a list or vector, got something else + mov rsi, let_bindings_list_string + mov rdx, let_bindings_list_string.len + jmp .let_handle_error + +.let_error_bind_symbol: ; expected a symbol, got something else + mov rsi, let_bind_symbol_string + mov rdx, let_bind_symbol_string.len + jmp .let_handle_error + +.let_error_bind_value: ; Missing value in binding list + mov rsi, let_bind_value_string + mov rdx, let_bind_value_string.len + jmp .let_handle_error + +.let_error_missing_body: ; Missing body to evaluate + mov rsi, let_missing_body_string + mov rdx, let_missing_body_string.len + jmp .let_handle_error + +.let_handle_error: + push r11 ; For printing later + + push rsi + push rdx + + print_str_mac error_string ; print 'Error: ' + + pop rdx + pop rsi + call print_rawstring ; print message + + pop rsi ; let* form + jmp error_throw ; No return + + ; ----------------------------- + +.do_symbol: + mov r11, rsi ; do form in RSI + ; Environment in R15 + + ; Check if there is a body + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .do_no_body ; error + + mov r11, [r11 + Cons.cdr] ; Body in R11 + +.do_symbol_loop: + + ; Need to test if this is the last form + ; so we can handle tail call + + mov bl, BYTE [r11 + Cons.typecdr] + cmp bl, content_pointer + jne .do_body_last ; Last expression + + ; not the last expression + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_next ; A value, so skip + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + ; since eval will release Env + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increment ref count since eval will release + + mov rdi, r15 ; Env + call eval ; Result in RAX + + ; Another form after this. + ; Discard the result of the last eval + mov rsi, rax + call release_object + + pop r11 + pop r15 + +.do_next: + mov r11, [r11 + Cons.cdr] ; Next in list + + jmp .do_symbol_loop + +.do_body_last: + ; The last form is in R11, which will be returned + + ; Check if this is a value or pointer + mov al, BYTE [r11] + and al, block_mask + content_mask + cmp al, content_pointer + jne .do_body_value_return + jmp .do_body_expr_return + +.do_body_value_return: + ; Got a value as last form (in R11). + ; Copy and return + + push rax ; Type of value to return + + ; release Env + mov rsi, r15 + call release_object + + ; Allocate a Cons object to hold value + call alloc_cons + pop rbx ; type in BL + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + ; release the AST + pop rsi + mov r15, rax ; not modified by release + call release_object + mov rax, r15 + + ret + +.do_body_expr_return: + ; An expression to evaluate as the last form + ; Tail call optimise, jumping to eval + ; Don't increment Env reference count + + mov rsi, [r11 + Cons.car] ; new AST form + call incref_object ; This will be released by eval + + mov r11, rsi ; Save new AST + pop rsi ; Remove old AST from stack + call release_object + mov rsi, r11 + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.do_no_body: + ; No expressions to evaluate. Return nil + + mov rsi, r15 + call release_object ; Release Env + + ; release the AST + pop rsi + call release_object + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + + ; ----------------------------- + +.if_symbol: + mov r11, rsi ; if form in R11 + ; Environment in R15 + + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .if_no_condition + + mov r11, [r11 + Cons.cdr] ; Should be a condition + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .if_cond_value + + ; A pointer, so evaluate + + push r15 + push r11 + + mov rsi, r15 + call incref_object ; Increase Env reference + + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Increase Form/AST ref count + + mov rdi, r15 ; Env + call eval ; Result in RAX + pop r11 + pop r15 + + ; Get type of result + mov bl, BYTE [rax] + + ; release value + push rbx + mov rsi, rax + call release_object + pop rbx + + ; Check type + cmp bl, maltype_nil + je .if_false + cmp bl, maltype_false + je .if_false + + jmp .if_true + +.if_cond_value: + + ; A value + cmp al, content_nil + je .if_false + cmp al, content_false + je .if_false + + jmp .if_true + +.if_false: + ; Skip the next item + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil + + mov r11, [r11 + Cons.cdr] + +.if_true: + ; Get the next item in the list and evaluate it + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; Nothing to return + + mov r11, [r11 + Cons.cdr] + + ; Check if value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + je .if_got_pointer + +.if_got_value: + ; copy value in r11 + call alloc_cons + mov bl, BYTE [r11] + and bl, content_mask + mov [rax], BYTE bl + mov rbx, [r11 + Cons.car] + mov [rax + Cons.car], rbx + + jmp .return + +.if_got_pointer: + mov rsi, [r11 + Cons.car] ; Form + call incref_object ; Will be released by eval + + mov r11, rsi + pop rsi + call release_object ; Release old AST + mov rsi, r11 ; New AST + + mov rdi, r15 ; Env + jmp eval ; Tail call + +.if_no_condition: ; just (if) without a condition + + print_str_mac error_string + print_str_mac if_missing_condition_string + + ; Release environment + mov rsi, r15 + call release_object + xor rsi, rsi ; No object to throw + jmp error_throw + +.return_nil: + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + +.return: + ; Release environment + mov rsi, r15 + mov r15, rax ; Save RAX (return value) + call release_object + + ; Release the AST + pop rsi ; Pushed at start of eval + call release_object + + mov rax, r15 ; return value + ret + + ; ----------------------------- + +.fn_symbol: + mov r11, rsi ; fn form in R11 + ; Environment in R15 + + ; Get the binds and body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_empty + + mov r11, [r11 + Cons.cdr] + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_binds_not_list + + mov r12, [r11 + Cons.car] ; Should be binds list + mov al, BYTE [r12] + and al, (block_mask + container_mask) + cmp al, (block_cons + container_list) + je .fn_got_binds ; Can be list + cmp al, (block_cons + container_vector) + je .fn_got_binds ; or vector + jmp .fn_binds_not_list + +.fn_got_binds: + + ; Next get the body of the function + mov al, BYTE [r11 + Cons.typecdr] + cmp al, content_pointer + jne .fn_no_body + + mov r11, [r11 + Cons.cdr] + ; Check value or pointer + mov al, BYTE [r11] + and al, content_mask + cmp al, content_pointer + jne .fn_is_value ; Body in r11 + mov r11, [r11 + Cons.car] + jmp .fn_got_body + +.fn_is_value: + ; Body is just a value, no expression + mov [r11], BYTE al ; Mark as value, not list + +.fn_got_body: + + ; Now put into function type + ; Addr is "apply_fn", the address to call + ; Env in R15 + ; Binds in R12 + ; Body in R11 + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_function) + mov rbx, apply_fn + mov [rax + Cons.car], rbx ; Address of apply function + mov [rax + Cons.typecdr], BYTE content_pointer + + mov r13, rax ; Return list in R13 + + ; Meta + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r13 + Cons.cdr], rax ; Append + mov r14, rax + + ; Env + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r15 ; Environment + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax ; R14 contains last cons in list + + push rax + mov rsi, r15 + call incref_object + pop rax + + ; Binds + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r12 ; Binds list + mov [rax + Cons.typecdr], BYTE content_pointer + + mov [r14 + Cons.cdr], rax ; Append to list + mov r14, rax + + push rax + mov rsi, r12 + call incref_object + pop rax + + call alloc_cons + mov [rax], BYTE (block_cons + container_function + content_pointer) + mov [rax + Cons.car], r11 ; Body of function + + mov [r14 + Cons.cdr], rax + + mov rsi, r11 + call incref_object + + mov rax, r13 + jmp .return + +.fn_empty: +.fn_binds_not_list: +.fn_no_body: + + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + jmp .return + + ; ----------------------------- + +.quote_symbol: + ; Just return the arguments in rsi cdr + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quote empty, so return nil + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + call incref_object + mov rax, rsi + jmp .return + + ; ----------------------------- + +.quasiquote_symbol: + ; call quasiquote function with first argument + + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; quasiquote empty, so return nil + + mov r11, rsi ; Save original AST in R11 + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .quasiquote_pointer + + ; RSI contains a value. Remove the list container + mov [rsi + Cons.typecar], BYTE al + call incref_object + mov rax, rsi + jmp .return + +.quasiquote_pointer: + ; RSI contains a pointer, so get the object pointed to + mov rsi, [rsi + Cons.car] + + push r15 ; Environment + ; Original AST already on stack + + call quasiquote + ; New AST in RAX + pop rdi ; Environment + pop rsi ; Old AST + + mov r11, rax ; New AST + call release_object ; Release old AST + mov rsi, r11 ; New AST in RSI + + jmp eval ; Tail call + + ; ----------------------------- + +.try_symbol: + ; Should have the form + ; + ; (try* A (catch* B C)) + ; + ; where B is a symbol, A and C are forms to evaluate + + ; Check first arg A + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .return_nil ; No argument + + mov rsi, [rsi + Cons.cdr] + + ; Check if this is a value or pointer + mov al, BYTE [rsi + Cons.typecar] + and al, content_mask + cmp al, content_pointer + je .try_pointer + + ; RSI contains a value. Copy and return + mov cl, al + call alloc_cons + mov [rax], BYTE cl ; Set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx + jmp .return + +.try_pointer: + + mov r8, [rsi + Cons.car] ; form A in R8 + + ; Check second arg B + + mov al, BYTE [rsi + Cons.typecdr] + ; If nil (catchless try) + cmp al, content_nil + je .catchless_try + + cmp al, content_pointer + jne .try_missing_catch + + mov rsi, [rsi + Cons.cdr] + + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .try_missing_catch + + mov r9, [rsi + Cons.car] ; (catch* B C) in R9 + + mov al, BYTE [r9] + cmp al, (container_list + content_pointer) + jne .try_missing_catch + + mov rsi, [r9 + Cons.car] ; Should be catch* symbol + mov al, BYTE [rsi] + cmp al, maltype_symbol + jne .try_missing_catch + + mov rdi, catch_symbol + call compare_char_array + test rax, rax ; ZF set if rax = 0 (equal) + jnz .try_missing_catch + + ; Check that B is a symbol + mov al, [r9 + Cons.typecdr] + cmp al, content_pointer + jne .catch_missing_symbol + + mov r9, [r9 + Cons.cdr] ; (B C) in R9 + + mov al, BYTE [r9] + and al, content_mask + cmp al, content_pointer + jne .catch_missing_symbol + + mov r10, [r9 + Cons.car] ; B in R10 + mov al, BYTE [r10] + cmp al, maltype_symbol + jne .catch_missing_symbol + + mov al, BYTE [r9 + Cons.typecdr] + cmp al, content_pointer + jne .catch_missing_form + mov r9, [r9 + Cons.cdr] ; C in R9 + + ; Now have extracted from (try* A (catch* B C)) + ; A in R8 + ; B in R10 + ; C in R9 + + push R9 + push R10 + push r15 ; Env + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the form in R8 + mov rsi, r15 + call incref_object ; Env released by eval + mov rdi, r15 ; Env in RDI + + mov rsi, r8 ; The form to evaluate (A) + + call incref_object ; AST released by eval + + call eval + + mov r8, rax ; Result in R8 + + pop r15 ; Environment + ; Discard B and C + ;add rsi, 8 ; pop R10 and R9 + pop r10 + pop r9 + + ; Remove error handler + call error_handler_pop + mov rax, r8 + jmp .return + +.catchless_try: + ;; Evaluate the form in R8 + push r15 ; Environment + + mov rsi, r15 + call incref_object ; Env released by eval + mov rdi, r15 ; Env in RDI + + mov rsi, r8 ; The form to evaluate (A) + + call incref_object ; AST released by eval + + call eval ; Result in RAX + + pop r15 ; Environment + + jmp .return +.catch: + ; Jumps here on error + ; Value thrown in RSI + ; + + push rsi + call error_handler_pop + pop rsi + + pop r15 ; Env + pop r12 ; B (symbol to bind) + pop r13 ; C (form to evaluate) + + ; Check if C is a value or pointer + + mov cl, BYTE [r13] + and cl, content_mask + cmp cl, content_pointer + je .catch_C_pointer + + ; A value, so copy and return + call alloc_cons + mov [rax], BYTE cl ; Set type + mov rbx, [r13 + Cons.car] + mov [rax + Cons.car], rbx ; Set value + + jmp .return + +.catch_C_pointer: + + mov r11, rsi ; Value thrown in R11 + + mov rsi, r15 ; Outer env + call env_new ; Increments R15's ref count + + mov rsi, rax ; New environment in RSI + mov rdi, r12 ; key (symbol) + mov rcx, r11 ; value + call env_set + + mov rdi, rsi ; Env in RDI (will be released) + mov rsi, [r13 + Cons.car] ; Form to evaluate + call incref_object ; will be released + + push r15 + call eval + pop r15 + + jmp .return + +.try_missing_catch: + load_static try_missing_catch + call raw_to_string + mov rsi, rax + jmp error_throw + +.catch_missing_symbol: + load_static catch_missing_symbol + call raw_to_string + mov rsi, rax + jmp error_throw + +.catch_missing_form: + load_static catch_missing_form + call raw_to_string + mov rsi, rax + jmp error_throw + + ; ----------------------------- + +.list_eval: + push rsi + mov rdi, r15 ; Environment + push r15 + jmp .list_map_eval ; List of evaluated forms in RAX +.return_from_list_map_eval + pop r15 + pop rsi + +.list_exec: + ; This point can be called to run a function + ; used by swap! + ; + ; Inputs: RAX - List with function as first element + ; NOTE: This list is released + ; + ; Check that the first element of the return is a function + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .list_not_function + + mov rbx, [rax + Cons.car] ; Get the address + mov cl, BYTE [rbx] + cmp cl, maltype_function + jne .list_not_function + + ; Check the rest of the args + mov cl, BYTE [rax + Cons.typecdr] + cmp cl, content_pointer + je .list_got_args + + ; No arguments + push rbx ; Function object + push rax ; List with function first + + ; Create an empty list for the arguments + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax ; Argument list into RSI + + pop rax ; list, function first + ;; Put new empty list onto end of original list + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.cdr], rsi + + pop rbx + jmp .list_function_call +.list_got_args: + mov rsi, [rax + Cons.cdr] ; Rest of list +.list_function_call: + ; Call the function with the rest of the list in RSI + + mov rdx, rax ; List to release + mov rdi, rbx ; Function object in RDI + + mov rbx, [rbx + Cons.car] ; Call function + cmp rbx, apply_fn + je apply_fn_jmp ; Jump to user function apply + + ; A built-in function, so call (no recursion) + push rax + push r15 + + call rbx + + ; Result in rax + pop r15 + pop rsi ; eval'ed list + + push rax + call release_cons + pop rax + jmp .return ; Releases Env + +.list_not_function: + ; Not a function. Probably an error + push rsi + + mov rsi, rax + call release_object + + print_str_mac error_string + print_str_mac eval_list_not_function + pop rsi + jmp error_throw + +.empty_list: + mov rax, rsi + jmp .return + +;; Applies a user-defined function +;; +;; Input: RSI - Arguments to bind +;; RDI - Function object +;; RDX - list to release after binding +;; R15 - Env (will be released) +;; R13 - AST released before return +;; +;; +;; Output: Result in RAX +;; +;; This is jumped to from eval, so if it returns +;; then it will return to the caller of eval, not to eval +apply_fn_jmp: + ; This is jumped to from eval with AST on the stack + pop r13 +apply_fn: + push rsi + ; Extract values from the list in RDI + mov rax, [rdi + Cons.cdr] + mov rax, [rax + Cons.cdr] ; Meta (don't need) + mov rsi, [rax + Cons.car] ; Env + mov rax, [rax + Cons.cdr] + mov rdi, [rax + Cons.car] ; Binds + mov rax, [rax + Cons.cdr] + mov rax, [rax + Cons.car] ; Body + pop rcx ; Exprs + + ; Check the type of the body + mov bl, BYTE [rax] + and bl, block_mask + container_mask + jnz .bind + ; Just a value (in RAX). No eval needed + + mov r14, rax ; Save return value in R14 + + mov rsi, rax + call incref_object + + ; Release the list passed in RDX + mov rsi, rdx + call release_object + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the AST + mov rsi, r13 + call release_object + + mov rax, r14 + ret +.bind: + ; Create a new environment, binding arguments + push rax ; Body + + mov r14, r13 ; Old AST. R13 used by env_new_bind + + push rdx + call env_new_bind + pop rdx + + mov rdi, rax ; New environment in RDI + + ; Note: Need to increment the reference count + ; of the function body before releasing anything, + ; since if the function was defined in-place (lambda) + ; then the body may be released early + + pop rsi ; Body + call incref_object ; Will be released by eval + mov r8, rsi ; Body in R8 + + ; Release the list passed in RDX + mov rsi, rdx + call release_cons + + ; Release the environment + mov rsi, r15 + call release_object + + ; Release the old AST + mov rsi, r14 + call release_object + + mov rsi, r8 ; Body + + jmp eval ; Tail call + ; The new environment (in RDI) will be released by eval + + +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX +quasiquote: + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged + call incref_object + mov rax, rsi + ret + +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr + + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr + + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + + ;; If so, return the argument. + mov rsi, [rsi + Cons.cdr] + call car_and_incref + mov rax, rsi + ret + +.map: +.symbol: + call incref_object + + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. + mov al, BYTE [rsi + Cons.typecdr] + +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then + mov rsi, [rsi + Cons.cdr] + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + mov rdx, rax + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, concat_symbol + call incref_object + + ;; rax := ('concat elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +;; Expands macro calls +;; +;; A part of eval, written here for historical reasons. +;; RSI: AST, a non-empty list (released and replaced) +;; RAX: evaluated first element of AST, a macro +;; R15: env +macroexpand: + mov r13, rsi + + mov rdi, rax ; Macro in RDI + + ; Check the rest of the args + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + je .got_args + + ; No arguments. Create an empty list + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rdx, rax + + mov rsi, rdx ; Arguments (empty list) + call incref_object + jmp .macro_call +.got_args: + mov rsi, [rsi + Cons.cdr] ; Rest of list + call incref_object + mov rdx, rsi ; Released +.macro_call: + ; Here have: + ; RSI - Arguments + ; RDI - Macro object + ; RDX - List to release + ; R15 - Environment + ; R13 - AST + + ; Increment reference for Environment + ; since this will be released by apply_fn + xchg rsi, r15 + call incref_object + xchg rsi, r15 + + call apply_fn + + mov rsi, rax ; Result in RSI + pop rdi ; env pushed as r15 by .list_eval + pop rax ; (ignored) ast pushed as r15 by .list_eval + pop rax ; (ignored) ast pushed as rsi by eval + jmp eval + +;; Read and eval +read_eval: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + jmp eval ; This releases Env and Form/AST + + +;; Read-Eval-Print in sequence +;; +;; Input string in RSI +rep_seq: + ; ------------- + ; Read + call read_str + + ; ------------- + ; Eval + mov rsi, rax ; Form to evaluate + mov rdi, [repl_env] ; Environment + + xchg rsi, rdi + call incref_object ; Environment increment refs + xchg rsi, rdi ; since it will be decremented by eval + + call eval ; This releases Env and Form/AST + push rax ; Save result of eval + + ; ------------- + ; Print + + mov rsi, rax ; Output of eval into input of print + mov rdi, 1 ; print readably + call pr_str ; String in RAX + + mov r8, rax ; Save output + + pop rsi ; Result from eval + call release_object + mov rax, r8 + + ret + + +_start: + ; Create and print the core environment + call core_environment ; Environment in RAX + + mov [repl_env], rax ; store in memory + + ; Set the error handler + mov rsi, rsp ; Stack pointer + mov rdi, .catch ; Address to jump to + xor rcx, rcx ; No data + call error_handler_push + + ; Evaluate the startup string + + mov rsi, mal_startup_string + mov edx, mal_startup_string.len + call raw_to_string ; String in RAX + + push rax + mov rsi, rax + call read_str ; AST in RAX + pop rsi ; string + + push rax ; AST + call release_array ; string + pop rdi ; AST in RDI + + mov rsi, [repl_env] ; Environment in RSI + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call eval + + mov rsi, rax + call release_object ; Return from eval + + ; ----------------------------- + ; Check command-line arguments + + pop rax ; Number of arguments + cmp rax, 1 ; Always have at least one, the path to executable + jg run_script + + ; No extra arguments, so just set *ARGV* to an empty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov rcx, rax ; value (empty list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + ; ----------------------------- + ; Header + + load_static mal_startup_header + call raw_to_string + push rax + + mov rsi, rax + call read_eval ; no print ('nil') + mov rsi, rax + call release_object ; Release result of eval + + ; Release the input string + pop rsi + call release_array + + ; ----------------------------- + ; Main loop + +.mainLoop: + ; print the prompt + print_str_mac prompt_string + + call read_line + + ; Check if we have a zero-length string + cmp DWORD [rax+Array.length], 0 + je .mainLoopEnd + + push rax ; Save address of the string + + mov rsi, rax + call rep_seq ; Read-Eval-Print + + push rax ; Save returned string + + mov rsi, rax ; Put into input of print_string + call print_string + + ; Release string from rep_seq + pop rsi + call release_array + + ; Release the input string + pop rsi + call release_array + + jmp .mainLoop +.mainLoopEnd: + + jmp quit + +.catch: + ; Jumps here on error + + ; Check if an object was thrown + cmp rsi, 0 + je .catch_done_print ; nothing to print + + push rsi + print_str_mac error_string ; print 'Error: ' + pop rsi + + mov rdi, 1 + call pr_str + mov rsi, rax + call print_string +.catch_done_print: + jmp .mainLoop ; Go back to the prompt + + + +run_script: + ; Called with number of command-line arguments in RAX + mov r8, rax + pop rbx ; executable + dec r8 + + pop rsi ; Address of first arg + call cstring_to_string ; string in RAX + mov r9, rax + + ; get the rest of the args + xor r10, r10 ; Zero + dec r8 + jz .no_args + + ; Got some arguments +.arg_loop: + ; Got an argument left. + pop rsi ; Address of C string + call cstring_to_string ; String in RAX + mov r12, rax + + ;Make a Cons to point to the string + call alloc_cons ; in RAX + mov [rax], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], r12 + + test r10, r10 + jnz .append + + ; R10 zero, so first arg + mov r10, rax ; Head of list + mov r11, rax ; Tail of list + jmp .next +.append: + ; R10 not zero, so append to list tail + mov [r11 + Cons.cdr], rax + mov [r11 + Cons.typecdr], BYTE content_pointer + mov r11, rax +.next: + dec r8 + jnz .arg_loop + jmp .got_args + +.no_args: + ; No arguments. Create an emoty list + call alloc_cons ; in RAX + mov [rax], BYTE maltype_empty_list + mov r10, rax + +.got_args: + push r9 ; File name string + + mov rcx, r10 ; value (list) + mov rdi, argv_symbol ; symbol (*ARGV*) + mov rsi, [repl_env] ; environment + call env_set + + mov rsi, run_script_string ; load-file function + mov edx, run_script_string.len + call raw_to_string ; String in RAX + + mov rsi, rax + pop rdx ; File name string + call string_append_string + + mov cl, 34 ; " + call string_append_char + mov cl, ')' + call string_append_char ; closing brace + + ; Read-Eval "(load-file )" + call read_eval + + jmp quit diff --git a/impls/nasm/system.asm b/impls/nasm/system.asm new file mode 100644 index 0000000000..e22ae13750 --- /dev/null +++ b/impls/nasm/system.asm @@ -0,0 +1,233 @@ +;;; System call functions +;;; +;;; This file contains system-specific functions, +;;; which use calls to the operating system (Linux) + +section .data + static error_open_file_string, db "Error opening file " + static error_read_file_string, db "Error reading file " + +section .bss + +timespec: RESQ 2 + +section .text + +;; ------------------------------------------- +;; Prints a raw string to stdout +;; String address in rsi, string length in rdx +print_rawstring: + push rax + push rdi + + ; write(1, string, length) + mov rax, 1 ; system call 1 is write + mov rdi, 1 ; file handle 1 is stdout + syscall + + pop rdi + pop rax + + ret + +;------------------------------------------ +; void exit() +; Exit program and restore resources +quit: + mov eax, 60 ; system call 60 is exit + xor rdi, rdi ; exit code 0 + syscall ; invoke operating system to exit + +quit_error: + mov eax, 60 ; system call 60 is exit + mov rdi, 1 ; exit code 1 + syscall + + +;; Read a line from stdin +;; Gets a new string array, fills it until a newline or EOF is reached +;; Returns pointer to string in RAX +read_line: + ; Get an array to put the string into + ; Address in rax + call alloc_array + ; Mark it as a character array (string) + mov BYTE [rax + Array.type], maltype_string + + push rax ; Save pointer to string + + ; Read character by character until either newline or end of input + mov ebx, 0 ; Count how many characters read + mov rsi, rax + add rsi, Array.data ; Point to the data +.readLoop: + mov rax, 0 ; sys_read + mov rdi, 0 ; stdin + mov rdx, 1 ; count + syscall + + ; Characters read in RAX + cmp rax, 0 ; end loop if read <= 0 + jle .readLoopEnd + + mov cl, BYTE [rsi] + + cmp cl, 10 ; End if we read a newline + je .readLoopEnd + + cmp cl, 8 ; Backspace? + je .handleBackspace + + cmp cl, 31 ; Below space + jle .readLoop ; Ignore, keep going + + cmp cl, 127 ; DEL or above + jge .readLoop ; Ignore, keep going + + inc ebx + inc rsi ; Move to next point in the array + jmp .readLoop ; Get another character + +.handleBackspace: + ; Check if we've read any characters + cmp ebx, 0 + je .readLoop ; If not, carry on the loop + ; Characters have been read. Remove one + dec ebx + dec rsi + jmp .readLoop +.readLoopEnd: + pop rax ; Restore pointer to string + mov DWORD [rax + Array.length], ebx ; Set string length + ret + +;; Reads a file into a string +;; +;; Input: RSI - File name string (char Array) +;; +;; Returns: string in RAX +;; +;; Pieces from https://stackoverflow.com/questions/20133698/how-to-read-from-and-write-to-files-using-nasm-for-x86-64bit +read_file: + + mov rdi, rsi ; Filename + + ; Need to add null terminator + mov eax, DWORD [rdi + Array.length] + cmp eax, (array_chunk_len * 8) + je .error_filename ; File name too long + + ; Insert a null terminator + add rax, rdi + mov [rax + Array.data], BYTE 0 + + ; Open the file + mov rax, 2 + add rdi, Array.data; filename in RDI + xor rsi, rsi ; O_RDONLY in RSI + syscall + + ; Check for error (return -1) + cmp eax, 0 + jl .error_open + + mov rdi, rax ; File handle in RDI + + ; Create a string + push rdi + call string_new ; In RAX + pop rdi + + mov r9, rax ; Current Array + push rax ; This is popped in .done +.loop: + ; Read next chunk + push r9 + + mov rsi, r9 + add rsi, Array.data ; address + + mov rax, 0 ; sys_read + ; file handle in RDI + mov rdx, (array_chunk_len * 8) ; count + syscall + + pop r9 + + ; Characters read in RAX + + cmp rax, 0 + jl .error_read + + cmp rax, (array_chunk_len * 8) + jg .error_read + + mov [r9 + Array.length], DWORD eax + + jl .done + + ; May still be more to read. + ; Allocate another + call string_new + mov [r9 + Array.next], rax + mov r9, rax + jmp .loop + +.done: + ; Close the file + mov rax, 3 + ;rdi = file handle + syscall + + pop rax + ret + +.error_filename: +.error_open: + ; File name in RDI + sub rdi, Array.data + + ; Make the error message + mov rsi, error_open_file_string + mov edx, error_open_file_string.len + call raw_to_string + mov rsi, rax + mov cl, 39 ; (') + call string_append_char + mov rdx, rdi ; file name + call string_append_string + mov cl, 39 + call string_append_char + + ; Error message in RSI + jmp error_throw + +.error_read: + mov rsi, error_read_file_string + mov edx, error_read_file_string.len + call raw_to_string + mov rsi, rax + jmp error_throw + + + +;; Returns the time in ms in RAX +clock_time_ms: + mov rax, 228 ; clock_gettime + mov rdi, 0 ; CLOCK_REALTIME + mov rsi, timespec + syscall + + mov rax, [timespec + 8] ; nanoseconds + cqo ; Sign extend RAX into RDX + mov rcx, 1000000 + idiv rcx ; Divide RAX by 1e6 -> ms + mov rbx, rax + ; -> ms in RBX + + mov rax, [timespec] ; Seconds + mov rcx, 1000 + imul rcx ; Convert to ms + add rax, rbx ; Add RBX + + ret diff --git a/impls/nasm/types.asm b/impls/nasm/types.asm new file mode 100644 index 0000000000..56de3cb1f0 --- /dev/null +++ b/impls/nasm/types.asm @@ -0,0 +1,1964 @@ +;; Data structures +;; =============== +;; +;; Memory management is done by having two fixed-size datatypes, +;; Cons and Array. +;; +;; Both Cons and Array have the following in common: +;; a type field at the start, a reference count, followed by data +;; [ type (8) | (8) | refs (16) | data ] +;; +;; +;; Type bit fields +;; --------------- +;; +;; The 8-bit type fields describe the Block, Container and Content type. +;; +;; The Block type is used for memory management, to determine the kind of memory block +;; The Container type indicates the data structure that the Cons or Array block is being used to represent +;; The Content type indicates the raw type of the data in the content +;; +;; Block type [1 bit]: +;; 0 0 - Cons memory block +;; 1 1 - Array memory block +;; +;; Container type [3 bits]: +;; 0 0 - Value (single boxed value for Cons blocks, multiple values for Array blocks). +;; 2 1 - List (value followed by pointer). Only for Cons blocks +;; 4 2 - Symbol (special char array). Only for Array blocks +;; 6 3 - Keyword. Only for Array blocks +;; 8 4 - Map +;; 10 5 - Function +;; 12 6 - Atom +;; 14 7 - Vector +;; +;; Content type [4 bits]: +;; 0 0 - Nil +;; 16 1 - True +;; 32 2 - Char +;; 48 3 - Int +;; 64 4 - Float +;; 80 5 - Pointer (memory address) +;; 96 6 - Function (instruction address) +;; 112 7 - Empty (distinct from Nil) +;; 208 8 - False +;; 224 9 - Macro +;; +;; +;; These represent MAL data types as follows: +;; +;; MAL type Block Container Content +;; --------- | -------- | ---------- | --------- +;; integer Cons Value Int +;; symbol Array Symbol Char +;; list Cons List Any +;; vector Cons Vector Any +;; nil Cons Value Nil +;; true Cons Value True +;; false Cons Value False +;; string Array Value Char +;; keyword Array Keyword Char +;; hash-map Cons Map Alternate key, values +;; atom Cons Atom Pointer +;; + +%include "macros.mac" + +;; Cons type. +;; Used to store either a single value with type information +;; or a pair of (value, Pointer or Nil) to represent a list +STRUC Cons +.typecar: RESB 1 ; Type information for car (8 bit) +.typecdr: RESB 1 ; Type information for cdr (8 bits) +.refcount: RESW 1 ; Number of references to this Cons (16 bit) +.car: RESQ 1 ; First value (64 bit) +.cdr: RESQ 1 ; Second value (64 bit) +.size: ; Total size of struc +ENDSTRUC + + +%define array_chunk_len 32 ; Number of 64-bit values which can be stored in a single chunk + +STRUC Array +.type: RESB 1 ; Type information (8 bits) +.control: RESB 1 ; Control data (8 bits) +.refcount: RESW 1 ; Number of references to this Array (16 bit) +.length: RESD 1 ; Number of elements in this part of the array (32 bit) +.next RESQ 1 ; Pointer to the next chunk (64 bit) +.data: RESQ array_chunk_len ; Data storage +.size: ; Total size of struc +ENDSTRUC + +;; Type information + +%define block_mask 1 ; LSB for block type +%define container_mask 2 + 4 + 8 ; Next three bits for container type +%define content_mask 16 + 32 + 64 + 128 ; Four bits for content type + +;; Block types +%define block_cons 0 ; Note: This must be zero +%define block_array 1 + +;; Container types +%define container_value 0 ; Note: This must be zero +%define container_list 2 +%define container_symbol 4 +%define container_keyword 6 +%define container_map 8 +%define container_function 10 +%define container_atom 12 +%define container_vector 14 + +;; Content type +%define content_nil 0 +%define content_true 16 +%define content_char 32 +%define content_int 48 +%define content_float 64 +%define content_pointer 80 ; Memory pointer (to Cons or Array) +%define content_function 96 ; Function pointer +%define content_empty 112 +%define content_false 208 +%define content_macro 224 + +;; Common combinations for MAL types +%define maltype_integer (block_cons + container_value + content_int) +%define maltype_string (block_array + container_value + content_char) +%define maltype_symbol (block_array + container_symbol + content_char) +%define maltype_nil (block_cons + container_value + content_nil) +%define maltype_empty_list (block_cons + container_list + content_empty) +%define maltype_empty_map (block_cons + container_map + content_empty) +%define maltype_empty_vector (block_cons + container_vector + content_empty) +%define maltype_function (block_cons + container_function + content_function) +%define maltype_macro (block_cons + container_function + content_macro) +%define maltype_true (block_cons + container_value + content_true) +%define maltype_false (block_cons + container_value + content_false) +%define maltype_atom (block_cons + container_atom + content_pointer) + +;; ------------------------------------------ + +section .data + +;; Fixed strings for printing + + static error_msg_print_string, db "Error in print string",10 + static error_array_memory_limit, db "Error: Run out of memory for Array objects. Increase heap_array_limit.",10 + static error_cons_memory_limit, db "Error: Run out of memory for Cons objects. Increase heap_cons_limit.",10 + + static error_cons_double_free, db "Error: double free error releasing Cons" + static error_array_double_free, db "Error: double free error releasing Array" + +;; ------------------------------------------ +;; Memory management +;; +;; For each object (Cons or Array), there is a block of memory (in BSS). +;; When an object is requested it is first taken from the free list +;; If the free list is empty (address 0) then the next object in the block +;; is used, and the heap_x_number counter is incremented. When an object +;; is free'd it is pushed onto the heap_x_free list. + + +%define heap_cons_limit 5000 ; Number of cons objects which can be created + +heap_cons_next: dq heap_cons_store ; Address of next cons in memory +heap_cons_free: dq 0 ; Address of start of free list + +%define heap_array_limit 2000 ; Number of array objects which can be created + +heap_array_next: dq heap_array_store +heap_array_free: dq 0 + +section .bss + +;; Reserve space to store Cons and Array objects +heap_cons_store: resb heap_cons_limit * Cons.size +.end: ; Address of end of the store + +heap_array_store: resb heap_array_limit * Array.size +.end: + +section .text + +;; ------------------------------------------ +;; Array alloc_array() +;; +;; Returns the address of an Array object in RAX +;; +;; Working registers: rbx +alloc_array: + + ; Get the address of a free array + mov rax, [heap_array_free] ; Address of the array + + ; Check if it's null + cmp rax, 0 + je .create_array + + mov rbx, [rax + Array.next] ; Get the address of the next array in the linked list + mov [heap_array_free], rbx ; Put this address at the front of the list + jmp .initialise_array + +.create_array: + + ; Get the address of the next Array + mov rax, [heap_array_next] + ; Check if we've reached the end + cmp rax, heap_array_store.end + je .out_of_memory + + mov rbx, rax + add rbx, Array.size ; Address of the next array + mov [heap_array_next], rbx ; for next time + +.initialise_array: + ; Address of Array now in rax + mov BYTE [rax + Array.type], block_array + mov WORD [rax + Array.refcount], 1 ; Only one reference + mov DWORD [rax + Array.length], 0 + mov QWORD [rax + Array.next], 0 ; null next address + + ret + +.out_of_memory: + mov rsi, error_array_memory_limit + mov rdx, error_array_memory_limit.len + call print_rawstring + jmp quit_error + + +;; ------------------------------------------- +;; Decrements the reference count of the array in RSI +;; If the count reaches zero then push the array +;; onto the free list +release_array: + mov ax, WORD [rsi + Array.refcount] + + ; Check if reference count is already zero + test ax,ax + jz .double_free + + dec ax + mov WORD [rsi + Array.refcount], ax + jz .free ; If the count reaches zero then put on free list + ret + +.free: + ; Get the next field + mov rbx, [rsi + Array.next] + + mov rax, [heap_array_free] ; Get the current head + mov [rsi + Array.next], rax ; Put current head into the "next" field + mov [heap_array_free], rsi ; Push Array onto free list + + cmp rbx, 0 + jne .release_next ; If there is another array, then need to release it + + ret + +.release_next: + ; release the next array + mov rsi, rbx + call release_array + ret + +.double_free: + ret + load_static error_cons_double_free + call raw_to_string + mov rsi, rax + jmp error_throw + +;; ------------------------------------------ +;; Cons alloc_cons() +;; +;; Returns the address of a Cons object in RAX +;; +;; Modifies: +;; RBX +alloc_cons: + + ; Get the address of a free cons + mov rax, [heap_cons_free] ; Address of the cons + + ; Check if it's null + cmp rax, 0 + je .create_cons + + mov rbx, [rax + Cons.cdr] ; Get the address of the next cons in the linked list + mov [heap_cons_free], rbx ; Put this address at the front of the list + jmp .initialise_cons + +.create_cons: + + ; Get the address of the next Cons + mov rax, [heap_cons_next] + ; Check if we've reached the end + cmp rax, heap_cons_store.end + je .out_of_memory + + mov rbx, rax + add rbx, Cons.size ; Address of the next cons + mov [heap_cons_next], rbx ; for next time + +.initialise_cons: + ; Address of Cons now in rax + mov BYTE [rax + Cons.typecar], 0 + mov BYTE [rax + Cons.typecdr], 0 + mov WORD [rax + Cons.refcount], 1 ; Only one reference + mov QWORD [rax + Cons.car], 0 + mov QWORD [rax + Cons.cdr], 0 + ret + +.out_of_memory: + mov rsi, error_cons_memory_limit + mov rdx, error_cons_memory_limit.len + call print_rawstring + jmp quit_error + + +;; ------------------------------------------- +;; Decrements the reference count of the cons in RSI +;; If the count reaches zero then push the cons +;; onto the free list +;; +;; Modifies registers: +;; RAX +;; RBX +;; RCX +;; +release_cons: + mov ax, WORD [rsi + Cons.refcount] + + ; Check if already released + test ax,ax + jz .double_free + + dec ax + mov WORD [rsi + Cons.refcount], ax + jz .free ; If the count reaches zero then put on free list + ret + +.free: + ; Get and push cdr onto stack + mov rcx, [rsi + Cons.cdr] + push rcx ; Content of CDR + push rsi ; Original Cons object being released + + mov rax, [heap_cons_free] ; Get the current head + mov [rsi + Cons.cdr], rax ; Put current head into the "cdr" field + mov [heap_cons_free], rsi ; Push Cons onto free list + + ; Check if the CAR needs to be released + + mov al, BYTE [rsi+Cons.typecar] + and al, content_mask ; Test content type + cmp al, content_pointer + jne .free_cdr ; Jump if CAR not pointer + + ; CAR is a pointer to either a Cons or Array + ; Get the address stored in CAR + mov rsi, [rsi + Cons.car] + call release_object +.free_cdr: + pop rcx ; This was rsi, the original Cons + pop rsi ; This was rcx, the original Cons.cdr + + ; Get the type from the original Cons + mov al, BYTE [rcx+Cons.typecdr] + and al, content_mask ; Test content type + cmp al, content_pointer + jne .done + + call release_object +.done: + ret + +.double_free: ; Already released + ret + load_static error_cons_double_free + call raw_to_string + mov rsi, rax + jmp error_throw + +;; Releases either a Cons or Array +;; Address of object in RSI +;; +;; May modify: +;; RAX +;; RBX +;; RCX +;; +release_object: + mov al, BYTE [rsi] ; Get first byte + and al, block_mask ; Test block type + cmp al, block_array ; Test if it's an array + je release_array + jmp release_cons + +;; Increment reference count of Cons or Array +;; Address of object in RSI +;; +;; This code makes use of the fact that the reference +;; count is in the same place in Cons and Array types +;; +;; Modifies +;; RAX +incref_object: + mov ax, WORD [rsi + Cons.refcount] ; Same for Array + inc ax + ; Check for overflow? + mov [rsi + Cons.refcount], WORD ax + ret + +;; ------------------------------------------- +;; Copying lists/vectors +;; This does a shallow copy, copying only the +;; top level of objects. Any objects pointed to are not copied +;; +;; Input: RSI - address of list/vector +;; +;; Returns: New list/vector in RAX, last Cons in RBX +;; +;; Modifies: +;; RBX +;; RCX +;; RDX +;; R8 +;; R9 +;; R10 +;; +cons_seq_copy: + push rsi ; Restored at the end + + mov r8, rsi ; Input in R8 + xor r9, r9 ; Head of list in R9, start in R10 +.loop: + ; Check the type + mov cl, BYTE [r8] + mov ch, cl + and ch, block_mask + jnz .not_seq ; Not a Cons object + + call alloc_cons + mov rdx, rax ; New Cons in RDX + mov [rdx], BYTE cl ; Copy type in RCX + mov rbx, [r8 + Cons.car] ; Value in RBX + mov [rdx + Cons.car], rbx ; Copy value + + and cl, content_mask + cmp cl, content_pointer + jne .copied + + ; A pointer, so increment the reference count + mov rsi, rbx + call incref_object + +.copied: + ; Check if this is the first + test r9,r9 + jnz .append + + ; First Cons + mov r9, rdx + mov r10, rdx ; Start of the list, will be returned + jmp .next + +.append: + ; Appending to last Cons + mov [r9 + Cons.cdr], rdx + mov [r9 + Cons.typecdr], BYTE content_pointer + ; Replace + mov r9, rdx + +.next: + ; Check if there's another + mov al, BYTE [r8 + Cons.typecdr] + cmp al, content_pointer + jne .done ; No more + ; Got another + mov r8, [r8 + Cons.cdr] + jmp .loop + +.done: + pop rsi ; Restore input + mov rax, r10 ; Output list + mov rbx, r9 ; Last Cons + ret + +.not_seq: + xor rsi,rsi + jmp error_throw + +;; ------------------------------------------- +;; String type +;; +;; Create a new string, address in RAX +;; +;; Modifies registers +;; RBX +;; +string_new: + call alloc_array + mov [rax], BYTE maltype_string + mov DWORD [rax + Array.length], 0 + mov QWORD [rax + Array.next], 0 + ret + +;; Convert a raw string to a String type +;; +;; Input: Address of raw string in RSI, length in EDX +;; Output: Address of string in RAX +;; +;; Modifies registers: R8,R9,RCX +;; +raw_to_string: + ; Save registers to restore at the end + push r10 + push r11 + + push rsi + push rdx + call string_new ; String now in RAX + pop rdx + pop rsi + + mov r8, rax + add r8, Array.data ; Address of string data + mov r10, rax + add r10, Array.size ; End of the destination data + mov r11, rax ; First Array to return + + mov r9, rsi ; Address of raw data + mov ecx, edx ; Count + +.copy_loop: + test ecx, ecx ; Check if count is zero + jz .done + + ; Copy one byte + mov bl, BYTE [r9] + mov [r8], BYTE bl + + ; Move the destination + inc r8 + cmp r8, r10 + jne .dest_ok + + ; Hit the end. Set the length of the array + mov [rax + Array.length], DWORD (array_chunk_len * 8) + + push rax ; Last Array + push rsi + push rdx + call string_new ; String now in RAX + pop rdx + pop rsi + pop rbx ; Last Array + mov [rbx + Array.next], rax ; Point to new Array + + mov r8, rax + add r8, Array.data ; Address of string data + mov r10, rax + add r10, Array.size ; End of the destination data + +.dest_ok: + + inc r9 + dec ecx + jmp .copy_loop +.done: + ; Set the length of the destination array + sub r8, Array.data + sub r8, rax + mov [rax + Array.length], DWORD r8d + + ; Move first Array into RAX + mov rax, r11 + + ; Restore registers + pop r11 + pop r10 + + ret + +;; Convert a raw string to a symbol +;; +;; Input: Address of raw string in RSI, length in EDX +;; Output: Address of string in RAX +;; +;; Modifies registers: R8,R9,RCX +raw_to_symbol: + call raw_to_string + ; set the content type + mov [rax], BYTE (block_array + container_symbol + content_char) + ret + +;; Convert a NUL terminated C string to string +;; +;; Input: RSI - Address of string +;; +;; Returns: String in RAX +;; +;; Modifies: +;; RBX +;; RCX +;; RDX + +cstring_to_string: + push rsi + call string_new ; in RAX + pop rsi + + mov rbx, rax + add rbx, Array.data ; Start of output + mov rcx, rax + add rcx, Array.size ; End of output +.loop: + mov dl, BYTE [rsi] + test dl, dl ; Check if NUL (0) + jz .done + mov [rbx], BYTE dl + inc rbx + inc rsi + jmp .loop +.done: + sub rbx, rax + sub rbx, Array.data + ; rbx now contains the length + mov [rax + Array.length], DWORD ebx + ret + +;; Appends a character to a string +;; Input: Address of string in RSI, character in CL +;; +;; Modifies +;; RAX +string_append_char: + push rsi + ; Get the end of the string +.get_end: + mov rax, [rsi + Array.next] + test rax, rax + jz .got_dest_end + mov rsi, rax + jmp .get_end +.got_dest_end: + + ; Check if this chunk is full + mov eax, DWORD [rsi + Array.length] + cmp eax, (array_chunk_len*8) + jne .append + + ; full, need to allocate another + call alloc_array + mov [rsi + Array.next], rax + mov rsi, rax + xor eax, eax ; Set length to zero +.append: + inc eax + mov DWORD [rsi + Array.length], eax + dec eax + add rax, rsi + add rax, Array.data ; End of data + mov [rax], BYTE cl + + pop rsi ; Restore original value + ret + +;; Appends a string to the end of a string +;; +;; Input: String to be modified in RSI +;; String to be copied in RDX +;; +;; Output: Modified string in RSI +;; +;; Working registers: +;; rax Array chunk for output (copied to) +;; rbx Array chunk for input (copied from) +;; cl Character being copied +;; r8 Address of destination +;; r9 Destination end address +;; r10 Address of source +;; r11 Source end address +string_append_string: + ; copy source Array address to rbx + mov rbx, rdx + + ; source data address in r10 + mov r10, rbx + add r10, Array.data ; Start of the data + + ; source data end address in r11 + mov r11, r10 + mov r8d, DWORD [rbx + Array.length] + add r11, r8 + + test r8d, r8d + jz .return ; Appending zero-size array + + ; Find the end of the string in RSI + ; and put the address of the Array object into rax + mov rax, rsi +.find_string_end: + mov r8, QWORD [rax + Array.next] + test r8, r8 ; Next chunk is 0 + je .got_dest_end ; so reached end + + mov rax, r8 ; Go to next chunk + jmp .find_string_end +.got_dest_end: + + ; destination data address into r8 + mov r8, rax + add r8, Array.data + add r8d, DWORD [rax + Array.length] + + ; destination data end into r9 + mov r9, rax + add r9, Array.size + + ; Check if we are at the end of the destination + cmp r8, r9 + je .alloc_dest + +.copy_loop: + ; Copy one byte from source to destination + mov cl, BYTE [r10] + mov BYTE [r8], cl + + ; move source to next byte + inc r10 + ; Check if we've reached the end of this Array + cmp r10, r11 + jne .source_ok + + ; have reached the end of the source Array + mov rbx, QWORD [rbx + Array.next] ; Get the next Array address + test rbx, rbx ; Test if it's null + je .finished ; No more, so we're done + ; Move on to next Array object + + ; Get source address into r10 + mov r10, rbx + add r10, Array.data ; Start of the data + + ; Source end address + mov r11d, DWORD [rbx + Array.length] ; Length of the array + add r11, r10 + + ; Check if the next array is empty + cmp r10, r11 + je .finished + +.source_ok: + + ; Move destination to next byte + inc r8 + ; Check if we've reached end of the Array + cmp r8, r9 + jne .copy_loop ; Next byte + +.alloc_dest: + ; Reached the end of the destination + ; Need to allocate another Array + push rax + push rbx + call alloc_array ; New Array in rax + mov r8, rax ; copy to r8 + pop rbx + pop rax + + ; Previous Array in rax. + ; Add a reference to the new array and set length + mov QWORD [rax + Array.next], r8 + mov DWORD [rax + Array.length], (Array.size - Array.data) + mov rax, r8 ; new array + add r8, Array.data ; Start of data + + mov r9, rax + add r9, Array.size + jmp .copy_loop + +.finished: + ; Compare r8 (destination) with data start + ; to get length of string + sub r8, rax + sub r8, Array.data + inc r8 + ; r8 now contains length + mov DWORD [rax + Array.length], r8d +.return: + ret + +;; ------------------------------------------ +;; void print_string(char array) +;; Address of the char Array should be in RSI +print_string: + ; Push registers we're going to use + push rax + push rdi + push rdx + push rsi + + ; Check that we have a char array + mov al, [rsi] + cmp al, maltype_string + jne .error + +.print_chunk: + ; write(1, string, length) + push rsi + mov edx, [rsi + Array.length] ; number of bytes + add rsi, Array.data ; address of raw string to output + call print_rawstring + pop rsi + + ; Check if this is the end + mov rsi, QWORD [rsi + Array.next] + cmp rsi, 0 + jne .print_chunk ; next chunk + + ; Restore registers + pop rsi + pop rdx + pop rdi + pop rax + + ret +.error: + ; An error occurred + mov rdx, error_msg_print_string.len ; number of bytes + mov rsi, error_msg_print_string ; address of raw string to output + call print_rawstring + ; exit + jmp quit_error + +;; Copy a string +;; +;; Input: RSI - String to copy +;; +;; Output: New string in RAX +;; +;; Modifies: +;; RBX +;; RCX +;; RDX +;; RSI +;; +string_copy: + call string_new ; new string in RAX + + push rsi + push rax + + ; Get lengths + mov ebx, DWORD [rsi + Array.length] + mov [rax + Array.length], ebx + + ; Copy the whole block of data + ; Not sure if this is quicker than copying byte-by-byte + ; Could divide ebx by 8 (rounded up) to get the number + ; of blocks needed + + add rsi, Array.data ; Start of input data + add rax, Array.data ; Start of output data + mov ecx, array_chunk_len ; Number of 64-bit chunks + +.loop: + mov rbx, QWORD [rsi] + mov [rax], QWORD rbx + add rsi, 8 + add rax, 8 + dec ecx + jnz .loop + + pop rax + pop rsi + ; Now check if there's another block + mov rsi, [rsi + Array.next] + cmp rsi, 0 + jz .done ; Result in RAX + + ; Another array chunk + push rax ; Save output + + call string_copy ; Copy next chunk + mov rbx, rax ; The copy in RBX + + pop rax + ; append + mov [rax + Array.next], rbx +.done: + ret + +;; ------------------------------------------ +;; String itostring(Integer number) +;; +;; Converts an integer to a string (array of chars) +;; +;; Input in RAX +;; Return string address in RAX +itostring: + ; Save registers to restore afterwards + push rbx + push rcx + push rdx + push rsi + push rdi + + mov rcx, 0 ; counter of how many bytes we need to print in the end + + mov rbx, rax ; Original input + + ; Check if the number is negative + cmp rax, 0 + jge .divideLoop + + ; a negative number. To get the '-' sign + ; at the front the test is done again at the end + ; using the value stored in rbx + + neg rax ; Make it positive + +.divideLoop: + inc rcx ; count each byte to print - number of characters + xor rdx, rdx + mov rsi, 10 + idiv rsi ; divide rax by rsi + add rdx, 48 ; convert rdx to it's ascii representation - rdx holds the remainder after a divide instruction + ; Character is now in DL + dec rsp + mov BYTE [rsp], dl ; Put onto stack + + cmp rax, 0 ; can the integer be divided anymore? + jnz .divideLoop ; jump if not zero to the label divideLoop + + ; Check if the value was negative (in rbx) + cmp rbx, 0 + jge .create_string + + ; a negative number + dec rsp + mov BYTE [rsp], '-' + inc rcx + +.create_string: + ; Get an Array object to put the string into + call string_new ; Address in RAX + + ; put length into string + mov [rax + Array.length], ecx + + ; copy data from stack into string + ; Note: Currently this does not handle long strings + mov rdi, rax + add rdi, Array.data ; Address where raw string will go +.copyLoop: + mov BYTE dl, [rsp] ; Copy one byte at a time. Could be more efficient + mov [rdi], BYTE dl + inc rsp + inc rdi + dec rcx + cmp rcx, 0 + jnz .copyLoop + + ; Restore registers + pop rdi + pop rsi + pop rdx + pop rcx + pop rbx + + ret + + +;; ------------------------------------------------------------ +;; Object comparison +;; +;; These comparison functions take two objects +;; in RSI and RDI +;; and return a code (not an object) in RAX +;; +;; RAX = 0 Objects are equal +;; 1 RSI object is greater than RDI +;; 2 RSI object is less than RDI +;; -1 Different object types, or no ordering +;; +;; Note that the ordering of objects depends on the type +;; strings - Alphabetical +;; +;; +;; + +;; Given an object in RSI, follows pointers +;; to return the value object in RAX +;; +;; Modifies registers: +;; RCX +compare_get_value: + mov cl, BYTE [rsi] + mov ch, cl + and ch, block_mask + jnz .nop ; Got an Array + + ; Here got Cons + mov ch, cl + and ch, content_mask + cmp ch, content_pointer + jne .nop ; Not a pointer + + ; Got a pointer, so follow and return + mov rax, [rsi + Cons.car] + ret +.nop: + mov rax, rsi + ret + +;; Compare two objects in RSI and RDI. +;; Note that this does not compare lists +;; but will just compare the first element +;; +;; Modifies registers +;; RAX, RBX, RCX, RDX +;; +compare_objects: + ; Get the value that RSI points to + call compare_get_value + mov rbx, rax ; Save in RBX + ; Get the value that RDI points to + mov rsi, rdi + call compare_get_value + mov rdi, rax + mov rsi, rbx + + ; now get types + mov cl, BYTE [rsi] ; Type of RSI + mov bl, BYTE [rdi] ; Type of RDI + + mov ch, cl + mov bh, bl + + ; Don't care about container type + and cl, block_mask + content_mask + and bl, block_mask + content_mask + + cmp bl, cl ; compare block and content + jne .different_types + + ; Here the same block, content type + ; May be different container (value/list, string/symbol) + + ; Need to distinguish between map and vector/list + and ch, (block_mask + container_mask) + and bh, (block_mask + container_mask) + cmp ch, bh + je .same_container + ; if either is a map, then different types + cmp ch, container_map + je .different_types + cmp bh, container_map + je .different_types + +.same_container: + cmp bl, block_cons + content_nil + je .objects_equal ; nil + + cmp bl, block_array + content_char + je compare_char_array ; strings, symbols + + cmp bl, block_cons + content_int + je .integers + + ; Unknown + jmp .different_types + +.integers: + ; two Cons objects, both containing integers + mov rbx, [rsi + Cons.car] + cmp rbx, [rdi + Cons.car] + je .objects_equal + jl .rdi_greater + jmp .rsi_greater + +.objects_equal: + mov rax, 0 + ret + +.rsi_greater: ; rsi > rdi + mov rax, 1 + ret + +.rdi_greater: ; rdi > rsi + mov rax, 2 + ret + +.different_types: + mov rax, -1 + ret + + +;; Recursively check objects, including lists +;; +;; Inputs: Objects in RSI and RDI +;; +;; Sets ZF if equal, clears flag otherwise +compare_objects_rec: + ; Compare rsi and rdi objects + + ; Check type + mov al, BYTE [rsi] + mov bl, BYTE [rdi] + + mov ah, al + mov bh, bl + + ; Don't distinguish between [] and () + and ah, (block_mask + content_mask) + and bh, (block_mask + content_mask) + + cmp ah, bh + jne .false + + ; Need to distinguish between map and vector/list + mov ah, al + mov bh, bl + + and ah, (block_mask + container_mask) + and bh, (block_mask + container_mask) + cmp ah, bh + je .same_container + ; if either is a map, then different types + cmp ah, container_map + je .false + cmp bh, container_map + je .false + +.same_container: + + ; Check the container type + and bh, block_mask + jnz .array + + ; Check if a pointer to something + and al, content_mask + cmp al, content_pointer + je .pointer + + ; Get the values + + mov rbx, [rsi + Cons.car] + mov rcx, [rdi + Cons.car] + cmp rbx, rcx + jne .false + + ; Value is the same, so get next + jmp .next + +.array: + ; Comparing arrays + + ; Container type (symbol/string) does matter + cmp al, bl + jne .false + + call compare_char_array + cmp rax, 0 + ret ; Array has no next + +.pointer: + + mov rbx, [rsi + Cons.car] + mov rcx, [rdi + Cons.car] + cmp rbx, rcx + je .next ; Equal pointers + + push rsi + push rdi + ; Put the addresses to compare into RSI and RDI + mov rsi, rbx + mov rdi, rcx + call compare_objects_rec + pop rdi + pop rsi + jne .false + ; fall through to .next + +.next: + ; Check if both have a 'cdr' pointer + mov al, BYTE [rsi + Cons.typecdr] + mov bl, BYTE [rdi + Cons.typecdr] + + cmp al, content_pointer + je .rsi_has_next + + ; No next pointer in RSI + cmp bl, content_pointer + je .false ; RDI has a next pointer + + ; Neither have a next pointer, so done + jmp .true + +.rsi_has_next: + cmp bl, content_pointer + jne .false ; RDI has no next pointer + + ; Both have a next pointer, so keep going + mov rsi, [rsi + Cons.cdr] + mov rdi, [rdi + Cons.cdr] + jmp compare_objects_rec + +.false: + lahf ; flags in AH + and ah, 255-64 ; clear zero flag + sahf + ret +.true: + lahf ; flags in AH + or ah, 64 ; set zero flag + sahf + ret + +;; Char array objects (strings, symbols, keywords) in RSI and RDI +;; Return code in RAX +;; +;; Modifies registers: +;; RBX +;; RCX +;; RDX +compare_char_array: + ; Check length + mov eax, DWORD [rsi + Array.length] + mov ebx, DWORD [rdi + Array.length] + cmp eax, ebx + jne .different + + ; same length + + cmp eax, 0 + je .equal ; Both zero length + + mov rbx, rsi + add rbx, Array.data + mov rcx, rdi + add rcx, Array.data +.compare_loop: + ; get next character + mov dl, BYTE [rbx] + cmp dl, BYTE [rcx] + jl .rdi_greater + jg .rsi_greater + + ; this character is equal + inc rbx + inc rcx + dec eax + jnz .compare_loop ; Next character + +.equal: + mov rax, 0 + ret + +.rsi_greater: ; rsi > rdi + mov rax, 1 + ret + +.rdi_greater: ; rdi > rsi + mov rax, 2 + ret + +.different: + mov rax, -1 + ret + +;; ------------------------------------------------------------ +;; Map type +;; +;; This uses a list (Cons type) to represent key-value pairs in +;; a single chain. The only map which consists of an odd number of Cons +;; objects is the empty map, created by map_new +map_new: + call alloc_cons + mov [rax], BYTE (block_cons + container_map + content_empty) + mov [rax + Cons.typecdr], BYTE content_nil + ret + +;; Copy map +;; +;; Input: RSI - map +;; +;; Returns: new map in RAX +;; +;; Modifies: +;; RAX, RBX, RCX, R13, R14, R15 +;; +map_copy: + mov r14, rsi + + call alloc_cons + mov r15, rax ; start of new map + xor r13, r13 +.loop: + mov bl, BYTE [rsi] + mov rcx, [rsi + Cons.car] + mov [rax], BYTE bl ; copy type + mov [rax + Cons.car], rcx ; copy value + + and bl, content_mask + cmp bl, content_pointer + jne .set_cdr + + ; A pointer in CAR. Increase reference count + mov bx, WORD [rcx + Cons.refcount] + inc bx + mov [rcx + Cons.refcount], WORD bx + +.set_cdr: + test r13,r13 + jz .next + + ; R13 contains last Cons + mov [r13 + Cons.typecdr], BYTE content_pointer + mov [r13 + Cons.cdr], rax +.next: + mov r13, rax + + ; Check if there's another Cons + mov bl, BYTE [rsi + Cons.typecdr] + cmp bl, content_pointer + jne .done ; no more + + mov rsi, [rsi + Cons.cdr] ; next + call alloc_cons + jmp .loop +.done: + mov rax, r15 + mov rsi, r14 + ret + + +;; Add to map. Input is a list with an even number of values +;; as (key, value, key, value, ...) +;; +;; Inputs: +;; RSI - Map to append to. This is not modified +;; RDI - List to add to the map +;; Outputs: +;; RAX - New map +;; +;; Modifies: +;; RCX +map_add: + ; Check type of input + mov cl, BYTE [rsi] + mov cl, ch + and ch, block_mask + container_mask + cmp ch, block_cons + container_map + jne .error + + mov cl, BYTE [rdi] + and cl, block_mask + container_mask + cmp cl, block_cons + container_list + jne .error + + xor r8, r8 ; Zero r8 + +.copy_input: + ; Copy input list, changing container type + call alloc_cons + + mov cl, BYTE [rdi] + and cl, content_mask ; Keep the content + add cl, block_cons + container_map + mov [rax], BYTE cl ; Set type + mov rcx, [rdi+Cons.car] ; Copy data + mov [rax+Cons.car], rcx + + cmp cl, (block_cons + container_map + content_pointer) + jne .copy_not_pointer + + ; Copying a pointer to data + ; so need to increase the reference count + mov bx, WORD [rcx + Cons.refcount] ; Same offset for Array + inc bx + mov [rcx + Cons.refcount], WORD bx + +.copy_not_pointer: + + ; Check if this is the first object + cmp r8, 0 + jnz .copy_not_first + mov r8, rax ; Save start of map to R8 + mov r9, rax ; Last cons in R9 + jmp .copy_next + +.copy_not_first: + ; Append to R9 + mov [r9+Cons.cdr], rax + mov [r9+Cons.typecdr], BYTE content_pointer + + ; Put new Cons in R9 as the latest in the list + mov r9, rax + +.copy_next: + ; Check if we've reached the end + mov cl, BYTE [rdi + Cons.typecdr] + cmp cl, content_nil + je .copy_finished + + ; Not yet. Get next Cons and keep going + mov rdi, [rdi + Cons.cdr] + jmp .copy_input + +.copy_finished: + ; Start of map in r8, end in r9 + + ; Check if the original map is empty + mov cl, [rsi] + and cl, content_mask + cmp cl, content_empty + je .return + + ; Put old map on the end of the new map + ; For now this avoids the need to overwrite + ; values in the map, since a search will find + ; the new values first. + + mov [r9 + Cons.cdr], rsi + mov [r9 + Cons.typecdr], BYTE content_pointer + + ; Increment reference count + mov bx, WORD [rsi + Cons.refcount] + inc bx + mov [rsi + Cons.refcount], WORD bx + +.return: + mov rax, r8 + ret + +.error: + ; Return nil + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + +;; Find a key in a map +;; +;; Inputs: RSI - map [ Modified ] +;; RDI - key [ Modified ] +;; +;; Outputs: RAX - Cons object containing value in CAR +;; +;; Modifies registers: +;; RBX [compare_objects, alloc_cons] +;; RCX [compare_objects] +;; +;; +;; If value is found then the Zero Flag is set +;; +;; Examples: +;; {a 1 b 2} find a -> {1 b 2} +;; {1 2 3 4} find a -> {4} +map_find: + mov al, BYTE [rsi] + cmp al, maltype_empty_map + je .not_found + +.map_loop: + ; compare RSI and RDI, ignoring differences in container + push rsi + push rdi + call compare_objects + pop rdi + pop rsi + + ; rax is now zero if objects are equal + cmp rax, 0 + je .found + + ; Move along two cons to the next key + mov al, [rsi + Cons.typecdr] + cmp al, content_pointer + jne .error ; Expecting value after key + + mov rsi, [rsi + Cons.cdr] ; Get value + mov al, [rsi + Cons.typecdr] + cmp al, content_pointer + jne .not_found + + mov rsi, [rsi + Cons.cdr] ; Get next key + + jmp .map_loop ; Test next key + +.found: + + lahf ; flags in AH + or ah, 64 ; set zero flag + sahf + + ; key in rsi. Get next value + mov al, [rsi + Cons.typecdr] + cmp al, content_pointer + jne .error ; Expecting value after key + + mov rsi, [rsi + Cons.cdr] + + ; ; increment reference count + ; mov ax, WORD [rsi + Cons.refcount] + ; inc ax + ; mov [rsi + Cons.refcount], WORD ax + ; Put address in rax + mov rax, rsi + ret + +.not_found: + lahf ; flags in AH + and ah, 255-64 ; clear zero flag + sahf + + ; last cons in rsi + ; increment reference count + ; mov ax, WORD [rsi + Cons.refcount] + ; inc ax + ; mov [rsi + Cons.refcount], WORD ax + ; Put address in rax + mov rax, rsi + + ret + +.error: + + lahf ; flags in AH + and ah, 255-64 ; clear zero flag + sahf + + ; return nil + call alloc_cons + mov [rax], BYTE maltype_nil + mov [rax + Cons.typecdr], BYTE content_nil + ret + +;; Map set +;; +;; Sets a key-value pair in a map +;; +;; Inputs: RSI - map [not modified] +;; RDI - key [not modified] +;; RCX - value [not modified] +;; +;; If references are added to key or value, +;; then reference counts are incremented. +;; +;; Modifies registers: +;; R8 +;; R9 +;; R10 +map_set: + ; Save inputs in less volatile registers + mov r8, rsi ; map + mov r9, rdi ; key + mov r10, rcx ; value + + ; Find the key, to see if it already exists in the map + call map_find ; Cons object in RAX + je .found_key + + ; Key not in map. RAX should be address of the last + ; value in the map, or empty + mov bl, BYTE [rax] + cmp bl, maltype_empty_map + je .set_key + + ; Append key + push rax + call alloc_cons ; New Cons in rax + pop rbx ; Last Cons in map + + ; append rax to rbx + mov [rbx + Cons.typecdr], BYTE content_pointer + mov [rbx + Cons.cdr], rax + jmp .set_key ; Put key into rax + +.found_key: + ; Key already in map, so replace value + ; address in RAX + + ; check type of value already there + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + jne .set_value ; Not a pointer, just overwrite + + ; A pointer, so need to release + mov rsi, [rax + Cons.car] ; Address of object + push rax + call release_object + pop rax + + jmp .set_value ; put value into Cons + +.set_key: + ; Put key (R9) in RAX + + ; Check the type of object + mov bl, BYTE [r9] + mov bh, bl + and bh, block_mask + jnz .set_key_pointer ; Array, so point to it + + ; Here a Cons object + mov bh, bl + and bh, container_mask + cmp bh, container_value + jne .set_key_pointer ; Not a simple value, so point to it + + ; A value, so copy + mov rcx, [r9 + Cons.car] + mov [rax + Cons.car], rcx + + ; Set the type + and bl, content_mask + or bl, (block_cons + container_map) + mov [rax], BYTE bl + + jmp .set_key_done + +.set_key_pointer: + ; The key is a pointer + + mov [rax + Cons.car], r9 + mov [rax], BYTE (block_cons + container_map + content_pointer) + ; Increment reference count + mov bx, WORD [r9 + Cons.refcount] + inc bx + mov [r9 + Cons.refcount], bx + ; fall through to .set_key_done + +.set_key_done: + ; Key in RAX. allocate and append a Cons for the value + push rax + call alloc_cons ; value Cons in rax + pop rbx ; key Cons + ; append rax to rbx + mov [rbx + Cons.typecdr], BYTE content_pointer + mov [rbx + Cons.cdr], rax + + ; fall through to .set_value + + ; -------------------------------- +.set_value: + ; Set the value into the Cons at [rax] + + ; Check the type of object + mov bl, BYTE [r10] + mov bh, bl + and bh, block_mask + jnz .set_value_pointer ; Array, so point to it + + ; Here a Cons object + mov bh, bl + and bh, container_mask + cmp bh, container_value + jne .set_value_pointer ; Not a simple value, so point to it + ; A value, so copy + mov rcx, [r10 + Cons.car] + mov [rax + Cons.car], rcx + + ; Set the type + and bl, content_mask + or bl, (block_cons + container_map) + mov [rax], BYTE bl + + jmp .finished + +.set_value_pointer: + mov [rax + Cons.car], r10 ; Put address into CAR + mov [rax], BYTE (block_cons + container_map + content_pointer) ; Mark as a pointer + ; Increment reference count + mov bx, WORD [r10 + Cons.refcount] + inc bx + mov [r10 + Cons.refcount], bx + ; fall through to .finished + +.finished: + ; Restore inputs + mov rsi, r8 + mov rdi, r9 + mov rcx, r10 + ret + +;; Get a value from a map, incrementing the reference count +;; of the object returned +;; +;; Inputs: RSI - map +;; RDI - key +;; +;; Returns: If found, Zero Flag is set and address in RAX +;; If not found, Zero Flag cleared +;; +;; Modifies registers: +;; RAX +;; RBX +;; RCX +;; R8 +;; R9 +map_get: + ; Save inputs + mov r8, rsi ; map + mov r9, rdi ; key + + call map_find ; Cons object in RAX + je .found_key + + ; Not found + + mov rsi, r8 + mov rdi, r9 + + lahf ; flags in AH + and ah, 255-64 ; clear zero flag + sahf + + ret + ; --------------- +.found_key: + + ; Check if the object in RAX is a value or pointer + mov bl, BYTE [rax] + and bl, content_mask + cmp bl, content_pointer + je .got_pointer + + ; A value, so copy + + push rax + push rbx + call alloc_cons ; cons in rax + pop rbx ; content type in bl + pop rcx ; Object to copy + + add bl, block_cons + container_value + mov [rax], BYTE bl ; set type + mov [rax + Cons.typecdr], BYTE content_nil + + ; Copy value + mov rbx, [rcx + Cons.car] + mov [rax + Cons.car], rbx + + jmp .finished_found + +.got_pointer: + ; A pointer, so get the address + mov rax, [rax + Cons.car] + + ; increment reference count + mov bx, WORD [rax + Cons.refcount] + inc bx + mov [rax + Cons.refcount], bx + + ; Fall through to .finished_found +.finished_found: + mov rsi, r8 + mov rdi, r9 + + mov rbx, rax + lahf ; flags in AH + or ah, 64 ; set zero flag + sahf + mov rax, rbx + ret + +;; Get a list of keys +;; +;; Input: Map in RSI +;; +;; Returns: List in RAX +;; +;; Modifies registers: +;; RAX +;; RBX +;; RCX +;; R8 +;; R9 +map_keys: + ; check type + mov al, BYTE [rsi] + cmp al, maltype_empty_map + je .empty_map + + and al, container_mask + cmp al, container_map + jne .empty_map ; error + + xor r8, r8 ; Return list + + ; Take the current value +.loop: + ; Create a new Cons for this key + call alloc_cons + mov cl, BYTE [rsi] + and cl, content_mask + add cl, block_cons + container_list + mov [rax], BYTE cl ; Set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; Set value + + and cl, content_mask + cmp cl, content_pointer + jne .append + + ; A pointer, so increment reference count + mov cx, WORD [rbx + Cons.refcount] + inc cx + mov [rbx + Cons.refcount], WORD cx + +.append: + cmp r8, 0 + je .first + + ; appending + mov [r9 + Cons.typecdr], BYTE content_pointer + mov [r9 + Cons.cdr], rax + mov r9, rax + jmp .next +.first: + ; First key, so put into r8 + mov r8, rax + mov r9, rax +.next: + ; First get the value + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .done ; error. Should be a value + mov rsi, [rsi + Cons.cdr] + + ; Get the next key + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .done + mov rsi, [rsi + Cons.cdr] + jmp .loop +.done: + ; Finished, return the list + mov rax, r8 + ret + +.empty_map: + ; return empty list + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + +;; Get a list of values +;; +;; Input: Map in RSI +;; +;; Returns: List in RAX +;; +;; Modifies registers: +;; RAX +;; RBX +;; RCX +;; R8 +;; R9 +map_vals: + ; check type + mov al, BYTE [rsi] + cmp al, maltype_empty_map + je .empty_map + + and al, container_mask + cmp al, container_map + jne .empty_map ; error + + xor r8, r8 ; Return list + +.loop: + ; Here should have a key in RSI + + ; First get the value + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .done ; error. Should be a value + + mov rsi, [rsi + Cons.cdr] ; Now have value in RSI + + ; Create a new Cons for this value + call alloc_cons + mov cl, BYTE [rsi] + and cl, content_mask + add cl, block_cons + container_list + mov [rax], BYTE cl ; Set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; Set value + + and cl, content_mask + cmp cl, content_pointer + jne .append + + ; A pointer, so increment reference count + mov cx, WORD [rbx + Cons.refcount] + inc cx + mov [rbx + Cons.refcount], WORD cx + +.append: + cmp r8, 0 + je .first + + ; appending + mov [r9 + Cons.typecdr], BYTE content_pointer + mov [r9 + Cons.cdr], rax + mov r9, rax + jmp .next +.first: + ; First key, so put into r8 + mov r8, rax + mov r9, rax +.next: + ; Get the next key + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .done + mov rsi, [rsi + Cons.cdr] + jmp .loop +.done: + ; Finished, return the list + mov rax, r8 + ret + +.empty_map: + ; return empty list + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; ------------------------------------------------------------ +;; Function type +;; +;; Functions are consist of a list +;; - First car is the function address to call +;; - Second is the Meta data (nil by default) +;; - Third is the environment +;; - Fourth is the binds list +;; - Fifth is the body of the function +;; +;; ( addr meta env binds body ) +;; +;; + +;; Address of native function in RSI +;; returns Function object in RAX +native_function: + call alloc_cons ; for meta + mov [rax], BYTE maltype_nil + push rax + + call alloc_cons ; For function address + mov [rax], BYTE (block_cons + container_function + content_function) + mov [rax + Cons.car], rsi + + mov [rax + Cons.typecdr], BYTE content_pointer + pop rbx ; meta + mov [rax + Cons.cdr], rbx + ret diff --git a/impls/nim/Dockerfile b/impls/nim/Dockerfile new file mode 100644 index 0000000000..afa621025a --- /dev/null +++ b/impls/nim/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install gcc libc-dev nim + +ENV HOME /mal diff --git a/impls/nim/Makefile b/impls/nim/Makefile new file mode 100644 index 0000000000..11fd6cb91f --- /dev/null +++ b/impls/nim/Makefile @@ -0,0 +1,27 @@ +##################### + +SOURCES_BASE = types.nim reader.nim printer.nim +SOURCES_REBUILD = $(SOURCES_BASE) env.nim core.nim + +##################### + +SRCS = step0_repl.nim step1_read_print.nim step2_eval.nim step3_env.nim \ + step4_if_fn_do.nim step5_tco.nim step6_file.nim step7_quote.nim \ + step8_macros.nim step9_try.nim stepA_mal.nim +BINS = $(SRCS:%.nim=%) + +##################### + +all: $(BINS) + +dist: mal + +mal: $(word $(words $(BINS)),$(BINS)) + cp $< $@ + +$(BINS): %: %.nim $(SOURCES_REBUILD) + nim -d:release --nimcache:nimcache-$@ c $@ + +clean: + rm -rf nimcache-*/ $(BINS) + rm -f mal diff --git a/nim/core.nim b/impls/nim/core.nim similarity index 80% rename from nim/core.nim rename to impls/nim/core.nim index e5ca517f8e..0393ef6ba6 100644 --- a/nim/core.nim +++ b/impls/nim/core.nim @@ -1,6 +1,6 @@ -import strutils, rdstdin, tables, algorithm, times, types, printer, reader +import strutils, rdstdin, tables, times, sequtils, types, printer, reader -type MalError* = object of Exception +type MalError* = object of CatchableError t*: MalType # String functions @@ -15,8 +15,7 @@ proc prn(xs: varargs[MalType]): MalType = result = nilObj proc println(xs: varargs[MalType]): MalType = - let line = xs.map(proc(x: MalType): string = x.pr_str(false)).join(" ") - echo line.replace("\\n", "\n") + echo xs.map(proc(x: MalType): string = x.pr_str(false)).join(" ") result = nilObj proc read_str(xs: varargs[MalType]): MalType = @@ -38,6 +37,11 @@ proc concat(xs: varargs[MalType]): MalType = for i in x.list: result.list.add i +proc vec(xs: varargs[MalType]): MalType = + result = MalType(kind: Vector, list: newSeq[MalType](xs[0].list.len)) + for i, x in xs[0].list: + result.list[i] = x + proc nth(xs: varargs[MalType]): MalType = if xs[1].number < xs[0].list.len: return xs[0].list[xs[1].number] else: raise newException(ValueError, "nth: index out of range") @@ -49,7 +53,7 @@ proc first(xs: varargs[MalType]): MalType = proc rest(xs: varargs[MalType]): MalType = if xs[0].kind in {List, Vector} and xs[0].list.len > 0: - list xs[0].list[1 .. -1] + list xs[0].list[1 .. ^1] else: list() proc throw(xs: varargs[MalType]): MalType = @@ -69,7 +73,8 @@ proc dissoc(xs: varargs[MalType]): MalType = proc get(xs: varargs[MalType]): MalType = if xs[0].kind == HashMap: - result = xs[0].hash_map[xs[1].str] + if xs[1].str in xs[0].hash_map: + result = xs[0].hash_map[xs[1].str] if not result.isNil: return result = nilObj @@ -87,6 +92,19 @@ proc vals(xs: varargs[MalType]): MalType = for value in xs[0].hash_map.values: result.list.add value +proc apply(xs: varargs[MalType]): MalType = + var s = newSeq[MalType]() + if xs.len > 2: + for j in 1 .. xs.high-1: + s.add xs[j] + s.add xs[xs.high].list + xs[0].getFun()(s) + +proc map(xs: varargs[MalType]): MalType = + result = list() + for i in 0 .. xs[1].list.high: + result.list.add xs[0].getFun()(xs[1].list[i]) + proc conj(xs: varargs[MalType]): MalType = if xs[0].kind == List: result = list() @@ -100,18 +118,23 @@ proc conj(xs: varargs[MalType]): MalType = result.list.add xs[i] result.meta = xs[0].meta -proc apply(xs: varargs[MalType]): MalType = - var s = newSeq[MalType]() - if xs.len > 2: - for j in 1 .. xs.high-1: - s.add xs[j] - s.add xs[xs.high].list - xs[0].getFun()(s) - -proc map(xs: varargs[MalType]): MalType = - result = list() - for i in 0 .. xs[1].list.high: - result.list.add xs[0].getFun()(xs[1].list[i]) +proc seq(xs: varargs[MalType]): MalType = + if xs[0].kind == List: + if len(xs[0].list) == 0: return nilObj + result = xs[0] + elif xs[0].kind == Vector: + if len(xs[0].list) == 0: return nilObj + result = list() + result.list.add xs[0].list + elif xs[0].kind == String: + if len(xs[0].str) == 0: return nilObj + result = list() + for i in countup(0, len(xs[0].str) - 1): + result.list.add(str xs[0].str.substr(i,i)) + elif xs[0] == nilObj: + result = nilObj + else: + raise newException(ValueError, "seq: called on non-sequence") proc with_meta(xs: varargs[MalType]): MalType = new result @@ -139,11 +162,11 @@ proc swap_bang(xs: varargs[MalType]): MalType = proc time_ms(xs: varargs[MalType]): MalType = number int(epochTime() * 1000) -template wrapNumberFun(op: expr): expr = +template wrapNumberFun(op): untyped = fun proc(xs: varargs[MalType]): MalType = number op(xs[0].number, xs[1].number) -template wrapBoolFun(op: expr): expr = +template wrapBoolFun(op): untyped = fun proc(xs: varargs[MalType]): MalType = if op(xs[0].number, xs[1].number): trueObj else: falseObj @@ -186,23 +209,30 @@ let ns* = { "sequential?": fun seq_q, "cons": fun cons, "concat": fun concat, + "vec": fun vec, "count": fun count, "nth": fun nth, "first": fun first, "rest": fun rest, - "conj": fun conj, "apply": fun apply, "map": fun map, + "conj": fun conj, + "seq": fun seq, + "throw": fun throw, "nil?": fun nil_q, "true?": fun true_q, "false?": fun false_q, + "string?": fun string_q, "symbol": fun symbol, "symbol?": fun symbol_q, "keyword": fun keyword, "keyword?": fun keyword_q, + "number?": fun number_q, + "fn?": fun fn_q, + "macro?": fun macro_q, "with-meta": fun with_meta, "meta": fun meta, diff --git a/impls/nim/env.nim b/impls/nim/env.nim new file mode 100644 index 0000000000..79f210beb6 --- /dev/null +++ b/impls/nim/env.nim @@ -0,0 +1,23 @@ +import tables, types + +proc initEnv*(outer: Env = nil, binds, exprs: MalType = nilObj): Env = + result = Env(data: initTable[string, MalType](), outer: outer) + + if binds.kind in {List, Vector}: + for i, e in binds.list: + if e.str == "&": + result.data[binds.list[i+1].str] = list(exprs.list[i .. ^1]) + break + else: + result.data[e.str] = exprs.list[i] + +proc set*(e: Env, key: string, value: MalType): MalType {.discardable.} = + e.data[key] = value + value + +proc get*(e: Env, key: string): MalType = + var env = e + while not env.data.hasKey(key): + env = env.outer + if env.isNil: return nil + return env.data[key] diff --git a/nim/mal.nimble b/impls/nim/mal.nimble similarity index 80% rename from nim/mal.nimble rename to impls/nim/mal.nimble index 5ec4b7f6a7..571ea349be 100644 --- a/nim/mal.nimble +++ b/impls/nim/mal.nimble @@ -1,6 +1,6 @@ [Package] name = "mal" -version = "1.0" +version = "1.1" author = "Dennis Felsing" description = "Mal code in Nim" license = "MIT" @@ -8,4 +8,4 @@ license = "MIT" bin = "step0_repl, step1_read_print, step2_eval, step3_env, step4_if_fn_do, step5_tco, step6_file, step7_quote, step8_macros, step9_try, stepA_mal" [Deps] -Requires = "nim >= 0.10.3, nre >= 0.6.0" +Requires = "nim >= 0.10.3" diff --git a/impls/nim/nim.cfg b/impls/nim/nim.cfg new file mode 100644 index 0000000000..a9663a6b63 --- /dev/null +++ b/impls/nim/nim.cfg @@ -0,0 +1 @@ +gc: markandsweep diff --git a/nim/printer.nim b/impls/nim/printer.nim similarity index 81% rename from nim/printer.nim rename to impls/nim/printer.nim index 912b8a96f8..e6edf9cc84 100644 --- a/nim/printer.nim +++ b/impls/nim/printer.nim @@ -3,7 +3,7 @@ import strutils, sequtils, tables, types proc str_handle(x: string, pr = true): string = if x.len > 0 and x[0] == '\xff': result = ":" & x[1 .. x.high] - elif pr: result = "\"" & x.replace("\\", "\\\\").replace("\"", "\\\"") & "\"" + elif pr: result = "\"" & x.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") & "\"" else: result = x proc pr_str*(m: MalType, pr = true): string = @@ -17,8 +17,8 @@ proc pr_str*(m: MalType, pr = true): string = of Symbol: result = m.str of String: result = m.str.str_handle(pr) of Number: result = $m.number - of List: result = "(" & m.list.mapIt(string, it.pr_str(pr)).join(" ") & ")" - of Vector: result = "[" & m.list.mapIt(string, it.pr_str(pr)).join(" ") & "]" + of List: result = "(" & m.list.mapIt(it.pr_str(pr)).join(" ") & ")" + of Vector: result = "[" & m.list.mapIt(it.pr_str(pr)).join(" ") & "]" of HashMap: result = "{" for key, val in m.hash_map.pairs: diff --git a/impls/nim/reader.nim b/impls/nim/reader.nim new file mode 100644 index 0000000000..7d02a1a7b6 --- /dev/null +++ b/impls/nim/reader.nim @@ -0,0 +1,116 @@ +import options, re, strutils, types + +let + tokenRE = re"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)""" + intRE = re"-?[0-9]+$" + strRE = re"""^"(?:\\.|[^\\"])*"$""" + +type + Blank* = object of CatchableError + + Reader = object + tokens: seq[string] + position: int + +proc next(r: var Reader): Option[string] = + if r.position < r.tokens.len: + result = r.tokens[r.position].some + inc r.position + +proc peek(r: Reader): Option[string] = + if r.position < r.tokens.len: return r.tokens[r.position].some + +proc tokenize(str: string): seq[string] = + result = @[] + var pos = 0 + while pos < str.len: + var matches: array[2, string] + var len = str.findBounds(tokenRE, matches, pos) + if len.first != -1 and len.last != -1 and len.last >= len.first: + pos = len.last + 1 + if matches[0].len > 0 and matches[0][0] != ';': + result.add matches[0] + else: + inc pos + +proc read_form(r: var Reader): MalType + +proc read_seq(r: var Reader, fr, to: string): seq[MalType] = + result = @[] + var t = r.next + if t.get("") != fr: raise newException(ValueError, "expected '" & fr & "'") + + t = r.peek + while t.get("") != to: + if t.get("") == "": raise newException(ValueError, "expected '" & to & "', got EOF") + result.add r.read_form + t = r.peek + discard r.next + +proc read_list(r: var Reader): MalType = + result = list r.read_seq("(", ")") + +proc read_vector(r: var Reader): MalType = + result = vector r.read_seq("[", "]") + +proc read_hash_map(r: var Reader): MalType = + result = hash_map r.read_seq("{", "}") + +proc read_atom(r: var Reader): MalType = + let t = r.next.get("") + if t.match(intRE): number t.parseInt + elif t[0] == '"': + if not t.match(strRE): + raise newException(ValueError, "expected '\"', got EOF") + str t[1 ..< t.high].multiReplace(("\\\"", "\""), ("\\n", "\n"), ("\\\\", "\\")) + elif t[0] == ':': keyword t[1 .. t.high] + elif t == "nil": nilObj + elif t == "true": trueObj + elif t == "false": falseObj + else: symbol t + +proc read_form(r: var Reader): MalType = + if r.peek.get("")[0] == ';': + discard r.next + return nilObj + case r.peek.get("") + of "'": + discard r.next + result = list(symbol "quote", r.read_form) + of "`": + discard r.next + result = list(symbol "quasiquote", r.read_form) + of "~": + discard r.next + result = list(symbol "unquote", r.read_form) + of "~@": + discard r.next + result = list(symbol "splice-unquote", r.read_form) + of "^": + discard r.next + let meta = r.read_form + result = list(symbol "with-meta", r.read_form, meta) + of "@": + discard r.next + result = list(symbol "deref", r.read_form) + + # list + of "(": result = r.read_list + of ")": raise newException(ValueError, "unexpected ')'") + + # vector + of "[": result = r.read_vector + of "]": raise newException(ValueError, "unexpected ']'") + + # hash-map + of "{": result = r.read_hash_map + of "}": raise newException(ValueError, "unexpected '}'") + + # atom + else: result = r.read_atom + +proc read_str*(str: string): MalType = + var r = Reader(tokens: str.tokenize) + if r.tokens.len == 0: + raise newException(Blank, "Blank line") + r.read_form diff --git a/impls/nim/run b/impls/nim/run new file mode 100755 index 0000000000..6efdc3de32 --- /dev/null +++ b/impls/nim/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/nim/step0_repl.nim b/impls/nim/step0_repl.nim similarity index 87% rename from nim/step0_repl.nim rename to impls/nim/step0_repl.nim index 6ae7d895a0..45c3127aba 100644 --- a/nim/step0_repl.nim +++ b/impls/nim/step0_repl.nim @@ -7,5 +7,7 @@ proc eval(ast: string): string = ast proc print(exp: string): string = exp while true: + try: let line = readLineFromStdin("user> ") echo line.read.eval.print + except IOError: quit() diff --git a/nim/step1_read_print.nim b/impls/nim/step1_read_print.nim similarity index 92% rename from nim/step1_read_print.nim rename to impls/nim/step1_read_print.nim index 4be58984a4..3a9fe02216 100644 --- a/nim/step1_read_print.nim +++ b/impls/nim/step1_read_print.nim @@ -10,5 +10,6 @@ while true: try: let line = readLineFromStdin("user> ") echo line.read.eval.print + except IOError: quit() except: echo getCurrentExceptionMsg() diff --git a/impls/nim/step2_eval.nim b/impls/nim/step2_eval.nim new file mode 100644 index 0000000000..545b04a38f --- /dev/null +++ b/impls/nim/step2_eval.nim @@ -0,0 +1,48 @@ +import rdstdin, tables, sequtils, types, reader, printer + +proc read(str: string): MalType = str.read_str + +proc eval(ast: MalType, env: Table[string, MalType]): MalType = + + # echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + if not env.hasKey(ast.str): + raise newException(ValueError, "'" & ast.str & "' not found") + result = env[ast.str] + of Vector: + result = vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + of List: + if ast.list.len == 0: return ast + let el = ast.list.mapIt(it.eval(env)) + result = el[0].fun(el[1 .. ^1]) + else: + result = ast + +proc print(exp: MalType): string = exp.pr_str + +template wrapNumberFun(op): untyped = + fun proc(xs: varargs[MalType]): MalType = number op(xs[0].number, xs[1].number) + +let repl_env = toTable({ + "+": wrapNumberFun `+`, + "-": wrapNumberFun `-`, + "*": wrapNumberFun `*`, + "/": wrapNumberFun `div`, +}) + +proc rep(str: string): string = + str.read.eval(repl_env).print + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except IOError: quit() + except: + echo getCurrentExceptionMsg() diff --git a/impls/nim/step3_env.nim b/impls/nim/step3_env.nim new file mode 100644 index 0000000000..0ada25543f --- /dev/null +++ b/impls/nim/step3_env.nim @@ -0,0 +1,69 @@ +import rdstdin, tables, sequtils, types, reader, printer, env + +proc read(str: string): MalType = str.read_str + +proc eval(ast: MalType, env: Env): MalType = + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + result = env.get(ast.str) + if result.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + of Vector: + result = vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + of List: + if ast.list.len == 0: return ast + let + a0 = ast.list[0] + a1 = ast.list[1] + a2 = ast.list[2] + + case a0.str + of "def!": + result = env.set(a1.str, a2.eval(env)) + of "let*": + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: discard + result = a2.eval(let_env) + else: + let el = ast.list.mapIt(it.eval(env)) + result = el[0].fun(el[1 .. ^1]) + else: + result = ast + +proc print(exp: MalType): string = exp.pr_str + +template wrapNumberFun(op): untyped = + fun proc(xs: varargs[MalType]): MalType = number op(xs[0].number, xs[1].number) + +let repl_env = initEnv() + +repl_env.set("+", wrapNumberFun(`+`)) +repl_env.set("-", wrapNumberFun(`-`)) +repl_env.set("*", wrapNumberFun(`*`)) +repl_env.set("/", wrapNumberFun(`div`)) +#repl_env.set("/", wrapNumberFun(proc(x,y: int): int = int(x.float / y.float))) + +proc rep(str: string): string = + str.read.eval(repl_env).print + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except IOError: quit() + except: + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/step4_if_fn_do.nim b/impls/nim/step4_if_fn_do.nim new file mode 100644 index 0000000000..72e7bd42ac --- /dev/null +++ b/impls/nim/step4_if_fn_do.nim @@ -0,0 +1,95 @@ +import rdstdin, tables, sequtils, types, reader, printer, env, core + +proc read(str: string): MalType = str.read_str + +proc eval(ast: MalType, env: Env): MalType = + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + result = env.get(ast.str) + if result.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + of Vector: + result = vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + of List: + if ast.list.len == 0: return ast + + let a0 = ast.list[0] + if a0.kind == Symbol: + case a0.str + of "def!": + let + a1 = ast.list[1] + a2 = ast.list[2] + return env.set(a1.str, a2.eval(env)) + + of "let*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: discard + return a2.eval(let_env) + + of "do": + let el = ast.list[1 .. ^1].mapIt(it.eval(env)) + return el[el.high] + + of "if": + let + a1 = ast.list[1] + a2 = ast.list[2] + cond = a1.eval(env) + + if cond.kind in {Nil, False}: + if ast.list.len > 3: return ast.list[3].eval(env) + else: return nilObj + else: return a2.eval(env) + + of "fn*": + let + a1 = ast.list[1] + a2 = ast.list[2] + return fun(proc(a: varargs[MalType]): MalType = + a2.eval(initEnv(env, a1, list(a)))) + + let el = ast.list.mapIt(it.eval(env)) + result = el[0].fun(el[1 .. ^1]) + + else: + result = ast + +proc print(exp: MalType): string = exp.pr_str + +let repl_env = initEnv() + +for k, v in ns.items: + repl_env.set(k, v) + +# core.nim: defined using nim +proc rep(str: string): string = + str.read.eval(repl_env).print + +# core.mal: defined using mal itself +discard rep "(def! not (fn* (a) (if a false true)))" + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except IOError: quit() + except: + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/step5_tco.nim b/impls/nim/step5_tco.nim new file mode 100644 index 0000000000..00f9bfa38d --- /dev/null +++ b/impls/nim/step5_tco.nim @@ -0,0 +1,117 @@ +import rdstdin, tables, sequtils, types, reader, printer, env, core + +proc read(str: string): MalType = str.read_str + +proc eval(ast: MalType, env: Env): MalType = + var ast = ast + var env = env + + while true: + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + let val = env.get(ast.str) + if val.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + return val + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + if ast.list.len == 0: return ast + + let a0 = ast.list[0] + if a0.kind == Symbol: + case a0.str + of "def!": + let + a1 = ast.list[1] + a2 = ast.list[2] + return env.set(a1.str, a2.eval(env)) + + of "let*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: raise newException(ValueError, "Illegal kind in let*") + ast = a2 + env = let_env + continue # TCO + + of "do": + let last = ast.list.high + discard (ast.list[1 ..< last].mapIt(it.eval(env))) + ast = ast.list[last] + continue # TCO + + of "if": + let + a1 = ast.list[1] + a2 = ast.list[2] + cond = a1.eval(env) + + if cond.kind in {Nil, False}: + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO + + of "fn*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let fn = proc(a: varargs[MalType]): MalType = + a2.eval(initEnv(env, a1, list(a))) + return malfun(fn, a2, a1, env) + + let f = eval(a0, env) + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO + + return f.fun(args) + +proc print(exp: MalType): string = exp.pr_str + +let repl_env = initEnv() + +for k, v in ns.items: + repl_env.set(k, v) + +# core.nim: defined using nim +proc rep(str: string): string = + str.read.eval(repl_env).print + +# core.mal: defined using mal itself +discard rep "(def! not (fn* (a) (if a false true)))" + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except IOError: quit() + except: + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/step6_file.nim b/impls/nim/step6_file.nim new file mode 100644 index 0000000000..c54de4dc76 --- /dev/null +++ b/impls/nim/step6_file.nim @@ -0,0 +1,127 @@ +import rdstdin, tables, sequtils, os, types, reader, printer, env, core + +proc read(str: string): MalType = str.read_str + +proc eval(ast: MalType, env: Env): MalType = + var ast = ast + var env = env + + while true: + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + let val = env.get(ast.str) + if val.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + return val + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + if ast.list.len == 0: return ast + + let a0 = ast.list[0] + if a0.kind == Symbol: + case a0.str + of "def!": + let + a1 = ast.list[1] + a2 = ast.list[2] + return env.set(a1.str, a2.eval(env)) + + of "let*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: raise newException(ValueError, "Illegal kind in let*") + ast = a2 + env = let_env + continue # TCO + + of "do": + let last = ast.list.high + discard (ast.list[1 ..< last].mapIt(it.eval(env))) + ast = ast.list[last] + continue # TCO + + of "if": + let + a1 = ast.list[1] + a2 = ast.list[2] + cond = a1.eval(env) + + if cond.kind in {Nil, False}: + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO + + of "fn*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let fn = proc(a: varargs[MalType]): MalType = + a2.eval(initEnv(env, a1, list(a))) + return malfun(fn, a2, a1, env) + + let f = eval(a0, env) + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO + + return f.fun(args) + +proc print(exp: MalType): string = exp.pr_str + +let repl_env = initEnv() + +for k, v in ns.items: + repl_env.set(k, v) +repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) +let ps = commandLineParams() +repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) + + +# core.nim: defined using nim +proc rep(str: string): string {.discardable.} = + str.read.eval(repl_env).print + +# core.mal: defined using mal itself +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + +if paramCount() >= 1: + rep "(load-file \"" & paramStr(1) & "\")" + quit() + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except Blank: discard + except IOError: quit() + except: + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/step7_quote.nim b/impls/nim/step7_quote.nim new file mode 100644 index 0000000000..8ab5418d7f --- /dev/null +++ b/impls/nim/step7_quote.nim @@ -0,0 +1,162 @@ +import rdstdin, tables, sequtils, os, types, reader, printer, env, core + +proc read(str: string): MalType = str.read_str + +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + let elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) + +proc quasiquote(ast: MalType): MalType = + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) + else: + result = ast + +proc eval(ast: MalType, env: Env): MalType = + var ast = ast + var env = env + + while true: + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + let val = env.get(ast.str) + if val.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + return val + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + + if ast.list.len == 0: return ast + + let a0 = ast.list[0] + if a0.kind == Symbol: + case a0.str + of "def!": + let + a1 = ast.list[1] + a2 = ast.list[2] + return env.set(a1.str, a2.eval(env)) + + of "let*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: raise newException(ValueError, "Illegal kind in let*") + ast = a2 + env = let_env + continue # TCO + + of "quote": + return ast.list[1] + + of "quasiquote": + ast = ast.list[1].quasiquote + continue # TCO + + of "do": + let last = ast.list.high + discard (ast.list[1 ..< last].mapIt(it.eval(env))) + ast = ast.list[last] + continue # TCO + + of "if": + let + a1 = ast.list[1] + a2 = ast.list[2] + cond = a1.eval(env) + + if cond.kind in {Nil, False}: + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO + + of "fn*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let fn = proc(a: varargs[MalType]): MalType = + a2.eval(initEnv(env, a1, list(a))) + return malfun(fn, a2, a1, env) + + let f = eval(a0, env) + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO + + return f.fun(args) + +proc print(exp: MalType): string = exp.pr_str + +let repl_env = initEnv() + +for k, v in ns.items: + repl_env.set(k, v) +repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) +let ps = commandLineParams() +repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) + + +# core.nim: defined using nim +proc rep(str: string): string {.discardable.} = + str.read.eval(repl_env).print + +# core.mal: defined using mal itself +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + +if paramCount() >= 1: + rep "(load-file \"" & paramStr(1) & "\")" + quit() + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except Blank: discard + except IOError: quit() + except: + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/step8_macros.nim b/impls/nim/step8_macros.nim new file mode 100644 index 0000000000..e379c2d82d --- /dev/null +++ b/impls/nim/step8_macros.nim @@ -0,0 +1,171 @@ +import rdstdin, tables, sequtils, os, types, reader, printer, env, core + +proc read(str: string): MalType = str.read_str + +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + let elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) + +proc quasiquote(ast: MalType): MalType = + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) + else: + result = ast + +proc eval(ast: MalType, env: Env): MalType = + var ast = ast + var env = env + + while true: + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + let val = env.get(ast.str) + if val.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + return val + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + + if ast.list.len == 0: return ast + + let a0 = ast.list[0] + if a0.kind == Symbol: + case a0.str + of "def!": + let + a1 = ast.list[1] + a2 = ast.list[2] + return env.set(a1.str, a2.eval(env)) + + of "let*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: raise newException(ValueError, "Illegal kind in let*") + ast = a2 + env = let_env + continue # TCO + + of "quote": + return ast.list[1] + + of "quasiquote": + ast = ast.list[1].quasiquote + continue # TCO + + of "defmacro!": + let fun = ast.list[2].eval(env) + let mac = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) + return env.set(ast.list[1].str, mac) + + of "do": + let last = ast.list.high + discard (ast.list[1 ..< last].mapIt(it.eval(env))) + ast = ast.list[last] + continue # TCO + + of "if": + let + a1 = ast.list[1] + a2 = ast.list[2] + cond = a1.eval(env) + + if cond.kind in {Nil, False}: + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO + + of "fn*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let fn = proc(a: varargs[MalType]): MalType = + a2.eval(initEnv(env, a1, list(a))) + return malfun(fn, a2, a1, env) + + let f = eval(a0, env) + if f.fun_is_macro: + ast = f.malfun.fn(ast.list[1 .. ^1]) + continue # TCO + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO + + return f.fun(args) + +proc print(exp: MalType): string = exp.pr_str + +let repl_env = initEnv() + +for k, v in ns.items: + repl_env.set(k, v) +repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) +let ps = commandLineParams() +repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) + + +# core.nim: defined using nim +proc rep(str: string): string {.discardable.} = + str.read.eval(repl_env).print + +# core.mal: defined using mal itself +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + +if paramCount() >= 1: + rep "(load-file \"" & paramStr(1) & "\")" + quit() + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except Blank: discard + except IOError: quit() + except: + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/step9_try.nim b/impls/nim/step9_try.nim new file mode 100644 index 0000000000..ca8effaac8 --- /dev/null +++ b/impls/nim/step9_try.nim @@ -0,0 +1,195 @@ +import rdstdin, tables, sequtils, os, types, reader, printer, env, core + +proc read(str: string): MalType = str.read_str + +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + let elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) + +proc quasiquote(ast: MalType): MalType = + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) + else: + result = ast + +proc eval(ast: MalType, env: Env): MalType = + var ast = ast + var env = env + + while true: + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + let val = env.get(ast.str) + if val.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + return val + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + + if ast.list.len == 0: return ast + + let a0 = ast.list[0] + if a0.kind == Symbol: + case a0.str + of "def!": + let + a1 = ast.list[1] + a2 = ast.list[2] + res = a2.eval(env) + return env.set(a1.str, res) + + of "let*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: raise newException(ValueError, "Illegal kind in let*") + ast = a2 + env = let_env + continue # TCO + + of "quote": + return ast.list[1] + + of "quasiquote": + ast = ast.list[1].quasiquote + continue # TCO + + of "defmacro!": + let fun = ast.list[2].eval(env) + let mac = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) + return env.set(ast.list[1].str, mac) + + of "try*": + let a1 = ast.list[1] + if ast.list.len <= 2: + ast = a1 + continue # TCO + let a2 = ast.list[2] + try: + return a1.eval(env) + except MalError: + let exc = (ref MalError) getCurrentException() + env = initEnv(env, list a2.list[1], exc.t) + ast = a2.list[2] + continue # TCO + except: + let exc = getCurrentExceptionMsg() + env = initEnv(env, list a2.list[1], list str (exc)) + ast = a2.list[2] + continue # TCO + + of "do": + let last = ast.list.high + discard (ast.list[1 ..< last].mapIt(it.eval(env))) + ast = ast.list[last] + continue # TCO + + of "if": + let + a1 = ast.list[1] + a2 = ast.list[2] + cond = a1.eval(env) + + if cond.kind in {Nil, False}: + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO + + of "fn*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let fn = proc(a: varargs[MalType]): MalType = + a2.eval(initEnv(env, a1, list(a))) + return malfun(fn, a2, a1, env) + + let f = eval(a0, env) + if f.fun_is_macro: + ast = f.malfun.fn(ast.list[1 .. ^1]) + continue # TCO + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO + + return f.fun(args) + +proc print(exp: MalType): string = exp.pr_str + +let repl_env = initEnv() + +for k, v in ns.items: + repl_env.set(k, v) +repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) +let ps = commandLineParams() +repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) + + +# core.nim: defined using nim +proc rep(str: string): string {.discardable.} = + str.read.eval(repl_env).print + +# core.mal: defined using mal itself +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + +if paramCount() >= 1: + rep "(load-file \"" & paramStr(1) & "\")" + quit() + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except Blank: discard + except IOError: quit() + except MalError: + let exc = (ref MalError) getCurrentException() + echo "Error: " & exc.t.list[0].pr_str + except: + stdout.write "Error: " + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/stepA_mal.nim b/impls/nim/stepA_mal.nim new file mode 100644 index 0000000000..526e30404b --- /dev/null +++ b/impls/nim/stepA_mal.nim @@ -0,0 +1,198 @@ +import rdstdin, tables, sequtils, os, types, reader, printer, env, core + +proc read(str: string): MalType = str.read_str + +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + let elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) + +proc quasiquote(ast: MalType): MalType = + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) + else: + result = ast + +proc eval(ast: MalType, env: Env): MalType = + var ast = ast + var env = env + + while true: + + let dbgeval = env.get("DEBUG-EVAL") + if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): + echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + let val = env.get(ast.str) + if val.isNil: + raise newException(ValueError, "'" & ast.str & "' not found") + return val + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + + if ast.list.len == 0: return ast + + let a0 = ast.list[0] + if a0.kind == Symbol: + case a0.str + of "def!": + let + a1 = ast.list[1] + a2 = ast.list[2] + res = a2.eval(env) + return env.set(a1.str, res) + + of "let*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let let_env = initEnv(env) + case a1.kind + of List, Vector: + for i in countup(0, a1.list.high, 2): + let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) + else: raise newException(ValueError, "Illegal kind in let*") + ast = a2 + env = let_env + continue # TCO + + of "quote": + return ast.list[1] + + of "quasiquote": + ast = ast.list[1].quasiquote + continue # TCO + + of "defmacro!": + let fun = ast.list[2].eval(env) + let mac = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) + return env.set(ast.list[1].str, mac) + + of "try*": + let a1 = ast.list[1] + if ast.list.len <= 2: + ast = a1 + continue # TCO + let a2 = ast.list[2] + try: + return a1.eval(env) + except MalError: + let exc = (ref MalError) getCurrentException() + env = initEnv(env, list a2.list[1], exc.t) + ast = a2.list[2] + continue # TCO + except: + let exc = getCurrentExceptionMsg() + env = initEnv(env, list a2.list[1], list str (exc)) + ast = a2.list[2] + continue # TCO + + of "do": + let last = ast.list.high + discard (ast.list[1 ..< last].mapIt(it.eval(env))) + ast = ast.list[last] + continue # TCO + + of "if": + let + a1 = ast.list[1] + a2 = ast.list[2] + cond = a1.eval(env) + + if cond.kind in {Nil, False}: + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO + + of "fn*": + let + a1 = ast.list[1] + a2 = ast.list[2] + let fn = proc(a: varargs[MalType]): MalType = + a2.eval(initEnv(env, a1, list(a))) + return malfun(fn, a2, a1, env) + + let f = eval(a0, env) + if f.fun_is_macro: + ast = f.malfun.fn(ast.list[1 .. ^1]) + continue # TCO + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO + + return f.fun(args) + +proc print(exp: MalType): string = exp.pr_str + +let repl_env = initEnv() + +for k, v in ns.items: + repl_env.set(k, v) +repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) +let ps = commandLineParams() +repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) + + +# core.nim: defined using nim +proc rep(str: string): string {.discardable.} = + str.read.eval(repl_env).print + +# core.mal: defined using mal itself +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" +rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +rep "(def! *host-language* \"nim\")" + +if paramCount() >= 1: + rep "(load-file \"" & paramStr(1) & "\")" + quit() + +rep "(println (str \"Mal [\" *host-language* \"]\"))" + +while true: + try: + let line = readLineFromStdin("user> ") + echo line.rep + except Blank: discard + except IOError: quit() + except MalError: + let exc = (ref MalError) getCurrentException() + echo "Error: " & exc.t.list[0].pr_str + except: + stdout.write "Error: " + echo getCurrentExceptionMsg() + echo getCurrentException().getStackTrace() diff --git a/impls/nim/tests/step5_tco.mal b/impls/nim/tests/step5_tco.mal new file mode 100644 index 0000000000..522de3e30e --- /dev/null +++ b/impls/nim/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Nim: skipping non-TCO recursion +;; Reason: completes at 10,000, unrecoverable segfault 20,000 diff --git a/nim/types.nim b/impls/nim/types.nim similarity index 86% rename from nim/types.nim rename to impls/nim/types.nim index 56983ff996..5deae49224 100644 --- a/nim/types.nim +++ b/impls/nim/types.nim @@ -1,4 +1,4 @@ -import tables, strutils +import tables type MalTypeKind* = enum Nil, True, False, Number, Symbol, String, @@ -64,7 +64,7 @@ proc hash_map*(xs: varargs[MalType]): MalType {.procvar.} = else: xs[i].str result.hash_map[s] = xs[i+1] -proc macro_q*(x: MalType): bool = +proc fun_is_macro*(x: MalType): bool = if x.kind == Fun: result = x.is_macro elif x.kind == MalFun: result = x.malfun.is_macro else: raise newException(ValueError, "no function") @@ -109,6 +109,9 @@ proc true_q*(xs: varargs[MalType]): MalType {.procvar.} = proc false_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == False +proc string_q*(xs: varargs[MalType]): MalType {.procvar.} = + boolObj(xs[0].kind == String and (xs[0].str.len == 0 or xs[0].str[0] != '\xff')) + proc symbol*(xs: varargs[MalType]): MalType {.procvar.} = symbol(xs[0].str) @@ -116,10 +119,20 @@ proc symbol_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == Symbol proc keyword*(xs: varargs[MalType]): MalType {.procvar.} = - keyword(xs[0].str) + if 0 < xs[0].str.len and xs[0].str[0] == '\xff': xs[0] + else: keyword(xs[0].str) proc keyword_q*(xs: varargs[MalType]): MalType {.procvar.} = - boolObj(xs[0].kind == String and xs[0].str[0] == '\xff') + boolObj(xs[0].kind == String and xs[0].str.len > 0 and xs[0].str[0] == '\xff') + +proc number_q*(xs: varargs[MalType]): MalType {.procvar.} = + boolObj xs[0].kind == Number + +proc fn_q*(xs: varargs[MalType]): MalType {.procvar.} = + boolObj((xs[0].kind == MalFun or xs[0].kind == Fun) and not xs[0].fun_is_macro) + +proc macro_q*(xs: varargs[MalType]): MalType {.procvar.} = + boolObj((xs[0].kind == MalFun or xs[0].kind == Fun) and xs[0].fun_is_macro) proc atom*(xs: varargs[MalType]): MalType {.procvar.} = atom(xs[0]) diff --git a/impls/objc/Dockerfile b/impls/objc/Dockerfile new file mode 100644 index 0000000000..fa7e6788f1 --- /dev/null +++ b/impls/objc/Dockerfile @@ -0,0 +1,62 @@ +M ubuntu:vivid +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Based on: +# https://blog.tlensing.org/2013/02/24/objective-c-on-linux-setting-up-gnustep-clang-llvm-objective-c-2-0-blocks-runtime-gcd-on-ubuntu-12-04/ + +RUN apt-get -y install build-essential clang libblocksruntime-dev \ + libkqueue-dev libpthread-workqueue-dev gobjc libxml2-dev \ + libjpeg-dev libtiff-dev libpng12-dev libcups2-dev \ + libfreetype6-dev libcairo2-dev libxt-dev libgl1-mesa-dev + +RUN mkdir -p /root/gnustep-dev +RUN cd /root/gnustep-dev && \ + curl http://download.gna.org/gnustep/libobjc2-1.7.tar.bz2 \ + | tar xjf - +RUN cd /root/gnustep-dev && \ + curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-make-2.6.7.tar.gz \ + | tar xzf - +RUN cd /root/gnustep-dev && \ + curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-base-1.24.8.tar.gz \ + | tar xzf - +RUN cd /root/gnustep-dev && \ + curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-gui-0.24.1.tar.gz \ + | tar xzf - +RUN cd /root/gnustep-dev && \ + curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-back-0.24.1.tar.gz \ + | tar xzf - + + +# TODO move up +RUN apt-get -y install gnutls-dev libxslt-dev libffi-dev openssl + +ENV CC clang +RUN cd /root/gnustep-dev/libobjc2-1.7 && make && make install +RUN cd /root/gnustep-dev/gnustep-make-2.6.7 && ./configure && make && make install +RUN cd /root/gnustep-dev/gnustep-base-1.24.8 && ./configure && make && make install && ldconfig +RUN cd /root/gnustep-dev/gnustep-gui-0.24.1 && ./configure && make && make install +RUN cd /root/gnustep-dev/gnustep-back-0.24.1 && ./configure && make && make install + +RUN apt-get -y install libdispatch-dev + +ENV HOME /mal diff --git a/impls/objc/Makefile b/impls/objc/Makefile new file mode 100644 index 0000000000..7e6fa2a07c --- /dev/null +++ b/impls/objc/Makefile @@ -0,0 +1,50 @@ +STEP0_DEPS = mal_readline.c mal_readline.h +STEP1_DEPS = $(STEP0_DEPS) types.h types.m reader.h reader.m printer.h printer.m +STEP2_DEPS = $(STEP1_DEPS) +STEP3_DEPS = $(STEP2_DEPS) env.m +STEP4_DEPS = $(STEP3_DEPS) malfunc.h malfunc.m core.h core.m + +STEPS = step0_repl step1_read_print step2_eval step3_env \ + step4_if_fn_do step5_tco step6_file step7_quote \ + step8_macros step9_try stepA_mal + +# From: https://blog.tlensing.org/2013/02/24/objective-c-on-linux-setting-up-gnustep-clang-llvm-objective-c-2-0-blocks-runtime-gcd-on-ubuntu-12-04/: +# clang `gnustep-config --objc-flags` -o main -x objective-c main.m -fconstant-string-class=NSConstantString -fobjc-nonfragile-abi -fblocks -lgnustep-base -lgnustep-gui -ldispatch -I/usr/local/include/GNUstep -L/usr/local/lib/GNUstep + +OS := $(shell uname) + +## Bizzare gnustep-config/make interaction causes make to get run +## during gnustep-config so we need to remove make output +ifeq ($(OS),Darwin) +CC = clang -framework Foundation +OBJC_LIBS := -lobjc -lreadline +else +#CC = clang -fblocks -fobjc-nonfragile-abi -fobjc-arc +CC = clang -fblocks -fobjc-nonfragile-abi +OBJC_FLAGS := $(shell gnustep-config --objc-flags 2>/dev/null | egrep -v "Entering|Leaving") +OBJC_LIBS := $(filter-out -shared-libgcc,$(shell gnustep-config --base-libs 2>/dev/null | egrep -v "Entering|Leaving")) -ldispatch -lreadline +endif + +all: $(STEPS) + +dist: mal + +mal: stepA_mal + cp $< $@ + +step0_repl: $(STEP0_DEPS) +step1_read_print: $(STEP1_DEPS) +step2_eval: $(STEP2_DEPS) +step3_env: $(STEP3_DEPS) +step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) + +step%: step%.m + $(CC) \ + -xobjective-c $(filter-out %.h mal_readline%,$+) \ + -xc mal_readline.c \ + -o $@ \ + $(OBJC_FLAGS) \ + $(OBJC_LIBS) + +clean: + rm -f $(STEPS) *.o *.d mal diff --git a/impls/objc/core.h b/impls/objc/core.h new file mode 100644 index 0000000000..de078bd8a3 --- /dev/null +++ b/impls/objc/core.h @@ -0,0 +1,7 @@ +#import + +@interface Core : NSObject + ++ (NSDictionary *)ns; + +@end diff --git a/impls/objc/core.m b/impls/objc/core.m new file mode 100644 index 0000000000..a1fcb58e23 --- /dev/null +++ b/impls/objc/core.m @@ -0,0 +1,362 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "malfunc.h" +#import "core.h" +#import + +NSObject * wrap_tf(BOOL val) { + return val ? [MalTrue alloc] : [MalFalse alloc]; +} + +@implementation Core + ++ (NSDictionary *)ns { + return @{ + @"=": ^(NSArray *args){ + return wrap_tf(equal_Q(args[0], args[1])); + }, + @"throw": ^(NSArray *args){ + @throw args[0]; + }, + + @"nil?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[NSNull class]]); + }, + @"true?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[MalTrue class]]); + }, + @"false?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[MalFalse class]]); + }, + @"string?": ^(NSArray *args){ + return wrap_tf(string_Q(args[0])); + }, + @"symbol": ^(NSArray *args){ + return [MalSymbol stringWithString:args[0]]; + }, + @"symbol?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[MalSymbol class]]); + }, + @"keyword": ^(NSArray *args){ + if (string_Q(args[0])) { + return [NSString stringWithFormat:@"\u029e%@", args[0]]; + } else { + return args[0]; + } + }, + @"keyword?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[NSString class]] && + ![args[0] isKindOfClass:[MalSymbol class]] && + !string_Q(args[0])); + }, + @"number?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[NSNumber class]]); + }, + @"fn?": ^(NSArray *args){ + return wrap_tf(block_Q(args[0]) || + ([args[0] isKindOfClass:[MalFunc class]] && ![(MalFunc *)args[0] isMacro])); + }, + @"macro?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[MalFunc class]] && [(MalFunc *)args[0] isMacro]); + }, + + @"pr-str": ^(NSArray *args){ + NSMutableArray * res = [NSMutableArray array]; + for (id e in args) { [res addObject:_pr_str(e,true)]; } + return [res componentsJoinedByString:@" "]; + }, + @"str": ^(NSArray *args){ + NSMutableArray * res = [NSMutableArray array]; + for (id e in args) { [res addObject:_pr_str(e,false)]; } + return [res componentsJoinedByString:@""]; + }, + @"prn": ^(NSArray *args){ + NSMutableArray * res = [NSMutableArray array]; + for (id e in args) { [res addObject:_pr_str(e,true)]; } + printf("%s\n", [[res componentsJoinedByString:@" "] UTF8String]); + fflush(stdout); + return [NSNull alloc]; + }, + @"println": ^(NSArray *args){ + NSMutableArray * res = [NSMutableArray array]; + for (id e in args) { [res addObject:_pr_str(e,false)]; } + printf("%s\n", [[res componentsJoinedByString:@" "] UTF8String]); + fflush(stdout); + return [NSNull alloc]; + }, + @"read-string": ^(NSArray *args){ + return read_str(args[0]); + }, + @"readline": ^(NSArray *args){ + char * rawline = _readline((char *)[(NSString *)args[0] UTF8String]); + if (rawline) { + return (NSObject *)[NSString stringWithUTF8String:rawline]; + } else { + return (NSObject *)[NSNull alloc]; + } + }, + @"slurp": ^(NSArray *args){ + return [NSString stringWithContentsOfFile:args[0] + encoding: NSUTF8StringEncoding + error: NULL]; + }, + + @"<": ^(NSArray *args){ + return wrap_tf([args[0] intValue] < [args[1] intValue]); + }, + @"<=": ^(NSArray *args){ + return wrap_tf([args[0] intValue] <= [args[1] intValue]); + }, + @">": ^(NSArray *args){ + return wrap_tf([args[0] intValue] > [args[1] intValue]); + }, + @">=": ^(NSArray *args){ + return wrap_tf([args[0] intValue] >= [args[1] intValue]); + }, + @"+": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] + [args[1] intValue]]; + }, + @"-": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] - [args[1] intValue]]; + }, + @"*": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] * [args[1] intValue]]; + }, + @"/": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] / [args[1] intValue]]; + }, + @"time-ms": ^(NSArray *args){ + long long ms = [[NSDate date] timeIntervalSince1970] * 1000; + return [NSNumber numberWithUnsignedInteger:ms]; + }, + + @"list": ^(NSArray *args){ + return args; + }, + @"list?": ^(NSArray *args){ + return wrap_tf(list_Q(args[0])); + }, + @"vector": ^(NSArray *args){ + return [MalVector fromArray:args]; + }, + @"vector?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[MalVector class]]); + }, + @"hash-map": ^(NSArray *args){ + return hash_map(args); + }, + @"map?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[NSDictionary class]]); + }, + @"assoc": ^(NSArray *args){ + NSDictionary * dict = args[0]; + NSMutableDictionary * new_dict = [[NSMutableDictionary alloc] + initWithDictionary:dict + copyItems:NO]; + return assoc_BANG(new_dict, _rest(args)); + }, + @"dissoc": ^(NSArray *args){ + NSDictionary * dict = args[0]; + NSMutableDictionary * new_dict = [[NSMutableDictionary alloc] + initWithDictionary:dict + copyItems:NO]; + for (NSString * key in _rest(args)) { + [new_dict removeObjectForKey:key]; + } + return new_dict; + }, + @"get": ^(NSArray *args){ + if ([args[0] isKindOfClass:[NSNull class]]) { + return (NSObject *)[NSNull alloc]; + } + NSObject * res = ((NSDictionary *)args[0])[args[1]]; + return res ? res : [NSNull alloc]; + }, + @"contains?": ^(NSArray *args){ + if ([args[0] isKindOfClass:[NSNull class]]) { + return wrap_tf(false); + } + return wrap_tf(((NSDictionary *)args[0])[args[1]] != nil); + }, + @"keys": ^(NSArray *args){ + return [(NSDictionary *)args[0] allKeys]; + }, + @"vals": ^(NSArray *args){ + return [(NSDictionary *)args[0] allValues]; + }, + + @"sequential?": ^(NSArray *args){ + return wrap_tf([args[0] isKindOfClass:[NSArray class]]); + }, + @"cons": ^(NSArray *args){ + NSMutableArray * res = [NSMutableArray array]; + [res addObject:args[0]]; + [res addObjectsFromArray:args[1]]; + return res; + }, + @"concat": ^(NSArray *args){ + NSMutableArray * res = [NSMutableArray array]; + for (NSArray * arr in args) { + [res addObjectsFromArray:arr]; + } + return res; + }, + @"vec": ^(NSArray *args){ + return [MalVector fromArray:args[0]]; + }, + @"nth": ^(NSArray *args){ + NSArray * lst = (NSArray *)args[0]; + int idx = [(NSNumber *)args[1] intValue]; + if (idx < [lst count]) { + return lst[idx]; + } else { + @throw @"nth: index out of range"; + } + }, + @"first": ^(NSArray *args){ + if ([args[0] isKindOfClass:[NSNull class]]) { + return (NSObject *)[NSNull alloc]; + } + NSArray * lst = (NSArray *)args[0]; + if ([lst count] > 0) { + return (NSObject *)lst[0]; + } else { + return (NSObject *)[NSNull alloc]; + } + }, + @"rest": ^(NSArray *args){ + if ([args[0] isKindOfClass:[NSNull class]]) { + return @[]; + } + NSArray * lst = (NSArray *)args[0]; + if ([lst count] > 1) { + return _rest(lst); + } else { + return @[]; + } + }, + @"empty?": ^(NSArray *args){ + if ([args[0] isKindOfClass:[NSNull class]]) { + return wrap_tf(true); + } else { + return wrap_tf([args[0] count] == 0); + } + }, + @"count": ^(NSArray *args){ + if ([args[0] isKindOfClass:[NSNull class]]) { + return @0; + } else { + return [NSNumber numberWithInt:[args[0] count]]; + } + }, + @"apply": ^(NSArray *args){ + NSObject * (^ f)(NSArray *) = args[0]; + NSMutableArray * fargs = [NSMutableArray array]; + if ([args count] > 1) { + NSRange r = NSMakeRange(1, [args count]-2); + [fargs addObjectsFromArray:[args subarrayWithRange:r]]; + } + [fargs addObjectsFromArray:(NSArray *)[args lastObject]]; + return apply(f, fargs); + }, + @"map": ^(NSArray *args){ + NSObject * (^ f)(NSArray *) = args[0]; + NSMutableArray * res = [NSMutableArray array]; + for (NSObject * x in (NSArray *)args[1]) { + [res addObject:apply(f, @[x])]; + } + return res; + }, + @"conj": ^(NSArray *args){ + NSMutableArray * res = [NSMutableArray array]; + if ([args[0] isKindOfClass:[MalVector class]]) { + [res addObjectsFromArray:args[0]]; + [res addObjectsFromArray:_rest(args)]; + return (NSObject *)[MalVector fromArray:res]; + } else { + [res addObjectsFromArray:[[_rest(args) reverseObjectEnumerator] + allObjects]]; + [res addObjectsFromArray:args[0]]; + return (NSObject *)res; + } + }, + @"seq": ^(NSArray *args){ + if (list_Q(args[0])) { + if ([args[0] count] == 0) { return (NSObject *)[NSNull alloc]; } + return (NSObject *)args[0]; + } else if ([args[0] isKindOfClass:[MalVector class]]) { + if ([args[0] count] == 0) { return (NSObject *)[NSNull alloc]; } + return (NSObject *)[NSArray arrayWithArray:args[0]]; + } else if (string_Q(args[0])) { + NSString * str = args[0]; + if ([str length] == 0) { return (NSObject *)[NSNull alloc]; } + NSMutableArray * res = [NSMutableArray array]; + for (int i=0; i < [str length]; i++) { + char c = [str characterAtIndex:i]; + [res addObject:[NSString stringWithFormat:@"%c", c]]; + } + return (NSObject *)res; + } else if ([args[0] isKindOfClass:[NSNull class]]) { + return (NSObject *)args[0]; + } else { + @throw @"seq: called on non-sequence"; + } + }, + + @"meta": ^id (NSArray *args){ + if ([args[0] isKindOfClass:[MalFunc class]]) { + return [(MalFunc *)args[0] meta]; + } else { + id res = objc_getAssociatedObject(args[0], @"meta"); + return res ? res : (NSObject *)[NSNull alloc]; + } + }, + @"with-meta": ^id (NSArray *args){ + if ([args[0] isKindOfClass:[MalFunc class]]) { + MalFunc * cmf = [(MalFunc *)args[0] copy]; + cmf.meta = args[1]; + return cmf; + } else if (!block_Q(args[0])) { + id res = [args[0] copy]; + objc_setAssociatedObject(res, @"meta", args[1], OBJC_ASSOCIATION_RETAIN_NONATOMIC); + return res; + } else { + id (^blk)(NSArray *args) = args[0]; + id (^wrapBlock)(NSArray *args) = ^id (NSArray *args) { return blk(args); }; + id (^res)(NSArray *args) = [wrapBlock copy]; // under mrc: copy to get a malloc block instead of a stack block. + objc_setAssociatedObject(res, @"meta", args[1], OBJC_ASSOCIATION_RETAIN_NONATOMIC); + return res; + } + }, + @"atom": ^(NSArray *args){ + return [MalAtom fromObject:args[0]]; + }, + @"atom?": ^(NSArray *args){ + return wrap_tf(atom_Q(args[0])); + }, + @"deref": ^(NSArray *args){ + return [(MalAtom *)args[0] val]; + }, + @"reset!": ^(NSArray *args){ + MalAtom * atm = (MalAtom *)args[0]; + return atm.val = args[1]; + }, + @"swap!": ^(NSArray *args){ + MalAtom * atm = (MalAtom *)args[0]; + NSObject * (^ f)(NSArray *) = args[1]; + NSMutableArray * fargs = [NSMutableArray array]; + [fargs addObject:atm.val]; + if ([args count] > 2) { + NSRange r = NSMakeRange(2, [args count]-2); + [fargs addObjectsFromArray:[args subarrayWithRange:r]]; + } + return atm.val = apply(f, fargs); + }, + }; +} + +@end diff --git a/impls/objc/env.h b/impls/objc/env.h new file mode 100644 index 0000000000..58437c58d7 --- /dev/null +++ b/impls/objc/env.h @@ -0,0 +1,3 @@ +#import + +// See types.h for Env interface definition diff --git a/impls/objc/env.m b/impls/objc/env.m new file mode 100644 index 0000000000..4dde577a9e --- /dev/null +++ b/impls/objc/env.m @@ -0,0 +1,66 @@ +#import + +#import "types.h" +//#import "env.h" + +@implementation Env + +@synthesize data = _data; +@synthesize outer = _outer; + +- (id)initWithBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs { + self = [super init]; + if (self) { + _outer = outer; + _data = [NSMutableDictionary dictionary]; + + for (int i=0; i < [binds count]; i++) { + if ([(NSString *)binds[i] isEqualTo:@"&"]) { + if ([exprs count] > i) { + NSRange r = NSMakeRange(i, [exprs count] - i); + _data[binds[i+1]] = [exprs subarrayWithRange:r]; + } else { + _data[binds[i+1]] = @[]; + } + break; + } else { + _data[binds[i]] = exprs[i]; + } + } + } + return self; +} + +- (id)initWithOuter:(Env *)outer { + return [self initWithBindings:outer binds:@[] exprs:@[]]; +} + +- (id)init { + return [self initWithBindings:nil binds:@[] exprs:@[]]; +} + ++ (id)fromOuter:(Env *)outer { + return [[Env alloc] initWithOuter:outer]; +} + ++ (id)fromBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs { + return [[Env alloc] initWithBindings:outer binds:binds exprs:exprs]; +} + +- (NSObject *) set:(MalSymbol *)key val:(NSObject *)val { + _data[key] = val; + return val; +} + +- (NSObject *) get:(MalSymbol *)key { + NSObject * value; + Env * e = self; + while (true) { + value = e.data[key]; + if (value != nil) return value; + e = e.outer; + if (e == nil) return nil; + } +} + +@end diff --git a/impls/objc/mal_readline.c b/impls/objc/mal_readline.c new file mode 100644 index 0000000000..3594a1a0db --- /dev/null +++ b/impls/objc/mal_readline.c @@ -0,0 +1,75 @@ +#include +#include +#include + +#if USE_READLINE + #include + #include + #include +#else + #include +#endif + +int history_loaded = 0; + +char HISTORY_FILE[] = "~/.mal-history"; + +void load_history() { + if (history_loaded) { return; } + int ret; + char *hf = tilde_expand(HISTORY_FILE); + if (access(hf, F_OK) != -1) { + // TODO: check if file exists first, use non-static path +#if USE_READLINE + ret = read_history(hf); +#else + FILE *fp = fopen(hf, "r"); + char *line = malloc(80); // getline reallocs as necessary + size_t sz = 80; + while ((ret = getline(&line, &sz, fp)) > 0) { + add_history(line); // Add line to in-memory history + } + free(line); + fclose(fp); +#endif + history_loaded = 1; + } + free(hf); +} + +void append_to_history() { + char *hf = tilde_expand(HISTORY_FILE); +#ifdef USE_READLINE + append_history(1, hf); +#else +#if defined(RL_READLINE_VERSION) + HIST_ENTRY *he = history_get(history_base+history_length-1); +#else + // libedit-2 segfaults if we add history_base + HIST_ENTRY *he = history_get(history_length-1); +#endif + FILE *fp = fopen(hf, "a"); + if (fp) { + fprintf(fp, "%s\n", he->line); + fclose(fp); + } +#endif + free(hf); +} + + +// line must be freed by caller +char *_readline (char prompt[]) { + char *line; + + load_history(); + + line = readline(prompt); + if (!line) return NULL; // EOF + add_history(line); // Add input to in-memory history + + append_to_history(); // Flush new line of history to disk + + return line; +} + diff --git a/impls/objc/mal_readline.h b/impls/objc/mal_readline.h new file mode 100644 index 0000000000..d524f4a0f0 --- /dev/null +++ b/impls/objc/mal_readline.h @@ -0,0 +1,6 @@ +#ifndef __MAL_READLINE__ +#define __MAL_READLINE__ + +char *_readline (char prompt[]); + +#endif diff --git a/impls/objc/malfunc.h b/impls/objc/malfunc.h new file mode 100644 index 0000000000..79f772c26a --- /dev/null +++ b/impls/objc/malfunc.h @@ -0,0 +1,24 @@ +#import + +/* +// Forward declaration of Env (see env.h for full interface) +@class Env; +*/ +// Forward declaration of EVAL function +NSObject *EVAL(id ast, id env); + +@interface MalFunc : NSObject + +@property (copy) NSArray * ast; +@property (copy) Env * env; +@property (copy) NSArray * params; +@property BOOL isMacro; +@property (copy) NSObject * meta; + +- (id)init:(NSArray *)ast env:(Env *)env params:(NSArray *)params; + +- (id)apply:(NSArray *)args; + +@end + +NSObject * apply(id f, NSArray *args); diff --git a/impls/objc/malfunc.m b/impls/objc/malfunc.m new file mode 100644 index 0000000000..060c63d72b --- /dev/null +++ b/impls/objc/malfunc.m @@ -0,0 +1,49 @@ +#import "types.h" + +#import "malfunc.h" + +@implementation MalFunc + +@synthesize ast = _ast; +@synthesize env = _env; +@synthesize params = _params; +@synthesize isMacro = _isMacro; +@synthesize meta = _meta; + +- (id)init:(NSArray *)ast env:(Env *)env params:(NSArray *)params { + self = [super init]; + if (self) { + _ast = ast; + _env = env; + _params = params; + _isMacro = false; + _meta = [NSNull alloc]; + } + return self; +} + +- (id)apply:(NSArray *)args { + return EVAL(_ast, [Env fromBindings:_env binds:_params exprs:args]); +} + +- (id)copyWithZone:(NSZone *)zone +{ + MalFunc * copy = [[[self class] alloc] init:_ast env:_env params:_params]; + if (copy) { + copy.isMacro = _isMacro; + copy.meta = _meta; + } + return copy; +} + +@end + + +NSObject * apply(id f, NSArray *args) { + if ([f isKindOfClass:[MalFunc class]]) { + return [f apply:args]; + } else { + NSObject * (^ fn)(NSArray *) = f; + return fn(args); + } +} diff --git a/impls/objc/printer.h b/impls/objc/printer.h new file mode 100644 index 0000000000..19d785dfd9 --- /dev/null +++ b/impls/objc/printer.h @@ -0,0 +1,3 @@ +#import + +NSString * _pr_str(NSObject * obj, BOOL print_readably); diff --git a/impls/objc/printer.m b/impls/objc/printer.m new file mode 100644 index 0000000000..c3b93ea3de --- /dev/null +++ b/impls/objc/printer.m @@ -0,0 +1,58 @@ +#import + +#import "types.h" + +NSString * _pr_str(NSObject * obj, BOOL print_readably) { + //NSLog(@"class: %@", [obj class]); + if ([obj isMemberOfClass:[NSNull class]]) { + return @"nil"; + } else if ([obj isMemberOfClass:[MalTrue class]]) { + return @"true"; + } else if ([obj isMemberOfClass:[MalFalse class]]) { + return @"false"; + } else if ([obj isKindOfClass:[MalSymbol class]]) { + return (NSString *) obj; + } else if ([obj isKindOfClass:[NSString class]]) { + NSString * str = (NSString *)obj; + if ([str length] > 0 && ([str hasPrefix:@"\u029e"])) { + return [NSString stringWithFormat:@":%@", + [str substringWithRange:NSMakeRange(1, [str length]-1)]]; + } else if (print_readably) { + str = [[[(NSString *)obj + stringByReplacingOccurrencesOfString:@"\\" withString:@"\\\\"] + stringByReplacingOccurrencesOfString:@"\"" withString:@"\\\""] + stringByReplacingOccurrencesOfString:@"\n" withString:@"\\n"]; + return [NSString stringWithFormat:@"\"%@\"", str]; + } else { + return [NSString stringWithString:str]; + } + } else if ([obj isKindOfClass:[NSArray class]]) { + NSMutableArray * elems = [NSMutableArray array]; + for (NSObject * elem in (NSArray *)obj) { + [elems addObject:_pr_str(elem, print_readably)]; + } + if ([obj isKindOfClass:[MalVector class]]) { + return [NSString stringWithFormat:@"[%@]", + [elems componentsJoinedByString:@" "]]; + } else { + return [NSString stringWithFormat:@"(%@)", + [elems componentsJoinedByString:@" "]]; + } + } else if ([obj isKindOfClass:[NSDictionary class]]) { + NSDictionary * dict = (NSDictionary *)obj; + NSMutableArray * elems = [NSMutableArray array]; + for (NSString * key in dict) { + [elems addObject:_pr_str(key, print_readably)]; + [elems addObject:_pr_str(dict[key], print_readably)]; + } + return [NSString stringWithFormat:@"{%@}", + [elems componentsJoinedByString:@" "]]; + } else if (block_Q(obj)) { + return @"#"; + } else if (atom_Q(obj)) { + return [NSString stringWithFormat:@"(atom %@)", + _pr_str([(MalAtom *)obj val], print_readably)]; + } else { + return [obj description]; + } +} diff --git a/impls/objc/reader.h b/impls/objc/reader.h new file mode 100644 index 0000000000..5e737b047d --- /dev/null +++ b/impls/objc/reader.h @@ -0,0 +1,2 @@ +NSArray * tokenize(NSString *str); +NSObject * read_str(NSString *str); diff --git a/impls/objc/reader.m b/impls/objc/reader.m new file mode 100644 index 0000000000..f187b064e4 --- /dev/null +++ b/impls/objc/reader.m @@ -0,0 +1,194 @@ +#import + +#import "types.h" + +// Only used here, so define interface locally +@interface Reader : NSObject + +- (id)initWithTokens:(NSArray *)toks; +- (id)init; + +- (NSString *) next; +- (NSString *) peek; + +@end + + +@implementation Reader + +NSArray *_tokens; +int _position; + +- (id)initWithTokens:(NSArray *)toks { + self = [super init]; + if (self) { + _tokens = toks; + _position = 0; + } + return self; +} + +- (id)init { + return [self initWithTokens:@[]]; +} + +- (NSString *)next { + _position++; + return _tokens[_position-1]; +} + +- (NSString *)peek { + if ([_tokens count] > _position) { + return _tokens[_position]; + } else { + return nil; + } +} + +@end + + +NSArray * tokenize(NSString *str) { + NSRegularExpression *regex = [NSRegularExpression + regularExpressionWithPattern:@"[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}()'\"`@,;]+)" + options:0 + error:NULL]; + + NSArray *matches = [regex + matchesInString:str + options:0 + range:NSMakeRange(0, [str length])]; + + NSMutableArray * tokens = [NSMutableArray array]; + for (NSTextCheckingResult *match in matches) { + NSString * mstr = [str substringWithRange:[match rangeAtIndex:1]]; + if ([mstr characterAtIndex:0] == ';') { continue; } + [tokens addObject:mstr]; + } + return tokens; +} + +NSObject * read_atom(Reader * rdr) { + NSRegularExpression *regex = [NSRegularExpression + regularExpressionWithPattern:@"(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"((?:[\\\\].|[^\\\\\"])*)\"$|^\"(.*)$|:(.*)|(^[^\"]*$)" + options:0 + error:NULL]; + NSNumberFormatter *numf = [[NSNumberFormatter alloc] init]; + numf.numberStyle = NSNumberFormatterDecimalStyle; + + NSString *token = [rdr next]; + + NSArray *matches = [regex + matchesInString:token + options:0 + range:NSMakeRange(0, [token length])]; + + if ([matches count] > 0) { + + NSTextCheckingResult *match = matches[0]; + if ([match rangeAtIndex:1].location < -1ULL/2) { // integer + return [numf numberFromString:token]; + } else if ([match rangeAtIndex:2].location < -1ULL/2) { // float + return [numf numberFromString:token]; + } else if ([match rangeAtIndex:3].location < -1ULL/2) { // nil + return [NSNull alloc]; + } else if ([match rangeAtIndex:4].location < -1ULL/2) { // true + return [MalTrue alloc]; // TODO: intern + } else if ([match rangeAtIndex:5].location < -1ULL/2) { // false + return [MalFalse alloc]; // TODO: intern + } else if ([match rangeAtIndex:6].location < -1ULL/2) { // string + NSString * str = [token substringWithRange:[match rangeAtIndex:6]]; + return [[[[str + stringByReplacingOccurrencesOfString:@"\\\\" withString:@"\u029e"] + stringByReplacingOccurrencesOfString:@"\\\"" withString:@"\""] + stringByReplacingOccurrencesOfString:@"\\n" withString:@"\n"] + stringByReplacingOccurrencesOfString:@"\u029e" withString:@"\\"]; + } else if ([match rangeAtIndex:7].location < -1ULL/2) { // string + @throw @"read_atom: expected '\"', got EOF"; + } else if ([match rangeAtIndex:8].location < -1ULL/2) { // keyword + return [NSString stringWithFormat:@"\u029e%@", + [token substringWithRange:[match rangeAtIndex:8]]]; + } else if ([match rangeAtIndex:9].location < -1ULL/2) { // symbol + return [MalSymbol stringWithString:token]; + } + } + + @throw @"read_atom: invalid token"; +} + +// Only used locally, so declare here +NSObject * read_form(Reader * rdr); + +NSArray * read_list(Reader * rdr, char start, char end) { + NSString * token = [rdr next]; + NSMutableArray * ast = [NSMutableArray array]; + + if ([token characterAtIndex:0] != start) { + @throw [NSString stringWithFormat:@"expected '%c'", start]; + } + while ((token = [rdr peek]) && ([token characterAtIndex:0] != end)) { + [ast addObject:read_form(rdr)]; + } + if (!token) { + @throw [NSString stringWithFormat:@"expected '%c', got EOF", end]; + } + [rdr next]; + return ast; +} + +NSObject * read_form(Reader * rdr) { + NSString *token = [rdr peek]; + switch ([token characterAtIndex:0]) { + case '\'': [rdr next]; + return @[[MalSymbol stringWithString:@"quote"], + read_form(rdr)]; + case '`': [rdr next]; + return @[[MalSymbol stringWithString:@"quasiquote"], + read_form(rdr)]; + case '~': [rdr next]; + if ([token isEqualToString:@"~@"]) { + return @[[MalSymbol stringWithString:@"splice-unquote"], + read_form(rdr)]; + } else { + return @[[MalSymbol stringWithString:@"unquote"], + read_form(rdr)]; + } + case '^': [rdr next]; + NSObject * meta = read_form(rdr); + return @[[MalSymbol stringWithString:@"with-meta"], + read_form(rdr), + meta]; + case '@': [rdr next]; + return @[[MalSymbol stringWithString:@"deref"], + read_form(rdr)]; + + // lists + case ')': + @throw @"unexpected ')'"; + case '(': + return read_list(rdr, '(', ')'); + + // vectors + case ']': + @throw @"unexpected ']'"; + case '[': + return [MalVector fromArray:read_list(rdr, '[', ']')]; + + // hash maps + case '}': + @throw @"unexpected '}'"; + case '{': + return hash_map(read_list(rdr, '{', '}')); + default: + return read_atom(rdr); + } +} + +NSObject * read_str(NSString *str) { + NSArray * tokens = tokenize(str); + if ([tokens count] == 0) { @throw [NSException exceptionWithName:@"ReaderContinue" + reason:@"empty token" + userInfo:nil]; } + //if ([tokens count] == 0) { @throw [[MalContinue alloc] init]; } + return read_form([[Reader alloc] initWithTokens:tokens]); +} diff --git a/impls/objc/run b/impls/objc/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/objc/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/objc/step0_repl.m b/impls/objc/step0_repl.m new file mode 100644 index 0000000000..16de667c87 --- /dev/null +++ b/impls/objc/step0_repl.m @@ -0,0 +1,38 @@ +#import + +#import "mal_readline.h" + +NSString *READ(NSString *str) { + return str; +} + +NSString *EVAL(NSString *ast, NSString *env) { + return ast; +} + +NSString *PRINT(NSString *exp) { + return exp; +} + +NSString *REP(NSString *line) { + return PRINT(EVAL(READ(line), @"")); +} + +int main () { + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + printf("%s\n", [[REP(line) description] UTF8String]); + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step1_read_print.m b/impls/objc/step1_read_print.m new file mode 100644 index 0000000000..028b9b7f2b --- /dev/null +++ b/impls/objc/step1_read_print.m @@ -0,0 +1,48 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" + +NSObject *READ(NSString *str) { + return read_str(str); +} + +NSObject *EVAL(NSObject *ast, NSString *env) { + return ast; +} + +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +NSString *REP(NSString *line) { + return PRINT(EVAL(READ(line), @"")); +} + +int main () { + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step2_eval.m b/impls/objc/step2_eval.m new file mode 100644 index 0000000000..97a9f16f6c --- /dev/null +++ b/impls/objc/step2_eval.m @@ -0,0 +1,101 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +NSObject *EVAL(NSObject *ast, NSDictionary *env) { + // NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); + if ([ast isMemberOfClass:[MalSymbol class]]) { + if ([env objectForKey:ast]) { + return env[ast]; + } else { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id el0 = EVAL(alst[0], env); + NSObject * (^ f)(NSArray *) = el0; + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + return f(args); +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, NSDictionary *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + NSDictionary * repl_env = @{ + @"+": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] + [args[1] intValue]]; + }, + @"-": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] - [args[1] intValue]]; + }, + @"*": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] * [args[1] intValue]]; + }, + @"/": ^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] / [args[1] intValue]]; + }, + }; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step3_env.m b/impls/objc/step3_env.m new file mode 100644 index 0000000000..b67729e088 --- /dev/null +++ b/impls/objc/step3_env.m @@ -0,0 +1,122 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +NSObject *EVAL(NSObject *ast, Env *env) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + if (![a0 isKindOfClass:[MalSymbol class]]) { + @throw @"attempt to apply on non-symbol"; + } + if ([(NSString *)a0 isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + return EVAL(alst[2], let_env); + } else { + id el0 = EVAL(a0, env); + NSObject * (^ f)(NSArray *) = el0; + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + return f(args); + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + Env * repl_env = [[Env alloc] init]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + [repl_env set:(MalSymbol *)@"+" val:^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] + [args[1] intValue]]; + }]; + [repl_env set:(MalSymbol *)@"-" val:^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] - [args[1] intValue]]; + }]; + [repl_env set:(MalSymbol *)@"*" val:^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] * [args[1] intValue]]; + }]; + [repl_env set:(MalSymbol *)@"/" val:^(NSArray *args){ + return [NSNumber numberWithInt:[args[0] intValue] / [args[1] intValue]]; + }]; + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step4_if_fn_do.m b/impls/objc/step4_if_fn_do.m new file mode 100644 index 0000000000..436b702284 --- /dev/null +++ b/impls/objc/step4_if_fn_do.m @@ -0,0 +1,141 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" +#import "malfunc.h" +#import "core.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +NSObject *EVAL(NSObject *ast, Env *env) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 + : @"__<*fn*>__"; + + if ([a0sym isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + return EVAL(alst[2], let_env); + } else if ([a0sym isEqualTo:@"do"]) { + for (int i=1; i < [alst count] - 1; i++) { + EVAL(alst[i], env); + } + return EVAL([alst lastObject], env); + } else if ([a0sym isEqualTo:@"if"]) { + NSObject * cond = EVAL(alst[1], env); + if ([cond isKindOfClass:[NSNull class]] || + [cond isKindOfClass:[MalFalse class]]) { + if ([alst count] > 3) { + return EVAL(alst[3], env); + } else { + return [NSNull alloc]; + } + } else { + return EVAL(alst[2], env); + } + } else if ([a0sym isEqualTo:@"fn*"]) { + return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; + } else { + id el0 = EVAL(a0, env); + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + return apply(el0, args); + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + Env * repl_env = [[Env alloc] init]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + // core.m: defined using Objective-C + NSDictionary * core_ns = [Core ns]; + for (NSString* key in core_ns) { + [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; + } + + // core.mal: defined using the language itself + REP(@"(def! not (fn* (a) (if a false true)))", repl_env); + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSObject *e) { + NSObject * exc = e; + printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step5_tco.m b/impls/objc/step5_tco.m new file mode 100644 index 0000000000..f576501094 --- /dev/null +++ b/impls/objc/step5_tco.m @@ -0,0 +1,151 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" +#import "malfunc.h" +#import "core.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +NSObject *EVAL(NSObject *ast, Env *env) { + while (true) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 + : @"__<*fn*>__"; + + if ([a0sym isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + env = let_env; + ast = alst[2]; // TCO + } else if ([a0sym isEqualTo:@"do"]) { + for (int i=1; i < [alst count] - 1; i++) { + EVAL(alst[i], env); + } + ast = [alst lastObject]; // TCO + } else if ([a0sym isEqualTo:@"if"]) { + NSObject * cond = EVAL(alst[1], env); + if ([cond isKindOfClass:[NSNull class]] || + [cond isKindOfClass:[MalFalse class]]) { + if ([alst count] > 3) { + ast = alst[3]; // TCO + } else { + return [NSNull alloc]; + } + } else { + ast = alst[2]; // TCO + } + } else if ([a0sym isEqualTo:@"fn*"]) { + return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; + } else { + id el0 = EVAL(a0, env); + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; + ast = [mf ast]; // TCO + } else { + NSObject * (^ f)(NSArray *) = el0; + return f(args); + } + } + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + Env * repl_env = [[Env alloc] init]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + // core.m: defined using Objective-C + NSDictionary * core_ns = [Core ns]; + for (NSString* key in core_ns) { + [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; + } + + // core.mal: defined using the language itself + REP(@"(def! not (fn* (a) (if a false true)))", repl_env); + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSObject *e) { + NSObject * exc = e; + printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step6_file.m b/impls/objc/step6_file.m new file mode 100644 index 0000000000..3dcc74cd88 --- /dev/null +++ b/impls/objc/step6_file.m @@ -0,0 +1,172 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" +#import "malfunc.h" +#import "core.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +NSObject *EVAL(NSObject *ast, Env *env) { + while (true) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 + : @"__<*fn*>__"; + + if ([a0sym isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + env = let_env; + ast = alst[2]; // TCO + } else if ([a0sym isEqualTo:@"do"]) { + for (int i=1; i < [alst count] - 1; i++) { + EVAL(alst[i], env); + } + ast = [alst lastObject]; // TCO + } else if ([a0sym isEqualTo:@"if"]) { + NSObject * cond = EVAL(alst[1], env); + if ([cond isKindOfClass:[NSNull class]] || + [cond isKindOfClass:[MalFalse class]]) { + if ([alst count] > 3) { + ast = alst[3]; // TCO + } else { + return [NSNull alloc]; + } + } else { + ast = alst[2]; // TCO + } + } else if ([a0sym isEqualTo:@"fn*"]) { + return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; + } else { + id el0 = EVAL(a0, env); + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; + ast = [mf ast]; // TCO + } else { + NSObject * (^ f)(NSArray *) = el0; + return f(args); + } + } + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + // Outside of pool to prevent "Block_release called upon + // a stack..." message on exit + Env * repl_env = [[Env alloc] init]; + NSArray *args = [[NSProcessInfo processInfo] arguments]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + // core.m: defined using Objective-C + NSDictionary * core_ns = [Core ns]; + for (NSString* key in core_ns) { + [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; + } + [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { + return EVAL(args[0], repl_env); + }]; + NSArray *argv = @[]; + if ([args count] > 2) { + argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; + } + [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; + + // core.mal: defined using the language itself + REP(@"(def! not (fn* (a) (if a false true)))", repl_env); + REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + + if ([args count] > 1) { + @try { + REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } + return 0; + } + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSObject *e) { + NSObject * exc = e; + printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step7_quote.m b/impls/objc/step7_quote.m new file mode 100644 index 0000000000..e2a2cb98e4 --- /dev/null +++ b/impls/objc/step7_quote.m @@ -0,0 +1,212 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" +#import "malfunc.h" +#import "core.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; +} + +NSObject * quasiquote(NSObject *ast) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) + return @[[MalSymbol stringWithString:@"quote"], ast]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; + } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; +} + +NSObject *EVAL(NSObject *ast, Env *env) { + while (true) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 + : @"__<*fn*>__"; + + if ([a0sym isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + env = let_env; + ast = alst[2]; // TCO + } else if ([(NSString *)a0 isEqualTo:@"quote"]) { + return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { + ast = quasiquote(alst[1]); // TCO + } else if ([a0sym isEqualTo:@"do"]) { + for (int i=1; i < [alst count] - 1; i++) { + EVAL(alst[i], env); + } + ast = [alst lastObject]; // TCO + } else if ([a0sym isEqualTo:@"if"]) { + NSObject * cond = EVAL(alst[1], env); + if ([cond isKindOfClass:[NSNull class]] || + [cond isKindOfClass:[MalFalse class]]) { + if ([alst count] > 3) { + ast = alst[3]; // TCO + } else { + return [NSNull alloc]; + } + } else { + ast = alst[2]; // TCO + } + } else if ([a0sym isEqualTo:@"fn*"]) { + return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; + } else { + id el0 = EVAL(a0, env); + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; + ast = [mf ast]; // TCO + } else { + NSObject * (^ f)(NSArray *) = el0; + return f(args); + } + } + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + // Outside of pool to prevent "Block_release called upon + // a stack..." message on exit + Env * repl_env = [[Env alloc] init]; + NSArray *args = [[NSProcessInfo processInfo] arguments]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + // core.m: defined using Objective-C + NSDictionary * core_ns = [Core ns]; + for (NSString* key in core_ns) { + [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; + } + [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { + return EVAL(args[0], repl_env); + }]; + NSArray *argv = @[]; + if ([args count] > 2) { + argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; + } + [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; + + // core.mal: defined using the language itself + REP(@"(def! not (fn* (a) (if a false true)))", repl_env); + REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + + if ([args count] > 1) { + @try { + REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } + return 0; + } + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSObject *e) { + NSObject * exc = e; + printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step8_macros.m b/impls/objc/step8_macros.m new file mode 100644 index 0000000000..324ed059a8 --- /dev/null +++ b/impls/objc/step8_macros.m @@ -0,0 +1,229 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" +#import "malfunc.h" +#import "core.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; +} + +NSObject * quasiquote(NSObject *ast) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) + return @[[MalSymbol stringWithString:@"quote"], ast]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; + } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; +} + +NSObject *EVAL(NSObject *ast, Env *env) { + while (true) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 + : @"__<*fn*>__"; + + if ([a0sym isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + env = let_env; + ast = alst[2]; // TCO + } else if ([(NSString *)a0 isEqualTo:@"quote"]) { + return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { + ast = quasiquote(alst[1]); // TCO + } else if ([a0sym isEqualTo:@"defmacro!"]) { + MalFunc * f = [(MalFunc *)EVAL(alst[2], env) copy]; + f.isMacro = true; + return [env set:alst[1] val:f]; + } else if ([a0sym isEqualTo:@"do"]) { + for (int i=1; i < [alst count] - 1; i++) { + EVAL(alst[i], env); + } + ast = [alst lastObject]; // TCO + } else if ([a0sym isEqualTo:@"if"]) { + NSObject * cond = EVAL(alst[1], env); + if ([cond isKindOfClass:[NSNull class]] || + [cond isKindOfClass:[MalFalse class]]) { + if ([alst count] > 3) { + ast = alst[3]; // TCO + } else { + return [NSNull alloc]; + } + } else { + ast = alst[2]; // TCO + } + } else if ([a0sym isEqualTo:@"fn*"]) { + return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; + } else { + id el0 = EVAL(a0, env); + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + if ([mf isMacro]) { + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:alst[i]]; + } + ast = [mf apply:args]; + continue; // TCO + } + } + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; + ast = [mf ast]; // TCO + } else { + NSObject * (^ f)(NSArray *) = el0; + return f(args); + } + } + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + // Outside of pool to prevent "Block_release called upon + // a stack..." message on exit + Env * repl_env = [[Env alloc] init]; + NSArray *args = [[NSProcessInfo processInfo] arguments]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + // core.m: defined using Objective-C + NSDictionary * core_ns = [Core ns]; + for (NSString* key in core_ns) { + [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; + } + [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { + return EVAL(args[0], repl_env); + }]; + NSArray *argv = @[]; + if ([args count] > 2) { + argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; + } + [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; + + // core.mal: defined using the language itself + REP(@"(def! not (fn* (a) (if a false true)))", repl_env); + REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + REP(@"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + + if ([args count] > 1) { + @try { + REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } + return 0; + } + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSObject *e) { + NSObject * exc = e; + printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/step9_try.m b/impls/objc/step9_try.m new file mode 100644 index 0000000000..c2f5c9be9a --- /dev/null +++ b/impls/objc/step9_try.m @@ -0,0 +1,248 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" +#import "malfunc.h" +#import "core.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; +} + +NSObject * quasiquote(NSObject *ast) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) + return @[[MalSymbol stringWithString:@"quote"], ast]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; + } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; +} + +NSObject *EVAL(NSObject *ast, Env *env) { + while (true) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 + : @"__<*fn*>__"; + + if ([a0sym isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + env = let_env; + ast = alst[2]; // TCO + } else if ([(NSString *)a0 isEqualTo:@"quote"]) { + return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { + ast = quasiquote(alst[1]); // TCO + } else if ([a0sym isEqualTo:@"defmacro!"]) { + MalFunc * f = [(MalFunc *)EVAL(alst[2], env) copy]; + f.isMacro = true; + return [env set:alst[1] val:f]; + } else if ([a0sym isEqualTo:@"try*"]) { + @try { + return EVAL(alst[1], env); + } @catch(NSObject *e) { + if ([alst count] > 2 && [alst[2] isKindOfClass:[NSArray class]]) { + NSArray * a2lst = alst[2]; + if ([a2lst[0] isKindOfClass:[MalSymbol class]] && + [(MalSymbol *)a2lst[0] isEqualTo:@"catch*"]) { + NSObject * exc = e; + if ([e isKindOfClass:[NSException class]]) { + exc = [e description]; + } + return EVAL(a2lst[2], [Env fromBindings:env + binds:@[a2lst[1]] + exprs:@[exc]]); + } + } + @throw e; + } + } else if ([a0sym isEqualTo:@"do"]) { + for (int i=1; i < [alst count] - 1; i++) { + EVAL(alst[i], env); + } + ast = [alst lastObject]; // TCO + } else if ([a0sym isEqualTo:@"if"]) { + NSObject * cond = EVAL(alst[1], env); + if ([cond isKindOfClass:[NSNull class]] || + [cond isKindOfClass:[MalFalse class]]) { + if ([alst count] > 3) { + ast = alst[3]; // TCO + } else { + return [NSNull alloc]; + } + } else { + ast = alst[2]; // TCO + } + } else if ([a0sym isEqualTo:@"fn*"]) { + return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; + } else { + id el0 = EVAL(a0, env); + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + if ([mf isMacro]) { + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:alst[i]]; + } + ast = [mf apply:args]; + continue; // TCO + } + } + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; + ast = [mf ast]; // TCO + } else { + NSObject * (^ f)(NSArray *) = el0; + return f(args); + } + } + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + // Outside of pool to prevent "Block_release called upon + // a stack..." message on exit + Env * repl_env = [[Env alloc] init]; + NSArray *args = [[NSProcessInfo processInfo] arguments]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + // core.m: defined using Objective-C + NSDictionary * core_ns = [Core ns]; + for (NSString* key in core_ns) { + [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; + } + [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { + return EVAL(args[0], repl_env); + }]; + NSArray *argv = @[]; + if ([args count] > 2) { + argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; + } + [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; + + // core.mal: defined using the language itself + REP(@"(def! not (fn* (a) (if a false true)))", repl_env); + REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + REP(@"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + + if ([args count] > 1) { + @try { + REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } + return 0; + } + + while (true) { + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSObject *e) { + NSObject * exc = e; + printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/stepA_mal.m b/impls/objc/stepA_mal.m new file mode 100644 index 0000000000..bf463b15e5 --- /dev/null +++ b/impls/objc/stepA_mal.m @@ -0,0 +1,250 @@ +#import + +#import "mal_readline.h" +#import "types.h" +#import "reader.h" +#import "printer.h" +#import "env.h" +#import "malfunc.h" +#import "core.h" + +// read +NSObject *READ(NSString *str) { + return read_str(str); +} + +// eval +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; +} + +NSObject * quasiquote(NSObject *ast) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) + return @[[MalSymbol stringWithString:@"quote"], ast]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; + } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; +} + +NSObject *EVAL(NSObject *ast, Env *env) { + while (true) { + NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; + if (dbgeval != nil + && ! [dbgeval isKindOfClass:[NSNull class]] + && ! [dbgeval isKindOfClass:[MalFalse class]]) { + printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); + } + if ([ast isMemberOfClass:[MalSymbol class]]) { + NSObject * value = [env get:(MalSymbol *)ast]; + if (value == nil) { + @throw [NSString stringWithFormat:@"'%@' not found", ast]; + } + return value; + } else if ([ast isKindOfClass:[MalVector class]]) { + NSMutableArray *newLst = [NSMutableArray array]; + for (NSObject * x in (NSArray *)ast) { + [newLst addObject:EVAL(x, env)]; + } + return [MalVector fromArray:newLst]; + } else if ([ast isKindOfClass:[NSDictionary class]]) { + NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; + for (NSString * k in (NSDictionary *)ast) { + newDict[k] = EVAL(((NSDictionary *)ast)[k], env); + } + return newDict; + } else if (! [ast isKindOfClass:[NSArray class]]) { + return ast; + } + + // apply list + NSArray * alst = (NSArray *)ast; + if ([alst count] == 0) { + return ast; + } + id a0 = alst[0]; + NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 + : @"__<*fn*>__"; + + if ([a0sym isEqualTo:@"def!"]) { + return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; + } else if ([(NSString *)a0 isEqualTo:@"let*"]) { + Env *let_env = [Env fromOuter:env]; + NSArray * binds = (NSArray *)alst[1]; + for (int i=0; i < [binds count]; i+=2) { + [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; + } + env = let_env; + ast = alst[2]; // TCO + } else if ([(NSString *)a0 isEqualTo:@"quote"]) { + return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { + ast = quasiquote(alst[1]); // TCO + } else if ([a0sym isEqualTo:@"defmacro!"]) { + MalFunc * f = [(MalFunc *)EVAL(alst[2], env) copy]; + f.isMacro = true; + return [env set:alst[1] val:f]; + } else if ([a0sym isEqualTo:@"try*"]) { + @try { + return EVAL(alst[1], env); + } @catch(NSObject *e) { + if ([alst count] > 2 && [alst[2] isKindOfClass:[NSArray class]]) { + NSArray * a2lst = alst[2]; + if ([a2lst[0] isKindOfClass:[MalSymbol class]] && + [(MalSymbol *)a2lst[0] isEqualTo:@"catch*"]) { + NSObject * exc = e; + if ([e isKindOfClass:[NSException class]]) { + exc = [e description]; + } + return EVAL(a2lst[2], [Env fromBindings:env + binds:@[a2lst[1]] + exprs:@[exc]]); + } + } + @throw e; + } + } else if ([a0sym isEqualTo:@"do"]) { + for (int i=1; i < [alst count] - 1; i++) { + EVAL(alst[i], env); + } + ast = [alst lastObject]; // TCO + } else if ([a0sym isEqualTo:@"if"]) { + NSObject * cond = EVAL(alst[1], env); + if ([cond isKindOfClass:[NSNull class]] || + [cond isKindOfClass:[MalFalse class]]) { + if ([alst count] > 3) { + ast = alst[3]; // TCO + } else { + return [NSNull alloc]; + } + } else { + ast = alst[2]; // TCO + } + } else if ([a0sym isEqualTo:@"fn*"]) { + return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; + } else { + id el0 = EVAL(a0, env); + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + if ([mf isMacro]) { + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:alst[i]]; + } + ast = [mf apply:args]; + continue; // TCO + } + } + NSMutableArray * args = [NSMutableArray array]; + for (int i = 1; i < [alst count]; i++) { + [args addObject:EVAL(alst[i], env)]; + } + if ([el0 isKindOfClass:[MalFunc class]]) { + MalFunc * mf = el0; + env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; + ast = [mf ast]; // TCO + } else { + NSObject * (^ f)(NSArray *) = el0; + return f(args); + } + } + } +} + +// print +NSString *PRINT(NSObject *exp) { + return _pr_str(exp, true); +} + +// REPL +NSString *REP(NSString *line, Env *env) { + return PRINT(EVAL(READ(line), env)); +} + +int main () { + // Outside of pool to prevent "Block_release called upon + // a stack..." message on exit + Env * repl_env = [[Env alloc] init]; + NSArray *args = [[NSProcessInfo processInfo] arguments]; + + // Create an autorelease pool to manage the memory into the program + NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; + // If using automatic reference counting (ARC), use @autoreleasepool instead: +// @autoreleasepool { + + // core.m: defined using Objective-C + NSDictionary * core_ns = [Core ns]; + for (NSString* key in core_ns) { + [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; + } + [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { + return EVAL(args[0], repl_env); + }]; + NSArray *argv = @[]; + if ([args count] > 2) { + argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; + } + [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; + + // core.mal: defined using the language itself + REP(@"(def! *host-language* \"Objective-C\")", repl_env); + REP(@"(def! not (fn* (a) (if a false true)))", repl_env); + REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + REP(@"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + + + if ([args count] > 1) { + @try { + REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } + return 0; + } + + while (true) { + REP(@"(println (str \"Mal [\" *host-language* \"]\"))", repl_env); + char *rawline = _readline("user> "); + if (!rawline) { break; } + NSString *line = [NSString stringWithUTF8String:rawline]; + if ([line length] == 0) { continue; } + @try { + printf("%s\n", [[REP(line, repl_env) description] UTF8String]); + } @catch(NSString *e) { + printf("Error: %s\n", [e UTF8String]); + } @catch(NSObject *e) { + NSObject * exc = e; + printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); + } @catch(NSException *e) { + if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } + printf("Exception: %s\n", [[e reason] UTF8String]); + } + } + + [pool drain]; + +// } +} diff --git a/impls/objc/tests/step5_tco.mal b/impls/objc/tests/step5_tco.mal new file mode 100644 index 0000000000..0a7e00560c --- /dev/null +++ b/impls/objc/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Objective C: skipping non-TCO recursion +;; Reason: completes at 10,000, unrecoverable segfault at 20,000 diff --git a/impls/objc/types.h b/impls/objc/types.h new file mode 100644 index 0000000000..2a307d9ecf --- /dev/null +++ b/impls/objc/types.h @@ -0,0 +1,93 @@ +#import + +// +// Env definition +// + +@class MalSymbol; + +@interface Env : NSObject + +@property (copy) NSMutableDictionary * data; +@property (copy) Env * outer; + +- (id)initWithBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs; +- (id)initWithOuter:(Env *)outer; +- (id)init; + ++ (id)fromOuter:(Env *)outer; ++ (id)fromBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs; + +- (NSObject *) set:(MalSymbol *)key val:(NSObject *)val; +- (NSObject *) get:(MalSymbol *)key; + +@end + +// +// Mal Types +// + +@interface MalTrue : NSObject +@end + +@interface MalFalse : NSObject +@end + +@interface MalSymbol: NSString +@end + +BOOL string_Q(NSObject * obj); + +// Lists + +BOOL list_Q(id obj); + +NSArray * _rest(NSArray * obj); + + +// Vectors + +@interface MalVector : NSArray + +@property (copy) NSArray * array; +@property(readonly) NSUInteger count; + +- (id)initWithArray:(NSArray *)arr; +- (id)init; + ++ (id)fromArray:(NSArray *)arr; + +- (id)objectAtIndex:(NSUInteger)index; + +@end + + +// Hash Maps + +NSDictionary * assoc_BANG(NSMutableDictionary * d, NSArray * kvs); +NSDictionary * hash_map(NSArray *kvs); + + +// Mal Functions + +BOOL block_Q(id obj); + + +// Atoms + +@interface MalAtom : NSObject + +@property (copy) NSObject * val; + +- (id)init:(NSObject *)val; + ++ (id)fromObject:(NSObject *)val; + +@end + +BOOL atom_Q(id obj); + + +// General functions + +BOOL equal_Q(NSObject * a, NSObject * b); diff --git a/impls/objc/types.m b/impls/objc/types.m new file mode 100644 index 0000000000..356c746223 --- /dev/null +++ b/impls/objc/types.m @@ -0,0 +1,175 @@ +#import "types.h" + +@implementation MalTrue +@end + +@implementation MalFalse +@end + + +// NSString subclassing based on: +// http://stackoverflow.com/a/21331422/471795 + +// Symbols + +@interface MalSymbol () +@property (nonatomic, strong) NSString *stringHolder; +@end + +@implementation MalSymbol + +- (instancetype)initWithCharactersNoCopy:(unichar *)characters length:(NSUInteger)length freeWhenDone:(BOOL)freeBuffer { + self = [super init]; + if (self) { + self.stringHolder = [[NSString alloc] initWithCharactersNoCopy:characters length:length freeWhenDone:freeBuffer]; + } + return self; +} + +- (NSUInteger)length { + return self.stringHolder.length; +} + +- (unichar)characterAtIndex:(NSUInteger)index { + return [self.stringHolder characterAtIndex:index]; +} + +@end + + +BOOL string_Q(id obj) { + if ([obj isKindOfClass:[NSString class]]) { + NSString * s = obj; + if (![s isKindOfClass:[MalSymbol class]]) { + return ![s hasPrefix:@"\u029e"]; + } + } + return false; +} + +// Lists + +BOOL list_Q(id obj) { + return ([obj isKindOfClass:[NSArray class]] && + ![obj isKindOfClass:[MalVector class]]); +} + +NSArray * _rest(NSArray * obj) { + return [obj subarrayWithRange:NSMakeRange(1, [obj count]-1)]; +} + +// Vectors + +@implementation MalVector + +@synthesize array = _array; +@synthesize count = _count; + +- (id)initWithArray:(NSArray *)arr { + self = [self init]; + if (self) { + _array = arr; + _count = [arr count]; + } + return self; +} + +- (id)init { + self = [super init]; + if (self) { + _array = @[]; + _count = 0; + } + return self; +} + ++ (id)fromArray:(NSArray *)arr { + return [[MalVector alloc] initWithArray:arr]; +} + +- (id)objectAtIndex:(NSUInteger)index { + return _array[index]; +} + +- (id)copyWithZone:(NSZone *)zone { + return [[MalVector alloc] initWithArray:[_array copy]]; +} + +@end + + +// Hash Maps + +NSDictionary * assoc_BANG(NSMutableDictionary * d, NSArray * kvs) { + for (int i=0; i < [kvs count]; i+=2) { + d[kvs[i]] = kvs[i+1]; + } + return d; +} + +NSDictionary * hash_map(NSArray *kvs) { + return assoc_BANG([NSMutableDictionary dictionary], kvs); +} + + +// Mal Functions + +BOOL block_Q(id obj) { + id block = ^{}; + Class blockClass = [block class]; + while ([blockClass superclass] != [NSObject class]) { + blockClass = [blockClass superclass]; + } + return [obj isKindOfClass:blockClass]; +} + + + +@implementation MalAtom + +@synthesize val = _val; + +- (id)init:(NSObject *)val { + self = [super init]; + if (self) { + _val = val; + } + return self; +} + ++ (id)fromObject:(NSObject *)val { + return [[MalAtom alloc] init:val]; +} + +@end + +BOOL atom_Q(id obj) { + return [obj isKindOfClass:[MalAtom class]]; +} + +// General functions + +BOOL sequential_Q(NSObject * obj) { + return [obj isKindOfClass:[NSArray class]]; +} + +BOOL equal_Q(NSObject * a, NSObject * b) { + //NSLog(@"= %@ (%@), %@ (%@)", a, [a class], b, [b class]); + if (!(([a class] == [b class]) || + ([a isKindOfClass:[NSArray class]] && + [b isKindOfClass:[NSArray class]]) || + ([a isKindOfClass:[NSNumber class]] && + [b isKindOfClass:[NSNumber class]]) || + (string_Q(a) && string_Q(b)))) { + return false; + } + if ([a isKindOfClass:[MalTrue class]]) { + return true; + } else if ([a isKindOfClass:[MalFalse class]]) { + return true; + } else if ([a isKindOfClass:[NSNumber class]]) { + return [(NSNumber *)a intValue] == [(NSNumber *)b intValue]; + } else { + return [a isEqual:b]; + } +} diff --git a/impls/objpascal/Dockerfile b/impls/objpascal/Dockerfile new file mode 100644 index 0000000000..ce8b8c34a2 --- /dev/null +++ b/impls/objpascal/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Free Pascal +RUN apt-get -y install libc-dev fp-compiler libedit-dev diff --git a/impls/objpascal/Makefile b/impls/objpascal/Makefile new file mode 100644 index 0000000000..b8efc48c43 --- /dev/null +++ b/impls/objpascal/Makefile @@ -0,0 +1,31 @@ +STEPS = step0_repl.pas step1_read_print.pas step2_eval.pas \ + step3_env.pas step4_if_fn_do.pas step5_tco.pas \ + step6_file.pas step7_quote.pas step8_macros.pas \ + step9_try.pas stepA_mal.pas + +STEP0_DEPS = mal_readline.pas +STEP1_DEPS = $(STEP0_DEPS) mal_types.pas reader.pas printer.pas +STEP3_DEPS = $(STEP1_DEPS) mal_env.pas +STEP4_DEPS = $(STEP3_DEPS) core.pas + +##################### + +DEBUG = -gl + +# Set this to link with libreadline instead of libedit +USE_READLINE = + +FPC = fpc -MOBJFPC -ve -Furegexpr/Source $(DEBUG) $(if $(strip $(USE_READLINE)),-dUSE_READLINE,) + +all: $(patsubst %.pas,%,$(STEPS)) + +step%: step%.pas + $(FPC) $< + +step0_repl: $(STEP0_DEPS) +step1_read_print step2_eval: $(STEP1_DEPS) +step3_env: $(STEP3_DEPS) +step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) + +clean: + rm -f $(STEPS:%.pas=%) *.o *.ppu regexpr/Source/*.o regexpr/Source/*.ppu mal diff --git a/impls/objpascal/core.pas b/impls/objpascal/core.pas new file mode 100644 index 0000000000..d51374c57f --- /dev/null +++ b/impls/objpascal/core.pas @@ -0,0 +1,632 @@ +unit core; + +{$H+} // Use AnsiString + +interface + +uses Classes, + sysutils, + fgl, + mal_readline, + mal_types, + mal_func, + mal_env, + reader, + printer; + +type + TCoreDict = specialize TFPGMap; + +var + EVAL : function (A: TMal; E: TEnv) : TMal; + NS : TCoreDict; + +//////////////////////////////////////////////////////////// + +implementation + +// General functions + +function equal_Q(Args: TMalArray) : TMal; +begin + equal_Q := wrap_tf(_equal_Q(Args[0], Args[1])); +end; + +function throw(Args: TMalArray) : TMal; +begin + raise TMalException.Create(Args[0]); + throw := TMalNil.Create; // Not reached +end; + +// Scalar functions + +function nil_Q(Args: TMalArray) : TMal; +begin + nil_Q := wrap_tf(Args[0] is TMalNil); +end; +function true_Q(Args: TMalArray) : TMal; +begin + true_Q := wrap_tf(Args[0] is TMalTrue); +end; +function false_Q(Args: TMalArray) : TMal; +begin + false_Q := wrap_tf(Args[0] is TMalFalse); +end; +function number_Q(Args: TMalArray) : TMal; +begin + number_Q := wrap_tf(Args[0] is TMalInt); +end; +function string_Q(Args: TMalArray) : TMal; +begin + string_Q := wrap_tf(_string_Q(Args[0])); +end; +function symbol(Args: TMalArray) : TMal; +begin + if Args[0] is TMalSymbol then + symbol := Args[0] + else if Args[0] is TMalString then + symbol := TMalSymbol.Create((Args[0] as TMalString).Val) + else + raise Exception.Create('Invalid symbol call'); +end; +function symbol_Q(Args: TMalArray) : TMal; +begin + symbol_Q := wrap_tf(Args[0] is TMalSymbol); +end; +function keyword(Args: TMalArray) : TMal; +begin + if ((Args[0] is TMalString) and not _string_Q(Args[0])) then + keyword := Args[0] + else if Args[0] is TMalString then + keyword := TMalString.Create(#127 + (Args[0] as TMalString).Val) + else + raise Exception.Create('Invalid keyword call'); +end; +function keyword_Q(Args: TMalArray) : TMal; +begin + keyword_Q := wrap_tf((Args[0] is TMalString) and not _string_Q(Args[0])); +end; +function fn_Q(Args: TMalArray) : TMal; +begin + if Args[0] is TMalFunc then + fn_Q := wrap_tf(not (Args[0] as TMalFunc).isMacro) + else + fn_Q := TMalFalse.Create; +end; + +function macro_Q(Args: TMalArray) : TMal; +begin + if Args[0] is TMalFunc then + macro_Q := wrap_tf((Args[0] as TMalFunc).isMacro) + else + macro_Q := TMalFalse.Create; +end; + + +// String functions + +function do_pr_str(Args: TMalArray) : TMal; +begin + do_pr_str := TMalString.Create(pr_str_array(Args, true, ' ')); +end; +function str(Args: TMalArray) : TMal; +begin + str := TMalString.Create(pr_str_array(Args, false, '')); +end; +function prn(Args: TMalArray) : TMal; +begin + WriteLn(pr_str_array(Args, true, ' ')); + prn := TMalNil.Create; +end; +function println(Args: TMalArray) : TMal; +begin + WriteLn(pr_str_array(Args, false, ' ')); + println := TMalNil.Create; +end; + +function read_string(Args: TMalArray) : TMal; +begin + read_string := read_str((Args[0] as TMalString).Val); +end; +function do_readline(Args: TMalArray) : TMal; +var + Prompt : string; + Line : string; +begin + Prompt := (Args[0] as TMalString).Val; + try + Line := _readline(Prompt); + do_readline := TMalString.Create(Line); + except + On E : MalEOF do do_readline := TMalNil.Create; + end; +end; +function slurp(Args: TMalArray) : TMal; +var + StrL : TStringList; +begin + StrL := TStringList.Create; + StrL.LoadFromFile((Args[0] as TMalString).Val); + slurp := TMalString.Create(StrL.Text); +end; + +// Math functions + +function lt(Args: TMalArray) : TMal; +begin + lt := wrap_tf((Args[0] as TMalInt).Val < (Args[1] as TMalInt).Val); +end; +function lte(Args: TMalArray) : TMal; +begin + lte := wrap_tf((Args[0] as TMalInt).Val <= (Args[1] as TMalInt).Val); +end; +function gt(Args: TMalArray) : TMal; +begin + gt := wrap_tf((Args[0] as TMalInt).Val > (Args[1] as TMalInt).Val); +end; +function gte(Args: TMalArray) : TMal; +begin + gte := wrap_tf((Args[0] as TMalInt).Val >= (Args[1] as TMalInt).Val); +end; + +function add(Args: TMalArray) : TMal; +begin + add := TMalInt.Create((Args[0] as TMalInt).Val + + (Args[1] as TMalInt).Val); +end; +function subtract(Args: TMalArray) : TMal; +begin + subtract := TMalInt.Create((Args[0] as TMalInt).Val - + (Args[1] as TMalInt).Val); +end; +function multiply(Args: TMalArray) : TMal; +begin + multiply := TMalInt.Create((Args[0] as TMalInt).Val * + (Args[1] as TMalInt).Val); +end; +function divide(Args: TMalArray) : TMal; +begin + divide := TMalInt.Create((Args[0] as TMalInt).Val div + (Args[1] as TMalInt).Val); +end; +function time_ms(Args: TMalArray) : TMal; +begin + time_ms := TMalInt.Create(Trunc(TimeStampToMSecs(DateTimeToTimeStamp(Now)))); +end; + +// Collection functions + +function list(Args: TMalArray) : TMal; +begin + list := TMalList.Create(Args); +end; +function list_Q(Args: TMalArray) : TMal; +begin + list_Q := wrap_tf(Args[0].ClassType = TMalList); +end; +function vec(Args: TMalArray) : TMal; +begin + vec := TMalVector.Create((Args[0] as TMalList).Val); +end; +function vector(Args: TMalArray) : TMal; +begin + vector := TMalVector.Create(Args); +end; +function vector_Q(Args: TMalArray) : TMal; +begin + vector_Q := wrap_tf(Args[0].ClassType = TMalVector); +end; +function hash_map(Args: TMalArray) : TMal; +begin + hash_map := TMalHashMap.Create(Args); +end; +function map_Q(Args: TMalArray) : TMal; +begin + map_Q := wrap_tf(Args[0].ClassType = TMalHashMap); +end; +function assoc(Args: TMalArray) : TMal; +var + OrigHM, NewHM : TMalHashMap; +begin + OrigHM := (Args[0] as TMalHashMap); + NewHM := TMalHashMap.Clone(OrigHM); + assoc := NewHM.assoc_BANG(copy(Args, 1, Length(Args))); +end; +function dissoc(Args: TMalArray) : TMal; +var + OrigHM, NewHM : TMalHashMap; +begin + OrigHM := (Args[0] as TMalHashMap); + NewHM := TMalHashMap.Clone(OrigHM); + dissoc := NewHM.dissoc_BANG(copy(Args, 1, Length(Args))); +end; +function get(Args: TMalArray) : TMal; +var + HM : TMalHashMap; +begin + if Args[0] is TMalNil then Exit(TMalNil.Create); + HM := (Args[0] as TMalHashMap); + if HM.Val.IndexOf((Args[1] as TMalString).Val) >= 0 then + get := HM.Val[(Args[1] as TMalString).Val] + else + get := TMalNil.Create; +end; +function contains_Q(Args: TMalArray) : TMal; +var + HM : TMalHashMap; +begin + if Args[0] is TMalNil then Exit(TMalFalse.Create); + HM := (Args[0] as TMalHashMap); + contains_Q := wrap_tf(HM.Val.IndexOf((Args[1] as TMalString).Val) >= 0); +end; +function keys(Args: TMalArray) : TMal; +var + Dict : TMalDict; + Arr : TMalArray; + I : longint; +begin + Dict := (Args[0] as TMalHashMap).Val; + SetLength(Arr, Dict.Count); + for I := 0 to Dict.Count-1 do + Arr[I] := TMalString.Create(Dict.Keys[I]); + keys := TMalList.Create(Arr); +end; +function vals(Args: TMalArray) : TMal; +var + Dict : TMalDict; + Arr : TMalArray; + I : longint; +begin + Dict := (Args[0] as TMalHashMap).Val; + SetLength(Arr, Dict.Count); + for I := 0 to Dict.Count-1 do + Arr[I] := Dict[Dict.Keys[I]]; + vals := TMalList.Create(Arr); +end; + + +// Sequence functions + +function sequential_Q(Args: TMalArray) : TMal; +begin + sequential_Q := wrap_tf(_sequential_Q(Args[0])); +end; +function cons(Args: TMalArray) : TMal; +var + Res, Src : TMalArray; + I : longint; +begin + Src := (Args[1] as TMalList).Val; + SetLength(Res, 1 + Length(Src)); + Res[0] := Args[0]; + for I := 1 to Length(Src) do + Res[I] := Src[I-1]; + cons := TMalList.Create(Res); +end; +function do_concat(Args: TMalArray) : TMal; +var + Res : TMalArray; + I : longint; +begin + SetLength(Res, 0); + for I := 0 to Length(Args)-1 do + begin + Res := _concat(Res, (Args[I] as TMalList).Val); + end; + do_concat := TMalList.Create(Res); +end; +function nth(Args: TMalArray) : TMal; +var + Arr : TMalArray; + Idx : longint; +begin + Arr := (Args[0] as TMalList).Val; + Idx := (Args[1] as TMalInt).Val; + if Idx >= Length(Arr) then + raise Exception.Create('nth: index out of range') + else + nth := Arr[Idx]; +end; +function first(Args: TMalArray) : TMal; +var + Arr : TMalArray; +begin + if Args[0] is TMalNil then Exit(TMalNil.Create); + Arr := (Args[0] as TMalList).Val; + if Length(Arr) = 0 then + first := TMalNil.Create + else + first := (Args[0] as TMalList).Val[0]; +end; +function rest(Args: TMalArray) : TMal; +begin + if Args[0] is TMalNil then Exit(_list()); + rest := (Args[0] as TMalList).Rest(); +end; + +function empty_Q(Args: TMalArray) : TMal; +begin + if Args[0] is TMalNil then + empty_Q := TMalTrue.Create + else if Args[0] is TMalList then + empty_Q := wrap_tf(Length((Args[0] as TMalList).Val) = 0) + else raise Exception.Create('invalid empty? call'); +end; +function count(Args: TMalArray) : TMal; +begin + if Args[0] is TMalNil then + count := TMalInt.Create(0) + else if Args[0] is TMalList then + count := TMalInt.Create(Length((Args[0] as TMalList).Val)) + else raise Exception.Create('invalid count call'); +end; + +function map(Args: TMalArray) : TMal; +var + Fn : TMalFunc; + FArgs : TMalArray; + Src, Res : TMalArray; + I : longint; +begin + Fn := (Args[0] as TMalFunc); + Src := (Args[1] as TMalList).Val; + SetLength(FArgs, 1); + SetLength(Res, Length(Src)); + if Fn.Ast = nil then + for I := 0 to Length(Src)-1 do + begin + FArgs[0] := Src[I]; + Res[I] := Fn.Val(FArgs); + end + else + for I := 0 to Length(Src)-1 do + begin + FArgs[0] := Src[I]; + Res[I] := EVAL(Fn.Ast, TEnv.Create(Fn.Env, Fn.Params, FArgs)); + end; + map := TMalList.Create(Res); +end; +function apply(Args: TMalArray) : TMal; +var + Fn : TMalFunc; + LastArgs : TMalArray; + FArgs : TMalArray; + I : longint; +begin + Fn := (Args[0] as TMalFunc); + LastArgs := (Args[Length(Args)-1] as TMalList).Val; + SetLength(FArgs, Length(LastArgs) + Length(Args) - 2); + for I := 0 to Length(Args)-3 do + FArgs[I] := Args[I+1]; + for I := 0 to Length(LastArgs)-1 do + FArgs[Length(Args)-2 + I] := LastArgs[I]; + if Fn.Ast = nil then + apply := Fn.Val(FArgs) + else + apply := EVAL(Fn.Ast, TEnv.Create(Fn.Env, Fn.Params, FArgs)); +end; + +function conj(Args: TMalArray) : TMal; +var + I : longint; + Vals : TMalArray; +begin + if Args[0] is TMalVector then + conj := TMalVector.Create(_concat((Args[0] as TMalList).Val, + copy(Args, 1, Length(Args)))) + else if Args[0] is TMalList then + begin + SetLength(Vals, Length(Args)-1); + for I := 1 to Length(Args)-1 do + Vals[I-1] := Args[Length(Args) - I]; + conj := TMalList.Create(_concat(Vals, (Args[0] as TMalList).Val)); + end + else + raise Exception.Create('conj: called on non-sequence'); +end; +function seq(Args: TMalArray) : TMal; +var + Str : string; + Arr : TMalArray; + I : longint; +begin + if Args[0] is TMalVector then + begin + if Length((Args[0] as TMalVector).Val) = 0 then + Exit(TMalNil.Create); + seq := TMalList.Create((Args[0] as TMalVector).Val); + end + else if Args[0] is TMalList then + begin + if Length((Args[0] as TMalList).Val) = 0 then + Exit(TMalNil.Create); + seq := Args[0] + end + else if _string_Q(Args[0]) then + begin + Str := (Args[0] as TMalString).Val; + if Length(Str) = 0 then + Exit(TMalNil.Create); + SetLength(Arr, Length(Str)); + for I := 0 to Length(Str) do + Arr[I] := TMalString.Create(Str[I+1]); + seq := TMalList.Create(Arr); + end + else if Args[0] is TMalNil then + begin + seq := Args[0]; + end + else + raise Exception.Create('seq: called on non-sequence'); +end; + + +// Metadata functions + +function meta(Args: TMalArray) : TMal; +begin + if Args[0] is TMalFunc then + meta := (Args[0] as TMalFunc).Meta + else if Args[0] is TMalList then + meta := (Args[0] as TMalList).Meta + else if Args[0] is TMalHashMap then + meta := (Args[0] as TMalHashMap).Meta + else + raise Exception.Create('meta not supported on ' + Args[0].ClassName); + + if meta = nil then + meta := TMalNil.Create; +end; +function with_meta(Args: TMalArray) : TMal; +var + Fn : TMalFunc; + Vec : TMalVector; + Lst : TMalList; + HM : TMalHashMap; +begin + if Args[0] is TMalFunc then + begin + Fn := TMalFunc.Clone(Args[0] as TMalFunc); + Fn.Meta := Args[1]; + with_meta := Fn; + end + else if Args[0] is TMalVector then + begin + Vec := TMalVector.Clone(Args[0] as TMalVector); + Vec.Meta := Args[1]; + with_meta := Vec; + end + else if Args[0] is TMalList then + begin + Lst := TMalList.Clone(Args[0] as TMalList); + Lst.Meta := Args[1]; + with_meta := Lst; + end + else if Args[0] is TMalHashMap then + begin + HM := TMalHashMap.Clone(Args[0] as TMalHashMap); + HM.Meta := Args[1]; + with_meta := HM; + end + else + raise Exception.Create('with-meta call on non-mal function'); +end; + +// Atom functions + +function atom(Args: TMalArray) : TMal; +begin + atom := TMalAtom.Create(Args[0]); +end; +function atom_Q(Args: TMalArray) : TMal; +begin + atom_Q := wrap_tf(Args[0] is TMalAtom); +end; +function deref(Args: TMalArray) : TMal; +begin + deref := (Args[0] as TMalAtom).Val; +end; +function reset_BANG(Args: TMalArray) : TMal; +begin + (Args[0] as TMalAtom).Val := Args[1]; + reset_BANG := Args[1]; +end; + +function swap_BANG(Args: TMalArray) : TMal; +var + Atm : TMalAtom; + Fn : TMalFunc; + FArgs : TMalArray; + I : longint; +begin + Atm := (Args[0] as TMalAtom); + Fn := (Args[1] as TMalFunc); + SetLength(FArgs, Length(Args)-1); + FArgs[0] := Atm.Val; + for I := 1 to Length(Args)-2 do + FArgs[I] := Args[I+1]; + + if Fn.Ast = nil then + Atm.Val := Fn.Val(FArgs) + else + Atm.Val := EVAL(Fn.Ast, TEnv.Create(Fn.Env, Fn.Params, FArgs)); + swap_BANG := Atm.Val; +end; + + +//////////////////////////////////////////////////////////// + +initialization +begin + NS := TCoreDict.Create; + NS['='] := @equal_Q; + NS['throw'] := @throw; + + NS['nil?'] := @nil_Q; + NS['true?'] := @true_Q; + NS['false?'] := @false_Q; + NS['number?'] := @number_Q; + NS['string?'] := @string_Q; + NS['symbol'] := @symbol; + NS['symbol?'] := @symbol_Q; + NS['keyword'] := @keyword; + NS['keyword?'] := @keyword_Q; + NS['fn?'] := @fn_Q; + NS['macro?'] := @macro_Q; + + NS['pr-str'] := @do_pr_str; + NS['str'] := @str; + NS['prn'] := @prn; + NS['println'] := @println; + NS['read-string'] := @read_string; + NS['readline'] := @do_readline; + NS['slurp'] := @slurp; + + NS['<'] := @lt; + NS['<='] := @lte; + NS['>'] := @gt; + NS['>='] := @gte; + NS['+'] := @add; + NS['-'] := @subtract; + NS['*'] := @multiply; + NS['/'] := @divide; + NS['time-ms'] := @time_ms; + + NS['list'] := @list; + NS['list?'] := @list_Q; + NS['vector'] := @vector; + NS['vector?'] := @vector_Q; + NS['hash-map'] := @hash_map; + NS['map?'] := @map_Q; + NS['assoc'] := @assoc; + NS['dissoc'] := @dissoc; + NS['get'] := @get; + NS['contains?'] := @contains_Q; + NS['keys'] := @keys; + NS['vals'] := @vals; + + NS['sequential?'] := @sequential_Q; + NS['cons'] := @cons; + NS['concat'] := @do_concat; + NS['vec'] := @vec; + NS['nth'] := @nth; + NS['first'] := @first; + NS['rest'] := @rest; + NS['empty?'] := @empty_Q; + NS['count'] := @count; + NS['apply'] := @apply; + NS['map'] := @map; + + NS['conj'] := @conj; + NS['seq'] := @seq; + + NS['meta'] := @meta; + NS['with-meta'] := @with_meta; + NS['atom'] := @atom; + NS['atom?'] := @atom_Q; + NS['deref'] := @deref; + NS['reset!'] := @reset_BANG; + NS['swap!'] := @swap_BANG; +end + +end. diff --git a/impls/objpascal/mal_env.pas b/impls/objpascal/mal_env.pas new file mode 100644 index 0000000000..1fc2ea580d --- /dev/null +++ b/impls/objpascal/mal_env.pas @@ -0,0 +1,84 @@ +unit mal_env; + +{$H+} // Use AnsiString + +interface + +Uses sysutils, + fgl, + mal_types; + +type TEnv = class(TObject) + public + Data : TMalDict; + Outer : TEnv; + + constructor Create; + constructor Create(_Outer : TEnv); + constructor Create(_Outer : TEnv; + Binds : TMalList; + Exprs : TMalArray); + + function Add(Key : TMalSymbol; Val : TMal) : TMal; + function Get(Key : String) : TMal; +end; + +//////////////////////////////////////////////////////////// + +implementation + +constructor TEnv.Create(); +begin + inherited Create(); + Self.Data := TMalDict.Create; + Self.Outer := nil; +end; + +constructor TEnv.Create(_Outer: TEnv); +begin + Self.Create(); + Self.Outer := _Outer; +end; + +constructor TEnv.Create(_Outer : TEnv; + Binds : TMalList; + Exprs : TMalArray); +var + I : longint; + Bind : TMalSymbol; + Rest : TMalList; +begin + Self.Create(_Outer); + for I := 0 to Length(Binds.Val)-1 do + begin + Bind := (Binds.Val[I] as TMalSymbol); + if Bind.Val = '&' then + begin + if I < Length(Exprs) then + Rest := TMalList.Create(copy(Exprs, I, Length(Exprs)-I)) + else + Rest := TMalList.Create; + Self.Data[(Binds.Val[I+1] as TMalSymbol).Val] := Rest; + break; + end; + Self.Data[Bind.Val] := Exprs[I]; + end; +end; + +function TEnv.Add(Key : TMalSymbol; Val : TMal) : TMal; +begin + Self.Data[Key.Val] := Val; + Add := Val; +end; + +function TEnv.Get(Key : String) : TMal; +begin + if Data.IndexOf(Key) >= 0 then + Get := Data[Key] + else if Outer <> nil then + Get := Outer.Get(Key) + else + Get := nil; +end; + +end. diff --git a/impls/objpascal/mal_func.pas b/impls/objpascal/mal_func.pas new file mode 100644 index 0000000000..402be8f9f6 --- /dev/null +++ b/impls/objpascal/mal_func.pas @@ -0,0 +1,57 @@ +unit mal_func; + +interface + +uses mal_types, + mal_env; + +// Some general type definitions + +type + TMalCallable = function (Args : TMalArray) : TMal; + +type TMalFunc = class(TMal) + public + Val : TMalCallable; + Ast : TMal; + Env : TEnv; + Params : TMalList; + isMacro : Boolean; + Meta : TMal; + + constructor Create(V : TMalCallable); + constructor Create(A : TMal; + E : TEnv; + P : TMalList); + + constructor Clone(F : TMalFunc); +end; + +//////////////////////////////////////////////////////////// + +implementation + +constructor TMalFunc.Create(V : TMalCallable); +begin + inherited Create(); + Self.Val := V; +end; + +constructor TMalFunc.Create(A : TMal; + E : TEnv; + P : TMalList); +begin + inherited Create(); + Self.Ast := A; + Self.Env := E; + Self.Params := P; +end; + +constructor TMalFunc.Clone(F : TMalFunc); +begin + Self.Create(F.Ast, F.Env, F.Params); + Self.isMacro := F.isMacro; + Self.Meta := F.Meta; +end; + +end. diff --git a/impls/objpascal/mal_readline.pas b/impls/objpascal/mal_readline.pas new file mode 100644 index 0000000000..ff6dcd0d05 --- /dev/null +++ b/impls/objpascal/mal_readline.pas @@ -0,0 +1,49 @@ +unit mal_readline; + +{$H+} // Use AnsiString + +interface + +uses sysutils, + CTypes; + +{$IFDEF USE_READLINE} + +{$LINKLIB readline} + +{$ELSE} + +{$LINKLIB libedit} + +{$ENDIF} + + +// External libedit/readline functions + +function readline(Prompt: PChar) : PChar; cdecl; external; +procedure add_history(Line: PChar); cdecl; external; + +// API + +type MalEOF = class(Exception); + +function _readline(Prompt: string) : string; + +//////////////////////////////////////////////////////////// + +implementation + +function _readline(Prompt: string) : string; +var + Line : PChar; +begin + Line := readline(PChar(Prompt)); + if Line = Nil then + raise MalEOF.Create('MalEOF'); + if Line <> '' then + add_history(Line); + + _readline := Line; +end; + +end. diff --git a/impls/objpascal/mal_types.pas b/impls/objpascal/mal_types.pas new file mode 100644 index 0000000000..a7aacdea52 --- /dev/null +++ b/impls/objpascal/mal_types.pas @@ -0,0 +1,387 @@ +unit mal_types; + +{$H+} // Use AnsiString + +interface + +uses sysutils, + fgl; + +// Ancestor of all Mal types + +type TMal = class(TObject); + + +// Some general type definitions + +type + TMalArray = array of TMal; + // TODO: use http://bugs.freepascal.org/view.php?id=27206 when + // incorporated into FPC + TMalDict = specialize TFPGMap; + +type TMalException = class(Exception) + public + Val: TMal; + + constructor Create(V : TMal); +end; + + +// Mal types + +type TMalNil = class(TMal); +type TMalTrue = class(TMal); +type TMalFalse = class(TMal); + +type TMalInt = class(TMal) + public + Val: int64; + + constructor Create(V : int64); +end; + +type TMalString = class(TMal) + public + Val: string; + + constructor Create(V : string); +end; + +type TMalSymbol = class(TMal) + public + Val: string; + + constructor Create(V : string); +end; + + +type TMalList = class(TMal) + public + Val: TMalArray; + Meta: TMal; + + constructor Create(); + constructor Create(V : TMalArray); + function Rest() : TMalList; + + constructor Clone(L : TMalList); +end; + +type TMalVector = class(TMalList) +end; + +type TMalAtom = class(TMal) + public + Val: TMal; + + constructor Create(V : TMal); +end; + +type TMalHashMap = class(TMal) + public + Val: TMalDict; + Meta: TMal; + + constructor Create(); + constructor Create(V : TMalDict); + constructor Create(V : TMalArray); + + constructor Clone(HM : TMalHashMap); + + function assoc_BANG(KVs: TMalArray) : TMal; + function dissoc_BANG(Ks: TMalArray) : TMal; +end; + + +// General type functions + +function GetBacktrace(E: Exception) : string; + +function wrap_tf(x : Boolean) : TMal; + +function _equal_Q(A : TMal; B : TMal) : Boolean; + +function _sequential_Q(Obj: TMal) : Boolean; + +function _list() : TMalList; +function _list(A: TMal) : TMalList; +function _list(A: TMal; B: TMal) : TMalList; +function _list(A: TMal; B: TMal; C: TMal) : TMalList; + +function _concat(A: TMalArray; B: TMalArray) : TMalArray; + +function _string_Q(Obj: TMal) : Boolean; + +//////////////////////////////////////////////////////////// + +implementation + +constructor TMalException.Create(V : TMal); +begin + inherited Create('MalException'); + Self.Val := V; +end; + +// +// Mal types +// + +constructor TMalInt.Create(V : int64); +begin + inherited Create(); + Self.Val := V; +end; + +constructor TMalString.Create(V : string); +begin + inherited Create(); + Self.Val := V; +end; + +constructor TMalSymbol.Create(V : string); +begin + inherited Create(); + Self.Val := V; +end; + +constructor TMalList.Create(); +begin + inherited Create(); + SetLength(Self.Val, 0); +end; + +constructor TMalList.Create(V : TMalArray); +begin + inherited Create(); + Self.Val := V; +end; + +constructor TMalList.Clone(L : TMalList); +begin + inherited Create(); + Self.Val := copy(L.Val, 0, Length(L.Val)); +end; + + +function TMalList.Rest() : TMalList; +begin + if Length(Val) <= 1 then + Rest := (_list() as TMalList) + else + Rest := TMalList.Create(copy(Val, 1, Length(Val)-1)); +end; + +// Hash Maps + +constructor TMalHashMap.Create(); +begin + inherited Create(); + Self.Val := TMalDict.Create; +end; + +constructor TMalHashMap.Create(V : TMalDict); +begin + inherited Create(); + Self.Val := V; +end; + +function TMalHashMap.assoc_BANG(KVs: TMalArray) : TMal; +var + I : longint; +begin + I := 0; + while I < Length(KVs) do + begin + Self.Val[(KVs[I] as TMalString).Val] := KVs[I+1]; + I := I + 2; + end; + assoc_BANG := Self; +end; + +function TMalHashMap.dissoc_BANG(Ks: TMalArray) : TMal; +var + I : longint; +begin + for I := 0 to Length(Ks)-1 do + Self.Val.Remove((Ks[I] as TMalString).Val); + dissoc_BANG := Self; +end; + + +constructor TMalHashMap.Create(V : TMalArray); +begin + Self.Create(); + Self.assoc_BANG(V); +end; + +constructor TMalHashMap.Clone(HM : TMalHashMap); +var + I : longint; +begin + Self.Create(); + I := 0; + while I < HM.Val.Count do + begin + Self.Val[HM.Val.Keys[I]] := HM.Val[HM.Val.Keys[I]]; + I := I + 1; + end; +end; + + +// Atoms + +constructor TMalAtom.Create(V : TMal); +begin + inherited Create(); + Self.Val := V; +end; + +// +// General type functions +// + +function GetBacktrace(E: Exception) : string; +var + I: Integer; + Frames: PPointer; +begin + GetBacktrace := BackTraceStrFunc(ExceptAddr); + Frames := ExceptFrames; + for I := 0 to ExceptFrameCount - 1 do + GetBacktrace := GetBacktrace + #10 + BackTraceStrFunc(Frames[I]); +end; + +function wrap_tf(x : Boolean) : TMal; +begin + if x = true then wrap_tf := TMalTrue.Create + else wrap_tf := TMalFalse.Create; +end; + +function _equal_Q(A : TMal; B : TMal) : Boolean; +var + I : longint; + ArrA, ArrB : TMalArray; + DictA, DictB : TMalDict; + Key : string; +begin + if not ((A.ClassType = B.ClassType) or + ((A is TMalList) and (B is TMalList))) then + _equal_Q := false + else + begin + if A is TMalList then + begin + ArrA := (A as TMalList).Val; + ArrB := (B as TMalList).Val; + if Length(ArrA) <> Length(ArrB) then + Exit(false); + for I := 0 to Length(ArrA)-1 do + if not _equal_Q(ArrA[I], ArrB[I]) then + Exit(false); + _equal_Q := true; + end + else if A is TMalHashMap then + begin + DictA := (A as TMalHashMap).Val; + DictB := (B as TMalHashMap).Val; + if DictA.Count <> DictB.Count then + Exit(false); + for I := 0 to DictA.Count-1 do + begin + Key := DictA.Keys[I]; + if DictB.IndexOf(Key) < 0 then + Exit(false); + if not _equal_Q(DictA[Key], DictB[Key]) then + Exit(false); + end; + _equal_Q := true; + end + else if A is TMalString then + _equal_Q := (A as TMalString).Val = (B as TMalString).Val + else if A is TMalSymbol then + _equal_Q := (A as TMalSymbol).Val = (B as TMalSymbol).Val + else if A is TMalInt then + _equal_Q := (A as TMalInt).Val = (B as TMalInt).Val + else if A is TMalNil then + _equal_Q := B is TMalNil + else if A is TMalTrue then + _equal_Q := B is TMalTrue + else if A is TMalFalse then + _equal_Q := B is TMalFalse + else + _equal_Q := A = B; + end +end; + +function _sequential_Q(Obj: TMal) : Boolean; +begin + _sequential_Q := Obj is TMalList; +end; + + +function _list() : TMalList; +var + Arr: TMalArray; +begin + SetLength(Arr, 0); + _list := TMalList.Create(Arr); +end; + +function _list(A: TMal) : TMalList; +var + Arr: TMalArray; +begin + SetLength(Arr, 1); + Arr[0] := A; + _list := TMalList.Create(Arr); +end; + +function _list(A: TMal; B: TMal) : TMalList; +var + Arr: TMalArray; +begin + SetLength(Arr, 2); + Arr[0] := A; + Arr[1] := B; + _list := TMalList.Create(Arr); +end; + +function _list(A: TMal; B: TMal; C: TMal) : TMalList; +var + Arr: TMalArray; +begin + SetLength(Arr, 3); + Arr[0] := A; + Arr[1] := B; + Arr[2] := C; + _list := TMalList.Create(Arr); +end; + +function _concat(A: TMalArray; B: TMalArray) : TMalArray; +var + Res : TMalArray; + I : longint; +begin + SetLength(Res, Length(A) + Length(B)); + for I := 0 to Length(A)-1 do + Res[I] := A[I]; + for I := 0 to Length(B)-1 do + Res[I+Length(A)] := B[I]; + _concat := Res; +end; + +function _string_Q(Obj: TMal) : Boolean; +var + Str : string; +begin + if (Obj is TMalString) then + begin + Str := (Obj as TMalString).Val; + _string_Q := (Length(Str) = 0) or (Str[1] <> #127) + end + else + _string_Q := false; +end; + +end. diff --git a/impls/objpascal/printer.pas b/impls/objpascal/printer.pas new file mode 100644 index 0000000000..4f1ddaf356 --- /dev/null +++ b/impls/objpascal/printer.pas @@ -0,0 +1,114 @@ +unit printer; + +{$H+} // Use AnsiString + +interface + +Uses sysutils, + mal_types, + mal_func; + +function pr_str_array(Args : TMalArray; + print_readably : Boolean; + Separator : string) : string; + +function pr_str(Obj : TMal; print_readably : Boolean) : string; + +implementation + +function pr_str_array(Args : TMalArray; + print_readably : Boolean; + Separator : string) : string; +var + Str : string; + I : longint; +begin + Str := ''; + for I := 0 to Length(Args)-1 do + begin + Str := Str + pr_str(Args[I], print_readably); + if I <> Length(Args)-1 then + Str := Str + Separator; + end; + pr_str_array := Str; +end; + +function pr_str_dict(Dict : TMalDict; + print_readably : Boolean; + Separator : string) : string; +var + I : longint; + Arr : TMalArray; +begin + SetLength(Arr, Dict.Count * 2); + I := 0; + while I < Dict.Count do + begin + Arr[I*2] := TMalString.Create(Dict.Keys[I]); + Arr[I*2+1] := Dict[Dict.Keys[I]]; + I := I + 1; + end; + pr_str_dict := pr_str_array(Arr, print_readably, ' '); +end; + + +function pr_str(Obj : TMal; print_readably : Boolean) : string; +var + Str : string; + Fn : TMalFunc; +begin + if Obj.ClassType = TMalList then + pr_str := '(' + pr_str_array((Obj as TMalList).Val, + print_readably, + ' ') + ')' + else if Obj.ClassType = TMalVector then + pr_str := '[' + pr_str_array((Obj as TMalList).Val, + print_readably, + ' ') + ']' + else if Obj is TMalHashMap then + pr_str := '{' + pr_str_dict((Obj as TMalHashMap).Val, + print_readably, + ' ') + '}' + else if Obj is TMalString then + begin + Str := (Obj as TMalString).Val; + if (Length(Str) > 0) and (Str[1] = #127) then + pr_str := ':' + copy(Str, 2, Length(Str)) + else if print_readably then + begin + Str := StringReplace(Str, '\', '\\', [rfReplaceAll]); + Str := StringReplace(Str, '"', '\"', [rfReplaceAll]); + Str := StringReplace(Str, #10, '\n', [rfReplaceAll]); + pr_str := Format('"%s"', [Str]) + end + else + pr_str := Str; + end + else if Obj is TMalNil then + pr_str := 'nil' + else if Obj is TMalTrue then + pr_str := 'true' + else if Obj is TMalFalse then + pr_str := 'false' + else if Obj is TMalInt then + pr_str := IntToStr((Obj as TMalInt).Val) + else if Obj is TMalSymbol then + pr_str := (Obj as TMalSymbol).Val + else if Obj is TMalAtom then + pr_str := '(atom ' + + pr_str((Obj as TMalAtom).Val, print_readably) + + ')' + else if Obj is TMalFunc then + begin + Fn := (Obj as TMalFunc); + if Fn.Ast = nil then + pr_str := '#' + else + pr_str := '(fn* ' + pr_str(Fn.Params,true) + + ' ' + pr_str(Fn.Ast,true) + ')' + end + else + pr_str := '#unknown'; +end; + +end. diff --git a/impls/objpascal/reader.pas b/impls/objpascal/reader.pas new file mode 100644 index 0000000000..d77ebf90b4 --- /dev/null +++ b/impls/objpascal/reader.pas @@ -0,0 +1,235 @@ +unit reader; + +{$H+} // Use AnsiString + +interface + +Uses sysutils, + Classes, + RegExpr in 'regexpr/Source/RegExpr.pas', + mal_types; + +// +// Reader class +// + +type TReader = class(TObject) + public + Tokens : TStringList; + Position : Integer; + + constructor Create(Toks: TStringList); + + function Peek() : string; + function Next() : string; +end; + +// +// reader functions +// + +function read_str(const Str: string): TMal; + + +implementation + +// +// Reader class +// + +constructor TReader.Create(Toks: TStringList); +begin + inherited Create(); + Self.Tokens := Toks; + Self.Position := 0; +end; + +function TReader.Peek() : string; +begin + if Position >= Tokens.Count then + Peek := #0 + else + Peek := Tokens[Position]; +end; + +function TReader.Next() : string; +begin + Next := Tokens[Position]; + Position := Position + 1; +end; + + +// +// reader functions +// + +function tokenize(const Str: string) : TStringList; +var + RE : TRegExpr; + Tokens : TStringList; +begin + RE := TRegExpr.Create; + RE.Expression := '[\s,]*(~@|[\[\]{}()''`~^@]|"(([\\].|[^\\"])*)"?|;[^\r\n]*|[^\s\[\]{}()''"`@,;]+)'; + Tokens := TStringList.Create; + if RE.Exec(Str) then + begin + repeat + if RE.Match[1][1] <> ';' then + Tokens.Add(RE.Match[1]); + until not RE.ExecNext; + end; + RE.Free; + + tokenize := Tokens; +end; + + +function read_atom(Reader : TReader) : TMal; +var + RE : TRegExpr; + Token : string; + Str : string; +begin + RE := TRegExpr.Create; + RE.Expression := '(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^("([\\].|[^\\"])*)"$|^(\".*)$|:(.*)|(^[^\"]*$)'; + Token := Reader.Next(); + //WriteLn('token: ' + Token); + if RE.Exec(Token) then + begin + if RE.Match[1] <> '' then + read_atom := TMalInt.Create(StrToInt(RE.Match[1])) + else if RE.Match[2] <> '' then + // TODO + read_atom := TMalNil.Create + else if RE.Match[3] <> '' then + read_atom := TMalNil.Create + else if RE.Match[4] <> '' then + read_atom := TMalTrue.Create + else if RE.Match[5] <> '' then + read_atom := TMalFalse.Create + else if RE.Match[6] <> '' then + begin + Str := copy(Token, 2, Length(Token)-2); + Str := StringReplace(Str, '\\', #127, [rfReplaceAll]); + Str := StringReplace(Str, '\"', '"', [rfReplaceAll]); + Str := StringReplace(Str, '\n', #10, [rfReplaceAll]); + Str := StringReplace(Str, #127, '\', [rfReplaceAll]); + read_atom := TMalString.Create(Str) + end + else if RE.Match[8] <> '' then + raise Exception.Create('expected ''"'', got EOF') + else if RE.Match[9] <> '' then + read_atom := TMalString.Create(#127 + RE.Match[9]) + else if RE.Match[10] <> '' then + read_atom := TMalSymbol.Create(Token); + end + else + begin + RE.Free; + raise Exception.Create('Invalid token in read_atom'); + end; + RE.Free; +end; + +// Forward declaration since read_seq calls it +function read_form(Reader : TReader) : TMal; forward; + +function read_seq(Reader : TReader; start: string; last: string) : TMalArray; +var + Token : string; + Ast : TMalArray; +begin + SetLength(Ast, 0); + + Token := Reader.Next(); + if Token <> start then + raise Exception.Create('expected ''' + start + ''''); + + Token := Reader.Peek(); + while Token <> last do + begin + if Token = #0 then + raise Exception.Create('expected ''' + last + ''', got EOF'); + SetLength(Ast, Length(Ast)+1); + Ast[Length(Ast)-1] := read_form(Reader); + Token := Reader.Peek(); + end; + + Token := Reader.Next(); + read_seq := Ast; +end; + +function read_form(Reader : TReader) : TMal; +var + Token : string; + Meta : TMal; +begin + Token := Reader.Peek(); + case Token of + // reader macros/transforms + '''': + begin + Reader.Next(); + read_form := _list(TMalSymbol.Create('quote'), + read_form(Reader)); + end; + '`': + begin + Reader.Next(); + read_form := _list(TMalSymbol.Create('quasiquote'), + read_form(Reader)); + end; + '~': + begin + Reader.Next(); + read_form := _list(TMalSymbol.Create('unquote'), + read_form(Reader)); + end; + '~@': + begin + Reader.Next(); + read_form := _list(TMalSymbol.Create('splice-unquote'), + read_form(Reader)); + end; + '^': + begin + Reader.Next(); + Meta := read_form(Reader); + read_form := _list(TMalSymbol.Create('with-meta'), + read_form(Reader), + Meta); + end; + '@': + begin + Reader.Next(); + read_form := _list(TMalSymbol.Create('deref'), read_form(Reader)); + end; + + // list + ')': raise Exception.Create('unexpected '')'''); + '(': read_form := TMalList.Create(read_seq(Reader, '(', ')')); + + // vector + ']': raise Exception.Create('unexpected '']'''); + '[': read_form := TMalVector.Create(read_seq(Reader, '[', ']')); + + // hash-map + '}': raise Exception.Create('unexpected ''}'''); + '{': read_form := TMalHashMap.Create(read_seq(Reader, '{', '}')); + else + read_form := read_atom(Reader); + end; +end; + + +function read_str(const Str: string): TMal; +var + Tokens : TStringList; + //Dict : TObjectDictionary; +begin + Tokens := tokenize(Str); + // TODO: check for empty list + read_str := read_form(TReader.Create(Tokens)); +end; + +end. diff --git a/impls/objpascal/regexpr/Source/RegExpr.pas b/impls/objpascal/regexpr/Source/RegExpr.pas new file mode 100644 index 0000000000..c97063fbd9 --- /dev/null +++ b/impls/objpascal/regexpr/Source/RegExpr.pas @@ -0,0 +1,4043 @@ +unit RegExpr; + +{ + TRegExpr class library + Delphi Regular Expressions + + Copyright (c) 1999-2004 Andrey V. Sorokin, St.Petersburg, Russia + + You may use this software in any kind of development, + including comercial, redistribute, and modify it freely, + under the following restrictions : + 1. This software is provided as it is, without any kind of + warranty given. Use it at Your own risk.The author is not + responsible for any consequences of use of this software. + 2. The origin of this software may not be mispresented, You + must not claim that You wrote the original software. If + You use this software in any kind of product, it would be + appreciated that there in a information box, or in the + documentation would be an acknowledgement like + + Partial Copyright (c) 2004 Andrey V. Sorokin + http://RegExpStudio.com + mailto:anso@mail.ru + + 3. You may not have any income from distributing this source + (or altered version of it) to other developers. When You + use this product in a comercial package, the source may + not be charged seperatly. + 4. Altered versions must be plainly marked as such, and must + not be misrepresented as being the original software. + 5. RegExp Studio application and all the visual components as + well as documentation is not part of the TRegExpr library + and is not free for usage. + + mailto:anso@mail.ru + http://RegExpStudio.com + http://anso.da.ru/ +} + +interface + +// ======== Determine compiler +{$IFDEF VER80} Sorry, TRegExpr is for 32-bits Delphi only. Delphi 1 is not supported (and whos really care today?!). {$ENDIF} +{$IFDEF VER90} {$DEFINE D2} {$ENDIF} // D2 +{$IFDEF VER93} {$DEFINE D2} {$ENDIF} // CPPB 1 +{$IFDEF VER100} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D3 +{$IFDEF VER110} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // CPPB 3 +{$IFDEF VER120} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D4 +{$IFDEF VER130} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D5 +{$IFDEF VER140} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D6 +{$IFDEF VER150} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7 + +// ======== Define base compiler options +{$BOOLEVAL OFF} +{$EXTENDEDSYNTAX ON} +{$LONGSTRINGS ON} +{$OPTIMIZATION ON} +{$IFDEF D6} + {$WARN SYMBOL_PLATFORM OFF} // Suppress .Net warnings +{$ENDIF} +{$IFDEF D7} + {$WARN UNSAFE_CAST OFF} // Suppress .Net warnings + {$WARN UNSAFE_TYPE OFF} // Suppress .Net warnings + {$WARN UNSAFE_CODE OFF} // Suppress .Net warnings +{$ENDIF} +{$IFDEF FPC} + {$MODE DELPHI} // Delphi-compatible mode in FreePascal +{$ENDIF} + +// ======== Define options for TRegExpr engine +{.$DEFINE UniCode} // Unicode support +{$DEFINE RegExpPCodeDump} // p-code dumping (see Dump method) +{$IFNDEF FPC} // the option is not supported in FreePascal + {$DEFINE reRealExceptionAddr} // exceptions will point to appropriate source line, not to Error procedure +{$ENDIF} +{$DEFINE ComplexBraces} // support braces in complex cases +{$IFNDEF UniCode} // the option applicable only for non-UniCode mode + {$DEFINE UseSetOfChar} // Significant optimization by using set of char +{$ENDIF} +{$IFDEF UseSetOfChar} + {$DEFINE UseFirstCharSet} // Fast skip between matches for r.e. that starts with determined set of chars +{$ENDIF} + +// ======== Define Pascal-language options +// Define 'UseAsserts' option (do not edit this definitions). +// Asserts used to catch 'strange bugs' in TRegExpr implementation (when something goes +// completely wrong). You can swith asserts on/off with help of {$C+}/{$C-} compiler options. +{$IFDEF D3} {$DEFINE UseAsserts} {$ENDIF} +{$IFDEF FPC} {$DEFINE UseAsserts} {$ENDIF} + +// Define 'use subroutine parameters default values' option (do not edit this definition). +{$IFDEF D4} {$DEFINE DefParam} {$ENDIF} + +// Define 'OverMeth' options, to use method overloading (do not edit this definitions). +{$IFDEF D5} {$DEFINE OverMeth} {$ENDIF} +{$IFDEF FPC} {$DEFINE OverMeth} {$ENDIF} + +uses + Classes, // TStrings in Split method + SysUtils; // Exception + +type + {$IFDEF UniCode} + PRegExprChar = PWideChar; + RegExprString = WideString; + REChar = WideChar; + {$ELSE} + PRegExprChar = PChar; + RegExprString = AnsiString; //###0.952 was string + REChar = Char; + {$ENDIF} + TREOp = REChar; // internal p-code type //###0.933 + PREOp = ^TREOp; + TRENextOff = integer; // internal Next "pointer" (offset to current p-code) //###0.933 + PRENextOff = ^TRENextOff; // used for extracting Next "pointers" from compiled r.e. //###0.933 + TREBracesArg = integer; // type of {m,n} arguments + PREBracesArg = ^TREBracesArg; + +const + REOpSz = SizeOf (TREOp) div SizeOf (REChar); // size of p-code in RegExprString units + RENextOffSz = SizeOf (TRENextOff) div SizeOf (REChar); // size of Next 'pointer' -"- + REBracesArgSz = SizeOf (TREBracesArg) div SizeOf (REChar); // size of BRACES arguments -"- + +type + TRegExprInvertCaseFunction = function (const Ch : REChar) : REChar + of object; + +const + EscChar = '\'; // 'Escape'-char ('\' in common r.e.) used for escaping metachars (\w, \d etc). + RegExprModifierI : boolean = False; // default value for ModifierI + RegExprModifierR : boolean = True; // default value for ModifierR + RegExprModifierS : boolean = True; // default value for ModifierS + RegExprModifierG : boolean = True; // default value for ModifierG + RegExprModifierM : boolean = False; // default value for ModifierM + RegExprModifierX : boolean = False; // default value for ModifierX + RegExprSpaceChars : RegExprString = // default value for SpaceChars + ' '#$9#$A#$D#$C; + RegExprWordChars : RegExprString = // default value for WordChars + '0123456789' //###0.940 + + 'abcdefghijklmnopqrstuvwxyz' + + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'; + RegExprLineSeparators : RegExprString =// default value for LineSeparators + #$d#$a{$IFDEF UniCode}+#$b#$c#$2028#$2029#$85{$ENDIF}; //###0.947 + RegExprLinePairedSeparator : RegExprString =// default value for LinePairedSeparator + #$d#$a; + { if You need Unix-styled line separators (only \n), then use: + RegExprLineSeparators = #$a; + RegExprLinePairedSeparator = ''; + } + + +const + NSUBEXP = 15; // max number of subexpression //###0.929 + // Cannot be more than NSUBEXPMAX + // Be carefull - don't use values which overflow CLOSE opcode + // (in this case you'll get compiler erorr). + // Big NSUBEXP will cause more slow work and more stack required + NSUBEXPMAX = 255; // Max possible value for NSUBEXP. //###0.945 + // Don't change it! It's defined by internal TRegExpr design. + + MaxBracesArg = $7FFFFFFF - 1; // max value for {n,m} arguments //###0.933 + + {$IFDEF ComplexBraces} + LoopStackMax = 10; // max depth of loops stack //###0.925 + {$ENDIF} + + TinySetLen = 3; + // if range includes more then TinySetLen chars, //###0.934 + // then use full (32 bytes) ANYOFFULL instead of ANYOF[BUT]TINYSET + // !!! Attension ! If you change TinySetLen, you must + // change code marked as "//!!!TinySet" + + +type + +{$IFDEF UseSetOfChar} + PSetOfREChar = ^TSetOfREChar; + TSetOfREChar = set of REChar; +{$ENDIF} + + TRegExpr = class; + + TRegExprReplaceFunction = function (ARegExpr : TRegExpr): string + of object; + + TRegExpr = class + private + startp : array [0 .. NSUBEXP - 1] of PRegExprChar; // founded expr starting points + endp : array [0 .. NSUBEXP - 1] of PRegExprChar; // founded expr end points + + {$IFDEF ComplexBraces} + LoopStack : array [1 .. LoopStackMax] of integer; // state before entering loop + LoopStackIdx : integer; // 0 - out of all loops + {$ENDIF} + + // The "internal use only" fields to pass info from compile + // to execute that permits the execute phase to run lots faster on + // simple cases. + regstart : REChar; // char that must begin a match; '\0' if none obvious + reganch : REChar; // is the match anchored (at beginning-of-line only)? + regmust : PRegExprChar; // string (pointer into program) that match must include, or nil + regmlen : integer; // length of regmust string + // Regstart and reganch permit very fast decisions on suitable starting points + // for a match, cutting down the work a lot. Regmust permits fast rejection + // of lines that cannot possibly match. The regmust tests are costly enough + // that regcomp() supplies a regmust only if the r.e. contains something + // potentially expensive (at present, the only such thing detected is * or + + // at the start of the r.e., which can involve a lot of backup). Regmlen is + // supplied because the test in regexec() needs it and regcomp() is computing + // it anyway. + {$IFDEF UseFirstCharSet} //###0.929 + FirstCharSet : TSetOfREChar; + {$ENDIF} + + // work variables for Exec's routins - save stack in recursion} + reginput : PRegExprChar; // String-input pointer. + fInputStart : PRegExprChar; // Pointer to first char of input string. + fInputEnd : PRegExprChar; // Pointer to char AFTER last char of input string + + // work variables for compiler's routines + regparse : PRegExprChar; // Input-scan pointer. + regnpar : integer; // count. + regdummy : char; + regcode : PRegExprChar; // Code-emit pointer; @regdummy = don't. + regsize : integer; // Code size. + + regexpbeg : PRegExprChar; // only for error handling. Contains + // pointer to beginning of r.e. while compiling + fExprIsCompiled : boolean; // true if r.e. successfully compiled + + // programm is essentially a linear encoding + // of a nondeterministic finite-state machine (aka syntax charts or + // "railroad normal form" in parsing technology). Each node is an opcode + // plus a "next" pointer, possibly plus an operand. "Next" pointers of + // all nodes except BRANCH implement concatenation; a "next" pointer with + // a BRANCH on both ends of it is connecting two alternatives. (Here we + // have one of the subtle syntax dependencies: an individual BRANCH (as + // opposed to a collection of them) is never concatenated with anything + // because of operator precedence.) The operand of some types of node is + // a literal string; for others, it is a node leading into a sub-FSM. In + // particular, the operand of a BRANCH node is the first node of the branch. + // (NB this is *not* a tree structure: the tail of the branch connects + // to the thing following the set of BRANCHes.) The opcodes are: + programm : PRegExprChar; // Unwarranted chumminess with compiler. + + fExpression : PRegExprChar; // source of compiled r.e. + fInputString : PRegExprChar; // input string + + fLastError : integer; // see Error, LastError + + fModifiers : integer; // modifiers + fCompModifiers : integer; // compiler's copy of modifiers + fProgModifiers : integer; // modifiers values from last programm compilation + + fSpaceChars : RegExprString; //###0.927 + fWordChars : RegExprString; //###0.929 + fInvertCase : TRegExprInvertCaseFunction; //###0.927 + + fLineSeparators : RegExprString; //###0.941 + fLinePairedSeparatorAssigned : boolean; + fLinePairedSeparatorHead, + fLinePairedSeparatorTail : REChar; + {$IFNDEF UniCode} + fLineSeparatorsSet : set of REChar; + {$ENDIF} + + procedure InvalidateProgramm; + // Mark programm as have to be [re]compiled + + function IsProgrammOk : boolean; //###0.941 + // Check if we can use precompiled r.e. or + // [re]compile it if something changed + + function GetExpression : RegExprString; + procedure SetExpression (const s : RegExprString); + + function GetModifierStr : RegExprString; + class function ParseModifiersStr (const AModifiers : RegExprString; + var AModifiersInt : integer) : boolean; //###0.941 class function now + // Parse AModifiers string and return true and set AModifiersInt + // if it's in format 'ismxrg-ismxrg'. + procedure SetModifierStr (const AModifiers : RegExprString); + + function GetModifier (AIndex : integer) : boolean; + procedure SetModifier (AIndex : integer; ASet : boolean); + + procedure Error (AErrorID : integer); virtual; // error handler. + // Default handler raise exception ERegExpr with + // Message = ErrorMsg (AErrorID), ErrorCode = AErrorID + // and CompilerErrorPos = value of property CompilerErrorPos. + + + {==================== Compiler section ===================} + function CompileRegExpr (exp : PRegExprChar) : boolean; + // compile a regular expression into internal code + + procedure Tail (p : PRegExprChar; val : PRegExprChar); + // set the next-pointer at the end of a node chain + + procedure OpTail (p : PRegExprChar; val : PRegExprChar); + // regoptail - regtail on operand of first argument; nop if operandless + + function EmitNode (op : TREOp) : PRegExprChar; + // regnode - emit a node, return location + + procedure EmitC (b : REChar); + // emit (if appropriate) a byte of code + + procedure InsertOperator (op : TREOp; opnd : PRegExprChar; sz : integer); //###0.90 + // insert an operator in front of already-emitted operand + // Means relocating the operand. + + function ParseReg (paren : integer; var flagp : integer) : PRegExprChar; + // regular expression, i.e. main body or parenthesized thing + + function ParseBranch (var flagp : integer) : PRegExprChar; + // one alternative of an | operator + + function ParsePiece (var flagp : integer) : PRegExprChar; + // something followed by possible [*+?] + + function ParseAtom (var flagp : integer) : PRegExprChar; + // the lowest level + + function GetCompilerErrorPos : integer; + // current pos in r.e. - for error hanling + + {$IFDEF UseFirstCharSet} //###0.929 + procedure FillFirstCharSet (prog : PRegExprChar); + {$ENDIF} + + {===================== Mathing section ===================} + function regrepeat (p : PRegExprChar; AMax : integer) : integer; + // repeatedly match something simple, report how many + + function regnext (p : PRegExprChar) : PRegExprChar; + // dig the "next" pointer out of a node + + function MatchPrim (prog : PRegExprChar) : boolean; + // recursively matching routine + + function ExecPrim (AOffset: integer) : boolean; + // Exec for stored InputString + + {$IFDEF RegExpPCodeDump} + function DumpOp (op : REChar) : RegExprString; + {$ENDIF} + + function GetSubExprMatchCount : integer; + function GetMatchPos (Idx : integer) : integer; + function GetMatchLen (Idx : integer) : integer; + function GetMatch (Idx : integer) : RegExprString; + + function GetInputString : RegExprString; + procedure SetInputString (const AInputString : RegExprString); + + {$IFNDEF UseSetOfChar} + function StrScanCI (s : PRegExprChar; ch : REChar) : PRegExprChar; //###0.928 + {$ENDIF} + + procedure SetLineSeparators (const AStr : RegExprString); + procedure SetLinePairedSeparator (const AStr : RegExprString); + function GetLinePairedSeparator : RegExprString; + + public + constructor Create; + destructor Destroy; override; + + class function VersionMajor : integer; //###0.944 + class function VersionMinor : integer; //###0.944 + + property Expression : RegExprString read GetExpression write SetExpression; + // Regular expression. + // For optimization, TRegExpr will automatically compiles it into 'P-code' + // (You can see it with help of Dump method) and stores in internal + // structures. Real [re]compilation occures only when it really needed - + // while calling Exec[Next], Substitute, Dump, etc + // and only if Expression or other P-code affected properties was changed + // after last [re]compilation. + // If any errors while [re]compilation occures, Error method is called + // (by default Error raises exception - see below) + + property ModifierStr : RegExprString read GetModifierStr write SetModifierStr; + // Set/get default values of r.e.syntax modifiers. Modifiers in + // r.e. (?ismx-ismx) will replace this default values. + // If you try to set unsupported modifier, Error will be called + // (by defaul Error raises exception ERegExpr). + + property ModifierI : boolean index 1 read GetModifier write SetModifier; + // Modifier /i - caseinsensitive, initialized from RegExprModifierI + + property ModifierR : boolean index 2 read GetModifier write SetModifier; + // Modifier /r - use r.e.syntax extended for russian, + // (was property ExtSyntaxEnabled in previous versions) + // If true, then à-ÿ additional include russian letter '¸', + // À-ß additional include '¨', and à-ß include all russian symbols. + // You have to turn it off if it may interfere with you national alphabet. + // , initialized from RegExprModifierR + + property ModifierS : boolean index 3 read GetModifier write SetModifier; + // Modifier /s - '.' works as any char (else as [^\n]), + // , initialized from RegExprModifierS + + property ModifierG : boolean index 4 read GetModifier write SetModifier; + // Switching off modifier /g switchs all operators in + // non-greedy style, so if ModifierG = False, then + // all '*' works as '*?', all '+' as '+?' and so on. + // , initialized from RegExprModifierG + + property ModifierM : boolean index 5 read GetModifier write SetModifier; + // Treat string as multiple lines. That is, change `^' and `$' from + // matching at only the very start or end of the string to the start + // or end of any line anywhere within the string. + // , initialized from RegExprModifierM + + property ModifierX : boolean index 6 read GetModifier write SetModifier; + // Modifier /x - eXtended syntax, allow r.e. text formatting, + // see description in the help. Initialized from RegExprModifierX + + function Exec (const AInputString : RegExprString) : boolean; {$IFDEF OverMeth} overload; + {$IFNDEF FPC} // I do not know why FreePascal cannot overload methods with empty param list + function Exec : boolean; overload; //###0.949 + {$ENDIF} + function Exec (AOffset: integer) : boolean; overload; //###0.949 + {$ENDIF} + // match a programm against a string AInputString + // !!! Exec store AInputString into InputString property + // For Delphi 5 and higher available overloaded versions - first without + // parameter (uses already assigned to InputString property value) + // and second that has integer parameter and is same as ExecPos + + function ExecNext : boolean; + // find next match: + // ExecNext; + // works same as + // if MatchLen [0] = 0 then ExecPos (MatchPos [0] + 1) + // else ExecPos (MatchPos [0] + MatchLen [0]); + // but it's more simpler ! + // Raises exception if used without preceeding SUCCESSFUL call to + // Exec* (Exec, ExecPos, ExecNext). So You always must use something like + // if Exec (InputString) then repeat { proceed results} until not ExecNext; + + function ExecPos (AOffset: integer {$IFDEF DefParam}= 1{$ENDIF}) : boolean; + // find match for InputString starting from AOffset position + // (AOffset=1 - first char of InputString) + + property InputString : RegExprString read GetInputString write SetInputString; + // returns current input string (from last Exec call or last assign + // to this property). + // Any assignment to this property clear Match* properties ! + + function Substitute (const ATemplate : RegExprString) : RegExprString; + // Returns ATemplate with '$&' or '$0' replaced by whole r.e. + // occurence and '$n' replaced by occurence of subexpression #n. + // Since v.0.929 '$' used instead of '\' (for future extensions + // and for more Perl-compatibility) and accept more then one digit. + // If you want place into template raw '$' or '\', use prefix '\' + // Example: '1\$ is $2\\rub\\' -> '1$ is \rub\' + // If you want to place raw digit after '$n' you must delimit + // n with curly braces '{}'. + // Example: 'a$12bc' -> 'abc' + // 'a${1}2bc' -> 'a2bc'. + + procedure Split (AInputStr : RegExprString; APieces : TStrings); + // Split AInputStr into APieces by r.e. occurencies + // Internally calls Exec[Next] + + function Replace (AInputStr : RegExprString; + const AReplaceStr : RegExprString; + AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) //###0.946 + : RegExprString; {$IFDEF OverMeth} overload; + function Replace (AInputStr : RegExprString; + AReplaceFunc : TRegExprReplaceFunction) + : RegExprString; overload; + {$ENDIF} + function ReplaceEx (AInputStr : RegExprString; + AReplaceFunc : TRegExprReplaceFunction) + : RegExprString; + // Returns AInputStr with r.e. occurencies replaced by AReplaceStr + // If AUseSubstitution is true, then AReplaceStr will be used + // as template for Substitution methods. + // For example: + // Expression := '({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*'; + // Replace ('BLOCK( test1)', 'def "$1" value "$2"', True); + // will return: def 'BLOCK' value 'test1' + // Replace ('BLOCK( test1)', 'def "$1" value "$2"') + // will return: def "$1" value "$2" + // Internally calls Exec[Next] + // Overloaded version and ReplaceEx operate with call-back function, + // so You can implement really complex functionality. + + property SubExprMatchCount : integer read GetSubExprMatchCount; + // Number of subexpressions has been found in last Exec* call. + // If there are no subexpr. but whole expr was found (Exec* returned True), + // then SubExprMatchCount=0, if no subexpressions nor whole + // r.e. found (Exec* returned false) then SubExprMatchCount=-1. + // Note, that some subexpr. may be not found and for such + // subexpr. MathPos=MatchLen=-1 and Match=''. + // For example: Expression := '(1)?2(3)?'; + // Exec ('123'): SubExprMatchCount=2, Match[0]='123', [1]='1', [2]='3' + // Exec ('12'): SubExprMatchCount=1, Match[0]='12', [1]='1' + // Exec ('23'): SubExprMatchCount=2, Match[0]='23', [1]='', [2]='3' + // Exec ('2'): SubExprMatchCount=0, Match[0]='2' + // Exec ('7') - return False: SubExprMatchCount=-1 + + property MatchPos [Idx : integer] : integer read GetMatchPos; + // pos of entrance subexpr. #Idx into tested in last Exec* + // string. First subexpr. have Idx=1, last - MatchCount, + // whole r.e. have Idx=0. + // Returns -1 if in r.e. no such subexpr. or this subexpr. + // not found in input string. + + property MatchLen [Idx : integer] : integer read GetMatchLen; + // len of entrance subexpr. #Idx r.e. into tested in last Exec* + // string. First subexpr. have Idx=1, last - MatchCount, + // whole r.e. have Idx=0. + // Returns -1 if in r.e. no such subexpr. or this subexpr. + // not found in input string. + // Remember - MatchLen may be 0 (if r.e. match empty string) ! + + property Match [Idx : integer] : RegExprString read GetMatch; + // == copy (InputString, MatchPos [Idx], MatchLen [Idx]) + // Returns '' if in r.e. no such subexpr. or this subexpr. + // not found in input string. + + function LastError : integer; + // Returns ID of last error, 0 if no errors (unusable if + // Error method raises exception) and clear internal status + // into 0 (no errors). + + function ErrorMsg (AErrorID : integer) : RegExprString; virtual; + // Returns Error message for error with ID = AErrorID. + + property CompilerErrorPos : integer read GetCompilerErrorPos; + // Returns pos in r.e. there compiler stopped. + // Usefull for error diagnostics + + property SpaceChars : RegExprString read fSpaceChars write fSpaceChars; //###0.927 + // Contains chars, treated as /s (initially filled with RegExprSpaceChars + // global constant) + + property WordChars : RegExprString read fWordChars write fWordChars; //###0.929 + // Contains chars, treated as /w (initially filled with RegExprWordChars + // global constant) + + property LineSeparators : RegExprString read fLineSeparators write SetLineSeparators; //###0.941 + // line separators (like \n in Unix) + + property LinePairedSeparator : RegExprString read GetLinePairedSeparator write SetLinePairedSeparator; //###0.941 + // paired line separator (like \r\n in DOS and Windows). + // must contain exactly two chars or no chars at all + + class function InvertCaseFunction (const Ch : REChar) : REChar; + // Converts Ch into upper case if it in lower case or in lower + // if it in upper (uses current system local setings) + + property InvertCase : TRegExprInvertCaseFunction read fInvertCase write fInvertCase; //##0.935 + // Set this property if you want to override case-insensitive functionality. + // Create set it to RegExprInvertCaseFunction (InvertCaseFunction by default) + + procedure Compile; //###0.941 + // [Re]compile r.e. Usefull for example for GUI r.e. editors (to check + // all properties validity). + + {$IFDEF RegExpPCodeDump} + function Dump : RegExprString; + // dump a compiled regexp in vaguely comprehensible form + {$ENDIF} + end; + + ERegExpr = class (Exception) + public + ErrorCode : integer; + CompilerErrorPos : integer; + end; + +const + RegExprInvertCaseFunction : TRegExprInvertCaseFunction = {$IFDEF FPC} nil {$ELSE} TRegExpr.InvertCaseFunction{$ENDIF}; + // defaul for InvertCase property + +function ExecRegExpr (const ARegExpr, AInputStr : RegExprString) : boolean; +// true if string AInputString match regular expression ARegExpr +// ! will raise exeption if syntax errors in ARegExpr + +procedure SplitRegExpr (const ARegExpr, AInputStr : RegExprString; APieces : TStrings); +// Split AInputStr into APieces by r.e. ARegExpr occurencies + +function ReplaceRegExpr (const ARegExpr, AInputStr, AReplaceStr : RegExprString; + AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) : RegExprString; //###0.947 +// Returns AInputStr with r.e. occurencies replaced by AReplaceStr +// If AUseSubstitution is true, then AReplaceStr will be used +// as template for Substitution methods. +// For example: +// ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*', +// 'BLOCK( test1)', 'def "$1" value "$2"', True) +// will return: def 'BLOCK' value 'test1' +// ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*', +// 'BLOCK( test1)', 'def "$1" value "$2"') +// will return: def "$1" value "$2" + +function QuoteRegExprMetaChars (const AStr : RegExprString) : RegExprString; +// Replace all metachars with its safe representation, +// for example 'abc$cd.(' converts into 'abc\$cd\.\(' +// This function usefull for r.e. autogeneration from +// user input + +function RegExprSubExpressions (const ARegExpr : string; + ASubExprs : TStrings; AExtendedSyntax : boolean{$IFDEF DefParam}= False{$ENDIF}) : integer; +// Makes list of subexpressions found in ARegExpr r.e. +// In ASubExps every item represent subexpression, +// from first to last, in format: +// String - subexpression text (without '()') +// low word of Object - starting position in ARegExpr, including '(' +// if exists! (first position is 1) +// high word of Object - length, including starting '(' and ending ')' +// if exist! +// AExtendedSyntax - must be True if modifier /m will be On while +// using the r.e. +// Usefull for GUI editors of r.e. etc (You can find example of using +// in TestRExp.dpr project) +// Returns +// 0 Success. No unbalanced brackets was found; +// -1 There are not enough closing brackets ')'; +// -(n+1) At position n was found opening '[' without //###0.942 +// corresponding closing ']'; +// n At position n was found closing bracket ')' without +// corresponding opening '('. +// If Result <> 0, then ASubExpr can contain empty items or illegal ones + + +implementation + +{$IFNDEF FPC} +uses + Windows; // CharUpper/Lower +{$ENDIF} + +const + TRegExprVersionMajor : integer = 0; + TRegExprVersionMinor : integer = 952; + // TRegExpr.VersionMajor/Minor return values of this constants + + MaskModI = 1; // modifier /i bit in fModifiers + MaskModR = 2; // -"- /r + MaskModS = 4; // -"- /s + MaskModG = 8; // -"- /g + MaskModM = 16; // -"- /m + MaskModX = 32; // -"- /x + + {$IFDEF UniCode} + XIgnoredChars = ' '#9#$d#$a; + {$ELSE} + XIgnoredChars = [' ', #9, #$d, #$a]; + {$ENDIF} + +{=============================================================} +{=================== WideString functions ====================} +{=============================================================} + +{$IFDEF UniCode} + +function StrPCopy (Dest: PRegExprChar; const Source: RegExprString): PRegExprChar; + var + i, Len : Integer; + begin + Len := length (Source); //###0.932 + for i := 1 to Len do + Dest [i - 1] := Source [i]; + Dest [Len] := #0; + Result := Dest; + end; { of function StrPCopy +--------------------------------------------------------------} + +function StrLCopy (Dest, Source: PRegExprChar; MaxLen: Cardinal): PRegExprChar; + var i: Integer; + begin + for i := 0 to MaxLen - 1 do + Dest [i] := Source [i]; + Result := Dest; + end; { of function StrLCopy +--------------------------------------------------------------} + +function StrLen (Str: PRegExprChar): Cardinal; + begin + Result:=0; + while Str [result] <> #0 + do Inc (Result); + end; { of function StrLen +--------------------------------------------------------------} + +function StrPos (Str1, Str2: PRegExprChar): PRegExprChar; + var n: Integer; + begin + Result := nil; + n := Pos (RegExprString (Str2), RegExprString (Str1)); + if n = 0 + then EXIT; + Result := Str1 + n - 1; + end; { of function StrPos +--------------------------------------------------------------} + +function StrLComp (Str1, Str2: PRegExprChar; MaxLen: Cardinal): Integer; + var S1, S2: RegExprString; + begin + S1 := Str1; + S2 := Str2; + if Copy (S1, 1, MaxLen) > Copy (S2, 1, MaxLen) + then Result := 1 + else + if Copy (S1, 1, MaxLen) < Copy (S2, 1, MaxLen) + then Result := -1 + else Result := 0; + end; { function StrLComp +--------------------------------------------------------------} + +function StrScan (Str: PRegExprChar; Chr: WideChar): PRegExprChar; + begin + Result := nil; + while (Str^ <> #0) and (Str^ <> Chr) + do Inc (Str); + if (Str^ <> #0) + then Result := Str; + end; { of function StrScan +--------------------------------------------------------------} + +{$ENDIF} + + +{=============================================================} +{===================== Global functions ======================} +{=============================================================} + +function ExecRegExpr (const ARegExpr, AInputStr : RegExprString) : boolean; + var r : TRegExpr; + begin + r := TRegExpr.Create; + try + r.Expression := ARegExpr; + Result := r.Exec (AInputStr); + finally r.Free; + end; + end; { of function ExecRegExpr +--------------------------------------------------------------} + +procedure SplitRegExpr (const ARegExpr, AInputStr : RegExprString; APieces : TStrings); + var r : TRegExpr; + begin + APieces.Clear; + r := TRegExpr.Create; + try + r.Expression := ARegExpr; + r.Split (AInputStr, APieces); + finally r.Free; + end; + end; { of procedure SplitRegExpr +--------------------------------------------------------------} + +function ReplaceRegExpr (const ARegExpr, AInputStr, AReplaceStr : RegExprString; + AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) : RegExprString; + begin + with TRegExpr.Create do try + Expression := ARegExpr; + Result := Replace (AInputStr, AReplaceStr, AUseSubstitution); + finally Free; + end; + end; { of function ReplaceRegExpr +--------------------------------------------------------------} + +function QuoteRegExprMetaChars (const AStr : RegExprString) : RegExprString; + const + RegExprMetaSet : RegExprString = '^$.[()|?+*'+EscChar+'{' + + ']}'; // - this last are additional to META. + // Very similar to META array, but slighly changed. + // !Any changes in META array must be synchronized with this set. + var + i, i0, Len : integer; + begin + Result := ''; + Len := length (AStr); + i := 1; + i0 := i; + while i <= Len do begin + if Pos (AStr [i], RegExprMetaSet) > 0 then begin + Result := Result + System.Copy (AStr, i0, i - i0) + + EscChar + AStr [i]; + i0 := i + 1; + end; + inc (i); + end; + Result := Result + System.Copy (AStr, i0, MaxInt); // Tail + end; { of function QuoteRegExprMetaChars +--------------------------------------------------------------} + +function RegExprSubExpressions (const ARegExpr : string; + ASubExprs : TStrings; AExtendedSyntax : boolean{$IFDEF DefParam}= False{$ENDIF}) : integer; + type + TStackItemRec = record //###0.945 + SubExprIdx : integer; + StartPos : integer; + end; + TStackArray = packed array [0 .. NSUBEXPMAX - 1] of TStackItemRec; + var + Len, SubExprLen : integer; + i, i0 : integer; + Modif : integer; + Stack : ^TStackArray; //###0.945 + StackIdx, StackSz : integer; + begin + Result := 0; // no unbalanced brackets found at this very moment + + ASubExprs.Clear; // I don't think that adding to non empty list + // can be usefull, so I simplified algorithm to work only with empty list + + Len := length (ARegExpr); // some optimization tricks + + // first we have to calculate number of subexpression to reserve + // space in Stack array (may be we'll reserve more then need, but + // it's faster then memory reallocation during parsing) + StackSz := 1; // add 1 for entire r.e. + for i := 1 to Len do + if ARegExpr [i] = '(' + then inc (StackSz); +// SetLength (Stack, StackSz); //###0.945 + GetMem (Stack, SizeOf (TStackItemRec) * StackSz); + try + + StackIdx := 0; + i := 1; + while (i <= Len) do begin + case ARegExpr [i] of + '(': begin + if (i < Len) and (ARegExpr [i + 1] = '?') then begin + // this is not subexpression, but comment or other + // Perl extension. We must check is it (?ismxrg-ismxrg) + // and change AExtendedSyntax if /x is changed. + inc (i, 2); // skip '(?' + i0 := i; + while (i <= Len) and (ARegExpr [i] <> ')') + do inc (i); + if i > Len + then Result := -1 // unbalansed '(' + else + if TRegExpr.ParseModifiersStr (System.Copy (ARegExpr, i, i - i0), Modif) + then AExtendedSyntax := (Modif and MaskModX) <> 0; + end + else begin // subexpression starts + ASubExprs.Add (''); // just reserve space + with Stack [StackIdx] do begin + SubExprIdx := ASubExprs.Count - 1; + StartPos := i; + end; + inc (StackIdx); + end; + end; + ')': begin + if StackIdx = 0 + then Result := i // unbalanced ')' + else begin + dec (StackIdx); + with Stack [StackIdx] do begin + SubExprLen := i - StartPos + 1; + ASubExprs.Objects [SubExprIdx] := + TObject (StartPos or (SubExprLen ShL 16)); + ASubExprs [SubExprIdx] := System.Copy ( + ARegExpr, StartPos + 1, SubExprLen - 2); // add without brackets + end; + end; + end; + EscChar: inc (i); // skip quoted symbol + '[': begin + // we have to skip character ranges at once, because they can + // contain '#', and '#' in it must NOT be recognized as eXtended + // comment beginning! + i0 := i; + inc (i); + if ARegExpr [i] = ']' // cannot be 'emty' ranges - this interpretes + then inc (i); // as ']' by itself + while (i <= Len) and (ARegExpr [i] <> ']') do + if ARegExpr [i] = EscChar //###0.942 + then inc (i, 2) // skip 'escaped' char to prevent stopping at '\]' + else inc (i); + if (i > Len) or (ARegExpr [i] <> ']') //###0.942 + then Result := - (i0 + 1); // unbalansed '[' //###0.942 + end; + '#': if AExtendedSyntax then begin + // skip eXtended comments + while (i <= Len) and (ARegExpr [i] <> #$d) and (ARegExpr [i] <> #$a) + // do not use [#$d, #$a] due to UniCode compatibility + do inc (i); + while (i + 1 <= Len) and ((ARegExpr [i + 1] = #$d) or (ARegExpr [i + 1] = #$a)) + do inc (i); // attempt to work with different kinds of line separators + // now we are at the line separator that must be skipped. + end; + // here is no 'else' clause - we simply skip ordinary chars + end; // of case + inc (i); // skip scanned char + // ! can move after Len due to skipping quoted symbol + end; + + // check brackets balance + if StackIdx <> 0 + then Result := -1; // unbalansed '(' + + // check if entire r.e. added + if (ASubExprs.Count = 0) + or ((integer (ASubExprs.Objects [0]) and $FFFF) <> 1) + or (((integer (ASubExprs.Objects [0]) ShR 16) and $FFFF) <> Len) + // whole r.e. wasn't added because it isn't bracketed + // well, we add it now: + then ASubExprs.InsertObject (0, ARegExpr, TObject ((Len ShL 16) or 1)); + + finally FreeMem (Stack); + end; + end; { of function RegExprSubExpressions +--------------------------------------------------------------} + + + +const + MAGIC = TREOp (216);// programm signature + +// name opcode opnd? meaning + EEND = TREOp (0); // - End of program + BOL = TREOp (1); // - Match "" at beginning of line + EOL = TREOp (2); // - Match "" at end of line + ANY = TREOp (3); // - Match any one character + ANYOF = TREOp (4); // Str Match any character in string Str + ANYBUT = TREOp (5); // Str Match any char. not in string Str + BRANCH = TREOp (6); // Node Match this alternative, or the next + BACK = TREOp (7); // - Jump backward (Next < 0) + EXACTLY = TREOp (8); // Str Match string Str + NOTHING = TREOp (9); // - Match empty string + STAR = TREOp (10); // Node Match this (simple) thing 0 or more times + PLUS = TREOp (11); // Node Match this (simple) thing 1 or more times + ANYDIGIT = TREOp (12); // - Match any digit (equiv [0-9]) + NOTDIGIT = TREOp (13); // - Match not digit (equiv [0-9]) + ANYLETTER = TREOp (14); // - Match any letter from property WordChars + NOTLETTER = TREOp (15); // - Match not letter from property WordChars + ANYSPACE = TREOp (16); // - Match any space char (see property SpaceChars) + NOTSPACE = TREOp (17); // - Match not space char (see property SpaceChars) + BRACES = TREOp (18); // Node,Min,Max Match this (simple) thing from Min to Max times. + // Min and Max are TREBracesArg + COMMENT = TREOp (19); // - Comment ;) + EXACTLYCI = TREOp (20); // Str Match string Str case insensitive + ANYOFCI = TREOp (21); // Str Match any character in string Str, case insensitive + ANYBUTCI = TREOp (22); // Str Match any char. not in string Str, case insensitive + LOOPENTRY = TREOp (23); // Node Start of loop (Node - LOOP for this loop) + LOOP = TREOp (24); // Node,Min,Max,LoopEntryJmp - back jump for LOOPENTRY. + // Min and Max are TREBracesArg + // Node - next node in sequence, + // LoopEntryJmp - associated LOOPENTRY node addr + ANYOFTINYSET= TREOp (25); // Chrs Match any one char from Chrs (exactly TinySetLen chars) + ANYBUTTINYSET=TREOp (26); // Chrs Match any one char not in Chrs (exactly TinySetLen chars) + ANYOFFULLSET= TREOp (27); // Set Match any one char from set of char + // - very fast (one CPU instruction !) but takes 32 bytes of p-code + BSUBEXP = TREOp (28); // Idx Match previously matched subexpression #Idx (stored as REChar) //###0.936 + BSUBEXPCI = TREOp (29); // Idx -"- in case-insensitive mode + + // Non-Greedy Style Ops //###0.940 + STARNG = TREOp (30); // Same as START but in non-greedy mode + PLUSNG = TREOp (31); // Same as PLUS but in non-greedy mode + BRACESNG = TREOp (32); // Same as BRACES but in non-greedy mode + LOOPNG = TREOp (33); // Same as LOOP but in non-greedy mode + + // Multiline mode \m + BOLML = TREOp (34); // - Match "" at beginning of line + EOLML = TREOp (35); // - Match "" at end of line + ANYML = TREOp (36); // - Match any one character + + // Word boundary + BOUND = TREOp (37); // Match "" between words //###0.943 + NOTBOUND = TREOp (38); // Match "" not between words //###0.943 + + // !!! Change OPEN value if you add new opcodes !!! + + OPEN = TREOp (39); // - Mark this point in input as start of \n + // OPEN + 1 is \1, etc. + CLOSE = TREOp (ord (OPEN) + NSUBEXP); + // - Analogous to OPEN. + + // !!! Don't add new OpCodes after CLOSE !!! + +// We work with p-code thru pointers, compatible with PRegExprChar. +// Note: all code components (TRENextOff, TREOp, TREBracesArg, etc) +// must have lengths that can be divided by SizeOf (REChar) ! +// A node is TREOp of opcode followed Next "pointer" of TRENextOff type. +// The Next is a offset from the opcode of the node containing it. +// An operand, if any, simply follows the node. (Note that much of +// the code generation knows about this implicit relationship!) +// Using TRENextOff=integer speed up p-code processing. + +// Opcodes description: +// +// BRANCH The set of branches constituting a single choice are hooked +// together with their "next" pointers, since precedence prevents +// anything being concatenated to any individual branch. The +// "next" pointer of the last BRANCH in a choice points to the +// thing following the whole choice. This is also where the +// final "next" pointer of each individual branch points; each +// branch starts with the operand node of a BRANCH node. +// BACK Normal "next" pointers all implicitly point forward; BACK +// exists to make loop structures possible. +// STAR,PLUS,BRACES '?', and complex '*' and '+', are implemented as +// circular BRANCH structures using BACK. Complex '{min,max}' +// - as pair LOOPENTRY-LOOP (see below). Simple cases (one +// character per match) are implemented with STAR, PLUS and +// BRACES for speed and to minimize recursive plunges. +// LOOPENTRY,LOOP {min,max} are implemented as special pair +// LOOPENTRY-LOOP. Each LOOPENTRY initialize loopstack for +// current level. +// OPEN,CLOSE are numbered at compile time. + + +{=============================================================} +{================== Error handling section ===================} +{=============================================================} + +const + reeOk = 0; + reeCompNullArgument = 100; + reeCompRegexpTooBig = 101; + reeCompParseRegTooManyBrackets = 102; + reeCompParseRegUnmatchedBrackets = 103; + reeCompParseRegUnmatchedBrackets2 = 104; + reeCompParseRegJunkOnEnd = 105; + reePlusStarOperandCouldBeEmpty = 106; + reeNestedSQP = 107; + reeBadHexDigit = 108; + reeInvalidRange = 109; + reeParseAtomTrailingBackSlash = 110; + reeNoHexCodeAfterBSlashX = 111; + reeHexCodeAfterBSlashXTooBig = 112; + reeUnmatchedSqBrackets = 113; + reeInternalUrp = 114; + reeQPSBFollowsNothing = 115; + reeTrailingBackSlash = 116; + reeRarseAtomInternalDisaster = 119; + reeBRACESArgTooBig = 122; + reeBracesMinParamGreaterMax = 124; + reeUnclosedComment = 125; + reeComplexBracesNotImplemented = 126; + reeUrecognizedModifier = 127; + reeBadLinePairedSeparator = 128; + reeRegRepeatCalledInappropriately = 1000; + reeMatchPrimMemoryCorruption = 1001; + reeMatchPrimCorruptedPointers = 1002; + reeNoExpression = 1003; + reeCorruptedProgram = 1004; + reeNoInpitStringSpecified = 1005; + reeOffsetMustBeGreaterThen0 = 1006; + reeExecNextWithoutExec = 1007; + reeGetInputStringWithoutInputString = 1008; + reeDumpCorruptedOpcode = 1011; + reeModifierUnsupported = 1013; + reeLoopStackExceeded = 1014; + reeLoopWithoutEntry = 1015; + reeBadPCodeImported = 2000; + +function TRegExpr.ErrorMsg (AErrorID : integer) : RegExprString; + begin + case AErrorID of + reeOk: Result := 'No errors'; + reeCompNullArgument: Result := 'TRegExpr(comp): Null Argument'; + reeCompRegexpTooBig: Result := 'TRegExpr(comp): Regexp Too Big'; + reeCompParseRegTooManyBrackets: Result := 'TRegExpr(comp): ParseReg Too Many ()'; + reeCompParseRegUnmatchedBrackets: Result := 'TRegExpr(comp): ParseReg Unmatched ()'; + reeCompParseRegUnmatchedBrackets2: Result := 'TRegExpr(comp): ParseReg Unmatched ()'; + reeCompParseRegJunkOnEnd: Result := 'TRegExpr(comp): ParseReg Junk On End'; + reePlusStarOperandCouldBeEmpty: Result := 'TRegExpr(comp): *+ Operand Could Be Empty'; + reeNestedSQP: Result := 'TRegExpr(comp): Nested *?+'; + reeBadHexDigit: Result := 'TRegExpr(comp): Bad Hex Digit'; + reeInvalidRange: Result := 'TRegExpr(comp): Invalid [] Range'; + reeParseAtomTrailingBackSlash: Result := 'TRegExpr(comp): Parse Atom Trailing \'; + reeNoHexCodeAfterBSlashX: Result := 'TRegExpr(comp): No Hex Code After \x'; + reeHexCodeAfterBSlashXTooBig: Result := 'TRegExpr(comp): Hex Code After \x Is Too Big'; + reeUnmatchedSqBrackets: Result := 'TRegExpr(comp): Unmatched []'; + reeInternalUrp: Result := 'TRegExpr(comp): Internal Urp'; + reeQPSBFollowsNothing: Result := 'TRegExpr(comp): ?+*{ Follows Nothing'; + reeTrailingBackSlash: Result := 'TRegExpr(comp): Trailing \'; + reeRarseAtomInternalDisaster: Result := 'TRegExpr(comp): RarseAtom Internal Disaster'; + reeBRACESArgTooBig: Result := 'TRegExpr(comp): BRACES Argument Too Big'; + reeBracesMinParamGreaterMax: Result := 'TRegExpr(comp): BRACE Min Param Greater then Max'; + reeUnclosedComment: Result := 'TRegExpr(comp): Unclosed (?#Comment)'; + reeComplexBracesNotImplemented: Result := 'TRegExpr(comp): If you want take part in beta-testing BRACES ''{min,max}'' and non-greedy ops ''*?'', ''+?'', ''??'' for complex cases - remove ''.'' from {.$DEFINE ComplexBraces}'; + reeUrecognizedModifier: Result := 'TRegExpr(comp): Urecognized Modifier'; + reeBadLinePairedSeparator: Result := 'TRegExpr(comp): LinePairedSeparator must countain two different chars or no chars at all'; + + reeRegRepeatCalledInappropriately: Result := 'TRegExpr(exec): RegRepeat Called Inappropriately'; + reeMatchPrimMemoryCorruption: Result := 'TRegExpr(exec): MatchPrim Memory Corruption'; + reeMatchPrimCorruptedPointers: Result := 'TRegExpr(exec): MatchPrim Corrupted Pointers'; + reeNoExpression: Result := 'TRegExpr(exec): Not Assigned Expression Property'; + reeCorruptedProgram: Result := 'TRegExpr(exec): Corrupted Program'; + reeNoInpitStringSpecified: Result := 'TRegExpr(exec): No Input String Specified'; + reeOffsetMustBeGreaterThen0: Result := 'TRegExpr(exec): Offset Must Be Greater Then 0'; + reeExecNextWithoutExec: Result := 'TRegExpr(exec): ExecNext Without Exec[Pos]'; + reeGetInputStringWithoutInputString: Result := 'TRegExpr(exec): GetInputString Without InputString'; + reeDumpCorruptedOpcode: Result := 'TRegExpr(dump): Corrupted Opcode'; + reeLoopStackExceeded: Result := 'TRegExpr(exec): Loop Stack Exceeded'; + reeLoopWithoutEntry: Result := 'TRegExpr(exec): Loop Without LoopEntry !'; + + reeBadPCodeImported: Result := 'TRegExpr(misc): Bad p-code imported'; + else Result := 'Unknown error'; + end; + end; { of procedure TRegExpr.Error +--------------------------------------------------------------} + +function TRegExpr.LastError : integer; + begin + Result := fLastError; + fLastError := reeOk; + end; { of function TRegExpr.LastError +--------------------------------------------------------------} + + +{=============================================================} +{===================== Common section ========================} +{=============================================================} + +class function TRegExpr.VersionMajor : integer; //###0.944 + begin + Result := TRegExprVersionMajor; + end; { of class function TRegExpr.VersionMajor +--------------------------------------------------------------} + +class function TRegExpr.VersionMinor : integer; //###0.944 + begin + Result := TRegExprVersionMinor; + end; { of class function TRegExpr.VersionMinor +--------------------------------------------------------------} + +constructor TRegExpr.Create; + begin + inherited; + programm := nil; + fExpression := nil; + fInputString := nil; + + regexpbeg := nil; + fExprIsCompiled := false; + + ModifierI := RegExprModifierI; + ModifierR := RegExprModifierR; + ModifierS := RegExprModifierS; + ModifierG := RegExprModifierG; + ModifierM := RegExprModifierM; //###0.940 + + SpaceChars := RegExprSpaceChars; //###0.927 + WordChars := RegExprWordChars; //###0.929 + fInvertCase := RegExprInvertCaseFunction; //###0.927 + + fLineSeparators := RegExprLineSeparators; //###0.941 + LinePairedSeparator := RegExprLinePairedSeparator; //###0.941 + end; { of constructor TRegExpr.Create +--------------------------------------------------------------} + +destructor TRegExpr.Destroy; + begin + if programm <> nil + then FreeMem (programm); + if fExpression <> nil + then FreeMem (fExpression); + if fInputString <> nil + then FreeMem (fInputString); + end; { of destructor TRegExpr.Destroy +--------------------------------------------------------------} + +class function TRegExpr.InvertCaseFunction (const Ch : REChar) : REChar; + begin + {$IFDEF UniCode} + if Ch >= #128 + then Result := Ch + else + {$ENDIF} + begin + Result := {$IFDEF FPC}AnsiUpperCase (Ch) [1]{$ELSE} REChar (CharUpper (PChar (Ch))){$ENDIF}; + if Result = Ch + then Result := {$IFDEF FPC}AnsiLowerCase (Ch) [1]{$ELSE} REChar (CharLower (PChar (Ch))){$ENDIF}; + end; + end; { of function TRegExpr.InvertCaseFunction +--------------------------------------------------------------} + +function TRegExpr.GetExpression : RegExprString; + begin + if fExpression <> nil + then Result := fExpression + else Result := ''; + end; { of function TRegExpr.GetExpression +--------------------------------------------------------------} + +procedure TRegExpr.SetExpression (const s : RegExprString); + var + Len : integer; //###0.950 + begin + if (s <> fExpression) or not fExprIsCompiled then begin + fExprIsCompiled := false; + if fExpression <> nil then begin + FreeMem (fExpression); + fExpression := nil; + end; + if s <> '' then begin + Len := length (s); //###0.950 + GetMem (fExpression, (Len + 1) * SizeOf (REChar)); +// StrPCopy (fExpression, s); //###0.950 replaced due to StrPCopy limitation of 255 chars + {$IFDEF UniCode} + StrPCopy (fExpression, Copy (s, 1, Len)); //###0.950 + {$ELSE} + StrLCopy (fExpression, PRegExprChar (s), Len); //###0.950 + {$ENDIF UniCode} + + InvalidateProgramm; //###0.941 + end; + end; + end; { of procedure TRegExpr.SetExpression +--------------------------------------------------------------} + +function TRegExpr.GetSubExprMatchCount : integer; + begin + if Assigned (fInputString) then begin + Result := NSUBEXP - 1; + while (Result > 0) and ((startp [Result] = nil) + or (endp [Result] = nil)) + do dec (Result); + end + else Result := -1; + end; { of function TRegExpr.GetSubExprMatchCount +--------------------------------------------------------------} + +function TRegExpr.GetMatchPos (Idx : integer) : integer; + begin + if (Idx >= 0) and (Idx < NSUBEXP) and Assigned (fInputString) + and Assigned (startp [Idx]) and Assigned (endp [Idx]) then begin + Result := (startp [Idx] - fInputString) + 1; + end + else Result := -1; + end; { of function TRegExpr.GetMatchPos +--------------------------------------------------------------} + +function TRegExpr.GetMatchLen (Idx : integer) : integer; + begin + if (Idx >= 0) and (Idx < NSUBEXP) and Assigned (fInputString) + and Assigned (startp [Idx]) and Assigned (endp [Idx]) then begin + Result := endp [Idx] - startp [Idx]; + end + else Result := -1; + end; { of function TRegExpr.GetMatchLen +--------------------------------------------------------------} + +function TRegExpr.GetMatch (Idx : integer) : RegExprString; + begin + if (Idx >= 0) and (Idx < NSUBEXP) and Assigned (fInputString) + and Assigned (startp [Idx]) and Assigned (endp [Idx]) + //then Result := copy (fInputString, MatchPos [Idx], MatchLen [Idx]) //###0.929 + then SetString (Result, startp [idx], endp [idx] - startp [idx]) + else Result := ''; + end; { of function TRegExpr.GetMatch +--------------------------------------------------------------} + +function TRegExpr.GetModifierStr : RegExprString; + begin + Result := '-'; + + if ModifierI + then Result := 'i' + Result + else Result := Result + 'i'; + if ModifierR + then Result := 'r' + Result + else Result := Result + 'r'; + if ModifierS + then Result := 's' + Result + else Result := Result + 's'; + if ModifierG + then Result := 'g' + Result + else Result := Result + 'g'; + if ModifierM + then Result := 'm' + Result + else Result := Result + 'm'; + if ModifierX + then Result := 'x' + Result + else Result := Result + 'x'; + + if Result [length (Result)] = '-' // remove '-' if all modifiers are 'On' + then System.Delete (Result, length (Result), 1); + end; { of function TRegExpr.GetModifierStr +--------------------------------------------------------------} + +class function TRegExpr.ParseModifiersStr (const AModifiers : RegExprString; +var AModifiersInt : integer) : boolean; +// !!! Be carefull - this is class function and must not use object instance fields + var + i : integer; + IsOn : boolean; + Mask : integer; + begin + Result := true; + IsOn := true; + Mask := 0; // prevent compiler warning + for i := 1 to length (AModifiers) do + if AModifiers [i] = '-' + then IsOn := false + else begin + if Pos (AModifiers [i], 'iI') > 0 + then Mask := MaskModI + else if Pos (AModifiers [i], 'rR') > 0 + then Mask := MaskModR + else if Pos (AModifiers [i], 'sS') > 0 + then Mask := MaskModS + else if Pos (AModifiers [i], 'gG') > 0 + then Mask := MaskModG + else if Pos (AModifiers [i], 'mM') > 0 + then Mask := MaskModM + else if Pos (AModifiers [i], 'xX') > 0 + then Mask := MaskModX + else begin + Result := false; + EXIT; + end; + if IsOn + then AModifiersInt := AModifiersInt or Mask + else AModifiersInt := AModifiersInt and not Mask; + end; + end; { of function TRegExpr.ParseModifiersStr +--------------------------------------------------------------} + +procedure TRegExpr.SetModifierStr (const AModifiers : RegExprString); + begin + if not ParseModifiersStr (AModifiers, fModifiers) + then Error (reeModifierUnsupported); + end; { of procedure TRegExpr.SetModifierStr +--------------------------------------------------------------} + +function TRegExpr.GetModifier (AIndex : integer) : boolean; + var + Mask : integer; + begin + Result := false; + case AIndex of + 1: Mask := MaskModI; + 2: Mask := MaskModR; + 3: Mask := MaskModS; + 4: Mask := MaskModG; + 5: Mask := MaskModM; + 6: Mask := MaskModX; + else begin + Error (reeModifierUnsupported); + EXIT; + end; + end; + Result := (fModifiers and Mask) <> 0; + end; { of function TRegExpr.GetModifier +--------------------------------------------------------------} + +procedure TRegExpr.SetModifier (AIndex : integer; ASet : boolean); + var + Mask : integer; + begin + case AIndex of + 1: Mask := MaskModI; + 2: Mask := MaskModR; + 3: Mask := MaskModS; + 4: Mask := MaskModG; + 5: Mask := MaskModM; + 6: Mask := MaskModX; + else begin + Error (reeModifierUnsupported); + EXIT; + end; + end; + if ASet + then fModifiers := fModifiers or Mask + else fModifiers := fModifiers and not Mask; + end; { of procedure TRegExpr.SetModifier +--------------------------------------------------------------} + + +{=============================================================} +{==================== Compiler section =======================} +{=============================================================} + +procedure TRegExpr.InvalidateProgramm; + begin + if programm <> nil then begin + FreeMem (programm); + programm := nil; + end; + end; { of procedure TRegExpr.InvalidateProgramm +--------------------------------------------------------------} + +procedure TRegExpr.Compile; //###0.941 + begin + if fExpression = nil then begin // No Expression assigned + Error (reeNoExpression); + EXIT; + end; + CompileRegExpr (fExpression); + end; { of procedure TRegExpr.Compile +--------------------------------------------------------------} + +function TRegExpr.IsProgrammOk : boolean; + {$IFNDEF UniCode} + var + i : integer; + {$ENDIF} + begin + Result := false; + + // check modifiers + if fModifiers <> fProgModifiers //###0.941 + then InvalidateProgramm; + + // can we optimize line separators by using sets? + {$IFNDEF UniCode} + fLineSeparatorsSet := []; + for i := 1 to length (fLineSeparators) + do System.Include (fLineSeparatorsSet, fLineSeparators [i]); + {$ENDIF} + + // [Re]compile if needed + if programm = nil + then Compile; //###0.941 + + // check [re]compiled programm + if programm = nil + then EXIT // error was set/raised by Compile (was reeExecAfterCompErr) + else if programm [0] <> MAGIC // Program corrupted. + then Error (reeCorruptedProgram) + else Result := true; + end; { of function TRegExpr.IsProgrammOk +--------------------------------------------------------------} + +procedure TRegExpr.Tail (p : PRegExprChar; val : PRegExprChar); +// set the next-pointer at the end of a node chain + var + scan : PRegExprChar; + temp : PRegExprChar; +// i : int64; + begin + if p = @regdummy + then EXIT; + // Find last node. + scan := p; + REPEAT + temp := regnext (scan); + if temp = nil + then BREAK; + scan := temp; + UNTIL false; + // Set Next 'pointer' + if val < scan + then PRENextOff (scan + REOpSz)^ := - (scan - val) //###0.948 + // work around PWideChar subtraction bug (Delphi uses + // shr after subtraction to calculate widechar distance %-( ) + // so, if difference is negative we have .. the "feature" :( + // I could wrap it in $IFDEF UniCode, but I didn't because + // "P – Q computes the difference between the address given + // by P (the higher address) and the address given by Q (the + // lower address)" - Delphi help quotation. + else PRENextOff (scan + REOpSz)^ := val - scan; //###0.933 + end; { of procedure TRegExpr.Tail +--------------------------------------------------------------} + +procedure TRegExpr.OpTail (p : PRegExprChar; val : PRegExprChar); +// regtail on operand of first argument; nop if operandless + begin + // "Operandless" and "op != BRANCH" are synonymous in practice. + if (p = nil) or (p = @regdummy) or (PREOp (p)^ <> BRANCH) + then EXIT; + Tail (p + REOpSz + RENextOffSz, val); //###0.933 + end; { of procedure TRegExpr.OpTail +--------------------------------------------------------------} + +function TRegExpr.EmitNode (op : TREOp) : PRegExprChar; //###0.933 +// emit a node, return location + begin + Result := regcode; + if Result <> @regdummy then begin + PREOp (regcode)^ := op; + inc (regcode, REOpSz); + PRENextOff (regcode)^ := 0; // Next "pointer" := nil + inc (regcode, RENextOffSz); + end + else inc (regsize, REOpSz + RENextOffSz); // compute code size without code generation + end; { of function TRegExpr.EmitNode +--------------------------------------------------------------} + +procedure TRegExpr.EmitC (b : REChar); +// emit a byte to code + begin + if regcode <> @regdummy then begin + regcode^ := b; + inc (regcode); + end + else inc (regsize); // Type of p-code pointer always is ^REChar + end; { of procedure TRegExpr.EmitC +--------------------------------------------------------------} + +procedure TRegExpr.InsertOperator (op : TREOp; opnd : PRegExprChar; sz : integer); +// insert an operator in front of already-emitted operand +// Means relocating the operand. + var + src, dst, place : PRegExprChar; + i : integer; + begin + if regcode = @regdummy then begin + inc (regsize, sz); + EXIT; + end; + src := regcode; + inc (regcode, sz); + dst := regcode; + while src > opnd do begin + dec (dst); + dec (src); + dst^ := src^; + end; + place := opnd; // Op node, where operand used to be. + PREOp (place)^ := op; + inc (place, REOpSz); + for i := 1 + REOpSz to sz do begin + place^ := #0; + inc (place); + end; + end; { of procedure TRegExpr.InsertOperator +--------------------------------------------------------------} + +function strcspn (s1 : PRegExprChar; s2 : PRegExprChar) : integer; +// find length of initial segment of s1 consisting +// entirely of characters not from s2 + var scan1, scan2 : PRegExprChar; + begin + Result := 0; + scan1 := s1; + while scan1^ <> #0 do begin + scan2 := s2; + while scan2^ <> #0 do + if scan1^ = scan2^ + then EXIT + else inc (scan2); + inc (Result); + inc (scan1) + end; + end; { of function strcspn +--------------------------------------------------------------} + +const +// Flags to be passed up and down. + HASWIDTH = 01; // Known never to match nil string. + SIMPLE = 02; // Simple enough to be STAR/PLUS/BRACES operand. + SPSTART = 04; // Starts with * or +. + WORST = 0; // Worst case. + META : array [0 .. 12] of REChar = ( + '^', '$', '.', '[', '(', ')', '|', '?', '+', '*', EscChar, '{', #0); + // Any modification must be synchronized with QuoteRegExprMetaChars !!! + +{$IFDEF UniCode} + RusRangeLo : array [0 .. 33] of REChar = + (#$430,#$431,#$432,#$433,#$434,#$435,#$451,#$436,#$437, + #$438,#$439,#$43A,#$43B,#$43C,#$43D,#$43E,#$43F, + #$440,#$441,#$442,#$443,#$444,#$445,#$446,#$447, + #$448,#$449,#$44A,#$44B,#$44C,#$44D,#$44E,#$44F,#0); + RusRangeHi : array [0 .. 33] of REChar = + (#$410,#$411,#$412,#$413,#$414,#$415,#$401,#$416,#$417, + #$418,#$419,#$41A,#$41B,#$41C,#$41D,#$41E,#$41F, + #$420,#$421,#$422,#$423,#$424,#$425,#$426,#$427, + #$428,#$429,#$42A,#$42B,#$42C,#$42D,#$42E,#$42F,#0); + RusRangeLoLow = #$430{'à'}; + RusRangeLoHigh = #$44F{'ÿ'}; + RusRangeHiLow = #$410{'À'}; + RusRangeHiHigh = #$42F{'ß'}; +{$ELSE} + RusRangeLo = 'àáâãäå¸æçèéêëìíîïðñòóôõö÷øùúûüýþÿ'; + RusRangeHi = 'ÀÁÂÃÄŨÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß'; + RusRangeLoLow = 'à'; + RusRangeLoHigh = 'ÿ'; + RusRangeHiLow = 'À'; + RusRangeHiHigh = 'ß'; +{$ENDIF} + +function TRegExpr.CompileRegExpr (exp : PRegExprChar) : boolean; +// compile a regular expression into internal code +// We can't allocate space until we know how big the compiled form will be, +// but we can't compile it (and thus know how big it is) until we've got a +// place to put the code. So we cheat: we compile it twice, once with code +// generation turned off and size counting turned on, and once "for real". +// This also means that we don't allocate space until we are sure that the +// thing really will compile successfully, and we never have to move the +// code and thus invalidate pointers into it. (Note that it has to be in +// one piece because free() must be able to free it all.) +// Beware that the optimization-preparation code in here knows about some +// of the structure of the compiled regexp. + var + scan, longest : PRegExprChar; + len : cardinal; + flags : integer; + begin + Result := false; // life too dark + + regparse := nil; // for correct error handling + regexpbeg := exp; + try + + if programm <> nil then begin + FreeMem (programm); + programm := nil; + end; + + if exp = nil then begin + Error (reeCompNullArgument); + EXIT; + end; + + fProgModifiers := fModifiers; + // well, may it's paranoia. I'll check it later... !!!!!!!! + + // First pass: determine size, legality. + fCompModifiers := fModifiers; + regparse := exp; + regnpar := 1; + regsize := 0; + regcode := @regdummy; + EmitC (MAGIC); + if ParseReg (0, flags) = nil + then EXIT; + + // Small enough for 2-bytes programm pointers ? + // ###0.933 no real p-code length limits now :))) +// if regsize >= 64 * 1024 then begin +// Error (reeCompRegexpTooBig); +// EXIT; +// end; + + // Allocate space. + GetMem (programm, regsize * SizeOf (REChar)); + + // Second pass: emit code. + fCompModifiers := fModifiers; + regparse := exp; + regnpar := 1; + regcode := programm; + EmitC (MAGIC); + if ParseReg (0, flags) = nil + then EXIT; + + // Dig out information for optimizations. + {$IFDEF UseFirstCharSet} //###0.929 + FirstCharSet := []; + FillFirstCharSet (programm + REOpSz); + {$ENDIF} + regstart := #0; // Worst-case defaults. + reganch := #0; + regmust := nil; + regmlen := 0; + scan := programm + REOpSz; // First BRANCH. + if PREOp (regnext (scan))^ = EEND then begin // Only one top-level choice. + scan := scan + REOpSz + RENextOffSz; + + // Starting-point info. + if PREOp (scan)^ = EXACTLY + then regstart := (scan + REOpSz + RENextOffSz)^ + else if PREOp (scan)^ = BOL + then inc (reganch); + + // If there's something expensive in the r.e., find the longest + // literal string that must appear and make it the regmust. Resolve + // ties in favor of later strings, since the regstart check works + // with the beginning of the r.e. and avoiding duplication + // strengthens checking. Not a strong reason, but sufficient in the + // absence of others. + if (flags and SPSTART) <> 0 then begin + longest := nil; + len := 0; + while scan <> nil do begin + if (PREOp (scan)^ = EXACTLY) + and (strlen (scan + REOpSz + RENextOffSz) >= len) then begin + longest := scan + REOpSz + RENextOffSz; + len := strlen (longest); + end; + scan := regnext (scan); + end; + regmust := longest; + regmlen := len; + end; + end; + + Result := true; + + finally begin + if not Result + then InvalidateProgramm; + regexpbeg := nil; + fExprIsCompiled := Result; //###0.944 + end; + end; + + end; { of function TRegExpr.CompileRegExpr +--------------------------------------------------------------} + +function TRegExpr.ParseReg (paren : integer; var flagp : integer) : PRegExprChar; +// regular expression, i.e. main body or parenthesized thing +// Caller must absorb opening parenthesis. +// Combining parenthesis handling with the base level of regular expression +// is a trifle forced, but the need to tie the tails of the branches to what +// follows makes it hard to avoid. + var + ret, br, ender : PRegExprChar; + parno : integer; + flags : integer; + SavedModifiers : integer; + begin + Result := nil; + flagp := HASWIDTH; // Tentatively. + parno := 0; // eliminate compiler stupid warning + SavedModifiers := fCompModifiers; + + // Make an OPEN node, if parenthesized. + if paren <> 0 then begin + if regnpar >= NSUBEXP then begin + Error (reeCompParseRegTooManyBrackets); + EXIT; + end; + parno := regnpar; + inc (regnpar); + ret := EmitNode (TREOp (ord (OPEN) + parno)); + end + else ret := nil; + + // Pick up the branches, linking them together. + br := ParseBranch (flags); + if br = nil then begin + Result := nil; + EXIT; + end; + if ret <> nil + then Tail (ret, br) // OPEN -> first. + else ret := br; + if (flags and HASWIDTH) = 0 + then flagp := flagp and not HASWIDTH; + flagp := flagp or flags and SPSTART; + while (regparse^ = '|') do begin + inc (regparse); + br := ParseBranch (flags); + if br = nil then begin + Result := nil; + EXIT; + end; + Tail (ret, br); // BRANCH -> BRANCH. + if (flags and HASWIDTH) = 0 + then flagp := flagp and not HASWIDTH; + flagp := flagp or flags and SPSTART; + end; + + // Make a closing node, and hook it on the end. + if paren <> 0 + then ender := EmitNode (TREOp (ord (CLOSE) + parno)) + else ender := EmitNode (EEND); + Tail (ret, ender); + + // Hook the tails of the branches to the closing node. + br := ret; + while br <> nil do begin + OpTail (br, ender); + br := regnext (br); + end; + + // Check for proper termination. + if paren <> 0 then + if regparse^ <> ')' then begin + Error (reeCompParseRegUnmatchedBrackets); + EXIT; + end + else inc (regparse); // skip trailing ')' + if (paren = 0) and (regparse^ <> #0) then begin + if regparse^ = ')' + then Error (reeCompParseRegUnmatchedBrackets2) + else Error (reeCompParseRegJunkOnEnd); + EXIT; + end; + fCompModifiers := SavedModifiers; // restore modifiers of parent + Result := ret; + end; { of function TRegExpr.ParseReg +--------------------------------------------------------------} + +function TRegExpr.ParseBranch (var flagp : integer) : PRegExprChar; +// one alternative of an | operator +// Implements the concatenation operator. + var + ret, chain, latest : PRegExprChar; + flags : integer; + begin + flagp := WORST; // Tentatively. + + ret := EmitNode (BRANCH); + chain := nil; + while (regparse^ <> #0) and (regparse^ <> '|') + and (regparse^ <> ')') do begin + latest := ParsePiece (flags); + if latest = nil then begin + Result := nil; + EXIT; + end; + flagp := flagp or flags and HASWIDTH; + if chain = nil // First piece. + then flagp := flagp or flags and SPSTART + else Tail (chain, latest); + chain := latest; + end; + if chain = nil // Loop ran zero times. + then EmitNode (NOTHING); + Result := ret; + end; { of function TRegExpr.ParseBranch +--------------------------------------------------------------} + +function TRegExpr.ParsePiece (var flagp : integer) : PRegExprChar; +// something followed by possible [*+?{] +// Note that the branching code sequences used for ? and the general cases +// of * and + and { are somewhat optimized: they use the same NOTHING node as +// both the endmarker for their branch list and the body of the last branch. +// It might seem that this node could be dispensed with entirely, but the +// endmarker role is not redundant. + function parsenum (AStart, AEnd : PRegExprChar) : TREBracesArg; + begin + Result := 0; + if AEnd - AStart + 1 > 8 then begin // prevent stupid scanning + Error (reeBRACESArgTooBig); + EXIT; + end; + while AStart <= AEnd do begin + Result := Result * 10 + (ord (AStart^) - ord ('0')); + inc (AStart); + end; + if (Result > MaxBracesArg) or (Result < 0) then begin + Error (reeBRACESArgTooBig); + EXIT; + end; + end; + + var + op : REChar; + NonGreedyOp, NonGreedyCh : boolean; //###0.940 + TheOp : TREOp; //###0.940 + NextNode : PRegExprChar; + flags : integer; + BracesMin, Bracesmax : TREBracesArg; + p, savedparse : PRegExprChar; + + procedure EmitComplexBraces (ABracesMin, ABracesMax : TREBracesArg; + ANonGreedyOp : boolean); //###0.940 + {$IFDEF ComplexBraces} + var + off : integer; + {$ENDIF} + begin + {$IFNDEF ComplexBraces} + Error (reeComplexBracesNotImplemented); + {$ELSE} + if ANonGreedyOp + then TheOp := LOOPNG + else TheOp := LOOP; + InsertOperator (LOOPENTRY, Result, REOpSz + RENextOffSz); + NextNode := EmitNode (TheOp); + if regcode <> @regdummy then begin + off := (Result + REOpSz + RENextOffSz) + - (regcode - REOpSz - RENextOffSz); // back to Atom after LOOPENTRY + PREBracesArg (regcode)^ := ABracesMin; + inc (regcode, REBracesArgSz); + PREBracesArg (regcode)^ := ABracesMax; + inc (regcode, REBracesArgSz); + PRENextOff (regcode)^ := off; + inc (regcode, RENextOffSz); + end + else inc (regsize, REBracesArgSz * 2 + RENextOffSz); + Tail (Result, NextNode); // LOOPENTRY -> LOOP + if regcode <> @regdummy then + Tail (Result + REOpSz + RENextOffSz, NextNode); // Atom -> LOOP + {$ENDIF} + end; + + procedure EmitSimpleBraces (ABracesMin, ABracesMax : TREBracesArg; + ANonGreedyOp : boolean); //###0.940 + begin + if ANonGreedyOp //###0.940 + then TheOp := BRACESNG + else TheOp := BRACES; + InsertOperator (TheOp, Result, REOpSz + RENextOffSz + REBracesArgSz * 2); + if regcode <> @regdummy then begin + PREBracesArg (Result + REOpSz + RENextOffSz)^ := ABracesMin; + PREBracesArg (Result + REOpSz + RENextOffSz + REBracesArgSz)^ := ABracesMax; + end; + end; + + begin + Result := ParseAtom (flags); + if Result = nil + then EXIT; + + op := regparse^; + if not ((op = '*') or (op = '+') or (op = '?') or (op = '{')) then begin + flagp := flags; + EXIT; + end; + if ((flags and HASWIDTH) = 0) and (op <> '?') then begin + Error (reePlusStarOperandCouldBeEmpty); + EXIT; + end; + + case op of + '*': begin + flagp := WORST or SPSTART; + NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 + NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 + if (flags and SIMPLE) = 0 then begin + if NonGreedyOp //###0.940 + then EmitComplexBraces (0, MaxBracesArg, NonGreedyOp) + else begin // Emit x* as (x&|), where & means "self". + InsertOperator (BRANCH, Result, REOpSz + RENextOffSz); // Either x + OpTail (Result, EmitNode (BACK)); // and loop + OpTail (Result, Result); // back + Tail (Result, EmitNode (BRANCH)); // or + Tail (Result, EmitNode (NOTHING)); // nil. + end + end + else begin // Simple + if NonGreedyOp //###0.940 + then TheOp := STARNG + else TheOp := STAR; + InsertOperator (TheOp, Result, REOpSz + RENextOffSz); + end; + if NonGreedyCh //###0.940 + then inc (regparse); // Skip extra char ('?') + end; { of case '*'} + '+': begin + flagp := WORST or SPSTART or HASWIDTH; + NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 + NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 + if (flags and SIMPLE) = 0 then begin + if NonGreedyOp //###0.940 + then EmitComplexBraces (1, MaxBracesArg, NonGreedyOp) + else begin // Emit x+ as x(&|), where & means "self". + NextNode := EmitNode (BRANCH); // Either + Tail (Result, NextNode); + Tail (EmitNode (BACK), Result); // loop back + Tail (NextNode, EmitNode (BRANCH)); // or + Tail (Result, EmitNode (NOTHING)); // nil. + end + end + else begin // Simple + if NonGreedyOp //###0.940 + then TheOp := PLUSNG + else TheOp := PLUS; + InsertOperator (TheOp, Result, REOpSz + RENextOffSz); + end; + if NonGreedyCh //###0.940 + then inc (regparse); // Skip extra char ('?') + end; { of case '+'} + '?': begin + flagp := WORST; + NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 + NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 + if NonGreedyOp then begin //###0.940 // We emit x?? as x{0,1}? + if (flags and SIMPLE) = 0 + then EmitComplexBraces (0, 1, NonGreedyOp) + else EmitSimpleBraces (0, 1, NonGreedyOp); + end + else begin // greedy '?' + InsertOperator (BRANCH, Result, REOpSz + RENextOffSz); // Either x + Tail (Result, EmitNode (BRANCH)); // or + NextNode := EmitNode (NOTHING); // nil. + Tail (Result, NextNode); + OpTail (Result, NextNode); + end; + if NonGreedyCh //###0.940 + then inc (regparse); // Skip extra char ('?') + end; { of case '?'} + '{': begin + savedparse := regparse; + // !!!!!!!!!!!! + // Filip Jirsak's note - what will happen, when we are at the end of regparse? + inc (regparse); + p := regparse; + while Pos (regparse^, '0123456789') > 0 // MUST appear + do inc (regparse); + if (regparse^ <> '}') and (regparse^ <> ',') or (p = regparse) then begin + regparse := savedparse; + flagp := flags; + EXIT; + end; + BracesMin := parsenum (p, regparse - 1); + if regparse^ = ',' then begin + inc (regparse); + p := regparse; + while Pos (regparse^, '0123456789') > 0 + do inc (regparse); + if regparse^ <> '}' then begin + regparse := savedparse; + EXIT; + end; + if p = regparse + then BracesMax := MaxBracesArg + else BracesMax := parsenum (p, regparse - 1); + end + else BracesMax := BracesMin; // {n} == {n,n} + if BracesMin > BracesMax then begin + Error (reeBracesMinParamGreaterMax); + EXIT; + end; + if BracesMin > 0 + then flagp := WORST; + if BracesMax > 0 + then flagp := flagp or HASWIDTH or SPSTART; + + NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 + NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 + if (flags and SIMPLE) <> 0 + then EmitSimpleBraces (BracesMin, BracesMax, NonGreedyOp) + else EmitComplexBraces (BracesMin, BracesMax, NonGreedyOp); + if NonGreedyCh //###0.940 + then inc (regparse); // Skip extra char '?' + end; { of case '{'} +// else // here we can't be + end; { of case op} + + inc (regparse); + if (regparse^ = '*') or (regparse^ = '+') or (regparse^ = '?') or (regparse^ = '{') then begin + Error (reeNestedSQP); + EXIT; + end; + end; { of function TRegExpr.ParsePiece +--------------------------------------------------------------} + +function TRegExpr.ParseAtom (var flagp : integer) : PRegExprChar; +// the lowest level +// Optimization: gobbles an entire sequence of ordinary characters so that +// it can turn them into a single node, which is smaller to store and +// faster to run. Backslashed characters are exceptions, each becoming a +// separate node; the code is simpler that way and it's not worth fixing. + var + ret : PRegExprChar; + flags : integer; + RangeBeg, RangeEnd : REChar; + CanBeRange : boolean; + len : integer; + ender : REChar; + begmodfs : PRegExprChar; + + {$IFDEF UseSetOfChar} //###0.930 + RangePCodeBeg : PRegExprChar; + RangePCodeIdx : integer; + RangeIsCI : boolean; + RangeSet : TSetOfREChar; + RangeLen : integer; + RangeChMin, RangeChMax : REChar; + {$ENDIF} + + procedure EmitExactly (ch : REChar); + begin + if (fCompModifiers and MaskModI) <> 0 + then ret := EmitNode (EXACTLYCI) + else ret := EmitNode (EXACTLY); + EmitC (ch); + EmitC (#0); + flagp := flagp or HASWIDTH or SIMPLE; + end; + + procedure EmitStr (const s : RegExprString); + var i : integer; + begin + for i := 1 to length (s) + do EmitC (s [i]); + end; + + function HexDig (ch : REChar) : integer; + begin + Result := 0; + if (ch >= 'a') and (ch <= 'f') + then ch := REChar (ord (ch) - (ord ('a') - ord ('A'))); + if (ch < '0') or (ch > 'F') or ((ch > '9') and (ch < 'A')) then begin + Error (reeBadHexDigit); + EXIT; + end; + Result := ord (ch) - ord ('0'); + if ch >= 'A' + then Result := Result - (ord ('A') - ord ('9') - 1); + end; + + function EmitRange (AOpCode : REChar) : PRegExprChar; + begin + {$IFDEF UseSetOfChar} + case AOpCode of + ANYBUTCI, ANYBUT: + Result := EmitNode (ANYBUTTINYSET); + else // ANYOFCI, ANYOF + Result := EmitNode (ANYOFTINYSET); + end; + case AOpCode of + ANYBUTCI, ANYOFCI: + RangeIsCI := True; + else // ANYBUT, ANYOF + RangeIsCI := False; + end; + RangePCodeBeg := regcode; + RangePCodeIdx := regsize; + RangeLen := 0; + RangeSet := []; + RangeChMin := #255; + RangeChMax := #0; + {$ELSE} + Result := EmitNode (AOpCode); + // ToDo: + // !!!!!!!!!!!!! Implement ANYOF[BUT]TINYSET generation for UniCode !!!!!!!!!! + {$ENDIF} + end; + +{$IFDEF UseSetOfChar} + procedure EmitRangeCPrim (b : REChar); //###0.930 + begin + if b in RangeSet + then EXIT; + inc (RangeLen); + if b < RangeChMin + then RangeChMin := b; + if b > RangeChMax + then RangeChMax := b; + Include (RangeSet, b); + end; + {$ENDIF} + + procedure EmitRangeC (b : REChar); + {$IFDEF UseSetOfChar} + var + Ch : REChar; + {$ENDIF} + begin + CanBeRange := false; + {$IFDEF UseSetOfChar} + if b <> #0 then begin + EmitRangeCPrim (b); //###0.930 + if RangeIsCI + then EmitRangeCPrim (InvertCase (b)); //###0.930 + end + else begin + {$IFDEF UseAsserts} + Assert (RangeLen > 0, 'TRegExpr.ParseAtom(subroutine EmitRangeC): empty range'); // impossible, but who knows.. + Assert (RangeChMin <= RangeChMax, 'TRegExpr.ParseAtom(subroutine EmitRangeC): RangeChMin > RangeChMax'); // impossible, but who knows.. + {$ENDIF} + if RangeLen <= TinySetLen then begin // emit "tiny set" + if regcode = @regdummy then begin + regsize := RangePCodeIdx + TinySetLen; // RangeChMin/Max !!! + EXIT; + end; + regcode := RangePCodeBeg; + for Ch := RangeChMin to RangeChMax do //###0.930 + if Ch in RangeSet then begin + regcode^ := Ch; + inc (regcode); + end; + // fill rest: + while regcode < RangePCodeBeg + TinySetLen do begin + regcode^ := RangeChMax; + inc (regcode); + end; + end + else begin + if regcode = @regdummy then begin + regsize := RangePCodeIdx + SizeOf (TSetOfREChar); + EXIT; + end; + if (RangePCodeBeg - REOpSz - RENextOffSz)^ = ANYBUTTINYSET + then RangeSet := [#0 .. #255] - RangeSet; + PREOp (RangePCodeBeg - REOpSz - RENextOffSz)^ := ANYOFFULLSET; + regcode := RangePCodeBeg; + Move (RangeSet, regcode^, SizeOf (TSetOfREChar)); + inc (regcode, SizeOf (TSetOfREChar)); + end; + end; + {$ELSE} + EmitC (b); + {$ENDIF} + end; + + procedure EmitSimpleRangeC (b : REChar); + begin + RangeBeg := b; + EmitRangeC (b); + CanBeRange := true; + end; + + procedure EmitRangeStr (const s : RegExprString); + var i : integer; + begin + for i := 1 to length (s) + do EmitRangeC (s [i]); + end; + + function UnQuoteChar (var APtr : PRegExprChar) : REChar; //###0.934 + begin + case APtr^ of + 't': Result := #$9; // tab (HT/TAB) + 'n': Result := #$a; // newline (NL) + 'r': Result := #$d; // car.return (CR) + 'f': Result := #$c; // form feed (FF) + 'a': Result := #$7; // alarm (bell) (BEL) + 'e': Result := #$1b; // escape (ESC) + 'x': begin // hex char + Result := #0; + inc (APtr); + if APtr^ = #0 then begin + Error (reeNoHexCodeAfterBSlashX); + EXIT; + end; + if APtr^ = '{' then begin // \x{nnnn} //###0.936 + REPEAT + inc (APtr); + if APtr^ = #0 then begin + Error (reeNoHexCodeAfterBSlashX); + EXIT; + end; + if APtr^ <> '}' then begin + if (Ord (Result) + ShR (SizeOf (REChar) * 8 - 4)) and $F <> 0 then begin + Error (reeHexCodeAfterBSlashXTooBig); + EXIT; + end; + Result := REChar ((Ord (Result) ShL 4) or HexDig (APtr^)); + // HexDig will cause Error if bad hex digit found + end + else BREAK; + UNTIL False; + end + else begin + Result := REChar (HexDig (APtr^)); + // HexDig will cause Error if bad hex digit found + inc (APtr); + if APtr^ = #0 then begin + Error (reeNoHexCodeAfterBSlashX); + EXIT; + end; + Result := REChar ((Ord (Result) ShL 4) or HexDig (APtr^)); + // HexDig will cause Error if bad hex digit found + end; + end; + else Result := APtr^; + end; + end; + + begin + Result := nil; + flagp := WORST; // Tentatively. + + inc (regparse); + case (regparse - 1)^ of + '^': if ((fCompModifiers and MaskModM) = 0) + or ((fLineSeparators = '') and not fLinePairedSeparatorAssigned) + then ret := EmitNode (BOL) + else ret := EmitNode (BOLML); + '$': if ((fCompModifiers and MaskModM) = 0) + or ((fLineSeparators = '') and not fLinePairedSeparatorAssigned) + then ret := EmitNode (EOL) + else ret := EmitNode (EOLML); + '.': + if (fCompModifiers and MaskModS) <> 0 then begin + ret := EmitNode (ANY); + flagp := flagp or HASWIDTH or SIMPLE; + end + else begin // not /s, so emit [^:LineSeparators:] + ret := EmitNode (ANYML); + flagp := flagp or HASWIDTH; // not so simple ;) +// ret := EmitRange (ANYBUT); +// EmitRangeStr (LineSeparators); //###0.941 +// EmitRangeStr (LinePairedSeparator); // !!! isn't correct if have to accept only paired +// EmitRangeC (#0); +// flagp := flagp or HASWIDTH or SIMPLE; + end; + '[': begin + if regparse^ = '^' then begin // Complement of range. + if (fCompModifiers and MaskModI) <> 0 + then ret := EmitRange (ANYBUTCI) + else ret := EmitRange (ANYBUT); + inc (regparse); + end + else + if (fCompModifiers and MaskModI) <> 0 + then ret := EmitRange (ANYOFCI) + else ret := EmitRange (ANYOF); + + CanBeRange := false; + + if (regparse^ = ']') then begin + EmitSimpleRangeC (regparse^); // []-a] -> ']' .. 'a' + inc (regparse); + end; + + while (regparse^ <> #0) and (regparse^ <> ']') do begin + if (regparse^ = '-') + and ((regparse + 1)^ <> #0) and ((regparse + 1)^ <> ']') + and CanBeRange then begin + inc (regparse); + RangeEnd := regparse^; + if RangeEnd = EscChar then begin + {$IFDEF UniCode} //###0.935 + if (ord ((regparse + 1)^) < 256) + and (char ((regparse + 1)^) + in ['d', 'D', 's', 'S', 'w', 'W']) then begin + {$ELSE} + if (regparse + 1)^ in ['d', 'D', 's', 'S', 'w', 'W'] then begin + {$ENDIF} + EmitRangeC ('-'); // or treat as error ?!! + CONTINUE; + end; + inc (regparse); + RangeEnd := UnQuoteChar (regparse); + end; + + // r.e.ranges extension for russian + if ((fCompModifiers and MaskModR) <> 0) + and (RangeBeg = RusRangeLoLow) and (RangeEnd = RusRangeLoHigh) then begin + EmitRangeStr (RusRangeLo); + end + else if ((fCompModifiers and MaskModR) <> 0) + and (RangeBeg = RusRangeHiLow) and (RangeEnd = RusRangeHiHigh) then begin + EmitRangeStr (RusRangeHi); + end + else if ((fCompModifiers and MaskModR) <> 0) + and (RangeBeg = RusRangeLoLow) and (RangeEnd = RusRangeHiHigh) then begin + EmitRangeStr (RusRangeLo); + EmitRangeStr (RusRangeHi); + end + else begin // standard r.e. handling + if RangeBeg > RangeEnd then begin + Error (reeInvalidRange); + EXIT; + end; + inc (RangeBeg); + EmitRangeC (RangeEnd); // prevent infinite loop if RangeEnd=$ff + while RangeBeg < RangeEnd do begin //###0.929 + EmitRangeC (RangeBeg); + inc (RangeBeg); + end; + end; + inc (regparse); + end + else begin + if regparse^ = EscChar then begin + inc (regparse); + if regparse^ = #0 then begin + Error (reeParseAtomTrailingBackSlash); + EXIT; + end; + case regparse^ of // r.e.extensions + 'd': EmitRangeStr ('0123456789'); + 'w': EmitRangeStr (WordChars); + 's': EmitRangeStr (SpaceChars); + else EmitSimpleRangeC (UnQuoteChar (regparse)); + end; { of case} + end + else EmitSimpleRangeC (regparse^); + inc (regparse); + end; + end; { of while} + EmitRangeC (#0); + if regparse^ <> ']' then begin + Error (reeUnmatchedSqBrackets); + EXIT; + end; + inc (regparse); + flagp := flagp or HASWIDTH or SIMPLE; + end; + '(': begin + if regparse^ = '?' then begin + // check for extended Perl syntax : (?..) + if (regparse + 1)^ = '#' then begin // (?#comment) + inc (regparse, 2); // find closing ')' + while (regparse^ <> #0) and (regparse^ <> ')') + do inc (regparse); + if regparse^ <> ')' then begin + Error (reeUnclosedComment); + EXIT; + end; + inc (regparse); // skip ')' + ret := EmitNode (COMMENT); // comment + end + else begin // modifiers ? + inc (regparse); // skip '?' + begmodfs := regparse; + while (regparse^ <> #0) and (regparse^ <> ')') + do inc (regparse); + if (regparse^ <> ')') + or not ParseModifiersStr (copy (begmodfs, 1, (regparse - begmodfs)), fCompModifiers) then begin + Error (reeUrecognizedModifier); + EXIT; + end; + inc (regparse); // skip ')' + ret := EmitNode (COMMENT); // comment +// Error (reeQPSBFollowsNothing); +// EXIT; + end; + end + else begin + ret := ParseReg (1, flags); + if ret = nil then begin + Result := nil; + EXIT; + end; + flagp := flagp or flags and (HASWIDTH or SPSTART); + end; + end; + #0, '|', ')': begin // Supposed to be caught earlier. + Error (reeInternalUrp); + EXIT; + end; + '?', '+', '*': begin + Error (reeQPSBFollowsNothing); + EXIT; + end; + EscChar: begin + if regparse^ = #0 then begin + Error (reeTrailingBackSlash); + EXIT; + end; + case regparse^ of // r.e.extensions + 'b': ret := EmitNode (BOUND); //###0.943 + 'B': ret := EmitNode (NOTBOUND); //###0.943 + 'A': ret := EmitNode (BOL); //###0.941 + 'Z': ret := EmitNode (EOL); //###0.941 + 'd': begin // r.e.extension - any digit ('0' .. '9') + ret := EmitNode (ANYDIGIT); + flagp := flagp or HASWIDTH or SIMPLE; + end; + 'D': begin // r.e.extension - not digit ('0' .. '9') + ret := EmitNode (NOTDIGIT); + flagp := flagp or HASWIDTH or SIMPLE; + end; + 's': begin // r.e.extension - any space char + {$IFDEF UseSetOfChar} + ret := EmitRange (ANYOF); + EmitRangeStr (SpaceChars); + EmitRangeC (#0); + {$ELSE} + ret := EmitNode (ANYSPACE); + {$ENDIF} + flagp := flagp or HASWIDTH or SIMPLE; + end; + 'S': begin // r.e.extension - not space char + {$IFDEF UseSetOfChar} + ret := EmitRange (ANYBUT); + EmitRangeStr (SpaceChars); + EmitRangeC (#0); + {$ELSE} + ret := EmitNode (NOTSPACE); + {$ENDIF} + flagp := flagp or HASWIDTH or SIMPLE; + end; + 'w': begin // r.e.extension - any english char / digit / '_' + {$IFDEF UseSetOfChar} + ret := EmitRange (ANYOF); + EmitRangeStr (WordChars); + EmitRangeC (#0); + {$ELSE} + ret := EmitNode (ANYLETTER); + {$ENDIF} + flagp := flagp or HASWIDTH or SIMPLE; + end; + 'W': begin // r.e.extension - not english char / digit / '_' + {$IFDEF UseSetOfChar} + ret := EmitRange (ANYBUT); + EmitRangeStr (WordChars); + EmitRangeC (#0); + {$ELSE} + ret := EmitNode (NOTLETTER); + {$ENDIF} + flagp := flagp or HASWIDTH or SIMPLE; + end; + '1' .. '9': begin //###0.936 + if (fCompModifiers and MaskModI) <> 0 + then ret := EmitNode (BSUBEXPCI) + else ret := EmitNode (BSUBEXP); + EmitC (REChar (ord (regparse^) - ord ('0'))); + flagp := flagp or HASWIDTH or SIMPLE; + end; + else EmitExactly (UnQuoteChar (regparse)); + end; { of case} + inc (regparse); + end; + else begin + dec (regparse); + if ((fCompModifiers and MaskModX) <> 0) and // check for eXtended syntax + ((regparse^ = '#') + or ({$IFDEF UniCode}StrScan (XIgnoredChars, regparse^) <> nil //###0.947 + {$ELSE}regparse^ in XIgnoredChars{$ENDIF})) then begin //###0.941 \x + if regparse^ = '#' then begin // Skip eXtended comment + // find comment terminator (group of \n and/or \r) + while (regparse^ <> #0) and (regparse^ <> #$d) and (regparse^ <> #$a) + do inc (regparse); + while (regparse^ = #$d) or (regparse^ = #$a) // skip comment terminator + do inc (regparse); // attempt to support different type of line separators + end + else begin // Skip the blanks! + while {$IFDEF UniCode}StrScan (XIgnoredChars, regparse^) <> nil //###0.947 + {$ELSE}regparse^ in XIgnoredChars{$ENDIF} + do inc (regparse); + end; + ret := EmitNode (COMMENT); // comment + end + else begin + len := strcspn (regparse, META); + if len <= 0 then + if regparse^ <> '{' then begin + Error (reeRarseAtomInternalDisaster); + EXIT; + end + else len := strcspn (regparse + 1, META) + 1; // bad {n,m} - compile as EXATLY + ender := (regparse + len)^; + if (len > 1) + and ((ender = '*') or (ender = '+') or (ender = '?') or (ender = '{')) + then dec (len); // Back off clear of ?+*{ operand. + flagp := flagp or HASWIDTH; + if len = 1 + then flagp := flagp or SIMPLE; + if (fCompModifiers and MaskModI) <> 0 + then ret := EmitNode (EXACTLYCI) + else ret := EmitNode (EXACTLY); + while (len > 0) + and (((fCompModifiers and MaskModX) = 0) or (regparse^ <> '#')) do begin + if ((fCompModifiers and MaskModX) = 0) or not ( //###0.941 + {$IFDEF UniCode}StrScan (XIgnoredChars, regparse^) <> nil //###0.947 + {$ELSE}regparse^ in XIgnoredChars{$ENDIF} ) + then EmitC (regparse^); + inc (regparse); + dec (len); + end; + EmitC (#0); + end; { of if not comment} + end; { of case else} + end; { of case} + + Result := ret; + end; { of function TRegExpr.ParseAtom +--------------------------------------------------------------} + +function TRegExpr.GetCompilerErrorPos : integer; + begin + Result := 0; + if (regexpbeg = nil) or (regparse = nil) + then EXIT; // not in compiling mode ? + Result := regparse - regexpbeg; + end; { of function TRegExpr.GetCompilerErrorPos +--------------------------------------------------------------} + + +{=============================================================} +{===================== Matching section ======================} +{=============================================================} + +{$IFNDEF UseSetOfChar} +function TRegExpr.StrScanCI (s : PRegExprChar; ch : REChar) : PRegExprChar; //###0.928 - now method of TRegExpr + begin + while (s^ <> #0) and (s^ <> ch) and (s^ <> InvertCase (ch)) + do inc (s); + if s^ <> #0 + then Result := s + else Result := nil; + end; { of function TRegExpr.StrScanCI +--------------------------------------------------------------} +{$ENDIF} + +function TRegExpr.regrepeat (p : PRegExprChar; AMax : integer) : integer; +// repeatedly match something simple, report how many + var + scan : PRegExprChar; + opnd : PRegExprChar; + TheMax : integer; + {Ch,} InvCh : REChar; //###0.931 + sestart, seend : PRegExprChar; //###0.936 + begin + Result := 0; + scan := reginput; + opnd := p + REOpSz + RENextOffSz; //OPERAND + TheMax := fInputEnd - scan; + if TheMax > AMax + then TheMax := AMax; + case PREOp (p)^ of + ANY: begin + // note - ANYML cannot be proceeded in regrepeat because can skip + // more than one char at once + Result := TheMax; + inc (scan, Result); + end; + EXACTLY: begin // in opnd can be only ONE char !!! +// Ch := opnd^; // store in register //###0.931 + while (Result < TheMax) and (opnd^ = scan^) do begin + inc (Result); + inc (scan); + end; + end; + EXACTLYCI: begin // in opnd can be only ONE char !!! +// Ch := opnd^; // store in register //###0.931 + while (Result < TheMax) and (opnd^ = scan^) do begin // prevent unneeded InvertCase //###0.931 + inc (Result); + inc (scan); + end; + if Result < TheMax then begin //###0.931 + InvCh := InvertCase (opnd^); // store in register + while (Result < TheMax) and + ((opnd^ = scan^) or (InvCh = scan^)) do begin + inc (Result); + inc (scan); + end; + end; + end; + BSUBEXP: begin //###0.936 + sestart := startp [ord (opnd^)]; + if sestart = nil + then EXIT; + seend := endp [ord (opnd^)]; + if seend = nil + then EXIT; + REPEAT + opnd := sestart; + while opnd < seend do begin + if (scan >= fInputEnd) or (scan^ <> opnd^) + then EXIT; + inc (scan); + inc (opnd); + end; + inc (Result); + reginput := scan; + UNTIL Result >= AMax; + end; + BSUBEXPCI: begin //###0.936 + sestart := startp [ord (opnd^)]; + if sestart = nil + then EXIT; + seend := endp [ord (opnd^)]; + if seend = nil + then EXIT; + REPEAT + opnd := sestart; + while opnd < seend do begin + if (scan >= fInputEnd) or + ((scan^ <> opnd^) and (scan^ <> InvertCase (opnd^))) + then EXIT; + inc (scan); + inc (opnd); + end; + inc (Result); + reginput := scan; + UNTIL Result >= AMax; + end; + ANYDIGIT: + while (Result < TheMax) and + (scan^ >= '0') and (scan^ <= '9') do begin + inc (Result); + inc (scan); + end; + NOTDIGIT: + while (Result < TheMax) and + ((scan^ < '0') or (scan^ > '9')) do begin + inc (Result); + inc (scan); + end; + {$IFNDEF UseSetOfChar} //###0.929 + ANYLETTER: + while (Result < TheMax) and + (Pos (scan^, fWordChars) > 0) //###0.940 + { ((scan^ >= 'a') and (scan^ <= 'z') !! I've forgotten (>='0') and (<='9') + or (scan^ >= 'A') and (scan^ <= 'Z') or (scan^ = '_'))} do begin + inc (Result); + inc (scan); + end; + NOTLETTER: + while (Result < TheMax) and + (Pos (scan^, fWordChars) <= 0) //###0.940 + { not ((scan^ >= 'a') and (scan^ <= 'z') !! I've forgotten (>='0') and (<='9') + or (scan^ >= 'A') and (scan^ <= 'Z') + or (scan^ = '_'))} do begin + inc (Result); + inc (scan); + end; + ANYSPACE: + while (Result < TheMax) and + (Pos (scan^, fSpaceChars) > 0) do begin + inc (Result); + inc (scan); + end; + NOTSPACE: + while (Result < TheMax) and + (Pos (scan^, fSpaceChars) <= 0) do begin + inc (Result); + inc (scan); + end; + {$ENDIF} + ANYOFTINYSET: begin + while (Result < TheMax) and //!!!TinySet + ((scan^ = opnd^) or (scan^ = (opnd + 1)^) + or (scan^ = (opnd + 2)^)) do begin + inc (Result); + inc (scan); + end; + end; + ANYBUTTINYSET: begin + while (Result < TheMax) and //!!!TinySet + (scan^ <> opnd^) and (scan^ <> (opnd + 1)^) + and (scan^ <> (opnd + 2)^) do begin + inc (Result); + inc (scan); + end; + end; + {$IFDEF UseSetOfChar} //###0.929 + ANYOFFULLSET: begin + while (Result < TheMax) and + (scan^ in PSetOfREChar (opnd)^) do begin + inc (Result); + inc (scan); + end; + end; + {$ELSE} + ANYOF: + while (Result < TheMax) and + (StrScan (opnd, scan^) <> nil) do begin + inc (Result); + inc (scan); + end; + ANYBUT: + while (Result < TheMax) and + (StrScan (opnd, scan^) = nil) do begin + inc (Result); + inc (scan); + end; + ANYOFCI: + while (Result < TheMax) and (StrScanCI (opnd, scan^) <> nil) do begin + inc (Result); + inc (scan); + end; + ANYBUTCI: + while (Result < TheMax) and (StrScanCI (opnd, scan^) = nil) do begin + inc (Result); + inc (scan); + end; + {$ENDIF} + else begin // Oh dear. Called inappropriately. + Result := 0; // Best compromise. + Error (reeRegRepeatCalledInappropriately); + EXIT; + end; + end; { of case} + reginput := scan; + end; { of function TRegExpr.regrepeat +--------------------------------------------------------------} + +function TRegExpr.regnext (p : PRegExprChar) : PRegExprChar; +// dig the "next" pointer out of a node + var offset : TRENextOff; + begin + if p = @regdummy then begin + Result := nil; + EXIT; + end; + offset := PRENextOff (p + REOpSz)^; //###0.933 inlined NEXT + if offset = 0 + then Result := nil + else Result := p + offset; + end; { of function TRegExpr.regnext +--------------------------------------------------------------} + +function TRegExpr.MatchPrim (prog : PRegExprChar) : boolean; +// recursively matching routine +// Conceptually the strategy is simple: check to see whether the current +// node matches, call self recursively to see whether the rest matches, +// and then act accordingly. In practice we make some effort to avoid +// recursion, in particular by going through "ordinary" nodes (that don't +// need to know whether the rest of the match failed) by a loop instead of +// by recursion. + var + scan : PRegExprChar; // Current node. + next : PRegExprChar; // Next node. + len : integer; + opnd : PRegExprChar; + no : integer; + save : PRegExprChar; + nextch : REChar; + BracesMin, BracesMax : integer; // we use integer instead of TREBracesArg for better support */+ + {$IFDEF ComplexBraces} + SavedLoopStack : array [1 .. LoopStackMax] of integer; // :(( very bad for recursion + SavedLoopStackIdx : integer; //###0.925 + {$ENDIF} + begin + Result := false; + scan := prog; + + while scan <> nil do begin + len := PRENextOff (scan + 1)^; //###0.932 inlined regnext + if len = 0 + then next := nil + else next := scan + len; + + case scan^ of + NOTBOUND, //###0.943 //!!! think about UseSetOfChar !!! + BOUND: + if (scan^ = BOUND) + xor ( + ((reginput = fInputStart) or (Pos ((reginput - 1)^, fWordChars) <= 0)) + and (reginput^ <> #0) and (Pos (reginput^, fWordChars) > 0) + or + (reginput <> fInputStart) and (Pos ((reginput - 1)^, fWordChars) > 0) + and ((reginput^ = #0) or (Pos (reginput^, fWordChars) <= 0))) + then EXIT; + + BOL: if reginput <> fInputStart + then EXIT; + EOL: if reginput^ <> #0 + then EXIT; + BOLML: if reginput > fInputStart then begin + nextch := (reginput - 1)^; + if (nextch <> fLinePairedSeparatorTail) + or ((reginput - 1) <= fInputStart) + or ((reginput - 2)^ <> fLinePairedSeparatorHead) + then begin + if (nextch = fLinePairedSeparatorHead) + and (reginput^ = fLinePairedSeparatorTail) + then EXIT; // don't stop between paired separator + if + {$IFNDEF UniCode} + not (nextch in fLineSeparatorsSet) + {$ELSE} + (pos (nextch, fLineSeparators) <= 0) + {$ENDIF} + then EXIT; + end; + end; + EOLML: if reginput^ <> #0 then begin + nextch := reginput^; + if (nextch <> fLinePairedSeparatorHead) + or ((reginput + 1)^ <> fLinePairedSeparatorTail) + then begin + if (nextch = fLinePairedSeparatorTail) + and (reginput > fInputStart) + and ((reginput - 1)^ = fLinePairedSeparatorHead) + then EXIT; // don't stop between paired separator + if + {$IFNDEF UniCode} + not (nextch in fLineSeparatorsSet) + {$ELSE} + (pos (nextch, fLineSeparators) <= 0) + {$ENDIF} + then EXIT; + end; + end; + ANY: begin + if reginput^ = #0 + then EXIT; + inc (reginput); + end; + ANYML: begin //###0.941 + if (reginput^ = #0) + or ((reginput^ = fLinePairedSeparatorHead) + and ((reginput + 1)^ = fLinePairedSeparatorTail)) + or {$IFNDEF UniCode} (reginput^ in fLineSeparatorsSet) + {$ELSE} (pos (reginput^, fLineSeparators) > 0) {$ENDIF} + then EXIT; + inc (reginput); + end; + ANYDIGIT: begin + if (reginput^ = #0) or (reginput^ < '0') or (reginput^ > '9') + then EXIT; + inc (reginput); + end; + NOTDIGIT: begin + if (reginput^ = #0) or ((reginput^ >= '0') and (reginput^ <= '9')) + then EXIT; + inc (reginput); + end; + {$IFNDEF UseSetOfChar} //###0.929 + ANYLETTER: begin + if (reginput^ = #0) or (Pos (reginput^, fWordChars) <= 0) //###0.943 + then EXIT; + inc (reginput); + end; + NOTLETTER: begin + if (reginput^ = #0) or (Pos (reginput^, fWordChars) > 0) //###0.943 + then EXIT; + inc (reginput); + end; + ANYSPACE: begin + if (reginput^ = #0) or not (Pos (reginput^, fSpaceChars) > 0) //###0.943 + then EXIT; + inc (reginput); + end; + NOTSPACE: begin + if (reginput^ = #0) or (Pos (reginput^, fSpaceChars) > 0) //###0.943 + then EXIT; + inc (reginput); + end; + {$ENDIF} + EXACTLYCI: begin + opnd := scan + REOpSz + RENextOffSz; // OPERAND + // Inline the first character, for speed. + if (opnd^ <> reginput^) + and (InvertCase (opnd^) <> reginput^) + then EXIT; + len := strlen (opnd); + //###0.929 begin + no := len; + save := reginput; + while no > 1 do begin + inc (save); + inc (opnd); + if (opnd^ <> save^) + and (InvertCase (opnd^) <> save^) + then EXIT; + dec (no); + end; + //###0.929 end + inc (reginput, len); + end; + EXACTLY: begin + opnd := scan + REOpSz + RENextOffSz; // OPERAND + // Inline the first character, for speed. + if opnd^ <> reginput^ + then EXIT; + len := strlen (opnd); + //###0.929 begin + no := len; + save := reginput; + while no > 1 do begin + inc (save); + inc (opnd); + if opnd^ <> save^ + then EXIT; + dec (no); + end; + //###0.929 end + inc (reginput, len); + end; + BSUBEXP: begin //###0.936 + no := ord ((scan + REOpSz + RENextOffSz)^); + if startp [no] = nil + then EXIT; + if endp [no] = nil + then EXIT; + save := reginput; + opnd := startp [no]; + while opnd < endp [no] do begin + if (save >= fInputEnd) or (save^ <> opnd^) + then EXIT; + inc (save); + inc (opnd); + end; + reginput := save; + end; + BSUBEXPCI: begin //###0.936 + no := ord ((scan + REOpSz + RENextOffSz)^); + if startp [no] = nil + then EXIT; + if endp [no] = nil + then EXIT; + save := reginput; + opnd := startp [no]; + while opnd < endp [no] do begin + if (save >= fInputEnd) or + ((save^ <> opnd^) and (save^ <> InvertCase (opnd^))) + then EXIT; + inc (save); + inc (opnd); + end; + reginput := save; + end; + ANYOFTINYSET: begin + if (reginput^ = #0) or //!!!TinySet + ((reginput^ <> (scan + REOpSz + RENextOffSz)^) + and (reginput^ <> (scan + REOpSz + RENextOffSz + 1)^) + and (reginput^ <> (scan + REOpSz + RENextOffSz + 2)^)) + then EXIT; + inc (reginput); + end; + ANYBUTTINYSET: begin + if (reginput^ = #0) or //!!!TinySet + (reginput^ = (scan + REOpSz + RENextOffSz)^) + or (reginput^ = (scan + REOpSz + RENextOffSz + 1)^) + or (reginput^ = (scan + REOpSz + RENextOffSz + 2)^) + then EXIT; + inc (reginput); + end; + {$IFDEF UseSetOfChar} //###0.929 + ANYOFFULLSET: begin + if (reginput^ = #0) + or not (reginput^ in PSetOfREChar (scan + REOpSz + RENextOffSz)^) + then EXIT; + inc (reginput); + end; + {$ELSE} + ANYOF: begin + if (reginput^ = #0) or (StrScan (scan + REOpSz + RENextOffSz, reginput^) = nil) + then EXIT; + inc (reginput); + end; + ANYBUT: begin + if (reginput^ = #0) or (StrScan (scan + REOpSz + RENextOffSz, reginput^) <> nil) + then EXIT; + inc (reginput); + end; + ANYOFCI: begin + if (reginput^ = #0) or (StrScanCI (scan + REOpSz + RENextOffSz, reginput^) = nil) + then EXIT; + inc (reginput); + end; + ANYBUTCI: begin + if (reginput^ = #0) or (StrScanCI (scan + REOpSz + RENextOffSz, reginput^) <> nil) + then EXIT; + inc (reginput); + end; + {$ENDIF} + NOTHING: ; + COMMENT: ; + BACK: ; + Succ (OPEN) .. TREOp (Ord (OPEN) + NSUBEXP - 1) : begin //###0.929 + no := ord (scan^) - ord (OPEN); +// save := reginput; + save := startp [no]; //###0.936 + startp [no] := reginput; //###0.936 + Result := MatchPrim (next); + if not Result //###0.936 + then startp [no] := save; +// if Result and (startp [no] = nil) +// then startp [no] := save; + // Don't set startp if some later invocation of the same + // parentheses already has. + EXIT; + end; + Succ (CLOSE) .. TREOp (Ord (CLOSE) + NSUBEXP - 1): begin //###0.929 + no := ord (scan^) - ord (CLOSE); +// save := reginput; + save := endp [no]; //###0.936 + endp [no] := reginput; //###0.936 + Result := MatchPrim (next); + if not Result //###0.936 + then endp [no] := save; +// if Result and (endp [no] = nil) +// then endp [no] := save; + // Don't set endp if some later invocation of the same + // parentheses already has. + EXIT; + end; + BRANCH: begin + if (next^ <> BRANCH) // No choice. + then next := scan + REOpSz + RENextOffSz // Avoid recursion + else begin + REPEAT + save := reginput; + Result := MatchPrim (scan + REOpSz + RENextOffSz); + if Result + then EXIT; + reginput := save; + scan := regnext (scan); + UNTIL (scan = nil) or (scan^ <> BRANCH); + EXIT; + end; + end; + {$IFDEF ComplexBraces} + LOOPENTRY: begin //###0.925 + no := LoopStackIdx; + inc (LoopStackIdx); + if LoopStackIdx > LoopStackMax then begin + Error (reeLoopStackExceeded); + EXIT; + end; + save := reginput; + LoopStack [LoopStackIdx] := 0; // init loop counter + Result := MatchPrim (next); // execute LOOP + LoopStackIdx := no; // cleanup + if Result + then EXIT; + reginput := save; + EXIT; + end; + LOOP, LOOPNG: begin //###0.940 + if LoopStackIdx <= 0 then begin + Error (reeLoopWithoutEntry); + EXIT; + end; + opnd := scan + PRENextOff (scan + REOpSz + RENextOffSz + 2 * REBracesArgSz)^; + BracesMin := PREBracesArg (scan + REOpSz + RENextOffSz)^; + BracesMax := PREBracesArg (scan + REOpSz + RENextOffSz + REBracesArgSz)^; + save := reginput; + if LoopStack [LoopStackIdx] >= BracesMin then begin // Min alredy matched - we can work + if scan^ = LOOP then begin + // greedy way - first try to max deep of greed ;) + if LoopStack [LoopStackIdx] < BracesMax then begin + inc (LoopStack [LoopStackIdx]); + no := LoopStackIdx; + Result := MatchPrim (opnd); + LoopStackIdx := no; + if Result + then EXIT; + reginput := save; + end; + dec (LoopStackIdx); // Fail. May be we are too greedy? ;) + Result := MatchPrim (next); + if not Result + then reginput := save; + EXIT; + end + else begin + // non-greedy - try just now + Result := MatchPrim (next); + if Result + then EXIT + else reginput := save; // failed - move next and try again + if LoopStack [LoopStackIdx] < BracesMax then begin + inc (LoopStack [LoopStackIdx]); + no := LoopStackIdx; + Result := MatchPrim (opnd); + LoopStackIdx := no; + if Result + then EXIT; + reginput := save; + end; + dec (LoopStackIdx); // Failed - back up + EXIT; + end + end + else begin // first match a min_cnt times + inc (LoopStack [LoopStackIdx]); + no := LoopStackIdx; + Result := MatchPrim (opnd); + LoopStackIdx := no; + if Result + then EXIT; + dec (LoopStack [LoopStackIdx]); + reginput := save; + EXIT; + end; + end; + {$ENDIF} + STAR, PLUS, BRACES, STARNG, PLUSNG, BRACESNG: begin + // Lookahead to avoid useless match attempts when we know + // what character comes next. + nextch := #0; + if next^ = EXACTLY + then nextch := (next + REOpSz + RENextOffSz)^; + BracesMax := MaxInt; // infinite loop for * and + //###0.92 + if (scan^ = STAR) or (scan^ = STARNG) + then BracesMin := 0 // STAR + else if (scan^ = PLUS) or (scan^ = PLUSNG) + then BracesMin := 1 // PLUS + else begin // BRACES + BracesMin := PREBracesArg (scan + REOpSz + RENextOffSz)^; + BracesMax := PREBracesArg (scan + REOpSz + RENextOffSz + REBracesArgSz)^; + end; + save := reginput; + opnd := scan + REOpSz + RENextOffSz; + if (scan^ = BRACES) or (scan^ = BRACESNG) + then inc (opnd, 2 * REBracesArgSz); + + if (scan^ = PLUSNG) or (scan^ = STARNG) or (scan^ = BRACESNG) then begin + // non-greedy mode + BracesMax := regrepeat (opnd, BracesMax); // don't repeat more than BracesMax + // Now we know real Max limit to move forward (for recursion 'back up') + // In some cases it can be faster to check only Min positions first, + // but after that we have to check every position separtely instead + // of fast scannig in loop. + no := BracesMin; + while no <= BracesMax do begin + reginput := save + no; + // If it could work, try it. + if (nextch = #0) or (reginput^ = nextch) then begin + {$IFDEF ComplexBraces} + System.Move (LoopStack, SavedLoopStack, SizeOf (LoopStack)); //###0.925 + SavedLoopStackIdx := LoopStackIdx; + {$ENDIF} + if MatchPrim (next) then begin + Result := true; + EXIT; + end; + {$IFDEF ComplexBraces} + System.Move (SavedLoopStack, LoopStack, SizeOf (LoopStack)); + LoopStackIdx := SavedLoopStackIdx; + {$ENDIF} + end; + inc (no); // Couldn't or didn't - move forward. + end; { of while} + EXIT; + end + else begin // greedy mode + no := regrepeat (opnd, BracesMax); // don't repeat more than max_cnt + while no >= BracesMin do begin + // If it could work, try it. + if (nextch = #0) or (reginput^ = nextch) then begin + {$IFDEF ComplexBraces} + System.Move (LoopStack, SavedLoopStack, SizeOf (LoopStack)); //###0.925 + SavedLoopStackIdx := LoopStackIdx; + {$ENDIF} + if MatchPrim (next) then begin + Result := true; + EXIT; + end; + {$IFDEF ComplexBraces} + System.Move (SavedLoopStack, LoopStack, SizeOf (LoopStack)); + LoopStackIdx := SavedLoopStackIdx; + {$ENDIF} + end; + dec (no); // Couldn't or didn't - back up. + reginput := save + no; + end; { of while} + EXIT; + end; + end; + EEND: begin + Result := true; // Success! + EXIT; + end; + else begin + Error (reeMatchPrimMemoryCorruption); + EXIT; + end; + end; { of case scan^} + scan := next; + end; { of while scan <> nil} + + // We get here only if there's trouble -- normally "case EEND" is the + // terminating point. + Error (reeMatchPrimCorruptedPointers); + end; { of function TRegExpr.MatchPrim +--------------------------------------------------------------} + +{$IFDEF UseFirstCharSet} //###0.929 +procedure TRegExpr.FillFirstCharSet (prog : PRegExprChar); + var + scan : PRegExprChar; // Current node. + next : PRegExprChar; // Next node. + opnd : PRegExprChar; + min_cnt : integer; + begin + scan := prog; + while scan <> nil do begin + next := regnext (scan); + case PREOp (scan)^ of + BSUBEXP, BSUBEXPCI: begin //###0.938 + FirstCharSet := [#0 .. #255]; // :((( we cannot + // optimize r.e. if it starts with back reference + EXIT; + end; + BOL, BOLML: ; // EXIT; //###0.937 + EOL, EOLML: begin //###0.948 was empty in 0.947, was EXIT in 0.937 + Include (FirstCharSet, #0); + if ModifierM + then begin + opnd := PRegExprChar (LineSeparators); + while opnd^ <> #0 do begin + Include (FirstCharSet, opnd^); + inc (opnd); + end; + end; + EXIT; + end; + BOUND, NOTBOUND: ; //###0.943 ?!! + ANY, ANYML: begin // we can better define ANYML !!! + FirstCharSet := [#0 .. #255]; //###0.930 + EXIT; + end; + ANYDIGIT: begin + FirstCharSet := FirstCharSet + ['0' .. '9']; + EXIT; + end; + NOTDIGIT: begin + FirstCharSet := FirstCharSet + ([#0 .. #255] - ['0' .. '9']); //###0.948 FirstCharSet was forgotten + EXIT; + end; + EXACTLYCI: begin + Include (FirstCharSet, (scan + REOpSz + RENextOffSz)^); + Include (FirstCharSet, InvertCase ((scan + REOpSz + RENextOffSz)^)); + EXIT; + end; + EXACTLY: begin + Include (FirstCharSet, (scan + REOpSz + RENextOffSz)^); + EXIT; + end; + ANYOFFULLSET: begin + FirstCharSet := FirstCharSet + PSetOfREChar (scan + REOpSz + RENextOffSz)^; + EXIT; + end; + ANYOFTINYSET: begin + //!!!TinySet + Include (FirstCharSet, (scan + REOpSz + RENextOffSz)^); + Include (FirstCharSet, (scan + REOpSz + RENextOffSz + 1)^); + Include (FirstCharSet, (scan + REOpSz + RENextOffSz + 2)^); + // ... // up to TinySetLen + EXIT; + end; + ANYBUTTINYSET: begin + //!!!TinySet + FirstCharSet := FirstCharSet + ([#0 .. #255] - [ //###0.948 FirstCharSet was forgotten + (scan + REOpSz + RENextOffSz)^, + (scan + REOpSz + RENextOffSz + 1)^, + (scan + REOpSz + RENextOffSz + 2)^]); + // ... // up to TinySetLen + EXIT; + end; + NOTHING: ; + COMMENT: ; + BACK: ; + Succ (OPEN) .. TREOp (Ord (OPEN) + NSUBEXP - 1) : begin //###0.929 + FillFirstCharSet (next); + EXIT; + end; + Succ (CLOSE) .. TREOp (Ord (CLOSE) + NSUBEXP - 1): begin //###0.929 + FillFirstCharSet (next); + EXIT; + end; + BRANCH: begin + if (PREOp (next)^ <> BRANCH) // No choice. + then next := scan + REOpSz + RENextOffSz // Avoid recursion. + else begin + REPEAT + FillFirstCharSet (scan + REOpSz + RENextOffSz); + scan := regnext (scan); + UNTIL (scan = nil) or (PREOp (scan)^ <> BRANCH); + EXIT; + end; + end; + {$IFDEF ComplexBraces} + LOOPENTRY: begin //###0.925 +// LoopStack [LoopStackIdx] := 0; //###0.940 line removed + FillFirstCharSet (next); // execute LOOP + EXIT; + end; + LOOP, LOOPNG: begin //###0.940 + opnd := scan + PRENextOff (scan + REOpSz + RENextOffSz + REBracesArgSz * 2)^; + min_cnt := PREBracesArg (scan + REOpSz + RENextOffSz)^; + FillFirstCharSet (opnd); + if min_cnt = 0 + then FillFirstCharSet (next); + EXIT; + end; + {$ENDIF} + STAR, STARNG: //###0.940 + FillFirstCharSet (scan + REOpSz + RENextOffSz); + PLUS, PLUSNG: begin //###0.940 + FillFirstCharSet (scan + REOpSz + RENextOffSz); + EXIT; + end; + BRACES, BRACESNG: begin //###0.940 + opnd := scan + REOpSz + RENextOffSz + REBracesArgSz * 2; + min_cnt := PREBracesArg (scan + REOpSz + RENextOffSz)^; // BRACES + FillFirstCharSet (opnd); + if min_cnt > 0 + then EXIT; + end; + EEND: begin + FirstCharSet := [#0 .. #255]; //###0.948 + EXIT; + end; + else begin + Error (reeMatchPrimMemoryCorruption); + EXIT; + end; + end; { of case scan^} + scan := next; + end; { of while scan <> nil} + end; { of procedure FillFirstCharSet +--------------------------------------------------------------} +{$ENDIF} + +function TRegExpr.Exec (const AInputString : RegExprString) : boolean; + begin + InputString := AInputString; + Result := ExecPrim (1); + end; { of function TRegExpr.Exec +--------------------------------------------------------------} + +{$IFDEF OverMeth} +{$IFNDEF FPC} +function TRegExpr.Exec : boolean; + begin + Result := ExecPrim (1); + end; { of function TRegExpr.Exec +--------------------------------------------------------------} +{$ENDIF} +function TRegExpr.Exec (AOffset: integer) : boolean; + begin + Result := ExecPrim (AOffset); + end; { of function TRegExpr.Exec +--------------------------------------------------------------} +{$ENDIF} + +function TRegExpr.ExecPos (AOffset: integer {$IFDEF DefParam}= 1{$ENDIF}) : boolean; + begin + Result := ExecPrim (AOffset); + end; { of function TRegExpr.ExecPos +--------------------------------------------------------------} + +function TRegExpr.ExecPrim (AOffset: integer) : boolean; + procedure ClearMatchs; + // Clears matchs array + var i : integer; + begin + for i := 0 to NSUBEXP - 1 do begin + startp [i] := nil; + endp [i] := nil; + end; + end; { of procedure ClearMatchs; +..............................................................} + function RegMatch (str : PRegExprChar) : boolean; + // try match at specific point + begin + //###0.949 removed clearing of start\endp + reginput := str; + Result := MatchPrim (programm + REOpSz); + if Result then begin + startp [0] := str; + endp [0] := reginput; + end; + end; { of function RegMatch +..............................................................} + var + s : PRegExprChar; + StartPtr: PRegExprChar; + InputLen : integer; + begin + Result := false; // Be paranoid... + + ClearMatchs; //###0.949 + // ensure that Match cleared either if optimization tricks or some error + // will lead to leaving ExecPrim without actual search. That is + // importent for ExecNext logic and so on. + + if not IsProgrammOk //###0.929 + then EXIT; + + // Check InputString presence + if not Assigned (fInputString) then begin + Error (reeNoInpitStringSpecified); + EXIT; + end; + + InputLen := length (fInputString); + + //Check that the start position is not negative + if AOffset < 1 then begin + Error (reeOffsetMustBeGreaterThen0); + EXIT; + end; + // Check that the start position is not longer than the line + // If so then exit with nothing found + if AOffset > (InputLen + 1) // for matching empty string after last char. + then EXIT; + + StartPtr := fInputString + AOffset - 1; + + // If there is a "must appear" string, look for it. + if regmust <> nil then begin + s := StartPtr; + REPEAT + s := StrScan (s, regmust [0]); + if s <> nil then begin + if StrLComp (s, regmust, regmlen) = 0 + then BREAK; // Found it. + inc (s); + end; + UNTIL s = nil; + if s = nil // Not present. + then EXIT; + end; + + // Mark beginning of line for ^ . + fInputStart := fInputString; + + // Pointer to end of input stream - for + // pascal-style string processing (may include #0) + fInputEnd := fInputString + InputLen; + + {$IFDEF ComplexBraces} + // no loops started + LoopStackIdx := 0; //###0.925 + {$ENDIF} + + // Simplest case: anchored match need be tried only once. + if reganch <> #0 then begin + Result := RegMatch (StartPtr); + EXIT; + end; + + // Messy cases: unanchored match. + s := StartPtr; + if regstart <> #0 then // We know what char it must start with. + REPEAT + s := StrScan (s, regstart); + if s <> nil then begin + Result := RegMatch (s); + if Result + then EXIT + else ClearMatchs; //###0.949 + inc (s); + end; + UNTIL s = nil + else begin // We don't - general case. + repeat //###0.948 + {$IFDEF UseFirstCharSet} + if s^ in FirstCharSet + then Result := RegMatch (s); + {$ELSE} + Result := RegMatch (s); + {$ENDIF} + if Result or (s^ = #0) // Exit on a match or after testing the end-of-string. + then EXIT + else ClearMatchs; //###0.949 + inc (s); + until false; +(* optimized and fixed by Martin Fuller - empty strings + were not allowed to pass thru in UseFirstCharSet mode + {$IFDEF UseFirstCharSet} //###0.929 + while s^ <> #0 do begin + if s^ in FirstCharSet + then Result := RegMatch (s); + if Result + then EXIT; + inc (s); + end; + {$ELSE} + REPEAT + Result := RegMatch (s); + if Result + then EXIT; + inc (s); + UNTIL s^ = #0; + {$ENDIF} +*) + end; + // Failure + end; { of function TRegExpr.ExecPrim +--------------------------------------------------------------} + +function TRegExpr.ExecNext : boolean; + var offset : integer; + begin + Result := false; + if not Assigned (startp[0]) or not Assigned (endp[0]) then begin + Error (reeExecNextWithoutExec); + EXIT; + end; +// Offset := MatchPos [0] + MatchLen [0]; +// if MatchLen [0] = 0 + Offset := endp [0] - fInputString + 1; //###0.929 + if endp [0] = startp [0] //###0.929 + then inc (Offset); // prevent infinite looping if empty string match r.e. + Result := ExecPrim (Offset); + end; { of function TRegExpr.ExecNext +--------------------------------------------------------------} + +function TRegExpr.GetInputString : RegExprString; + begin + if not Assigned (fInputString) then begin + Error (reeGetInputStringWithoutInputString); + EXIT; + end; + Result := fInputString; + end; { of function TRegExpr.GetInputString +--------------------------------------------------------------} + +procedure TRegExpr.SetInputString (const AInputString : RegExprString); + var + Len : integer; + i : integer; + begin + // clear Match* - before next Exec* call it's undefined + for i := 0 to NSUBEXP - 1 do begin + startp [i] := nil; + endp [i] := nil; + end; + + // need reallocation of input string buffer ? + Len := length (AInputString); + if Assigned (fInputString) and (Length (fInputString) <> Len) then begin + FreeMem (fInputString); + fInputString := nil; + end; + // buffer [re]allocation + if not Assigned (fInputString) + then GetMem (fInputString, (Len + 1) * SizeOf (REChar)); + + // copy input string into buffer + {$IFDEF UniCode} + StrPCopy (fInputString, Copy (AInputString, 1, Len)); //###0.927 + {$ELSE} + StrLCopy (fInputString, PRegExprChar (AInputString), Len); + {$ENDIF} + + { + fInputString : string; + fInputStart, fInputEnd : PRegExprChar; + + SetInputString: + fInputString := AInputString; + UniqueString (fInputString); + fInputStart := PChar (fInputString); + Len := length (fInputString); + fInputEnd := PRegExprChar (integer (fInputStart) + Len); ?? + !! startp/endp âñå ðàâíî áóäåò îïàñíî èñïîëüçîâàòü ? + } + end; { of procedure TRegExpr.SetInputString +--------------------------------------------------------------} + +procedure TRegExpr.SetLineSeparators (const AStr : RegExprString); + begin + if AStr <> fLineSeparators then begin + fLineSeparators := AStr; + InvalidateProgramm; + end; + end; { of procedure TRegExpr.SetLineSeparators +--------------------------------------------------------------} + +procedure TRegExpr.SetLinePairedSeparator (const AStr : RegExprString); + begin + if length (AStr) = 2 then begin + if AStr [1] = AStr [2] then begin + // it's impossible for our 'one-point' checking to support + // two chars separator for identical chars + Error (reeBadLinePairedSeparator); + EXIT; + end; + if not fLinePairedSeparatorAssigned + or (AStr [1] <> fLinePairedSeparatorHead) + or (AStr [2] <> fLinePairedSeparatorTail) then begin + fLinePairedSeparatorAssigned := true; + fLinePairedSeparatorHead := AStr [1]; + fLinePairedSeparatorTail := AStr [2]; + InvalidateProgramm; + end; + end + else if length (AStr) = 0 then begin + if fLinePairedSeparatorAssigned then begin + fLinePairedSeparatorAssigned := false; + InvalidateProgramm; + end; + end + else Error (reeBadLinePairedSeparator); + end; { of procedure TRegExpr.SetLinePairedSeparator +--------------------------------------------------------------} + +function TRegExpr.GetLinePairedSeparator : RegExprString; + begin + if fLinePairedSeparatorAssigned then begin + {$IFDEF UniCode} + // Here is some UniCode 'magic' + // If You do know better decision to concatenate + // two WideChars, please, let me know! + Result := fLinePairedSeparatorHead; //###0.947 + Result := Result + fLinePairedSeparatorTail; + {$ELSE} + Result := fLinePairedSeparatorHead + fLinePairedSeparatorTail; + {$ENDIF} + end + else Result := ''; + end; { of function TRegExpr.GetLinePairedSeparator +--------------------------------------------------------------} + +function TRegExpr.Substitute (const ATemplate : RegExprString) : RegExprString; +// perform substitutions after a regexp match +// completely rewritten in 0.929 + var + TemplateLen : integer; + TemplateBeg, TemplateEnd : PRegExprChar; + p, p0, ResultPtr : PRegExprChar; + ResultLen : integer; + n : integer; + Ch : REChar; + function ParseVarName (var APtr : PRegExprChar) : integer; + // extract name of variable (digits, may be enclosed with + // curly braces) from APtr^, uses TemplateEnd !!! + const + Digits = ['0' .. '9']; + var + p : PRegExprChar; + Delimited : boolean; + begin + Result := 0; + p := APtr; + Delimited := (p < TemplateEnd) and (p^ = '{'); + if Delimited + then inc (p); // skip left curly brace + if (p < TemplateEnd) and (p^ = '&') + then inc (p) // this is '$&' or '${&}' + else + while (p < TemplateEnd) and + {$IFDEF UniCode} //###0.935 + (ord (p^) < 256) and (char (p^) in Digits) + {$ELSE} + (p^ in Digits) + {$ENDIF} + do begin + Result := Result * 10 + (ord (p^) - ord ('0')); //###0.939 + inc (p); + end; + if Delimited then + if (p < TemplateEnd) and (p^ = '}') + then inc (p) // skip right curly brace + else p := APtr; // isn't properly terminated + if p = APtr + then Result := -1; // no valid digits found or no right curly brace + APtr := p; + end; + begin + // Check programm and input string + if not IsProgrammOk + then EXIT; + if not Assigned (fInputString) then begin + Error (reeNoInpitStringSpecified); + EXIT; + end; + // Prepare for working + TemplateLen := length (ATemplate); + if TemplateLen = 0 then begin // prevent nil pointers + Result := ''; + EXIT; + end; + TemplateBeg := pointer (ATemplate); + TemplateEnd := TemplateBeg + TemplateLen; + // Count result length for speed optimization. + ResultLen := 0; + p := TemplateBeg; + while p < TemplateEnd do begin + Ch := p^; + inc (p); + if Ch = '$' + then n := ParseVarName (p) + else n := -1; + if n >= 0 then begin + if (n < NSUBEXP) and Assigned (startp [n]) and Assigned (endp [n]) + then inc (ResultLen, endp [n] - startp [n]); + end + else begin + if (Ch = EscChar) and (p < TemplateEnd) + then inc (p); // quoted or special char followed + inc (ResultLen); + end; + end; + // Get memory. We do it once and it significant speed up work ! + if ResultLen = 0 then begin + Result := ''; + EXIT; + end; + SetString (Result, nil, ResultLen); + // Fill Result + ResultPtr := pointer (Result); + p := TemplateBeg; + while p < TemplateEnd do begin + Ch := p^; + inc (p); + if Ch = '$' + then n := ParseVarName (p) + else n := -1; + if n >= 0 then begin + p0 := startp [n]; + if (n < NSUBEXP) and Assigned (p0) and Assigned (endp [n]) then + while p0 < endp [n] do begin + ResultPtr^ := p0^; + inc (ResultPtr); + inc (p0); + end; + end + else begin + if (Ch = EscChar) and (p < TemplateEnd) then begin // quoted or special char followed + Ch := p^; + inc (p); + end; + ResultPtr^ := Ch; + inc (ResultPtr); + end; + end; + end; { of function TRegExpr.Substitute +--------------------------------------------------------------} + +procedure TRegExpr.Split (AInputStr : RegExprString; APieces : TStrings); + var PrevPos : integer; + begin + PrevPos := 1; + if Exec (AInputStr) then + REPEAT + APieces.Add (System.Copy (AInputStr, PrevPos, MatchPos [0] - PrevPos)); + PrevPos := MatchPos [0] + MatchLen [0]; + UNTIL not ExecNext; + APieces.Add (System.Copy (AInputStr, PrevPos, MaxInt)); // Tail + end; { of procedure TRegExpr.Split +--------------------------------------------------------------} + +function TRegExpr.Replace (AInputStr : RegExprString; const AReplaceStr : RegExprString; + AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) : RegExprString; + var + PrevPos : integer; + begin + Result := ''; + PrevPos := 1; + if Exec (AInputStr) then + REPEAT + Result := Result + System.Copy (AInputStr, PrevPos, + MatchPos [0] - PrevPos); + if AUseSubstitution //###0.946 + then Result := Result + Substitute (AReplaceStr) + else Result := Result + AReplaceStr; + PrevPos := MatchPos [0] + MatchLen [0]; + UNTIL not ExecNext; + Result := Result + System.Copy (AInputStr, PrevPos, MaxInt); // Tail + end; { of function TRegExpr.Replace +--------------------------------------------------------------} + +function TRegExpr.ReplaceEx (AInputStr : RegExprString; + AReplaceFunc : TRegExprReplaceFunction) + : RegExprString; + var + PrevPos : integer; + begin + Result := ''; + PrevPos := 1; + if Exec (AInputStr) then + REPEAT + Result := Result + System.Copy (AInputStr, PrevPos, + MatchPos [0] - PrevPos) + + AReplaceFunc (Self); + PrevPos := MatchPos [0] + MatchLen [0]; + UNTIL not ExecNext; + Result := Result + System.Copy (AInputStr, PrevPos, MaxInt); // Tail + end; { of function TRegExpr.ReplaceEx +--------------------------------------------------------------} + + +{$IFDEF OverMeth} +function TRegExpr.Replace (AInputStr : RegExprString; + AReplaceFunc : TRegExprReplaceFunction) + : RegExprString; + begin + ReplaceEx (AInputStr, AReplaceFunc); + end; { of function TRegExpr.Replace +--------------------------------------------------------------} +{$ENDIF} + +{=============================================================} +{====================== Debug section ========================} +{=============================================================} + +{$IFDEF RegExpPCodeDump} +function TRegExpr.DumpOp (op : TREOp) : RegExprString; +// printable representation of opcode + begin + case op of + BOL: Result := 'BOL'; + EOL: Result := 'EOL'; + BOLML: Result := 'BOLML'; + EOLML: Result := 'EOLML'; + BOUND: Result := 'BOUND'; //###0.943 + NOTBOUND: Result := 'NOTBOUND'; //###0.943 + ANY: Result := 'ANY'; + ANYML: Result := 'ANYML'; //###0.941 + ANYLETTER: Result := 'ANYLETTER'; + NOTLETTER: Result := 'NOTLETTER'; + ANYDIGIT: Result := 'ANYDIGIT'; + NOTDIGIT: Result := 'NOTDIGIT'; + ANYSPACE: Result := 'ANYSPACE'; + NOTSPACE: Result := 'NOTSPACE'; + ANYOF: Result := 'ANYOF'; + ANYBUT: Result := 'ANYBUT'; + ANYOFCI: Result := 'ANYOF/CI'; + ANYBUTCI: Result := 'ANYBUT/CI'; + BRANCH: Result := 'BRANCH'; + EXACTLY: Result := 'EXACTLY'; + EXACTLYCI: Result := 'EXACTLY/CI'; + NOTHING: Result := 'NOTHING'; + COMMENT: Result := 'COMMENT'; + BACK: Result := 'BACK'; + EEND: Result := 'END'; + BSUBEXP: Result := 'BSUBEXP'; + BSUBEXPCI: Result := 'BSUBEXP/CI'; + Succ (OPEN) .. TREOp (Ord (OPEN) + NSUBEXP - 1): //###0.929 + Result := Format ('OPEN[%d]', [ord (op) - ord (OPEN)]); + Succ (CLOSE) .. TREOp (Ord (CLOSE) + NSUBEXP - 1): //###0.929 + Result := Format ('CLOSE[%d]', [ord (op) - ord (CLOSE)]); + STAR: Result := 'STAR'; + PLUS: Result := 'PLUS'; + BRACES: Result := 'BRACES'; + {$IFDEF ComplexBraces} + LOOPENTRY: Result := 'LOOPENTRY'; //###0.925 + LOOP: Result := 'LOOP'; //###0.925 + LOOPNG: Result := 'LOOPNG'; //###0.940 + {$ENDIF} + ANYOFTINYSET: Result:= 'ANYOFTINYSET'; + ANYBUTTINYSET:Result:= 'ANYBUTTINYSET'; + {$IFDEF UseSetOfChar} //###0.929 + ANYOFFULLSET: Result:= 'ANYOFFULLSET'; + {$ENDIF} + STARNG: Result := 'STARNG'; //###0.940 + PLUSNG: Result := 'PLUSNG'; //###0.940 + BRACESNG: Result := 'BRACESNG'; //###0.940 + else Error (reeDumpCorruptedOpcode); + end; {of case op} + Result := ':' + Result; + end; { of function TRegExpr.DumpOp +--------------------------------------------------------------} + +function TRegExpr.Dump : RegExprString; +// dump a regexp in vaguely comprehensible form + var + s : PRegExprChar; + op : TREOp; // Arbitrary non-END op. + next : PRegExprChar; + i : integer; + Diff : integer; +{$IFDEF UseSetOfChar} //###0.929 + Ch : REChar; +{$ENDIF} + begin + if not IsProgrammOk //###0.929 + then EXIT; + + op := EXACTLY; + Result := ''; + s := programm + REOpSz; + while op <> EEND do begin // While that wasn't END last time... + op := s^; + Result := Result + Format ('%2d%s', [s - programm, DumpOp (s^)]); // Where, what. + next := regnext (s); + if next = nil // Next ptr. + then Result := Result + ' (0)' + else begin + if next > s //###0.948 PWideChar subtraction workaround (see comments in Tail method for details) + then Diff := next - s + else Diff := - (s - next); + Result := Result + Format (' (%d) ', [(s - programm) + Diff]); + end; + inc (s, REOpSz + RENextOffSz); + if (op = ANYOF) or (op = ANYOFCI) or (op = ANYBUT) or (op = ANYBUTCI) + or (op = EXACTLY) or (op = EXACTLYCI) then begin + // Literal string, where present. + while s^ <> #0 do begin + Result := Result + s^; + inc (s); + end; + inc (s); + end; + if (op = ANYOFTINYSET) or (op = ANYBUTTINYSET) then begin + for i := 1 to TinySetLen do begin + Result := Result + s^; + inc (s); + end; + end; + if (op = BSUBEXP) or (op = BSUBEXPCI) then begin + Result := Result + ' \' + IntToStr (Ord (s^)); + inc (s); + end; + {$IFDEF UseSetOfChar} //###0.929 + if op = ANYOFFULLSET then begin + for Ch := #0 to #255 do + if Ch in PSetOfREChar (s)^ then + if Ch < ' ' + then Result := Result + '#' + IntToStr (Ord (Ch)) //###0.936 + else Result := Result + Ch; + inc (s, SizeOf (TSetOfREChar)); + end; + {$ENDIF} + if (op = BRACES) or (op = BRACESNG) then begin //###0.941 + // show min/max argument of BRACES operator + Result := Result + Format ('{%d,%d}', [PREBracesArg (s)^, PREBracesArg (s + REBracesArgSz)^]); + inc (s, REBracesArgSz * 2); + end; + {$IFDEF ComplexBraces} + if (op = LOOP) or (op = LOOPNG) then begin //###0.940 + Result := Result + Format (' -> (%d) {%d,%d}', [ + (s - programm - (REOpSz + RENextOffSz)) + PRENextOff (s + 2 * REBracesArgSz)^, + PREBracesArg (s)^, PREBracesArg (s + REBracesArgSz)^]); + inc (s, 2 * REBracesArgSz + RENextOffSz); + end; + {$ENDIF} + Result := Result + #$d#$a; + end; { of while} + + // Header fields of interest. + + if regstart <> #0 + then Result := Result + 'start ' + regstart; + if reganch <> #0 + then Result := Result + 'anchored '; + if regmust <> nil + then Result := Result + 'must have ' + regmust; + {$IFDEF UseFirstCharSet} //###0.929 + Result := Result + #$d#$a'FirstCharSet:'; + for Ch := #0 to #255 do + if Ch in FirstCharSet + then begin + if Ch < ' ' + then Result := Result + '#' + IntToStr(Ord(Ch)) //###0.948 + else Result := Result + Ch; + end; + {$ENDIF} + Result := Result + #$d#$a; + end; { of function TRegExpr.Dump +--------------------------------------------------------------} +{$ENDIF} + +{$IFDEF reRealExceptionAddr} +{$OPTIMIZATION ON} +// ReturnAddr works correctly only if compiler optimization is ON +// I placed this method at very end of unit because there are no +// way to restore compiler optimization flag ... +{$ENDIF} +procedure TRegExpr.Error (AErrorID : integer); +{$IFDEF reRealExceptionAddr} + function ReturnAddr : pointer; //###0.938 + asm + mov eax,[ebp+4] + end; +{$ENDIF} + var + e : ERegExpr; + begin + fLastError := AErrorID; // dummy stub - useless because will raise exception + if AErrorID < 1000 // compilation error ? + then e := ERegExpr.Create (ErrorMsg (AErrorID) // yes - show error pos + + ' (pos ' + IntToStr (CompilerErrorPos) + ')') + else e := ERegExpr.Create (ErrorMsg (AErrorID)); + e.ErrorCode := AErrorID; + e.CompilerErrorPos := CompilerErrorPos; + raise e + {$IFDEF reRealExceptionAddr} + At ReturnAddr; //###0.938 + {$ENDIF} + end; { of procedure TRegExpr.Error +--------------------------------------------------------------} + +(* + PCode persistence: + FirstCharSet + programm, regsize + regstart // -> programm + reganch // -> programm + regmust, regmlen // -> programm + fExprIsCompiled +*) + +// be carefull - placed here code will be always compiled with +// compiler optimization flag + +{$IFDEF FPC} +initialization + RegExprInvertCaseFunction := TRegExpr.InvertCaseFunction; + +{$ENDIF} +end. + diff --git a/impls/objpascal/run b/impls/objpascal/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/objpascal/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/objpascal/step0_repl.pas b/impls/objpascal/step0_repl.pas new file mode 100644 index 0000000000..a2adefe12a --- /dev/null +++ b/impls/objpascal/step0_repl.pas @@ -0,0 +1,46 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses mal_readline; + +var + Repl_Env: string = ''; + Line : string; + +// read +function READ(const Str: string) : string; +begin + READ := Str; +end; + +// eval +function EVAL(Ast: string; Env: string) : string; +begin + EVAL := Ast; +end; + +// print +function PRINT(Exp: string) : string; +begin + PRINT := Exp; +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +begin + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + end; + end; +end. diff --git a/impls/objpascal/step1_read_print.pas b/impls/objpascal/step1_read_print.pas new file mode 100644 index 0000000000..83f10ecf19 --- /dev/null +++ b/impls/objpascal/step1_read_print.pas @@ -0,0 +1,56 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + mal_readline, + mal_types, + reader, + printer; + +var + Repl_Env : string = ''; + Line : string; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval +function EVAL(Ast: TMal; Env: string) : TMal; +begin + EVAL := Ast; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +begin + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step2_eval.pas b/impls/objpascal/step2_eval.pas new file mode 100644 index 0000000000..a588cd48a3 --- /dev/null +++ b/impls/objpascal/step2_eval.pas @@ -0,0 +1,139 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + mal_readline, + mal_types, + mal_func, + reader, + printer; + +type + TEnv = specialize TFPGMap; + +var + Repl_Env : TEnv; + Line : string; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Arr : TMalArray; + Arr1 : TMalArray; + Sym : string; + Cond : TMal; + Fn : TMalFunc; + Args : TMalArray; + OldDict, NewDict : TMalDict; + I : longint; +begin + // WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + Sym := (Ast as TMalSymbol).Val; + if Env.IndexOf(Sym) < 0 then + raise Exception.Create('''' + Sym + ''' not found') + else + Exit(Env[Sym]); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Arr := (Ast as TMalList).Val; + if Length(Arr) = 0 then + Exit(Ast); + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := (Cond as TMalFunc); + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + EVAL := Fn.Val(Args) + end + else + raise Exception.Create('invalid apply'); +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +function add(Args: TMalArray) : TMal; +begin + add := TMalInt.Create((Args[0] as TMalInt).Val + + (Args[1] as TMalInt).Val); +end; +function subtract(Args: TMalArray) : TMal; +begin + subtract := TMalInt.Create((Args[0] as TMalInt).Val - + (Args[1] as TMalInt).Val); +end; +function multiply(Args: TMalArray) : TMal; +begin + multiply := TMalInt.Create((Args[0] as TMalInt).Val * + (Args[1] as TMalInt).Val); +end; +function divide(Args: TMalArray) : TMal; +begin + divide := TMalInt.Create((Args[0] as TMalInt).Val div + (Args[1] as TMalInt).Val); +end; + +begin + Repl_Env := TEnv.Create; + Repl_Env.Add('+', TMalFunc.Create(@add)); + Repl_Env.Add('-', TMalFunc.Create(@subtract)); + Repl_Env.Add('*', TMalFunc.Create(@multiply)); + Repl_Env.Add('/', TMalFunc.Create(@divide)); + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step3_env.pas b/impls/objpascal/step3_env.pas new file mode 100644 index 0000000000..1f8ba168ec --- /dev/null +++ b/impls/objpascal/step3_env.pas @@ -0,0 +1,164 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env; + +var + Repl_Env : TEnv; + Line : string; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + Fn : TMalCallable; + Args : TMalArray; + OldDict, NewDict : TMalDict; + I : longint; +begin + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Arr := (Ast as TMalList).Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + EVAL := Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV)); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + EVAL := EVAL(Arr[2], LetEnv); + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := (Cond as TMalFunc).Val; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + EVAL := Fn(Args) + end + else + raise Exception.Create('invalid apply'); + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +function add(Args: TMalArray) : TMal; +begin + add := TMalInt.Create((Args[0] as TMalInt).Val + + (Args[1] as TMalInt).Val); +end; +function subtract(Args: TMalArray) : TMal; +begin + subtract := TMalInt.Create((Args[0] as TMalInt).Val - + (Args[1] as TMalInt).Val); +end; +function multiply(Args: TMalArray) : TMal; +begin + multiply := TMalInt.Create((Args[0] as TMalInt).Val * + (Args[1] as TMalInt).Val); +end; +function divide(Args: TMalArray) : TMal; +begin + divide := TMalInt.Create((Args[0] as TMalInt).Val div + (Args[1] as TMalInt).Val); +end; + +begin + Repl_Env := TEnv.Create; + Repl_Env.Add(TMalSymbol.Create('+'), TMalFunc.Create(@add)); + Repl_Env.Add(TMalSymbol.Create('-'), TMalFunc.Create(@subtract)); + Repl_Env.Add(TMalSymbol.Create('*'), TMalFunc.Create(@multiply)); + Repl_Env.Add(TMalSymbol.Create('/'), TMalFunc.Create(@divide)); + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step4_if_fn_do.pas b/impls/objpascal/step4_if_fn_do.pas new file mode 100644 index 0000000000..b538ef4d65 --- /dev/null +++ b/impls/objpascal/step4_if_fn_do.pas @@ -0,0 +1,185 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env, + core; + +var + Repl_Env : TEnv; + Line : string; + I : longint; + Key : string; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Lst : TMalList; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + FnEnv : TEnv; + Cond : TMal; + I : longint; + Fn : TMalFunc; + Args : TMalArray; + OldDict, NewDict : TMalDict; +begin + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Lst := (Ast as TMalList); + Arr := Lst.Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + EVAL := Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV)); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + EVAL := EVAL(Arr[2], LetEnv); + end; + 'do': + begin + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + EVAL := EVAL(Arr[Length(Arr)-1], Env); + end; + 'if': + begin + Cond := EVAL(Arr[1], Env); + if (Cond is TMalNil) or (Cond is TMalFalse) then + if Length(Arr) > 3 then + EVAL := EVAL(Arr[3], Env) + else + EVAL := TMalNil.Create + else + EVAL := EVAL(Arr[2], Env); + end; + 'fn*': + begin + EVAL := TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList)) + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := Cond as TMalFunc; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + if Fn.Ast = nil then + EVAL := Fn.Val(Args) + else + begin + FnEnv := TEnv.Create(Fn.Env, Fn.Params, Args); + EVAL := EVAL(Fn.Ast, FnEnv); + end + + end + else + raise Exception.Create('invalid apply'); + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +begin + Repl_Env := TEnv.Create; + + // core.pas: defined using Pascal + for I := 0 to core.NS.Count-1 do + begin + Key := core.NS.Keys[I]; + Repl_Env.Add(TMalSymbol.Create(Key), + TMalFunc.Create(core.NS[Key])); + end; + + // core.mal: defined using language itself + REP('(def! not (fn* (a) (if a false true)))'); + + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step5_tco.pas b/impls/objpascal/step5_tco.pas new file mode 100644 index 0000000000..182ee95828 --- /dev/null +++ b/impls/objpascal/step5_tco.pas @@ -0,0 +1,189 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env, + core; + +var + Repl_Env : TEnv; + Line : string; + I : longint; + Key : string; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Lst : TMalList; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + I : longint; + Fn : TMalFunc; + Args : TMalArray; + OldDict, NewDict : TMalDict; +begin + while true do + begin + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Lst := (Ast as TMalList); + Arr := Lst.Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + Env := LetEnv; + Ast := Arr[2]; // TCO + end; + 'do': + begin + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + Ast := Arr[Length(Arr)-1]; // TCO + end; + 'if': + begin + Cond := EVAL(Arr[1], Env); + if (Cond is TMalNil) or (Cond is TMalFalse) then + if Length(Arr) > 3 then + Ast := Arr[3] // TCO + else + Exit(TMalNil.Create) + else + Ast := Arr[2]; // TCO + end; + 'fn*': + begin + Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := Cond as TMalFunc; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + if Fn.Ast = nil then + Exit(Fn.Val(Args)) + else + begin + Env := TEnv.Create(Fn.Env, Fn.Params, Args); + Ast := Fn.Ast; // TCO + end + + end + else + raise Exception.Create('invalid apply'); + end; + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +begin + Repl_Env := TEnv.Create; + + // core.pas: defined using Pascal + for I := 0 to core.NS.Count-1 do + begin + Key := core.NS.Keys[I]; + Repl_Env.Add(TMalSymbol.Create(Key), + TMalFunc.Create(core.NS[Key])); + end; + + // core.mal: defined using language itself + REP('(def! not (fn* (a) (if a false true)))'); + + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step6_file.pas b/impls/objpascal/step6_file.pas new file mode 100644 index 0000000000..dbe51b1b54 --- /dev/null +++ b/impls/objpascal/step6_file.pas @@ -0,0 +1,210 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + math, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env, + core; + +var + Repl_Env : TEnv; + Line : string; + I : longint; + Key : string; + CmdArgs : TMalArray; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Lst : TMalList; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + I : longint; + Fn : TMalFunc; + Args : TMalArray; + OldDict, NewDict : TMalDict; +begin + while true do + begin + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Lst := (Ast as TMalList); + Arr := Lst.Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + Env := LetEnv; + Ast := Arr[2]; // TCO + end; + 'do': + begin + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + Ast := Arr[Length(Arr)-1]; // TCO + end; + 'if': + begin + Cond := EVAL(Arr[1], Env); + if (Cond is TMalNil) or (Cond is TMalFalse) then + if Length(Arr) > 3 then + Ast := Arr[3] // TCO + else + Exit(TMalNil.Create) + else + Ast := Arr[2]; // TCO + end; + 'fn*': + begin + Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := Cond as TMalFunc; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + if Fn.Ast = nil then + Exit(Fn.Val(Args)) + else + begin + Env := TEnv.Create(Fn.Env, Fn.Params, Args); + Ast := Fn.Ast; // TCO + end + + end + else + raise Exception.Create('invalid apply'); + end; + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +function do_eval(Args : TMalArray) : TMal; +begin + do_eval := EVAL(Args[0], Repl_Env); +end; + +begin + Repl_Env := TEnv.Create; + core.EVAL := @EVAL; + + // core.pas: defined using Pascal + for I := 0 to core.NS.Count-1 do + begin + Key := core.NS.Keys[I]; + Repl_Env.Add(TMalSymbol.Create(Key), + TMalFunc.Create(core.NS[Key])); + end; + Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); + SetLength(CmdArgs, Max(0, ParamCount-1)); + for I := 2 to ParamCount do + CmdArgs[I-2] := TMalString.Create(ParamStr(I)); + Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); + + // core.mal: defined using language itself + REP('(def! not (fn* (a) (if a false true)))'); + REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + + if ParamCount >= 1 then + begin + REP('(load-file "' + ParamStr(1) + '")'); + ExitCode := 0; + Exit; + end; + + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step7_quote.pas b/impls/objpascal/step7_quote.pas new file mode 100644 index 0000000000..0953b11a18 --- /dev/null +++ b/impls/objpascal/step7_quote.pas @@ -0,0 +1,257 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + math, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env, + core; + +var + Repl_Env : TEnv; + Line : string; + I : longint; + Key : string; + CmdArgs : TMalArray; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; +begin + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); +end; + +function quasiquote(Ast: TMal) : TMal; +var + Arr : TMalArray; + Res, Elt : TMal; + I : longint; +begin + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do + begin + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); + end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); +end; + +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Lst : TMalList; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + I : longint; + Fn : TMalFunc; + Args : TMalArray; + OldDict, NewDict : TMalDict; +begin + while true do + begin + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Lst := (Ast as TMalList); + Arr := Lst.Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + Env := LetEnv; + Ast := Arr[2]; // TCO + end; + 'quote': + Exit(Arr[1]); + 'quasiquote': + Ast := quasiquote(Arr[1]); + 'do': + begin + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + Ast := Arr[Length(Arr)-1]; // TCO + end; + 'if': + begin + Cond := EVAL(Arr[1], Env); + if (Cond is TMalNil) or (Cond is TMalFalse) then + if Length(Arr) > 3 then + Ast := Arr[3] // TCO + else + Exit(TMalNil.Create) + else + Ast := Arr[2]; // TCO + end; + 'fn*': + begin + Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := Cond as TMalFunc; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + if Fn.Ast = nil then + Exit(Fn.Val(Args)) + else + begin + Env := TEnv.Create(Fn.Env, Fn.Params, Args); + Ast := Fn.Ast; // TCO + end + + end + else + raise Exception.Create('invalid apply'); + end; + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +function do_eval(Args : TMalArray) : TMal; +begin + do_eval := EVAL(Args[0], Repl_Env); +end; + +begin + Repl_Env := TEnv.Create; + core.EVAL := @EVAL; + + // core.pas: defined using Pascal + for I := 0 to core.NS.Count-1 do + begin + Key := core.NS.Keys[I]; + Repl_Env.Add(TMalSymbol.Create(Key), + TMalFunc.Create(core.NS[Key])); + end; + Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); + SetLength(CmdArgs, Max(0, ParamCount-1)); + for I := 2 to ParamCount do + CmdArgs[I-2] := TMalString.Create(ParamStr(I)); + Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); + + // core.mal: defined using language itself + REP('(def! not (fn* (a) (if a false true)))'); + REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + + if ParamCount >= 1 then + begin + REP('(load-file "' + ParamStr(1) + '")'); + ExitCode := 0; + Exit; + end; + + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step8_macros.pas b/impls/objpascal/step8_macros.pas new file mode 100644 index 0000000000..7cd26a59f9 --- /dev/null +++ b/impls/objpascal/step8_macros.pas @@ -0,0 +1,274 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + math, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env, + core; + +var + Repl_Env : TEnv; + Line : string; + I : longint; + Key : string; + CmdArgs : TMalArray; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; +begin + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); +end; + +function quasiquote(Ast: TMal) : TMal; +var + Arr : TMalArray; + Res, Elt : TMal; + I : longint; +begin + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do + begin + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); + end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); +end; + +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Lst : TMalList; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + I : longint; + Fn : TMalFunc; + Args : TMalArray; + OldDict, NewDict : TMalDict; +begin + while true do + begin + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Lst := (Ast as TMalList); + Arr := Lst.Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + Env := LetEnv; + Ast := Arr[2]; // TCO + end; + 'quote': + Exit(Arr[1]); + 'quasiquote': + Ast := quasiquote(Arr[1]); + 'defmacro!': + begin + Fn := EVAL(Arr[2], ENV) as TMalFunc; + Fn := TMalFunc.Clone(Fn); + Fn.isMacro := true; + Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); + end; + 'do': + begin + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + Ast := Arr[Length(Arr)-1]; // TCO + end; + 'if': + begin + Cond := EVAL(Arr[1], Env); + if (Cond is TMalNil) or (Cond is TMalFalse) then + if Length(Arr) > 3 then + Ast := Arr[3] // TCO + else + Exit(TMalNil.Create) + else + Ast := Arr[2]; // TCO + end; + 'fn*': + begin + Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := Cond as TMalFunc; + if Fn.isMacro then + begin + if Fn.Ast =nil then + Ast := Fn.Val(Args) + else + Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); + continue; // TCO + end; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + if Fn.Ast = nil then + Exit(Fn.Val(Args)) + else + begin + Env := TEnv.Create(Fn.Env, Fn.Params, Args); + Ast := Fn.Ast; // TCO + end + + end + else + raise Exception.Create('invalid apply'); + end; + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +function do_eval(Args : TMalArray) : TMal; +begin + do_eval := EVAL(Args[0], Repl_Env); +end; + +begin + Repl_Env := TEnv.Create; + core.EVAL := @EVAL; + + // core.pas: defined using Pascal + for I := 0 to core.NS.Count-1 do + begin + Key := core.NS.Keys[I]; + Repl_Env.Add(TMalSymbol.Create(Key), + TMalFunc.Create(core.NS[Key])); + end; + Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); + SetLength(CmdArgs, Max(0, ParamCount-1)); + for I := 2 to ParamCount do + CmdArgs[I-2] := TMalString.Create(ParamStr(I)); + Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); + + // core.mal: defined using language itself + REP('(def! not (fn* (a) (if a false true)))'); + REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); + + + if ParamCount >= 1 then + begin + REP('(load-file "' + ParamStr(1) + '")'); + ExitCode := 0; + Exit; + end; + + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/step9_try.pas b/impls/objpascal/step9_try.pas new file mode 100644 index 0000000000..42df570eb2 --- /dev/null +++ b/impls/objpascal/step9_try.pas @@ -0,0 +1,299 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + math, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env, + core; + +var + Repl_Env : TEnv; + Line : string; + I : longint; + Key : string; + CmdArgs : TMalArray; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; +begin + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); +end; + +function quasiquote(Ast: TMal) : TMal; +var + Arr : TMalArray; + Res, Elt : TMal; + I : longint; +begin + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do + begin + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); + end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); +end; + +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Lst : TMalList; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + I : longint; + Fn : TMalFunc; + Args : TMalArray; + Err : TMalArray; + OldDict, NewDict : TMalDict; +begin + while true do + begin + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Lst := (Ast as TMalList); + Arr := Lst.Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + Env := LetEnv; + Ast := Arr[2]; // TCO + end; + 'quote': + Exit(Arr[1]); + 'quasiquote': + Ast := quasiquote(Arr[1]); + 'defmacro!': + begin + Fn := EVAL(Arr[2], ENV) as TMalFunc; + Fn := TMalFunc.Clone(Fn); + Fn.isMacro := true; + Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); + end; + 'try*': + begin + try + Exit(EVAL(Arr[1], Env)); + except + On E : Exception do + begin + if Length(Arr) < 3 then + raise; + SetLength(Err, 1); + if E.ClassType = TMalException then + Err[0] := (E as TMalException).Val + else + Err[0] := TMalString.Create(E.message); + Arr := (Arr[2] as TMalList).Val; + Exit(EVAL(Arr[2], TEnv.Create(Env, + _list(Arr[1]), + Err))); + end; + end; + end; + 'do': + begin + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + Ast := Arr[Length(Arr)-1]; // TCO + end; + 'if': + begin + Cond := EVAL(Arr[1], Env); + if (Cond is TMalNil) or (Cond is TMalFalse) then + if Length(Arr) > 3 then + Ast := Arr[3] // TCO + else + Exit(TMalNil.Create) + else + Ast := Arr[2]; // TCO + end; + 'fn*': + begin + Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := Cond as TMalFunc; + if Fn.isMacro then + begin + if Fn.Ast =nil then + Ast := Fn.Val(Args) + else + Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); + continue; // TCO + end; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + if Fn.Ast = nil then + Exit(Fn.Val(Args)) + else + begin + Env := TEnv.Create(Fn.Env, Fn.Params, Args); + Ast := Fn.Ast; // TCO + end + + end + else + raise Exception.Create('invalid apply'); + end; + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +function do_eval(Args : TMalArray) : TMal; +begin + do_eval := EVAL(Args[0], Repl_Env); +end; + +begin + Repl_Env := TEnv.Create; + core.EVAL := @EVAL; + + // core.pas: defined using Pascal + for I := 0 to core.NS.Count-1 do + begin + Key := core.NS.Keys[I]; + Repl_Env.Add(TMalSymbol.Create(Key), + TMalFunc.Create(core.NS[Key])); + end; + Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); + SetLength(CmdArgs, Max(0, ParamCount-1)); + for I := 2 to ParamCount do + CmdArgs[I-2] := TMalString.Create(ParamStr(I)); + Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); + + // core.mal: defined using language itself + REP('(def! not (fn* (a) (if a false true)))'); + REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); + + + if ParamCount >= 1 then + begin + REP('(load-file "' + ParamStr(1) + '")'); + ExitCode := 0; + Exit; + end; + + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + if E.ClassType = TMalException then + WriteLn('Error: ' + pr_str((E as TMalException).Val, True)) + else + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/stepA_mal.pas b/impls/objpascal/stepA_mal.pas new file mode 100644 index 0000000000..75efb19fca --- /dev/null +++ b/impls/objpascal/stepA_mal.pas @@ -0,0 +1,302 @@ +program Mal; + +{$H+} // Use AnsiString + +Uses sysutils, + fgl, + math, + mal_readline, + mal_types, + mal_func, + reader, + printer, + mal_env, + core; + +var + Repl_Env : TEnv; + Line : string; + I : longint; + Key : string; + CmdArgs : TMalArray; + +// read +function READ(const Str: string) : TMal; +begin + READ := read_str(Str); +end; + +// eval + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; +begin + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); +end; + +function quasiquote(Ast: TMal) : TMal; +var + Arr : TMalArray; + Res, Elt : TMal; + I : longint; +begin + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do + begin + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); + end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); +end; + +function EVAL(Ast: TMal; Env: TEnv) : TMal; +var + Lst : TMalList; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + I : longint; + Fn : TMalFunc; + Args : TMalArray; + Err : TMalArray; + OldDict, NewDict : TMalDict; +begin + while true do + begin + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); + + // Apply list + Lst := (Ast as TMalList); + Arr := Lst.Val; + if Length(Arr) = 0 then + Exit(Ast); + if Arr[0] is TMalSymbol then + A0Sym := (Arr[0] as TMalSymbol).Val + else + A0Sym := '__<*fn*>__'; + + case A0Sym of + 'def!': + Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); + 'let*': + begin + LetEnv := TEnv.Create(Env); + Arr1 := (Arr[1] as TMalList).Val; + I := 0; + while I < Length(Arr1) do + begin + LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); + Inc(I,2); + end; + Env := LetEnv; + Ast := Arr[2]; // TCO + end; + 'quote': + Exit(Arr[1]); + 'quasiquote': + Ast := quasiquote(Arr[1]); + 'defmacro!': + begin + Fn := EVAL(Arr[2], ENV) as TMalFunc; + Fn := TMalFunc.Clone(Fn); + Fn.isMacro := true; + Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); + end; + 'try*': + begin + try + Exit(EVAL(Arr[1], Env)); + except + On E : Exception do + begin + if Length(Arr) < 3 then + raise; + SetLength(Err, 1); + if E.ClassType = TMalException then + Err[0] := (E as TMalException).Val + else + Err[0] := TMalString.Create(E.message); + Arr := (Arr[2] as TMalList).Val; + Exit(EVAL(Arr[2], TEnv.Create(Env, + _list(Arr[1]), + Err))); + end; + end; + end; + 'do': + begin + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + Ast := Arr[Length(Arr)-1]; // TCO + end; + 'if': + begin + Cond := EVAL(Arr[1], Env); + if (Cond is TMalNil) or (Cond is TMalFalse) then + if Length(Arr) > 3 then + Ast := Arr[3] // TCO + else + Exit(TMalNil.Create) + else + Ast := Arr[2]; // TCO + end; + 'fn*': + begin + Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); + end; + else + begin + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then + begin + Fn := Cond as TMalFunc; + if Fn.isMacro then + begin + if Fn.Ast =nil then + Ast := Fn.Val(Args) + else + Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); + continue; // TCO + end; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + if Fn.Ast = nil then + Exit(Fn.Val(Args)) + else + begin + Env := TEnv.Create(Fn.Env, Fn.Params, Args); + Ast := Fn.Ast; // TCO + end + + end + else + raise Exception.Create('invalid apply'); + end; + end; + end; +end; + +// print +function PRINT(Exp: TMal) : string; +begin + PRINT := pr_str(Exp, True); +end; + +// repl +function REP(Str: string) : string; +begin + REP := PRINT(EVAL(READ(Str), Repl_Env)); +end; + +function do_eval(Args : TMalArray) : TMal; +begin + do_eval := EVAL(Args[0], Repl_Env); +end; + +begin + Repl_Env := TEnv.Create; + core.EVAL := @EVAL; + + // core.pas: defined using Pascal + for I := 0 to core.NS.Count-1 do + begin + Key := core.NS.Keys[I]; + Repl_Env.Add(TMalSymbol.Create(Key), + TMalFunc.Create(core.NS[Key])); + end; + Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); + SetLength(CmdArgs, Max(0, ParamCount-1)); + for I := 2 to ParamCount do + CmdArgs[I-2] := TMalString.Create(ParamStr(I)); + Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); + Repl_Env.Add(TMalSymbol.Create('*host-language*'), + TMalString.Create('Object Pascal')); + + // core.mal: defined using language itself + REP('(def! not (fn* (a) (if a false true)))'); + REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); + + + if ParamCount >= 1 then + begin + REP('(load-file "' + ParamStr(1) + '")'); + ExitCode := 0; + Exit; + end; + + REP('(println (str "Mal [" *host-language* "]"))'); + while True do + begin + try + Line := _readline('user> '); + if Line = '' then continue; + WriteLn(REP(Line)) + except + On E : MalEOF do Halt(0); + On E : Exception do + begin + if E.ClassType = TMalException then + WriteLn('Error: ' + pr_str((E as TMalException).Val, True)) + else + WriteLn('Error: ' + E.message); + WriteLn('Backtrace:'); + WriteLn(GetBacktrace(E)); + end; + end; + end; +end. diff --git a/impls/objpascal/tests/step5_tco.mal b/impls/objpascal/tests/step5_tco.mal new file mode 100644 index 0000000000..9a24ee4d02 --- /dev/null +++ b/impls/objpascal/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Object Pascal: skipping non-TCO recursion +;; Reason: completes at 10,000, unrecoverable segfault at 20,000 diff --git a/impls/ocaml/Dockerfile b/impls/ocaml/Dockerfile new file mode 100644 index 0000000000..9df2367798 --- /dev/null +++ b/impls/ocaml/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:25.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install ocaml diff --git a/impls/ocaml/Makefile b/impls/ocaml/Makefile new file mode 100644 index 0000000000..1b992475c3 --- /dev/null +++ b/impls/ocaml/Makefile @@ -0,0 +1,37 @@ +STEPS = step0_repl.ml step1_read_print.ml step2_eval.ml step3_env.ml \ + step4_if_fn_do.ml step5_tco.ml step6_file.ml step7_quote.ml \ + step8_macros.ml step9_try.ml stepA_mal.ml +MODULES = types.ml reader.ml printer.ml env.ml core.ml +LIBS = str.cmxa unix.cmxa +MAL_LIB = mal_lib.cmxa +# Apparently necessary with caml 5.0: +OPTIONS = -I +str -I +unix + +STEP_BINS = $(STEPS:%.ml=%) +LAST_STEP_BIN = $(word $(words $(STEP_BINS)),$(STEP_BINS)) + +all: $(STEP_BINS) + +dist: mal + +mal: $(LAST_STEP_BIN) + cp $< $@ + +# ocaml repl apparently needs bytecode, not native, compilation. +# Just do it all right here: +repl: + ocamlc -c $(LIBS:%.cmxa=%.cma) $(MODULES) $(STEPS) + rlwrap ocaml $(LIBS:%.cmxa=%.cma) $(MODULES:%.ml=%.cmo) + +$(MAL_LIB): $(MODULES) + ocamlopt -a $(MODULES) -o $@ $(OPTIONS) + +$(STEP_BINS): %: %.ml $(MAL_LIB) + ocamlopt $(LIBS) $(MAL_LIB) $< -o $@ $(OPTIONS) + +clean: + rm -f $(STEP_BINS) mal mal_lib.* *.cmo *.cmx *.cmi *.o + +format: + ocamlformat --inplace --enable-outside-detected-project *.ml +.PHONY: all repl clean format diff --git a/impls/ocaml/core.ml b/impls/ocaml/core.ml new file mode 100644 index 0000000000..aae6b7106d --- /dev/null +++ b/impls/ocaml/core.ml @@ -0,0 +1,263 @@ +module T = Types.Types + +let ns = Env.make None +let kw_macro = T.Keyword "macro" + +let num_fun t f = + Types.fn (function + | [ T.Int a; T.Int b ] -> t (f a b) + | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) + +let mk_int x = T.Int x +let mk_bool x = T.Bool x + +let rec mal_equal a b = + match (a, b) with + | T.List { T.value = xs }, T.List { T.value = ys } + | T.List { T.value = xs }, T.Vector { T.value = ys } + | T.Vector { T.value = xs }, T.List { T.value = ys } + | T.Vector { T.value = xs }, T.Vector { T.value = ys } -> + List.equal mal_equal xs ys + | T.Map { T.value = xs }, T.Map { T.value = ys } -> + Types.MalMap.equal mal_equal xs ys + | _ -> a = b + +let seq = function + | T.List { T.value = xs } -> xs + | T.Vector { T.value = xs } -> xs + | _ -> [] + +let mal_seq = function + | [ (T.List { T.value = xs } as lst) ] when not (List.is_empty xs) -> lst + | [ T.Vector { T.value = xs } ] when not (List.is_empty xs) -> Types.list xs + | [ T.String s ] when 0 < String.length s -> + Types.list (List.map (fun x -> T.String x) (Str.split (Str.regexp "") s)) + | _ -> T.Nil + +let rec assoc = function + | T.Map { T.value = m } :: xs -> Types.list_into_map m xs + | _ -> T.Nil + +let rec dissoc = function + | T.Map { T.value = m } :: xs -> + Types.map (List.fold_left (fun k m -> Types.MalMap.remove m k) m xs) + | _ -> T.Nil + +let rec conj = function + | c :: x :: (_ :: _ as xs) -> conj (conj [ c; x ] :: xs) + | [ T.List { T.value = c; T.meta }; x ] -> T.List { T.value = x :: c; T.meta } + | [ T.Vector { T.value = c; T.meta }; x ] -> + T.Vector { T.value = c @ [ x ]; T.meta } + | _ -> T.Nil + +let init env = + Env.set env "throw" + (Types.fn (function [ ast ] -> raise (Types.MalExn ast) | _ -> T.Nil)); + + Env.set env "+" (num_fun mk_int ( + )); + Env.set env "-" (num_fun mk_int ( - )); + Env.set env "*" (num_fun mk_int ( * )); + Env.set env "/" (num_fun mk_int ( / )); + Env.set env "<" (num_fun mk_bool ( < )); + Env.set env "<=" (num_fun mk_bool ( <= )); + Env.set env ">" (num_fun mk_bool ( > )); + Env.set env ">=" (num_fun mk_bool ( >= )); + + Env.set env "list" (Types.fn (function xs -> Types.list xs)); + Env.set env "list?" + (Types.fn (function [ T.List _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "vector" (Types.fn (function xs -> Types.vector xs)); + Env.set env "vector?" + (Types.fn (function [ T.Vector _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "empty?" + (Types.fn (function + | [ T.List { T.value = [] } ] -> T.Bool true + | [ T.Vector { T.value = [] } ] -> T.Bool true + | _ -> T.Bool false)); + Env.set env "count" + (Types.fn (function + | [ T.List { T.value = xs } ] | [ T.Vector { T.value = xs } ] -> + T.Int (List.length xs) + | _ -> T.Int 0)); + Env.set env "=" + (Types.fn (function + | [ a; b ] -> T.Bool (mal_equal a b) + | _ -> T.Bool false)); + + Env.set env "pr-str" + (Types.fn (function xs -> + T.String (Format.asprintf "%a" (Printer.pr_list true true) xs))); + Env.set env "str" + (Types.fn (function xs -> + T.String (Format.asprintf "%a" (Printer.pr_list false false) xs))); + Env.set env "prn" + (Types.fn (function xs -> + Format.printf "%a\n" (Printer.pr_list true true) xs; + T.Nil)); + Env.set env "println" + (Types.fn (function xs -> + Format.printf "%a\n" (Printer.pr_list false true) xs; + T.Nil)); + + Env.set env "compare" + (Types.fn (function [ a; b ] -> T.Int (compare a b) | _ -> T.Nil)); + Env.set env "with-meta" + (Types.fn (function + | [ T.List v; m ] -> T.List { v with T.meta = m } + | [ T.Map v; m ] -> T.Map { v with T.meta = m } + | [ T.Vector v; m ] -> T.Vector { v with T.meta = m } + | [ T.Fn v; m ] -> T.Fn { v with meta = m } + | _ -> T.Nil)); + Env.set env "meta" + (Types.fn (function + | [ T.List { T.meta } ] -> meta + | [ T.Map { T.meta } ] -> meta + | [ T.Vector { T.meta } ] -> meta + | [ T.Fn { meta } ] -> meta + | _ -> T.Nil)); + + Env.set env "read-string" + (Types.fn (function [ T.String x ] -> Reader.read_str x | _ -> T.Nil)); + Env.set env "slurp" + (Types.fn (function + | [ T.String x ] -> + let chan = open_in x in + let b = Buffer.create 27 in + Buffer.add_channel b chan (in_channel_length chan); + close_in chan; + T.String (Buffer.contents b) + | _ -> T.Nil)); + + Env.set env "cons" + (Types.fn (function [ x; xs ] -> Types.list (x :: seq xs) | _ -> T.Nil)); + Env.set env "concat" + (Types.fn + (let rec concat = function + | x :: y :: more -> concat (Types.list (seq x @ seq y) :: more) + | [ (T.List _ as x) ] -> x + | [ x ] -> Types.list (seq x) + | [] -> Types.list [] + in + concat)); + Env.set env "vec" + (Types.fn (function + | [ T.List { T.value = xs } ] -> Types.vector xs + | [ T.Vector { T.value = xs } ] -> Types.vector xs + | [ _ ] -> raise (Invalid_argument "vec: expects a sequence") + | _ -> raise (Invalid_argument "vec: arg count"))); + + Env.set env "nth" + (Types.fn (function + | [ xs; T.Int i ] -> ( + try List.nth (seq xs) i + with _ -> raise (Invalid_argument "nth: index out of range")) + | _ -> T.Nil)); + Env.set env "first" + (Types.fn (function + | [ xs ] -> ( match seq xs with x :: _ -> x | _ -> T.Nil) + | _ -> T.Nil)); + Env.set env "rest" + (Types.fn (function + | [ xs ] -> Types.list (match seq xs with _ :: xs -> xs | _ -> []) + | _ -> T.Nil)); + + Env.set env "string?" + (Types.fn (function [ T.String _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "symbol" + (Types.fn (function [ T.String x ] -> T.Symbol x | _ -> T.Nil)); + Env.set env "symbol?" + (Types.fn (function [ T.Symbol _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "keyword" + (Types.fn (function + | [ T.String x ] -> T.Keyword x + | [ T.Keyword x ] -> T.Keyword x + | _ -> T.Nil)); + Env.set env "keyword?" + (Types.fn (function [ T.Keyword _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "number?" + (Types.fn (function [ T.Int _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "fn?" + (Types.fn (function + | [ T.Fn { macro = false } ] -> T.Bool true + | _ -> T.Bool false)); + Env.set env "macro?" + (Types.fn (function + | [ T.Fn { macro = true } ] -> T.Bool true + | _ -> T.Bool false)); + Env.set env "nil?" + (Types.fn (function [ T.Nil ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "true?" + (Types.fn (function [ T.Bool true ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "false?" + (Types.fn (function [ T.Bool false ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "sequential?" + (Types.fn (function + | [ T.List _ ] | [ T.Vector _ ] -> T.Bool true + | _ -> T.Bool false)); + Env.set env "apply" + (Types.fn (function + | T.Fn { value = f } :: apply_args -> ( + match List.rev apply_args with + | last_arg :: rev_args -> f (List.rev rev_args @ seq last_arg) + | [] -> f []) + | _ -> raise (Invalid_argument "First arg to apply must be a fn"))); + Env.set env "map" + (Types.fn (function + | [ T.Fn { value = f }; xs ] -> + Types.list (List.map (fun x -> f [ x ]) (seq xs)) + | _ -> T.Nil)); + Env.set env "readline" + (Types.fn (function + | [ T.String x ] -> + Format.printf "%s%!" x; + T.String (read_line ()) + | _ -> T.String (read_line ()))); + + Env.set env "map?" + (Types.fn (function [ T.Map _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "hash-map" (Types.fn (Types.list_into_map Types.MalMap.empty)); + Env.set env "assoc" (Types.fn assoc); + Env.set env "dissoc" (Types.fn dissoc); + Env.set env "get" + (Types.fn (function + | [ T.Map { T.value = m }; k ] -> ( + try Types.MalMap.find k m with _ -> T.Nil) + | _ -> T.Nil)); + Env.set env "keys" + (Types.fn (function + | [ T.Map { T.value = m } ] -> + Types.list (Types.MalMap.fold (fun k _ c -> k :: c) m []) + | _ -> T.Nil)); + Env.set env "vals" + (Types.fn (function + | [ T.Map { T.value = m } ] -> + Types.list (Types.MalMap.fold (fun _ v c -> v :: c) m []) + | _ -> T.Nil)); + Env.set env "contains?" + (Types.fn (function + | [ T.Map { T.value = m }; k ] -> T.Bool (Types.MalMap.mem k m) + | _ -> T.Bool false)); + Env.set env "conj" (Types.fn conj); + Env.set env "seq" (Types.fn mal_seq); + + Env.set env "atom?" + (Types.fn (function [ T.Atom _ ] -> T.Bool true | _ -> T.Bool false)); + Env.set env "atom" + (Types.fn (function [ x ] -> T.Atom (ref x) | _ -> T.Nil)); + Env.set env "deref" (Types.fn (function [ T.Atom x ] -> !x | _ -> T.Nil)); + Env.set env "reset!" + (Types.fn (function + | [ T.Atom x; v ] -> + x := v; + v + | _ -> T.Nil)); + Env.set env "swap!" + (Types.fn (function + | T.Atom x :: T.Fn { value = f } :: args -> + let v = f (!x :: args) in + x := v; + v + | _ -> T.Nil)); + + Env.set env "time-ms" + (Types.fn (function _ -> T.Int (truncate (1000.0 *. Unix.gettimeofday ())))) diff --git a/impls/ocaml/env.ml b/impls/ocaml/env.ml new file mode 100644 index 0000000000..15746cffd9 --- /dev/null +++ b/impls/ocaml/env.ml @@ -0,0 +1,12 @@ +module T = Types.Types +module Data = Map.Make (String) + +type env = { outer : env option; data : Types.mal_type Data.t ref } + +let make outer = { outer; data = ref Data.empty } +let set env key value = env.data := Data.add key value !(env.data) + +let rec get env key = + match Data.find_opt key !(env.data) with + | Some _ as v -> v + | None -> ( match env.outer with Some outer -> get outer key | None -> None) diff --git a/impls/ocaml/printer.ml b/impls/ocaml/printer.ml new file mode 100644 index 0000000000..1808dfc784 --- /dev/null +++ b/impls/ocaml/printer.ml @@ -0,0 +1,41 @@ +open Format +module T = Types.Types + +(* Compile the regex once and for all *) +let _pr_escape_re = Str.regexp "\\([\"\\\n]\\)" + +let _pr_escape_chunk out = function + | Str.Text s -> fprintf out "%s" s + | Str.Delim "\n" -> fprintf out "\\n" + | Str.Delim s -> fprintf out "\\%s" s + +let _pr_escape_string out s = + List.iter (_pr_escape_chunk out) (Str.full_split _pr_escape_re s) + +let rec pr_str readably out mal_obj = + match mal_obj with + | T.Int i -> fprintf out "%i" i + | T.Keyword s -> fprintf out ":%s" s + | T.Nil -> fprintf out "nil" + | T.Bool b -> fprintf out "%B" b + | T.String s when readably -> fprintf out "\"%a\"" _pr_escape_string s + | T.String s | T.Symbol s -> fprintf out "%s" s + | T.List { T.value = xs } -> fprintf out "(%a)" (pr_list readably true) xs + | T.Vector { T.value = xs } -> fprintf out "[%a]" (pr_list readably true) xs + | T.Map { T.value = xs } -> fprintf out "{%a}" (_pr_map readably) xs + | T.Fn _ -> fprintf out "#" + | T.Atom x -> fprintf out "(atom %a)" (pr_str readably) !x + +and pr_list readably spaced out = + List.iter + (let sep = ref "" in + fun x -> + fprintf out "%s%a" !sep (pr_str readably) x; + if spaced && !sep == "" then sep := " " else ()) + +and _pr_map readably out = + Types.MalMap.iter + (let sep = ref "" in + fun k v -> + fprintf out "%s%a %a" !sep (pr_str readably) k (pr_str readably) v; + if !sep == "" then sep := " " else ()) diff --git a/impls/ocaml/reader.ml b/impls/ocaml/reader.ml new file mode 100644 index 0000000000..f129b0cf16 --- /dev/null +++ b/impls/ocaml/reader.ml @@ -0,0 +1,65 @@ +open Str (* not reentrant, but simple and always available *) +open Types + +let separator_re = regexp "\\([, \t\n]\\|;[^\n]*\\)+" +let number_re = regexp "-?[0-9]+" +let chars = "[^][, \t\n;(){}'`~@^\"]+" +let keyword_re = regexp (":\\(" ^ chars ^ "\\)") +let symbol_re = regexp chars +let string_re = regexp {|"\(\(\\[\\n"]\|[^\\"]\)*\)"|} +let escape_re = regexp {|\\.|} +let quote_re = regexp_string "'" +let quasiquote_re = regexp_string "`" +let deref_re = regexp_string "@" +let unquote_re = regexp_string "~" +let sp_unq_re = regexp_string "~@" +let with_meta_re = regexp_string "^" +let list_re = regexp_string "(" +let map_re = regexp_string "{" +let vector_re = regexp_string "[" +let close_re = regexp "[])}]" (* so "[1 2)" is accepted as a vector *) + +let unescape str = + let e = match_end () - 1 in + if str.[e] == 'n' then "\n" else String.sub str e 1 + +let read_str str = + (* !p is the currently parsed position inside str *) + let rec read pattern p = + let result = string_match pattern str !p in + if result then p := match_end (); + result + and read_list p = + ignore (read separator_re p); + if read close_re p then [] + else + (* Parse the first form before the rest of the list *) + let first = read_form p in + first :: read_list p + and read_form p = + ignore (read separator_re p); + if read number_re p then Types.Int (int_of_string (matched_string str)) + else if read keyword_re p then Keyword (matched_group 1 str) + else if read symbol_re p then + match matched_string str with + | "nil" -> Nil + | "true" -> Bool true + | "false" -> Bool false + | t -> Symbol t + else if read string_re p then + String (global_substitute escape_re unescape (matched_group 1 str)) + else if read quote_re p then list [ Symbol "quote"; read_form p ] + else if read quasiquote_re p then list [ Symbol "quasiquote"; read_form p ] + else if read deref_re p then list [ Symbol "deref"; read_form p ] + else if read sp_unq_re p then list [ Symbol "splice-unquote"; read_form p ] + else if read unquote_re p then list [ Symbol "unquote"; read_form p ] + else if read with_meta_re p then + (* Parse the metadata before the value *) + let meta = read_form p in + list [ Symbol "with-meta"; read_form p; meta ] + else if read list_re p then list (read_list p) + else if read vector_re p then vector (read_list p) + else if read map_re p then list_into_map MalMap.empty (read_list p) + else raise (Invalid_argument "unexpected EOF ] } ) or string escape") + in + read_form (ref 0) diff --git a/impls/ocaml/run b/impls/ocaml/run new file mode 100755 index 0000000000..6efdc3de32 --- /dev/null +++ b/impls/ocaml/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/ocaml/step0_repl.ml b/impls/ocaml/step0_repl.ml new file mode 100644 index 0000000000..bd94056fb0 --- /dev/null +++ b/impls/ocaml/step0_repl.ml @@ -0,0 +1,24 @@ +(* + To try things at the ocaml repl: + rlwrap ocaml + + To see type signatures of all functions: + ocamlc -i step0_repl.ml + + To run the program: + ocaml step0_repl.ml +*) + +let eval ast = ast +let read str = str +let print exp = exp +let rep str = print (eval (read str)) + +let main = + try + while true do + Format.printf "user> %!"; + let line = read_line () in + Format.printf "%s\n" (rep line) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/step1_read_print.ml b/impls/ocaml/step1_read_print.ml new file mode 100644 index 0000000000..6073036dff --- /dev/null +++ b/impls/ocaml/step1_read_print.ml @@ -0,0 +1,14 @@ +let eval ast = ast +let read str = Reader.read_str str +let print = Printer.pr_str true + +let main = + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/step2_eval.ml b/impls/ocaml/step2_eval.ml new file mode 100644 index 0000000000..2d07307a74 --- /dev/null +++ b/impls/ocaml/step2_eval.ml @@ -0,0 +1,47 @@ +module T = Types.Types +module Env = Map.Make (String) + +let num_fun f = + Types.fn (function + | [ T.Int a; T.Int b ] -> T.Int (f a b) + | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) + +let repl_env = + Env.of_list + [ + ("+", num_fun ( + )); + ("-", num_fun ( - )); + ("*", num_fun ( * )); + ("/", num_fun ( / )); + ] + +let rec eval env ast = + (* + Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + *) + match ast with + | T.Symbol s -> ( + match Env.find_opt s env with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true + +let main = + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/step3_env.ml b/impls/ocaml/step3_env.ml new file mode 100644 index 0000000000..24ef0385c3 --- /dev/null +++ b/impls/ocaml/step3_env.ml @@ -0,0 +1,68 @@ +module T = Types.Types + +let num_fun f = + Types.fn (function + | [ T.Int a; T.Int b ] -> T.Int (f a b) + | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) + +let repl_env = Env.make None + +let init_repl env = + Env.set env "+" (num_fun ( + )); + Env.set env "-" (num_fun ( - )); + Env.set env "*" (num_fun ( * )); + Env.set env "/" (num_fun ( / )) + +let rec eval env ast = + (match Env.get env "DEBUG-EVAL" with + | None | Some T.Nil | Some (T.Bool false) -> () + | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + match ast with + | T.Symbol s -> ( + match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> + let value = eval env expr in + Env.set env key value; + value + | T.List + { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } + | T.List + { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> + let sub_env = Env.make (Some env) in + let rec bind_pairs = function + | T.Symbol sym :: expr :: more -> + Env.set sub_env sym (eval sub_env expr); + bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") + | _ :: [] -> + raise + (Invalid_argument "let* bindings must be an even number of forms") + | [] -> () + in + bind_pairs bindings; + eval sub_env body + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true + +let main = + init_repl repl_env; + + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/step4_if_fn_do.ml b/impls/ocaml/step4_if_fn_do.ml new file mode 100644 index 0000000000..15e91766f2 --- /dev/null +++ b/impls/ocaml/step4_if_fn_do.ml @@ -0,0 +1,88 @@ +module T = Types.Types + +let repl_env = Env.make (Some Core.ns) + +let rec eval env ast = + (match Env.get env "DEBUG-EVAL" with + | None | Some T.Nil | Some (T.Bool false) -> () + | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + match ast with + | T.Symbol s -> ( + match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> + let value = eval env expr in + Env.set env key value; + value + | T.List + { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } + | T.List + { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> + let sub_env = Env.make (Some env) in + let rec bind_pairs = function + | T.Symbol sym :: expr :: more -> + Env.set sub_env sym (eval sub_env expr); + bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") + | _ :: [] -> + raise + (Invalid_argument "let* bindings must be an even number of forms") + | [] -> () + in + bind_pairs bindings; + eval sub_env body + | T.List { T.value = T.Symbol "do" :: body } -> + List.fold_left (fun _ -> eval env) T.Nil body + | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> + eval env + (match eval env test with + | T.Nil | T.Bool false -> else_expr + | _ -> then_expr) + | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( + match eval env test with + | T.Nil | T.Bool false -> T.Nil + | _ -> eval env then_expr) + | T.List + { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } + | T.List + { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> + Types.fn (function args -> + let sub_env = Env.make (Some env) in + let rec bind_args a b = + match (a, b) with + | [ T.Symbol "&"; T.Symbol name ], args -> + Env.set sub_env name (Types.list args) + | T.Symbol name :: names, arg :: args -> + Env.set sub_env name arg; + bind_args names args + | [], [] -> () + | _ -> raise (Invalid_argument "Bad param count in fn call") + in + bind_args arg_names args; + eval sub_env expr) + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true +let re str = ignore (eval repl_env (read str)) + +let main = + Core.init Core.ns; + re "(def! not (fn* (a) (if a false true)))"; + + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/ocaml/step5_tco.ml b/impls/ocaml/step5_tco.ml similarity index 100% rename from ocaml/step5_tco.ml rename to impls/ocaml/step5_tco.ml diff --git a/impls/ocaml/step6_file.ml b/impls/ocaml/step6_file.ml new file mode 100644 index 0000000000..749fba5a67 --- /dev/null +++ b/impls/ocaml/step6_file.ml @@ -0,0 +1,104 @@ +module T = Types.Types + +let repl_env = Env.make (Some Core.ns) + +let rec eval env ast = + (match Env.get env "DEBUG-EVAL" with + | None | Some T.Nil | Some (T.Bool false) -> () + | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + match ast with + | T.Symbol s -> ( + match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> + let value = eval env expr in + Env.set env key value; + value + | T.List + { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } + | T.List + { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> + let sub_env = Env.make (Some env) in + let rec bind_pairs = function + | T.Symbol sym :: expr :: more -> + Env.set sub_env sym (eval sub_env expr); + bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") + | _ :: [] -> + raise + (Invalid_argument "let* bindings must be an even number of forms") + | [] -> () + in + bind_pairs bindings; + eval sub_env body + | T.List { T.value = T.Symbol "do" :: body } -> + List.fold_left (fun _ -> eval env) T.Nil body + | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> + eval env + (match eval env test with + | T.Nil | T.Bool false -> else_expr + | _ -> then_expr) + | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( + match eval env test with + | T.Nil | T.Bool false -> T.Nil + | _ -> eval env then_expr) + | T.List + { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } + | T.List + { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> + Types.fn (function args -> + let sub_env = Env.make (Some env) in + let rec bind_args a b = + match (a, b) with + | [ T.Symbol "&"; T.Symbol name ], args -> + Env.set sub_env name (Types.list args) + | T.Symbol name :: names, arg :: args -> + Env.set sub_env name arg; + bind_args names args + | [], [] -> () + | _ -> raise (Invalid_argument "Bad param count in fn call") + in + bind_args arg_names args; + eval sub_env expr) + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true +let re str = ignore (eval repl_env (read str)) + +let main = + Core.init Core.ns; + Env.set repl_env "*ARGV*" + (Types.list + (if Array.length Sys.argv > 1 then + List.map + (fun x -> T.String x) + (List.tl (List.tl (Array.to_list Sys.argv))) + else [])); + Env.set repl_env "eval" + (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); + + re + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ + nil)\")))))"; + re "(def! not (fn* (a) (if a false true)))"; + + if Array.length Sys.argv > 1 then + re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) + else + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/step7_quote.ml b/impls/ocaml/step7_quote.ml new file mode 100644 index 0000000000..ce22535047 --- /dev/null +++ b/impls/ocaml/step7_quote.ml @@ -0,0 +1,123 @@ +module T = Types.Types + +let repl_env = Env.make (Some Core.ns) + +let rec quasiquote ast = + match ast with + | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x + | T.List { T.value = xs } -> qq_list xs + | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] + | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] + | _ -> ast + +and qq_list xs = List.fold_right qq_folder xs (Types.list []) + +and qq_folder elt acc = + match elt with + | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> + Types.list [ T.Symbol "concat"; x; acc ] + | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] + +let rec eval env ast = + (match Env.get env "DEBUG-EVAL" with + | None | Some T.Nil | Some (T.Bool false) -> () + | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + match ast with + | T.Symbol s -> ( + match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> + let value = eval env expr in + Env.set env key value; + value + | T.List + { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } + | T.List + { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> + let sub_env = Env.make (Some env) in + let rec bind_pairs = function + | T.Symbol sym :: expr :: more -> + Env.set sub_env sym (eval sub_env expr); + bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") + | _ :: [] -> + raise + (Invalid_argument "let* bindings must be an even number of forms") + | [] -> () + in + bind_pairs bindings; + eval sub_env body + | T.List { T.value = T.Symbol "do" :: body } -> + List.fold_left (fun _ -> eval env) T.Nil body + | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> + eval env + (match eval env test with + | T.Nil | T.Bool false -> else_expr + | _ -> then_expr) + | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( + match eval env test with + | T.Nil | T.Bool false -> T.Nil + | _ -> eval env then_expr) + | T.List + { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } + | T.List + { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> + Types.fn (function args -> + let sub_env = Env.make (Some env) in + let rec bind_args a b = + match (a, b) with + | [ T.Symbol "&"; T.Symbol name ], args -> + Env.set sub_env name (Types.list args) + | T.Symbol name :: names, arg :: args -> + Env.set sub_env name arg; + bind_args names args + | [], [] -> () + | _ -> raise (Invalid_argument "Bad param count in fn call") + in + bind_args arg_names args; + eval sub_env expr) + | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast + | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> + eval env (quasiquote ast) + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true +let re str = ignore (eval repl_env (read str)) + +let main = + Core.init Core.ns; + Env.set repl_env "*ARGV*" + (Types.list + (if Array.length Sys.argv > 1 then + List.map + (fun x -> T.String x) + (List.tl (List.tl (Array.to_list Sys.argv))) + else [])); + Env.set repl_env "eval" + (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); + + re + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ + nil)\")))))"; + re "(def! not (fn* (a) (if a false true)))"; + + if Array.length Sys.argv > 1 then + re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) + else + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/step8_macros.ml b/impls/ocaml/step8_macros.ml new file mode 100644 index 0000000000..0a90532cd8 --- /dev/null +++ b/impls/ocaml/step8_macros.ml @@ -0,0 +1,135 @@ +module T = Types.Types + +let repl_env = Env.make (Some Core.ns) + +let rec quasiquote ast = + match ast with + | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x + | T.List { T.value = xs } -> qq_list xs + | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] + | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] + | _ -> ast + +and qq_list xs = List.fold_right qq_folder xs (Types.list []) + +and qq_folder elt acc = + match elt with + | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> + Types.list [ T.Symbol "concat"; x; acc ] + | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] + +let rec eval env ast = + (match Env.get env "DEBUG-EVAL" with + | None | Some T.Nil | Some (T.Bool false) -> () + | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + match ast with + | T.Symbol s -> ( + match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> + let value = eval env expr in + Env.set env key value; + value + | T.List { T.value = [ T.Symbol "defmacro!"; T.Symbol key; expr ] } -> ( + match eval env expr with + | T.Fn ({ macro = false } as f) -> + let fn = T.Fn { f with macro = true } in + Env.set env key fn; + fn + | _ -> raise (Invalid_argument "defmacro! value must be a fn")) + | T.List + { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } + | T.List + { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> + let sub_env = Env.make (Some env) in + let rec bind_pairs = function + | T.Symbol sym :: expr :: more -> + Env.set sub_env sym (eval sub_env expr); + bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") + | _ :: [] -> + raise + (Invalid_argument "let* bindings must be an even number of forms") + | [] -> () + in + bind_pairs bindings; + eval sub_env body + | T.List { T.value = T.Symbol "do" :: body } -> + List.fold_left (fun _ -> eval env) T.Nil body + | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> + eval env + (match eval env test with + | T.Nil | T.Bool false -> else_expr + | _ -> then_expr) + | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( + match eval env test with + | T.Nil | T.Bool false -> T.Nil + | _ -> eval env then_expr) + | T.List + { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } + | T.List + { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> + Types.fn (function args -> + let sub_env = Env.make (Some env) in + let rec bind_args a b = + match (a, b) with + | [ T.Symbol "&"; T.Symbol name ], args -> + Env.set sub_env name (Types.list args) + | T.Symbol name :: names, arg :: args -> + Env.set sub_env name arg; + bind_args names args + | [], [] -> () + | _ -> raise (Invalid_argument "Bad param count in fn call") + in + bind_args arg_names args; + eval sub_env expr) + | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast + | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> + eval env (quasiquote ast) + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f; macro = true } -> eval env (f args) + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true +let re str = ignore (eval repl_env (read str)) + +let main = + Core.init Core.ns; + Env.set repl_env "*ARGV*" + (Types.list + (if Array.length Sys.argv > 1 then + List.map + (fun x -> T.String x) + (List.tl (List.tl (Array.to_list Sys.argv))) + else [])); + Env.set repl_env "eval" + (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); + + re + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ + nil)\")))))"; + re "(def! not (fn* (a) (if a false true)))"; + re + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if \ + (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) \ + (cons 'cond (rest (rest xs)))))))"; + + if Array.length Sys.argv > 1 then + re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) + else + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/step9_try.ml b/impls/ocaml/step9_try.ml new file mode 100644 index 0000000000..64a4e9d19e --- /dev/null +++ b/impls/ocaml/step9_try.ml @@ -0,0 +1,156 @@ +module T = Types.Types + +let repl_env = Env.make (Some Core.ns) + +let rec quasiquote ast = + match ast with + | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x + | T.List { T.value = xs } -> qq_list xs + | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] + | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] + | _ -> ast + +and qq_list xs = List.fold_right qq_folder xs (Types.list []) + +and qq_folder elt acc = + match elt with + | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> + Types.list [ T.Symbol "concat"; x; acc ] + | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] + +let rec eval env ast = + (match Env.get env "DEBUG-EVAL" with + | None | Some T.Nil | Some (T.Bool false) -> () + | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + match ast with + | T.Symbol s -> ( + match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> + let value = eval env expr in + Env.set env key value; + value + | T.List { T.value = [ T.Symbol "defmacro!"; T.Symbol key; expr ] } -> ( + match eval env expr with + | T.Fn ({ macro = false } as f) -> + let fn = T.Fn { f with macro = true } in + Env.set env key fn; + fn + | _ -> raise (Invalid_argument "defmacro! value must be a fn")) + | T.List + { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } + | T.List + { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> + let sub_env = Env.make (Some env) in + let rec bind_pairs = function + | T.Symbol sym :: expr :: more -> + Env.set sub_env sym (eval sub_env expr); + bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") + | _ :: [] -> + raise + (Invalid_argument "let* bindings must be an even number of forms") + | [] -> () + in + bind_pairs bindings; + eval sub_env body + | T.List { T.value = T.Symbol "do" :: body } -> + List.fold_left (fun _ -> eval env) T.Nil body + | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> + eval env + (match eval env test with + | T.Nil | T.Bool false -> else_expr + | _ -> then_expr) + | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( + match eval env test with + | T.Nil | T.Bool false -> T.Nil + | _ -> eval env then_expr) + | T.List + { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } + | T.List + { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> + Types.fn (function args -> + let sub_env = Env.make (Some env) in + let rec bind_args a b = + match (a, b) with + | [ T.Symbol "&"; T.Symbol name ], args -> + Env.set sub_env name (Types.list args) + | T.Symbol name :: names, arg :: args -> + Env.set sub_env name arg; + bind_args names args + | [], [] -> () + | _ -> raise (Invalid_argument "Bad param count in fn call") + in + bind_args arg_names args; + eval sub_env expr) + | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast + | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> + eval env (quasiquote ast) + | T.List { T.value = [ T.Symbol "try*"; scary ] } -> eval env scary + | T.List + { + T.value = + [ + T.Symbol "try*"; + scary; + T.List { T.value = [ T.Symbol "catch*"; T.Symbol local; handler ] }; + ]; + } -> ( + try eval env scary + with exn -> + let value = + match exn with + | Types.MalExn value -> value + | Invalid_argument msg -> T.String msg + | e -> T.String (Printexc.to_string e) + in + let sub_env = Env.make (Some env) in + Env.set sub_env local value; + eval sub_env handler) + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f; macro = true } -> eval env (f args) + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true +let re str = ignore (eval repl_env (read str)) + +let main = + Core.init Core.ns; + Env.set repl_env "*ARGV*" + (Types.list + (if Array.length Sys.argv > 1 then + List.map + (fun x -> T.String x) + (List.tl (List.tl (Array.to_list Sys.argv))) + else [])); + Env.set repl_env "eval" + (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); + + re + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ + nil)\")))))"; + re "(def! not (fn* (a) (if a false true)))"; + re + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if \ + (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) \ + (cons 'cond (rest (rest xs)))))))"; + + if Array.length Sys.argv > 1 then + re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) + else + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n" diff --git a/impls/ocaml/stepA_mal.ml b/impls/ocaml/stepA_mal.ml new file mode 100644 index 0000000000..de065e7afa --- /dev/null +++ b/impls/ocaml/stepA_mal.ml @@ -0,0 +1,158 @@ +module T = Types.Types + +let repl_env = Env.make (Some Core.ns) + +let rec quasiquote ast = + match ast with + | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x + | T.List { T.value = xs } -> qq_list xs + | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] + | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] + | _ -> ast + +and qq_list xs = List.fold_right qq_folder xs (Types.list []) + +and qq_folder elt acc = + match elt with + | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> + Types.list [ T.Symbol "concat"; x; acc ] + | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] + +let rec eval env ast = + (match Env.get env "DEBUG-EVAL" with + | None | Some T.Nil | Some (T.Bool false) -> () + | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); + match ast with + | T.Symbol s -> ( + match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) + | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) + | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) + | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> + let value = eval env expr in + Env.set env key value; + value + | T.List { T.value = [ T.Symbol "defmacro!"; T.Symbol key; expr ] } -> ( + match eval env expr with + | T.Fn ({ macro = false } as f) -> + let fn = T.Fn { f with macro = true } in + Env.set env key fn; + fn + | _ -> raise (Invalid_argument "defmacro! value must be a fn")) + | T.List + { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } + | T.List + { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> + let sub_env = Env.make (Some env) in + let rec bind_pairs = function + | T.Symbol sym :: expr :: more -> + Env.set sub_env sym (eval sub_env expr); + bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") + | _ :: [] -> + raise + (Invalid_argument "let* bindings must be an even number of forms") + | [] -> () + in + bind_pairs bindings; + eval sub_env body + | T.List { T.value = T.Symbol "do" :: body } -> + List.fold_left (fun _ -> eval env) T.Nil body + | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> + eval env + (match eval env test with + | T.Nil | T.Bool false -> else_expr + | _ -> then_expr) + | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( + match eval env test with + | T.Nil | T.Bool false -> T.Nil + | _ -> eval env then_expr) + | T.List + { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } + | T.List + { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> + Types.fn (function args -> + let sub_env = Env.make (Some env) in + let rec bind_args a b = + match (a, b) with + | [ T.Symbol "&"; T.Symbol name ], args -> + Env.set sub_env name (Types.list args) + | T.Symbol name :: names, arg :: args -> + Env.set sub_env name arg; + bind_args names args + | [], [] -> () + | _ -> raise (Invalid_argument "Bad param count in fn call") + in + bind_args arg_names args; + eval sub_env expr) + | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast + | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> + eval env (quasiquote ast) + | T.List { T.value = [ T.Symbol "try*"; scary ] } -> eval env scary + | T.List + { + T.value = + [ + T.Symbol "try*"; + scary; + T.List { T.value = [ T.Symbol "catch*"; T.Symbol local; handler ] }; + ]; + } -> ( + try eval env scary + with exn -> + let value = + match exn with + | Types.MalExn value -> value + | Invalid_argument msg -> T.String msg + | e -> T.String (Printexc.to_string e) + in + let sub_env = Env.make (Some env) in + Env.set sub_env local value; + eval sub_env handler) + | T.List { T.value = a0 :: args } -> ( + match eval env a0 with + | T.Fn { value = f; macro = true } -> eval env (f args) + | T.Fn { value = f } -> f (List.map (eval env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) + | _ -> ast + +let read str = Reader.read_str str +let print = Printer.pr_str true +let re str = ignore (eval repl_env (read str)) + +let main = + Core.init Core.ns; + Env.set repl_env "*ARGV*" + (Types.list + (if Array.length Sys.argv > 1 then + List.map + (fun x -> T.String x) + (List.tl (List.tl (Array.to_list Sys.argv))) + else [])); + Env.set repl_env "eval" + (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); + + re "(def! *host-language* \"ocaml\")"; + re + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ + nil)\")))))"; + re "(def! not (fn* (a) (if a false true)))"; + re + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if \ + (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) \ + (cons 'cond (rest (rest xs)))))))"; + + if Array.length Sys.argv > 1 then + re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) + else ( + re "(println (str \"Mal [\" *host-language* \"]\"))"; + try + while true do + Format.printf "user> %!"; + let line = read_line () in + try Format.printf "%a\n" print (eval repl_env (read line)) with + | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc + | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) + done + with End_of_file -> Format.printf "\n") diff --git a/impls/ocaml/tests/step5_tco.mal b/impls/ocaml/tests/step5_tco.mal new file mode 100644 index 0000000000..193f7b66fd --- /dev/null +++ b/impls/ocaml/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Ocaml skipping non-TCO recursion +;; Reason: completes at 50,000, unrecoverable segfaul at 100,000 diff --git a/impls/ocaml/types.ml b/impls/ocaml/types.ml new file mode 100644 index 0000000000..52bad004f2 --- /dev/null +++ b/impls/ocaml/types.ml @@ -0,0 +1,46 @@ +module rec Types : sig + type 'a with_meta = { value : 'a; meta : t } + + and t = + | List of t list with_meta + | Vector of t list with_meta + | Map of t MalMap.t with_meta + | Int of int + | Symbol of string + | Keyword of string + | Nil + | Bool of bool + | String of string + | Fn of { value : t list -> t; meta : t; macro : bool } + | Atom of t ref +end = + Types + +and MalValue : sig + type t = Types.t + + val compare : t -> t -> int +end = struct + type t = Types.t + + let compare = compare +end + +and MalMap : (Map.S with type key = MalValue.t) = Map.Make (MalValue) + +exception MalExn of Types.t + +type mal_type = MalValue.t + +let list x = Types.List { Types.value = x; meta = Types.Nil } +let map x = Types.Map { Types.value = x; meta = Types.Nil } +let vector x = Types.Vector { Types.value = x; meta = Types.Nil } +let fn f = Types.Fn { macro = false; value = f; meta = Types.Nil } + +let rec list_into_map target source = + match source with + | k :: v :: more -> list_into_map (MalMap.add k v target) more + | [] -> map target + | _ :: [] -> + raise + (Invalid_argument "Literal maps must contain an even number of forms") diff --git a/impls/perl/Core.pm b/impls/perl/Core.pm new file mode 100644 index 0000000000..728c6fa701 --- /dev/null +++ b/impls/perl/Core.pm @@ -0,0 +1,260 @@ +package Core; +use re '/msx'; +use strict; +use warnings; + +use English '-no_match_vars'; +use Hash::Util qw(fieldhash); +use Time::HiRes qw(time); + +use Readline qw(mal_readline); +use Types qw(equal_q thaw_key nil true false); +use Reader qw(read_str); +use Printer qw(pr_list); +use Interop qw(pl_to_mal); + +use Exporter 'import'; +our @EXPORT_OK = qw(%NS); + +# String functions + +sub pr_str { + my @args = @_; + return Mal::String->new( pr_list( q{ }, 1, @args ) ); +} + +sub str { + my @args = @_; + return Mal::String->new( pr_list( q{}, 0, @args ) ); +} + +sub prn { + my @args = @_; + print pr_list( q{ }, 1, @args ), "\n" or die $ERRNO; + return nil; +} + +sub println { + my @args = @_; + print pr_list( q{ }, 0, @args ), "\n" or die $ERRNO; + return nil; +} + +sub core_readline { + my ($prompt) = @_; + my $line = mal_readline( ${$prompt} ); + return defined $line ? Mal::String->new($line) : nil; +} + +sub slurp { + my ($filename) = @_; + local $INPUT_RECORD_SEPARATOR = undef; + open my $fh, q{<}, ${$filename} or die $ERRNO; + my $data = <$fh>; + close $fh or die $ERRNO; + return Mal::String->new($data); +} + +# Hash Map functions + +sub assoc { + my ( $src_hsh, @keys ) = @_; + return Mal::HashMap->new( { %{$src_hsh}, @keys } ); +} + +sub dissoc { + my ( $map, @keys ) = @_; + my $new_hsh = { %{$map} }; + delete @{$new_hsh}{@keys}; + return Mal::HashMap->new($new_hsh); +} + +sub get { + my ( $hsh, $key ) = @_; + return $hsh->{$key} // nil; +} + +sub contains_q { + my ( $hsh, $key ) = @_; + return mal_bool( exists $hsh->{$key} ); +} + +sub mal_keys { + my ($map) = @_; + return Mal::List->new( [ map { thaw_key($_) } keys %{$map} ] ); +} + +sub mal_vals { + my ($map) = @_; + return Mal::List->new( [ values %{$map} ] ); +} + +# Sequence functions + +sub cons { + my ( $a, $b ) = @_; + return Mal::List->new( [ $a, @{$b} ] ); +} + +sub concat { + my @args = @_; + return Mal::List->new( [ map { @{$_} } @args ] ); +} + +sub nth { + my ( $seq, $i ) = @_; + return $seq->[ ${$i} ] // die 'nth: index out of bounds'; +} + +sub first { + my ($seq) = @_; + return $seq->[0] // nil; +} + +sub rest { + my ($l) = @_; + return Mal::List->new( [ @{$l}[ 1 .. $#{$l} ] ] ); +} + +sub apply { + my ( $f, @args ) = @_; + my $more_args = pop @args; + return $f->( @args, @{$more_args} ); +} + +sub mal_map { + my ( $f, $args ) = @_; + return Mal::List->new( [ map { $f->($_) } @{$args} ] ); +} + +sub conj { + my ( $seq, @items ) = @_; + if ( $seq->isa('Mal::List') ) { + return Mal::List->new( [ reverse(@items), @{$seq} ] ); + } + else { + return Mal::Vector->new( [ @{$seq}, @items ] ); + } +} + +sub seq { + my ($arg) = @_; + if ( $arg->isa('Mal::List') and @{$arg} ) { + return $arg; + } + if ( $arg->isa('Mal::Vector') and @{$arg} ) { + return Mal::List->new( [ @{$arg} ] ); + } + if ( $arg->isa('Mal::String') and length ${$arg} ) { + return Mal::List->new( + [ map { Mal::String->new($_) } split //, ${$arg} ] ); + } + return nil; +} + +fieldhash my %meta; + +# Metadata functions +sub with_meta { + my ( $old, $new_meta ) = @_; + my $new_obj = $old->clone; + $meta{$new_obj} = $new_meta; + return $new_obj; +} + +# Atom functions +sub swap_bang { + my ( $atm, $f, @args ) = @_; + return ${$atm} = $f->( ${$atm}, @args ); +} + +# Interop + +# Force array context so that undef is a valid result. +sub pl_star { + my ($perl) = @_; + ## no critic (BuiltinFunctions::ProhibitStringyEval) + my @result = eval ${$perl}; + ## use critic + @result or die $EVAL_ERROR; + return pl_to_mal( $result[0] ); +} + +sub mal_bool { + my ($test) = @_; + return $test ? true : false; +} + +our %NS = ( + q{=} => sub { mal_bool( equal_q( $_[0], $_[1] ) ) }, + 'throw' => sub { die $_[0] }, + 'nil?' => sub { mal_bool( $_[0]->isa('Mal::Nil') ) }, + 'true?' => sub { mal_bool( $_[0]->isa('Mal::True') ) }, + 'false?' => sub { mal_bool( $_[0]->isa('Mal::False') ) }, + 'number?' => sub { mal_bool( $_[0]->isa('Mal::Integer') ) }, + 'symbol' => sub { Mal::Symbol->new( ${ $_[0] } ) }, + 'symbol?' => sub { mal_bool( $_[0]->isa('Mal::Symbol') ) }, + 'string?' => sub { mal_bool( $_[0]->isa('Mal::String') ) }, + 'keyword' => sub { Mal::Keyword->new( ${ $_[0] } ) }, + 'keyword?' => sub { mal_bool( $_[0]->isa('Mal::Keyword') ) }, + 'fn?' => sub { mal_bool( $_[0]->isa('Mal::Function') ) }, + 'macro?' => sub { mal_bool( $_[0]->isa('Mal::Macro') ) }, + + 'pr-str' => \&pr_str, + 'str' => \&str, + 'prn' => \&prn, + 'println' => \&println, + 'readline' => \&core_readline, + 'read-string' => sub { read_str( ${ $_[0] } ) }, + 'slurp' => \&slurp, + '<' => sub { mal_bool( ${ $_[0] } < ${ $_[1] } ) }, + '<=' => sub { mal_bool( ${ $_[0] } <= ${ $_[1] } ) }, + '>' => sub { mal_bool( ${ $_[0] } > ${ $_[1] } ) }, + '>=' => sub { mal_bool( ${ $_[0] } >= ${ $_[1] } ) }, + q{+} => sub { Mal::Integer->new( ${ $_[0] } + ${ $_[1] } ) }, + q{-} => sub { Mal::Integer->new( ${ $_[0] } - ${ $_[1] } ) }, + q{*} => sub { Mal::Integer->new( ${ $_[0] } * ${ $_[1] } ) }, + q{/} => sub { Mal::Integer->new( ${ $_[0] } / ${ $_[1] } ) }, + ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) + 'time-ms' => sub { Mal::Integer->new( int( time() * 1000 ) ) }, + ## use critic + + 'list' => sub { Mal::List->new( \@_ ) }, + 'list?' => sub { mal_bool( $_[0]->isa('Mal::List') ) }, + 'vector' => sub { Mal::Vector->new( \@_ ) }, + 'vector?' => sub { mal_bool( $_[0]->isa('Mal::Vector') ) }, + 'hash-map' => sub { Mal::HashMap->new( {@_} ) }, + 'map?' => sub { mal_bool( $_[0]->isa('Mal::HashMap') ) }, + 'assoc' => \&assoc, + 'dissoc' => \&dissoc, + 'get' => \&get, + 'contains?' => \&contains_q, + 'keys' => \&mal_keys, + 'vals' => \&mal_vals, + + 'sequential?' => sub { mal_bool( $_[0]->isa('Mal::Sequence') ) }, + 'nth' => \&nth, + 'first' => \&first, + 'rest' => \&rest, + 'cons' => \&cons, + 'concat' => \&concat, + 'vec' => sub { Mal::Vector->new( [ @{ $_[0] } ] ) }, + 'empty?' => sub { mal_bool( not @{ $_[0] } ) }, + 'count' => sub { Mal::Integer->new( scalar @{ $_[0] } ) }, + 'apply' => \&apply, + 'map' => \&mal_map, + 'conj' => \&conj, + 'seq' => \&seq, + + 'with-meta' => \&with_meta, + 'meta' => sub { $meta{ $_[0] } // nil }, + 'atom' => sub { Mal::Atom->new( $_[0] ) }, + 'atom?' => sub { mal_bool( $_[0]->isa('Mal::Atom') ) }, + 'deref' => sub { ${ $_[0] } }, + 'reset!' => sub { ${ $_[0] } = $_[1] }, + 'swap!' => \&swap_bang, + + 'pl*' => \&pl_star, +); + +1; diff --git a/impls/perl/Dockerfile b/impls/perl/Dockerfile new file mode 100644 index 0000000000..7909e5b99e --- /dev/null +++ b/impls/perl/Dockerfile @@ -0,0 +1,25 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install perl + +# For style checks in Makefile. +# RUN apt-get -y install libperl-critic-perl perltidy diff --git a/impls/perl/Env.pm b/impls/perl/Env.pm new file mode 100644 index 0000000000..763a0ce173 --- /dev/null +++ b/impls/perl/Env.pm @@ -0,0 +1,60 @@ +package Env; +use strict; +use warnings; + +use Exporter 'import'; +our @EXPORT_OK = (); + +use Types; + +sub new { + my ( $class, $outer, $binds, $exprs ) = @_; + my $data = { __outer__ => $outer }; + if ($binds) { + for my $i ( 0 .. $#{$binds} ) { + if ( ${ $binds->[$i] } eq q{&} ) { + + # variable length arguments + $data->{ ${ $binds->[ $i + 1 ] } } = + Mal::List->new( [ @{$exprs}[ $i .. $#{$exprs} ] ] ); + last; + } + $data->{ ${ $binds->[$i] } } = $exprs->[$i]; + } + } + return bless $data => $class; +} + +sub get { + my ( $self, $key ) = @_; + while ( not $self->{$key} ) { + $self = $self->{__outer__} // return; + } + return $self->{$key}; +} + +## no critic (NamingConventions::ProhibitAmbiguousNames) +sub set { + ## use critic + my ( $self, $key, $value ) = @_; + $self->{$key} = $value; + return $value; +} + +#my $e1 = Env->new(); +#print Dumper($e1); +# +#my $e2 = Env->new(); +#$e2->set('abc', 123); +#$e2->set('def', 456); +#print Dumper($e2); +# +#my $e3 = Env->new($e2); +#$e3->set('abc', 789); +#$e3->set('ghi', 1024); +#print Dumper($e3); +# +#print Dumper($e3->get('abc')); +#print Dumper($e3->get('def')); + +1; diff --git a/impls/perl/Interop.pm b/impls/perl/Interop.pm new file mode 100644 index 0000000000..85ecbc315f --- /dev/null +++ b/impls/perl/Interop.pm @@ -0,0 +1,31 @@ +package Interop; +use re '/msx'; +use strict; +use warnings; + +use Exporter 'import'; +our @EXPORT_OK = qw( pl_to_mal ); +use Scalar::Util qw(looks_like_number); + +use Types qw(nil); + +sub pl_to_mal { + my ($obj) = @_; + defined $obj or return nil; + $_ = ref $obj; + if (/^ARRAY/) { + return Mal::List->new( [ map { pl_to_mal($_) } @{$obj} ] ); + } + if (/^HASH/) { + return Mal::HashMap->new( { map { pl_to_mal($_) } %{$obj} } ); + } + if ( $_ eq q{} ) { + if ( looks_like_number $obj ) { + return Mal::Integer->new($obj); + } + return Mal::String->new($obj); + } + die 'Failed to convert a perl object to mal.'; +} + +1; diff --git a/impls/perl/Makefile b/impls/perl/Makefile new file mode 100644 index 0000000000..a4561e7eca --- /dev/null +++ b/impls/perl/Makefile @@ -0,0 +1,45 @@ +SOURCES_BASE = \ + Readline.pm \ + Types.pm \ + Reader.pm \ + Printer.pm \ + Interop.pm +SOURCES_LISP = \ + Env.pm \ + Core.pm \ + stepA_mal.pl +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + +dist: mal.pl mal + +mal.pl: $(SOURCES) + #fatpack pack ./stepA_mal.pl > $@ + fatpack trace ./stepA_mal.pl + fatpack packlists-for `cat fatpacker.trace` > packlists + fatpack tree `cat packlists` + cp $+ fatlib/ + (fatpack file; cat ./stepA_mal.pl) > mal.pl + +mal: mal.pl + echo "#!/usr/bin/env perl" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.pl mal fatpacker.trace packlists fatlib/* *-lint + [ -d fatlib ] && rmdir fatlib || true + +no_critic := \ + ErrorHandling::RequireCarping \ + RequireVersionVar \ + # EOL + +lint-all: $(addsuffix -lint,$(wildcard *.pl *.pm)) +lint: $(SOURCES:%=%-lint) +%-lint: % Makefile + perl -c -I. $* + perltidy -st $* | diff -u $* - + perlcritic -1 --verbose 11 $(no_critic:%=--exclude=%) $* + touch $@ diff --git a/impls/perl/Printer.pm b/impls/perl/Printer.pm new file mode 100644 index 0000000000..e375ac6193 --- /dev/null +++ b/impls/perl/Printer.pm @@ -0,0 +1,59 @@ +package Printer; +use re '/msx'; +use strict; +use warnings; + +use Exporter 'import'; +our @EXPORT_OK = qw( pr_list pr_str ); + +use Types qw(thaw_key); + +use List::Util qw(pairmap); + +sub pr_str { + my ( $obj, $print_readably ) = @_; + my $_r = $print_readably // 1; + if ( $obj->isa('Mal::List') ) { + return '(' . pr_list( q{ }, $_r, @{$obj} ) . ')'; + } + if ( $obj->isa('Mal::Vector') ) { + return '[' . pr_list( q{ }, $_r, @{$obj} ) . ']'; + } + if ( $obj->isa('Mal::HashMap') ) { + return + '{' + . pr_list( q{ }, $_r, pairmap { thaw_key($a) => $b } %{$obj} ) . '}'; + } + if ( $obj->isa('Mal::Keyword') ) { + return ":${$obj}"; + } + if ( $obj->isa('Mal::String') ) { + if ($_r) { + my $str = ${$obj}; + $str =~ s/\\/\\\\/g; + $str =~ s/"/\\"/g; + $str =~ s/\n/\\n/g; + return qq{"$str"}; + } + else { + return ${$obj}; + } + } + if ( $obj->isa('Mal::Atom') ) { + return '(atom ' . pr_str( ${$obj} ) . ')'; + } + if ( $obj->isa('Mal::Function') ) { + return ""; + } + if ( $obj->isa('Mal::Macro') ) { + return ""; + } + return ${$obj}; +} + +sub pr_list { + my ( $separator, $readably, @objs ) = @_; + return join $separator, map { pr_str( $_, $readably ) } @objs; +} + +1; diff --git a/impls/perl/README.md b/impls/perl/README.md new file mode 100644 index 0000000000..60d30f5561 --- /dev/null +++ b/impls/perl/README.md @@ -0,0 +1,28 @@ +# Notes on the mal implementation in Perl5. + +This implementation should work in any perl from 5.19.3 onwards. +Earlier versions are likely to work too as long as you install a new +List::Util. The implementation uses the experimental `switch` +feature, which may make it vulnerable to future changes in perl. + +Mal objects are all in subclasses of `Mal::Type`, and can be treated +as scalar, array, or hash references as appropriate. + +Metadata support uses `Hash::Util::FieldHash` to attach external +metadata to objects. This means that in the metadata system imposes +no overhead on the normal use of objects. + +Hash-maps are slightly magical. They're keyed by the stringified +versions of mal objects, and `Mal::Scalar` overloads stringification +so that this works properly. + +Tail-call optimisation uses Perl's built-in `goto &NAME` syntax for +explicit tail calls. This allows functions defined by `fn*` to be +implemented as functions at the Perl layer. + +Perl's garbage-collection is based on reference counting. This means +that reference loops will cause memory leaks, and in particular using +`def!` to define a function will cause that function to have a +reference to the environment it's defined in, making a small reference +loop and hence a memory leak. This can be avoided by carefully +undefining any function before it goes out of scope. diff --git a/impls/perl/Reader.pm b/impls/perl/Reader.pm new file mode 100644 index 0000000000..7046da2257 --- /dev/null +++ b/impls/perl/Reader.pm @@ -0,0 +1,113 @@ +package Reader; +use re '/msx'; +use strict; +use warnings; + +use Exporter 'import'; +our @EXPORT_OK = qw( read_str ); + +use Types qw(nil true false); + +my $separators = <<'EOF'; +(?: [\s,] | ; [^\n]* \n )* +EOF + +my $normal = <<'EOF'; +[^\s,;'`~@^()[\]{}"] +EOF + +sub read_list { + my ( $str, $end ) = @_; + + # print "read_list: /${$str}/$end/\n"; + my @lst; + while () { + ${$str} =~ s/ \A $separators //; + ${$str} or die "expected '$end', got EOF"; + last if ( ${$str} =~ s/ \A $end // ); + push @lst, read_form($str); + } + return \@lst; +} + +sub quote { + my ( $quoter, @args ) = @_; + + # print "read_form: quote/$quoter/\n"; + return Mal::List->new( [ Mal::Symbol->new($quoter), @args ] ); +} + +sub read_form { + my $str = shift; + + # print "read_form: /${$str}/\n"; + + # Always skip initial separators. + ${$str} =~ s/ \A $separators //; + + if ( ${$str} =~ s/ \A ' // ) { + return quote( 'quote', read_form($str) ); + } + if ( ${$str} =~ s/ \A ` // ) { + return quote( 'quasiquote', read_form($str) ); + } + if ( ${$str} =~ s/ \A ~ // ) { + return quote( ${$str} =~ s/ \A @ // ? 'splice-unquote' : 'unquote', + read_form($str) ); + } + if ( ${$str} =~ s/ \A \^ // ) { + my $meta = read_form($str); + return quote( 'with-meta', read_form($str), $meta ); + } + if ( ${$str} =~ s/ \A @ // ) { + return quote( 'deref', read_form($str) ); + } + if ( ${$str} =~ s/ \A [(] // ) { + return Mal::List->new( read_list( $str, '\)' ) ); + } + if ( ${$str} =~ s/ \A \[ // ) { + return Mal::Vector->new( read_list( $str, '\]' ) ); + } + if ( ${$str} =~ s/ \A [{] // ) { + return Mal::HashMap->new( { @{ read_list( $str, '\}' ) } } ); + } + if ( ${$str} =~ s/ \A ( -? \d+ ) // ) { + return Mal::Integer->new($1); + } + if ( ${$str} =~ s/ \A " // ) { + ${$str} =~ s/ \A ( (?: \\ . | [^\\"] )* ) " // + or die 'expected ", got EOF'; + return Mal::String->new( $1 =~ s/ \\ (.) / $1 =~ tr|n|\n|r /ger ); + } + if ( ${$str} =~ s/ \A : // ) { + ${$str} =~ s/ \A ( $normal + ) // + or die 'letters expected after a colon'; + return Mal::Keyword->new($1); + } + if ( ${$str} =~ s/ \A ( $normal+ ) // ) { + if ( $1 eq 'nil' ) { return nil; } + if ( $1 eq 'true' ) { return true; } + if ( $1 eq 'false' ) { return false; } + return Mal::Symbol->new($1); + } + if ( ${$str} =~ / \A [)\]}] / ) { + die "unexpected '$1'"; + } + die "Failed to parse '${$str}'"; +} + +sub read_str { + my $str = shift; + return read_form( \$str ); +} + +#print Dumper(read_str("123")); +#print Dumper(read_str("+")); +#print Dumper(read_str("\"abc\"")); +#print Dumper(read_str("nil")); +#print Dumper(read_str("true")); +#print Dumper(read_str("false")); +#print Dumper(read_str("(+ 2 3)")); +#print Dumper(read_str("(foo 2 (3 4))")); + +1; diff --git a/impls/perl/Readline.pm b/impls/perl/Readline.pm new file mode 100644 index 0000000000..f77af6d334 --- /dev/null +++ b/impls/perl/Readline.pm @@ -0,0 +1,78 @@ +# To get readline line editing functionality, please install +# Term::ReadKey and either Term::ReadLine::Gnu (GPL) or +# Term::ReadLine::Perl (GPL, Artistic) from CPAN. + +package Readline; +use re '/msx'; +use strict; +use warnings; + +use English '-no_match_vars'; +use Term::ReadLine; + +use Exporter 'import'; +our @EXPORT_OK = qw( mal_readline set_rl_mode ); + +my $_rl = Term::ReadLine->new('Mal'); +$_rl->ornaments(0); + +#print "Using ReadLine implementation: " . $_rl->ReadLine() . "\n"; +my $OUT = $_rl->OUT || \*STDOUT; +my $_history_loaded = 0; + +my $history_file = "$ENV{'HOME'}/.mal-history"; + +sub save_line { + my ($line) = @_; + open my $fh, '>>', $history_file or return; + print {$fh} "$line\n" or die $ERRNO; + close $fh or die $ERRNO; + return; +} + +sub load_history { + open my $fh, q{<}, $history_file or return; + + while ( my $line = <$fh> ) { + chomp $line; + $line =~ /\S/ or next; + $_rl->addhistory($line); + } + + close $fh or die $ERRNO; + return; +} + +my $rl_mode = 'terminal'; + +sub set_rl_mode { + my ($mode) = @_; + $rl_mode = $mode; + return; +} + +sub mal_readline { + my ($prompt) = @_; + my $line; + if ( !$_history_loaded ) { + $_history_loaded = 1; + load_history(); + } + + if ( $rl_mode eq 'terminal' ) { + $line = $_rl->readline($prompt); + } + else { + print $prompt or die $ERRNO; + $line = readline *STDIN; + } + if ($line) { + chomp $line; + if ($line) { + save_line($line); + } + } + return $line; +} + +1; diff --git a/impls/perl/Types.pm b/impls/perl/Types.pm new file mode 100644 index 0000000000..ce30054ada --- /dev/null +++ b/impls/perl/Types.pm @@ -0,0 +1,218 @@ +package Types; +use re '/msx'; +use strict; +use warnings; + +use Exporter 'import'; + +our @EXPORT_OK = qw(equal_q thaw_key + nil true false); + +## no critic (Modules::ProhibitMultiplePackages) + +# General functions + +sub equal_q { + my ( $a, $b ) = @_; + if ( $a->isa('Mal::Sequence') ) { + $b->isa('Mal::Sequence') or return 0; + scalar @{$a} == scalar @{$b} or return 0; + for ( 0 .. $#{$a} ) { + equal_q( $a->[$_], $b->[$_] ) or return 0; + } + return 1; + } + ref $b eq ref $a or return 0; + if ( $a->isa('Mal::HashMap') ) { + scalar keys %{$a} == scalar keys %{$b} or return 0; + while ( my ( $k, $v ) = each %{$a} ) { + equal_q( $v, $b->{$k} ) or return 0; + } + return 1; + } + return ${$a} eq ${$b}; +} + +# Superclass for all kinds of mal value + +{ + + package Mal::Type; +} + +# Scalars + +{ + + package Mal::Scalar; + use parent -norequire, 'Mal::Type'; + + # Overload stringification so that its result is something + # suitable for use as a hash-map key. The important thing here is + # that strings and keywords are distinct: support for other kinds + # of scalar is a bonus. + use overload + '""' => sub { my $self = shift; ref($self) . q{ } . ${$self} }, + fallback => 1; + + sub new { + my ( $class, $value ) = @_; + return bless \$value, $class; + } +} + +# This function converts hash-map keys back into full objects + +sub thaw_key { + my ($key) = @_; + my ( $class, $value ) = split m/[ ]/, $key, 2; + return $class->new($value); +} + +{ + + package Mal::Nil; + use parent -norequire, 'Mal::Scalar'; + + # Allow nil to be treated as an empty list or hash-map. + use overload '@{}' => sub { [] }, '%{}' => sub { {} }, fallback => 1; + +} +{ + + package Mal::True; + use parent -norequire, 'Mal::Scalar'; +} +{ + + package Mal::False; + use parent -norequire, 'Mal::Scalar'; +} + +my $nil = Mal::Nil->new('nil'); +my $true = Mal::True->new('true'); +my $false = Mal::False->new('false'); +sub nil { return $nil; } +sub true { return $true; } +sub false { return $false; } + +{ + + package Mal::Integer; + use parent -norequire, 'Mal::Scalar'; +} + +{ + + package Mal::Symbol; + use parent -norequire, 'Mal::Scalar'; +} + +{ + + package Mal::String; + use parent -norequire, 'Mal::Scalar'; +} + +{ + + package Mal::Keyword; + use parent -norequire, 'Mal::Scalar'; +} + +# Sequences + +{ + + package Mal::Sequence; + use parent -norequire, 'Mal::Type'; + + sub new { + my ( $class, $data ) = @_; + return bless $data, $class; + } + + sub clone { + my $self = shift; + return ref($self)->new( [ @{$self} ] ); + } +} + +# Lists + +{ + + package Mal::List; + use parent -norequire, 'Mal::Sequence'; +} + +# Vectors + +{ + + package Mal::Vector; + use parent -norequire, 'Mal::Sequence'; +} + +# Hash-maps + +{ + + package Mal::HashMap; + use parent -norequire, 'Mal::Type'; + + sub new { + my ( $class, $src ) = @_; + return bless $src, $class; + } + + sub clone { + my $self = shift; + return ref($self)->new( { %{$self} } ); + } +} + +# Functions + +{ + + package Mal::Callable; + use parent -norequire, 'Mal::Type'; + + sub new { + my ( $class, $data ) = @_; + return bless $data, $class; + } + + sub clone { + my $self = shift; + return bless sub { goto &{$self} }, ref $self; + } +} + +{ + + package Mal::Function; + use parent -norequire, 'Mal::Callable'; +} + +{ + + package Mal::Macro; + use parent -norequire, 'Mal::Callable'; +} + +# Atoms + +{ + + package Mal::Atom; + use parent -norequire, 'Mal::Type'; + + sub new { + my ( $class, $val ) = @_; + return bless \$val, $class; + } +} + +1; diff --git a/impls/perl/run b/impls/perl/run new file mode 100755 index 0000000000..4f255fe5fe --- /dev/null +++ b/impls/perl/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec perl $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" diff --git a/impls/perl/step0_repl.pl b/impls/perl/step0_repl.pl new file mode 100644 index 0000000000..2947178df3 --- /dev/null +++ b/impls/perl/step0_repl.pl @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; + +use Readline qw(mal_readline set_rl_mode); + +# read +sub READ { + my $str = shift; + return $str; +} + +# eval +sub EVAL { + my ($ast) = @_; + return $ast; +} + +# print +sub PRINT { + my $exp = shift; + return $exp; +} + +# repl +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str) ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} + +while ( defined( my $line = mal_readline('user> ') ) ) { + print REP($line), "\n" or die $ERRNO; +} diff --git a/impls/perl/step1_read_print.pl b/impls/perl/step1_read_print.pl new file mode 100644 index 0000000000..43f2d82fcf --- /dev/null +++ b/impls/perl/step1_read_print.pl @@ -0,0 +1,52 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; + +use Readline qw(mal_readline set_rl_mode); +use Reader qw(read_str); +use Printer qw(pr_str); + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval +sub EVAL { + my ($ast) = @_; + return $ast; +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str) ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} + +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step2_eval.pl b/impls/perl/step2_eval.pl new file mode 100644 index 0000000000..23bccdc69f --- /dev/null +++ b/impls/perl/step2_eval.pl @@ -0,0 +1,79 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairmap); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(); +use Reader qw(read_str); +use Printer qw(pr_str); + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval +sub EVAL { + my ( $ast, $env ) = @_; + + #print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + + if ( $ast->isa('Mal::Symbol') ) { + return $env->{ ${$ast} } // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + my $f = EVAL( $a0, $env ); + return $f->( map { EVAL( $_, $env ) } @args ); + } + return $ast; +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = { + q{+} => sub { Mal::Integer->new( ${ $_[0] } + ${ $_[1] } ) }, + q{-} => sub { Mal::Integer->new( ${ $_[0] } - ${ $_[1] } ) }, + q{*} => sub { Mal::Integer->new( ${ $_[0] } * ${ $_[1] } ) }, + q{/} => sub { Mal::Integer->new( ${ $_[0] } / ${ $_[1] } ) }, +}; + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} + +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step3_env.pl b/impls/perl/step3_env.pl new file mode 100644 index 0000000000..9b09031d8a --- /dev/null +++ b/impls/perl/step3_env.pl @@ -0,0 +1,109 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + return $sf->( $env, @args ); + } + my $f = EVAL( $a0, $env ); + return $f->( map { EVAL( $_, $env ) } @args ); + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + return EVAL( $body, $let_env ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); +$repl_env->set( q{+}, sub { Mal::Integer->new( ${ $_[0] } + ${ $_[1] } ) } ); +$repl_env->set( q{-}, sub { Mal::Integer->new( ${ $_[0] } - ${ $_[1] } ) } ); +$repl_env->set( q{*}, sub { Mal::Integer->new( ${ $_[0] } * ${ $_[1] } ) } ); +$repl_env->set( q{/}, sub { Mal::Integer->new( ${ $_[0] } / ${ $_[1] } ) } ); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} + +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step4_if_fn_do.pl b/impls/perl/step4_if_fn_do.pl new file mode 100644 index 0000000000..df4b825302 --- /dev/null +++ b/impls/perl/step4_if_fn_do.pl @@ -0,0 +1,148 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; +use Core qw(%NS); + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, + + 'do' => \&special_do, + 'if' => \&special_if, + 'fn*' => \&special_fn, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + return $sf->( $env, @args ); + } + my $f = EVAL( $a0, $env ); + return $f->( map { EVAL( $_, $env ) } @args ); + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + return EVAL( $body, $let_env ); +} + +sub special_do { + my ( $env, @todo ) = @_; + my $final = pop @todo; + for (@todo) { + EVAL( $_, $env ); + } + return EVAL( $final, $env ); +} + +sub special_if { + my ( $env, $if, $then, $else ) = @_; + my $cond = EVAL( $if, $env ); + if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { + return EVAL( $then, $env ); + } + if ($else) { + return EVAL( $else, $env ); + } + return nil; +} + +sub special_fn { + my ( $env, $params, $body ) = @_; + return Mal::Function->new( + sub { + return EVAL( $body, Env->new( $env, $params, \@_ ) ); + } + ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} + +# core.pl: defined using perl +while ( my ( $k, $v ) = each %NS ) { + $repl_env->set( $k, Mal::Function->new($v) ); +} + +# core.mal: defined using the language itself +REP(q[(def! not (fn* (a) (if a false true)))]); + +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step5_tco.pl b/impls/perl/step5_tco.pl new file mode 100644 index 0000000000..7d2460de36 --- /dev/null +++ b/impls/perl/step5_tco.pl @@ -0,0 +1,158 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'recursion'; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; +use Core qw(%NS); + +# False positives because of TCO. +## no critic (Subroutines::RequireArgUnpacking) + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, + + 'do' => \&special_do, + 'if' => \&special_if, + 'fn*' => \&special_fn, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + @_ = ( $env, @args ); + goto &{$sf}; + } + my $f = EVAL( $a0, $env ); + @_ = map { EVAL( $_, $env ) } @args; + goto &{$f}; + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + @_ = ( $body, $let_env ); + goto &EVAL; +} + +sub special_do { + my ( $env, @todo ) = @_; + my $final = pop @todo; + for (@todo) { + EVAL( $_, $env ); + } + @_ = ( $final, $env ); + goto &EVAL; +} + +sub special_if { + my ( $env, $if, $then, $else ) = @_; + my $cond = EVAL( $if, $env ); + if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { + @_ = ( $then, $env ); + goto &EVAL; + } + if ($else) { + @_ = ( $else, $env ); + goto &EVAL; + } + return nil; +} + +sub special_fn { + my ( $env, $params, $body ) = @_; + return Mal::Function->new( + sub { + @_ = ( $body, Env->new( $env, $params, \@_ ) ); + goto &EVAL; + } + ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} + +# core.pl: defined using perl +while ( my ( $k, $v ) = each %NS ) { + $repl_env->set( $k, Mal::Function->new($v) ); +} + +# core.mal: defined using the language itself +REP(q[(def! not (fn* (a) (if a false true)))]); + +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step6_file.pl b/impls/perl/step6_file.pl new file mode 100644 index 0000000000..e0eca83ec5 --- /dev/null +++ b/impls/perl/step6_file.pl @@ -0,0 +1,170 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'recursion'; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; +use Core qw(%NS); + +# False positives because of TCO. +## no critic (Subroutines::RequireArgUnpacking) + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, + + 'do' => \&special_do, + 'if' => \&special_if, + 'fn*' => \&special_fn, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + @_ = ( $env, @args ); + goto &{$sf}; + } + my $f = EVAL( $a0, $env ); + @_ = map { EVAL( $_, $env ) } @args; + goto &{$f}; + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + @_ = ( $body, $let_env ); + goto &EVAL; +} + +sub special_do { + my ( $env, @todo ) = @_; + my $final = pop @todo; + for (@todo) { + EVAL( $_, $env ); + } + @_ = ( $final, $env ); + goto &EVAL; +} + +sub special_if { + my ( $env, $if, $then, $else ) = @_; + my $cond = EVAL( $if, $env ); + if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { + @_ = ( $then, $env ); + goto &EVAL; + } + if ($else) { + @_ = ( $else, $env ); + goto &EVAL; + } + return nil; +} + +sub special_fn { + my ( $env, $params, $body ) = @_; + return Mal::Function->new( + sub { + @_ = ( $body, Env->new( $env, $params, \@_ ) ); + goto &EVAL; + } + ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} +my $script_file = shift @ARGV; + +# core.pl: defined using perl +while ( my ( $k, $v ) = each %NS ) { + $repl_env->set( $k, Mal::Function->new($v) ); +} +$repl_env->set( 'eval', + Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); +$repl_env->set( '*ARGV*', + Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); + +# core.mal: defined using the language itself +REP(q[(def! not (fn* (a) (if a false true)))]); +REP(<<'EOF'); +(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +EOF + +if ( defined $script_file ) { + REP(qq[(load-file "$script_file")]); + exit 0; +} +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step7_quote.pl b/impls/perl/step7_quote.pl new file mode 100644 index 0000000000..ceee9c894f --- /dev/null +++ b/impls/perl/step7_quote.pl @@ -0,0 +1,223 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'recursion'; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; +use Core qw(%NS); + +# False positives because of TCO. +## no critic (Subroutines::RequireArgUnpacking) + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval +sub starts_with { + my ( $ast, $sym ) = @_; + return @{$ast} && $ast->[0]->isa('Mal::Symbol') && ${ $ast->[0] } eq $sym; +} + +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new( [] ); + foreach my $elt ( reverse @{$ast} ) { + if ( $elt->isa('Mal::List') and starts_with( $elt, 'splice-unquote' ) ) + { + $res = + Mal::List->new( [ Mal::Symbol->new('concat'), $elt->[1], $res ] ); + } + else { + $res = Mal::List->new( + [ Mal::Symbol->new('cons'), quasiquote($elt), $res ] ); + } + } + return $res; +} + +sub quasiquote { + my ($ast) = @_; + if ( $ast->isa('Mal::Vector') ) { + return Mal::List->new( + [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); + } + if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { + return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); + } + if ( $ast->isa('Mal::List') ) { + if ( starts_with( $ast, 'unquote' ) ) { + return $ast->[1]; + } + return quasiquote_loop($ast); + } + return $ast; +} + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, + + 'do' => \&special_do, + 'if' => \&special_if, + 'fn*' => \&special_fn, + + 'quasiquote' => \&special_quasiquote, + 'quote' => \&special_quote, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + @_ = ( $env, @args ); + goto &{$sf}; + } + my $f = EVAL( $a0, $env ); + @_ = map { EVAL( $_, $env ) } @args; + goto &{$f}; + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + @_ = ( $body, $let_env ); + goto &EVAL; +} + +sub special_quote { + my ( $env, $quoted ) = @_; + return $quoted; +} + +sub special_quasiquote { + my ( $env, $quoted ) = @_; + @_ = ( quasiquote($quoted), $env ); + goto &EVAL; +} + +sub special_do { + my ( $env, @todo ) = @_; + my $final = pop @todo; + for (@todo) { + EVAL( $_, $env ); + } + @_ = ( $final, $env ); + goto &EVAL; +} + +sub special_if { + my ( $env, $if, $then, $else ) = @_; + my $cond = EVAL( $if, $env ); + if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { + @_ = ( $then, $env ); + goto &EVAL; + } + if ($else) { + @_ = ( $else, $env ); + goto &EVAL; + } + return nil; +} + +sub special_fn { + my ( $env, $params, $body ) = @_; + return Mal::Function->new( + sub { + @_ = ( $body, Env->new( $env, $params, \@_ ) ); + goto &EVAL; + } + ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} +my $script_file = shift @ARGV; + +# core.pl: defined using perl +while ( my ( $k, $v ) = each %NS ) { + $repl_env->set( $k, Mal::Function->new($v) ); +} +$repl_env->set( 'eval', + Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); +$repl_env->set( '*ARGV*', + Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); + +# core.mal: defined using the language itself +REP(q[(def! not (fn* (a) (if a false true)))]); +REP(<<'EOF'); +(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +EOF + +if ( defined $script_file ) { + REP(qq[(load-file "$script_file")]); + exit 0; +} +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step8_macros.pl b/impls/perl/step8_macros.pl new file mode 100644 index 0000000000..aee1bb8274 --- /dev/null +++ b/impls/perl/step8_macros.pl @@ -0,0 +1,239 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'recursion'; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; +use Core qw(%NS); + +# False positives because of TCO. +## no critic (Subroutines::RequireArgUnpacking) + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval +sub starts_with { + my ( $ast, $sym ) = @_; + return @{$ast} && $ast->[0]->isa('Mal::Symbol') && ${ $ast->[0] } eq $sym; +} + +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new( [] ); + foreach my $elt ( reverse @{$ast} ) { + if ( $elt->isa('Mal::List') and starts_with( $elt, 'splice-unquote' ) ) + { + $res = + Mal::List->new( [ Mal::Symbol->new('concat'), $elt->[1], $res ] ); + } + else { + $res = Mal::List->new( + [ Mal::Symbol->new('cons'), quasiquote($elt), $res ] ); + } + } + return $res; +} + +sub quasiquote { + my ($ast) = @_; + if ( $ast->isa('Mal::Vector') ) { + return Mal::List->new( + [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); + } + if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { + return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); + } + if ( $ast->isa('Mal::List') ) { + if ( starts_with( $ast, 'unquote' ) ) { + return $ast->[1]; + } + return quasiquote_loop($ast); + } + return $ast; +} + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, + + 'do' => \&special_do, + 'if' => \&special_if, + 'fn*' => \&special_fn, + + 'quasiquote' => \&special_quasiquote, + 'quote' => \&special_quote, + + 'defmacro!' => \&special_defmacro, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + @_ = ( $env, @args ); + goto &{$sf}; + } + my $f = EVAL( $a0, $env ); + if ( $f->isa('Mal::Macro') ) { + @_ = ( $f->(@args), $env ); + goto &EVAL; + } + @_ = map { EVAL( $_, $env ) } @args; + goto &{$f}; + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + @_ = ( $body, $let_env ); + goto &EVAL; +} + +sub special_quote { + my ( $env, $quoted ) = @_; + return $quoted; +} + +sub special_quasiquote { + my ( $env, $quoted ) = @_; + @_ = ( quasiquote($quoted), $env ); + goto &EVAL; +} + +sub special_defmacro { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, Mal::Macro->new( EVAL( $val, $env )->clone ) ); +} + +sub special_do { + my ( $env, @todo ) = @_; + my $final = pop @todo; + for (@todo) { + EVAL( $_, $env ); + } + @_ = ( $final, $env ); + goto &EVAL; +} + +sub special_if { + my ( $env, $if, $then, $else ) = @_; + my $cond = EVAL( $if, $env ); + if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { + @_ = ( $then, $env ); + goto &EVAL; + } + if ($else) { + @_ = ( $else, $env ); + goto &EVAL; + } + return nil; +} + +sub special_fn { + my ( $env, $params, $body ) = @_; + return Mal::Function->new( + sub { + @_ = ( $body, Env->new( $env, $params, \@_ ) ); + goto &EVAL; + } + ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} +my $script_file = shift @ARGV; + +# core.pl: defined using perl +while ( my ( $k, $v ) = each %NS ) { + $repl_env->set( $k, Mal::Function->new($v) ); +} +$repl_env->set( 'eval', + Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); +$repl_env->set( '*ARGV*', + Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); + +# core.mal: defined using the language itself +REP(q[(def! not (fn* (a) (if a false true)))]); +REP(<<'EOF'); +(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +EOF +REP(<<'EOF'); +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) +(if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) +(cons 'cond (rest (rest xs))))))) +EOF + +if ( defined $script_file ) { + REP(qq[(load-file "$script_file")]); + exit 0; +} +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/step9_try.pl b/impls/perl/step9_try.pl new file mode 100644 index 0000000000..3612fba99d --- /dev/null +++ b/impls/perl/step9_try.pl @@ -0,0 +1,265 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'recursion'; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); +use Scalar::Util qw(blessed); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; +use Core qw(%NS); + +# False positives because of TCO. +## no critic (Subroutines::RequireArgUnpacking) + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval +sub starts_with { + my ( $ast, $sym ) = @_; + return @{$ast} && $ast->[0]->isa('Mal::Symbol') && ${ $ast->[0] } eq $sym; +} + +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new( [] ); + foreach my $elt ( reverse @{$ast} ) { + if ( $elt->isa('Mal::List') and starts_with( $elt, 'splice-unquote' ) ) + { + $res = + Mal::List->new( [ Mal::Symbol->new('concat'), $elt->[1], $res ] ); + } + else { + $res = Mal::List->new( + [ Mal::Symbol->new('cons'), quasiquote($elt), $res ] ); + } + } + return $res; +} + +sub quasiquote { + my ($ast) = @_; + if ( $ast->isa('Mal::Vector') ) { + return Mal::List->new( + [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); + } + if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { + return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); + } + if ( $ast->isa('Mal::List') ) { + if ( starts_with( $ast, 'unquote' ) ) { + return $ast->[1]; + } + return quasiquote_loop($ast); + } + return $ast; +} + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, + + 'do' => \&special_do, + 'if' => \&special_if, + 'fn*' => \&special_fn, + + 'quasiquote' => \&special_quasiquote, + 'quote' => \&special_quote, + + 'defmacro!' => \&special_defmacro, + + 'try*' => \&special_try, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + @_ = ( $env, @args ); + goto &{$sf}; + } + my $f = EVAL( $a0, $env ); + if ( $f->isa('Mal::Macro') ) { + @_ = ( $f->(@args), $env ); + goto &EVAL; + } + @_ = map { EVAL( $_, $env ) } @args; + goto &{$f}; + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + @_ = ( $body, $let_env ); + goto &EVAL; +} + +sub special_quote { + my ( $env, $quoted ) = @_; + return $quoted; +} + +sub special_quasiquote { + my ( $env, $quoted ) = @_; + @_ = ( quasiquote($quoted), $env ); + goto &EVAL; +} + +sub special_defmacro { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, Mal::Macro->new( EVAL( $val, $env )->clone ) ); +} + +sub special_try { + my ( $env, $try, $catch ) = @_; + if ($catch) { + my ( undef, $binding, $body ) = @{$catch}; + if ( my $ret = eval { EVAL( $try, $env ) } ) { + return $ret; + } + my $exc = $EVAL_ERROR; + if ( not blessed($exc) or not $exc->isa('Mal::Type') ) { + chomp $exc; + $exc = Mal::String->new($exc); + } + my $catch_env = Env->new( $env, [$binding], [$exc] ); + @_ = ( $body, $catch_env ); + goto &EVAL; + } + @_ = ( $try, $env ); + goto &EVAL; +} + +sub special_do { + my ( $env, @todo ) = @_; + my $final = pop @todo; + for (@todo) { + EVAL( $_, $env ); + } + @_ = ( $final, $env ); + goto &EVAL; +} + +sub special_if { + my ( $env, $if, $then, $else ) = @_; + my $cond = EVAL( $if, $env ); + if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { + @_ = ( $then, $env ); + goto &EVAL; + } + if ($else) { + @_ = ( $else, $env ); + goto &EVAL; + } + return nil; +} + +sub special_fn { + my ( $env, $params, $body ) = @_; + return Mal::Function->new( + sub { + @_ = ( $body, Env->new( $env, $params, \@_ ) ); + goto &EVAL; + } + ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} +my $script_file = shift @ARGV; + +# core.pl: defined using perl +while ( my ( $k, $v ) = each %NS ) { + $repl_env->set( $k, Mal::Function->new($v) ); +} +$repl_env->set( 'eval', + Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); +$repl_env->set( '*ARGV*', + Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); + +# core.mal: defined using the language itself +REP(q[(def! not (fn* (a) (if a false true)))]); +REP(<<'EOF'); +(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +EOF +REP(<<'EOF'); +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) +(if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) +(cons 'cond (rest (rest xs))))))) +EOF + +if ( defined $script_file ) { + REP(qq[(load-file "$script_file")]); + exit 0; +} +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + if ( defined blessed($err) and $err->isa('Mal::Type') ) { + $err = pr_str($err) . "\n"; + } + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/stepA_mal.pl b/impls/perl/stepA_mal.pl new file mode 100644 index 0000000000..e48046d504 --- /dev/null +++ b/impls/perl/stepA_mal.pl @@ -0,0 +1,267 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'recursion'; +use File::Basename 'dirname'; +use lib dirname(__FILE__); + +use English '-no_match_vars'; +use List::Util qw(pairs pairmap); +use Scalar::Util qw(blessed); + +use Readline qw(mal_readline set_rl_mode); +use Types qw(nil false); +use Reader qw(read_str); +use Printer qw(pr_str); +use Env; +use Core qw(%NS); + +# False positives because of TCO. +## no critic (Subroutines::RequireArgUnpacking) + +# read +sub READ { + my $str = shift; + return read_str($str); +} + +# eval +sub starts_with { + my ( $ast, $sym ) = @_; + return @{$ast} && $ast->[0]->isa('Mal::Symbol') && ${ $ast->[0] } eq $sym; +} + +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new( [] ); + foreach my $elt ( reverse @{$ast} ) { + if ( $elt->isa('Mal::List') and starts_with( $elt, 'splice-unquote' ) ) + { + $res = + Mal::List->new( [ Mal::Symbol->new('concat'), $elt->[1], $res ] ); + } + else { + $res = Mal::List->new( + [ Mal::Symbol->new('cons'), quasiquote($elt), $res ] ); + } + } + return $res; +} + +sub quasiquote { + my ($ast) = @_; + if ( $ast->isa('Mal::Vector') ) { + return Mal::List->new( + [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); + } + if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { + return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); + } + if ( $ast->isa('Mal::List') ) { + if ( starts_with( $ast, 'unquote' ) ) { + return $ast->[1]; + } + return quasiquote_loop($ast); + } + return $ast; +} + +my %special_forms = ( + 'def!' => \&special_def, + 'let*' => \&special_let, + + 'do' => \&special_do, + 'if' => \&special_if, + 'fn*' => \&special_fn, + + 'quasiquote' => \&special_quasiquote, + 'quote' => \&special_quote, + + 'defmacro!' => \&special_defmacro, + + 'try*' => \&special_try, +); + +sub EVAL { + my ( $ast, $env ) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ( $dbgeval + and not $dbgeval->isa('Mal::Nil') + and not $dbgeval->isa('Mal::False') ) + { + print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; + } + + if ( $ast->isa('Mal::Symbol') ) { + return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; + } + if ( $ast->isa('Mal::Vector') ) { + return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); + } + if ( $ast->isa('Mal::HashMap') ) { + return Mal::HashMap->new( + { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); + } + if ( $ast->isa('Mal::List') and @{$ast} ) { + my ( $a0, @args ) = @{$ast}; + if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { + @_ = ( $env, @args ); + goto &{$sf}; + } + my $f = EVAL( $a0, $env ); + if ( $f->isa('Mal::Macro') ) { + @_ = ( $f->(@args), $env ); + goto &EVAL; + } + @_ = map { EVAL( $_, $env ) } @args; + goto &{$f}; + } + return $ast; +} + +sub special_def { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, EVAL( $val, $env ) ); +} + +sub special_let { + my ( $env, $bindings, $body ) = @_; + my $let_env = Env->new($env); + foreach my $pair ( pairs @{$bindings} ) { + my ( $k, $v ) = @{$pair}; + $let_env->set( ${$k}, EVAL( $v, $let_env ) ); + } + @_ = ( $body, $let_env ); + goto &EVAL; +} + +sub special_quote { + my ( $env, $quoted ) = @_; + return $quoted; +} + +sub special_quasiquote { + my ( $env, $quoted ) = @_; + @_ = ( quasiquote($quoted), $env ); + goto &EVAL; +} + +sub special_defmacro { + my ( $env, $sym, $val ) = @_; + return $env->set( ${$sym}, Mal::Macro->new( EVAL( $val, $env )->clone ) ); +} + +sub special_try { + my ( $env, $try, $catch ) = @_; + if ($catch) { + my ( undef, $binding, $body ) = @{$catch}; + if ( my $ret = eval { EVAL( $try, $env ) } ) { + return $ret; + } + my $exc = $EVAL_ERROR; + if ( not blessed($exc) or not $exc->isa('Mal::Type') ) { + chomp $exc; + $exc = Mal::String->new($exc); + } + my $catch_env = Env->new( $env, [$binding], [$exc] ); + @_ = ( $body, $catch_env ); + goto &EVAL; + } + @_ = ( $try, $env ); + goto &EVAL; +} + +sub special_do { + my ( $env, @todo ) = @_; + my $final = pop @todo; + for (@todo) { + EVAL( $_, $env ); + } + @_ = ( $final, $env ); + goto &EVAL; +} + +sub special_if { + my ( $env, $if, $then, $else ) = @_; + my $cond = EVAL( $if, $env ); + if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { + @_ = ( $then, $env ); + goto &EVAL; + } + if ($else) { + @_ = ( $else, $env ); + goto &EVAL; + } + return nil; +} + +sub special_fn { + my ( $env, $params, $body ) = @_; + return Mal::Function->new( + sub { + @_ = ( $body, Env->new( $env, $params, \@_ ) ); + goto &EVAL; + } + ); +} + +# print +sub PRINT { + my $exp = shift; + return pr_str($exp); +} + +# repl +my $repl_env = Env->new(); + +sub REP { + my $str = shift; + return PRINT( EVAL( READ($str), $repl_env ) ); +} + +# Command line arguments +if ( $ARGV[0] eq '--raw' ) { + set_rl_mode('raw'); + shift @ARGV; +} +my $script_file = shift @ARGV; + +# core.pl: defined using perl +while ( my ( $k, $v ) = each %NS ) { + $repl_env->set( $k, Mal::Function->new($v) ); +} +$repl_env->set( 'eval', + Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); +$repl_env->set( '*ARGV*', + Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); + +# core.mal: defined using the language itself +REP(q[(def! *host-language* "perl")]); +REP(q[(def! not (fn* (a) (if a false true)))]); +REP(<<'EOF'); +(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) +EOF +REP(<<'EOF'); +(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) +(if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) +(cons 'cond (rest (rest xs))))))) +EOF + +if ( defined $script_file ) { + REP(qq[(load-file "$script_file")]); + exit 0; +} +REP(q[(println (str "Mal [" *host-language* "]"))]); +while ( defined( my $line = mal_readline('user> ') ) ) { + eval { + print REP($line), "\n" or die $ERRNO; + 1; + } or do { + my $err = $EVAL_ERROR; + if ( defined blessed($err) and $err->isa('Mal::Type') ) { + $err = pr_str($err) . "\n"; + } + print 'Error: ', $err or die $ERRNO; + }; +} diff --git a/impls/perl/tests/step5_tco.mal b/impls/perl/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/perl/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/perl/tests/stepA_mal.mal b/impls/perl/tests/stepA_mal.mal new file mode 100644 index 0000000000..4d2b80c541 --- /dev/null +++ b/impls/perl/tests/stepA_mal.mal @@ -0,0 +1,30 @@ +;; Testing types returned from pl* + +(pl* "123") +;=>123 + +(pl* "\"abc\"") +;=>"abc" + +(pl* "{'abc'=>123}") +;=>{"abc" 123} + +(pl* "['abc', 123]") +;=>("abc" 123) + +(pl* "2+3") +;=>5 + +(pl* "undef") +;=>nil + +;; Testing eval of print statement + +(pl* "print 'hello\n';") +;/hello +;=>1 + +;; Testing exceptions passing through pl* + +(try* (pl* "die \"pop!\\n\"") (catch* e e)) +;=>"pop!" diff --git a/impls/perl6/Dockerfile b/impls/perl6/Dockerfile new file mode 100644 index 0000000000..d77ab0de62 --- /dev/null +++ b/impls/perl6/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Perl6 build deps +RUN apt-get -y install rakudo diff --git a/impls/perl6/Makefile b/impls/perl6/Makefile new file mode 100644 index 0000000000..d2e469ecd4 --- /dev/null +++ b/impls/perl6/Makefile @@ -0,0 +1,4 @@ +all: + @true + +clean: diff --git a/impls/perl6/core.pm b/impls/perl6/core.pm new file mode 100644 index 0000000000..f5cc5d1cc4 --- /dev/null +++ b/impls/perl6/core.pm @@ -0,0 +1,105 @@ +unit module core; +use types; +use printer; +use reader; + +sub equal ($a, $b) { + if $a ~~ MalSequence && $b ~~ MalSequence { + return $FALSE if $a.elems != $b.elems; + for |$a Z |$b -> ($a_el, $b_el) { + return $FALSE if equal($a_el, $b_el) ~~ $FALSE; + } + return $TRUE; + } + elsif $a ~~ MalHashMap && $b ~~ MalHashMap { + return $FALSE if $a.elems != $b.elems; + for $a.pairs { + return $FALSE if !$b{.key} || equal(.value, $b{.key}) ~~ $FALSE; + } + return $TRUE; + } + else { + return $a.^name eq $b.^name && $a.val ~~ $b.val ?? $TRUE !! $FALSE; + } +} + +sub perl6-eval ($code) { + my &convert = -> $data { + given $data { + when Array|List { MalList($_.map({&convert($_)}).Array) } + when Hash { MalHashMap($_.map({.key => &convert(.value)}).Hash) } + when Bool { $_ ?? $TRUE !! $FALSE } + when Int { MalNumber($_) } + when Nil { $NIL } + default { $_.^name eq 'Any' ?? $NIL !! MalString($_.gist) } + } + }; + + use MONKEY-SEE-NO-EVAL; + return &convert(EVAL($code)); +} + +our %ns = ( + '+' => MalCode({ MalNumber($^a.val + $^b.val) }), + '-' => MalCode({ MalNumber($^a.val - $^b.val) }), + '*' => MalCode({ MalNumber($^a.val * $^b.val) }), + '/' => MalCode({ MalNumber(($^a.val / $^b.val).Int) }), + '<' => MalCode({ $^a.val < $^b.val ?? $TRUE !! $FALSE }), + '<=' => MalCode({ $^a.val <= $^b.val ?? $TRUE !! $FALSE }), + '>' => MalCode({ $^a.val > $^b.val ?? $TRUE !! $FALSE }), + '>=' => MalCode({ $^a.val >= $^b.val ?? $TRUE !! $FALSE }), + '=' => MalCode({ equal($^a, $^b) }), + prn => MalCode({ say @_.map({ pr_str($_, True) }).join(' '); $NIL }), + println => MalCode({ say @_.map({ pr_str($_) }).join(' '); $NIL }), + pr-str => MalCode({ MalString(@_.map({ pr_str($_, True) }).join(' ') ) }), + str => MalCode({ MalString(@_.map({ pr_str($_) }).join) }), + read-string => MalCode({ read_str($^a.val) }), + slurp => MalCode({ MalString($^a.val.IO.slurp) }), + list => MalCode({ MalList(@_) }), + 'list?' => MalCode({ $^a ~~ MalList ?? $TRUE !! $FALSE }), + 'empty?' => MalCode({ $^a.elems ?? $FALSE !! $TRUE }), + count => MalCode({ MalNumber($^a ~~ $NIL ?? 0 !! $^a.elems) }), + atom => MalCode({ MalAtom($^a) }), + 'atom?' => MalCode({ $^a ~~ MalAtom ?? $TRUE !! $FALSE }), + deref => MalCode({ $^a.val }), + 'reset!' => MalCode({ $^a.val = $^b }), + 'swap!' => MalCode(-> $atom, $func, *@args { $atom.val = $func.apply($atom.val, |@args) }), + cons => MalCode({ MalList([$^a, |$^b.val]) }), + concat => MalCode({ MalList([@_.map({|$_.val})]) }), + vec => MalCode({ MalVector([|$^a.val]) }), + nth => MalCode({ $^a[$^b.val] // die X::MalOutOfRange.new }), + first => MalCode({ $^a[0] // $NIL }), + rest => MalCode({ MalList([$^a[1..*]]) }), + throw => MalCode({ die X::MalThrow.new(value => $^a) }), + apply => MalCode(-> $func, *@args { $func.apply(|@args[0..*-2], |@args[*-1].val) }), + map => MalCode(-> $func, $list { MalList([$list.map({ $func.apply($_) })]) }), + 'nil?' => MalCode({ $^a ~~ MalNil ?? $TRUE !! $FALSE }), + 'true?' => MalCode({ $^a ~~ MalTrue ?? $TRUE !! $FALSE }), + 'false?' => MalCode({ $^a ~~ MalFalse ?? $TRUE !! $FALSE }), + 'symbol?' => MalCode({ $^a ~~ MalSymbol ?? $TRUE !! $FALSE }), + symbol => MalCode({ MalSymbol($^a.val) }), + keyword => MalCode({ $^a.val ~~ /^\x29E/ ?? $^a !! MalString("\x29E" ~ $^a.val) }), + 'keyword?' => MalCode({ $^a.val ~~ /^\x29E/ ?? $TRUE !! $FALSE }), + 'number?' => MalCode({ $^a ~~ MalNumber ?? $TRUE !! $FALSE }), + 'fn?' => MalCode({ ($^a ~~ MalCallable && !$^a.?is_macro) ?? $TRUE !! $FALSE }), + 'macro?' => MalCode({ $^a.?is_macro ?? $TRUE !! $FALSE }), + vector => MalCode({ MalVector(@_) }), + 'vector?' => MalCode({ $^a ~~ MalVector ?? $TRUE !! $FALSE }), + hash-map => MalCode({ MalHashMap(@_.map({ $^a.val => $^b }).Hash) }), + 'map?' => MalCode({ $^a ~~ MalHashMap ?? $TRUE !! $FALSE }), + assoc => MalCode(-> $map, *@kv { MalHashMap(Hash.new(|$map.kv, |@kv.map({$^a.val, $^b}))) }), + dissoc => MalCode(-> $map, *@keys { my %h = $map.val.clone; %h{@keys.map(*.val)}:delete; MalHashMap(%h) }), + get => MalCode({ $^a.val{$^b.val} // $NIL }), + 'contains?' => MalCode({ $^a.val{$^b.val}:exists ?? $TRUE !! $FALSE }), + keys => MalCode({ MalList([$^a.keys.map({ MalString($_) })]) }), + vals => MalCode({ MalList([$^a.values]) }), + 'sequential?' => MalCode({ $^a ~~ MalList|MalVector ?? $TRUE !! $FALSE }), + readline => MalCode({ with prompt($^a.val) { MalString($_) } else { $NIL } }), + time-ms => MalCode({ MalNumber((now * 1000).Int) }), + conj => MalCode(-> $seq, *@args { $seq.conj(@args) }), + 'string?' => MalCode({ $^a ~~ MalString && $^a.val !~~ /^\x29E/ ?? $TRUE !! $FALSE }), + seq => MalCode({ $^a.seq }), + with-meta => MalCode({ return $NIL if !$^a.can('meta'); my $x = $^a.clone; $x.meta = $^b; $x }), + meta => MalCode({ $^a.?meta // $NIL }), + perl6-eval => MalCode({ perl6-eval($^a.val) }), +); diff --git a/impls/perl6/env.pm b/impls/perl6/env.pm new file mode 100644 index 0000000000..533e915f81 --- /dev/null +++ b/impls/perl6/env.pm @@ -0,0 +1,33 @@ +unit class MalEnv; +use types; + +has $.outer; +has %.data; +has @.binds; +has @.exprs; + +method new ($outer?, @binds?, @exprs?) { + self.bless(:$outer, :@binds, :@exprs); +} + +submethod BUILD (:@!binds, :@!exprs, :$!outer, :%!data) { + for @!binds.kv -> $idx, $key { + if $key eq '&' { + my $value = MalList([@!exprs[$idx..*]]); + self.set(@!binds[$idx+1], $value); + last; + } + my $value = @!exprs[$idx]; + self.set($key, $value); + } +} + +method set ($key, $value) { + %.data{$key} = $value; +} + +method get ($key) { + return %.data{$key} if %.data{$key}; + return $.outer.get($key) if $.outer; + return 0; +} diff --git a/impls/perl6/printer.pm b/impls/perl6/printer.pm new file mode 100644 index 0000000000..0872f860a3 --- /dev/null +++ b/impls/perl6/printer.pm @@ -0,0 +1,29 @@ +unit module printer; +use types; + +sub pr_str ($exp, $print_readably = False) is export { + given $exp { + when MalFunction { "#" } + when MalCode { "#" } + when MalList { + '(' ~ join(' ', |$exp.map({ pr_str($_, $print_readably) })) ~ ')'; + } + when MalVector { + '[' ~ join(' ', |$exp.map({ pr_str($_, $print_readably) })) ~ ']'; + } + when MalHashMap { + '{' ~ $exp.kv.flatmap({ MalString($^a), $^b }).map({ pr_str($_, $print_readably) }) ~ '}' + } + when MalString { + my $str = $exp.val; + if $str ~~ s/^\x29E/:/ || !$print_readably { + $str; + } + else { + '"' ~ $str.trans(/\\/ => '\\\\', /\"/ => '\\"', /\n/ => '\\n') ~ '"'; + } + } + when MalAtom { "(atom {pr_str($exp.val, $print_readably)})" } + when MalValue { $exp.val } + } +} diff --git a/impls/perl6/reader.pm b/impls/perl6/reader.pm new file mode 100644 index 0000000000..70d83a3447 --- /dev/null +++ b/impls/perl6/reader.pm @@ -0,0 +1,87 @@ +unit module reader; +use types; + +class Reader { + has @.tokens; + has $!position = 0; + method peek { @.tokens[$!position] } + method next { @.tokens[$!position++] } +} + +sub read_form ($rdr) { + given $rdr.peek { + when "'" { $rdr.next; MalList([MalSymbol('quote'), read_form($rdr)]) } + when '`' { $rdr.next; MalList([MalSymbol('quasiquote'), read_form($rdr)]) } + when '~' { $rdr.next; MalList([MalSymbol('unquote'), read_form($rdr)]) } + when '~@' { $rdr.next; MalList([MalSymbol('splice-unquote'), read_form($rdr)]) } + when '@' { $rdr.next; MalList([MalSymbol('deref'), read_form($rdr)]) } + when '^' { + $rdr.next; + my $meta = read_form($rdr); + MalList([MalSymbol('with-meta'), read_form($rdr), $meta]); + } + when ')'|']'|'}' { die X::MalUnexpected.new(token => $_) } + when '(' { MalList(read_list($rdr, ')')) } + when '[' { MalVector(read_list($rdr, ']')) } + when '{' { MalHashMap(read_list($rdr, '}').map({ $^a.val => $^b }).Hash) } + default { read_atom($rdr) } + } +} + +sub read_list ($rdr, $end) { + my @list; + my $token = $rdr.next; + + loop { + $token = $rdr.peek; + die X::MalIncomplete.new(end => $end) if !$token.defined; + last if $token eq $end; + @list.push(read_form($rdr)); + } + $rdr.next; + + return @list; +} + +sub read_atom ($rdr) { + my $atom = $rdr.next; + given $atom { + when /^'"' [ \\. || <-[\"\\]> ]* '"'$/ { + s:g/^\"|\"$//; + MalString(.trans(/\\\"/ => '"', /\\n/ => "\n", /\\\\/ => '\\')); + } + when /^\"/ { + die X::MalIncomplete.new(end => '"'); + } + when /^\:(.*)/ { MalString("\x29E$0") } + when /^'-'? <[0..9]>+$/ { MalNumber($_) } + when 'nil' { $NIL } + when 'true' { $TRUE } + when 'false' { $FALSE } + default { MalSymbol($_) } + } +} + +my regex mal { + [ + <[\s,]>* # whitespace/commas + $=( + || '~@' # ~@ + || <[\[\]{}()'`~^@]> # special single-char tokens + || '"' [ \\. || <-[\"\\]> ]* '"'? # double-quoted strings + || ';'<-[\n]>* # comments + || <-[\s\[\]{}('"`,;)]>+ # symbols + ) + ]+ +} + +sub tokenizer ($str) { + return [] if !$str.match(/^/); + return grep { ! /^\;/ }, $.map({~$_}); +} + +sub read_str ($str) is export { + my @tokens = tokenizer($str); + die X::MalNoTokens.new if !@tokens; + return read_form(Reader.new(tokens => @tokens)); +} diff --git a/impls/perl6/run b/impls/perl6/run new file mode 100755 index 0000000000..80cb92b34b --- /dev/null +++ b/impls/perl6/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec perl6 $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" diff --git a/impls/perl6/step0_repl.pl b/impls/perl6/step0_repl.pl new file mode 100644 index 0000000000..b502b5835c --- /dev/null +++ b/impls/perl6/step0_repl.pl @@ -0,0 +1,27 @@ +use v6; +#use Linenoise; + +sub read ($str) { + return $str; +} + +sub eval ($ast) { + return $ast; +} + +sub print ($exp) { + return $exp; +} + +sub rep ($str) { + return print(eval(read($str))); +} + +sub MAIN { + #while (my $line = linenoise('user> ')).defined { + # say rep($line); + #} + while (my $line = prompt 'user> ').defined { + say rep($line); + } +} diff --git a/impls/perl6/step1_read_print.pl b/impls/perl6/step1_read_print.pl new file mode 100644 index 0000000000..f8f6deb46e --- /dev/null +++ b/impls/perl6/step1_read_print.pl @@ -0,0 +1,30 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; + +sub read ($str) { + return read_str($str); +} + +sub eval ($ast) { + return $ast; +} + +sub print ($exp) { + return pr_str($exp, True); +} + +sub rep ($str) { + return print(eval(read($str))); +} + +sub MAIN { + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step2_eval.pl b/impls/perl6/step2_eval.pl new file mode 100644 index 0000000000..d4cedad890 --- /dev/null +++ b/impls/perl6/step2_eval.pl @@ -0,0 +1,52 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; + +sub read ($str) { + return read_str($str); +} + +sub eval ($ast, $env) { + + # say "EVAL: " ~ print($ast); + + given $ast { + when MalSymbol { return $env{$ast.val} || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($func, @args) = $ast.map({ eval($_, $env) }); + my $arglist = MalList(@args); + return $func.apply($arglist); +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN { + $repl_env<+> = MalCode({ MalNumber($^a[0].val + $^a[1].val) }); + $repl_env<-> = MalCode({ MalNumber($^a[0].val - $^a[1].val) }); + $repl_env<*> = MalCode({ MalNumber($^a[0].val * $^a[1].val) }); + $repl_env = MalCode({ MalNumber(($^a[0].val / $^a[1].val).Int) }); + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step3_env.pl b/impls/perl6/step3_env.pl new file mode 100644 index 0000000000..cb011b42f1 --- /dev/null +++ b/impls/perl6/step3_env.pl @@ -0,0 +1,67 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; + +sub read ($str) { + return read_str($str); +} + +sub eval ($ast, $env) { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + return eval($a2, $new_env); + } + default { + my ($func, @args) = $ast.map({ eval($_, $env) }); + return $func.apply(@args); + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN { + $repl_env.set('+', MalCode({ MalNumber($^a.val + $^b.val) })); + $repl_env.set('-', MalCode({ MalNumber($^a.val - $^b.val) })); + $repl_env.set('*', MalCode({ MalNumber($^a.val * $^b.val) })); + $repl_env.set('/', MalCode({ MalNumber(($^a.val / $^b.val).Int) })); + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step4_if_fn_do.pl b/impls/perl6/step4_if_fn_do.pl new file mode 100644 index 0000000000..b712de5951 --- /dev/null +++ b/impls/perl6/step4_if_fn_do.pl @@ -0,0 +1,81 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; +use core; + +sub read ($str) { + return read_str($str); +} + +sub eval ($ast, $env) { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + return eval($a2, $new_env); + } + when 'do' { + $ast[1..*-2].map({ eval($_, $env) }); + return eval($ast[*-1], $env); + } + when 'if' { + return eval($a1, $env) !~~ MalNil|MalFalse + ?? return eval($a2, $env) + !! return $a3 ?? eval($a3, $env) !! $NIL; + } + when 'fn*' { + return MalCode(-> *@args { + my @binds = $a1 ?? $a1.map(*.val) !! (); + eval($a2, MalEnv.new($env, @binds, @args)); + }); + } + default { + my ($func, @args) = $ast.map({ eval($_, $env) }); + return $func.apply(|@args); + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN { + $repl_env.set(.key, .value) for %core::ns; + rep(q{(def! not (fn* (a) (if a false true)))}); + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step5_tco.pl b/impls/perl6/step5_tco.pl new file mode 100644 index 0000000000..8c253faccb --- /dev/null +++ b/impls/perl6/step5_tco.pl @@ -0,0 +1,91 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; +use core; + +sub read ($str) { + return read_str($str); +} + +sub eval ($ast is copy, $env is copy) { + loop { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + $env = $new_env; + $ast = $a2; + } + when 'do' { + $ast[1..*-2].map({ eval($_, $env) }); + $ast = $ast[*-1]; + } + when 'if' { + if eval($a1, $env) ~~ MalNil|MalFalse { + return $NIL if $a3 ~~ $NIL; + $ast = $a3; + } + else { + $ast = $a2; + } + } + when 'fn*' { + my @binds = $a1 ?? $a1.map(*.val) !! (); + my &fn = -> *@args { + eval($a2, MalEnv.new($env, @binds, @args)); + }; + return MalFunction($a2, $env, @binds, &fn); + } + default { + my ($func, @args) = $ast.map({ eval($_, $env) }); + return $func.apply(|@args) if $func !~~ MalFunction; + $ast = $func.ast; + $env = MalEnv.new($func.env, $func.params, @args); + } + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN { + $repl_env.set(.key, .value) for %core::ns; + rep(q{(def! not (fn* (a) (if a false true)))}); + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step6_file.pl b/impls/perl6/step6_file.pl new file mode 100644 index 0000000000..7b22c1d3ba --- /dev/null +++ b/impls/perl6/step6_file.pl @@ -0,0 +1,99 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; +use core; + +sub read ($str) { + return read_str($str); +} + +sub eval ($ast is copy, $env is copy) { + loop { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + $env = $new_env; + $ast = $a2; + } + when 'do' { + $ast[1..*-2].map({ eval($_, $env) }); + $ast = $ast[*-1]; + } + when 'if' { + if eval($a1, $env) ~~ MalNil|MalFalse { + return $NIL if $a3 ~~ $NIL; + $ast = $a3; + } + else { + $ast = $a2; + } + } + when 'fn*' { + my @binds = $a1 ?? $a1.map(*.val) !! (); + my &fn = -> *@args { + eval($a2, MalEnv.new($env, @binds, @args)); + }; + return MalFunction($a2, $env, @binds, &fn); + } + default { + my ($func, @args) = $ast.map({ eval($_, $env) }); + return $func.apply(|@args) if $func !~~ MalFunction; + $ast = $func.ast; + $env = MalEnv.new($func.env, $func.params, @args); + } + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN ($source_file?, *@args) { + $repl_env.set(.key, .value) for %core::ns; + $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); + $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); + rep(q{(def! not (fn* (a) (if a false true)))}); + rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); + + if ($source_file.defined) { + rep("(load-file \"$source_file\")"); + exit; + } + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step7_quote.pl b/impls/perl6/step7_quote.pl new file mode 100644 index 0000000000..fbb6e8c191 --- /dev/null +++ b/impls/perl6/step7_quote.pl @@ -0,0 +1,131 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; +use core; + +sub read ($str) { + return read_str($str); +} + +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; +} + +sub quasiquote ($ast) { + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } + } +} + +sub eval ($ast is copy, $env is copy) { + loop { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + $env = $new_env; + $ast = $a2; + } + when 'do' { + $ast[1..*-2].map({ eval($_, $env) }); + $ast = $ast[*-1]; + } + when 'if' { + if eval($a1, $env) ~~ MalNil|MalFalse { + return $NIL if $a3 ~~ $NIL; + $ast = $a3; + } + else { + $ast = $a2; + } + } + when 'fn*' { + my @binds = $a1 ?? $a1.map(*.val) !! (); + my &fn = -> *@args { + eval($a2, MalEnv.new($env, @binds, @args)); + }; + return MalFunction($a2, $env, @binds, &fn); + } + when 'quote' { return $a1 } + when 'quasiquote' { $ast = quasiquote($a1) } + default { + my ($func, @args) = $ast.map({ eval($_, $env) }); + return $func.apply(|@args) if $func !~~ MalFunction; + $ast = $func.ast; + $env = MalEnv.new($func.env, $func.params, @args); + } + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN ($source_file?, *@args) { + $repl_env.set(.key, .value) for %core::ns; + $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); + $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); + rep(q{(def! not (fn* (a) (if a false true)))}); + rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); + + if ($source_file.defined) { + rep("(load-file \"$source_file\")"); + exit; + } + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step8_macros.pl b/impls/perl6/step8_macros.pl new file mode 100644 index 0000000000..eb8318346c --- /dev/null +++ b/impls/perl6/step8_macros.pl @@ -0,0 +1,144 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; +use core; + +sub read ($str) { + return read_str($str); +} + +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; +} + +sub quasiquote ($ast) { + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } + } +} + +sub eval ($ast is copy, $env is copy) { + loop { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + $env = $new_env; + $ast = $a2; + } + when 'do' { + $ast[1..*-2].map({ eval($_, $env) }); + $ast = $ast[*-1]; + } + when 'if' { + if eval($a1, $env) ~~ MalNil|MalFalse { + return $NIL if $a3 ~~ $NIL; + $ast = $a3; + } + else { + $ast = $a2; + } + } + when 'fn*' { + my @binds = $a1 ?? $a1.map(*.val) !! (); + my &fn = -> *@args { + eval($a2, MalEnv.new($env, @binds, @args)); + }; + return MalFunction($a2, $env, @binds, &fn); + } + when 'quote' { return $a1 } + when 'quasiquote' { $ast = quasiquote($a1) } + when 'defmacro!' { + my $func = eval($a2, $env); + $func = MalFunction($func.ast, $func.env, $func.params, $func.fn); + $func.is_macro = True; + return $env.set($a1.val, $func); + } + default { + my $func = eval($a0, $env); + my @args = $ast[1..*]; + if $func.?is_macro { + $ast = $func.apply(@args); + next; + } + @args = @args.map({ eval($_, $env) }); + return $func.apply(|@args) if $func !~~ MalFunction; + $ast = $func.ast; + $env = MalEnv.new($func.env, $func.params, @args); + } + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN ($source_file?, *@args) { + $repl_env.set(.key, .value) for %core::ns; + $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); + $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); + rep(q{(def! not (fn* (a) (if a false true)))}); + rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); + rep(q{(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))}); + + if ($source_file.defined) { + rep("(load-file \"$source_file\")"); + exit; + } + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalException { .Str.say } + } + } +} diff --git a/impls/perl6/step9_try.pl b/impls/perl6/step9_try.pl new file mode 100644 index 0000000000..83caa754a4 --- /dev/null +++ b/impls/perl6/step9_try.pl @@ -0,0 +1,155 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; +use core; + +sub read ($str) { + return read_str($str); +} + +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; +} + +sub quasiquote ($ast) { + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } + } +} + +sub eval ($ast is copy, $env is copy) { + loop { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + $env = $new_env; + $ast = $a2; + } + when 'do' { + $ast[1..*-2].map({ eval($_, $env) }); + $ast = $ast[*-1]; + } + when 'if' { + if eval($a1, $env) ~~ MalNil|MalFalse { + return $NIL if $a3 ~~ $NIL; + $ast = $a3; + } + else { + $ast = $a2; + } + } + when 'fn*' { + my @binds = $a1 ?? $a1.map(*.val) !! (); + my &fn = -> *@args { + eval($a2, MalEnv.new($env, @binds, @args)); + }; + return MalFunction($a2, $env, @binds, &fn); + } + when 'quote' { return $a1 } + when 'quasiquote' { $ast = quasiquote($a1) } + when 'defmacro!' { + my $func = eval($a2, $env); + $func = MalFunction($func.ast, $func.env, $func.params, $func.fn); + $func.is_macro = True; + return $env.set($a1.val, $func); + } + when 'try*' { + return eval($a1, $env); + CATCH { + .rethrow if !$a2; + my $ex = $_ ~~ X::MalThrow ?? .value !! MalString(.Str); + my $new_env = $env; + $env.set($a2[1].val, $ex); + return eval($a2[2], $new_env); + } + } + default { + my $func = eval($a0, $env); + my @args = $ast[1..*]; + if $func.?is_macro { + $ast = $func.apply(@args); + next; + } + @args = @args.map({ eval($_, $env) }); + return $func.apply(|@args) if $func !~~ MalFunction; + $ast = $func.ast; + $env = MalEnv.new($func.env, $func.params, @args); + } + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN ($source_file?, *@args) { + $repl_env.set(.key, .value) for %core::ns; + $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); + $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); + rep(q{(def! not (fn* (a) (if a false true)))}); + rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); + rep(q{(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))}); + + if ($source_file.defined) { + rep("(load-file \"$source_file\")"); + exit; + } + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalThrow { say "Error: " ~ pr_str(.value, True) } + when X::MalException { say "Error: " ~ .Str } + } + } +} diff --git a/impls/perl6/stepA_mal.pl b/impls/perl6/stepA_mal.pl new file mode 100644 index 0000000000..a80161301f --- /dev/null +++ b/impls/perl6/stepA_mal.pl @@ -0,0 +1,157 @@ +use v6; +use lib IO::Path.new($?FILE).dirname; +use reader; +use printer; +use types; +use env; +use core; + +sub read ($str) { + return read_str($str); +} + +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; +} + +sub quasiquote ($ast) { + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } + } +} + +sub eval ($ast is copy, $env is copy) { + loop { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + + return $ast if !$ast.elems; + + my ($a0, $a1, $a2, $a3) = $ast.val; + given $a0.val { + when 'def!' { + return $env.set($a1.val, eval($a2, $env)); + } + when 'let*' { + my $new_env = MalEnv.new($env); + for |$a1.val -> $key, $value { + $new_env.set($key.val, eval($value, $new_env)); + } + $env = $new_env; + $ast = $a2; + } + when 'do' { + $ast[1..*-2].map({ eval($_, $env) }); + $ast = $ast[*-1]; + } + when 'if' { + if eval($a1, $env) ~~ MalNil|MalFalse { + return $NIL if $a3 ~~ $NIL; + $ast = $a3; + } + else { + $ast = $a2; + } + } + when 'fn*' { + my @binds = $a1 ?? $a1.map(*.val) !! (); + my &fn = -> *@args { + eval($a2, MalEnv.new($env, @binds, @args)); + }; + return MalFunction($a2, $env, @binds, &fn); + } + when 'quote' { return $a1 } + when 'quasiquote' { $ast = quasiquote($a1) } + when 'defmacro!' { + my $func = eval($a2, $env); + $func = MalFunction($func.ast, $func.env, $func.params, $func.fn); + $func.is_macro = True; + return $env.set($a1.val, $func); + } + when 'try*' { + return eval($a1, $env); + CATCH { + .rethrow if !$a2; + my $ex = $_ ~~ X::MalThrow ?? .value !! MalString(.Str); + my $new_env = $env; + $env.set($a2[1].val, $ex); + return eval($a2[2], $new_env); + } + } + default { + my $func = eval($a0, $env); + my @args = $ast[1..*]; + if $func.?is_macro { + $ast = $func.apply(@args); + next; + } + @args = @args.map({ eval($_, $env) }); + return $func.apply(|@args) if $func !~~ MalFunction; + $ast = $func.ast; + $env = MalEnv.new($func.env, $func.params, @args); + } + } + } +} + +sub print ($exp) { + return pr_str($exp, True); +} + +my $repl_env = MalEnv.new; + +sub rep ($str) { + return print(eval(read($str), $repl_env)); +} + +sub MAIN ($source_file?, *@args) { + $repl_env.set(.key, .value) for %core::ns; + $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); + $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); + $repl_env.set('*host-language*', MalString('perl6')); + rep(q{(def! not (fn* (a) (if a false true)))}); + rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); + rep(q{(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))}); + + if ($source_file.defined) { + rep("(load-file \"$source_file\")"); + exit; + } + rep(q{(println (str "Mal [" *host-language* "]"))}); + + while (my $line = prompt 'user> ').defined { + say rep($line); + CATCH { + when X::MalThrow { say "Error: " ~ pr_str(.value, True) } + when X::MalException { say "Error: " ~ .Str } + } + } +} diff --git a/impls/perl6/tests/stepA_mal.mal b/impls/perl6/tests/stepA_mal.mal new file mode 100644 index 0000000000..0a586b4c20 --- /dev/null +++ b/impls/perl6/tests/stepA_mal.mal @@ -0,0 +1,48 @@ +;; Testing basic Perl 6 interop + +(perl6-eval "7") +;=>7 + +(perl6-eval "'7'") +;=>"7" + +(perl6-eval "123 == 123") +;=>true + +(perl6-eval "123 == 456") +;=>false + +(perl6-eval "(7,8,9)") +;=>(7 8 9) + +(perl6-eval "[7,8,9]") +;=>(7 8 9) + +(perl6-eval "{abc => 789}") +;=>{"abc" 789} + +(perl6-eval "Nil") +;=>nil + +(perl6-eval "True") +;=>true + +(perl6-eval "False") +;=>false + +(perl6-eval "my $foo") +;=>nil + +(perl6-eval "say 'hello' ") +;/hello +;=>true + +(perl6-eval "sub { my $foo = 8 }()") +;=>8 + +(perl6-eval "'This sentence has five words'.subst(/\w+/, :g, {'*' ~ $^a.chars ~ '*'})") +;=>"*4* *8* *3* *4* *5*" + +(perl6-eval "<3 a 45 b>.join: '|'") +;=>"3|a|45|b" + diff --git a/impls/perl6/types.pm b/impls/perl6/types.pm new file mode 100644 index 0000000000..95695c4787 --- /dev/null +++ b/impls/perl6/types.pm @@ -0,0 +1,94 @@ +unit module types; + +class X::MalException is Exception is export {} +class X::MalNoTokens is X::MalException is export { + method message() { "got no tokens" } +} +class X::MalIncomplete is X::MalException is export { + has $.end; + method message() { "expected '$.end', got EOF" } +} +class X::MalUnexpected is X::MalException is export { + has $.token; + method message() { "unexpected '$.token'" } +} +class X::MalNotFound is X::MalException is export { + has $.name; + method message() { "'$.name' not found" } +} +class X::MalOutOfRange is X::MalException is export { + method message() { "nth: index out of range" } +} +class X::MalThrow is X::MalException is export { + has $.value; +} + +role MalValue is export { + has $.val is rw; + method CALL-ME ($val) { self.new(:$val) } +} +role MalSequence is export { + has $.val handles ; + has $.meta is rw; + method CALL-ME ($val) { self.new(:$val) } +} +role MalCallable is export { + has &.fn; + method apply (*@_) { &!fn(|@_) } +} +role MalMeta is export { + has $.meta is rw; +} + +class MalNil does MalValue is export { + method seq { self } +} +class MalTrue does MalValue is export {} +class MalFalse does MalValue is export {} + +our $NIL is export = MalNil('nil'); +our $TRUE is export = MalTrue('true'); +our $FALSE is export = MalFalse('false'); + +class MalSymbol does MalValue does MalMeta is export {} + +class MalList does MalSequence is export { + method conj (@args) { return self.new(val => [|@args.reverse, |$.val]) } + method seq { return self.elems ?? self !! $NIL } +} + +class MalVector does MalSequence is export { + method conj (@args) { return self.new(val => [|$.val, |@args]) } + method seq { return self.elems ?? MalList(self.val) !! $NIL } +} + +class MalHashMap does MalMeta is export { + has $.val handles ; + method CALL-ME ($val) { self.new(:$val) } +} + +class MalNumber does MalValue is export {} + +class MalString does MalValue is export { + method seq { + return self.val.chars + ?? MalList(self.val.comb.map({MalString($_)})) + !! $NIL; + } +} + +class MalCode does MalCallable does MalMeta is export { + method CALL-ME (&fn) { self.new(:&fn) } +} + +class MalFunction does MalCallable does MalMeta is export { + has $.ast; + has @.params; + has $.env; + has $.is_macro is rw = False; + method CALL-ME ($ast, $env, @params, &fn) { + self.bless(:$ast, :$env, :@params, :&fn); + } +} + +class MalAtom does MalValue does MalMeta is export {} diff --git a/impls/php/Dockerfile b/impls/php/Dockerfile new file mode 100644 index 0000000000..eec64dd89d --- /dev/null +++ b/impls/php/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install php-cli diff --git a/impls/php/Makefile b/impls/php/Makefile new file mode 100644 index 0000000000..1682d6c40f --- /dev/null +++ b/impls/php/Makefile @@ -0,0 +1,21 @@ +SOURCES_BASE = readline.php types.php reader.php printer.php interop.php +SOURCES_LISP = env.php core.php stepA_mal.php +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + +dist: mal.php mal + +mal.php: $(SOURCES) + cat $+ | grep -v "^require_once" > $@ + +mal: mal.php + echo "#!/usr/bin/env php" > $@ + cat $< >> $@ + chmod +x $@ + +mal-web.php: mal.php + cat $< | ( IFS="NON-MATCHING-IFS"; while read -r line; do if [ "$$line" = "// run mal file" ]; then echo "?>"; cat webrunner.php; echo " $@ + +clean: + rm -f mal.php mal mal-web.php diff --git a/impls/php/README.md b/impls/php/README.md new file mode 100644 index 0000000000..24500da82e --- /dev/null +++ b/impls/php/README.md @@ -0,0 +1,42 @@ +### Running .mal scripts on PHP hosting ### + +Create a symlink to `mal-web.php` with the same name as your `.mal` script and your script will be executed as if it was PHP. + +Here's an example using local dev. + +First build `mal-web.php`: + + cd mal/php + make mal-web.php + +Now you can create a web runnable mal script: + + echo '(println "Hello world!")' > myscript.mal + ln -s mal-web.php myscript.php + +Start a development server with `php -S 0.0.0.0:8000` and then browse to http://localhost:8000/myscript.php and you should see "Hello world!" in your browser as `myscript.mal` is run. + +You can do the same thing on live PHP web hosting by copying `mal.php` up and creating a symlink for each `.mal` file you want to be web-executable. + +### PHP interop ### + +In [stepA_mal.mal](./tests/stepA_mal.mal) you can find some examples of PHP interop. + +Eval PHP code: + + (php* "return 7;") + 7 + + (php* "return array(7,8,9);") + (7 8 9) + +Native function call: + + (php/date "Y-m-d" 0) + "1970-01-01" + +Accessing PHP "superglobal" variables: + + (get php/_SERVER "PHP_SELF") + "./mal" + diff --git a/php/core.php b/impls/php/core.php similarity index 81% rename from php/core.php rename to impls/php/core.php index 96129b1db9..6e87e0c186 100644 --- a/php/core.php +++ b/impls/php/core.php @@ -6,7 +6,7 @@ require_once 'printer.php'; // Error/Exception functions -function mal_throw($obj) { throw new Error($obj); } +function mal_throw($obj) { throw new _Error($obj); } // String functions @@ -69,7 +69,8 @@ function get($hm, $k) { function contains_Q($hm, $k) { return array_key_exists($k, $hm); } function keys($hm) { - return call_user_func_array('_list', array_keys($hm->getArrayCopy())); + return call_user_func_array('_list', + array_map('strval', array_keys($hm->getArrayCopy()))); } function vals($hm) { return call_user_func_array('_list', array_values($hm->getArrayCopy())); @@ -96,6 +97,16 @@ function concat() { return $l; } +function vec($a) { + if (_vector_Q($a)) { + return $a; + } else { + $v = new VectorClass(); + $v->exchangeArray($a->getArrayCopy()); + return $v; + } +} + function nth($seq, $idx) { if ($idx < $seq->count()) { return $seq[$idx]; @@ -105,7 +116,7 @@ function nth($seq, $idx) { } function first($seq) { - if (count($seq) === 0) { + if ($seq === NULL || count($seq) === 0) { return NULL; } else { return $seq[0]; @@ -113,15 +124,32 @@ function first($seq) { } function rest($seq) { - $l = new ListClass(); - $l->exchangeArray(array_slice($seq->getArrayCopy(), 1)); - return $l; + if ($seq === NULL) { + return new ListClass(); + } else { + $l = new ListClass(); + $l->exchangeArray(array_slice($seq->getArrayCopy(), 1)); + return $l; + } } function empty_Q($seq) { return $seq->count() === 0; } function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); } +function apply($f) { + $args = array_slice(func_get_args(), 1); + $last_arg = array_pop($args)->getArrayCopy(); + return $f->apply(array_merge($args, $last_arg)); +} + +function map($f, $seq) { + $l = new ListClass(); + # @ to surpress warning if $f throws an exception + @$l->exchangeArray(array_map($f, $seq->getArrayCopy())); + return $l; +} + function conj($src) { $args = array_slice(func_get_args(), 1); $tmp = $src->getArrayCopy(); @@ -136,17 +164,30 @@ function conj($src) { return $s; } -function apply($f) { - $args = array_slice(func_get_args(), 1); - $last_arg = array_pop($args)->getArrayCopy(); - return $f->apply(array_merge($args, $last_arg)); +function seq($src) { + if (_list_Q($src)) { + if (count($src) == 0) { return NULL; } + return $src; + } elseif (_vector_Q($src)) { + if (count($src) == 0) { return NULL; } + $tmp = $src->getArrayCopy(); + $s = new ListClass(); + $s->exchangeArray($tmp); + return $s; + } elseif (_string_Q($src)) { + if (strlen($src) == 0) { return NULL; } + $tmp = str_split($src); + $s = new ListClass(); + $s->exchangeArray($tmp); + return $s; + } elseif (_nil_Q($src)) { + return NULL; + } else { + throw new Exception("seq: called on non-sequence"); + } + return $s; } -function map($f, $seq) { - $l = new ListClass(); - $l->exchangeArray(array_map($f, $seq->getArrayCopy())); - return $l; -} // Metadata functions @@ -179,12 +220,15 @@ function swap_BANG($atm, $f) { 'nil?'=> function ($a) { return _nil_Q($a); }, 'true?'=> function ($a) { return _true_Q($a); }, 'false?'=> function ($a) { return _false_Q($a); }, + 'number?'=> function ($a) { return _number_Q($a); }, 'symbol'=> function () { return call_user_func_array('_symbol', func_get_args()); }, 'symbol?'=> function ($a) { return _symbol_Q($a); }, 'keyword'=> function () { return call_user_func_array('_keyword', func_get_args()); }, 'keyword?'=> function ($a) { return _keyword_Q($a); }, 'string?'=> function ($a) { return _string_Q($a); }, + 'fn?'=> function($a) { return _fn_Q($a) || (_function_Q($a) && !$a->ismacro ); }, + 'macro?'=> function($a) { return _function_Q($a) && $a->ismacro; }, 'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); }, 'str'=> function () { return call_user_func_array('str', func_get_args()); }, 'prn'=> function () { return call_user_func_array('prn', func_get_args()); }, @@ -218,15 +262,18 @@ function swap_BANG($atm, $f) { 'sequential?'=> function ($a) { return _sequential_Q($a); }, 'cons'=> function ($a, $b) { return cons($a, $b); }, 'concat'=> function () { return call_user_func_array('concat', func_get_args()); }, + 'vec'=> function ($a) { return vec($a, $b); }, 'nth'=> function ($a, $b) { return nth($a, $b); }, 'first'=> function ($a) { return first($a); }, 'rest'=> function ($a) { return rest($a); }, 'empty?'=> function ($a) { return empty_Q($a); }, 'count'=> function ($a) { return scount($a); }, - 'conj'=> function () { return call_user_func_array('conj', func_get_args()); }, 'apply'=> function () { return call_user_func_array('apply', func_get_args()); }, 'map'=> function ($a, $b) { return map($a, $b); }, + 'conj'=> function () { return call_user_func_array('conj', func_get_args()); }, + 'seq'=> function ($a) { return seq($a); }, + 'with-meta'=> function ($a, $b) { return with_meta($a, $b); }, 'meta'=> function ($a) { return meta($a); }, 'atom'=> function ($a) { return _atom($a); }, diff --git a/php/env.php b/impls/php/env.php similarity index 89% rename from php/env.php rename to impls/php/env.php index a660d3b9d4..839da55318 100644 --- a/php/env.php +++ b/impls/php/env.php @@ -31,7 +31,7 @@ public function __construct($outer, $binds=NULL, $exprs=NULL) { } } public function find($key) { - if (array_key_exists($key->value, $this->data)) { + if (array_key_exists($key, $this->data)) { return $this; } elseif ($this->outer) { return $this->outer->find($key); @@ -46,9 +46,9 @@ public function set($key, $value) { public function get($key) { $env = $this->find($key); if (!$env) { - throw new Exception("'" . $key->value . "' not found"); + throw new Exception("'" . $key . "' not found"); } else { - return $env->data[$key->value]; + return $env->data[$key]; } } } diff --git a/impls/php/interop.php b/impls/php/interop.php new file mode 100644 index 0000000000..bb14d880ed --- /dev/null +++ b/impls/php/interop.php @@ -0,0 +1,80 @@ + $v) { + $ret[_to_php($k)] = _to_php($v); + } + return $ret; + } elseif (is_string($obj)) { + if (strpos($obj, chr(0x7f)) === 0) { + return ":".substr($obj,1); + } else { + return $obj; + } + } elseif (_symbol_Q($obj)) { + return ${$obj->value}; + } elseif (_atom_Q($obj)) { + return $obj->value; + } else { + return $obj; + } +} + +function _to_mal($obj) { + switch (gettype($obj)) { + case "object": + return _to_mal(get_object_vars($obj)); + case "array": + $obj_conv = array(); + foreach ($obj as $k => $v) { + $obj_conv[_to_mal($k)] = _to_mal($v); + } + if ($obj_conv !== array_values($obj_conv)) { + $new_obj = _hash_map(); + $new_obj->exchangeArray($obj_conv); + return $new_obj; + } else { + return call_user_func_array('_list', $obj_conv); + } + default: + return $obj; + } +} + +function _to_native($name, $env) { + if (is_callable($name)) { + return _function(function() use ($name) { + $args = array_map("_to_php", func_get_args()); + $res = call_user_func_array($name, $args); + return _to_mal($res); + }); + // special case for language constructs + } else if ($name == "print") { + return _function(function($value) { + print(_to_php($value)); + return null; + }); + } else if ($name == "exit") { + return _function(function($value) { + exit(_to_php($value)); + return null; + }); + } else if ($name == "require") { + return _function(function($value) { + require(_to_php($value)); + return null; + }); + } else if (in_array($name, ["_SERVER", "_GET", "_POST", "_FILES", "_REQUEST", "_SESSION", "_ENV", "_COOKIE"])) { + $val = $GLOBALS[$name]; + } else if (defined($name)) { + $val = constant($name); + } else { + $val = ${$name}; + } + return _to_mal($val); +} +?> diff --git a/php/printer.php b/impls/php/printer.php similarity index 81% rename from php/printer.php rename to impls/php/printer.php index 130d31ba02..d70d4ed7a4 100644 --- a/php/printer.php +++ b/impls/php/printer.php @@ -18,7 +18,7 @@ function _pr_str($obj, $print_readably=True) { } elseif (_hash_map_Q($obj)) { $ret = array(); foreach (array_keys($obj->getArrayCopy()) as $k) { - $ret[] = _pr_str($k, $print_readably); + $ret[] = _pr_str("$k", $print_readably); $ret[] = _pr_str($obj[$k], $print_readably); } return "{" . implode(" ", $ret) . "}"; @@ -26,11 +26,13 @@ function _pr_str($obj, $print_readably=True) { if (strpos($obj, chr(0x7f)) === 0) { return ":".substr($obj,1); } elseif ($print_readably) { - $obj = preg_replace('/"/', '\\"', preg_replace('/\\\\/', '\\\\\\\\', $obj)); + $obj = preg_replace('/\n/', '\\n', preg_replace('/"/', '\\"', preg_replace('/\\\\/', '\\\\\\\\', $obj))); return '"' . $obj . '"'; } else { return $obj; } + } elseif (is_double($obj)) { + return $obj; } elseif (is_integer($obj)) { return $obj; } elseif ($obj === NULL) { @@ -47,6 +49,10 @@ function _pr_str($obj, $print_readably=True) { return "(fn* [...] ...)"; } elseif (is_callable($obj)) { // only step4 and below return "#"; + } elseif (is_object($obj)) { + return "#"; + } elseif (is_array($obj)) { + return "#"; } else { throw new Exception("_pr_str unknown type: " . gettype($obj)); } diff --git a/php/reader.php b/impls/php/reader.php similarity index 86% rename from php/reader.php rename to impls/php/reader.php index ed9063f3c3..53e404d336 100644 --- a/php/reader.php +++ b/impls/php/reader.php @@ -27,7 +27,7 @@ function _real_token($s) { } function tokenize($str) { - $pat = "/[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\s\[\]{}('\"`,;)]*)/"; + $pat = "/[\s,]*(php\/|~@|[\[\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\s\[\]{}('\"`,;)]*)/"; preg_match_all($pat, $str, $matches); return array_values(array_filter($matches[1], '_real_token')); } @@ -36,10 +36,15 @@ function read_atom($reader) { $token = $reader->next(); if (preg_match("/^-?[0-9]+$/", $token)) { return intval($token, 10); - } elseif ($token[0] === "\"") { + } elseif (preg_match("/^\"(?:\\\\.|[^\\\\\"])*\"$/", $token)) { $str = substr($token, 1, -1); - $str = preg_replace('/\\\\"/', '"', $str); + $str = str_replace('\\\\', chr(0x7f), $str); + $str = str_replace('\\"', '"', $str); + $str = str_replace('\\n', "\n", $str); + $str = str_replace(chr(0x7f), "\\", $str); return $str; + } elseif ($token[0] === "\"") { + throw new Exception("expected '\"', got EOF"); } elseif ($token[0] === ":") { return _keyword(substr($token,1)); } elseif ($token === "nil") { @@ -99,6 +104,10 @@ function read_form($reader) { return _list(_symbol('deref'), read_form($reader)); + case 'php/': $reader->next(); + return _list(_symbol('to-native'), + read_form($reader)); + case ')': throw new Exception("unexpected ')'"); case '(': return read_list($reader); case ']': throw new Exception("unexpected ']'"); diff --git a/impls/php/readline.php b/impls/php/readline.php new file mode 100644 index 0000000000..8b3d28b9cb --- /dev/null +++ b/impls/php/readline.php @@ -0,0 +1,41 @@ + diff --git a/impls/php/run b/impls/php/run new file mode 100755 index 0000000000..daf97f93c0 --- /dev/null +++ b/impls/php/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec php $(dirname $0)/${STEP:-stepA_mal}.php "${@}" diff --git a/php/step0_repl.php b/impls/php/step0_repl.php similarity index 75% rename from php/step0_repl.php rename to impls/php/step0_repl.php index eecb0523d4..421173c1d3 100644 --- a/php/step0_repl.php +++ b/impls/php/step0_repl.php @@ -9,12 +9,12 @@ function READ($str) { // eval function MAL_EVAL($ast, $env) { - return eval($ast); + return $ast; } // print function MAL_PRINT($exp) { - return var_export($exp, true) . "\n"; + return $exp; } // repl @@ -26,8 +26,8 @@ function rep($str) { do { $line = mal_readline("user> "); if ($line === NULL) { break; } - if (!empty($line)) { - print(rep($line)); + if ($line !== "") { + print(rep($line) . "\n"); } } while (true); diff --git a/php/step1_read_print.php b/impls/php/step1_read_print.php similarity index 91% rename from php/step1_read_print.php rename to impls/php/step1_read_print.php index c9c5267829..b1f18a8adb 100644 --- a/php/step1_read_print.php +++ b/impls/php/step1_read_print.php @@ -17,7 +17,7 @@ function MAL_EVAL($ast, $env) { // print function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; + return _pr_str($exp, True); } // repl @@ -31,7 +31,7 @@ function rep($str) { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { - print(rep($line)); + print(rep($line) . "\n"); } } catch (BlankException $e) { continue; diff --git a/php/step2_eval.php b/impls/php/step2_eval.php similarity index 78% rename from php/step2_eval.php rename to impls/php/step2_eval.php index b9d2e8e980..03135bcc96 100644 --- a/php/step2_eval.php +++ b/impls/php/step2_eval.php @@ -11,15 +11,13 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + // echo "EVAL: " . _pr_str($ast) . "\n"; + if (_symbol_Q($ast)) { return $env[$ast->value]; - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -28,25 +26,25 @@ function eval_ast($ast, $env) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; - } else { + } elseif (!_list_Q($ast)) { return $ast; } -} -function MAL_EVAL($ast, $env) { - if (!_list_Q($ast)) { - return eval_ast($ast, $env); + if ($ast->count() === 0) { + return $ast; } // apply list - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + $args = array_slice($el, 1); + return call_user_func_array($f, $args); } // print function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; + return _pr_str($exp, True); } // repl @@ -67,7 +65,7 @@ function rep($str) { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { - print(rep($line)); + print(rep($line) . "\n"); } } catch (BlankException $e) { continue; diff --git a/php/step3_env.php b/impls/php/step3_env.php similarity index 76% rename from php/step3_env.php rename to impls/php/step3_env.php index a31c298ea3..3000fb08d4 100644 --- a/php/step3_env.php +++ b/impls/php/step3_env.php @@ -12,15 +12,19 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -29,15 +33,12 @@ function eval_ast($ast, $env) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; - } else { + } elseif (!_list_Q($ast)) { return $ast; } -} -function MAL_EVAL($ast, $env) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); + if ($ast->count() === 0) { + return $ast; } // apply list @@ -55,15 +56,17 @@ function MAL_EVAL($ast, $env) { } return MAL_EVAL($ast[2], $let_env); default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + $args = array_slice($el, 1); + return call_user_func_array($f, $args); } } // print function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; + return _pr_str($exp, True); } // repl @@ -84,7 +87,7 @@ function rep($str) { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { - print(rep($line)); + print(rep($line) . "\n"); } } catch (BlankException $e) { continue; diff --git a/php/step4_if_fn_do.php b/impls/php/step4_if_fn_do.php similarity index 76% rename from php/step4_if_fn_do.php rename to impls/php/step4_if_fn_do.php index 72662613a9..54610a5373 100644 --- a/php/step4_if_fn_do.php +++ b/impls/php/step4_if_fn_do.php @@ -13,15 +13,19 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -30,15 +34,12 @@ function eval_ast($ast, $env) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; - } else { + } elseif (!_list_Q($ast)) { return $ast; } -} -function MAL_EVAL($ast, $env) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); + if ($ast->count() === 0) { + return $ast; } // apply list @@ -56,9 +57,8 @@ function MAL_EVAL($ast, $env) { } return MAL_EVAL($ast[2], $let_env); case "do": - #$el = eval_ast(array_slice($ast->getArrayCopy(), 1), $env); - $el = eval_ast($ast->slice(1), $env); - return $el[count($el)-1]; + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } + return MAL_EVAL($ast[count($ast)-1], $env); case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { @@ -73,15 +73,17 @@ function MAL_EVAL($ast, $env) { return MAL_EVAL($ast[2], $fn_env); }; default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + $args = array_slice($el, 1); + return call_user_func_array($f, $args); } } // print function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; + return _pr_str($exp, True); } // repl @@ -105,7 +107,7 @@ function rep($str) { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { - print(rep($line)); + print(rep($line) . "\n"); } } catch (BlankException $e) { continue; diff --git a/php/step5_tco.php b/impls/php/step5_tco.php similarity index 81% rename from php/step5_tco.php rename to impls/php/step5_tco.php index a3785cff45..6ed2dc774c 100644 --- a/php/step5_tco.php +++ b/impls/php/step5_tco.php @@ -13,15 +13,21 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -30,17 +36,12 @@ function eval_ast($ast, $env) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; - } else { + } elseif (!_list_Q($ast)) { return $ast; } -} -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); + if ($ast->count() === 0) { + return $ast; } // apply list @@ -60,7 +61,7 @@ function MAL_EVAL($ast, $env) { $env = $let_env; break; // Continue loop (TCO) case "do": - eval_ast($ast->slice(1, -1), $env); + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": @@ -76,9 +77,10 @@ function MAL_EVAL($ast, $env) { return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); @@ -93,7 +95,7 @@ function MAL_EVAL($ast, $env) { // print function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; + return _pr_str($exp, True); } // repl @@ -117,7 +119,7 @@ function rep($str) { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { - print(rep($line)); + print(rep($line) . "\n"); } } catch (BlankException $e) { continue; diff --git a/php/step6_file.php b/impls/php/step6_file.php similarity index 82% rename from php/step6_file.php rename to impls/php/step6_file.php index a27acb8a5f..6939535e33 100644 --- a/php/step6_file.php +++ b/impls/php/step6_file.php @@ -13,15 +13,21 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -30,17 +36,12 @@ function eval_ast($ast, $env) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; - } else { + } elseif (!_list_Q($ast)) { return $ast; } -} -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); + if ($ast->count() === 0) { + return $ast; } // apply list @@ -60,7 +61,7 @@ function MAL_EVAL($ast, $env) { $env = $let_env; break; // Continue loop (TCO) case "do": - eval_ast($ast->slice(1, -1), $env); + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": @@ -76,9 +77,10 @@ function MAL_EVAL($ast, $env) { return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); @@ -93,7 +95,7 @@ function MAL_EVAL($ast, $env) { // print function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; + return _pr_str($exp, True); } // repl @@ -118,7 +120,7 @@ function rep($str) { // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (count($argv) > 1) { rep('(load-file "' . $argv[1] . '")'); @@ -131,7 +133,7 @@ function rep($str) { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { - print(rep($line)); + print(rep($line) . "\n"); } } catch (BlankException $e) { continue; diff --git a/impls/php/step7_quote.php b/impls/php/step7_quote.php new file mode 100644 index 0000000000..af84cef040 --- /dev/null +++ b/impls/php/step7_quote.php @@ -0,0 +1,184 @@ +value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; +} + +function quasiquote($ast) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { + return _list(_symbol("quote"), $ast); + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { + return $ast[1]; + } else { + return qq_foldr($ast); + } +} + +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + + if (_symbol_Q($ast)) { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { + $el = _vector(); + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } + return $el; + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); + foreach (array_keys($ast->getArrayCopy()) as $key) { + $new_hm[$key] = MAL_EVAL($ast[$key], $env); + } + return $new_hm; + } elseif (!_list_Q($ast)) { + return $ast; + } + + if ($ast->count() === 0) { + return $ast; + } + + // apply list + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1], $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); + } + $ast = $ast[2]; + $env = $let_env; + break; // Continue loop (TCO) + case "quote": + return $ast[1]; + case "quasiquote": + $ast = quasiquote($ast[1]); + break; // Continue loop (TCO) + case "do": + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } + $ast = $ast[count($ast)-1]; + break; // Continue loop (TCO) + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; // Continue loop (TCO) + case "fn*": + return _function('MAL_EVAL', 'native', + $ast[2], $env, $ast[1]); + default: + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } + $f = $el[0]; + $args = array_slice($el, 1); + if ($f->type === 'native') { + $ast = $f->ast; + $env = $f->gen_env($args); + // Continue loop (TCO) + } else { + return $f->apply($args); + } + } + + } +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True); +} + +// repl +$repl_env = new Env(NULL); +function rep($str) { + global $repl_env; + return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); +} + +// core.php: defined using PHP +foreach ($core_ns as $k=>$v) { + $repl_env->set(_symbol($k), _function($v)); +} +$repl_env->set(_symbol('eval'), _function(function($ast) { + global $repl_env; return MAL_EVAL($ast, $repl_env); +})); +$_argv = _list(); +for ($i=2; $i < count($argv); $i++) { + $_argv->append($argv[$i]); +} +$repl_env->set(_symbol('*ARGV*'), $_argv); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); + +if (count($argv) > 1) { + rep('(load-file "' . $argv[1] . '")'); + exit(0); +} + +// repl loop +do { + try { + $line = mal_readline("user> "); + if ($line === NULL) { break; } + if ($line !== "") { + print(rep($line) . "\n"); + } + } catch (BlankException $e) { + continue; + } catch (Exception $e) { + echo "Error: " . $e->getMessage() . "\n"; + echo $e->getTraceAsString() . "\n"; + } +} while (true); + +?> diff --git a/impls/php/step8_macros.php b/impls/php/step8_macros.php new file mode 100644 index 0000000000..dff99689f0 --- /dev/null +++ b/impls/php/step8_macros.php @@ -0,0 +1,194 @@ +value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; +} + +function quasiquote($ast) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { + return _list(_symbol("quote"), $ast); + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { + return $ast[1]; + } else { + return qq_foldr($ast); + } +} + +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + + if (_symbol_Q($ast)) { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { + $el = _vector(); + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } + return $el; + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); + foreach (array_keys($ast->getArrayCopy()) as $key) { + $new_hm[$key] = MAL_EVAL($ast[$key], $env); + } + return $new_hm; + } elseif (!_list_Q($ast)) { + return $ast; + } + + // apply list + if ($ast->count() === 0) { + return $ast; + } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1], $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); + } + $ast = $ast[2]; + $env = $let_env; + break; // Continue loop (TCO) + case "quote": + return $ast[1]; + case "quasiquote": + $ast = quasiquote($ast[1]); + break; // Continue loop (TCO) + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); + $func->ismacro = true; + return $env->set($ast[1], $func); + case "do": + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } + $ast = $ast[count($ast)-1]; + break; // Continue loop (TCO) + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; // Continue loop (TCO) + case "fn*": + return _function('MAL_EVAL', 'native', + $ast[2], $env, $ast[1]); + default: + $f = MAL_EVAL($a0, $env); + $unevaluated_args = array_slice($ast->getArrayCopy(), 1); + if ($f->ismacro) { + $ast = $f->apply($unevaluated_args); + break; // Continue loop (TCO) + } + $args = []; + foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } + if ($f->type === 'native') { + $ast = $f->ast; + $env = $f->gen_env($args); + // Continue loop (TCO) + } else { + return $f->apply($args); + } + } + + } +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True); +} + +// repl +$repl_env = new Env(NULL); +function rep($str) { + global $repl_env; + return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); +} + +// core.php: defined using PHP +foreach ($core_ns as $k=>$v) { + $repl_env->set(_symbol($k), _function($v)); +} +$repl_env->set(_symbol('eval'), _function(function($ast) { + global $repl_env; return MAL_EVAL($ast, $repl_env); +})); +$_argv = _list(); +for ($i=2; $i < count($argv); $i++) { + $_argv->append($argv[$i]); +} +$repl_env->set(_symbol('*ARGV*'), $_argv); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +if (count($argv) > 1) { + rep('(load-file "' . $argv[1] . '")'); + exit(0); +} + +// repl loop +do { + try { + $line = mal_readline("user> "); + if ($line === NULL) { break; } + if ($line !== "") { + print(rep($line) . "\n"); + } + } catch (BlankException $e) { + continue; + } catch (Exception $e) { + echo "Error: " . $e->getMessage() . "\n"; + echo $e->getTraceAsString() . "\n"; + } +} while (true); + +?> diff --git a/impls/php/step9_try.php b/impls/php/step9_try.php new file mode 100644 index 0000000000..c839bd8036 --- /dev/null +++ b/impls/php/step9_try.php @@ -0,0 +1,214 @@ +value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; +} + +function quasiquote($ast) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { + return _list(_symbol("quote"), $ast); + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { + return $ast[1]; + } else { + return qq_foldr($ast); + } +} + +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + + if (_symbol_Q($ast)) { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { + $el = _vector(); + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } + return $el; + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); + foreach (array_keys($ast->getArrayCopy()) as $key) { + $new_hm[$key] = MAL_EVAL($ast[$key], $env); + } + return $new_hm; + } elseif (!_list_Q($ast)) { + return $ast; + } + + // apply list + if ($ast->count() === 0) { + return $ast; + } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1], $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); + } + $ast = $ast[2]; + $env = $let_env; + break; // Continue loop (TCO) + case "quote": + return $ast[1]; + case "quasiquote": + $ast = quasiquote($ast[1]); + break; // Continue loop (TCO) + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); + $func->ismacro = true; + return $env->set($ast[1], $func); + case "try*": + $a1 = $ast[1]; + $a2 = $ast[2]; + if ($a2[0]->value === "catch*") { + try { + return MAL_EVAL($a1, $env); + } catch (_Error $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->obj)); + return MAL_EVAL($a2[2], $catch_env); + } catch (Exception $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->getMessage())); + return MAL_EVAL($a2[2], $catch_env); + } + } else { + return MAL_EVAL($a1, $env); + } + case "do": + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } + $ast = $ast[count($ast)-1]; + break; // Continue loop (TCO) + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; // Continue loop (TCO) + case "fn*": + return _function('MAL_EVAL', 'native', + $ast[2], $env, $ast[1]); + default: + $f = MAL_EVAL($a0, $env); + $unevaluated_args = array_slice($ast->getArrayCopy(), 1); + if ($f->ismacro) { + $ast = $f->apply($unevaluated_args); + break; // Continue loop (TCO) + } + $args = []; + foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } + if ($f->type === 'native') { + $ast = $f->ast; + $env = $f->gen_env($args); + // Continue loop (TCO) + } else { + return $f->apply($args); + } + } + + } +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True); +} + +// repl +$repl_env = new Env(NULL); +function rep($str) { + global $repl_env; + return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); +} + +// core.php: defined using PHP +foreach ($core_ns as $k=>$v) { + $repl_env->set(_symbol($k), _function($v)); +} +$repl_env->set(_symbol('eval'), _function(function($ast) { + global $repl_env; return MAL_EVAL($ast, $repl_env); +})); +$_argv = _list(); +for ($i=2; $i < count($argv); $i++) { + $_argv->append($argv[$i]); +} +$repl_env->set(_symbol('*ARGV*'), $_argv); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +if (count($argv) > 1) { + rep('(load-file "' . $argv[1] . '")'); + exit(0); +} + +// repl loop +do { + try { + $line = mal_readline("user> "); + if ($line === NULL) { break; } + if ($line !== "") { + print(rep($line) . "\n"); + } + } catch (BlankException $e) { + continue; + } catch (_Error $e) { + echo "Error: " . _pr_str($e->obj, True) . "\n"; + } catch (Exception $e) { + echo "Error: " . $e->getMessage() . "\n"; + echo $e->getTraceAsString() . "\n"; + } +} while (true); + +?> diff --git a/impls/php/stepA_mal.php b/impls/php/stepA_mal.php new file mode 100644 index 0000000000..94bf1568f7 --- /dev/null +++ b/impls/php/stepA_mal.php @@ -0,0 +1,225 @@ +value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; +} + +function quasiquote($ast) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { + return _list(_symbol("quote"), $ast); + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { + return $ast[1]; + } else { + return qq_foldr($ast); + } +} + +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + + if (_symbol_Q($ast)) { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { + $el = _vector(); + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } + return $el; + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); + foreach (array_keys($ast->getArrayCopy()) as $key) { + $new_hm[$key] = MAL_EVAL($ast[$key], $env); + } + return $new_hm; + } elseif (!_list_Q($ast)) { + return $ast; + } + + // apply list + if ($ast->count() === 0) { + return $ast; + } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1], $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); + } + $ast = $ast[2]; + $env = $let_env; + break; // Continue loop (TCO) + case "quote": + return $ast[1]; + case "quasiquote": + $ast = quasiquote($ast[1]); + break; // Continue loop (TCO) + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); + $func->ismacro = true; + return $env->set($ast[1], $func); + case "php*": + $res = eval($ast[1]); + return _to_mal($res); + case "try*": + $a1 = $ast[1]; + $a2 = $ast[2]; + if ($a2[0]->value === "catch*") { + try { + return MAL_EVAL($a1, $env); + } catch (_Error $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->obj)); + return MAL_EVAL($a2[2], $catch_env); + } catch (Exception $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->getMessage())); + return MAL_EVAL($a2[2], $catch_env); + } + } else { + return MAL_EVAL($a1, $env); + } + case "do": + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } + $ast = $ast[count($ast)-1]; + break; // Continue loop (TCO) + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; // Continue loop (TCO) + case "fn*": + return _function('MAL_EVAL', 'native', + $ast[2], $env, $ast[1]); + case "to-native": + return _to_native($ast[1]->value, $env); + default: + $f = MAL_EVAL($a0, $env); + $unevaluated_args = array_slice($ast->getArrayCopy(), 1); + if ($f->ismacro) { + $ast = $f->apply($unevaluated_args); + break; // Continue loop (TCO) + } + $args = []; + foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } + if ($f->type === 'native') { + $ast = $f->ast; + $env = $f->gen_env($args); + // Continue loop (TCO) + } else { + return $f->apply($args); + } + } + + } +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True); +} + +// repl +$repl_env = new Env(NULL); +function rep($str) { + global $repl_env; + return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); +} + +// core.php: defined using PHP +foreach ($core_ns as $k=>$v) { + $repl_env->set(_symbol($k), _function($v)); +} +$repl_env->set(_symbol('eval'), _function(function($ast) { + global $repl_env; return MAL_EVAL($ast, $repl_env); +})); +$_argv = _list(); +if (isset($argv)) { + for ($i=2; $i < count($argv); $i++) { + $_argv->append($argv[$i]); + } +} +$repl_env->set(_symbol('*ARGV*'), $_argv); + +// core.mal: defined using the language itself +rep("(def! *host-language* \"php\")"); +rep("(def! not (fn* (a) (if a false true)))"); +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); + +// run mal file +if (count($argv) > 1) { + rep('(load-file "' . $argv[1] . '")'); + exit(0); +} + +// repl loop +rep("(println (str \"Mal [\" *host-language* \"]\"))"); +do { + try { + $line = mal_readline("user> "); + if ($line === NULL) { break; } + if ($line !== "") { + print(rep($line) . "\n"); + } + } catch (BlankException $e) { + continue; + } catch (_Error $e) { + echo "Error: " . _pr_str($e->obj, True) . "\n"; + } catch (Exception $e) { + echo "Error: " . $e->getMessage() . "\n"; + echo $e->getTraceAsString() . "\n"; + } +} while (true); + +?> diff --git a/impls/php/tests/step5_tco.mal b/impls/php/tests/step5_tco.mal new file mode 100644 index 0000000000..d04796d469 --- /dev/null +++ b/impls/php/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; PHP: skipping non-TCO recursion +;; Reason: completes at 10,000, unrecoverable segfault at 20,000 diff --git a/impls/php/tests/stepA_mal.mal b/impls/php/tests/stepA_mal.mal new file mode 100644 index 0000000000..de459cdbcf --- /dev/null +++ b/impls/php/tests/stepA_mal.mal @@ -0,0 +1,45 @@ +;; Testing basic php interop + +(php* "return 7;") +;=>7 + +(php* "return '7';") +;=>"7" + +(php* "return array(7,8,9);") +;=>(7 8 9) + +(php* "return array(\"abc\" => 789);") +;=>{"abc" 789} + +(php* "print \"hello\n\";") +;/hello +;=>nil + +(php* "global $foo; $foo=8;") +(php* "global $foo; return $foo;") +;=>8 + +(php* "global $f; $f = function($v) { return 1+$v; };") +(php* "global $f; return array_map($f, array(1,2,3));") +;=>(2 3 4) + +;; testing native function calling + +(php/date "Y-m-d" 0) +;=>"1970-01-01" + +;; testing native function with mal callback + +(php/array_map (fn* [t] (if (> t 3) t)) [1 2 3 4 5 6]) +;=>(nil nil nil 4 5 6) + +;; testing superglobal variable access + +(get php/_SERVER "PHP_SELF") +;=>"../php/stepA_mal.php" + +;; testing PHP constants access + +php/FILE_APPEND +;=>8 diff --git a/php/types.php b/impls/php/types.php similarity index 88% rename from php/types.php rename to impls/php/types.php index fa87197312..006bcc9f2c 100644 --- a/php/types.php +++ b/impls/php/types.php @@ -2,7 +2,7 @@ // Errors/Exceptions -class Error extends Exception { +class _Error extends Exception { public $obj = null; public function __construct($obj) { parent::__construct("Mal Error", 0, null); @@ -27,6 +27,14 @@ function _equal_Q($a, $b) { if (!_equal_Q($a[$i], $b[$i])) { return false; } } return true; + } elseif (_hash_map_Q($a)) { + if ($a->count() !== $b->count()) { return false; } + $hm1 = $a->getArrayCopy(); + $hm2 = $b->getArrayCopy(); + foreach (array_keys($hm1) as $k) { + if (!_equal_Q($hm1[$k], $hm2[$k])) { return false; } + } + return true; } else { return $a === $b; } @@ -39,7 +47,10 @@ function _sequential_Q($seq) { return _list_Q($seq) or _vector_Q($seq); } function _nil_Q($obj) { return $obj === NULL; } function _true_Q($obj) { return $obj === true; } function _false_Q($obj) { return $obj === false; } -function _string_Q($obj) { return is_string($obj); } +function _string_Q($obj) { + return is_string($obj) && strpos($obj, chr(0x7f)) !== 0; +} +function _number_Q($obj) { return is_int($obj); } // Symbols @@ -54,7 +65,13 @@ function _symbol($name) { return new SymbolClass($name); } function _symbol_Q($obj) { return ($obj instanceof SymbolClass); } // Keywords -function _keyword($name) { return chr(0x7f).$name; } +function _keyword($name) { + if (_keyword_Q($name)) { + return $name; + } else { + return chr(0x7f).$name; + } +} function _keyword_Q($obj) { return is_string($obj) && strpos($obj, chr(0x7f)) === 0; } @@ -104,9 +121,10 @@ function _function($func, $type='platform', return new FunctionClass($func, $type, $ast, $env, $params, $ismacro); } function _function_Q($obj) { return $obj instanceof FunctionClass; } +function _fn_Q($obj) { return $obj instanceof Closure; } -// Parent class of list, vector, hash-map +// Parent class of list, vector // http://www.php.net/manual/en/class.arrayobject.php class SeqClass extends ArrayObject { public function slice($start, $length=NULL) { diff --git a/impls/php/webrunner.php b/impls/php/webrunner.php new file mode 100644 index 0000000000..ce720a7f20 --- /dev/null +++ b/impls/php/webrunner.php @@ -0,0 +1,8 @@ + diff --git a/impls/picolisp/Dockerfile b/impls/picolisp/Dockerfile new file mode 100644 index 0000000000..a461e039ed --- /dev/null +++ b/impls/picolisp/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# picolisp +RUN apt-get -y install picolisp libreadline-dev diff --git a/impls/picolisp/Makefile b/impls/picolisp/Makefile new file mode 100644 index 0000000000..7af3113c71 --- /dev/null +++ b/impls/picolisp/Makefile @@ -0,0 +1,3 @@ +all: + +clean: diff --git a/impls/picolisp/core.l b/impls/picolisp/core.l new file mode 100644 index 0000000000..a549d782b7 --- /dev/null +++ b/impls/picolisp/core.l @@ -0,0 +1,180 @@ +(de MAL-= (A B) + (let (A* (MAL-type A) + B* (MAL-type B)) + (cond + ((and (= A* 'map) (= B* 'map)) + (MAL-map-= (MAL-value A) (MAL-value B)) ) + ((and (memq A* '(list vector)) (memq B* '(list vector))) + (MAL-seq-= (MAL-value A) (MAL-value B)) ) + ((= A* B*) + (= (MAL-value A) (MAL-value B)) ) + (T NIL) ) ) ) + +(de MAL-map-= (As Bs) + (when (= (length As) (length Bs)) + (let (As* (chunk As) Bs* (chunk Bs)) + (catch 'result + (while As* + (let (A (pop 'As*) Key (MAL-value (car A)) Val (cdr A) + B (find '((X) (= Key (MAL-value (car X)))) Bs*) ) + (when (or (not B) (not (MAL-= Val (cdr B)))) + (throw 'result NIL) ) ) ) + T ) ) ) ) + +(de MAL-seq-= (As Bs) + (when (= (length As) (length Bs)) + (catch 'result + (while As + (ifn (MAL-= (pop 'As) (pop 'Bs)) + (throw 'result NIL) ) ) + T ) ) ) + +(de MAL-seq? (X) + (memq (MAL-type X) '(list vector)) ) + +(de MAL-f (X) + (MAL-value (if (isa '+Func X) (get X 'fn) X)) ) + +(de MAL-swap! @ + (let (X (next) Fn (next) Args (rest)) + (put X 'value (apply (MAL-f Fn) Args (MAL-value X))) ) ) + +(de MAL-nth (Seq N) + (let (Seq* (MAL-value Seq) N* (MAL-value N)) + (if (< N* (length Seq*)) + (nth Seq* (inc N*) 1) + (throw 'err (MAL-error (MAL-string "out of bounds"))) ) ) ) + +(de chunk (List) + (make + (for (L List L (cddr L)) + (link (cons (car L) (cadr L))) ) ) ) + +(de join (List) + (mapcan '((X) (list (car X) (cdr X))) List) ) + +(de MAL-assoc @ + (let (Map (next) Args (rest)) + (MAL-map + (append Args + (join + (filter '((X) (not (find '((Y) (MAL-= (car Y) (car X))) + (chunk Args) ) ) ) + (chunk (MAL-value Map)) ) ) ) ) ) ) + +(de MAL-dissoc @ + (let (Map (next) Args (rest)) + (MAL-map + (make + (for (L (MAL-value Map) L (cddr L)) + (unless (find '((X) (MAL-= (car L) X)) Args) + (link (car L) (cadr L)) ) ) ) ) ) ) + +(de MAL-seq (X) + (if (or (= (MAL-type X) 'nil) (not (MAL-value X))) + *MAL-nil + (case (MAL-type X) + (list X) + (vector (MAL-list (MAL-value X))) + (string (MAL-list (mapcar MAL-string (chop (MAL-value X))))) ) ) ) + +(de MAL-conj @ + (let (Seq (next) Args (rest)) + (if (= (MAL-type Seq) 'vector) + (MAL-vector (append (MAL-value Seq) Args)) + (MAL-list (append (reverse Args) (MAL-value Seq))) ) ) ) + +(de clone (X) + (let X* (new (val X)) + (maps '((C) (put X* (cdr C) (car C))) X) + X* ) ) + +(de pil-to-mal (X) + (cond + ((not X) *MAL-nil) + ((=T X) *MAL-true) + ((num? X) (MAL-number X)) + ((str? X) (MAL-string X)) + ((sym? X) (MAL-symbol X)) + ((lst? X) (MAL-list (mapcar pil-to-mal X))) + (T (MAL-string (sym X))) ) ) + +(def '*Ns + '((+ . `(MAL-fn '((A B) (MAL-number (+ (MAL-value A) (MAL-value B)))))) + (- . `(MAL-fn '((A B) (MAL-number (- (MAL-value A) (MAL-value B)))))) + (* . `(MAL-fn '((A B) (MAL-number (* (MAL-value A) (MAL-value B)))))) + (/ . `(MAL-fn '((A B) (MAL-number (/ (MAL-value A) (MAL-value B)))))) + + (< . `(MAL-fn '((A B) (if (< (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) + (<= . `(MAL-fn '((A B) (if (<= (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) + (> . `(MAL-fn '((A B) (if (> (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) + (>= . `(MAL-fn '((A B) (if (>= (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) + + (= . `(MAL-fn '((A B) (if (MAL-= A B) *MAL-true *MAL-false)))) + + (list . `(MAL-fn '(@ (MAL-list (rest))))) + (list? . `(MAL-fn '((X) (if (= (MAL-type X) 'list) *MAL-true *MAL-false)))) + (empty? . `(MAL-fn '((X) (if (and (MAL-seq? X) (not (MAL-value X))) *MAL-true *MAL-false)))) + (count . `(MAL-fn '((X) (if (MAL-seq? X) (MAL-number (length (MAL-value X))) (MAL-number 0))))) + + (pr-str . `(MAL-fn '(@ (MAL-string (glue " " (mapcar '((X) (pr-str X T)) (rest))))))) + (str . `(MAL-fn '(@ (MAL-string (pack (mapcar pr-str (rest))))))) + (prn . `(MAL-fn '(@ (prinl (glue " " (mapcar '((X) (pr-str X T)) (rest)))) *MAL-nil))) + (println . `(MAL-fn '(@ (prinl (glue " " (mapcar pr-str (rest)))) *MAL-nil))) + + (read-string . `(MAL-fn '((X) (read-str (MAL-value X))))) + (slurp . `(MAL-fn '((X) (MAL-string (in (MAL-value X) (till NIL T)))))) + + (atom . `(MAL-fn '((X) (MAL-atom X)))) + (atom? . `(MAL-fn '((X) (if (= (MAL-type X) 'atom) *MAL-true *MAL-false)))) + (deref . `(MAL-fn '((X) (MAL-value X)))) + (reset! . `(MAL-fn '((X Value) (put X 'value Value)))) + (swap! . `(MAL-fn MAL-swap!)) + + (cons . `(MAL-fn '((X Seq) (MAL-list (cons X (MAL-value Seq)))))) + (concat . `(MAL-fn '(@ (MAL-list (apply append (mapcar MAL-value (rest))))))) + (vec . `(MAL-fn '((Seq) (MAL-vector (MAL-value Seq))))) + + (nth . `(MAL-fn MAL-nth)) + (first . `(MAL-fn '((X) (if (MAL-seq? X) (or (car (MAL-value X)) *MAL-nil) *MAL-nil)))) + (rest . `(MAL-fn '((X) (if (MAL-seq? X) (MAL-list (cdr (MAL-value X))) (MAL-list NIL))))) + + (throw . `(MAL-fn '((X) (throw 'err (MAL-error X))))) + + (apply . `(MAL-fn '(@ (let (Fn (next) X (rest)) (apply (MAL-f Fn) (append (head -1 X) (MAL-value (last X)))))))) + (map . `(MAL-fn '((Fn Seq) (MAL-list (mapcar (MAL-f Fn) (MAL-value Seq)))))) + + (nil? . `(MAL-fn '((X) (if (= (MAL-type X) 'nil) *MAL-true *MAL-false)))) + (true? . `(MAL-fn '((X) (if (= (MAL-type X) 'true) *MAL-true *MAL-false)))) + (false? . `(MAL-fn '((X) (if (= (MAL-type X) 'false) *MAL-true *MAL-false)))) + (number? . `(MAL-fn '((X) (if (= (MAL-type X) 'number) *MAL-true *MAL-false)))) + (symbol? . `(MAL-fn '((X) (if (= (MAL-type X) 'symbol) *MAL-true *MAL-false)))) + (keyword? . `(MAL-fn '((X) (if (= (MAL-type X) 'keyword) *MAL-true *MAL-false)))) + (string? . `(MAL-fn '((X) (if (= (MAL-type X) 'string) *MAL-true *MAL-false)))) + (vector? . `(MAL-fn '((X) (if (= (MAL-type X) 'vector) *MAL-true *MAL-false)))) + (map? . `(MAL-fn '((X) (if (= (MAL-type X) 'map) *MAL-true *MAL-false)))) + (sequential? . `(MAL-fn '((X) (if (MAL-seq? X) *MAL-true *MAL-false)))) + (fn? . `(MAL-fn '((X) (if (or (= (MAL-type X) 'fn) (and (= (MAL-type X) 'func) (not (get X 'is-macro)))) *MAL-true *MAL-false)))) + (macro? . `(MAL-fn '((X) (if (and (= (MAL-type X) 'func) (get X 'is-macro)) *MAL-true *MAL-false)))) + + (symbol . `(MAL-fn '((Name) (MAL-symbol (MAL-value Name))))) + (keyword . `(MAL-fn '((X) (if (= (MAL-type X) 'keyword) X (MAL-keyword (MAL-value X)))))) + (vector . `(MAL-fn '(@ (MAL-vector (rest))))) + (hash-map . `(MAL-fn '(@ (MAL-map (rest))))) + + (assoc . `(MAL-fn MAL-assoc)) + (dissoc . `(MAL-fn MAL-dissoc)) + (get . `(MAL-fn '((Map Key) (or (and (<> (MAL-type Map) 'nil) (cdr (find '((X) (MAL-= (car X) Key)) (chunk (MAL-value Map))))) *MAL-nil)))) + (contains? . `(MAL-fn '((Map Key) (if (find '((X) (MAL-= (car X) Key)) (chunk (MAL-value Map))) *MAL-true *MAL-false)))) + (keys . `(MAL-fn '((Map) (MAL-list (mapcar car (chunk (MAL-value Map))))))) + (vals . `(MAL-fn '((Map) (MAL-list (extract cdr (chunk (MAL-value Map))))))) + + (with-meta . `(MAL-fn '((X Meta) (let X* (clone X) (put X* 'meta Meta) X*)))) + (meta . `(MAL-fn '((X) (or (MAL-meta X) *MAL-nil)))) + + (readline . `(MAL-fn '((Prompt) (let Output (readline (MAL-value Prompt)) (if (=0 Output) NIL (MAL-string Output)))))) + (time-ms . `(MAL-fn '(() (MAL-number (/ (usec) 1000))))) + (conj . `(MAL-fn MAL-conj)) + (seq . `(MAL-fn MAL-seq)) + + (pil-eval . `(MAL-fn '((Input) (pil-to-mal (run (str (MAL-value Input))))))) ) ) diff --git a/impls/picolisp/env.l b/impls/picolisp/env.l new file mode 100644 index 0000000000..29bef1e422 --- /dev/null +++ b/impls/picolisp/env.l @@ -0,0 +1,20 @@ +(class +Env) +# data outer +(dm T (Outer Binds Exprs) + (=: data (new)) + (=: outer Outer) + (for (Binds Binds Binds) + (if (<> (car Binds) '&) + (set> This (pop 'Binds) (pop 'Exprs)) + (pop 'Binds) + (set> This (pop 'Binds) (MAL-list Exprs)) ) ) ) + +(de MAL-env (Outer Binds Exprs) + (new '(+Env) Outer Binds Exprs) ) + +(dm set> (Key Value) + (put (: data) Key Value) ) + +(dm get> (Key) + (or (get (: data) Key) + (and (: outer) (get> @ Key)) ) ) diff --git a/impls/picolisp/func.l b/impls/picolisp/func.l new file mode 100644 index 0000000000..fe329a522d --- /dev/null +++ b/impls/picolisp/func.l @@ -0,0 +1,20 @@ +(class +Func) +# env ast params fn +(dm T (Env Ast Params Fn) + (=: type 'func) # HACK + (=: env Env) + (=: ast Ast) + (=: params Params) + (=: fn Fn) ) + +(de MAL-func (Env Ast Params Fn) + (new '(+Func) Env Ast Params Fn) ) + +(de MAL-macro (MalFn) + (let (env (get MalFn 'env) + ast (get MalFn 'ast) + params (get MalFn 'params) + fn (get MalFn 'fn) + clone (MAL-func env ast params fn)) + (put clone 'is-macro T) + clone)) diff --git a/impls/picolisp/printer.l b/impls/picolisp/printer.l new file mode 100644 index 0000000000..81ad6f8396 --- /dev/null +++ b/impls/picolisp/printer.l @@ -0,0 +1,28 @@ +(de pr-str (Ast PrintReadably) + (let Value (MAL-value Ast) + (case (MAL-type Ast) + ((true false nil) + (sym @) ) + (string (if PrintReadably (repr Value) Value)) + (keyword (pack ":" Value)) + ((number symbol) Value) + (fn "#") + (func "#") + (list (pr-list Value PrintReadably "(" ")")) + (vector (pr-list Value PrintReadably "[" "]")) + (map (pr-list Value PrintReadably "{" "}")) + (atom (pack "(atom " (pr-str Value PrintReadably) ")")) + (T (pretty Value) (throw 'err (MAL-error (MAL-string "[pr-str] unimplemented type")))) ) ) ) + +(de repr (X) + (let Chars (chop X) + (if (not X) + "\"\"" + (setq Chars (replace Chars "\\" "\\\\")) + (setq Chars (replace Chars "\"" "\\\"")) + (setq Chars (replace Chars "\n" "\\n")) + (pack "\"" Chars "\"") ) ) ) + +(de pr-list (Forms PrintReadably Starter Ender) + (let Values (mapcar '((Form) (pr-str Form PrintReadably)) Forms) + (pack Starter (glue " " Values) Ender) ) ) diff --git a/impls/picolisp/reader.l b/impls/picolisp/reader.l new file mode 100644 index 0000000000..f6df3ee3f7 --- /dev/null +++ b/impls/picolisp/reader.l @@ -0,0 +1,126 @@ +(class +Reader) +# tokens +(dm T (Tokens) + (=: tokens Tokens) ) + +(dm next> () + (pop (:: tokens)) ) + +(dm peek> () + (car (: tokens)) ) + +(de read-str (String) + (let (Tokens (tokenizer String) + Reader (new '(+Reader) Tokens) ) + (read-form Reader) ) ) + +(de tokenizer (String) + # [\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*) + (let (Special " []{}()'\"`,;" ) + (make + (for (Chars (chop String) Chars) + (let Char (pop 'Chars) + (cond + ((or (sp? Char) (= Char ",")) + # do nothing, whitespace + ) + ((and (= Char "~") (= (car Chars) "@")) + (link "~@") + (pop 'Chars) ) # remove @ token + ((index Char (chop "[]{}()'`~^\@")) + (link Char) ) + ((= Char "\"") + (link + (pack + (make + (link Char) # HACK + (use Done + (while (and Chars (not Done)) + (let Char (pop 'Chars) + (cond + ((= Char "\\") + (if Chars + (let Char (pop 'Chars) + (if (= Char "n") + (link "\n") + (link Char) ) ) + (throw 'err (MAL-error (MAL-string "expected '\"', got EOF"))) ) ) + ((<> Char "\"") + (link Char) ) + ((= Char "\"") + (setq Done T) ) ) ) ) + (unless Done + (throw 'err (MAL-error (MAL-string "expected '\"', got EOF"))) ) ) ) ) ) ) + ((= Char ";") + (while (and Chars (<> Char "\n")) + (setq Char (pop 'Chars)) ) ) + ((and (not (index Char (chop Special))) (not (sp? Char))) + (link + (pack + (make + (link Char) + (let Char (car Chars) + (while (and Chars (not (index Char (chop Special))) (not (sp? Char))) + (link (pop 'Chars)) + (setq Char (car Chars)) ) ) ) ) ) ) ) ) ) ) ) ) + +(de read-form (Reader) + (case (peek> Reader) + ("'" (read-macro Reader 'quote)) + ("`" (read-macro Reader 'quasiquote)) + ("~" (read-macro Reader 'unquote)) + ("~@" (read-macro Reader 'splice-unquote)) + ("@" (read-macro Reader 'deref)) + ("\^" (read-meta Reader)) + ("(" (read-list Reader 'list ")")) + ("[" (read-list Reader 'vector "]")) + ("{" (read-list Reader 'map "}")) + (T (read-atom Reader)) ) ) + +(de read-macro (Reader symbol) + (next> Reader) # pop reader macro token + (MAL-list (list (MAL-symbol symbol) (read-form Reader))) ) + +(de read-meta (Reader) + (next> Reader) # pop reader macro token + (let Form (read-form Reader) + (MAL-list (list (MAL-symbol 'with-meta) (read-form Reader) Form) ) ) ) + +(de read-list (Reader Type Ender) + (next> Reader) # pop list start + (new (list (case Type + (list '+MALList) + (vector '+MALVector) + (map '+MALMap) ) ) + (make + (use Done + (while (not Done) + (let Token (peek> Reader) + (cond + ((= Token Ender) + (next> Reader) # pop list end + (setq Done T) ) + ((not Token) + (let Msg (pack "expected '" Ender "', got EOF") + (throw 'err (MAL-error (MAL-string Msg))) ) ) + (T (link (read-form Reader))) ) ) ) ) ) ) ) + +(de read-atom (Reader) + (let (Token (next> Reader) + Chars (chop Token)) + (cond + ((= Token "true") + *MAL-true) + ((= Token "false") + *MAL-false) + ((= Token "nil") + *MAL-nil) + ((format Token) + (MAL-number @) ) + ((= (car Chars) "\"") + (MAL-string (pack (cdr Chars))) ) + ((= (car Chars) ":") + (MAL-keyword (intern (pack (cdr Chars)))) ) + ((not Token) + (throw 'err (MAL-error (MAL-string "end of token stream"))) ) + (T (MAL-symbol (intern Token))) ) ) ) diff --git a/impls/picolisp/readline.l b/impls/picolisp/readline.l new file mode 100644 index 0000000000..777e7d3e98 --- /dev/null +++ b/impls/picolisp/readline.l @@ -0,0 +1,19 @@ +(de load-history (File) + (when (info File) + (in File + (until (eof) + (native "libreadline.so" "add_history" NIL (line T)) ) ) ) ) + +(de save-to-history (Input) + (when Input + (native "libreadline.so" "add_history" NIL Input) + (out "+.mal_history" + (prinl Input) ) ) ) + +(de readline (Prompt) + (let Input (native "libreadline.so" "readline" 'N Prompt) + (if (=0 Input) + 0 + (prog1 + (struct Input 'S) + (save-to-history @) ) ) ) ) diff --git a/impls/picolisp/run b/impls/picolisp/run new file mode 100755 index 0000000000..a7f77da3fd --- /dev/null +++ b/impls/picolisp/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec pil $(dirname $0)/${STEP:-stepA_mal}.l - "${@}" diff --git a/impls/picolisp/step0_repl.l b/impls/picolisp/step0_repl.l new file mode 100644 index 0000000000..0f40e9bd0f --- /dev/null +++ b/impls/picolisp/step0_repl.l @@ -0,0 +1,28 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") + +(de READ (String) + String) + +(de EVAL (Ast) + Ast) + +(de PRINT (Ast) + Ast) + +(de rep (String) + (PRINT (EVAL (READ String))) ) + +(load-history ".mal_history") + +(use Eof + (until Eof + (let Input (readline "user> ") + (if (=0 Input) + (setq Eof T) + (prinl (rep Input)) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step1_read_print.l b/impls/picolisp/step1_read_print.l new file mode 100644 index 0000000000..5e4008801a --- /dev/null +++ b/impls/picolisp/step1_read_print.l @@ -0,0 +1,36 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") + +(de READ (String) + (read-str String) ) + +(de EVAL (Ast) + Ast) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String))) ) + +(load-history ".mal_history") + +(use Eof + (until Eof + (let Input (readline "user> ") + (if (=0 Input) + (setq Eof T) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step2_eval.l b/impls/picolisp/step2_eval.l new file mode 100644 index 0000000000..6f74561491 --- /dev/null +++ b/impls/picolisp/step2_eval.l @@ -0,0 +1,56 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv + '((+ . ((A B) (MAL-number (+ (MAL-value A) (MAL-value B))))) + (- . ((A B) (MAL-number (- (MAL-value A) (MAL-value B))))) + (* . ((A B) (MAL-number (* (MAL-value A) (MAL-value B))))) + (/ . ((A B) (MAL-number (/ (MAL-value A) (MAL-value B))))) ) ) + +(de EVAL (Ast Env) + ;; (prinl "EVAL: " (pr-str Ast T)) + (let Value (MAL-value Ast) + (case (MAL-type Ast) + (symbol + (if (assoc Value Env) + (cdr @) + (throw 'err (MAL-error (MAL-string (pack "'" Value "' not found")))) ) ) + (list + (if Value + (let El (mapcar '((Form) (EVAL Form Env)) Value) + (apply (car El) (cdr El))) + Ast)) + (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) + (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) + (T Ast) ) ) ) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(load-history ".mal_history") + +(use Eof + (until Eof + (let Input (readline "user> ") + (if (=0 Input) + (setq Eof T) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step3_env.l b/impls/picolisp/step3_env.l new file mode 100644 index 0000000000..a061b75af3 --- /dev/null +++ b/impls/picolisp/step3_env.l @@ -0,0 +1,73 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(set> *ReplEnv '+ '((A B) (MAL-number (+ (MAL-value A) (MAL-value B))))) +(set> *ReplEnv '- '((A B) (MAL-number (- (MAL-value A) (MAL-value B))))) +(set> *ReplEnv '* '((A B) (MAL-number (* (MAL-value A) (MAL-value B))))) +(set> *ReplEnv '/ '((A B) (MAL-number (/ (MAL-value A) (MAL-value B))))) + +(de EVAL (Ast Env) + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1* (MAL-value (cadr Ast*)) + A2 (caddr Ast*)) + (cond + ((not Ast*) + Ast) + ((= A0* 'def!) + (set> Env A1* (EVAL A2 Env)) ) + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*)) + (set> Env* Key Value) ) ) + (EVAL A2 Env*) ) ) + (T (let Value (mapcar '((Form) (EVAL Form Env)) Ast*) + (apply (car Value) (cdr Value)) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast)) + (or (get> Env Key) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) + (map (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) + (T Ast))) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(load-history ".mal_history") + +(use Eof + (until Eof + (let Input (readline "user> ") + (if (=0 Input) + (setq Eof T) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step4_if_fn_do.l b/impls/picolisp/step4_if_fn_do.l new file mode 100644 index 0000000000..6d39ec16c5 --- /dev/null +++ b/impls/picolisp/step4_if_fn_do.l @@ -0,0 +1,92 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") +(load-relative "func.l") +(load-relative "core.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) + +(de EVAL (Ast Env) + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1 (cadr Ast*) + A1* (MAL-value A1) + A2 (caddr Ast*) + A3 (cadddr Ast*) ) + (cond + ((not Ast*) + Ast) + ((= A0* 'def!) + (set> Env A1* (EVAL A2 Env)) ) + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*)) + (set> Env* Key Value) ) ) + (EVAL A2 Env*) ) ) + ((= A0* 'do) + (for Form (cdr Ast*) + (EVAL Form Env) ) ) + ((= A0* 'if) + (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) + (EVAL A2 Env) + (if A3 + (EVAL A3 Env) + *MAL-nil ) ) ) + ((= A0* 'fn*) + (let (Binds (mapcar MAL-value A1*) + Body A2) + (MAL-fn + (curry (Env Binds Body) @ + (let Env* (MAL-env Env Binds (rest)) + (EVAL Body Env*) ) ) ) ) ) + (T + (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) + Fn (MAL-value (car Ast*)) + Args (cdr Ast*)) + (apply Fn Args) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast)) + (or (get> Env Key) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) + (map (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) + (T Ast))) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(rep "(def! not (fn* (a) (if a false true)))") + +(load-history ".mal_history") + +(use Input + (until (=0 (setq Input (readline "user> "))) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step5_tco.l b/impls/picolisp/step5_tco.l new file mode 100644 index 0000000000..067db07954 --- /dev/null +++ b/impls/picolisp/step5_tco.l @@ -0,0 +1,102 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") +(load-relative "func.l") +(load-relative "core.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) + +(de EVAL (Ast Env) + (catch 'done + (while t + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1 (cadr Ast*) + A1* (MAL-value A1) + A2 (caddr Ast*) + A3 (cadddr Ast*) ) + (cond + ((not Ast*) + (throw 'done Ast)) + ((= A0* 'def!) + (throw 'done (set> Env A1* (EVAL A2 Env))) ) + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*) ) + (set> Env* Key Value) ) ) + (setq Env Env* Ast A2) ) ) # TCO + ((= A0* 'do) + (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) + (setq Ast (last Ast*)) ) # TCO + ((= A0* 'if) + (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) + (setq Ast A2) # TCO + (if A3 + (setq Ast A3) # TCO + (throw 'done *MAL-nil) ) ) ) + ((= A0* 'fn*) + (let (Binds (mapcar MAL-value A1*) + Body A2 + Fn (MAL-fn + (curry (Env Binds Body) @ + (let Env* (MAL-env Env Binds (rest)) + (EVAL Body Env*) ) ) ) ) + (throw 'done (MAL-func Env Body Binds Fn)) ) ) + (T + (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) + Fn (car Ast*) + Args (cdr Ast*) ) + (if (isa '+MALFn Fn) + (throw 'done (apply (MAL-value Fn) Args)) + (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast) + Value (get> Env Key)) + (if Value + (throw 'done Value) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (throw 'done + (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done + (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)))))) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(rep "(def! not (fn* (a) (if a false true)))") + +(load-history ".mal_history") + +(use Input + (until (=0 (setq Input (readline "user> "))) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step6_file.l b/impls/picolisp/step6_file.l new file mode 100644 index 0000000000..f6c08bf439 --- /dev/null +++ b/impls/picolisp/step6_file.l @@ -0,0 +1,108 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") +(load-relative "func.l") +(load-relative "core.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) + +(de EVAL (Ast Env) + (catch 'done + (while t + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1 (cadr Ast*) + A1* (MAL-value A1) + A2 (caddr Ast*) + A3 (cadddr Ast*) ) + (cond + ((not Ast*) + (throw 'done Ast)) + ((= A0* 'def!) + (throw 'done (set> Env A1* (EVAL A2 Env))) ) + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*) ) + (set> Env* Key Value) ) ) + (setq Env Env* Ast A2) ) ) # TCO + ((= A0* 'do) + (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) + (setq Ast (last Ast*)) ) # TCO + ((= A0* 'if) + (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) + (setq Ast A2) # TCO + (if A3 + (setq Ast A3) # TCO + (throw 'done *MAL-nil) ) ) ) + ((= A0* 'fn*) + (let (Binds (mapcar MAL-value A1*) + Body A2 + Fn (MAL-fn + (curry (Env Binds Body) @ + (let Env* (MAL-env Env Binds (rest)) + (EVAL Body Env*) ) ) ) ) + (throw 'done (MAL-func Env Body Binds Fn)) ) ) + (T + (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) + Fn (car Ast*) + Args (cdr Ast*) ) + (if (isa '+MALFn Fn) + (throw 'done (apply (MAL-value Fn) Args)) + (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast) + Value (get> Env Key)) + (if Value + (throw 'done Value) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (throw 'done + (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done + (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)))))) + +(set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) +(set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(load-history ".mal_history") + +(if (argv) + (rep (pack "(load-file \"" (car (argv)) "\")")) + (use Input + (until (=0 (setq Input (readline "user> "))) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step7_quote.l b/impls/picolisp/step7_quote.l new file mode 100644 index 0000000000..77bc6223a4 --- /dev/null +++ b/impls/picolisp/step7_quote.l @@ -0,0 +1,138 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") +(load-relative "func.l") +(load-relative "core.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) + +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) + +(de quasiquote (Ast) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) + +(de EVAL (Ast Env) + (catch 'done + (while t + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1 (cadr Ast*) + A1* (MAL-value A1) + A2 (caddr Ast*) + A3 (cadddr Ast*) ) + (cond + ((not Ast*) + (throw 'done Ast)) + ((= A0* 'def!) + (throw 'done (set> Env A1* (EVAL A2 Env))) ) + ((= A0* 'quote) + (throw 'done A1) ) + ((= A0* 'quasiquote) + (setq Ast (quasiquote A1)) ) # TCO + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*) ) + (set> Env* Key Value) ) ) + (setq Env Env* Ast A2) ) ) # TCO + ((= A0* 'do) + (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) + (setq Ast (last Ast*)) ) # TCO + ((= A0* 'if) + (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) + (setq Ast A2) # TCO + (if A3 + (setq Ast A3) # TCO + (throw 'done *MAL-nil) ) ) ) + ((= A0* 'fn*) + (let (Binds (mapcar MAL-value A1*) + Body A2 + Fn (MAL-fn + (curry (Env Binds Body) @ + (let Env* (MAL-env Env Binds (rest)) + (EVAL Body Env*) ) ) ) ) + (throw 'done (MAL-func Env Body Binds Fn)) ) ) + (T + (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) + Fn (car Ast*) + Args (cdr Ast*) ) + (if (isa '+MALFn Fn) + (throw 'done (apply (MAL-value Fn) Args)) + (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast) + Value (get> Env Key)) + (if Value + (throw 'done Value) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (throw 'done + (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done + (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)))))) + +(set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) +(set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(load-history ".mal_history") + +(if (argv) + (rep (pack "(load-file \"" (car (argv)) "\")")) + (use Input + (until (=0 (setq Input (readline "user> "))) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step8_macros.l b/impls/picolisp/step8_macros.l new file mode 100644 index 0000000000..895d202aea --- /dev/null +++ b/impls/picolisp/step8_macros.l @@ -0,0 +1,143 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") +(load-relative "func.l") +(load-relative "core.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) + +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) + +(de quasiquote (Ast) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) + +(de EVAL (Ast Env) + (catch 'done + (while t + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1 (cadr Ast*) + A1* (MAL-value A1) + A2 (caddr Ast*) + A3 (cadddr Ast*) ) + (cond + ((not Ast*) + (throw 'done Ast)) + ((= A0* 'def!) + (throw 'done (set> Env A1* (EVAL A2 Env))) ) + ((= A0* 'quote) + (throw 'done A1) ) + ((= A0* 'quasiquote) + (setq Ast (quasiquote A1)) ) # TCO + ((= A0* 'defmacro!) + (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*) ) + (set> Env* Key Value) ) ) + (setq Env Env* Ast A2) ) ) # TCO + ((= A0* 'do) + (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) + (setq Ast (last Ast*)) ) # TCO + ((= A0* 'if) + (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) + (setq Ast A2) # TCO + (if A3 + (setq Ast A3) # TCO + (throw 'done *MAL-nil) ) ) ) + ((= A0* 'fn*) + (let (Binds (mapcar MAL-value A1*) + Body A2 + Fn (MAL-fn + (curry (Env Binds Body) @ + (let Env* (MAL-env Env Binds (rest)) + (EVAL Body Env*) ) ) ) ) + (throw 'done (MAL-func Env Body Binds Fn)) ) ) + (T + (let (Fn (EVAL (car Ast*) Env)) + (if (get Fn 'is-macro) + (setq Ast (apply (MAL-value (get Fn 'fn)) (cdr Ast*))) # TCO + (let Args (mapcar '((Form) (EVAL Form Env)) (cdr Ast*)) + (if (isa '+MALFn Fn) + (throw 'done (apply (MAL-value Fn) Args)) + (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast) + Value (get> Env Key)) + (if Value + (throw 'done Value) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (throw 'done + (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done + (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)))))) + +(set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) +(set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +(load-history ".mal_history") + +(if (argv) + (rep (pack "(load-file \"" (car (argv)) "\")")) + (use Input + (until (=0 (setq Input (readline "user> "))) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/step9_try.l b/impls/picolisp/step9_try.l new file mode 100644 index 0000000000..1686ee8a60 --- /dev/null +++ b/impls/picolisp/step9_try.l @@ -0,0 +1,155 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") +(load-relative "func.l") +(load-relative "core.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) + +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) + +(de quasiquote (Ast) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) + +(de EVAL (Ast Env) + (catch 'done + (while t + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1 (cadr Ast*) + A1* (MAL-value A1) + A2 (caddr Ast*) + A3 (cadddr Ast*) ) + (cond + ((not Ast*) + (throw 'done Ast)) + ((= A0* 'def!) + (throw 'done (set> Env A1* (EVAL A2 Env))) ) + ((= A0* 'quote) + (throw 'done A1) ) + ((= A0* 'quasiquote) + (setq Ast (quasiquote A1)) ) # TCO + ((= A0* 'defmacro!) + (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) + ((= A0* 'try*) + (let Result (catch 'err (throw 'done (EVAL A1 Env))) + (if (isa '+MALError Result) + (let A (MAL-value A2) + (if (and (= (MAL-type A2) 'list) + (= (MAL-value (car A)) 'catch*) ) + (let (Bind (MAL-value (cadr A)) + Exc (MAL-value Result) + Form (caddr A) + Env* (MAL-env Env (list Bind) (list Exc)) ) + (throw 'done (EVAL Form Env*)) ) + (throw 'err Result) ) ) + (throw 'done Result) ) ) ) + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*) ) + (set> Env* Key Value) ) ) + (setq Env Env* Ast A2) ) ) # TCO + ((= A0* 'do) + (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) + (setq Ast (last Ast*)) ) # TCO + ((= A0* 'if) + (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) + (setq Ast A2) # TCO + (if A3 + (setq Ast A3) # TCO + (throw 'done *MAL-nil) ) ) ) + ((= A0* 'fn*) + (let (Binds (mapcar MAL-value A1*) + Body A2 + Fn (MAL-fn + (curry (Env Binds Body) @ + (let Env* (MAL-env Env Binds (rest)) + (EVAL Body Env*) ) ) ) ) + (throw 'done (MAL-func Env Body Binds Fn)) ) ) + (T + (let (Fn (EVAL (car Ast*) Env)) + (if (get Fn 'is-macro) + (setq Ast (apply (MAL-value (get Fn 'fn)) (cdr Ast*))) # TCO + (let Args (mapcar '((Form) (EVAL Form Env)) (cdr Ast*)) + (if (isa '+MALFn Fn) + (throw 'done (apply (MAL-value Fn) Args)) + (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast) + Value (get> Env Key)) + (if Value + (throw 'done Value) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (throw 'done + (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done + (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)))))) + +(set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) +(set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(load-history ".mal_history") + +(if (argv) + (rep (pack "(load-file \"" (car (argv)) "\")")) + (use Input + (until (=0 (setq Input (readline "user> "))) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/stepA_mal.l b/impls/picolisp/stepA_mal.l new file mode 100644 index 0000000000..33c6e5da89 --- /dev/null +++ b/impls/picolisp/stepA_mal.l @@ -0,0 +1,157 @@ +(de load-relative (Path) + (load (pack (car (file)) Path)) ) + +(load-relative "readline.l") +(load-relative "types.l") +(load-relative "reader.l") +(load-relative "printer.l") +(load-relative "env.l") +(load-relative "func.l") +(load-relative "core.l") + +(de READ (String) + (read-str String) ) + +(def '*ReplEnv (MAL-env NIL)) +(for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) + +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) + +(de quasiquote (Ast) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) + +(de EVAL (Ast Env) + (catch 'done + (while t + (when (and (get> Env 'DEBUG-EVAL) + (not (memq (MAL-type @) '(nil false)))) + (prinl "EVAL: " (pr-str Ast T))) + + (case (MAL-type Ast) + (list + (let (Ast* (MAL-value Ast) + A0* (MAL-value (car Ast*)) + A1 (cadr Ast*) + A1* (MAL-value A1) + A2 (caddr Ast*) + A3 (cadddr Ast*) ) + (cond + ((not Ast*) + (throw 'done Ast)) + ((= A0* 'def!) + (throw 'done (set> Env A1* (EVAL A2 Env))) ) + ((= A0* 'quote) + (throw 'done A1) ) + ((= A0* 'quasiquote) + (setq Ast (quasiquote A1)) ) # TCO + ((= A0* 'defmacro!) + (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) + ((= A0* 'try*) + (let Result (catch 'err (throw 'done (EVAL A1 Env))) + (if (isa '+MALError Result) + (let A (MAL-value A2) + (if (and (= (MAL-type A2) 'list) + (= (MAL-value (car A)) 'catch*) ) + (let (Bind (MAL-value (cadr A)) + Exc (MAL-value Result) + Form (caddr A) + Env* (MAL-env Env (list Bind) (list Exc)) ) + (throw 'done (EVAL Form Env*)) ) + (throw 'err Result) ) ) + (throw 'done Result) ) ) ) + ((= A0* 'let*) + (let Env* (MAL-env Env) + (for (Bindings A1* Bindings) + (let (Key (MAL-value (pop 'Bindings)) + Value (EVAL (pop 'Bindings) Env*) ) + (set> Env* Key Value) ) ) + (setq Env Env* Ast A2) ) ) # TCO + ((= A0* 'do) + (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) + (setq Ast (last Ast*)) ) # TCO + ((= A0* 'if) + (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) + (setq Ast A2) # TCO + (if A3 + (setq Ast A3) # TCO + (throw 'done *MAL-nil) ) ) ) + ((= A0* 'fn*) + (let (Binds (mapcar MAL-value A1*) + Body A2 + Fn (MAL-fn + (curry (Env Binds Body) @ + (let Env* (MAL-env Env Binds (rest)) + (EVAL Body Env*) ) ) ) ) + (throw 'done (MAL-func Env Body Binds Fn)) ) ) + (T + (let (Fn (EVAL (car Ast*) Env)) + (if (get Fn 'is-macro) + (setq Ast (apply (MAL-value (get Fn 'fn)) (cdr Ast*))) # TCO + (let Args (mapcar '((Form) (EVAL Form Env)) (cdr Ast*)) + (if (isa '+MALFn Fn) + (throw 'done (apply (MAL-value Fn) Args)) + (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) + (symbol + (let (Key (MAL-value Ast) + Value (get> Env Key)) + (if Value + (throw 'done Value) + (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) + (vector (throw 'done + (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done + (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)))))) + +(set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) +(set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) +(set> *ReplEnv '*host-language* (MAL-string "pil")) + +(de PRINT (Ast) + (pr-str Ast T) ) + +(de rep (String) + (PRINT (EVAL (READ String) *ReplEnv)) ) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(load-history ".mal_history") + +(if (argv) + (rep (pack "(load-file \"" (car (argv)) "\")")) + (use Input + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (until (=0 (setq Input (readline "user> "))) + (let Output (catch 'err (rep Input)) + (if (isa '+MALError Output) + (let Message (MAL-value Output) + (unless (= (MAL-value Message) "end of token stream") + (prinl "[error] " (pr-str Message)) ) ) + (prinl Output) ) ) ) ) ) + +(prinl) +(bye) diff --git a/impls/picolisp/tests/step5_tco.mal b/impls/picolisp/tests/step5_tco.mal new file mode 100644 index 0000000000..901069482d --- /dev/null +++ b/impls/picolisp/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; PIL: skipping non-TCO recursion +;; Reason: segfault (unrecoverable) diff --git a/impls/picolisp/tests/stepA_mal.mal b/impls/picolisp/tests/stepA_mal.mal new file mode 100644 index 0000000000..562c5703ea --- /dev/null +++ b/impls/picolisp/tests/stepA_mal.mal @@ -0,0 +1,17 @@ +;; Testing basic pil interop + +(pil-eval "T") +;=>true + +(pil-eval "NIL") +;=>nil + +(pil-eval "(+ 1 1)") +;=>2 + +(pil-eval "(cons 1 2 3 NIL)") +;=>(1 2 3) + +(pil-eval "(use (@A @O) (match '(@A and @O) '(Alpha and Omega)) (prinl @A) (prinl @O))") +Alpha +Omega diff --git a/impls/picolisp/types.l b/impls/picolisp/types.l new file mode 100644 index 0000000000..299a071531 --- /dev/null +++ b/impls/picolisp/types.l @@ -0,0 +1,101 @@ +(class +MAL) +# type value meta +(dm T (Type Value Meta) + (=: type Type) + (=: value Value) + (=: meta Meta) ) + +(de MAL-type (MAL) + (get MAL 'type) ) + +(de MAL-value (MAL) + (get MAL 'value) ) + +(de MAL-meta (MAL) + (get MAL 'meta) ) + +(class +MALTrue +MAL) +(dm T () + (super 'true 'true NIL) ) + +(class +MALFalse +MAL) +(dm T () + (super 'false 'false NIL) ) + +(class +MALNil +MAL) +(dm T () + (super 'nil 'nil NIL) ) + +(def '*MAL-true (new '(+MALTrue))) +(def '*MAL-false (new '(+MALFalse))) +(def '*MAL-nil (new '(+MALNil))) + +(class +MALNumber +MAL) +(dm T (Number) + (super 'number Number NIL) ) + +(de MAL-number (N) + (new '(+MALNumber) N) ) + +(class +MALString +MAL) +(dm T (String) + (super 'string String NIL) ) + +(de MAL-string (N) + (new '(+MALString) N) ) + +(class +MALSymbol +MAL) +(dm T (String) + (super 'symbol String NIL) ) + +(de MAL-symbol (N) + (new '(+MALSymbol) N) ) + +(class +MALKeyword +MAL) +(dm T (String) + (super 'keyword String NIL) ) + +(de MAL-keyword (N) + (new '(+MALKeyword) N) ) + +(class +MALList +MAL) +(dm T (Values) + (super 'list Values NIL) ) + +(de MAL-list (N) + (new '(+MALList) N) ) + +(class +MALVector +MAL) +(dm T (Values) + (super 'vector Values NIL) ) + +(de MAL-vector (N) + (new '(+MALVector) N) ) + +(class +MALMap +MAL) +(dm T (Values) + (super 'map Values NIL) ) + +(de MAL-map (N) + (new '(+MALMap) N) ) + +(class +MALAtom +MAL) +(dm T (Value) + (super 'atom Value NIL) ) + +(de MAL-atom (N) + (new '(+MALAtom) N) ) + +(class +MALFn +MAL) +(dm T (Fn) + (super 'fn Fn NIL) ) + +(de MAL-fn (Fn) + (new '(+MALFn) Fn) ) + +(class +MALError +MAL) +(dm T (Value) + (super 'error Value NIL) ) + +(de MAL-error (Value) + (new '(+MALError) Value) ) diff --git a/impls/pike/Core.pmod b/impls/pike/Core.pmod new file mode 100644 index 0000000000..74b6d9c3c5 --- /dev/null +++ b/impls/pike/Core.pmod @@ -0,0 +1,98 @@ +import .Interop; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +private Val apply(mixed f, Val ... args) +{ + if(sizeof(args) == 1) return f(@args[0].data); + array(Val) mid_args = args[0..(sizeof(args) - 2)]; + return f(@(mid_args + args[-1].data)); +} + +private Val swap_bang(Val atom, mixed f, Val ... args) +{ + atom.data = f(@(({ atom.data }) + args)); + return atom.data; +} + +private mapping(string:function) builtins = ([ + "=": lambda(Val a, Val b) { return to_bool(a == b); }, + "throw": lambda(Val a) { throw(a); }, + + "nil?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_NIL); }, + "true?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_TRUE); }, + "false?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_FALSE); }, + "string?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_STRING); }, + "symbol": lambda(Val a) { return a.mal_type == MALTYPE_SYMBOL ? a : Symbol(a.value); }, + "symbol?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_SYMBOL); }, + "keyword": lambda(Val a) { return a.mal_type == MALTYPE_KEYWORD ? a : Keyword(a.value); }, + "keyword?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_KEYWORD); }, + "number?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_NUMBER); }, + "fn?": lambda(Val a) { return to_bool(a.is_fn && !a.macro); }, + "macro?": lambda(Val a) { return to_bool(a.macro); }, + + "pr-str": lambda(Val ... a) { return String(map(a, lambda(Val e) { return pr_str(e, true); }) * " "); }, + "str": lambda(Val ... a) { return String(map(a, lambda(Val e) { return pr_str(e, false); }) * ""); }, + "prn": lambda(Val ... a) { write(({ map(a, lambda(Val e) { return pr_str(e, true); }) * " ", "\n" })); return MAL_NIL; }, + "println": lambda(Val ... a) { write(({ map(a, lambda(Val e) { return pr_str(e, false); }) * " ", "\n" })); return MAL_NIL; }, + "read-string": lambda(Val a) { return read_str(a.value); }, + "readline": lambda(Val a) { string line = readline(a.value); return line ? String(line) : MAL_NIL; }, + "slurp": lambda(Val a) { return String(Stdio.read_file(a.value)); }, + + "<": lambda(Val a, Val b) { return to_bool(a.value < b.value); }, + "<=": lambda(Val a, Val b) { return to_bool(a.value <= b.value); }, + ">": lambda(Val a, Val b) { return to_bool(a.value > b.value); }, + ">=": lambda(Val a, Val b) { return to_bool(a.value >= b.value); }, + "+": lambda(Val a, Val b) { return Number(a.value + b.value); }, + "-": lambda(Val a, Val b) { return Number(a.value - b.value); }, + "*": lambda(Val a, Val b) { return Number(a.value * b.value); }, + "/": lambda(Val a, Val b) { return Number(a.value / b.value); }, + "time-ms": lambda() { array(int) t = System.gettimeofday(); return Number(t[0] * 1000 + t[1] / 1000); }, + + "list": lambda(Val ... a) { return List(a); }, + "list?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_LIST); }, + "vector": lambda(Val ... a) { return Vector(a); }, + "vector?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_VECTOR); }, + "hash-map": lambda(Val ... a) { return Map(a); }, + "map?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_MAP); }, + "assoc": lambda(Val a, Val ... b) { return a.assoc(b); }, + "dissoc": lambda(Val a, Val ... b) { return a.dissoc(b); }, + "get": lambda(Val a, Val b) { return a.mal_type != MALTYPE_NIL ? (a.data[b] || MAL_NIL) : MAL_NIL; }, + "contains?": lambda(Val a, Val b) { return to_bool(a.data[b]); }, + "keys": lambda(Val a) { return List(indices(a.data)); }, + "vals": lambda(Val a) { return List(values(a.data)); }, + + "sequential?": lambda(Val a) { return to_bool(a.is_sequence); }, + "cons": lambda(Val a, Val b) { return List(({ a }) + b.data); }, + "concat": lambda(Val ... a) { return List(`+(({ }), @map(a, lambda(Val e) { return e.data; }))); }, + "vec": lambda(Val a) { return Vector(a.data); }, + "nth": lambda(Val a, Val b) { return a.nth(b.value); }, + "first": lambda(Val a) { return a.first(); }, + "rest": lambda(Val a) { return a.rest(); }, + "empty?": lambda(Val a) { return to_bool(a.emptyp()); }, + "count": lambda(Val a) { return Number(a.count()); }, + "apply": apply, + "map": lambda(mixed f, Val a) { return List(map(a.data, f)); }, + + "conj": lambda(Val a, Val ... b) { return a.conj(b); }, + "seq": lambda(Val a) { return a.seq(); }, + + "meta": lambda(Val a) { return a.meta || MAL_NIL; }, + "with-meta": lambda(Val a, Val b) { Val new_a = a.clone(); new_a.meta = b; return new_a; }, + "atom": lambda(Val a) { return Atom(a); }, + "atom?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_ATOM); }, + "deref": lambda(Val a) { return a.data; }, + "reset!": lambda(Val a, Val b) { a.data = b; return a.data; }, + "swap!": swap_bang, + + "pike-eval": lambda(Val a) { return pike_eval(a.value); }, +]); + +mapping(Val:Val) NS() +{ + mapping(Val:Val) ns = ([ ]); + foreach(builtins; string name; function f) { ns[Symbol(name)] = BuiltinFn(name, f); } + return ns; +} diff --git a/impls/pike/Dockerfile b/impls/pike/Dockerfile new file mode 100644 index 0000000000..1d306c7eab --- /dev/null +++ b/impls/pike/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install pike8.0 diff --git a/impls/pike/Env.pmod b/impls/pike/Env.pmod new file mode 100644 index 0000000000..4ff72bc159 --- /dev/null +++ b/impls/pike/Env.pmod @@ -0,0 +1,39 @@ +import .Types; + +class Env +{ + Env outer; + mapping(string:Val) data; + + void create(Env the_outer, List|void binds, List|void exprs) + { + outer = the_outer; + data = ([ ]); + if(binds) + { + for(int i = 0; i < binds.count(); i++) + { + if(binds.data[i].value == "&") + { + set(binds.data[i + 1], List(exprs.data[i..])); + break; + } + set(binds.data[i], exprs.data[i]); + } + } + } + + Val set(Val key, Val val) + { + data[key.value] = val; + return val; + } + + Val get(string key) + { + Val res = data[key]; + if(res) return res; + if(outer) return outer.get(key); + return 0; + } +} diff --git a/impls/pike/Interop.pmod b/impls/pike/Interop.pmod new file mode 100644 index 0000000000..df09694579 --- /dev/null +++ b/impls/pike/Interop.pmod @@ -0,0 +1,33 @@ +import .Types; + +Val pike_eval(string expr_str) +{ + program prog = compile_string("mixed tmp_func() { return (" + expr_str + "); }", "pike-eval"); + mixed v = prog()->tmp_func(); + return pike2mal(v); +} + +private Val pike2mal(mixed v) +{ + if(stringp(v)) return String(v); + if(intp(v)) return Number(v); + if(arrayp(v)) + { + array(Val) res = ({ }); + foreach(v, mixed e) + { + res += ({ pike2mal(e) }); + } + return List(res); + } + if(mappingp(v)) + { + array(Val) res = ({ }); + foreach(v; mixed k; mixed v) + { + res += ({ pike2mal(k), pike2mal(v) }); + } + return Map(res); + } + return MAL_NIL; +} diff --git a/impls/pike/Makefile b/impls/pike/Makefile new file mode 100644 index 0000000000..862751b0fc --- /dev/null +++ b/impls/pike/Makefile @@ -0,0 +1,19 @@ +SOURCES_BASE = readline.pike types.pike reader.pike printer.pike +SOURCES_LISP = env.pike core.pike stepA_mal.pike +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.pike mal + +mal.pike: $(SOURCES) + cat $+ | grep -v "^#include" > $@ + +mal: mal.pike + echo "#!/usr/bin/env pike" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.pike mal diff --git a/impls/pike/Printer.pmod b/impls/pike/Printer.pmod new file mode 100644 index 0000000000..74760b0f4d --- /dev/null +++ b/impls/pike/Printer.pmod @@ -0,0 +1,7 @@ +import .Types; + +string pr_str(Val ast, bool print_readably) +{ + if(functionp(ast)) return "#"; + return ast->to_string(print_readably); +} diff --git a/impls/pike/Reader.pmod b/impls/pike/Reader.pmod new file mode 100644 index 0000000000..312f0bb1d0 --- /dev/null +++ b/impls/pike/Reader.pmod @@ -0,0 +1,122 @@ +import .Types; + +Regexp.PCRE tokenizer_regexp = Regexp.PCRE.Studied("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"([\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)"); +Regexp.PCRE string_regexp = Regexp.PCRE.Studied("^\"(?:[\\\\].|[^\\\\\"])*\"$"); +Regexp.PCRE number_regexp = Regexp.PCRE.Studied("^-?[0-9]+$"); + +private class Reader(private array(string) tokens, private void|int position) +{ + string next() + { + if(position >= sizeof(tokens)) return 0; + string token = tokens[position]; + position++; + return token; + } + + string peek() + { + if(position >= sizeof(tokens)) return 0; + return tokens[position]; + } +} + +private array(string) tokenize(string str) +{ + array(string) tokens = ({ }); + tokenizer_regexp.matchall(str, lambda(mixed m) { + if(sizeof(m[1]) > 0 && m[1][0] != ';') tokens += ({ m[1] }); + }); + return tokens; +} + +private string unescape_string(string token) +{ + if(!string_regexp.match(token)) throw("expected '\"', got EOF"); + string s = token[1..(sizeof(token) - 2)]; + s = replace(s, "\\\\", "\u029e"); + s = replace(s, "\\\"", "\""); + s = replace(s, "\\n", "\n"); + s = replace(s, "\u029e", "\\"); + return s; +} + +private Val read_atom(Reader reader) +{ + string token = reader->next(); + if(number_regexp.match(token)) return Number((int)token); + if(token[0] == '"') return String(unescape_string(token)); + if(token[0] == ':') return Keyword(token[1..]); + switch(token) + { + case "nil": return MAL_NIL; + case "true": return MAL_TRUE; + case "false": return MAL_FALSE; + } + return Symbol(token); +} + +private array(Val) read_seq(Reader reader, string start, string end) +{ + string token = reader->next(); + if(token != start) throw("expected '" + start + "'"); + token = reader->peek(); + array(Val) elements = ({ }); + while(token != end) + { + if(!token) throw("expected '" + end + "', got EOF"); + elements += ({ read_form(reader) }); + token = reader->peek(); + } + reader->next(); + return elements; +} + +private Val reader_macro(Reader reader, string symbol) +{ + reader->next(); + return List(({ Symbol(symbol), read_form(reader) })); +} + +private Val read_form(Reader reader) +{ + string token = reader->peek(); + switch(token) + { + case "'": + return reader_macro(reader, "quote"); + case "`": + return reader_macro(reader, "quasiquote"); + case "~": + return reader_macro(reader, "unquote"); + case "~@": + return reader_macro(reader, "splice-unquote"); + case "@": + return reader_macro(reader, "deref"); + case "^": + reader->next(); + Val meta = read_form(reader); + return List(({ Symbol("with-meta"), read_form(reader), meta })); + case "(": + return List(read_seq(reader, "(", ")")); + case ")": + throw("unexpected ')'"); + case "[": + return Vector(read_seq(reader, "[", "]")); + case "]": + throw("unexpected ']'"); + case "{": + return Map(read_seq(reader, "{", "}")); + case "}": + throw("unexpected '}'"); + default: + return read_atom(reader); + } +} + +Val read_str(string str) +{ + array(string) tokens = tokenize(str); + if(sizeof(tokens) == 0) return MAL_NIL; + return read_form(Reader(tokens)); +} diff --git a/impls/pike/Readline.pmod b/impls/pike/Readline.pmod new file mode 100644 index 0000000000..be93884913 --- /dev/null +++ b/impls/pike/Readline.pmod @@ -0,0 +1,4 @@ +string readline(string prompt) { + write(prompt); + return Stdio.stdin->gets(); +} diff --git a/impls/pike/Types.pmod b/impls/pike/Types.pmod new file mode 100644 index 0000000000..b76d6a7000 --- /dev/null +++ b/impls/pike/Types.pmod @@ -0,0 +1,460 @@ +enum MalType { + MALTYPE_UNDEFINED, + MALTYPE_NIL, + MALTYPE_TRUE, + MALTYPE_FALSE, + MALTYPE_NUMBER, + MALTYPE_SYMBOL, + MALTYPE_STRING, + MALTYPE_KEYWORD, + MALTYPE_LIST, + MALTYPE_VECTOR, + MALTYPE_MAP, + MALTYPE_FN, + MALTYPE_BUILTINFN, + MALTYPE_ATOM, +}; + +class Val +{ + constant mal_type = MALTYPE_UNDEFINED; + Val meta; + string to_string(bool print_readably); + Val clone(); + + bool `==(mixed other) + { + return objectp(other) && other.mal_type == mal_type; + } +} + +class Nil +{ + inherit Val; + constant mal_type = MALTYPE_NIL; + + string to_string(bool print_readably) + { + return "nil"; + } + + int count() + { + return 0; + } + + Val first() + { + return MAL_NIL; + } + + Val rest() + { + return List(({ })); + } + + Val clone() + { + return this_object(); + } + + Val seq() + { + return MAL_NIL; + } +} + +Nil MAL_NIL = Nil(); + +class True +{ + inherit Val; + constant mal_type = MALTYPE_TRUE; + string to_string(bool print_readably) + { + return "true"; + } + + Val clone() + { + return this_object(); + } +} + +True MAL_TRUE = True(); + +class False +{ + inherit Val; + constant mal_type = MALTYPE_FALSE; + string to_string(bool print_readably) + { + return "false"; + } + + Val clone() + { + return this_object(); + } +} + +False MAL_FALSE = False(); + +Val to_bool(bool b) +{ + if(b) return MAL_TRUE; + return MAL_FALSE; +} + +class Number(int value) +{ + constant mal_type = MALTYPE_NUMBER; + inherit Val; + + string to_string(bool print_readably) + { + return (string)value; + } + + bool `==(mixed other) + { + return ::`==(other) && other.value == value; + } + + Val clone() + { + return this_object(); + } +} + +class Symbol(string value) +{ + constant mal_type = MALTYPE_SYMBOL; + inherit Val; + + string to_string(bool print_readably) + { + return value; + } + + bool `==(mixed other) + { + return ::`==(other) && other.value == value; + } + + int __hash() + { + return hash((string)mal_type) ^ hash(value); + } + + Val clone() + { + return Symbol(value); + } +} + +class String(string value) +{ + constant mal_type = MALTYPE_STRING; + inherit Val; + + string to_string(bool print_readably) + { + if(print_readably) { + string s = replace(value, "\\", "\\\\"); + s = replace(s, "\"", "\\\""); + s = replace(s, "\n", "\\n"); + return "\"" + s + "\""; + } + return value; + } + + bool `==(mixed other) + { + return ::`==(other) && other.value == value; + } + + int __hash() + { + return hash((string)mal_type) ^ hash(value); + } + + Val clone() + { + return String(value); + } + + Val seq() + { + if(sizeof(value) == 0) return MAL_NIL; + array(Val) parts = ({ }); + for(int i = 0; i < sizeof(value); i++) + { + parts += ({ String(value[i..i]) }); + } + return List(parts); + } +} + +class Keyword(string value) +{ + constant mal_type = MALTYPE_KEYWORD; + inherit Val; + + string to_string(bool print_readably) + { + return ":" + value; + } + + bool `==(mixed other) + { + return ::`==(other) && other.value == value; + } + + int __hash() + { + return hash((string)mal_type) ^ hash(value); + } + + Val clone() + { + return Keyword(value); + } +} + +class Sequence(array(Val) data) +{ + inherit Val; + constant is_sequence = true; + + string to_string(bool print_readably) + { + return map(data, lambda(Val e) { return e.to_string(print_readably); }) * " "; + } + + bool emptyp() + { + return sizeof(data) == 0; + } + + int count() + { + return sizeof(data); + } + + Val nth(int index) + { + if(index >= count()) throw("nth: index out of range"); + return data[index]; + } + + Val first() + { + if(emptyp()) return MAL_NIL; + return data[0]; + } + + Val rest() + { + return List(data[1..]); + } + + bool `==(mixed other) + { + if(!objectp(other)) return 0; + if(!other.is_sequence) return 0; + if(other.count() != count()) return 0; + for(int i = 0; i < count(); i++) + { + if(other.data[i] != data[i]) return 0; + } + return 1; + } + + Val seq() + { + if(emptyp()) return MAL_NIL; + return List(data); + } +} + +class List +{ + inherit Sequence; + constant mal_type = MALTYPE_LIST; + + string to_string(bool print_readably) + { + return "(" + ::to_string(print_readably) + ")"; + } + + Val clone() + { + return List(data); + } + + Val conj(array(Val) other) + { + return List(reverse(other) + data); + } +} + +class Vector +{ + inherit Sequence; + constant mal_type = MALTYPE_VECTOR; + + string to_string(bool print_readably) + { + return "[" + ::to_string(print_readably) + "]"; + } + + Val clone() + { + return Vector(data); + } + + Val conj(array(Val) other) + { + return Vector(data + other); + } +} + +class Map +{ + inherit Val; + constant mal_type = MALTYPE_MAP; + mapping(Val:Val) data; + + void create(array(Val) list) + { + array(Val) keys = Array.everynth(list, 2, 0); + array(Val) vals = Array.everynth(list, 2, 1); + data = mkmapping(keys, vals); + } + + string to_string(bool print_readably) + { + array(string) strs = ({ }); + foreach(data; Val k; Val v) + { + strs += ({ k.to_string(print_readably), v.to_string(print_readably) }); + } + return "{" + (strs * " ") + "}"; + } + + int count() + { + return sizeof(data); + } + + bool `==(mixed other) + { + if(!::`==(other)) return 0; + if(other.count() != count()) return 0; + foreach(data; Val k; Val v) + { + if(other.data[k] != v) return 0; + } + return 1; + } + + Val assoc(array(Val) list) + { + array(Val) keys = Array.everynth(list, 2, 0); + array(Val) vals = Array.everynth(list, 2, 1); + Map result = Map(({ })); + result.data = copy_value(data); + for(int i = 0; i < sizeof(keys); i++) + { + result.data[keys[i]] = vals[i]; + } + return result; + } + + Val dissoc(array(Val) list) + { + Map result = Map(({ })); + result.data = copy_value(data); + foreach(list, Val key) m_delete(result.data, key); + return result; + } + + Val clone() + { + Map m = Map(({ })); + m.data = data; + return m; + } +} + +class Fn(Val ast, Val params, .Env.Env env, function func, void|bool macro) +{ + inherit Val; + constant mal_type = MALTYPE_FN; + constant is_fn = true; + + void set_macro() + { + macro = true; + } + + string to_string(bool print_readably) + { + string tag = macro ? "Macro" : "Fn"; + return "#<" + tag + " params=" + params.to_string(true) + ">"; + } + + mixed `()(mixed ... args) + { + return func(@args); + } + + Val clone() + { + return Fn(ast, params, env, func); + } + + Val clone_as_macro() + { + return Fn(ast, params, env, func, true); + } +} + +class BuiltinFn(string name, function func) +{ + inherit Val; + constant mal_type = MALTYPE_BUILTINFN; + constant is_fn = true; + + string to_string(bool print_readably) + { + return "#"; + } + + mixed `()(mixed ... args) + { + return func(@args); + } + + Val clone() + { + return BuiltinFn(name, func); + } +} + +class Atom(Val data) +{ + inherit Val; + constant mal_type = MALTYPE_ATOM; + + string to_string(bool print_readably) + { + return "(atom " + data.to_string(print_readably) + ")"; + } + + Val clone() + { + return Atom(data); + } +} diff --git a/impls/pike/run b/impls/pike/run new file mode 100755 index 0000000000..1281d967de --- /dev/null +++ b/impls/pike/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec pike $(dirname $0)/${STEP:-stepA_mal}.pike "${@}" diff --git a/impls/pike/step0_repl.pike b/impls/pike/step0_repl.pike new file mode 100644 index 0000000000..65150a31e1 --- /dev/null +++ b/impls/pike/step0_repl.pike @@ -0,0 +1,34 @@ +import .Readline; + +string READ(string str) +{ + return str; +} + +string EVAL(string ast, string env) +{ + return ast; +} + +string PRINT(string exp) +{ + return exp; +} + +string rep(string str) +{ + return PRINT(EVAL(READ(str), "")); +} + +int main() +{ + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + write(({ rep(line), "\n" })); + } + write("\n"); + return 0; +} diff --git a/impls/pike/step1_read_print.pike b/impls/pike/step1_read_print.pike new file mode 100644 index 0000000000..15cdfc8de2 --- /dev/null +++ b/impls/pike/step1_read_print.pike @@ -0,0 +1,41 @@ +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +Val EVAL(Val ast, string env) +{ + return ast; +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str) +{ + return PRINT(EVAL(READ(str), "")); +} + +int main() +{ + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step2_eval.pike b/impls/pike/step2_eval.pike new file mode 100644 index 0000000000..b31d1297a5 --- /dev/null +++ b/impls/pike/step2_eval.pike @@ -0,0 +1,74 @@ +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +Val EVAL(Val ast, mapping(string:function) env) +{ + // write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + function f = env[ast.value]; + if(!f) throw("'" + ast.value + "' not found"); + return f; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + args = map(args, lambda(Val e) { return EVAL(e, env);}); + return f(@args); +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, mapping(string:function) env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main() +{ + mapping(string:function) repl_env = ([ + "+": lambda(Val a, Val b) { return Number(a.value + b.value); }, + "-": lambda(Val a, Val b) { return Number(a.value - b.value); }, + "*": lambda(Val a, Val b) { return Number(a.value * b.value); }, + "/": lambda(Val a, Val b) { return Number(a.value / b.value); } + ]); + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step3_env.pike b/impls/pike/step3_env.pike new file mode 100644 index 0000000000..42f6cd6cac --- /dev/null +++ b/impls/pike/step3_env.pike @@ -0,0 +1,93 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +Val EVAL(Val ast, Env env) +{ + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + return EVAL(ast.data[2], let_env); + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + args = map(args, lambda(Val e) { return EVAL(e, env);}); + return f(@args); +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main() +{ + Env repl_env = Env(0); + repl_env.set(Symbol("+"), lambda(Val a, Val b) { return Number(a.value + b.value); }); + repl_env.set(Symbol("-"), lambda(Val a, Val b) { return Number(a.value - b.value); }); + repl_env.set(Symbol("*"), lambda(Val a, Val b) { return Number(a.value * b.value); }); + repl_env.set(Symbol("/"), lambda(Val a, Val b) { return Number(a.value / b.value); }); + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step4_if_fn_do.pike b/impls/pike/step4_if_fn_do.pike new file mode 100644 index 0000000000..90bc23434d --- /dev/null +++ b/impls/pike/step4_if_fn_do.pike @@ -0,0 +1,111 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +Val EVAL(Val ast, Env env) +{ + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + return EVAL(ast.data[2], let_env); + case "do": + Val result; + foreach(ast.data[1..], Val element) + { + result = EVAL(element, env); + } + return result; + case "if": + Val cond = EVAL(ast.data[1], env); + if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) + { + if(sizeof(ast.data) > 3) + return EVAL(ast.data[3], env); + else + return MAL_NIL; + } + else + return EVAL(ast.data[2], env); + case "fn*": + return lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }; + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + args = map(args, lambda(Val e) { return EVAL(e, env);}); + return f(@args); +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main() +{ + Env repl_env = Env(0); + foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); + rep("(def! not (fn* (a) (if a false true)))", repl_env); + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step5_tco.pike b/impls/pike/step5_tco.pike new file mode 100644 index 0000000000..c72183c768 --- /dev/null +++ b/impls/pike/step5_tco.pike @@ -0,0 +1,130 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +Val EVAL(Val ast, Env env) +{ + while(true) + { + + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + env = let_env; + ast = ast.data[2]; + continue; // TCO + case "do": + Val result; + foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) + { + result = EVAL(element, env); + } + ast = ast.data[-1]; + continue; // TCO + case "if": + Val cond = EVAL(ast.data[1], env); + if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) + { + if(sizeof(ast.data) > 3) + ast = ast.data[3]; + else + return MAL_NIL; + } + else + ast = ast.data[2]; + continue; // TCO + case "fn*": + return Fn(ast.data[2], ast.data[1], env, + lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + args = map(args, lambda(Val e) { return EVAL(e, env);}); + switch(f.mal_type) + { + case MALTYPE_BUILTINFN: + return f(@args); + case MALTYPE_FN: + ast = f.ast; + env = Env(f.env, f.params, List(args)); + continue; // TCO + default: + throw("Unknown function type"); + } + } +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main() +{ + Env repl_env = Env(0); + foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); + rep("(def! not (fn* (a) (if a false true)))", repl_env); + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step6_file.pike b/impls/pike/step6_file.pike new file mode 100644 index 0000000000..c5b3f3c3d1 --- /dev/null +++ b/impls/pike/step6_file.pike @@ -0,0 +1,138 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +Val EVAL(Val ast, Env env) +{ + while(true) + { + + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + env = let_env; + ast = ast.data[2]; + continue; // TCO + case "do": + Val result; + foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) + { + result = EVAL(element, env); + } + ast = ast.data[-1]; + continue; // TCO + case "if": + Val cond = EVAL(ast.data[1], env); + if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) + { + if(sizeof(ast.data) > 3) + ast = ast.data[3]; + else + return MAL_NIL; + } + else + ast = ast.data[2]; + continue; // TCO + case "fn*": + return Fn(ast.data[2], ast.data[1], env, + lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + args = map(args, lambda(Val e) { return EVAL(e, env);}); + switch(f.mal_type) + { + case MALTYPE_BUILTINFN: + return f(@args); + case MALTYPE_FN: + ast = f.ast; + env = Env(f.env, f.params, List(args)); + continue; // TCO + default: + throw("Unknown function type"); + } + } +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main(int argc, array argv) +{ + Env repl_env = Env(0); + foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); + repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); + repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); + rep("(def! not (fn* (a) (if a false true)))", repl_env); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + if(argc >= 2) + { + rep("(load-file \"" + argv[1] + "\")", repl_env); + return 0; + } + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step7_quote.pike b/impls/pike/step7_quote.pike new file mode 100644 index 0000000000..222c42cb0d --- /dev/null +++ b/impls/pike/step7_quote.pike @@ -0,0 +1,184 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +bool starts_with(Val ast, string sym) +{ + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; +} + +Val quasiquote(Val ast) +{ + switch(ast.mal_type) + { + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; + } +} + +Val EVAL(Val ast, Env env) +{ + while(true) + { + + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + env = let_env; + ast = ast.data[2]; + continue; // TCO + case "quote": + return ast.data[1]; + case "quasiquote": + ast = quasiquote(ast.data[1]); + continue; // TCO + case "do": + Val result; + foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) + { + result = EVAL(element, env); + } + ast = ast.data[-1]; + continue; // TCO + case "if": + Val cond = EVAL(ast.data[1], env); + if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) + { + if(sizeof(ast.data) > 3) + ast = ast.data[3]; + else + return MAL_NIL; + } + else + ast = ast.data[2]; + continue; // TCO + case "fn*": + return Fn(ast.data[2], ast.data[1], env, + lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + args = map(args, lambda(Val e) { return EVAL(e, env);}); + switch(f.mal_type) + { + case MALTYPE_BUILTINFN: + return f(@args); + case MALTYPE_FN: + ast = f.ast; + env = Env(f.env, f.params, List(args)); + continue; // TCO + default: + throw("Unknown function type"); + } + } +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main(int argc, array argv) +{ + Env repl_env = Env(0); + foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); + repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); + repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); + rep("(def! not (fn* (a) (if a false true)))", repl_env); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + if(argc >= 2) + { + rep("(load-file \"" + argv[1] + "\")", repl_env); + return 0; + } + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step8_macros.pike b/impls/pike/step8_macros.pike new file mode 100644 index 0000000000..764b84dfed --- /dev/null +++ b/impls/pike/step8_macros.pike @@ -0,0 +1,192 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +bool starts_with(Val ast, string sym) +{ + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; +} + +Val quasiquote(Val ast) +{ + switch(ast.mal_type) + { + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; + } +} + +Val EVAL(Val ast, Env env) +{ + while(true) + { + + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + env = let_env; + ast = ast.data[2]; + continue; // TCO + case "quote": + return ast.data[1]; + case "quasiquote": + ast = quasiquote(ast.data[1]); + continue; // TCO + case "defmacro!": + Val macro = EVAL(ast.data[2], env).clone_as_macro(); + return env.set(ast.data[1], macro); + case "do": + Val result; + foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) + { + result = EVAL(element, env); + } + ast = ast.data[-1]; + continue; // TCO + case "if": + Val cond = EVAL(ast.data[1], env); + if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) + { + if(sizeof(ast.data) > 3) + ast = ast.data[3]; + else + return MAL_NIL; + } + else + ast = ast.data[2]; + continue; // TCO + case "fn*": + return Fn(ast.data[2], ast.data[1], env, + lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + switch(f.mal_type) + { + case MALTYPE_BUILTINFN: + return f(@map(args, lambda(Val e) { return EVAL(e, env);})); + case MALTYPE_FN: + if(f.macro) + { + ast = f(@args); + continue; // TCO + } + ast = f.ast; + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); + continue; // TCO + default: + throw("Unknown function type"); + } + } +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main(int argc, array argv) +{ + Env repl_env = Env(0); + foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); + repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); + repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); + rep("(def! not (fn* (a) (if a false true)))", repl_env); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + if(argc >= 2) + { + rep("(load-file \"" + argv[1] + "\")", repl_env); + return 0; + } + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) err = err[0]; + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/step9_try.pike b/impls/pike/step9_try.pike new file mode 100644 index 0000000000..6d68525070 --- /dev/null +++ b/impls/pike/step9_try.pike @@ -0,0 +1,212 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +bool starts_with(Val ast, string sym) +{ + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; +} + +Val quasiquote(Val ast) +{ + switch(ast.mal_type) + { + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; + } +} + +Val EVAL(Val ast, Env env) +{ + while(true) + { + + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + env = let_env; + ast = ast.data[2]; + continue; // TCO + case "quote": + return ast.data[1]; + case "quasiquote": + ast = quasiquote(ast.data[1]); + continue; // TCO + case "defmacro!": + Val macro = EVAL(ast.data[2], env).clone_as_macro(); + return env.set(ast.data[1], macro); + case "try*": + if(ast.count() < 3) return EVAL(ast.data[1], env); + if(mixed err = catch { return EVAL(ast.data[1], env); } ) + { + Val err_val; + if(objectp(err)) err_val = err; + else if(stringp(err)) err_val = String(err); + else if(arrayp(err)) err_val = String(err[0]); + Val catch_clause = ast.data[2]; + Env catch_env = Env(env); + catch_env.set(catch_clause.data[1], err_val); + return EVAL(catch_clause.data[2], catch_env); + } + case "do": + Val result; + foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) + { + result = EVAL(element, env); + } + ast = ast.data[-1]; + continue; // TCO + case "if": + Val cond = EVAL(ast.data[1], env); + if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) + { + if(sizeof(ast.data) > 3) + ast = ast.data[3]; + else + return MAL_NIL; + } + else + ast = ast.data[2]; + continue; // TCO + case "fn*": + return Fn(ast.data[2], ast.data[1], env, + lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + switch(f.mal_type) + { + case MALTYPE_BUILTINFN: + return f(@map(args, lambda(Val e) { return EVAL(e, env);})); + case MALTYPE_FN: + if(f.macro) + { + ast = f(@args); + continue; // TCO + } + ast = f.ast; + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); + continue; // TCO + default: + throw("Unknown function type"); + } + } +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main(int argc, array argv) +{ + Env repl_env = Env(0); + foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); + repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); + repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); + rep("(def! not (fn* (a) (if a false true)))", repl_env); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + if(argc >= 2) + { + rep("(load-file \"" + argv[1] + "\")", repl_env); + return 0; + } + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(objectp(err)) + { + err = err.to_string(true); + } + else if(arrayp(err)) + { + err = err[0]; + } + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/stepA_mal.pike b/impls/pike/stepA_mal.pike new file mode 100644 index 0000000000..7c9b02acdf --- /dev/null +++ b/impls/pike/stepA_mal.pike @@ -0,0 +1,214 @@ +import .Env; +import .Printer; +import .Reader; +import .Readline; +import .Types; + +Val READ(string str) +{ + return read_str(str); +} + +bool starts_with(Val ast, string sym) +{ + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; +} + +Val quasiquote(Val ast) +{ + switch(ast.mal_type) + { + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; + } +} + +Val EVAL(Val ast, Env env) +{ + while(true) + { + + Val dbgeval = env.get("DEBUG-EVAL"); + if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE + && dbgeval.mal_type != MALTYPE_NIL) + write(({ "EVAL: ", PRINT(ast), "\n" })); + + switch(ast.mal_type) + { + case MALTYPE_SYMBOL: + Val key = ast.value; + Val val = env.get(ast.value); + if(!val) throw("'" + key + "' not found"); + return val; + case MALTYPE_LIST: + break; + case MALTYPE_VECTOR: + return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + case MALTYPE_MAP: + array(Val) elements = ({ }); + foreach(ast.data; Val k; Val v) + { + elements += ({ k, EVAL(v, env) }); + } + return Map(elements); + default: + return ast; + } + + if(ast.emptyp()) return ast; + if(ast.data[0].mal_type == MALTYPE_SYMBOL) { + switch(ast.data[0].value) + { + case "def!": + return env.set(ast.data[1], EVAL(ast.data[2], env)); + case "let*": + Env let_env = Env(env); + Val ast1 = ast.data[1]; + for(int i = 0; i < sizeof(ast1.data); i += 2) + { + let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); + } + env = let_env; + ast = ast.data[2]; + continue; // TCO + case "quote": + return ast.data[1]; + case "quasiquote": + ast = quasiquote(ast.data[1]); + continue; // TCO + case "defmacro!": + Val macro = EVAL(ast.data[2], env).clone_as_macro(); + return env.set(ast.data[1], macro); + case "try*": + if(ast.count() < 3) return EVAL(ast.data[1], env); + if(mixed err = catch { return EVAL(ast.data[1], env); } ) + { + Val err_val; + if(objectp(err)) err_val = err; + else if(stringp(err)) err_val = String(err); + else if(arrayp(err)) err_val = String(err[0]); + Val catch_clause = ast.data[2]; + Env catch_env = Env(env); + catch_env.set(catch_clause.data[1], err_val); + return EVAL(catch_clause.data[2], catch_env); + } + case "do": + Val result; + foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) + { + result = EVAL(element, env); + } + ast = ast.data[-1]; + continue; // TCO + case "if": + Val cond = EVAL(ast.data[1], env); + if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) + { + if(sizeof(ast.data) > 3) + ast = ast.data[3]; + else + return MAL_NIL; + } + else + ast = ast.data[2]; + continue; // TCO + case "fn*": + return Fn(ast.data[2], ast.data[1], env, + lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); + } + } + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; + switch(f.mal_type) + { + case MALTYPE_BUILTINFN: + return f(@map(args, lambda(Val e) { return EVAL(e, env);})); + case MALTYPE_FN: + if(f.macro) + { + ast = f(@args); + continue; // TCO + } + ast = f.ast; + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); + continue; // TCO + default: + throw("Unknown function type"); + } + } +} + +string PRINT(Val exp) +{ + return pr_str(exp, true); +} + +string rep(string str, Env env) +{ + return PRINT(EVAL(READ(str), env)); +} + +int main(int argc, array argv) +{ + Env repl_env = Env(0); + foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); + repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); + repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); + rep("(def! *host-language* \"pike\")", repl_env); + rep("(def! not (fn* (a) (if a false true)))", repl_env); + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); + if(argc >= 2) + { + rep("(load-file \"" + argv[1] + "\")", repl_env); + return 0; + } + rep("(println (str \"Mal [\" \*host-language\* \"]\"))", repl_env); + while(1) + { + string line = readline("user> "); + if(!line) break; + if(strlen(line) == 0) continue; + if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) + { + if(arrayp(err)) + { + err = err[0]; + } + else if(objectp(err)) + { + err = err.to_string(true); + } + write(({ "Error: ", err, "\n" })); + } + } + write("\n"); + return 0; +} diff --git a/impls/pike/tests/step5_tco.mal b/impls/pike/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/pike/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/pike/tests/stepA_mal.mal b/impls/pike/tests/stepA_mal.mal new file mode 100644 index 0000000000..3d69497c5e --- /dev/null +++ b/impls/pike/tests/stepA_mal.mal @@ -0,0 +1,36 @@ +;; Testing basic Pike interop + +;;; pike-eval compiles the given string inside a temporary function after a +;;; "return " keyword. To evaluate complex statements, you may use an anonymous +;;; lambda and call it immediately (see the last example). + +(pike-eval "7") +;=>7 + +(pike-eval "'A'") +;=>65 + +(pike-eval "\"7\"") +;=>"7" + +(pike-eval "({ 7,8,9 })") +;=>(7 8 9) + +(pike-eval "([ \"abc\": 789 ])") +;=>{"abc" 789} + +(pike-eval "write(\"hello\\n\")") +;/hello +;=>6 + +(pike-eval "map(({ \"a\", \"b\", \"c\" }), lambda(string x) { return \"X\" + x + \"Y\"; }) * \" \"") +;=>"XaY XbY XcY" + +(pike-eval "map(({ 1,2,3 }), lambda(int x) { return 1 + x; })") +;=>(2 3 4) + +(pike-eval "throw(upper_case(\"aaa\" + \"bbb\"))") +;/Error: AAABBB + +(pike-eval "(lambda() { int a = 5; int b = a * 3; return a + b; })()") +;=>20 diff --git a/impls/plpgsql/Dockerfile b/impls/plpgsql/Dockerfile new file mode 100644 index 0000000000..eb64c1ae34 --- /dev/null +++ b/impls/plpgsql/Dockerfile @@ -0,0 +1,37 @@ +FROM ubuntu:14.04 + +RUN apt-get -y update +RUN apt-get -y install make cpp python + +RUN apt-get -y install curl +RUN useradd -u 1000 -m -s /bin/bash -G sudo postgres + +ENV PG_VERSION=9.4 +RUN curl https://www.postgresql.org/media/keys/ACCC4CF8.asc | apt-key add - && \ + echo 'deb http://apt.postgresql.org/pub/repos/apt/ trusty-pgdg main' > /etc/apt/sources.list.d/pgdg.list && \ + apt-get update && \ + DEBIAN_FRONTEND=noninteractive apt-get -y install acl \ + postgresql-${PG_VERSION} postgresql-client-${PG_VERSION} postgresql-contrib-${PG_VERSION} && \ + mkdir -p /var/run/postgresql/9.4-main.pg_stat_tmp/ && \ + chown -R postgres.postgres /var/run/postgresql + +ENV HOME=/var/run/postgresql + +WORKDIR /mal + +# Travis runs as a couple of different users so add them +RUN useradd -ou 1001 -m -s /bin/bash -G sudo,postgres travis +RUN useradd -ou 2000 -m -s /bin/bash -G sudo,postgres travis2 + +# Enable postgres and travis users to sudo for postgres startup +RUN echo "%sudo ALL=(ALL:ALL) NOPASSWD: ALL" >> /etc/sudoers + +# Allow both travis and postgres user to connect to DB as 'postgres' +RUN sed -i 's/peer$/peer map=mal/' /etc/postgresql/9.4/main/pg_hba.conf +RUN echo "mal postgres postgres" >> /etc/postgresql/9.4/main/pg_ident.conf +RUN echo "mal travis postgres" >> /etc/postgresql/9.4/main/pg_ident.conf +RUN echo "mal travis2 postgres" >> /etc/postgresql/9.4/main/pg_ident.conf + +# Add entrypoint.sh which starts postgres then run bash/command +ADD entrypoint.sh /entrypoint.sh +ENTRYPOINT ["/entrypoint.sh"] diff --git a/impls/plpgsql/Makefile b/impls/plpgsql/Makefile new file mode 100644 index 0000000000..7af3113c71 --- /dev/null +++ b/impls/plpgsql/Makefile @@ -0,0 +1,3 @@ +all: + +clean: diff --git a/impls/plpgsql/core.sql b/impls/plpgsql/core.sql new file mode 100644 index 0000000000..a989154d7e --- /dev/null +++ b/impls/plpgsql/core.sql @@ -0,0 +1,584 @@ +CREATE SCHEMA core; + +-- general functions + +CREATE FUNCTION core.equal(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._equal_Q(args[1], args[2])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.throw(args integer[]) RETURNS integer AS $$ +BEGIN + -- TODO: Only throws strings. Without subtransactions, all changes + -- to DB up to this point get rolled back so the object being + -- thrown dissapears. + RAISE EXCEPTION '%', printer.pr_str(args[1], false); +END; $$ LANGUAGE plpgsql; + + +-- scalar functions + +CREATE FUNCTION core.nil_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._nil_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.true_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._true_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.false_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._false_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.number_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._number_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.string_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._string_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.symbol(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._symbolv(types._valueToString(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.symbol_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._symbol_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.keyword(args integer[]) RETURNS integer AS $$ +BEGIN + IF types._keyword_Q(args[1]) THEN + RETURN args[1]; + ELSE + RETURN types._keywordv(types._valueToString(args[1])); + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.keyword_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._keyword_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.fn_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._fn_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.macro_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._macro_Q(args[1])); +END; $$ LANGUAGE plpgsql; + + +-- string functions + +CREATE FUNCTION core.pr_str(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._stringv(printer.pr_str_array(args, ' ', true)); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.str(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._stringv(printer.pr_str_array(args, '', false)); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.prn(args integer[]) RETURNS integer AS $$ +BEGIN + PERFORM io.writeline(printer.pr_str_array(args, ' ', true)); + RETURN 0; -- nil +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.println(args integer[]) RETURNS integer AS $$ +BEGIN + PERFORM io.writeline(printer.pr_str_array(args, ' ', false)); + RETURN 0; -- nil +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.read_string(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(types._valueToString(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.readline(args integer[]) RETURNS integer AS $$ +DECLARE + input varchar; +BEGIN + input := io.readline(types._valueToString(args[1])); + IF input IS NULL THEN + RETURN 0; -- nil + END IF; + RETURN types._stringv(rtrim(input, E'\n')); +END; $$ LANGUAGE plpgsql; + + +-- See: +-- http://shuber.io/reading-from-the-filesystem-with-postgres/ +CREATE FUNCTION core.slurp(args integer[]) RETURNS integer AS $$ +DECLARE + fname varchar; + tmp varchar; + cmd varchar; + lines varchar[]; + content varchar; +BEGIN + fname := types._valueToString(args[1]); + IF fname NOT LIKE '/%' THEN + fname := types._valueToString(envs.get(0, '*PWD*')) || '/' || fname; + END IF; + + tmp := CAST(round(random()*1000000) AS varchar); + + EXECUTE format('CREATE TEMP TABLE %I (content text)', tmp); + cmd := format('sed ''s/\\/\\\\/g'' %L', fname); + EXECUTE format('COPY %I FROM PROGRAM %L', tmp, cmd); + EXECUTE format('SELECT ARRAY(SELECT content FROM %I)', tmp) INTO lines; + EXECUTE format('DROP TABLE %I', tmp); + + content := array_to_string(lines, E'\n') || E'\n'; + RETURN types._stringv(content); +END; $$ LANGUAGE plpgsql; + + +-- number functions + +-- integer comparison +CREATE FUNCTION core.intcmp(op varchar, args integer[]) RETURNS integer AS $$ +DECLARE a bigint; b bigint; result boolean; +BEGIN + SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; + SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; + EXECUTE format('SELECT $1 %s $2;', op) INTO result USING a, b; + RETURN types._wraptf(result); +END; $$ LANGUAGE plpgsql; + +-- integer operation +CREATE FUNCTION core.intop(op varchar, args integer[]) RETURNS integer AS $$ +DECLARE a bigint; b bigint; result bigint; +BEGIN + SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; + SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; + EXECUTE format('SELECT $1 %s $2;', op) INTO result USING a, b; + RETURN types._numToValue(result); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.lt(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intcmp('<', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.lte(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intcmp('<=', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.gt(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intcmp('>', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.gte(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intcmp('>=', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.add(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intop('+', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.subtract(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intop('-', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.multiply(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intop('*', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.divide(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN core.intop('/', args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.time_ms(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._numToValue( + CAST(date_part('epoch', clock_timestamp()) * 1000 AS bigint)); +END; $$ LANGUAGE plpgsql; + + +-- collection functions + +CREATE FUNCTION core.list(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._list(args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.list_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._list_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.vector(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._vector(args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.vector_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._vector_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.hash_map(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._hash_map(args); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.map_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._hash_map_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.assoc(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._assoc_BANG(types._clone(args[1]), + args[2:array_length(args, 1)]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.dissoc(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._dissoc_BANG(types._clone(args[1]), + args[2:array_length(args, 1)]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.get(args integer[]) RETURNS integer AS $$ +DECLARE + result integer; +BEGIN + IF types._type(args[1]) = 0 THEN -- nil + RETURN 0; + ELSE + result := types._get(args[1], types._valueToString(args[2])); + IF result IS NULL THEN RETURN 0; END IF; + RETURN result; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.contains_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._contains_Q(args[1], + types._valueToString(args[2]))); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.keys(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._list(types._keys(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.vals(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._list(types._vals(args[1])); +END; $$ LANGUAGE plpgsql; + + + +-- sequence functions + +CREATE FUNCTION core.sequential_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._sequential_Q(args[1])); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.cons(args integer[]) RETURNS integer AS $$ +DECLARE + lst integer[]; +BEGIN + lst := array_prepend(args[1], types._valueToArray(args[2])); + RETURN types._list(lst); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.concat(args integer[]) RETURNS integer AS $$ +DECLARE + lst integer; + result integer[] = ARRAY[]::integer[]; +BEGIN + FOREACH lst IN ARRAY args LOOP + result := array_cat(result, types._valueToArray(lst)); + END LOOP; + RETURN types._list(result); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.vec(args integer[]) RETURNS integer AS $$ +BEGIN + IF types._vector_Q(args[1]) THEN + RETURN args[1]; + ELSE + RETURN types._vector(types._valueToArray(args[1])); + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.nth(args integer[]) RETURNS integer AS $$ +DECLARE + idx integer; +BEGIN + SELECT val_int INTO idx FROM types.value WHERE value_id = args[2]; + IF idx >= types._count(args[1]) THEN + RAISE EXCEPTION 'nth: index out of range'; + END IF; + RETURN types._nth(args[1], idx); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.first(args integer[]) RETURNS integer AS $$ +BEGIN + IF types._nil_Q(args[1]) THEN + RETURN 0; -- nil + ELSIF types._count(args[1]) = 0 THEN + RETURN 0; -- nil + ELSE + RETURN types._first(args[1]); + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.rest(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._rest(args[1]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.empty_Q(args integer[]) RETURNS integer AS $$ +BEGIN + IF types._sequential_Q(args[1]) AND types._count(args[1]) = 0 THEN + RETURN 2; + ELSE + RETURN 1; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.count(args integer[]) RETURNS integer AS $$ +BEGIN + IF types._sequential_Q(args[1]) THEN + RETURN types._numToValue(types._count(args[1])); + ELSIF types._nil_Q(args[1]) THEN + RETURN types._numToValue(0); + ELSE + RAISE EXCEPTION 'count called on non-sequence'; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.apply(args integer[]) RETURNS integer AS $$ +DECLARE + alen integer; + fargs integer[]; +BEGIN + alen := array_length(args, 1); + fargs := array_cat(args[2:alen-1], types._valueToArray(args[alen])); + RETURN types._apply(args[1], fargs); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.map(args integer[]) RETURNS integer AS $$ +DECLARE + x integer; + result integer[]; +BEGIN + FOREACH x IN ARRAY types._valueToArray(args[2]) + LOOP + result := array_append(result, types._apply(args[1], ARRAY[x])); + END LOOP; + return types._list(result); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.conj(args integer[]) RETURNS integer AS $$ +DECLARE + type integer; +BEGIN + type := types._type(args[1]); + CASE + WHEN type = 8 THEN -- list + RETURN types._list(array_cat( + types.array_reverse(args[2:array_length(args, 1)]), + types._valueToArray(args[1]))); + WHEN type = 9 THEN -- vector + RETURN types._vector(array_cat( + types._valueToArray(args[1]), + args[2:array_length(args, 1)])); + ELSE + RAISE EXCEPTION 'conj: called on non-sequence'; + END CASE; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.seq(args integer[]) RETURNS integer AS $$ +DECLARE + type integer; + vid integer; + str varchar; + chr varchar; + seq integer[]; +BEGIN + type := types._type(args[1]); + CASE + WHEN type = 8 THEN -- list + IF types._count(args[1]) = 0 THEN RETURN 0; END IF; -- nil + RETURN args[1]; + WHEN type = 9 THEN -- vector + IF types._count(args[1]) = 0 THEN RETURN 0; END IF; -- nil + -- clone and modify to a list + vid := types._clone(args[1]); + UPDATE types.value SET type_id = 8 WHERE value_id = vid; + RETURN vid; + WHEN type = 5 THEN -- string + str := types._valueToString(args[1]); + IF char_length(str) = 0 THEN RETURN 0; END IF; -- nil + FOREACH chr IN ARRAY regexp_split_to_array(str, '') LOOP + seq := array_append(seq, types._stringv(chr)); + END LOOP; + RETURN types._list(seq); + WHEN type = 0 THEN -- nil + RETURN 0; -- nil + ELSE + RAISE EXCEPTION 'seq: called on non-sequence'; + END CASE; +END; $$ LANGUAGE plpgsql; + + +-- meta functions + +CREATE FUNCTION core.meta(args integer[]) RETURNS integer AS $$ +DECLARE + m integer; +BEGIN + SELECT meta_id INTO m FROM types.value WHERE value_id = args[1]; + IF m IS NULL THEN + RETURN 0; + ELSE + RETURN m; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.with_meta(args integer[]) RETURNS integer AS $$ +DECLARE + vid integer; +BEGIN + vid := types._clone(args[1]); + UPDATE types.value SET meta_id = args[2] + WHERE value_id = vid; + RETURN vid; +END; $$ LANGUAGE plpgsql; + + + +-- atom functions + +CREATE FUNCTION core.atom(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._atom(args[1]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.atom_Q(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._wraptf(types._atom_Q(args[1])); +END; $$ LANGUAGE plpgsql; + + +CREATE FUNCTION core.deref(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._deref(args[1]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.reset_BANG(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._reset_BANG(args[1], args[2]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION core.swap_BANG(args integer[]) RETURNS integer AS $$ +DECLARE + atm integer; + fargs integer[]; +BEGIN + atm := args[1]; + fargs := array_cat(ARRAY[types._deref(atm)], args[3:array_length(args, 1)]); + RETURN types._reset_BANG(atm, types._apply(args[2], fargs)); +END; $$ LANGUAGE plpgsql; + +-- --------------------------------------------------------- + +-- repl_env is environment 0 + +INSERT INTO envs.env (env_id, outer_id, data) + VALUES (0, NULL, hstore(ARRAY[ + '=', types._function('core.equal'), + 'throw', types._function('core.throw'), + + 'nil?', types._function('core.nil_Q'), + 'true?', types._function('core.true_Q'), + 'false?', types._function('core.false_Q'), + 'number?', types._function('core.number_Q'), + 'string?', types._function('core.string_Q'), + 'symbol', types._function('core.symbol'), + 'symbol?', types._function('core.symbol_Q'), + 'keyword', types._function('core.keyword'), + 'keyword?', types._function('core.keyword_Q'), + 'fn?', types._function('core.fn_Q'), + 'macro?', types._function('core.macro_Q'), + + 'pr-str', types._function('core.pr_str'), + 'str', types._function('core.str'), + 'prn', types._function('core.prn'), + 'println', types._function('core.println'), + 'read-string', types._function('core.read_string'), + 'readline', types._function('core.readline'), + 'slurp', types._function('core.slurp'), + + '<', types._function('core.lt'), + '<=', types._function('core.lte'), + '>', types._function('core.gt'), + '>=', types._function('core.gte'), + '+', types._function('core.add'), + '-', types._function('core.subtract'), + '*', types._function('core.multiply'), + '/', types._function('core.divide'), + 'time-ms', types._function('core.time_ms'), + + 'list', types._function('core.list'), + 'list?', types._function('core.list_Q'), + 'vector', types._function('core.vector'), + 'vector?', types._function('core.vector_Q'), + 'hash-map', types._function('core.hash_map'), + 'map?', types._function('core.map_Q'), + 'assoc', types._function('core.assoc'), + 'dissoc', types._function('core.dissoc'), + 'get', types._function('core.get'), + 'contains?', types._function('core.contains_Q'), + 'keys', types._function('core.keys'), + 'vals', types._function('core.vals'), + + 'sequential?', types._function('core.sequential_Q'), + 'cons', types._function('core.cons'), + 'concat', types._function('core.concat'), + 'vec', types._function('core.vec'), + 'nth', types._function('core.nth'), + 'first', types._function('core.first'), + 'rest', types._function('core.rest'), + 'empty?', types._function('core.empty_Q'), + 'count', types._function('core.count'), + 'apply', types._function('core.apply'), + 'map', types._function('core.map'), + + 'conj', types._function('core.conj'), + 'seq', types._function('core.seq'), + + 'meta', types._function('core.meta'), + 'with-meta', types._function('core.with_meta'), + 'atom', types._function('core.atom'), + 'atom?', types._function('core.atom_Q'), + 'deref', types._function('core.deref'), + 'reset!', types._function('core.reset_BANG'), + 'swap!', types._function('core.swap_BANG') + ])); diff --git a/impls/plpgsql/entrypoint.sh b/impls/plpgsql/entrypoint.sh new file mode 100755 index 0000000000..67ae1373ce --- /dev/null +++ b/impls/plpgsql/entrypoint.sh @@ -0,0 +1,25 @@ +#!/usr/bin/env bash + +POSTGRES_SUDO_USER=${POSTGRES_SUDO_USER:-postgres} + +POPTS="" +while [[ ${1:0:1} = '-' ]]; do + POPTS="${POPTS}$1 $2" + shift; shift +done + +sudo --user=${POSTGRES_SUDO_USER} \ + bash -c "/usr/lib/postgresql/9.4/bin/postgres \ + -c config_file=/etc/postgresql/9.4/main/postgresql.conf \ + ${POPTS} >/var/log/postgresql/output.log 2>&1" & disown -h + +while ! ( echo "" > /dev/tcp/localhost/5432) 2>/dev/null; do + echo "Waiting for postgres to start" + sleep 1 +done + +if [ "${*}" ]; then + exec "${@}" +else + exec bash +fi diff --git a/impls/plpgsql/envs.sql b/impls/plpgsql/envs.sql new file mode 100644 index 0000000000..626eb95798 --- /dev/null +++ b/impls/plpgsql/envs.sql @@ -0,0 +1,111 @@ +-- --------------------------------------------------------- +-- envs.sql + +CREATE SCHEMA envs + -- env table + CREATE SEQUENCE env_id_seq + CREATE TABLE env ( + env_id integer NOT NULL DEFAULT nextval('envs.env_id_seq'), + outer_id integer, + data hstore + ); + +ALTER TABLE envs.env ADD CONSTRAINT pk_env_id + PRIMARY KEY (env_id); +-- drop sequence when table dropped +ALTER SEQUENCE envs.env_id_seq OWNED BY envs.env.env_id; +ALTER TABLE envs.env ADD CONSTRAINT fk_env_outer_id + FOREIGN KEY (outer_id) REFERENCES envs.env(env_id); + +-- ----------------------- + +-- envs.new +CREATE FUNCTION envs.new(outer_env integer) RETURNS integer AS $$ +DECLARE + e integer; +BEGIN + INSERT INTO envs.env (outer_id) VALUES (outer_env) + RETURNING env_id INTO e; + --RAISE NOTICE 'env_new: e: %, outer_env: %', e, outer_env; + RETURN e; +END; $$ LANGUAGE plpgsql; + +-- envs.new with bindings +CREATE FUNCTION envs.new(outer_env integer, + binds integer, + exprs integer[]) + RETURNS integer AS $$ +DECLARE + bseq integer[]; + env integer; + i integer; + bind integer; + bsym varchar; + expr integer; +BEGIN + env := envs.new(outer_env); + bseq := types._valueToArray(binds); + FOR i IN 1 .. COALESCE(array_length(bseq, 1), 0) LOOP + bind := bseq[i]; + bsym := types._valueToString(bind); + expr := exprs[i]; + --RAISE NOTICE 'i: %, bind: %, expr: %', i, bind, expr; + IF bsym = '&' THEN + bind := bseq[i+1]; + PERFORM envs.set(env, bind, + types._list(exprs[i:array_length(exprs, 1)])); + RETURN env; + END IF; + PERFORM envs.vset(env, bsym, expr); + END LOOP; + RETURN env; +END; $$ LANGUAGE plpgsql; + + +-- envs.vset +-- like envs.set but takes a varchar key instead of value_id +CREATE FUNCTION envs.vset(env integer, name varchar, val integer) + RETURNS integer AS $$ +DECLARE + e integer = env; + d hstore; +BEGIN + SELECT data INTO d FROM envs.env WHERE env_id=e; + IF d IS NULL THEN + d := hstore(name, CAST(val AS varchar)); + ELSE + d := d || hstore(name, CAST(val AS varchar)); + END IF; + UPDATE envs.env SET data = d WHERE env_id=e; + RETURN val; +END; $$ LANGUAGE plpgsql; + + +-- envs.set +CREATE FUNCTION envs.set(env integer, key integer, val integer) + RETURNS integer AS $$ +DECLARE + symkey varchar; +BEGIN + symkey := types._valueToString(key); + RETURN envs.vset(env, symkey, val); +END; $$ LANGUAGE plpgsql; + +-- envs.get +CREATE FUNCTION envs.get(env integer, symkey varchar) RETURNS integer AS $$ +DECLARE + outer_id integer; + d hstore; +BEGIN + LOOP + SELECT e.data, e.outer_id INTO d, outer_id FROM envs.env e + WHERE e.env_id = env; + IF d ? symkey THEN + RETURN d -> symkey; + END IF; + env := outer_id; + IF env IS NULL THEN + RETURN NULL; + END IF; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/init.sql b/impls/plpgsql/init.sql new file mode 100755 index 0000000000..07188d529c --- /dev/null +++ b/impls/plpgsql/init.sql @@ -0,0 +1,13 @@ +-- --------------------------------------------------------- +-- init.sql + +-- Drop pre-existing schemas +DROP SCHEMA IF EXISTS io, types, reader, printer, envs, core, mal CASCADE; + +-- Drop and recreate extensions +DROP EXTENSION IF EXISTS hstore; +CREATE EXTENSION hstore; + +DROP EXTENSION IF EXISTS dblink; +CREATE EXTENSION dblink; + diff --git a/impls/plpgsql/io.sql b/impls/plpgsql/io.sql new file mode 100644 index 0000000000..4134956e7e --- /dev/null +++ b/impls/plpgsql/io.sql @@ -0,0 +1,224 @@ +-- dblink is necessary to be able to sub-transactions (autonomous +-- transactions) to the stream table. This is necessary to be able to +-- modify the stream table from the perspective of outside callers +-- because actual code can be long-lived and it's direct updates will +-- not be seen until the process completes. + +CREATE SCHEMA io + + CREATE TABLE stream ( + stream_id integer, + open boolean, + data varchar, + rl_prompt varchar -- prompt for readline input + ); + +-- stdin +INSERT INTO io.stream (stream_id, open, data, rl_prompt) + VALUES (0, false, '', ''); +-- stdout +INSERT INTO io.stream (stream_id, open, data, rl_prompt) + VALUES (1, false, '', ''); + +-- --------------------------------------------------------- + +CREATE FUNCTION io.open(sid integer) RETURNS void AS $$ +DECLARE + query varchar; +BEGIN + --RAISE NOTICE 'io.open start'; + query := format('UPDATE io.stream + SET data = '''', rl_prompt = '''', open = true + WHERE stream_id = %L', sid); + PERFORM dblink('dbname=mal', query); + --RAISE NOTICE 'io.open done'; +END; $$ LANGUAGE 'plpgsql' STRICT; + +CREATE FUNCTION io.close(sid integer) RETURNS void AS $$ +DECLARE + query varchar; +BEGIN + --RAISE NOTICE 'io.close start'; + query := format('UPDATE io.stream + SET rl_prompt = '''', open = false + WHERE stream_id = %L', sid); + PERFORM dblink('dbname=mal', query); + --RAISE NOTICE 'io.close done'; +END; $$ LANGUAGE 'plpgsql' STRICT; + + +-- called from read via dblink +CREATE FUNCTION io.__read(sid integer) RETURNS varchar AS $$ +DECLARE + input varchar; + isopen boolean; +BEGIN + LOCK io.stream; + SELECT data, open INTO input, isopen FROM io.stream + WHERE stream_id = sid; + IF input <> '' THEN + UPDATE io.stream SET data = '' WHERE stream_id = sid; + RETURN input; + END IF; + IF isopen = false THEN + RETURN NULL; + END IF; + RETURN input; +END; $$ LANGUAGE 'plpgsql' STRICT; + +-- read: +-- read from stream stream_id in stream table. Waits until there is +-- either data to return or the stream closes (NULL data). Returns +-- NULL when stream is closed. +CREATE FUNCTION io.read(sid integer DEFAULT 0) RETURNS varchar AS $$ +DECLARE + query varchar; + input varchar; + sleep real = 0.05; +BEGIN + -- poll / wait for input + query := format('SELECT io.__read(%L);', sid); + + WHILE true + LOOP + -- atomic get and set to empty + SELECT cur_data INTO input FROM dblink('dbname=mal', query) + AS t1(cur_data varchar); + IF input <> '' OR input IS NULL THEN + RETURN input; + END IF; + PERFORM pg_sleep(sleep); + IF sleep < 0.5 THEN + sleep := sleep * 1.1; -- backoff + END IF; + END LOOP; +END; $$ LANGUAGE 'plpgsql' STRICT; + +-- read_or_error: +-- similar to read, but throws exception when stream is closed +CREATE FUNCTION io.read_or_error(sid integer DEFAULT 0) RETURNS varchar AS $$ +DECLARE + input varchar; +BEGIN + input := io.read(sid); + IF input IS NULL THEN + raise EXCEPTION 'Stream ''%'' is closed', sid; + ELSE + RETURN input; + END IF; +END; $$ LANGUAGE 'plpgsql' STRICT; + + +-- readline: +-- set prompt and wait for readline style input on the stream +CREATE FUNCTION io.readline(prompt varchar, sid integer DEFAULT 0) + RETURNS varchar AS $$ +DECLARE + query varchar; +BEGIN + -- set prompt / request readline style input + IF sid = 0 THEN + PERFORM io.wait_flushed(1); + ELSIF sid = 1 THEN + PERFORM io.wait_flushed(0); + END IF; + query := format('LOCK io.stream; UPDATE io.stream SET rl_prompt = %L', + prompt); + PERFORM dblink('dbname=mal', query); + + RETURN io.read(sid); +END; $$ LANGUAGE 'plpgsql' STRICT; + +CREATE FUNCTION io.write(data varchar, sid integer DEFAULT 1) +RETURNS void AS $$ +DECLARE + query varchar; +BEGIN + query := format('LOCK io.stream; + UPDATE io.stream SET data = data || %L WHERE stream_id = %L', + data, sid); + --RAISE NOTICE 'write query: %', query; + PERFORM dblink('dbname=mal', query); +END; $$ LANGUAGE 'plpgsql' STRICT; + +CREATE FUNCTION io.writeline(data varchar, sid integer DEFAULT 1) +RETURNS void AS $$ +BEGIN + PERFORM io.write(data || E'\n', sid); +END; $$ LANGUAGE 'plpgsql' STRICT; + +-- --------------------------------------------------------- + +-- called from wait_rl_prompt via dblink +CREATE FUNCTION io.__wait_rl_prompt(sid integer) RETURNS varchar AS $$ +DECLARE + isopen boolean; + prompt varchar; + datas integer; +BEGIN + LOCK io.stream; + SELECT open, rl_prompt INTO isopen, prompt FROM io.stream + WHERE stream_id = sid; + SELECT count(stream_id) INTO datas FROM io.stream WHERE data <> ''; + + IF isopen = false THEN + return NULL; + --raise EXCEPTION 'Stream ''%'' is closed', sid; + END IF; + + IF datas = 0 AND prompt <> '' THEN + UPDATE io.stream SET rl_prompt = '' WHERE stream_id = sid; + -- There is pending data on some stream + RETURN prompt; + END IF; + RETURN ''; -- '' -> no input +END; $$ LANGUAGE 'plpgsql' STRICT; + +-- wait_rl_prompt: +-- wait for rl_prompt to be set on the given stream and return the +-- rl_prompt value. Errors if stream is already closed. +CREATE FUNCTION io.wait_rl_prompt(sid integer DEFAULT 0) RETURNS varchar AS $$ +DECLARE + query varchar; + prompt varchar; + sleep real = 0.05; +BEGIN + query := format('SELECT io.__wait_rl_prompt(%L);', sid); + WHILE true + LOOP + SELECT rl_prompt INTO prompt FROM dblink('dbname=mal', query) + AS t1(rl_prompt varchar); + IF prompt IS NULL THEN + raise EXCEPTION 'Stream ''%'' is closed', sid; + END IF; + IF prompt <> '' THEN + sleep := 0.05; -- reset sleep timer + RETURN prompt; + END IF; + PERFORM pg_sleep(sleep); + IF sleep < 0.5 THEN + sleep := sleep * 1.1; -- backoff + END IF; + END LOOP; +END; $$ LANGUAGE 'plpgsql' STRICT; + +CREATE FUNCTION io.wait_flushed(sid integer DEFAULT 1) RETURNS void AS $$ +DECLARE + query varchar; + pending integer; + sleep real = 0.05; +BEGIN + query := format('SELECT count(stream_id) FROM io.stream + WHERE stream_id = %L AND data <> ''''', sid); + WHILE true + LOOP + SELECT p INTO pending FROM dblink('dbname=mal', query) + AS t1(p integer); + IF pending = 0 THEN RETURN; END IF; + PERFORM pg_sleep(sleep); + IF sleep < 0.5 THEN + sleep := sleep * 1.1; -- backoff + END IF; + END LOOP; +END; $$ LANGUAGE 'plpgsql' STRICT; + diff --git a/impls/plpgsql/printer.sql b/impls/plpgsql/printer.sql new file mode 100644 index 0000000000..83c423aed4 --- /dev/null +++ b/impls/plpgsql/printer.sql @@ -0,0 +1,111 @@ +-- --------------------------------------------------------- +-- printer.sql + +CREATE SCHEMA printer; + +CREATE FUNCTION printer.pr_str_array(arr integer[], + sep varchar, print_readably boolean) + RETURNS varchar AS $$ +DECLARE + i integer; + res varchar[]; +BEGIN + IF array_length(arr, 1) > 0 THEN + FOR i IN array_lower(arr, 1) .. array_upper(arr, 1) + LOOP + res := array_append(res, printer.pr_str(arr[i], print_readably)); + END LOOP; + RETURN array_to_string(res, sep); + ELSE + RETURN ''; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION printer.pr_str(ast integer, + print_readably boolean DEFAULT true) + RETURNS varchar AS $$ +DECLARE + type integer; + seq integer[]; + hash hstore; + cid integer; + vid integer; + pid integer; + str varchar; +BEGIN + -- RAISE NOTICE 'pr_str ast: %', ast; + SELECT type_id FROM types.value WHERE value_id = ast INTO type; + -- RAISE NOTICE 'pr_str type: %', type; + CASE + WHEN type = 0 THEN RETURN 'nil'; + WHEN type = 1 THEN RETURN 'false'; + WHEN type = 2 THEN RETURN 'true'; + WHEN type = 3 THEN -- integer + RETURN CAST((SELECT val_int + FROM types.value WHERE value_id = ast) as varchar); + WHEN type = 5 THEN -- string + str := types._valueToString(ast); + IF chr(CAST(x'7f' AS integer)) = substring(str FROM 1 FOR 1) THEN + RETURN ':' || substring(str FROM 2 FOR (char_length(str)-1)); + ELSIF print_readably THEN + str := replace(str, E'\\', '\\'); + str := replace(str, '"', '\"'); + str := replace(str, E'\n', '\n'); + RETURN '"' || str || '"'; + ELSE + RETURN str; + END IF; + WHEN type = 7 THEN -- symbol + RETURN types._valueToString(ast); + WHEN type = 8 THEN -- list + BEGIN + SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; + RETURN '(' || + array_to_string(array( + SELECT printer.pr_str(x, print_readably) + FROM unnest(seq) AS x), ' ') || + ')'; + END; + WHEN type = 9 THEN -- vector + BEGIN + SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; + RETURN '[' || + array_to_string(array( + SELECT printer.pr_str(x, print_readably) + FROM unnest(seq) AS x), ' ') || + ']'; + END; + WHEN type = 10 THEN -- hash-map + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + RETURN '{' || + array_to_string(array( + SELECT printer.pr_str(CAST(key AS integer), + print_readably) || ' ' || + printer.pr_str(CAST(value AS integer), + print_readably) + FROM each(hash)), ' ') || + '}'; + END; + WHEN type = 11 THEN -- native function + RETURN '#'; + WHEN type = 12 THEN -- mal function + BEGIN + SELECT ast_id, params_id + INTO vid, pid + FROM types.value WHERE value_id = ast; + RETURN '(fn* ' || printer.pr_str(pid, print_readably) || + ' ' || printer.pr_str(vid, print_readably) || ')'; + END; + WHEN type = 13 THEN -- atom + BEGIN + SELECT val_seq[1] INTO vid + FROM types.value WHERE value_id = ast; + RETURN '(atom ' || printer.pr_str(vid, print_readably) || ')'; + END; + ELSE + RETURN 'unknown'; + END CASE; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/reader.sql b/impls/plpgsql/reader.sql new file mode 100644 index 0000000000..de4ff83d81 --- /dev/null +++ b/impls/plpgsql/reader.sql @@ -0,0 +1,188 @@ +-- --------------------------------------------------------- +-- reader.sql + +CREATE SCHEMA reader; + +CREATE FUNCTION reader.tokenize(str varchar) RETURNS varchar[] AS $$ +DECLARE + re varchar = E'[[:space:] ,]*(~@|[\\[\\]{}()\'`~@^]|"(?:[\\\\].|[^\\\\"])*"?|;[^\n]*|[^\\s \\[\\]{}()\'"`~@,;^]*)'; +BEGIN + RETURN ARRAY(SELECT tok FROM + (SELECT (regexp_matches(str, re, 'g'))[1] AS tok) AS x + WHERE tok <> '' AND tok NOT LIKE ';%'); +END; $$ LANGUAGE plpgsql IMMUTABLE; + +-- read_atom: +-- takes a tokens array and position +-- returns new position and value_id +CREATE FUNCTION reader.read_atom(tokens varchar[], + INOUT pos integer, OUT result integer) AS $$ +DECLARE + str_id integer; + str varchar; + token varchar; +BEGIN + token := tokens[pos]; + pos := pos + 1; + -- RAISE NOTICE 'read_atom: %', token; + IF token = 'nil' THEN -- nil + result := 0; + ELSIF token = 'false' THEN -- false + result := 1; + ELSIF token = 'true' THEN -- true + result := 2; + ELSIF token ~ '^-?[0-9][0-9]*$' THEN -- integer + -- integer + INSERT INTO types.value (type_id, val_int) + VALUES (3, CAST(token AS integer)) + RETURNING value_id INTO result; + ELSIF token ~ '^"(?:[\\\\].|[^\\\\"])*"' THEN -- string + -- string + str := substring(token FROM 2 FOR (char_length(token)-2)); + str := replace(str, '\\', chr(CAST(x'7f' AS integer))); + str := replace(str, '\"', '"'); + str := replace(str, '\n', E'\n'); + str := replace(str, chr(CAST(x'7f' AS integer)), E'\\'); + result := types._stringv(str); + ELSIF token ~ '^".*' THEN -- unclosed string + RAISE EXCEPTION 'expected ''"'', got EOF'; + ELSIF token ~ '^:.*' THEN -- keyword + -- keyword + result := types._keywordv(substring(token FROM 2 FOR (char_length(token)-1))); + ELSE + -- symbol + result := types._symbolv(token); + END IF; +END; $$ LANGUAGE plpgsql; + +-- read_seq: +-- takes a tokens array, type (8, 9, 10), first and last characters +-- and position +-- returns new position and value_id for a list (8), vector (9) or +-- hash-map (10) +CREATE FUNCTION reader.read_seq(tokens varchar[], first varchar, last varchar, + INOUT p integer, OUT items integer[]) AS $$ +DECLARE + token varchar; + key varchar = NULL; + item_id integer; +BEGIN + token := tokens[p]; + p := p + 1; + IF token <> first THEN + RAISE EXCEPTION 'expected ''%'', got EOF', first; + END IF; + items := ARRAY[]::integer[]; + LOOP + IF p > array_length(tokens, 1) THEN + RAISE EXCEPTION 'expected ''%'', got EOF', last; + END IF; + token := tokens[p]; + IF token = last THEN EXIT; END IF; + SELECT * FROM reader.read_form(tokens, p) INTO p, item_id; + items := array_append(items, item_id); + END LOOP; + + p := p + 1; +END; $$ LANGUAGE plpgsql; + +-- read_form: +-- takes a tokens array and position +-- returns new position and value_id +CREATE FUNCTION reader.read_form(tokens varchar[], + INOUT pos integer, OUT result integer) AS $$ +DECLARE + vid integer; + meta integer; + token varchar; +BEGIN + token := tokens[pos]; -- peek + CASE + WHEN token = '''' THEN + BEGIN + pos := pos + 1; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; + result := types._list(ARRAY[types._symbolv('quote'), vid]); + END; + WHEN token = '`' THEN + BEGIN + pos := pos + 1; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; + result := types._list(ARRAY[types._symbolv('quasiquote'), vid]); + END; + WHEN token = '~' THEN + BEGIN + pos := pos + 1; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; + result := types._list(ARRAY[types._symbolv('unquote'), vid]); + END; + WHEN token = '~@' THEN + BEGIN + pos := pos + 1; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; + result := types._list(ARRAY[types._symbolv('splice-unquote'), vid]); + END; + WHEN token = '^' THEN + BEGIN + pos := pos + 1; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, meta; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; + result := types._list(ARRAY[types._symbolv('with-meta'), vid, meta]); + END; + WHEN token = '@' THEN + BEGIN + pos := pos + 1; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; + result := types._list(ARRAY[types._symbolv('deref'), vid]); + END; + + -- list + WHEN token = ')' THEN + RAISE EXCEPTION 'unexpected '')'''; + WHEN token = '(' THEN + BEGIN + SELECT p, types._list(items) + FROM reader.read_seq(tokens, '(', ')', pos) INTO pos, result; + END; + + -- vector + WHEN token = ']' THEN + RAISE EXCEPTION 'unexpected '']'''; + WHEN token = '[' THEN + BEGIN + SELECT p, types._vector(items) + FROM reader.read_seq(tokens, '[', ']', pos) INTO pos, result; + END; + + -- hash-map + WHEN token = '}' THEN + RAISE EXCEPTION 'unexpected ''}'''; + WHEN token = '{' THEN + BEGIN + SELECT p, types._hash_map(items) + FROM reader.read_seq(tokens, '{', '}', pos) INTO pos, result; + END; + + -- + ELSE + SELECT * FROM reader.read_atom(tokens, pos) INTO pos, result; + END CASE; +END; $$ LANGUAGE plpgsql; + +-- read_str: +-- takes a string +-- returns a new value_id +CREATE FUNCTION reader.read_str(str varchar) RETURNS integer AS $$ +DECLARE + tokens varchar[]; + pos integer; + ast integer; +BEGIN + tokens := reader.tokenize(str); + -- RAISE NOTICE 'read_str first: %', tokens[1]; + pos := 1; + SELECT * FROM reader.read_form(tokens, pos) INTO pos, ast; + -- RAISE NOTICE 'pos after read_atom: %', pos; + RETURN ast; +END; $$ LANGUAGE plpgsql; + diff --git a/impls/plpgsql/run b/impls/plpgsql/run new file mode 100755 index 0000000000..a16184e01a --- /dev/null +++ b/impls/plpgsql/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/wrap.sh $(dirname $0)/${STEP:-stepA_mal}.sql "${@}" diff --git a/impls/plpgsql/step0_repl.sql b/impls/plpgsql/step0_repl.sql new file mode 100644 index 0000000000..2c8e8747ee --- /dev/null +++ b/impls/plpgsql/step0_repl.sql @@ -0,0 +1,59 @@ +-- --------------------------------------------------------- +-- step0_repl.sql + +\i init.sql +\i io.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN line; +END; $$ LANGUAGE plpgsql; + +-- eval +CREATE FUNCTION mal.EVAL(ast varchar, env varchar) RETURNS varchar AS $$ +BEGIN + RETURN ast; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp varchar) RETURNS varchar AS $$ +BEGIN + RETURN exp; +END; $$ LANGUAGE plpgsql; + + +-- repl + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), '')); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; +BEGIN + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step1_read_print.sql b/impls/plpgsql/step1_read_print.sql new file mode 100644 index 0000000000..5138fa8980 --- /dev/null +++ b/impls/plpgsql/step1_read_print.sql @@ -0,0 +1,62 @@ +-- --------------------------------------------------------- +-- step1_read_print.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval +CREATE FUNCTION mal.EVAL(ast integer, env varchar) RETURNS integer AS $$ +BEGIN + RETURN ast; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), '')); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; +BEGIN + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step2_eval.sql b/impls/plpgsql/step2_eval.sql new file mode 100644 index 0000000000..468be88a65 --- /dev/null +++ b/impls/plpgsql/step2_eval.sql @@ -0,0 +1,170 @@ +-- --------------------------------------------------------- +-- step2_eval.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_symbol(ast integer, env hstore) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + BEGIN + IF env ? symkey THEN + RETURN env -> symkey; + ELSE + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env hstore) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env hstore) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env hstore) RETURNS integer AS $$ +DECLARE + a0 integer; + fname varchar; + args integer[] := ARRAY[]::integer[]; + evda0 integer; + result integer; +BEGIN + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + evda0 := mal.EVAL(a0, env); + SELECT val_string INTO fname FROM types.value + WHERE value_id = evda0; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + EXECUTE format('SELECT %s($1);', fname) INTO result USING args; + RETURN result; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +CREATE FUNCTION mal.intop(op varchar, args integer[]) RETURNS integer AS $$ +DECLARE a integer; b integer; result integer; +BEGIN + SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; + SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; + EXECUTE format('INSERT INTO types.value (type_id, val_int) + VALUES (3, $1 %s $2) + RETURNING value_id;', op) INTO result USING a, b; + RETURN result; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.add(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('+', args); END; $$ LANGUAGE plpgsql; +CREATE FUNCTION mal.subtract(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('-', args); END; $$ LANGUAGE plpgsql; +CREATE FUNCTION mal.multiply(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('*', args); END; $$ LANGUAGE plpgsql; +CREATE FUNCTION mal.divide(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('/', args); END; $$ LANGUAGE plpgsql; + + +CREATE FUNCTION mal.REP(env hstore, line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), env)); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ +DECLARE + repl_env hstore; + line varchar; + output varchar; +BEGIN + repl_env := hstore(ARRAY[ + '+', types._function('mal.add'), + '-', types._function('mal.subtract'), + '*', types._function('mal.multiply'), + '/', types._function('mal.divide')]); + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(repl_env, line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step3_env.sql b/impls/plpgsql/step3_env.sql new file mode 100644 index 0000000000..d40d322dc7 --- /dev/null +++ b/impls/plpgsql/step3_env.sql @@ -0,0 +1,213 @@ +-- --------------------------------------------------------- +-- step3_env.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + RETURN mal.EVAL(types._nth(ast, 2), let_env); + END; + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + fname varchar; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT val_string INTO fname FROM types.value + WHERE value_id = evda0; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + END; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +CREATE FUNCTION mal.intop(op varchar, args integer[]) RETURNS integer AS $$ +DECLARE a integer; b integer; result integer; +BEGIN + SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; + SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; + EXECUTE format('INSERT INTO types.value (type_id, val_int) + VALUES (3, $1 %s $2) + RETURNING value_id;', op) INTO result USING a, b; + RETURN result; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.add(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('+', args); END; $$ LANGUAGE plpgsql; +CREATE FUNCTION mal.subtract(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('-', args); END; $$ LANGUAGE plpgsql; +CREATE FUNCTION mal.multiply(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('*', args); END; $$ LANGUAGE plpgsql; +CREATE FUNCTION mal.divide(args integer[]) RETURNS integer AS $$ +BEGIN RETURN mal.intop('/', args); END; $$ LANGUAGE plpgsql; + +-- repl_env is environment 0 +INSERT INTO envs.env (env_id, outer_id, data) + VALUES (0, NULL, hstore(ARRAY['+', types._function('mal.add'), + '-', types._function('mal.subtract'), + '*', types._function('mal.multiply'), + '/', types._function('mal.divide')])); + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; +BEGIN + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step4_if_fn_do.sql b/impls/plpgsql/step4_if_fn_do.sql new file mode 100644 index 0000000000..cef9a8c5ae --- /dev/null +++ b/impls/plpgsql/step4_if_fn_do.sql @@ -0,0 +1,234 @@ +-- --------------------------------------------------------- +-- step4_if_fn_do.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql +\i core.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + RETURN mal.EVAL(types._nth(ast, 2), let_env); + END; + + WHEN 'do' THEN + DECLARE + result integer; + BEGIN + FOR i IN 1 .. types._count(ast) - 1 LOOP + result := mal.EVAL(types._nth(ast, i), env); + END LOOP; + RETURN result; + END; + + WHEN 'if' THEN + IF (SELECT type_id FROM types.value + WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) + IN (0, 1) + THEN -- nil or false + IF types._count(ast) > 3 THEN + RETURN mal.EVAL(types._nth(ast, 3), env); + ELSE + RETURN 0; -- nil + END IF; + ELSE + RETURN mal.EVAL(types._nth(ast, 2), env); + END IF; + + WHEN 'fn*' THEN + RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); + + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + type integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id + INTO type, fname, fast, fparams, fenv + FROM types.value WHERE value_id = evda0; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + RETURN mal.EVAL(fast, envs.new(fenv, fparams, args)); + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; + END; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +-- repl_env is environment 0 + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +-- core.sql: defined using SQL (in core.sql) +-- repl_env is created and populated with core functions in by core.sql + +-- core.mal: defined using the language itself +SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' + +CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; +BEGIN + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step5_tco.sql b/impls/plpgsql/step5_tco.sql new file mode 100644 index 0000000000..2536c742ed --- /dev/null +++ b/impls/plpgsql/step5_tco.sql @@ -0,0 +1,244 @@ +-- --------------------------------------------------------- +-- step5_tco.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql +\i core.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + LOOP + + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + env := let_env; + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END; + + WHEN 'do' THEN + DECLARE + ignored integer; + BEGIN + FOR i IN 1 .. types._count(ast) - 2 LOOP + ignored := mal.EVAL(types._nth(ast, i), env); + END LOOP; + ast := types._nth(ast, types._count(ast)-1); + CONTINUE; -- TCO + END; + + WHEN 'if' THEN + IF (SELECT type_id FROM types.value + WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) + IN (0, 1) + THEN -- nil or false + IF types._count(ast) > 3 THEN + ast := types._nth(ast, 3); + CONTINUE; -- TCO + ELSE + RETURN 0; -- nil + END IF; + ELSE + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END IF; + + WHEN 'fn*' THEN + RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); + + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + type integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id + INTO type, fname, fast, fparams, fenv + FROM types.value WHERE value_id = evda0; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + env := envs.new(fenv, fparams, args); + ast := fast; + CONTINUE; -- TCO + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; + END; + END LOOP; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +-- repl_env is environment 0 + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +-- core.sql: defined using SQL (in core.sql) +-- repl_env is created and populated with core functions in by core.sql + +-- core.mal: defined using the language itself +SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' + +CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; +BEGIN + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step6_file.sql b/impls/plpgsql/step6_file.sql new file mode 100644 index 0000000000..1cbf5fc65d --- /dev/null +++ b/impls/plpgsql/step6_file.sql @@ -0,0 +1,271 @@ +-- --------------------------------------------------------- +-- step6_file.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql +\i core.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + LOOP + + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + env := let_env; + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END; + + WHEN 'do' THEN + DECLARE + ignored integer; + BEGIN + FOR i IN 1 .. types._count(ast) - 2 LOOP + ignored := mal.EVAL(types._nth(ast, i), env); + END LOOP; + ast := types._nth(ast, types._count(ast)-1); + CONTINUE; -- TCO + END; + + WHEN 'if' THEN + IF (SELECT type_id FROM types.value + WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) + IN (0, 1) + THEN -- nil or false + IF types._count(ast) > 3 THEN + ast := types._nth(ast, 3); + CONTINUE; -- TCO + ELSE + RETURN 0; -- nil + END IF; + ELSE + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END IF; + + WHEN 'fn*' THEN + RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); + + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + type integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id + INTO type, fname, fast, fparams, fenv + FROM types.value WHERE value_id = evda0; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + env := envs.new(fenv, fparams, args); + ast := fast; + CONTINUE; -- TCO + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; + END; + END LOOP; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +-- repl_env is environment 0 + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +-- core.sql: defined using SQL (in core.sql) +-- repl_env is created and populated with core functions in by core.sql +CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN mal.EVAL(args[1], 0); +END; $$ LANGUAGE plpgsql; +INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); + +SELECT envs.vset(0, 'eval', + (SELECT value_id FROM types.value + WHERE val_string = 'mal.mal_eval')) \g '/dev/null' +-- *ARGV* values are set by RUN +SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' + + +-- core.mal: defined using the language itself +SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' +SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' + +CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) + RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; + allargs integer; +BEGIN + PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); + + IF argstring IS NOT NULL THEN + allargs := mal.READ(argstring); + PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); + PERFORM mal.REP('(load-file ' || + printer.pr_str(types._first(allargs)) || ')'); + PERFORM io.close(1); + PERFORM io.wait_flushed(1); + RETURN 0; + END IF; + + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step7_quote.sql b/impls/plpgsql/step7_quote.sql new file mode 100644 index 0000000000..4554724dc2 --- /dev/null +++ b/impls/plpgsql/step7_quote.sql @@ -0,0 +1,328 @@ +-- --------------------------------------------------------- +-- step7_quote.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql +\i core.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ +BEGIN + CASE type_id FROM types.value WHERE value_id = ast + WHEN 8 THEN -- list + DECLARE + a0 integer; + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); + END IF; + END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN 9 THEN -- vector + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + WHEN 7, 10 THEN -- symbol or map + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + ELSE + RETURN ast; + END CASE; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + LOOP + + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + env := let_env; + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END; + + WHEN 'quote' THEN + RETURN types._nth(ast, 1); + + WHEN 'quasiquote' THEN + BEGIN + ast := mal.quasiquote(types._nth(ast, 1)); + CONTINUE; -- TCO + END; + + WHEN 'do' THEN + DECLARE + ignored integer; + BEGIN + FOR i IN 1 .. types._count(ast) - 2 LOOP + ignored := mal.EVAL(types._nth(ast, i), env); + END LOOP; + ast := types._nth(ast, types._count(ast)-1); + CONTINUE; -- TCO + END; + + WHEN 'if' THEN + IF (SELECT type_id FROM types.value + WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) + IN (0, 1) + THEN -- nil or false + IF types._count(ast) > 3 THEN + ast := types._nth(ast, 3); + CONTINUE; -- TCO + ELSE + RETURN 0; -- nil + END IF; + ELSE + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END IF; + + WHEN 'fn*' THEN + RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); + + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + type integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id + INTO type, fname, fast, fparams, fenv + FROM types.value WHERE value_id = evda0; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + env := envs.new(fenv, fparams, args); + ast := fast; + CONTINUE; -- TCO + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; + END; + END LOOP; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +-- repl_env is environment 0 + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +-- core.sql: defined using SQL (in core.sql) +-- repl_env is created and populated with core functions in by core.sql +CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN mal.EVAL(args[1], 0); +END; $$ LANGUAGE plpgsql; +INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); + +SELECT envs.vset(0, 'eval', + (SELECT value_id FROM types.value + WHERE val_string = 'mal.mal_eval')) \g '/dev/null' +-- *ARGV* values are set by RUN +SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' + + +-- core.mal: defined using the language itself +SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' +SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' + +CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) + RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; + allargs integer; +BEGIN + PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); + + IF argstring IS NOT NULL THEN + allargs := mal.READ(argstring); + PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); + PERFORM mal.REP('(load-file ' || + printer.pr_str(types._first(allargs)) || ')'); + PERFORM io.close(1); + PERFORM io.wait_flushed(1); + RETURN 0; + END IF; + + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step8_macros.sql b/impls/plpgsql/step8_macros.sql new file mode 100644 index 0000000000..47ed0819fb --- /dev/null +++ b/impls/plpgsql/step8_macros.sql @@ -0,0 +1,338 @@ +-- --------------------------------------------------------- +-- step8_macros.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql +\i core.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ +BEGIN + CASE type_id FROM types.value WHERE value_id = ast + WHEN 8 THEN -- list + DECLARE + a0 integer; + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); + END IF; + END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN 9 THEN -- vector + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + WHEN 7, 10 THEN -- symbol or map + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + ELSE + RETURN ast; + END CASE; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + LOOP + + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + env := let_env; + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END; + + WHEN 'quote' THEN + RETURN types._nth(ast, 1); + + WHEN 'quasiquote' THEN + BEGIN + ast := mal.quasiquote(types._nth(ast, 1)); + CONTINUE; -- TCO + END; + + WHEN 'defmacro!' THEN + RETURN envs.set(env, types._nth(ast, 1), + types._macro(mal.EVAL(types._nth(ast, 2), env))); + + WHEN 'do' THEN + DECLARE + ignored integer; + BEGIN + FOR i IN 1 .. types._count(ast) - 2 LOOP + ignored := mal.EVAL(types._nth(ast, i), env); + END LOOP; + ast := types._nth(ast, types._count(ast)-1); + CONTINUE; -- TCO + END; + + WHEN 'if' THEN + IF (SELECT type_id FROM types.value + WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) + IN (0, 1) + THEN -- nil or false + IF types._count(ast) > 3 THEN + ast := types._nth(ast, 3); + CONTINUE; -- TCO + ELSE + RETURN 0; -- nil + END IF; + ELSE + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END IF; + + WHEN 'fn*' THEN + RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); + + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + type integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + fmacro boolean; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id, macro + INTO type, fname, fast, fparams, fenv, fmacro + FROM types.value WHERE value_id = evda0; + IF fmacro THEN + ast := types._apply(evda0, types._restArray(ast)); + CONTINUE; -- TCO + END IF; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + env := envs.new(fenv, fparams, args); + ast := fast; + CONTINUE; -- TCO + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; + END; + END LOOP; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +-- repl_env is environment 0 + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +-- core.sql: defined using SQL (in core.sql) +-- repl_env is created and populated with core functions in by core.sql +CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN mal.EVAL(args[1], 0); +END; $$ LANGUAGE plpgsql; +INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); + +SELECT envs.vset(0, 'eval', + (SELECT value_id FROM types.value + WHERE val_string = 'mal.mal_eval')) \g '/dev/null' +-- *ARGV* values are set by RUN +SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' + + +-- core.mal: defined using the language itself +SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' +SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' +SELECT mal.REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null' + +CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) + RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; + allargs integer; +BEGIN + PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); + + IF argstring IS NOT NULL THEN + allargs := mal.READ(argstring); + PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); + PERFORM mal.REP('(load-file ' || + printer.pr_str(types._first(allargs)) || ')'); + PERFORM io.close(1); + PERFORM io.wait_flushed(1); + RETURN 0; + END IF; + + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/step9_try.sql b/impls/plpgsql/step9_try.sql new file mode 100644 index 0000000000..94230ad57b --- /dev/null +++ b/impls/plpgsql/step9_try.sql @@ -0,0 +1,361 @@ +-- --------------------------------------------------------- +-- step9_try.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql +\i core.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ +BEGIN + CASE type_id FROM types.value WHERE value_id = ast + WHEN 8 THEN -- list + DECLARE + a0 integer; + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); + END IF; + END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN 9 THEN -- vector + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + WHEN 7, 10 THEN -- symbol or map + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + ELSE + RETURN ast; + END CASE; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + LOOP + + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + env := let_env; + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END; + + WHEN 'quote' THEN + RETURN types._nth(ast, 1); + + WHEN 'quasiquote' THEN + BEGIN + ast := mal.quasiquote(types._nth(ast, 1)); + CONTINUE; -- TCO + END; + + WHEN 'defmacro!' THEN + RETURN envs.set(env, types._nth(ast, 1), + types._macro(mal.EVAL(types._nth(ast, 2), env))); + + WHEN 'try*' THEN + DECLARE + a1 constant integer := types._nth(ast, 1); + a2 integer; + BEGIN + IF types._count(ast) >= 3 THEN + a2 = types._nth(ast, 2); + IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN + BEGIN + RETURN mal.EVAL(a1, env); + EXCEPTION WHEN OTHERS THEN + env := envs.new(env); + PERFORM envs.set(env, types._nth(a2, 1), + types._stringv(SQLERRM)); + ast := types._nth(a2, 2); + CONTINUE; -- TCO + END; + END IF; + END IF; + ast := a1; + CONTINUE; -- TCO + END; + + WHEN 'do' THEN + DECLARE + ignored integer; + BEGIN + FOR i IN 1 .. types._count(ast) - 2 LOOP + ignored := mal.EVAL(types._nth(ast, i), env); + END LOOP; + ast := types._nth(ast, types._count(ast)-1); + CONTINUE; -- TCO + END; + + WHEN 'if' THEN + IF (SELECT type_id FROM types.value + WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) + IN (0, 1) + THEN -- nil or false + IF types._count(ast) > 3 THEN + ast := types._nth(ast, 3); + CONTINUE; -- TCO + ELSE + RETURN 0; -- nil + END IF; + ELSE + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END IF; + + WHEN 'fn*' THEN + RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); + + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + type integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + fmacro boolean; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id, macro + INTO type, fname, fast, fparams, fenv, fmacro + FROM types.value WHERE value_id = evda0; + IF fmacro THEN + ast := types._apply(evda0, types._restArray(ast)); + CONTINUE; -- TCO + END IF; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + env := envs.new(fenv, fparams, args); + ast := fast; + CONTINUE; -- TCO + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; + END; + END LOOP; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +-- repl_env is environment 0 + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +-- core.sql: defined using SQL (in core.sql) +-- repl_env is created and populated with core functions in by core.sql +CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN mal.EVAL(args[1], 0); +END; $$ LANGUAGE plpgsql; +INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); + +SELECT envs.vset(0, 'eval', + (SELECT value_id FROM types.value + WHERE val_string = 'mal.mal_eval')) \g '/dev/null' +-- *ARGV* values are set by RUN +SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' + + +-- core.mal: defined using the language itself +SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' +SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' +SELECT mal.REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null' + +CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) + RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; + allargs integer; +BEGIN + PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); + + IF argstring IS NOT NULL THEN + allargs := mal.READ(argstring); + PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); + PERFORM mal.REP('(load-file ' || + printer.pr_str(types._first(allargs)) || ')'); + PERFORM io.close(1); + PERFORM io.wait_flushed(1); + RETURN 0; + END IF; + + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/stepA_mal.sql b/impls/plpgsql/stepA_mal.sql new file mode 100644 index 0000000000..be813b1883 --- /dev/null +++ b/impls/plpgsql/stepA_mal.sql @@ -0,0 +1,363 @@ +-- --------------------------------------------------------- +-- stepA_mal.sql + +\i init.sql +\i io.sql +\i types.sql +\i reader.sql +\i printer.sql +\i envs.sql +\i core.sql + +-- --------------------------------------------------------- + +CREATE SCHEMA mal; + +-- read +CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ +BEGIN + RETURN reader.read_str(line); +END; $$ LANGUAGE plpgsql; + +-- eval + +CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ +DECLARE + val constant integer := envs.get(env, 'DEBUG-EVAL'); +BEGIN + IF val IS NOT NULL THEN + IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) + THEN + PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); + END IF; + END IF; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ +BEGIN + CASE type_id FROM types.value WHERE value_id = ast + WHEN 8 THEN -- list + DECLARE + a0 integer; + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); + END IF; + END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN 9 THEN -- vector + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + WHEN 7, 10 THEN -- symbol or map + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + ELSE + RETURN ast; + END CASE; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + symkey constant varchar := types._valueToString(ast); + result constant integer := envs.get(env, symkey); + BEGIN + IF result IS NULL THEN + RAISE EXCEPTION '''%'' not found', symkey; + END IF; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + seq constant integer[] := types._valueToArray(ast); + eseq integer[]; + result integer; + BEGIN + -- Evaluate each entry creating a new sequence + FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP + eseq[i] := mal.EVAL(seq[i], env); + END LOOP; + INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer +AS $$ + DECLARE + hash hstore; + ehash hstore; + kv RECORD; + e integer; + result integer; + BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; + -- Evaluate each value for every key/value + FOR kv IN SELECT * FROM each(hash) LOOP + e := mal.EVAL(CAST(kv.value AS integer), env); + IF ehash IS NULL THEN + ehash := hstore(kv.key, CAST(e AS varchar)); + ELSE + ehash := ehash || hstore(kv.key, CAST(e AS varchar)); + END IF; + END LOOP; + INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) + RETURNING value_id INTO result; + RETURN result; + END; +$$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ +DECLARE + a0 integer; +BEGIN + LOOP + + PERFORM mal.eval_debug(ast, env); + + CASE type_id FROM types.value WHERE value_id = ast + WHEN 7 THEN RETURN mal.eval_symbol(ast, env); + WHEN 8 THEN NULL; -- List, proceed after this case statement. + WHEN 9 THEN RETURN mal.eval_vector(ast, env); + WHEN 10 THEN RETURN mal.eval_map(ast, env); + ELSE RETURN ast; + END CASE; + + IF types._count(ast) = 0 THEN + RETURN ast; + END IF; + + a0 := types._first(ast); + IF types._symbol_Q(a0) THEN + + CASE val_string FROM types.value WHERE value_id = a0 + + WHEN 'def!' THEN + RETURN envs.set(env, types._nth(ast, 1), + mal.EVAL(types._nth(ast, 2), env)); + + WHEN 'let*' THEN + DECLARE + let_env constant integer := envs.new(env); + binds constant integer[] := types._valueToArray(types._nth(ast, 1)); + BEGIN + FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP + PERFORM envs.set(let_env, binds[idx], + mal.EVAL(binds[idx+1], let_env)); + END LOOP; + env := let_env; + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END; + + WHEN 'quote' THEN + RETURN types._nth(ast, 1); + + WHEN 'quasiquote' THEN + BEGIN + ast := mal.quasiquote(types._nth(ast, 1)); + CONTINUE; -- TCO + END; + + WHEN 'defmacro!' THEN + RETURN envs.set(env, types._nth(ast, 1), + types._macro(mal.EVAL(types._nth(ast, 2), env))); + + WHEN 'try*' THEN + DECLARE + a1 constant integer := types._nth(ast, 1); + a2 integer; + BEGIN + IF types._count(ast) >= 3 THEN + a2 = types._nth(ast, 2); + IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN + BEGIN + RETURN mal.EVAL(a1, env); + EXCEPTION WHEN OTHERS THEN + env := envs.new(env); + PERFORM envs.set(env, types._nth(a2, 1), + types._stringv(SQLERRM)); + ast := types._nth(a2, 2); + CONTINUE; -- TCO + END; + END IF; + END IF; + ast := a1; + CONTINUE; -- TCO + END; + + WHEN 'do' THEN + DECLARE + ignored integer; + BEGIN + FOR i IN 1 .. types._count(ast) - 2 LOOP + ignored := mal.EVAL(types._nth(ast, i), env); + END LOOP; + ast := types._nth(ast, types._count(ast)-1); + CONTINUE; -- TCO + END; + + WHEN 'if' THEN + IF (SELECT type_id FROM types.value + WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) + IN (0, 1) + THEN -- nil or false + IF types._count(ast) > 3 THEN + ast := types._nth(ast, 3); + CONTINUE; -- TCO + ELSE + RETURN 0; -- nil + END IF; + ELSE + ast := types._nth(ast, 2); + CONTINUE; -- TCO + END IF; + + WHEN 'fn*' THEN + RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); + + ELSE + NULL; + END CASE; + END IF; + -- Apply phase. + DECLARE + type integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + fmacro boolean; + args integer[] := ARRAY[]::integer[]; + result integer; + evda0 constant integer := mal.EVAL(a0, env); + BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id, macro + INTO type, fname, fast, fparams, fenv, fmacro + FROM types.value WHERE value_id = evda0; + IF fmacro THEN + ast := types._apply(evda0, types._restArray(ast)); + CONTINUE; -- TCO + END IF; + FOR i in 1 .. types._count(ast) - 1 LOOP + args[i] := mal.EVAL(types._nth(ast, i), env); + END LOOP; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + env := envs.new(fenv, fparams, args); + ast := fast; + CONTINUE; -- TCO + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; + END; + END LOOP; +END; $$ LANGUAGE plpgsql; + +-- print +CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ +BEGIN + RETURN printer.pr_str(exp); +END; $$ LANGUAGE plpgsql; + + +-- repl + +-- repl_env is environment 0 + +CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ +BEGIN + RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); +END; $$ LANGUAGE plpgsql; + +-- core.sql: defined using SQL (in core.sql) +-- repl_env is created and populated with core functions in by core.sql +CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ +BEGIN + RETURN mal.EVAL(args[1], 0); +END; $$ LANGUAGE plpgsql; +INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); + +SELECT envs.vset(0, 'eval', + (SELECT value_id FROM types.value + WHERE val_string = 'mal.mal_eval')) \g '/dev/null' +-- *ARGV* values are set by RUN +SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' + + +-- core.mal: defined using the language itself +SELECT mal.REP('(def! *host-language* "plpqsql")') \g '/dev/null' +SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' +SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' +SELECT mal.REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null' + +CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) + RETURNS integer AS $$ +DECLARE + line varchar; + output varchar; + allargs integer; +BEGIN + PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); + + IF argstring IS NOT NULL THEN + allargs := mal.READ(argstring); + PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); + PERFORM mal.REP('(load-file ' || + printer.pr_str(types._first(allargs)) || ')'); + PERFORM io.close(1); + PERFORM io.wait_flushed(1); + RETURN 0; + END IF; + + PERFORM mal.REP('(println (str "Mal [" *host-language* "]"))'); + WHILE true + LOOP + BEGIN + line := io.readline('user> ', 0); + IF line IS NULL THEN + PERFORM io.close(1); + RETURN 0; + END IF; + IF line NOT IN ('', E'\n') THEN + output := mal.REP(line); + PERFORM io.writeline(output); + END IF; + + EXCEPTION WHEN OTHERS THEN + PERFORM io.writeline('Error: ' || SQLERRM); + END; + END LOOP; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/types.sql b/impls/plpgsql/types.sql new file mode 100644 index 0000000000..a6cb67d1e6 --- /dev/null +++ b/impls/plpgsql/types.sql @@ -0,0 +1,703 @@ +-- --------------------------------------------------------- +-- persistent values + +-- list of types for type_id +-- 0: nil +-- 1: false +-- 2: true +-- 3: integer +-- 4: float +-- 5: string +-- 6: keyword (not used, uses prefixed string) +-- 7: symbol +-- 8: list +-- 9: vector +-- 10: hashmap +-- 11: function +-- 12: malfunc +-- 13: atom + +CREATE SCHEMA types + + CREATE SEQUENCE value_id_seq START WITH 3 -- skip nil, false, true + + CREATE TABLE value ( + value_id integer NOT NULL DEFAULT nextval('value_id_seq'), + type_id integer NOT NULL, + val_int bigint, -- set for integers + val_string varchar, -- set for strings, keywords, symbols, + -- and native functions (function name) + val_seq integer[], -- set for lists and vectors + val_hash hstore, -- set for hash-maps + ast_id integer, -- set for malfunc + params_id integer, -- set for malfunc + env_id integer, -- set for malfunc + macro boolean, -- set for malfunc + meta_id integer -- can be set for any collection + ); + +ALTER TABLE types.value ADD CONSTRAINT pk_value_id + PRIMARY KEY (value_id); +-- drop sequence when table dropped +ALTER SEQUENCE types.value_id_seq OWNED BY types.value.value_id; +ALTER TABLE types.value ADD CONSTRAINT fk_meta_id + FOREIGN KEY (meta_id) REFERENCES types.value(value_id); +ALTER TABLE types.value ADD CONSTRAINT fk_params_id + FOREIGN KEY (params_id) REFERENCES types.value(value_id); + +CREATE INDEX ON types.value (value_id, type_id); + +INSERT INTO types.value (value_id, type_id) VALUES (0, 0); -- nil +INSERT INTO types.value (value_id, type_id) VALUES (1, 1); -- false +INSERT INTO types.value (value_id, type_id) VALUES (2, 2); -- true + + +-- --------------------------------------------------------- +-- general functions + +CREATE FUNCTION types._wraptf(val boolean) RETURNS integer AS $$ +BEGIN + IF val THEN + RETURN 2; + ELSE + RETURN 1; + END IF; +END; $$ LANGUAGE plpgsql IMMUTABLE; + +-- pun both NULL and false to false +CREATE FUNCTION types._tf(val boolean) RETURNS boolean AS $$ +BEGIN + IF val IS NULL OR val = false THEN + RETURN false; + END IF; + RETURN true; +END; $$ LANGUAGE plpgsql IMMUTABLE; + +-- pun both NULL and 0 to false +CREATE FUNCTION types._tf(val integer) RETURNS boolean AS $$ +BEGIN + IF val IS NULL OR val = 0 THEN + RETURN false; + END IF; + RETURN true; +END; $$ LANGUAGE plpgsql IMMUTABLE; + +-- return the type of the given value_id +CREATE FUNCTION types._type(obj integer) RETURNS integer AS $$ +BEGIN + RETURN (SELECT type_id FROM types.value WHERE value_id = obj); +END; $$ LANGUAGE plpgsql; + + +CREATE FUNCTION types._equal_Q(a integer, b integer) RETURNS boolean AS $$ +DECLARE + atype integer; + btype integer; + anum bigint; + bnum bigint; + avid integer; + bvid integer; + aseq integer[]; + bseq integer[]; + ahash hstore; + bhash hstore; + kv RECORD; + i integer; +BEGIN + atype := types._type(a); + btype := types._type(b); + IF NOT ((atype = btype) OR + (types._sequential_Q(a) AND types._sequential_Q(b))) THEN + RETURN false; + END IF; + CASE + WHEN atype = 3 THEN -- integer + SELECT val_int FROM types.value INTO anum WHERE value_id = a; + SELECT val_int FROM types.value INTO bnum WHERE value_id = b; + RETURN anum = bnum; + WHEN atype = 5 OR atype = 7 THEN -- string/symbol + RETURN types._valueToString(a) = types._valueToString(b); + WHEN atype IN (8, 9) THEN -- list/vector + IF types._count(a) <> types._count(b) THEN + RETURN false; + END IF; + SELECT val_seq INTO aseq FROM types.value WHERE value_id = a; + SELECT val_seq INTO bseq FROM types.value WHERE value_id = b; + FOR i IN 1 .. types._count(a) + LOOP + IF NOT types._equal_Q(aseq[i], bseq[i]) THEN + return false; + END IF; + END LOOP; + RETURN true; + WHEN atype = 10 THEN -- hash-map + SELECT val_hash INTO ahash FROM types.value WHERE value_id = a; + SELECT val_hash INTO bhash FROM types.value WHERE value_id = b; + IF array_length(akeys(ahash), 1) <> array_length(akeys(bhash), 1) THEN + RETURN false; + END IF; + FOR kv IN SELECT * FROM each(ahash) LOOP + avid := CAST((ahash -> kv.key) AS integer); + bvid := CAST((bhash -> kv.key) AS integer); + IF bvid IS NULL OR NOT types._equal_Q(avid, bvid) THEN + return false; + END IF; + END LOOP; + RETURN true; + ELSE + RETURN a = b; + END CASE; +END; $$ LANGUAGE plpgsql; + + +-- _clone: +-- take a value_id of a collection +-- returns a new value_id of a cloned collection +CREATE FUNCTION types._clone(id integer) RETURNS integer AS $$ +DECLARE + result integer; +BEGIN + INSERT INTO types.value (type_id,val_int,val_string,val_seq,val_hash, + ast_id,params_id,env_id,meta_id) + (SELECT type_id,val_int,val_string,val_seq,val_hash, + ast_id,params_id,env_id,meta_id + FROM types.value + WHERE value_id = id) + RETURNING value_id INTO result; + RETURN result; +END; $$ LANGUAGE plpgsql; + + +-- --------------------------------------------------------- +-- scalar functions + + +-- _nil_Q: +-- takes a value_id +-- returns the whether value_id is nil +CREATE FUNCTION types._nil_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN id = 0; +END; $$ LANGUAGE plpgsql IMMUTABLE; + +-- _true_Q: +-- takes a value_id +-- returns the whether value_id is true +CREATE FUNCTION types._true_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN id = 2; +END; $$ LANGUAGE plpgsql IMMUTABLE; + +-- _false_Q: +-- takes a value_id +-- returns the whether value_id is false +CREATE FUNCTION types._false_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN id = 1; +END; $$ LANGUAGE plpgsql IMMUTABLE; + +-- _string_Q: +-- takes a value_id +-- returns the whether value_id is string type +CREATE FUNCTION types._string_Q(id integer) RETURNS boolean AS $$ +BEGIN + IF (SELECT 1 FROM types.value WHERE type_id = 5 AND value_id = id) THEN + RETURN NOT types._keyword_Q(id); + END IF; + RETURN false; +END; $$ LANGUAGE plpgsql; + +-- _number_Q: +-- takes a value_id +-- returns the whether value_id is integer or float type +CREATE FUNCTION types._number_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE (type_id = 3 OR type_id = 4) + AND value_id = id)); +END; $$ LANGUAGE plpgsql; + +-- _valueToString: +-- takes a value_id for a string +-- returns the varchar value of the string +CREATE FUNCTION types._valueToString(sid integer) RETURNS varchar AS $$ +BEGIN + RETURN (SELECT val_string FROM types.value WHERE value_id = sid); +END; $$ LANGUAGE plpgsql; + +-- _stringish: +-- takes a varchar string +-- returns the value_id of a stringish type (string, symbol, keyword) +CREATE FUNCTION types._stringish(str varchar, type integer) RETURNS integer AS $$ +DECLARE + result integer; +BEGIN + -- TODO: share string data between string types + -- lookup if it exists + SELECT value_id FROM types.value INTO result + WHERE val_string = str AND type_id = type; + IF result IS NULL THEN + -- Create string entry + INSERT INTO types.value (type_id, val_string) + VALUES (type, str) + RETURNING value_id INTO result; + END IF; + RETURN result; +END; $$ LANGUAGE plpgsql; + +-- _stringv: +-- takes a varchar string +-- returns the value_id of a string (new or existing) +CREATE FUNCTION types._stringv(str varchar) RETURNS integer AS $$ +BEGIN + RETURN types._stringish(str, 5); +END; $$ LANGUAGE plpgsql; + +-- _keywordv: +-- takes a varchar string +-- returns the value_id of a keyword (new or existing) +CREATE FUNCTION types._keywordv(name varchar) RETURNS integer AS $$ +BEGIN + RETURN types._stringish(chr(CAST(x'7f' AS integer)) || name, 5); +END; $$ LANGUAGE plpgsql; + +-- _keyword_Q: +-- takes a value_id +-- returns the whether value_id is keyword type +CREATE FUNCTION types._keyword_Q(id integer) RETURNS boolean AS $$ +DECLARE + str varchar; +BEGIN + IF (SELECT 1 FROM types.value WHERE type_id = 5 AND value_id = id) THEN + str := types._valueToString(id); + IF char_length(str) > 0 AND + chr(CAST(x'7f' AS integer)) = substring(str FROM 1 FOR 1) THEN + RETURN true; + END IF; + END IF; + RETURN false; +END; $$ LANGUAGE plpgsql; + +-- _symbolv: +-- takes a varchar string +-- returns the value_id of a symbol (new or existing) +CREATE FUNCTION types._symbolv(name varchar) RETURNS integer AS $$ +BEGIN + RETURN types._stringish(name, 7); +END; $$ LANGUAGE plpgsql; + +-- _symbol_Q: +-- takes a value_id +-- returns the whether value_id is symbol type +CREATE FUNCTION types._symbol_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE type_id = 7 AND value_id = id)); +END; $$ LANGUAGE plpgsql; + +-- _numToValue: +-- takes an bigint number +-- returns the value_id for the number +CREATE FUNCTION types._numToValue(num bigint) RETURNS integer AS $$ +DECLARE + result integer; +BEGIN + SELECT value_id FROM types.value INTO result + WHERE val_int = num AND type_id = 3; + IF result IS NULL THEN + -- Create an integer entry + INSERT INTO types.value (type_id, val_int) + VALUES (3, num) + RETURNING value_id INTO result; + END IF; + RETURN result; +END; $$ LANGUAGE plpgsql; + +-- _fn_Q: +-- takes a value_id +-- returns the whether value_id is a function +CREATE FUNCTION types._fn_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE (type_id = 11 OR type_id = 12) + AND macro IS NULL + AND value_id = id)); +END; $$ LANGUAGE plpgsql; + +-- _macro_Q: +-- takes a value_id +-- returns the whether value_id is a macro +CREATE FUNCTION types._macro_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE type_id = 12 + AND macro IS TRUE + AND value_id = id)); +END; $$ LANGUAGE plpgsql; + +-- --------------------------------------------------------- +-- sequence functions + +-- _sequential_Q: +-- return true if obj value_id is a list or vector +CREATE FUNCTION types._sequential_Q(obj integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE value_id = obj AND (type_id = 8 OR type_id = 9))); +END; $$ LANGUAGE plpgsql; + +-- _collection: +-- takes a array of value_id integers +-- returns the value_id of a new list (8), vector (9) or hash-map (10) +CREATE FUNCTION types._collection(items integer[], type integer) RETURNS integer AS $$ +DECLARE + vid integer; +BEGIN + IF type IN (8, 9) THEN + INSERT INTO types.value (type_id, val_seq) + VALUES (type, items) + RETURNING value_id INTO vid; + ELSIF type = 10 THEN + IF (array_length(items, 1) % 2) = 1 THEN + RAISE EXCEPTION 'hash-map: odd number of arguments'; + END IF; + INSERT INTO types.value (type_id, val_hash) + VALUES (type, hstore(CAST(items AS varchar[]))) + RETURNING value_id INTO vid; + END IF; + RETURN vid; +END; $$ LANGUAGE plpgsql; + + +-- _list: +-- takes a array of value_id integers +-- returns the value_id of a new list +CREATE FUNCTION types._list(items integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._collection(items, 8); +END; $$ LANGUAGE plpgsql; + +-- _vector: +-- takes a array of value_id integers +-- returns the value_id of a new list +CREATE FUNCTION types._vector(items integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._collection(items, 9); +END; $$ LANGUAGE plpgsql; + +-- _list_Q: +-- return true if obj value_id is a list +CREATE FUNCTION types._list_Q(obj integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE value_id = obj and type_id = 8)); +END; $$ LANGUAGE plpgsql; + +-- _vector_Q: +-- return true if obj value_id is a list +CREATE FUNCTION types._vector_Q(obj integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE value_id = obj and type_id = 9)); +END; $$ LANGUAGE plpgsql; + + +-- _valueToArray: +-- takes an value_id referring to a list or vector +-- returns an array of the value_ids from the list/vector +CREATE FUNCTION types._valueToArray(seq integer) RETURNS integer[] AS $$ +DECLARE + result integer[]; +BEGIN + result := (SELECT val_seq FROM types.value WHERE value_id = seq); + IF result IS NULL THEN + result := ARRAY[]::integer[]; + END IF; + RETURN result; +END; $$ LANGUAGE plpgsql; + +-- From: https://wiki.postgresql.org/wiki/Array_reverse +CREATE FUNCTION types.array_reverse(a integer[]) RETURNS integer[] AS $$ +SELECT ARRAY( + SELECT a[i] + FROM generate_subscripts(a,1) AS s(i) + ORDER BY i DESC +); +$$ LANGUAGE 'sql' STRICT IMMUTABLE; + + +-- _nth: +-- takes value_id and an index +-- returns the value_id of nth element in list/vector +CREATE FUNCTION types._nth(seq_id integer, indx integer) RETURNS integer AS $$ +DECLARE + result integer; +BEGIN + RETURN (SELECT val_seq[indx+1] FROM types.value WHERE value_id = seq_id); +END; $$ LANGUAGE plpgsql; + +-- _first: +-- takes value_id +-- returns the value_id of first element in list/vector +CREATE FUNCTION types._first(seq_id integer) RETURNS integer AS $$ +BEGIN + RETURN types._nth(seq_id, 0); +END; $$ LANGUAGE plpgsql; + + +-- _restArray: +-- takes value_id +-- returns the array of value_ids +CREATE FUNCTION types._restArray(seq_id integer) RETURNS integer[] AS $$ +DECLARE + result integer[]; +BEGIN + result := (SELECT val_seq FROM types.value WHERE value_id = seq_id); + RETURN result[2:array_length(result, 1)]; +END; $$ LANGUAGE plpgsql; + +-- _slice: +-- takes value_id, a first index and an last index +-- returns the value_id of new list from first (inclusive) to last (exclusive) +CREATE FUNCTION types._slice(seq_id integer, first integer, last integer) +RETURNS integer AS $$ +DECLARE + seq integer[]; + vid integer; + i integer; + result integer; +BEGIN + SELECT val_seq INTO seq FROM types.value WHERE value_id = seq_id; + INSERT INTO types.value (type_id, val_seq) + VALUES (8, seq[first+1:last]) + RETURNING value_id INTO result; + RETURN result; +END; $$ LANGUAGE plpgsql; + +-- _rest: +-- takes value_id +-- returns the value_id of new list +CREATE FUNCTION types._rest(seq_id integer) RETURNS integer AS $$ +BEGIN + RETURN types._slice(seq_id, 1, types._count(seq_id)); +END; $$ LANGUAGE plpgsql; + +-- _count: +-- takes value_id +-- returns a count (not value_id) +CREATE FUNCTION types._count(seq_id integer) RETURNS integer AS $$ +DECLARE + result integer[]; +BEGIN + result := (SELECT val_seq FROM types.value + WHERE value_id = seq_id); + RETURN COALESCE(array_length(result, 1), 0); +END; $$ LANGUAGE plpgsql; + + +-- --------------------------------------------------------- +-- hash-map functions + +-- _hash_map: +-- return value_id of a new hash-map +CREATE FUNCTION types._hash_map(items integer[]) RETURNS integer AS $$ +BEGIN + RETURN types._collection(items, 10); +END; $$ LANGUAGE plpgsql; + +-- _hash_map_Q: +-- return true if obj value_id is a list +CREATE FUNCTION types._hash_map_Q(obj integer) RETURNS boolean AS $$ +BEGIN + RETURN types._tf((SELECT 1 FROM types.value + WHERE value_id = obj and type_id = 10)); +END; $$ LANGUAGE plpgsql; + +-- _assoc_BANG: +-- return value_id of the hash-map with new elements appended +CREATE FUNCTION types._assoc_BANG(hm integer, items integer[]) RETURNS integer AS $$ +DECLARE + hash hstore; +BEGIN + IF (array_length(items, 1) % 2) = 1 THEN + RAISE EXCEPTION 'hash-map: odd number of arguments'; + END IF; + SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; + IF hash IS NULL THEN + UPDATE types.value SET val_hash = hstore(CAST(items AS varchar[])) + WHERE value_id = hm; + ELSE + UPDATE types.value + SET val_hash = hash || hstore(CAST(items AS varchar[])) + WHERE value_id = hm; + END IF; + RETURN hm; +END; $$ LANGUAGE plpgsql; + +-- _dissoc_BANG: +-- return value_id of the hash-map with elements removed +CREATE FUNCTION types._dissoc_BANG(hm integer, items integer[]) RETURNS integer AS $$ +DECLARE + hash hstore; +BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; + UPDATE types.value SET val_hash = hash - CAST(items AS varchar[]) + WHERE value_id = hm; + RETURN hm; +END; $$ LANGUAGE plpgsql; + +-- _get: +-- return value_id of the hash-map entry matching key +CREATE FUNCTION types._get(hm integer, key varchar) RETURNS integer AS $$ +DECLARE + hash hstore; +BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; + RETURN hash -> CAST(types._stringv(key) AS varchar); +END; $$ LANGUAGE plpgsql; + +-- _contains_Q: +-- return true if hash-map contains entry matching key +CREATE FUNCTION types._contains_Q(hm integer, key varchar) RETURNS boolean AS $$ +DECLARE + hash hstore; +BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; + RETURN types._tf(hash ? CAST(types._stringv(key) AS varchar)); +END; $$ LANGUAGE plpgsql; + +-- _keys: +-- return array of key value_ids from hash-map +CREATE FUNCTION types._keys(hm integer) RETURNS integer[] AS $$ +DECLARE + hash hstore; +BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; + RETURN CAST(akeys(hash) AS integer[]); +END; $$ LANGUAGE plpgsql; + +-- _vals: +-- return array of value value_ids from hash-map +CREATE FUNCTION types._vals(hm integer) RETURNS integer[] AS $$ +DECLARE + hash hstore; +BEGIN + SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; + RETURN CAST(avals(hash) AS integer[]); +END; $$ LANGUAGE plpgsql; + + +-- --------------------------------------------------------- +-- function functions + +-- _function: +-- takes a function name +-- returns the value_id of a new +CREATE FUNCTION types._function(fname varchar) +RETURNS varchar AS $$ +DECLARE + result integer; +BEGIN + INSERT INTO types.value (type_id, val_string) + VALUES (11, fname) + RETURNING value_id INTO result; + RETURN CAST(result AS varchar); +END; $$ LANGUAGE plpgsql; + +-- _malfunc: +-- takes a ast value_id, params value_id and env_id +-- returns the value_id of a new function +CREATE FUNCTION types._malfunc(ast integer, params integer, env integer) +RETURNS integer AS $$ +DECLARE + cid integer = NULL; + result integer; +BEGIN + -- Create function entry + INSERT INTO types.value (type_id, ast_id, params_id, env_id) + VALUES (12, ast, params, env) + RETURNING value_id into result; + RETURN result; +END; $$ LANGUAGE plpgsql; + +-- _macro: +CREATE FUNCTION types._macro(func integer) RETURNS integer AS $$ +DECLARE + newfunc integer; + cid integer; +BEGIN + newfunc := types._clone(func); + UPDATE types.value SET macro = true WHERE value_id = newfunc; + RETURN newfunc; +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION types._apply(func integer, args integer[]) RETURNS integer AS $$ +DECLARE + type integer; + fcid integer; + fname varchar; + fast integer; + fparams integer; + fenv integer; + result integer; +BEGIN + SELECT type_id, val_string, ast_id, params_id, env_id + INTO type, fname, fast, fparams, fenv + FROM types.value WHERE value_id = func; + IF type = 11 THEN + EXECUTE format('SELECT %s($1);', fname) + INTO result USING args; + RETURN result; + ELSIF type = 12 THEN + -- NOTE: forward reference to current step EVAL function + RETURN mal.EVAL(fast, envs.new(fenv, fparams, args)); + ELSE + RAISE EXCEPTION 'Invalid function call'; + END IF; +END; $$ LANGUAGE plpgsql; + +-- --------------------------------------------------------- +-- atom functions + +-- _atom: +-- takes an ast value_id +-- returns a new atom value_id +CREATE FUNCTION types._atom(val integer) RETURNS integer AS $$ +DECLARE + cid integer = NULL; + result integer; +BEGIN + -- Create atom + INSERT INTO types.value (type_id, val_seq) + VALUES (13, ARRAY[val]) + RETURNING value_id INTO result; + RETURN result; +END; $$ LANGUAGE plpgsql; + +-- _atom_Q: +-- takes a value_id +-- returns the whether value_id is an atom +CREATE FUNCTION types._atom_Q(id integer) RETURNS boolean AS $$ +BEGIN + RETURN EXISTS(SELECT 1 FROM types.value + WHERE type_id = 13 AND value_id = id); +END; $$ LANGUAGE plpgsql; + +-- _deref: +-- takes an atom value_id +-- returns a atom value value_id +CREATE FUNCTION types._deref(atm integer) RETURNS integer AS $$ +DECLARE + result integer; +BEGIN + RETURN (SELECT val_seq[1] FROM types.value WHERE value_id = atm); +END; $$ LANGUAGE plpgsql; + +-- _reset_BANG: +-- takes an atom value_id and new value value_id +-- returns a new value value_id +CREATE FUNCTION types._reset_BANG(atm integer, newval integer) RETURNS integer AS $$ +BEGIN + UPDATE types.value SET val_seq = ARRAY[newval] WHERE value_id = atm; + RETURN newval; +END; $$ LANGUAGE plpgsql; diff --git a/impls/plpgsql/wrap.sh b/impls/plpgsql/wrap.sh new file mode 100755 index 0000000000..e14c072d6a --- /dev/null +++ b/impls/plpgsql/wrap.sh @@ -0,0 +1,75 @@ +#!/usr/bin/env bash + +RL_HISTORY_FILE=${HOME}/.mal-history +SKIP_INIT="${SKIP_INIT:-}" +PSQL_USER="${PSQL_USER:-postgres}" + +PSQL="psql -q -t -A -v ON_ERROR_STOP=1 ${PSQL_USER:+-U ${PSQL_USER}}" +[ "${DEBUG}" ] || PSQL="${PSQL} -v VERBOSITY=terse" + +# If mal DB is not there, force create of it +dbcheck=$(${PSQL} -c "select 1 from pg_database where datname='mal'") +[ -z "${dbcheck}" ] && SKIP_INIT= + +STDOUT_PID= STDIN_PID= +cleanup () { + trap - TERM QUIT INT EXIT + # Make sure input stream is closed. Input subprocess will do this + # for normal terminal input but in the runtest.py case it does not + # get a chance. + ${PSQL} -dmal -c "SELECT io.close(0);" > /dev/null + [ "${STDIN_PID}" ] && kill ${STDIN_PID} 2>/dev/null +} + +# Load the SQL code +trap "cleanup" TERM QUIT INT EXIT +${PSQL} -tc "SELECT 1 FROM pg_database WHERE datname = 'mal'" \ + | grep -q 1 || ${PSQL} -c "CREATE DATABASE mal" +#[ "${SKIP_INIT}" ] || ${PSQL} -dmal -f $1 > /dev/null +[ "${SKIP_INIT}" ] || ${PSQL} -dmal -f $1 + +${PSQL} -dmal -c "SELECT io.open(0); SELECT io.open(1);" > /dev/null + +# Stream from table to stdout +( +while true; do + out="$(${PSQL} -dmal -c "SELECT io.read_or_error(1)" 2>/dev/null)" || break + echo "${out}" +done +) & +STDOUT_PID=$! + +# Perform readline input into stream table when requested +( +[ -r ${RL_HISTORY_FILE} ] && history -r ${RL_HISTORY_FILE} +while true; do + prompt=$(${PSQL} -dmal \ + -c "SELECT io.wait_rl_prompt(0);" 2>/dev/null) || break + IFS= read -u 0 -r -e -p "${prompt}" line || break + if [ "${line}" ]; then + history -s -- "${line}" # add to history + history -a ${RL_HISTORY_FILE} # save history to file + fi + + ${PSQL} -dmal -v arg="${line}" \ + -f <(echo "SELECT io.writeline(:'arg', 0);") >/dev/null || break +done +${PSQL} -dmal -c "SELECT io.close(0);" > /dev/null +) <&0 >&1 & +STDIN_PID=$! + +res=0 +shift +if [ $# -gt 0 ]; then + # If there are command line arguments then run a command and exit + args=$(for a in "$@"; do echo -n "\"$a\" "; done) + ${PSQL} -dmal -v args="(${args})" \ + -f <(echo "SELECT mal.MAIN('$(pwd)', :'args');") > /dev/null + res=$? +else + # Start main loop in the background + ${PSQL} -dmal -c "SELECT mal.MAIN('$(pwd)');" > /dev/null + res=$? +fi +wait ${STDOUT_PID} +exit ${res} diff --git a/impls/plsql/Dockerfile b/impls/plsql/Dockerfile new file mode 100644 index 0000000000..420f5ee184 --- /dev/null +++ b/impls/plsql/Dockerfile @@ -0,0 +1,34 @@ +FROM wnameless/oracle-xe-11g + +RUN apt-get -y update +RUN apt-get -y install make cpp python + +RUN apt-get -y install rlwrap + +ENV ORACLE_HOME /u01/app/oracle/product/11.2.0/xe +ENV PATH ${ORACLE_HOME}/bin:${PATH} +ENV ORACLE_SID=XE + +# Enable use of DMBS_LOCK.sleep and make sure there are no password +# expiry messages that may interfere with communication. +RUN /usr/sbin/startup.sh && \ + echo "GRANT EXECUTE ON DBMS_LOCK TO system;" | sqlplus -S sys/oracle AS sysdba && \ + echo "ALTER PROFILE default LIMIT PASSWORD_LIFE_TIME UNLIMITED;" | sqlplus -S system/oracle && \ + echo "ALTER USER system IDENTIFIED BY oracle ACCOUNT UNLOCK;" | sqlplus -S system/oracle + +WORKDIR /mal + +# Add oracle user +RUN usermod -a -G sudo oracle + +# Travis runs as user ID 1001 so add that user +RUN useradd -ou 1001 -m -s /bin/bash -G sudo travis + +# Enable oracle and travis users to sudo for oracle startup +RUN echo "%sudo ALL=(ALL:ALL) NOPASSWD: ALL" >> /etc/sudoers + +ADD entrypoint.sh /entrypoint.sh +ENTRYPOINT ["/entrypoint.sh"] +CMD [] + + diff --git a/impls/plsql/Dockerfile-oracle b/impls/plsql/Dockerfile-oracle new file mode 100644 index 0000000000..6956e833cc --- /dev/null +++ b/impls/plsql/Dockerfile-oracle @@ -0,0 +1,6 @@ +FROM wnameless/oracle-xe-11g + +RUN apt-get -y update +RUN apt-get -y install make cpp python + +RUN apt-get -y install rlwrap diff --git a/impls/plsql/Dockerfile-postgres b/impls/plsql/Dockerfile-postgres new file mode 100644 index 0000000000..e6aa498fea --- /dev/null +++ b/impls/plsql/Dockerfile-postgres @@ -0,0 +1,22 @@ +FROM ubuntu:14.04 + +RUN apt-get -y update +RUN apt-get -y install make cpp python + +RUN apt-get -y install curl +RUN useradd -u 1000 -m -s /bin/bash -G sudo postgres + +ENV PG_VERSION=9.4 +RUN curl https://www.postgresql.org/media/keys/ACCC4CF8.asc | apt-key add - && \ + echo 'deb http://apt.postgresql.org/pub/repos/apt/ trusty-pgdg main' > /etc/apt/sources.list.d/pgdg.list && \ + apt-get update && \ + DEBIAN_FRONTEND=noninteractive apt-get -y install acl \ + postgresql-${PG_VERSION} postgresql-client-${PG_VERSION} postgresql-contrib-${PG_VERSION} && \ + mkdir -p /var/run/postgresql/9.4-main.pg_stat_tmp/ && \ + chown -R postgres /var/run/postgresql + +ENV HOME=/var/run/postgresql + +# Add entrypoint.sh which starts postgres then run bash/command +ADD entrypoint.sh /entrypoint.sh +ENTRYPOINT ["/entrypoint.sh"] diff --git a/impls/plsql/Makefile b/impls/plsql/Makefile new file mode 100644 index 0000000000..7af3113c71 --- /dev/null +++ b/impls/plsql/Makefile @@ -0,0 +1,3 @@ +all: + +clean: diff --git a/impls/plsql/core.sql b/impls/plsql/core.sql new file mode 100644 index 0000000000..02cf30f8b5 --- /dev/null +++ b/impls/plsql/core.sql @@ -0,0 +1,632 @@ +CREATE OR REPLACE TYPE core_ns_T IS TABLE OF varchar2(100); +/ + +CREATE OR REPLACE PACKAGE core IS + FUNCTION do_core_func(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + fn integer, + a mal_vals) RETURN integer; + + FUNCTION get_core_ns RETURN core_ns_T; +END core; +/ +show errors; + + +CREATE OR REPLACE PACKAGE BODY core AS + +-- general functions +FUNCTION equal_Q(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.tf(types.equal_Q(M, H, args(1), args(2))); +END; + +-- scalar functiosn +FUNCTION symbol(M IN OUT NOCOPY types.mal_table, + val integer) RETURN integer IS +BEGIN + RETURN types.symbol(M, TREAT(M(val) AS mal_str_T).val_str); +END; + +FUNCTION keyword(M IN OUT NOCOPY types.mal_table, + val integer) RETURN integer IS +BEGIN + IF types.string_Q(M, val) THEN + RETURN types.keyword(M, TREAT(M(val) AS mal_str_T).val_str); + ELSIF types.keyword_Q(M, val) THEN + RETURN val; + ELSE + raise_application_error(-20009, + 'invalid keyword call', TRUE); + END IF; +END; + + +-- string functions +FUNCTION pr_str(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.string(M, printer.pr_str_seq(M, H, args, ' ', TRUE)); +END; + +FUNCTION str(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.string(M, printer.pr_str_seq(M, H, args, '', FALSE)); +END; + +FUNCTION prn(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + args mal_vals) RETURN integer IS +BEGIN + io.writeline(printer.pr_str_seq(M, H, args, ' ', TRUE)); + RETURN 1; -- nil +END; + +FUNCTION println(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + args mal_vals) RETURN integer IS +BEGIN + io.writeline(printer.pr_str_seq(M, H, args, ' ', FALSE)); + RETURN 1; -- nil +END; + +FUNCTION read_string(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + args mal_vals) RETURN integer IS +BEGIN + IF M(args(1)).type_id = 5 THEN + RETURN reader.read_str(M, H, + TREAT(M(args(1)) AS mal_str_T).val_str); + ELSE + RETURN reader.read_str(M, H, + TREAT(M(args(1)) AS mal_long_str_T).val_long_str); + END IF; +END; + +FUNCTION readline(M IN OUT NOCOPY types.mal_table, + prompt integer) RETURN integer IS + input CLOB; +BEGIN + input := io.readline(TREAT(M(prompt) AS mal_str_T).val_str, 0); + RETURN types.string(M, input); +EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io streams closed + RETURN 1; -- nil + ELSE + RAISE; + END IF; +END; + +FUNCTION slurp(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS + content CLOB; +BEGIN + content := io.file_open_and_read(TREAT(M(args(1)) AS mal_str_T).val_str); + content := REPLACE(content, '\n', chr(10)); + RETURN types.string(M, content); +END; + + +-- numeric functions +FUNCTION lt(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int < + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION lte(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int <= + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION gt(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int > + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION gte(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int >= + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION add(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int + + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION subtract(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int - + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION multiply(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int * + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION divide(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS +BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int / + TREAT(M(args(2)) AS mal_int_T).val_int); +END; + +FUNCTION time_ms(M IN OUT NOCOPY types.mal_table) RETURN integer IS + now integer; +BEGIN + SELECT extract(day from(sys_extract_utc(systimestamp) - + to_timestamp('1970-01-01', 'YYYY-MM-DD'))) * 86400000 + + to_number(to_char(sys_extract_utc(systimestamp), 'SSSSSFF3')) + INTO now + FROM dual; + RETURN types.int(M, now); +END; + +-- hash-map functions +FUNCTION assoc(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + hm integer, + kvs mal_vals) RETURN integer IS + new_hm integer; + midx integer; +BEGIN + new_hm := types.clone(M, H, hm); + midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + -- Add the new key/values + midx := types.assoc_BANG(M, H, midx, kvs); + RETURN new_hm; +END; + +FUNCTION dissoc(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + hm integer, + ks mal_vals) RETURN integer IS + new_hm integer; + midx integer; +BEGIN + new_hm := types.clone(M, H, hm); + midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + -- Remove the keys + midx := types.dissoc_BANG(M, H, midx, ks); + RETURN new_hm; +END; + + +FUNCTION get(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + hm integer, key integer) RETURN integer IS + midx integer; + k varchar2(256); + val integer; +BEGIN + IF M(hm).type_id = 0 THEN + RETURN 1; -- nil + END IF; + midx := TREAT(M(hm) AS mal_map_T).map_idx; + k := TREAT(M(key) AS mal_str_T).val_str; + IF H(midx).EXISTS(k) THEN + RETURN H(midx)(k); + ELSE + RETURN 1; -- nil + END IF; +END; + +FUNCTION contains_Q(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + hm integer, key integer) RETURN integer IS + midx integer; + k varchar2(256); + val integer; +BEGIN + midx := TREAT(M(hm) AS mal_map_T).map_idx; + k := TREAT(M(key) AS mal_str_T).val_str; + RETURN types.tf(H(midx).EXISTS(k)); +END; + +FUNCTION keys(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + hm integer) RETURN integer IS + midx integer; + k varchar2(256); + ks mal_vals; + val integer; +BEGIN + midx := TREAT(M(hm) AS mal_map_T).map_idx; + ks := mal_vals(); + + k := H(midx).FIRST(); + WHILE k IS NOT NULL LOOP + ks.EXTEND(); + ks(ks.COUNT()) := types.string(M, k); + k := H(midx).NEXT(k); + END LOOP; + + RETURN types.seq(M, 8, ks); +END; + +FUNCTION vals(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + hm integer) RETURN integer IS + midx integer; + k varchar2(256); + ks mal_vals; + val integer; +BEGIN + midx := TREAT(M(hm) AS mal_map_T).map_idx; + ks := mal_vals(); + + k := H(midx).FIRST(); + WHILE k IS NOT NULL LOOP + ks.EXTEND(); + ks(ks.COUNT()) := H(midx)(k); + k := H(midx).NEXT(k); + END LOOP; + + RETURN types.seq(M, 8, ks); +END; + + +-- sequence functions +FUNCTION cons(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS + new_items mal_vals; + len integer; + i integer; +BEGIN + new_items := mal_vals(); + len := types.count(M, args(2)); + new_items.EXTEND(len+1); + new_items(1) := args(1); + FOR i IN 1..len LOOP + new_items(i+1) := TREAT(M(args(2)) AS mal_seq_T).val_seq(i); + END LOOP; + RETURN types.seq(M, 8, new_items); +END; + +FUNCTION concat(M IN OUT NOCOPY types.mal_table, + args mal_vals) RETURN integer IS + new_items mal_vals; + cur_len integer; + seq_len integer; + i integer; + j integer; +BEGIN + new_items := mal_vals(); + cur_len := 0; + FOR i IN 1..args.COUNT() LOOP + seq_len := types.count(M, args(i)); + new_items.EXTEND(seq_len); + FOR j IN 1..seq_len LOOP + new_items(cur_len + j) := types.nth(M, args(i), j-1); + END LOOP; + cur_len := cur_len + seq_len; + END LOOP; + RETURN types.seq(M, 8, new_items); +END; + +FUNCTION vec(M IN OUT NOCOPY types.mal_table, + seq integer) RETURN integer IS +BEGIN + type_id := M(seq).type_id; + CASE + WHEN type_id = 8 THEN + RETURN types.seq(M, 9, TREAT(M(seq) AS mal_seq_T).val_seq); + WHEN type_id = 9 THEN + RETURN seq; + ELSE + raise_application_error(-20009, + 'vec: not supported on type ' || type_id, TRUE); + END CASE; +END; + +FUNCTION nth(M IN OUT NOCOPY types.mal_table, + val integer, + ival integer) RETURN integer IS + idx integer; +BEGIN + idx := TREAT(M(ival) AS mal_int_T).val_int; + RETURN types.nth(M, val, idx); +END; + +FUNCTION first(M IN OUT NOCOPY types.mal_table, + val integer) RETURN integer IS +BEGIN + IF val = 1 OR types.count(M, val) = 0 THEN + RETURN 1; -- nil + ELSE + RETURN types.first(M, val); + END IF; +END; + +FUNCTION rest(M IN OUT NOCOPY types.mal_table, + val integer) RETURN integer IS +BEGIN + IF val = 1 OR types.count(M, val) = 0 THEN + RETURN types.list(M); + ELSE + RETURN types.slice(M, val, 1); + END IF; +END; + +FUNCTION do_count(M IN OUT NOCOPY types.mal_table, + val integer) RETURN integer IS +BEGIN + IF M(val).type_id = 0 THEN + RETURN types.int(M, 0); + ELSE + RETURN types.int(M, types.count(M, val)); + END IF; +END; + + +FUNCTION conj(M IN OUT NOCOPY types.mal_table, + seq integer, + vals mal_vals) RETURN integer IS + type_id integer; + slen integer; + items mal_vals; +BEGIN + type_id := M(seq).type_id; + slen := types.count(M, seq); + items := mal_vals(); + items.EXTEND(slen + vals.COUNT()); + CASE + WHEN type_id = 8 THEN + FOR i IN 1..vals.COUNT() LOOP + items(i) := vals(vals.COUNT + 1 - i); + END LOOP; + FOR i IN 1..slen LOOP + items(vals.COUNT() + i) := types.nth(M, seq, i-1); + END LOOP; + WHEN type_id = 9 THEN + FOR i IN 1..slen LOOP + items(i) := types.nth(M, seq, i-1); + END LOOP; + FOR i IN 1..vals.COUNT() LOOP + items(slen + i) := vals(i); + END LOOP; + ELSE + raise_application_error(-20009, + 'conj: not supported on type ' || type_id, TRUE); + END CASE; + RETURN types.seq(M, type_id, items); +END; + +FUNCTION seq(M IN OUT NOCOPY types.mal_table, + val integer) RETURN integer IS + type_id integer; + new_val integer; + str CLOB; + str_items mal_vals; +BEGIN + type_id := M(val).type_id; + CASE + WHEN type_id = 8 THEN + IF types.count(M, val) = 0 THEN + RETURN 1; -- nil + END IF; + RETURN val; + WHEN type_id = 9 THEN + IF types.count(M, val) = 0 THEN + RETURN 1; -- nil + END IF; + RETURN types.seq(M, 8, TREAT(M(val) AS mal_seq_T).val_seq); + WHEN types.string_Q(M, val) THEN + str := TREAT(M(val) AS mal_str_T).val_str; + IF str IS NULL THEN + RETURN 1; -- nil + END IF; + str_items := mal_vals(); + str_items.EXTEND(LENGTH(str)); + FOR i IN 1..LENGTH(str) LOOP + str_items(i) := types.string(M, SUBSTR(str, i, 1)); + END LOOP; + RETURN types.seq(M, 8, str_items); + WHEN type_id = 0 THEN + RETURN 1; -- nil + ELSE + raise_application_error(-20009, + 'seq: not supported on type ' || type_id, TRUE); + END CASE; +END; + +-- metadata functions +FUNCTION meta(M IN OUT NOCOPY types.mal_table, + val integer) RETURN integer IS + type_id integer; +BEGIN + type_id := M(val).type_id; + IF type_id IN (8,9) THEN -- list/vector + RETURN TREAT(M(val) AS mal_seq_T).meta; + ELSIF type_id = 10 THEN -- hash-map + RETURN TREAT(M(val) AS mal_map_T).meta; + ELSIF type_id = 11 THEN -- native function + RETURN 1; -- nil + ELSIF type_id = 12 THEN -- mal function + RETURN TREAT(M(val) AS mal_func_T).meta; + ELSE + raise_application_error(-20006, + 'meta: metadata not supported on type', TRUE); + END IF; +END; + +-- general native function case/switch +FUNCTION do_core_func(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + fn integer, + a mal_vals) RETURN integer IS + fname varchar(256); + idx integer; +BEGIN + IF M(fn).type_id <> 11 THEN + raise_application_error(-20004, + 'Invalid function call', TRUE); + END IF; + + fname := TREAT(M(fn) AS mal_str_T).val_str; + + CASE + WHEN fname = '=' THEN RETURN equal_Q(M, H, a); + + WHEN fname = 'nil?' THEN RETURN types.tf(a(1) = 1); + WHEN fname = 'false?' THEN RETURN types.tf(a(1) = 2); + WHEN fname = 'true?' THEN RETURN types.tf(a(1) = 3); + WHEN fname = 'string?' THEN RETURN types.tf(types.string_Q(M, a(1))); + WHEN fname = 'symbol' THEN RETURN symbol(M, a(1)); + WHEN fname = 'symbol?' THEN RETURN types.tf(M(a(1)).type_id = 7); + WHEN fname = 'keyword' THEN RETURN keyword(M, a(1)); + WHEN fname = 'keyword?' THEN RETURN types.tf(types.keyword_Q(M, a(1))); + WHEN fname = 'number?' THEN RETURN types.tf(types.number_Q(M, a(1))); + WHEN fname = 'fn?' THEN RETURN types.tf(types.function_Q(M, a(1))); + WHEN fname = 'macro?' THEN RETURN types.tf(types.macro_Q(M, a(1))); + + WHEN fname = 'pr-str' THEN RETURN pr_str(M, H, a); + WHEN fname = 'str' THEN RETURN str(M, H, a); + WHEN fname = 'prn' THEN RETURN prn(M, H, a); + WHEN fname = 'println' THEN RETURN println(M, H, a); + WHEN fname = 'read-string' THEN RETURN read_string(M, H, a); + WHEN fname = 'readline' THEN RETURN readline(M, a(1)); + WHEN fname = 'slurp' THEN RETURN slurp(M, a); + + WHEN fname = '<' THEN RETURN lt(M, a); + WHEN fname = '<=' THEN RETURN lte(M, a); + WHEN fname = '>' THEN RETURN gt(M, a); + WHEN fname = '>=' THEN RETURN gte(M, a); + WHEN fname = '+' THEN RETURN add(M, a); + WHEN fname = '-' THEN RETURN subtract(M, a); + WHEN fname = '*' THEN RETURN multiply(M, a); + WHEN fname = '/' THEN RETURN divide(M, a); + WHEN fname = 'time-ms' THEN RETURN time_ms(M); + + WHEN fname = 'list' THEN RETURN types.seq(M, 8, a); + WHEN fname = 'list?' THEN RETURN types.tf(M(a(1)).type_id = 8); + WHEN fname = 'vector' THEN RETURN types.seq(M, 9, a); + WHEN fname = 'vector?' THEN RETURN types.tf(M(a(1)).type_id = 9); + WHEN fname = 'hash-map' THEN RETURN types.hash_map(M, H, a); + WHEN fname = 'assoc' THEN RETURN assoc(M, H, a(1), types.islice(a, 1)); + WHEN fname = 'dissoc' THEN RETURN dissoc(M, H, a(1), types.islice(a, 1)); + WHEN fname = 'map?' THEN RETURN types.tf(M(a(1)).type_id = 10); + WHEN fname = 'get' THEN RETURN get(M, H, a(1), a(2)); + WHEN fname = 'contains?' THEN RETURN contains_Q(M, H, a(1), a(2)); + WHEN fname = 'keys' THEN RETURN keys(M, H, a(1)); + WHEN fname = 'vals' THEN RETURN vals(M, H, a(1)); + + WHEN fname = 'sequential?' THEN RETURN types.tf(M(a(1)).type_id IN (8,9)); + WHEN fname = 'cons' THEN RETURN cons(M, a); + WHEN fname = 'concat' THEN RETURN concat(M, a); + WHEN fname = 'vec' THEN RETURN vec(M, a(1)); + WHEN fname = 'nth' THEN RETURN nth(M, a(1), a(2)); + WHEN fname = 'first' THEN RETURN first(M, a(1)); + WHEN fname = 'rest' THEN RETURN rest(M, a(1)); + WHEN fname = 'empty?' THEN RETURN types.tf(0 = types.count(M, a(1))); + WHEN fname = 'count' THEN RETURN do_count(M, a(1)); + + WHEN fname = 'conj' THEN RETURN conj(M, a(1), types.islice(a, 1)); + WHEN fname = 'seq' THEN RETURN seq(M, a(1)); + + WHEN fname = 'meta' THEN RETURN meta(M, a(1)); + WHEN fname = 'with-meta' THEN RETURN types.clone(M, H, a(1), a(2)); + WHEN fname = 'atom' THEN RETURN types.atom_new(M, a(1)); + WHEN fname = 'atom?' THEN RETURN types.tf(M(a(1)).type_id = 13); + WHEN fname = 'deref' THEN RETURN TREAT(M(a(1)) AS mal_atom_T).val; + WHEN fname = 'reset!' THEN RETURN types.atom_reset(M, a(1), a(2)); + + ELSE raise_application_error(-20004, 'Invalid function call', TRUE); + END CASE; +END; + +FUNCTION get_core_ns RETURN core_ns_T IS +BEGIN + RETURN core_ns_T( + '=', + 'throw', + + 'nil?', + 'true?', + 'false?', + 'string?', + 'symbol', + 'symbol?', + 'keyword', + 'keyword?', + 'number?', + 'fn?', + 'macro?', + + 'pr-str', + 'str', + 'prn', + 'println', + 'read-string', + 'readline', + 'slurp', + + '<', + '<=', + '>', + '>=', + '+', + '-', + '*', + '/', + 'time-ms', + + 'list', + 'list?', + 'vector', + 'vector?', + 'hash-map', + 'assoc', + 'dissoc', + 'map?', + 'get', + 'contains?', + 'keys', + 'vals', + + 'sequential?', + 'cons', + 'concat', + 'vec', + 'nth', + 'first', + 'rest', + 'empty?', + 'count', + 'apply', -- defined in step do_builtin function + 'map', -- defined in step do_builtin function + + 'conj', + 'seq', + + 'meta', + 'with-meta', + 'atom', + 'atom?', + 'deref', + 'reset!', + 'swap!' -- defined in step do_builtin function + ); +END; + +END core; +/ +show errors; diff --git a/impls/plsql/entrypoint.sh b/impls/plsql/entrypoint.sh new file mode 100755 index 0000000000..cba55117dc --- /dev/null +++ b/impls/plsql/entrypoint.sh @@ -0,0 +1,17 @@ +#!/usr/bin/env bash + +case ${1} in +make*) + echo "Skipping Oracle XE startup" + ;; +*) + echo "Starting Oracle XE" + sudo /usr/sbin/startup.sh + ;; +esac + +if [ "${*}" ]; then + exec "${@}" +else + exec bash +fi diff --git a/impls/plsql/env.sql b/impls/plsql/env.sql new file mode 100644 index 0000000000..6fdc2ee0b7 --- /dev/null +++ b/impls/plsql/env.sql @@ -0,0 +1,148 @@ +-- --------------------------------------------------------- +-- env.sql + +CREATE OR REPLACE TYPE env_item FORCE AS OBJECT ( + key varchar2(256), + val integer +) FINAL; +/ + +CREATE OR REPLACE TYPE env_data FORCE IS TABLE OF env_item; +/ + +CREATE OR REPLACE TYPE env_T FORCE AS OBJECT ( + idx integer, + outer_idx integer, + data env_data +); +/ + +CREATE OR REPLACE TYPE env_mem_T FORCE IS TABLE OF env_T; +/ + +CREATE OR REPLACE PACKAGE env_pkg IS + TYPE env_entry IS TABLE OF integer INDEX BY varchar2(256); + TYPE env_entry_table IS TABLE OF env_entry; + + FUNCTION env_new(M IN OUT NOCOPY types.mal_table, + eeT IN OUT NOCOPY env_entry_table, + outer_idx integer DEFAULT NULL) + RETURN integer; + FUNCTION env_new(M IN OUT NOCOPY types.mal_table, + eeT IN OUT NOCOPY env_entry_table, + outer_idx integer, + binds integer, + exprs mal_vals) + RETURN integer; + FUNCTION env_set(M IN OUT NOCOPY types.mal_table, + eeT IN OUT NOCOPY env_entry_table, + eidx integer, + key integer, + val integer) RETURN integer; + FUNCTION env_find(M IN OUT NOCOPY types.mal_table, + eeT env_entry_table, + eidx integer, + key integer) RETURN integer; + FUNCTION env_get(M IN OUT NOCOPY types.mal_table, + eeT env_entry_table, + eidx integer, + key integer) RETURN integer; +END env_pkg; +/ +show errors; + + +CREATE OR REPLACE PACKAGE BODY env_pkg IS + +FUNCTION env_new(M IN OUT NOCOPY types.mal_table, + eeT IN OUT NOCOPY env_entry_table, + outer_idx integer DEFAULT NULL) + RETURN integer IS + eidx integer; +BEGIN + eeT.EXTEND(); + eidx := eeT.COUNT(); + eeT(eidx)('**OUTER**') := outer_idx; + RETURN eidx; +END; + +FUNCTION env_new(M IN OUT NOCOPY types.mal_table, + eeT IN OUT NOCOPY env_entry_table, + outer_idx integer, + binds integer, + exprs mal_vals) + RETURN integer IS + eidx integer; + i integer; + bs mal_vals; +BEGIN + eeT.EXTEND(); + eidx := eeT.COUNT(); + eeT(eidx)('**OUTER**') := outer_idx; + IF binds IS NOT NULL THEN + bs := TREAT(M(binds) AS mal_seq_T).val_seq; + FOR i IN 1..bs.COUNT LOOP + IF TREAT(M(bs(i)) AS mal_str_T).val_str = '&' THEN + eeT(eidx)(TREAT(M(bs(i+1)) AS mal_str_T).val_str) := + types.slice(M, exprs, i-1); + EXIT; + ELSE + eeT(eidx)(TREAT(M(bs(i)) AS mal_str_T).val_str) := + exprs(i); + END IF; + END LOOP; + END IF; + RETURN eidx; +END; + +FUNCTION env_set(M IN OUT NOCOPY types.mal_table, + eeT IN OUT NOCOPY env_entry_table, + eidx integer, + key integer, + val integer) RETURN integer IS + k varchar2(256); + i integer; + cnt integer; +BEGIN + k := TREAT(M(key) AS mal_str_T).val_str; + eeT(eidx)(k) := val; + RETURN val; +END; + +FUNCTION env_find(M IN OUT NOCOPY types.mal_table, + eeT env_entry_table, + eidx integer, + key integer) RETURN integer IS + k varchar2(256); + cnt integer; +BEGIN + k := TREAT(M(key) AS mal_str_T).val_str; + IF eeT(eidx).EXISTS(k) THEN + RETURN eidx; + ELSIF eeT(eidx)('**OUTER**') IS NOT NULL THEN + RETURN env_find(M, eeT, eeT(eidx)('**OUTER**'), key); + ELSE + RETURN NULL; + END IF; +END; + +FUNCTION env_get(M IN OUT NOCOPY types.mal_table, + eeT env_entry_table, + eidx integer, + key integer) RETURN integer IS + found integer; + k varchar2(256); +BEGIN + found := env_find(M, eeT, eidx, key); + k := TREAT(M(key) AS mal_str_T).val_str; + IF found IS NOT NULL THEN + RETURN eeT(found)(k); + ELSE + raise_application_error(-20005, + '''' || k || ''' not found', TRUE); + END IF; +END; + +END env_pkg; +/ +show errors; diff --git a/impls/plsql/io.sql b/impls/plsql/io.sql new file mode 100644 index 0000000000..527dde2cb5 --- /dev/null +++ b/impls/plsql/io.sql @@ -0,0 +1,250 @@ +BEGIN + EXECUTE IMMEDIATE 'DROP TABLE stream'; +EXCEPTION + WHEN OTHERS THEN IF SQLCODE != -942 THEN RAISE; END IF; +END; +/ + +CREATE TABLE stream ( + stream_id integer, + open number(1,0), -- stream open (1) or closed (0) + data CLOB, -- queued stream data + rl_prompt varchar2(256) -- prompt for readline input +); + +-- stdin +INSERT INTO stream (stream_id, open, data, rl_prompt) + VALUES (0, 0, '', ''); +-- stdout +INSERT INTO stream (stream_id, open, data, rl_prompt) + VALUES (1, 0, '', ''); + +-- --------------------------------------------------------- + +BEGIN + EXECUTE IMMEDIATE 'DROP TABLE file_io'; +EXCEPTION + WHEN OTHERS THEN IF SQLCODE != -942 THEN RAISE; END IF; +END; +/ + +CREATE TABLE file_io ( + path varchar2(1024), -- file to read/write + data CLOB, -- file data + error varchar2(1024), -- any errors during read + in_or_out varchar2(4) -- input ('in') or output ('out') +); + +-- --------------------------------------------------------- + +CREATE OR REPLACE PACKAGE io IS + PROCEDURE open(sid integer); + PROCEDURE close(sid integer); + FUNCTION read(sid integer DEFAULT 0) RETURN CLOB; + FUNCTION readline(prompt varchar, sid integer DEFAULT 0) RETURN CLOB; + PROCEDURE write(input CLOB, sid integer DEFAULT 1); + PROCEDURE writeline(data CLOB, sid integer DEFAULT 1); + FUNCTION wait_rl_prompt(sid integer DEFAULT 0) RETURN varchar; + PROCEDURE wait_flushed(sid integer DEFAULT 1); +FUNCTION file_open_and_read(path varchar) RETURN varchar; +END io; +/ +show errors; + +CREATE OR REPLACE PACKAGE BODY io AS + +PROCEDURE open(sid integer) AS + PRAGMA AUTONOMOUS_TRANSACTION; +BEGIN + -- DBMS_OUTPUT.PUT_LINE('io.open(' || sid || ') start'); + UPDATE stream SET data = '', rl_prompt = '', open = 1 + WHERE stream_id = sid; + COMMIT; + -- DBMS_OUTPUT.PUT_LINE('io.open(' || sid || ') done'); +END; + +PROCEDURE close(sid integer) AS + PRAGMA AUTONOMOUS_TRANSACTION; +BEGIN + -- DBMS_OUTPUT.PUT_LINE('io.close(' || sid || ') start'); + UPDATE stream SET rl_prompt = '', open = 0 + WHERE stream_id = sid; + COMMIT; + -- DBMS_OUTPUT.PUT_LINE('io.close(' || sid || ') done'); +END; + +-- read: +-- read from stream stream_id in stream table. Waits until there is +-- either data to return or the stream closes (NULL data). Returns +-- NULL when stream is closed. +FUNCTION read(sid integer DEFAULT 0) RETURN CLOB IS + PRAGMA AUTONOMOUS_TRANSACTION; + input CLOB; + isopen integer; + sleep real; +BEGIN + sleep := 0.05; + -- poll / wait for input + WHILE true + LOOP + -- atomic get and set to empty + -- LOCK TABLE stream IN EXCLUSIVE MODE; + SELECT data, open INTO input, isopen FROM stream + WHERE stream_id = sid; + IF input IS NOT NULL THEN + UPDATE stream SET data = '' WHERE stream_id = sid; + COMMIT; + RETURN trim(TRAILING chr(10) FROM input); + END IF; + -- '' -> no input, NULL -> stream closed + --RAISE NOTICE 'read input: [%] %', input, stream_id; + IF isopen = 0 THEN + raise_application_error(-20001, + 'io.read: stream ''' || sid || ''' is closed', TRUE); + END IF; + SYS.DBMS_LOCK.SLEEP(sleep); + IF sleep < 0.5 THEN + sleep := sleep * 1.1; -- backoff + END IF; + END LOOP; +END; + +-- readline: +-- set prompt and wait for readline style input on the stream +FUNCTION readline(prompt varchar, sid integer DEFAULT 0) RETURN CLOB IS + PRAGMA AUTONOMOUS_TRANSACTION; +BEGIN + -- set prompt / request readline style input + -- LOCK TABLE stream IN EXCLUSIVE MODE; + IF sid = 0 THEN + wait_flushed(1); + ELSIF sid = 1 THEN + wait_flushed(0); + END IF; + UPDATE stream SET rl_prompt = prompt WHERE stream_id = sid; + COMMIT; + + RETURN read(sid); +END; + +PROCEDURE write(input CLOB, sid integer DEFAULT 1) AS + PRAGMA AUTONOMOUS_TRANSACTION; +BEGIN + -- LOCK TABLE stream IN EXCLUSIVE MODE; + UPDATE stream SET data = data || input WHERE stream_id = sid; + COMMIT; +END; + +PROCEDURE writeline(data CLOB, sid integer DEFAULT 1) AS + PRAGMA AUTONOMOUS_TRANSACTION; +BEGIN + write(data || TO_CLOB(chr(10)), sid); +END; + +-- --------------------------------------------------------- + +-- wait_rl_prompt: +-- wait for rl_prompt to be set on the given stream and return the +-- rl_prompt value. Errors if stream is already closed. +FUNCTION wait_rl_prompt(sid integer DEFAULT 0) RETURN varchar IS + PRAGMA AUTONOMOUS_TRANSACTION; + isopen integer; + prompt CLOB; + sleep real; + datas integer; +BEGIN + sleep := 0.05; + WHILE true + LOOP + LOCK TABLE stream IN EXCLUSIVE MODE; + SELECT open, rl_prompt INTO isopen, prompt + FROM stream WHERE stream_id = sid; + SELECT count(stream_id) INTO datas FROM stream WHERE data IS NOT NULL; + + IF isopen = 0 THEN + raise_application_error(-20001, + 'io.wait_rl_prompt: stream ''' || sid || ''' is closed', TRUE); + END IF; + + -- wait until all channels have flushed + IF datas = 0 AND prompt IS NOT NULL THEN + UPDATE stream SET rl_prompt = '' WHERE stream_id = sid; + COMMIT; + -- Prompt is returned single-quoted because sqlplus trims + -- trailing whitespace in select output. + RETURN '''' || prompt || ''''; + END IF; + COMMIT; + + DBMS_LOCK.SLEEP(sleep); + IF sleep < 0.5 THEN + sleep := sleep * 1.1; -- backoff + END IF; + END LOOP; +END; + +PROCEDURE wait_flushed(sid integer DEFAULT 1) AS + PRAGMA AUTONOMOUS_TRANSACTION; + pending integer; + sleep real; +BEGIN + sleep := 0.05; + WHILE true + LOOP + SELECT count(stream_id) INTO pending FROM stream + WHERE stream_id = sid AND data IS NOT NULL; + IF pending = 0 THEN RETURN; END IF; + DBMS_LOCK.SLEEP(sleep); + IF sleep < 0.5 THEN + sleep := sleep * 1.1; -- backoff + END IF; + END LOOP; +END; + +-- --------------------------------------------------------- + +FUNCTION file_open_and_read(path varchar) RETURN varchar IS + PRAGMA AUTONOMOUS_TRANSACTION; + sleep real; + content CLOB; + error_msg varchar2(1024); +BEGIN + sleep := 0.05; + -- TODO: use unique ID instead of path + INSERT INTO file_io (path, data, error, in_or_out) + VALUES (path, NULL, NULL, 'in'); + WHILE true + LOOP + LOCK TABLE file_io IN EXCLUSIVE MODE; + SELECT data, error INTO content, error_msg + FROM file_io WHERE path = path AND ROWNUM = 1; + + IF error_msg IS NOT NULL THEN + raise_application_error(-20010, + 'open_and_read error: ''' || error_msg || '''', TRUE); + END IF; + + IF content IS NOT NULL THEN + DELETE FROM file_io WHERE path = path; + COMMIT; + RETURN content; + END IF; + COMMIT; + + -- keep waiting + DBMS_LOCK.SLEEP(sleep); + IF sleep < 0.5 THEN + sleep := sleep * 1.1; -- backoff + END IF; + END LOOP; +END; + +PROCEDURE file_read_response(path varchar, data varchar) AS + PRAGMA AUTONOMOUS_TRANSACTION; +BEGIN + UPDATE file_io SET data = data WHERE path = path; +END; + +END io; +/ +show errors; diff --git a/impls/plsql/login.sql b/impls/plsql/login.sql new file mode 100644 index 0000000000..0cf9f6b7ca --- /dev/null +++ b/impls/plsql/login.sql @@ -0,0 +1,25 @@ +-- PROMPT 'Start login.sql'; +whenever sqlerror exit SQL.SQLCODE; +whenever oserror exit 1; + +SET ECHO OFF; +SET LINESIZE 32767; +-- SET TRIMOUT ON; +-- SET WRAP OFF; +SET PAGESIZE 0; + +-- Do not format whitespace in terminaml output +SET TAB OFF; + +-- Allow literal & in strings +SET DEFINE OFF; + +-- Print DBMS_OUTPUT.PUT_LINE debugcommands +SET SERVEROUTPUT ON SIZE 30000; + +-- Do not truncate or wrap CLOB output +SET LONG 32767; +SET LONGCHUNKSIZE 32767; + +-- PROMPT 'Finish login.sql'; + diff --git a/impls/plsql/printer.sql b/impls/plsql/printer.sql new file mode 100644 index 0000000000..f64e272c48 --- /dev/null +++ b/impls/plsql/printer.sql @@ -0,0 +1,128 @@ +-- --------------------------------------------------------- +-- printer.sql + +CREATE OR REPLACE PACKAGE printer IS + FUNCTION pr_str_seq(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + seq mal_vals, sep varchar2, + print_readably boolean DEFAULT TRUE) RETURN varchar; + FUNCTION pr_str(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + ast integer, + print_readably boolean DEFAULT TRUE) RETURN varchar; +END printer; +/ +show errors; + +CREATE OR REPLACE PACKAGE BODY printer AS + +FUNCTION pr_str_seq(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + seq mal_vals, sep varchar2, + print_readably boolean DEFAULT TRUE) RETURN varchar IS + first integer := 1; + str CLOB; +BEGIN + FOR i IN 1..seq.COUNT LOOP + IF first = 1 THEN + first := 0; + ELSE + str := str || sep; + END IF; + str := str || pr_str(M, H, seq(i), print_readably); + END LOOP; + RETURN str; +END; + +FUNCTION pr_str_map(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + midx integer, sep varchar2, + print_readably boolean DEFAULT TRUE) RETURN varchar IS + key varchar2(256); + first integer := 1; + str CLOB; +BEGIN + key := H(midx).FIRST(); + WHILE key IS NOT NULL LOOP + IF first = 1 THEN + first := 0; + ELSE + str := str || sep; + END IF; + str := str || pr_str(M, H, types.string(M, key), print_readably); + str := str || ' ' || pr_str(M, H, H(midx)(key), print_readably); + key := H(midx).NEXT(key); + END LOOP; + RETURN str; +END; + + +FUNCTION pr_str(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + ast integer, + print_readably boolean DEFAULT TRUE) RETURN varchar IS + type_id integer; + first integer := 1; + i integer; + str CLOB; + malfn mal_func_T; +BEGIN + type_id := M(ast).type_id; + -- io.writeline('pr_str type: ' || type_id); + CASE + WHEN type_id = 0 THEN RETURN 'nil'; + WHEN type_id = 1 THEN RETURN 'false'; + WHEN type_id = 2 THEN RETURN 'true'; + WHEN type_id = 3 THEN -- integer + RETURN CAST(TREAT(M(ast) AS mal_int_T).val_int as varchar); + WHEN type_id IN (5,6) THEN -- string + IF type_id = 5 THEN + str := TREAT(M(ast) as mal_str_T).val_str; + ELSE + str := TREAT(M(ast) as mal_long_str_T).val_long_str; + END IF; + IF chr(127) = SUBSTR(str, 1, 1) THEN + RETURN ':' || SUBSTR(str, 2, LENGTH(str)-1); + ELSIF print_readably THEN + str := REPLACE(str, chr(92), '\\'); + str := REPLACE(str, '"', '\"'); + str := REPLACE(str, chr(10), '\n'); + RETURN '"' || str || '"'; + ELSE + RETURN str; + END IF; + RETURN TREAT(M(ast) AS mal_str_T).val_str; + WHEN type_id = 7 THEN -- symbol + RETURN TREAT(M(ast) AS mal_str_T).val_str; + WHEN type_id = 8 THEN -- list + RETURN '(' || pr_str_seq(M, H, + TREAT(M(ast) AS mal_seq_T).val_seq, ' ', + print_readably) || ')'; + WHEN type_id = 9 THEN -- vector + RETURN '[' || pr_str_seq(M, H, + TREAT(M(ast) AS mal_seq_T).val_seq, ' ', + print_readably) || ']'; + WHEN type_id = 10 THEN -- hash-map + RETURN '{' || pr_str_map(M, H, + TREAT(M(ast) AS mal_map_T).map_idx, ' ', + print_readably) || '}'; + WHEN type_id = 11 THEN -- native function + RETURN '#'; + WHEN type_id = 12 THEN -- mal function + malfn := TREAT(M(ast) AS mal_func_T); + RETURN '(fn* ' || pr_str(M, H, malfn.params, print_readably) || + ' ' || pr_str(M, H, malfn.ast, print_readably) || ')'; + WHEN type_id = 13 THEN -- atom + RETURN '(atom ' || + pr_str(M, H, TREAT(M(ast) AS mal_atom_T).val, print_readably) || + ')'; + ELSE + RETURN 'unknown'; + END CASE; +END; + +END printer; +/ +show errors; diff --git a/impls/plsql/reader.sql b/impls/plsql/reader.sql new file mode 100644 index 0000000000..e5e37cf389 --- /dev/null +++ b/impls/plsql/reader.sql @@ -0,0 +1,236 @@ +-- --------------------------------------------------------- +-- reader.sql + +CREATE OR REPLACE TYPE tokens FORCE AS TABLE OF CLOB; +/ + +CREATE OR REPLACE TYPE reader_T FORCE AS OBJECT ( + position integer, + toks tokens, + MEMBER FUNCTION peek (SELF IN OUT NOCOPY reader_T) RETURN varchar, + MEMBER FUNCTION next (SELF IN OUT NOCOPY reader_T) RETURN varchar +); +/ + + +CREATE OR REPLACE TYPE BODY reader_T AS + MEMBER FUNCTION peek (SELF IN OUT NOCOPY reader_T) RETURN varchar IS + BEGIN + IF position > toks.COUNT THEN + RETURN NULL; + END IF; + RETURN toks(position); + END; + MEMBER FUNCTION next (SELF IN OUT NOCOPY reader_T) RETURN varchar IS + BEGIN + position := position + 1; + RETURN toks(position-1); + END; +END; +/ + + +CREATE OR REPLACE PACKAGE reader IS + FUNCTION read_str(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + str varchar) RETURN integer; +END reader; +/ +show errors; + + +CREATE OR REPLACE PACKAGE BODY reader AS + +-- tokenize: +-- takes a string and returns a nested table of token strings +FUNCTION tokenize(str varchar) RETURN tokens IS + re varchar2(100) := '[[:space:] ,]*(~@|[][{}()''`~@]|"(([\].|[^\"])*)"?|;[^' || chr(10) || ']*|[^][[:space:] {}()''"`~@,;]*)'; + tok CLOB; + toks tokens := tokens(); + cnt integer; +BEGIN + cnt := REGEXP_COUNT(str, re); + FOR I IN 1..cnt LOOP + tok := REGEXP_SUBSTR(str, re, 1, I, 'm', 1); + IF tok IS NOT NULL AND SUBSTR(tok, 1, 1) <> ';' THEN + toks.extend(); + toks(toks.COUNT) := tok; + -- io.writeline('tok: [' || tok || ']'); + END IF; + END LOOP; + RETURN toks; +END; + +-- read_atom: +-- takes a reader_T +-- updates reader_T and returns a single scalar mal value +FUNCTION read_atom(M IN OUT NOCOPY types.mal_table, + rdr IN OUT NOCOPY reader_T) RETURN integer IS + str_id integer; + str CLOB; + token CLOB; + istr varchar2(256); + result integer; +BEGIN + token := rdr.next(); + -- io.writeline('read_atom: ' || token); + IF token = 'nil' THEN -- nil + result := 1; + ELSIF token = 'false' THEN -- false + result := 2; + ELSIF token = 'true' THEN -- true + result := 3; + ELSIF REGEXP_LIKE(token, '^-?[0-9][0-9]*$') THEN -- integer + istr := token; + result := types.int(M, CAST(istr AS integer)); + ELSIF REGEXP_LIKE(token, '^".*"') THEN -- string + -- string + str := SUBSTR(token, 2, LENGTH(token)-2); + str := REPLACE(str, '\"', '"'); + str := REPLACE(str, '\n', chr(10)); + str := REPLACE(str, '\\', chr(92)); + result := types.string(M, str); + ELSIF REGEXP_LIKE(token, '^".*') THEN -- unclosed string + raise_application_error(-20003, + 'expected ''"'', got EOF', TRUE); + ELSIF REGEXP_LIKE(token, '^:.*') THEN -- keyword + -- keyword + result := types.keyword(M, SUBSTR(token, 2, LENGTH(token)-1)); + ELSE + -- symbol + result := types.symbol(M, token); + END IF; + return result; +END; + +-- forward declaration of read_form +FUNCTION read_form(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + rdr IN OUT NOCOPY reader_T) RETURN integer; + +-- read_seq: +-- takes a reader_T +-- updates reader_T and returns new mal_list/vector/hash-map +FUNCTION read_seq(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + rdr IN OUT NOCOPY reader_T, + type_id integer, + first varchar, last varchar) + RETURN integer IS + token CLOB; + items mal_vals; +BEGIN + token := rdr.next(); + IF token <> first THEN + raise_application_error(-20003, + 'expected ''' || first || '''', TRUE); + END IF; + items := mal_vals(); + LOOP + token := rdr.peek(); + IF token IS NULL THEN + raise_application_error(-20003, + 'expected ''' || last || ''', got EOF', TRUE); + END IF; + IF token = last THEN EXIT; END IF; + items.EXTEND(); + items(items.COUNT) := read_form(M, H, rdr); + END LOOP; + token := rdr.next(); + IF type_id IN (8,9) THEN + RETURN types.seq(M, type_id, items); + ELSE + RETURN types.hash_map(M, H, items); + END IF; +END; + +-- read_form: +-- takes a reader_T +-- updates the reader_T and returns new mal value +FUNCTION read_form(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + rdr IN OUT NOCOPY reader_T) RETURN integer IS + token CLOB; + meta integer; + midx integer; +BEGIN + token := rdr.peek(); -- peek + CASE + WHEN token = '''' THEN + token := rdr.next(); + RETURN types.list(M, + types.symbol(M, 'quote'), + read_form(M, H, rdr)); + WHEN token = '`' THEN + token := rdr.next(); + RETURN types.list(M, + types.symbol(M, 'quasiquote'), + read_form(M, H, rdr)); + WHEN token = '~' THEN + token := rdr.next(); + RETURN types.list(M, + types.symbol(M, 'unquote'), + read_form(M, H, rdr)); + WHEN token = '~@' THEN + token := rdr.next(); + RETURN types.list(M, + types.symbol(M, 'splice-unquote'), + read_form(M, H, rdr)); + WHEN token = '^' THEN + token := rdr.next(); + meta := read_form(M, H, rdr); + RETURN types.list(M, + types.symbol(M, 'with-meta'), + read_form(M, H, rdr), + meta); + WHEN token = '@' THEN + token := rdr.next(); + RETURN types.list(M, + types.symbol(M, 'deref'), + read_form(M, H, rdr)); + + -- list + WHEN token = ')' THEN + raise_application_error(-20002, + 'unexpected '')''', TRUE); + WHEN token = '(' THEN + RETURN read_seq(M, H, rdr, 8, '(', ')'); + + -- vector + WHEN token = ']' THEN + raise_application_error(-20002, + 'unexpected '']''', TRUE); + WHEN token = '[' THEN + RETURN read_seq(M, H, rdr, 9, '[', ']'); + + -- hash-map + WHEN token = '}' THEN + raise_application_error(-20002, + 'unexpected ''}''', TRUE); + WHEN token = '{' THEN + RETURN read_seq(M, H, rdr, 10, '{', '}'); + + -- atom/scalar + ELSE + RETURN read_atom(M, rdr); + END CASE; +END; + +-- read_str: +-- takes a string +-- returns a new mal value +FUNCTION read_str(M IN OUT NOCOPY types.mal_table, + H IN OUT NOCOPY types.map_entry_table, + str varchar) RETURN integer IS + toks tokens; + rdr reader_T; +BEGIN + toks := tokenize(str); + rdr := reader_T(1, toks); + -- io.writeline('token 1: ' || rdr.peek()); + RETURN read_form(M, H, rdr); +END; + +END reader; +/ +show errors; diff --git a/impls/plsql/run b/impls/plsql/run new file mode 100755 index 0000000000..a16184e01a --- /dev/null +++ b/impls/plsql/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/wrap.sh $(dirname $0)/${STEP:-stepA_mal}.sql "${@}" diff --git a/impls/plsql/step0_repl.sql b/impls/plsql/step0_repl.sql new file mode 100644 index 0000000000..7da8032968 --- /dev/null +++ b/impls/plsql/step0_repl.sql @@ -0,0 +1,64 @@ +--\i init.sql +@io.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + line CLOB; + + -- read + FUNCTION READ(line varchar) RETURN varchar IS + BEGIN + RETURN line; + END; + + -- eval + FUNCTION EVAL(ast varchar, env varchar) RETURN varchar IS + BEGIN + RETURN ast; + END; + + -- print + FUNCTION PRINT(exp varchar) RETURN varchar IS + BEGIN + RETURN exp; + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), '')); + END; + +BEGIN + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step1_read_print.sql b/impls/plsql/step1_read_print.sql new file mode 100644 index 0000000000..54ed647562 --- /dev/null +++ b/impls/plsql/step1_read_print.sql @@ -0,0 +1,73 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + line CLOB; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + FUNCTION EVAL(ast integer, env varchar) RETURN integer IS + BEGIN + RETURN ast; + END; + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), '')); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.writeline('closing stream 1'); + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step2_eval.sql b/impls/plsql/step2_eval.sql new file mode 100644 index 0000000000..3ade3ff6e5 --- /dev/null +++ b/impls/plsql/step2_eval.sql @@ -0,0 +1,178 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + TYPE env_T IS TABLE OF integer INDEX BY varchar2(100); + repl_env env_T; + line CLOB; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(ast integer, env env_T) RETURN integer; + FUNCTION do_core_func(fn integer, args mal_vals) + RETURN integer; + + FUNCTION eval_ast(ast integer, env env_T) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env(TREAT(M(ast) AS mal_str_T).val_str); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(ast integer, env env_T) RETURN integer IS + el integer; + f integer; + args mal_vals; + BEGIN + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + RETURN do_core_func(f, args); + END; + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION mal_add(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int + + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION mal_subtract(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int - + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION mal_multiply(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int * + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION mal_divide(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int / + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION do_core_func(fn integer, args mal_vals) + RETURN integer IS + fname varchar(256); + BEGIN + IF M(fn).type_id <> 11 THEN + raise_application_error(-20004, + 'Invalid function call', TRUE); + END IF; + + fname := TREAT(M(fn) AS mal_str_T).val_str; + CASE + WHEN fname = '+' THEN RETURN mal_add(args); + WHEN fname = '-' THEN RETURN mal_subtract(args); + WHEN fname = '*' THEN RETURN mal_multiply(args); + WHEN fname = '/' THEN RETURN mal_divide(args); + ELSE raise_application_error(-20004, + 'Invalid function call', TRUE); + END CASE; + END; + + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + + repl_env('+') := types.func(M, '+'); + repl_env('-') := types.func(M, '-'); + repl_env('*') := types.func(M, '*'); + repl_env('/') := types.func(M, '/'); + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step3_env.sql b/impls/plsql/step3_env.sql new file mode 100644 index 0000000000..171333598b --- /dev/null +++ b/impls/plsql/step3_env.sql @@ -0,0 +1,215 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(ast integer, env integer) RETURN integer; + FUNCTION do_core_func(fn integer, args mal_vals) + RETURN integer; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(ast integer, env integer) RETURN integer IS + el integer; + a0 integer; + a0sym varchar2(256); + seq mal_vals; + let_env integer; + i integer; + f integer; + args mal_vals; + BEGIN + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + RETURN EVAL(types.nth(M, ast, 2), let_env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + RETURN do_core_func(f, args); + END CASE; + + END; + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION mal_add(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int + + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION mal_subtract(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int - + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION mal_multiply(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int * + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION mal_divide(args mal_vals) RETURN integer IS + BEGIN + RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int / + TREAT(M(args(2)) AS mal_int_T).val_int); + END; + + FUNCTION do_core_func(fn integer, args mal_vals) + RETURN integer IS + fname varchar(256); + BEGIN + IF M(fn).type_id <> 11 THEN + raise_application_error(-20004, + 'Invalid function call', TRUE); + END IF; + + fname := TREAT(M(fn) AS mal_str_T).val_str; + CASE + WHEN fname = '+' THEN RETURN mal_add(args); + WHEN fname = '-' THEN RETURN mal_subtract(args); + WHEN fname = '*' THEN RETURN mal_multiply(args); + WHEN fname = '/' THEN RETURN mal_divide(args); + ELSE raise_application_error(-20004, + 'Invalid function call', TRUE); + END CASE; + END; + + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '+'), + types.func(M, '+')); + x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '-'), + types.func(M, '-')); + x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '*'), + types.func(M, '*')); + x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '/'), + types.func(M, '/')); + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step4_if_fn_do.sql b/impls/plsql/step4_if_fn_do.sql new file mode 100644 index 0000000000..814731c2ef --- /dev/null +++ b/impls/plsql/step4_if_fn_do.sql @@ -0,0 +1,203 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql +@core.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + core_ns core_ns_T; + cidx integer; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(ast integer, env integer) RETURN integer; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(ast integer, env integer) RETURN integer IS + el integer; + a0 integer; + a0sym varchar2(100); + seq mal_vals; + let_env integer; + i integer; + f integer; + fn_env integer; + cond integer; + malfn mal_func_T; + args mal_vals; + BEGIN + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + RETURN EVAL(types.nth(M, ast, 2), let_env); + WHEN a0sym = 'do' THEN + el := eval_ast(types.slice(M, ast, 1), env); + RETURN types.nth(M, el, types.count(M, el)-1); + WHEN a0sym = 'if' THEN + cond := EVAL(types.nth(M, ast, 1), env); + IF cond = 1 OR cond = 2 THEN -- nil or false + IF types.count(M, ast) > 3 THEN + RETURN EVAL(types.nth(M, ast, 3), env); + ELSE + RETURN 1; -- nil + END IF; + ELSE + RETURN EVAL(types.nth(M, ast, 2), env); + END IF; + WHEN a0sym = 'fn*' THEN + RETURN types.malfunc(M, types.nth(M, ast, 2), + types.nth(M, ast, 1), + env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, args); + RETURN EVAL(malfn.ast, fn_env); + ELSE + RETURN core.do_core_func(M, H, f, args); + END IF; + END CASE; + + END; + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + + -- core.EXT: defined using PL/SQL + core_ns := core.get_core_ns(); + FOR cidx IN 1..core_ns.COUNT LOOP + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, core_ns(cidx)), + types.func(M, core_ns(cidx))); + END LOOP; + + -- core.mal: defined using the language itself + line := REP('(def! not (fn* (a) (if a false true)))'); + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step5_tco.sql b/impls/plsql/step5_tco.sql new file mode 100644 index 0000000000..6209aba488 --- /dev/null +++ b/impls/plsql/step5_tco.sql @@ -0,0 +1,210 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql +@core.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + core_ns core_ns_T; + cidx integer; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS + ast integer := orig_ast; + env integer := orig_env; + el integer; + a0 integer; + a0sym varchar2(100); + seq mal_vals; + let_env integer; + i integer; + f integer; + cond integer; + malfn mal_func_T; + args mal_vals; + BEGIN + WHILE TRUE LOOP + -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + env := let_env; + ast := types.nth(M, ast, 2); -- TCO + WHEN a0sym = 'do' THEN + x := types.slice(M, ast, 1, types.count(M, ast)-2); + x := eval_ast(x, env); + ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO + WHEN a0sym = 'if' THEN + cond := EVAL(types.nth(M, ast, 1), env); + IF cond = 1 OR cond = 2 THEN -- nil or false + IF types.count(M, ast) > 3 THEN + ast := types.nth(M, ast, 3); -- TCO + ELSE + RETURN 1; -- nil + END IF; + ELSE + ast := types.nth(M, ast, 2); -- TCO + END IF; + WHEN a0sym = 'fn*' THEN + RETURN types.malfunc(M, types.nth(M, ast, 2), + types.nth(M, ast, 1), + env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + env := env_pkg.env_new(M, E, malfn.env, + malfn.params, args); + ast := malfn.ast; -- TCO + ELSE + RETURN core.do_core_func(M, H, f, args); + END IF; + END CASE; + + END LOOP; + + END; + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + + -- core.EXT: defined using PL/SQL + core_ns := core.get_core_ns(); + FOR cidx IN 1..core_ns.COUNT LOOP + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, core_ns(cidx)), + types.func(M, core_ns(cidx))); + END LOOP; + + -- core.mal: defined using the language itself + line := REP('(def! not (fn* (a) (if a false true)))'); + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step6_file.sql b/impls/plsql/step6_file.sql new file mode 100644 index 0000000000..5ef9e59bcc --- /dev/null +++ b/impls/plsql/step6_file.sql @@ -0,0 +1,274 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql +@core.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + core_ns core_ns_T; + cidx integer; + argv mal_vals; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS + ast integer := orig_ast; + env integer := orig_env; + el integer; + a0 integer; + a0sym varchar2(100); + seq mal_vals; + let_env integer; + i integer; + f integer; + cond integer; + malfn mal_func_T; + args mal_vals; + BEGIN + WHILE TRUE LOOP + -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + env := let_env; + ast := types.nth(M, ast, 2); -- TCO + WHEN a0sym = 'do' THEN + x := types.slice(M, ast, 1, types.count(M, ast)-2); + x := eval_ast(x, env); + ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO + WHEN a0sym = 'if' THEN + cond := EVAL(types.nth(M, ast, 1), env); + IF cond = 1 OR cond = 2 THEN -- nil or false + IF types.count(M, ast) > 3 THEN + ast := types.nth(M, ast, 3); -- TCO + ELSE + RETURN 1; -- nil + END IF; + ELSE + ast := types.nth(M, ast, 2); -- TCO + END IF; + WHEN a0sym = 'fn*' THEN + RETURN types.malfunc(M, types.nth(M, ast, 2), + types.nth(M, ast, 1), + env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + env := env_pkg.env_new(M, E, malfn.env, + malfn.params, args); + ast := malfn.ast; -- TCO + ELSE + RETURN do_builtin(f, args); + END IF; + END CASE; + + END LOOP; + + END; + + -- hack to get around lack of function references + -- functions that require special access to repl_env or EVAL + -- are implemented directly here, otherwise, core.do_core_fn + -- is called. + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS + fname varchar2(100); + val integer; + f integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + BEGIN + fname := TREAT(M(fn) AS mal_str_T).val_str; + CASE + WHEN fname = 'do_eval' THEN + RETURN EVAL(args(1), repl_env); + WHEN fname = 'swap!' THEN + val := TREAT(M(args(1)) AS mal_atom_T).val; + f := args(2); + -- slice one extra at the beginning that will be changed + -- to the value of the atom + fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; + fargs(1) := val; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, fargs); + val := EVAL(malfn.ast, fn_env); + ELSE + val := do_builtin(f, fargs); + END IF; + RETURN types.atom_reset(M, args(1), val); + ELSE + RETURN core.do_core_func(M, H, fn, args); + END CASE; + END; + + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + + argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; + + -- core.EXT: defined using PL/SQL + core_ns := core.get_core_ns(); + FOR cidx IN 1..core_ns.COUNT LOOP + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, core_ns(cidx)), + types.func(M, core_ns(cidx))); + END LOOP; + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, 'eval'), + types.func(M, 'do_eval')); + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, '*ARGV*'), + types.slice(M, argv, 1)); + + -- core.mal: defined using the language itself + line := REP('(def! not (fn* (a) (if a false true)))'); + line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + + IF argv.COUNT() > 0 THEN + BEGIN + line := REP('(load-file "' || + TREAT(M(argv(1)) AS mal_str_T).val_str || + '")'); + io.close(1); -- close output stream + RETURN 0; + EXCEPTION WHEN OTHERS THEN + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + io.close(1); -- close output stream + RAISE; + END; + END IF; + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step7_quote.sql b/impls/plsql/step7_quote.sql new file mode 100644 index 0000000000..98b5c80a13 --- /dev/null +++ b/impls/plsql/step7_quote.sql @@ -0,0 +1,323 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql +@core.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + core_ns core_ns_T; + cidx integer; + argv mal_vals; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; + + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; + BEGIN + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; + END IF; + RETURN FALSE; + END; + + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS + BEGIN + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); + END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); + END; + + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS + ast integer := orig_ast; + env integer := orig_env; + el integer; + a0 integer; + a0sym varchar2(100); + seq mal_vals; + let_env integer; + i integer; + f integer; + cond integer; + malfn mal_func_T; + args mal_vals; + BEGIN + WHILE TRUE LOOP + -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + env := let_env; + ast := types.nth(M, ast, 2); -- TCO + WHEN a0sym = 'quote' THEN + RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); + WHEN a0sym = 'quasiquote' THEN + RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); + WHEN a0sym = 'do' THEN + x := types.slice(M, ast, 1, types.count(M, ast)-2); + x := eval_ast(x, env); + ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO + WHEN a0sym = 'if' THEN + cond := EVAL(types.nth(M, ast, 1), env); + IF cond = 1 OR cond = 2 THEN -- nil or false + IF types.count(M, ast) > 3 THEN + ast := types.nth(M, ast, 3); -- TCO + ELSE + RETURN 1; -- nil + END IF; + ELSE + ast := types.nth(M, ast, 2); -- TCO + END IF; + WHEN a0sym = 'fn*' THEN + RETURN types.malfunc(M, types.nth(M, ast, 2), + types.nth(M, ast, 1), + env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + env := env_pkg.env_new(M, E, malfn.env, + malfn.params, args); + ast := malfn.ast; -- TCO + ELSE + RETURN do_builtin(f, args); + END IF; + END CASE; + + END LOOP; + + END; + + -- hack to get around lack of function references + -- functions that require special access to repl_env or EVAL + -- are implemented directly here, otherwise, core.do_core_fn + -- is called. + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS + fname varchar2(100); + val integer; + f integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + BEGIN + fname := TREAT(M(fn) AS mal_str_T).val_str; + CASE + WHEN fname = 'do_eval' THEN + RETURN EVAL(args(1), repl_env); + WHEN fname = 'swap!' THEN + val := TREAT(M(args(1)) AS mal_atom_T).val; + f := args(2); + -- slice one extra at the beginning that will be changed + -- to the value of the atom + fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; + fargs(1) := val; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, fargs); + val := EVAL(malfn.ast, fn_env); + ELSE + val := do_builtin(f, fargs); + END IF; + RETURN types.atom_reset(M, args(1), val); + ELSE + RETURN core.do_core_func(M, H, fn, args); + END CASE; + END; + + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + + argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; + + -- core.EXT: defined using PL/SQL + core_ns := core.get_core_ns(); + FOR cidx IN 1..core_ns.COUNT LOOP + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, core_ns(cidx)), + types.func(M, core_ns(cidx))); + END LOOP; + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, 'eval'), + types.func(M, 'do_eval')); + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, '*ARGV*'), + types.slice(M, argv, 1)); + + -- core.mal: defined using the language itself + line := REP('(def! not (fn* (a) (if a false true)))'); + line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + + IF argv.COUNT() > 0 THEN + BEGIN + line := REP('(load-file "' || + TREAT(M(argv(1)) AS mal_str_T).val_str || + '")'); + io.close(1); -- close output stream + RETURN 0; + EXCEPTION WHEN OTHERS THEN + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + io.close(1); -- close output stream + RAISE; + END; + END IF; + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step8_macros.sql b/impls/plsql/step8_macros.sql new file mode 100644 index 0000000000..ff77f1ff57 --- /dev/null +++ b/impls/plsql/step8_macros.sql @@ -0,0 +1,380 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql +@core.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + core_ns core_ns_T; + cidx integer; + argv mal_vals; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; + + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; + BEGIN + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; + END IF; + RETURN FALSE; + END; + + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS + BEGIN + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); + END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); + END; + + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; + + FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS + a0 integer; + mac integer; + BEGIN + IF M(ast).type_id = 8 THEN + a0 := types.nth(M, ast, 0); + IF M(a0).type_id = 7 AND + env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN + mac := env_pkg.env_get(M, E, env, a0); + IF M(mac).type_id = 12 THEN + RETURN TREAT(M(mac) AS mal_func_T).is_macro > 0; + END IF; + END IF; + END IF; + RETURN FALSE; + END; + + FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS + ast integer; + mac integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + BEGIN + ast := orig_ast; + WHILE is_macro_call(ast, env) LOOP + mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0)); + fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_T).val_seq; + if M(mac).type_id = 12 THEN + malfn := TREAT(M(mac) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, + fargs); + ast := EVAL(malfn.ast, fn_env); + ELSE + ast := do_builtin(mac, fargs); + END IF; + END LOOP; + RETURN ast; + END; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS + ast integer := orig_ast; + env integer := orig_env; + el integer; + a0 integer; + a0sym varchar2(100); + seq mal_vals; + let_env integer; + i integer; + f integer; + cond integer; + malfn mal_func_T; + args mal_vals; + BEGIN + WHILE TRUE LOOP + -- io.writeline('EVAL: ' || printer.pr_str(M, H, ast)); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + + -- apply + ast := macroexpand(ast, env); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + env := let_env; + ast := types.nth(M, ast, 2); -- TCO + WHEN a0sym = 'quote' THEN + RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); + WHEN a0sym = 'quasiquote' THEN + RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); + WHEN a0sym = 'defmacro!' THEN + x := EVAL(types.nth(M, ast, 2), env); + malfn := TREAT(M(x) as mal_func_T); + malfn.is_macro := 1; + M(x) := malfn; + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), x); + WHEN a0sym = 'macroexpand' THEN + RETURN macroexpand(types.nth(M, ast, 1), env); + WHEN a0sym = 'do' THEN + x := types.slice(M, ast, 1, types.count(M, ast)-2); + x := eval_ast(x, env); + ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO + WHEN a0sym = 'if' THEN + cond := EVAL(types.nth(M, ast, 1), env); + IF cond = 1 OR cond = 2 THEN -- nil or false + IF types.count(M, ast) > 3 THEN + ast := types.nth(M, ast, 3); -- TCO + ELSE + RETURN 1; -- nil + END IF; + ELSE + ast := types.nth(M, ast, 2); -- TCO + END IF; + WHEN a0sym = 'fn*' THEN + RETURN types.malfunc(M, types.nth(M, ast, 2), + types.nth(M, ast, 1), + env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + env := env_pkg.env_new(M, E, malfn.env, + malfn.params, args); + ast := malfn.ast; -- TCO + ELSE + RETURN do_builtin(f, args); + END IF; + END CASE; + + END LOOP; + + END; + + -- hack to get around lack of function references + -- functions that require special access to repl_env or EVAL + -- are implemented directly here, otherwise, core.do_core_fn + -- is called. + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS + fname varchar2(100); + val integer; + f integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + BEGIN + fname := TREAT(M(fn) AS mal_str_T).val_str; + CASE + WHEN fname = 'do_eval' THEN + RETURN EVAL(args(1), repl_env); + WHEN fname = 'swap!' THEN + val := TREAT(M(args(1)) AS mal_atom_T).val; + f := args(2); + -- slice one extra at the beginning that will be changed + -- to the value of the atom + fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; + fargs(1) := val; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, fargs); + val := EVAL(malfn.ast, fn_env); + ELSE + val := do_builtin(f, fargs); + END IF; + RETURN types.atom_reset(M, args(1), val); + ELSE + RETURN core.do_core_func(M, H, fn, args); + END CASE; + END; + + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + + argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; + + -- core.EXT: defined using PL/SQL + core_ns := core.get_core_ns(); + FOR cidx IN 1..core_ns.COUNT LOOP + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, core_ns(cidx)), + types.func(M, core_ns(cidx))); + END LOOP; + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, 'eval'), + types.func(M, 'do_eval')); + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, '*ARGV*'), + types.slice(M, argv, 1)); + + -- core.mal: defined using the language itself + line := REP('(def! not (fn* (a) (if a false true)))'); + line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); + + IF argv.COUNT() > 0 THEN + BEGIN + line := REP('(load-file "' || + TREAT(M(argv(1)) AS mal_str_T).val_str || + '")'); + io.close(1); -- close output stream + RETURN 0; + EXCEPTION WHEN OTHERS THEN + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + io.close(1); -- close output stream + RAISE; + END; + END IF; + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/step9_try.sql b/impls/plsql/step9_try.sql new file mode 100644 index 0000000000..29c948a45f --- /dev/null +++ b/impls/plsql/step9_try.sql @@ -0,0 +1,470 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql +@core.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + core_ns core_ns_T; + cidx integer; + argv mal_vals; + err_val integer; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; + + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; + BEGIN + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; + END IF; + RETURN FALSE; + END; + + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS + BEGIN + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); + END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); + END; + + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; + + FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS + a0 integer; + mac integer; + BEGIN + IF M(ast).type_id = 8 THEN + a0 := types.nth(M, ast, 0); + IF M(a0).type_id = 7 AND + env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN + mac := env_pkg.env_get(M, E, env, a0); + IF M(mac).type_id = 12 THEN + RETURN TREAT(M(mac) AS mal_func_T).is_macro > 0; + END IF; + END IF; + END IF; + RETURN FALSE; + END; + + FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS + ast integer; + mac integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + BEGIN + ast := orig_ast; + WHILE is_macro_call(ast, env) LOOP + mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0)); + fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_T).val_seq; + if M(mac).type_id = 12 THEN + malfn := TREAT(M(mac) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, + fargs); + ast := EVAL(malfn.ast, fn_env); + ELSE + ast := do_builtin(mac, fargs); + END IF; + END LOOP; + RETURN ast; + END; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS + ast integer := orig_ast; + env integer := orig_env; + el integer; + a0 integer; + a0sym varchar2(100); + seq mal_vals; + let_env integer; + try_env integer; + i integer; + f integer; + cond integer; + malfn mal_func_T; + args mal_vals; + BEGIN + WHILE TRUE LOOP + -- io.writeline('EVAL: ' || printer.pr_str(M, H, ast)); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + + -- apply + ast := macroexpand(ast, env); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + env := let_env; + ast := types.nth(M, ast, 2); -- TCO + WHEN a0sym = 'quote' THEN + RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); + WHEN a0sym = 'quasiquote' THEN + RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); + WHEN a0sym = 'defmacro!' THEN + x := EVAL(types.nth(M, ast, 2), env); + malfn := TREAT(M(x) as mal_func_T); + malfn.is_macro := 1; + M(x) := malfn; + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), x); + WHEN a0sym = 'macroexpand' THEN + RETURN macroexpand(types.nth(M, ast, 1), env); + WHEN a0sym = 'try*' THEN + DECLARE + exc integer; + a2 integer := -1; + a20 integer := -1; + a20sym varchar2(100); + BEGIN + RETURN EVAL(types.nth(M, ast, 1), env); + + EXCEPTION WHEN OTHERS THEN + IF types.count(M, ast) > 2 THEN + a2 := types.nth(M, ast, 2); + IF M(a2).type_id = 8 THEN + a20 := types.nth(M, a2, 0); + IF M(a20).type_id = 7 THEN + a20sym := TREAT(M(a20) AS mal_str_T).val_str; + END IF; + END IF; + END IF; + IF a20sym = 'catch*' THEN + IF SQLCODE <> -20000 THEN + IF SQLCODE < -20000 AND SQLCODE > -20100 THEN + exc := types.string(M, + REGEXP_REPLACE(SQLERRM, + '^ORA-200[0-9][0-9]: ')); + ELSE + exc := types.string(M, SQLERRM); + END IF; + ELSE -- mal throw + exc := err_val; + err_val := NULL; + END IF; + try_env := env_pkg.env_new(M, E, env, + types.list(M, types.nth(M, a2, 1)), + mal_vals(exc)); + RETURN EVAL(types.nth(M, a2, 2), try_env); + END IF; + RAISE; -- not handled, re-raise the exception + END; + WHEN a0sym = 'do' THEN + x := types.slice(M, ast, 1, types.count(M, ast)-2); + x := eval_ast(x, env); + ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO + WHEN a0sym = 'if' THEN + cond := EVAL(types.nth(M, ast, 1), env); + IF cond = 1 OR cond = 2 THEN -- nil or false + IF types.count(M, ast) > 3 THEN + ast := types.nth(M, ast, 3); -- TCO + ELSE + RETURN 1; -- nil + END IF; + ELSE + ast := types.nth(M, ast, 2); -- TCO + END IF; + WHEN a0sym = 'fn*' THEN + RETURN types.malfunc(M, types.nth(M, ast, 2), + types.nth(M, ast, 1), + env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + env := env_pkg.env_new(M, E, malfn.env, + malfn.params, args); + ast := malfn.ast; -- TCO + ELSE + RETURN do_builtin(f, args); + END IF; + END CASE; + + END LOOP; + + END; + + -- hack to get around lack of function references + -- functions that require special access to repl_env or EVAL + -- are implemented directly here, otherwise, core.do_core_fn + -- is called. + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS + fname varchar2(100); + val integer; + f integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + i integer; + tseq mal_vals; + BEGIN + fname := TREAT(M(fn) AS mal_str_T).val_str; + CASE + WHEN fname = 'do_eval' THEN + RETURN EVAL(args(1), repl_env); + WHEN fname = 'swap!' THEN + val := TREAT(M(args(1)) AS mal_atom_T).val; + f := args(2); + -- slice one extra at the beginning that will be changed + -- to the value of the atom + fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; + fargs(1) := val; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, fargs); + val := EVAL(malfn.ast, fn_env); + ELSE + val := do_builtin(f, fargs); + END IF; + RETURN types.atom_reset(M, args(1), val); + WHEN fname = 'apply' THEN + f := args(1); + fargs := mal_vals(); + tseq := TREAT(M(args(args.COUNT())) AS mal_seq_T).val_seq; + fargs.EXTEND(args.COUNT()-2 + tseq.COUNT()); + FOR i IN 1..args.COUNT()-2 LOOP + fargs(i) := args(i+1); + END LOOP; + FOR i IN 1..tseq.COUNT() LOOP + fargs(args.COUNT()-2 + i) := tseq(i); + END LOOP; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, fargs); + val := EVAL(malfn.ast, fn_env); + ELSE + val := do_builtin(f, fargs); + END IF; + RETURN val; + WHEN fname = 'map' THEN + f := args(1); + fargs := TREAT(M(args(2)) AS mal_seq_T).val_seq; + tseq := mal_vals(); + tseq.EXTEND(fargs.COUNT()); + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + FOR i IN 1..fargs.COUNT() LOOP + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, + mal_vals(fargs(i))); + tseq(i) := EVAL(malfn.ast, fn_env); + END LOOP; + ELSE + FOR i IN 1..fargs.COUNT() LOOP + tseq(i) := do_builtin(f, + mal_vals(fargs(i))); + END LOOP; + END IF; + RETURN types.seq(M, 8, tseq); + WHEN fname = 'throw' THEN + err_val := args(1); + raise_application_error(-20000, 'MalException', TRUE); + ELSE + RETURN core.do_core_func(M, H, fn, args); + END CASE; + END; + + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + + argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; + + -- core.EXT: defined using PL/SQL + core_ns := core.get_core_ns(); + FOR cidx IN 1..core_ns.COUNT LOOP + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, core_ns(cidx)), + types.func(M, core_ns(cidx))); + END LOOP; + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, 'eval'), + types.func(M, 'do_eval')); + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, '*ARGV*'), + types.slice(M, argv, 1)); + + -- core.mal: defined using the language itself + line := REP('(def! not (fn* (a) (if a false true)))'); + line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); + + IF argv.COUNT() > 0 THEN + BEGIN + line := REP('(load-file "' || + TREAT(M(argv(1)) AS mal_str_T).val_str || + '")'); + io.close(1); -- close output stream + RETURN 0; + EXCEPTION WHEN OTHERS THEN + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + io.close(1); -- close output stream + RAISE; + END; + END IF; + + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + IF SQLCODE <> -20000 THEN + io.writeline('Error: ' || SQLERRM); + ELSE + io.writeline('Error: ' || printer.pr_str(M, H, err_val)); + END IF; + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/stepA_mal.sql b/impls/plsql/stepA_mal.sql new file mode 100644 index 0000000000..dd07c15b25 --- /dev/null +++ b/impls/plsql/stepA_mal.sql @@ -0,0 +1,472 @@ +@io.sql +@types.sql +@reader.sql +@printer.sql +@env.sql +@core.sql + +CREATE OR REPLACE PACKAGE mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; + +END mal; +/ + +CREATE OR REPLACE PACKAGE BODY mal IS + +FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS + M types.mal_table; -- general mal value memory pool + H types.map_entry_table; -- hashmap memory pool + E env_pkg.env_entry_table; -- mal env memory pool + repl_env integer; + x integer; + line CLOB; + core_ns core_ns_T; + cidx integer; + argv mal_vals; + err_val integer; + + -- read + FUNCTION READ(line varchar) RETURN integer IS + BEGIN + RETURN reader.read_str(M, H, line); + END; + + -- eval + + -- forward declarations + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; + + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; + BEGIN + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; + END IF; + RETURN FALSE; + END; + + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS + BEGIN + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); + END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); + END; + + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; + + FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS + a0 integer; + mac integer; + BEGIN + IF M(ast).type_id = 8 THEN + a0 := types.nth(M, ast, 0); + IF M(a0).type_id = 7 AND + env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN + mac := env_pkg.env_get(M, E, env, a0); + IF M(mac).type_id = 12 THEN + RETURN TREAT(M(mac) AS mal_func_T).is_macro > 0; + END IF; + END IF; + END IF; + RETURN FALSE; + END; + + FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS + ast integer; + mac integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + BEGIN + ast := orig_ast; + WHILE is_macro_call(ast, env) LOOP + mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0)); + fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_T).val_seq; + if M(mac).type_id = 12 THEN + malfn := TREAT(M(mac) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, + fargs); + ast := EVAL(malfn.ast, fn_env); + ELSE + ast := do_builtin(mac, fargs); + END IF; + END LOOP; + RETURN ast; + END; + + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS + i integer; + old_seq mal_vals; + new_seq mal_vals; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + BEGIN + IF M(ast).type_id = 7 THEN + RETURN env_pkg.env_get(M, E, env, ast); + ELSIF M(ast).type_id IN (8,9) THEN + old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; + new_seq := mal_vals(); + new_seq.EXTEND(old_seq.COUNT); + FOR i IN 1..old_seq.COUNT LOOP + new_seq(i) := EVAL(old_seq(i), env); + END LOOP; + RETURN types.seq(M, M(ast).type_id, new_seq); + ELSIF M(ast).type_id IN (10) THEN + new_hm := types.hash_map(M, H, mal_vals()); + old_midx := TREAT(M(ast) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := EVAL(H(old_midx)(k), env); + k := H(old_midx).NEXT(k); + END LOOP; + RETURN new_hm; + ELSE + RETURN ast; + END IF; + END; + + FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS + ast integer := orig_ast; + env integer := orig_env; + el integer; + a0 integer; + a0sym varchar2(100); + seq mal_vals; + let_env integer; + try_env integer; + i integer; + f integer; + cond integer; + malfn mal_func_T; + args mal_vals; + BEGIN + WHILE TRUE LOOP + -- io.writeline('EVAL: ' || printer.pr_str(M, H, ast)); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + + -- apply + ast := macroexpand(ast, env); + IF M(ast).type_id <> 8 THEN + RETURN eval_ast(ast, env); + END IF; + IF types.count(M, ast) = 0 THEN + RETURN ast; -- empty list just returned + END IF; + + -- apply + a0 := types.first(M, ast); + if M(a0).type_id = 7 THEN -- symbol + a0sym := TREAT(M(a0) AS mal_str_T).val_str; + ELSE + a0sym := '__<*fn*>__'; + END IF; + + CASE + WHEN a0sym = 'def!' THEN + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); + WHEN a0sym = 'let*' THEN + let_env := env_pkg.env_new(M, E, env); + seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; + i := 1; + WHILE i <= seq.COUNT LOOP + x := env_pkg.env_set(M, E, let_env, + seq(i), EVAL(seq(i+1), let_env)); + i := i + 2; + END LOOP; + env := let_env; + ast := types.nth(M, ast, 2); -- TCO + WHEN a0sym = 'quote' THEN + RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); + WHEN a0sym = 'quasiquote' THEN + RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); + WHEN a0sym = 'defmacro!' THEN + x := EVAL(types.nth(M, ast, 2), env); + malfn := TREAT(M(x) as mal_func_T); + malfn.is_macro := 1; + M(x) := malfn; + RETURN env_pkg.env_set(M, E, env, + types.nth(M, ast, 1), x); + WHEN a0sym = 'macroexpand' THEN + RETURN macroexpand(types.nth(M, ast, 1), env); + WHEN a0sym = 'try*' THEN + DECLARE + exc integer; + a2 integer := -1; + a20 integer := -1; + a20sym varchar2(100); + BEGIN + RETURN EVAL(types.nth(M, ast, 1), env); + + EXCEPTION WHEN OTHERS THEN + IF types.count(M, ast) > 2 THEN + a2 := types.nth(M, ast, 2); + IF M(a2).type_id = 8 THEN + a20 := types.nth(M, a2, 0); + IF M(a20).type_id = 7 THEN + a20sym := TREAT(M(a20) AS mal_str_T).val_str; + END IF; + END IF; + END IF; + IF a20sym = 'catch*' THEN + IF SQLCODE <> -20000 THEN + IF SQLCODE < -20000 AND SQLCODE > -20100 THEN + exc := types.string(M, + REGEXP_REPLACE(SQLERRM, + '^ORA-200[0-9][0-9]: ')); + ELSE + exc := types.string(M, SQLERRM); + END IF; + ELSE -- mal throw + exc := err_val; + err_val := NULL; + END IF; + try_env := env_pkg.env_new(M, E, env, + types.list(M, types.nth(M, a2, 1)), + mal_vals(exc)); + RETURN EVAL(types.nth(M, a2, 2), try_env); + END IF; + RAISE; -- not handled, re-raise the exception + END; + WHEN a0sym = 'do' THEN + x := types.slice(M, ast, 1, types.count(M, ast)-2); + x := eval_ast(x, env); + ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO + WHEN a0sym = 'if' THEN + cond := EVAL(types.nth(M, ast, 1), env); + IF cond = 1 OR cond = 2 THEN -- nil or false + IF types.count(M, ast) > 3 THEN + ast := types.nth(M, ast, 3); -- TCO + ELSE + RETURN 1; -- nil + END IF; + ELSE + ast := types.nth(M, ast, 2); -- TCO + END IF; + WHEN a0sym = 'fn*' THEN + RETURN types.malfunc(M, types.nth(M, ast, 2), + types.nth(M, ast, 1), + env); + ELSE + el := eval_ast(ast, env); + f := types.first(M, el); + args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + env := env_pkg.env_new(M, E, malfn.env, + malfn.params, args); + ast := malfn.ast; -- TCO + ELSE + RETURN do_builtin(f, args); + END IF; + END CASE; + + END LOOP; + + END; + + -- hack to get around lack of function references + -- functions that require special access to repl_env or EVAL + -- are implemented directly here, otherwise, core.do_core_fn + -- is called. + FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS + fname varchar2(100); + val integer; + f integer; + malfn mal_func_T; + fargs mal_vals; + fn_env integer; + i integer; + tseq mal_vals; + BEGIN + fname := TREAT(M(fn) AS mal_str_T).val_str; + CASE + WHEN fname = 'do_eval' THEN + RETURN EVAL(args(1), repl_env); + WHEN fname = 'swap!' THEN + val := TREAT(M(args(1)) AS mal_atom_T).val; + f := args(2); + -- slice one extra at the beginning that will be changed + -- to the value of the atom + fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; + fargs(1) := val; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, fargs); + val := EVAL(malfn.ast, fn_env); + ELSE + val := do_builtin(f, fargs); + END IF; + RETURN types.atom_reset(M, args(1), val); + WHEN fname = 'apply' THEN + f := args(1); + fargs := mal_vals(); + tseq := TREAT(M(args(args.COUNT())) AS mal_seq_T).val_seq; + fargs.EXTEND(args.COUNT()-2 + tseq.COUNT()); + FOR i IN 1..args.COUNT()-2 LOOP + fargs(i) := args(i+1); + END LOOP; + FOR i IN 1..tseq.COUNT() LOOP + fargs(args.COUNT()-2 + i) := tseq(i); + END LOOP; + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, fargs); + val := EVAL(malfn.ast, fn_env); + ELSE + val := do_builtin(f, fargs); + END IF; + RETURN val; + WHEN fname = 'map' THEN + f := args(1); + fargs := TREAT(M(args(2)) AS mal_seq_T).val_seq; + tseq := mal_vals(); + tseq.EXTEND(fargs.COUNT()); + IF M(f).type_id = 12 THEN + malfn := TREAT(M(f) AS mal_func_T); + FOR i IN 1..fargs.COUNT() LOOP + fn_env := env_pkg.env_new(M, E, malfn.env, + malfn.params, + mal_vals(fargs(i))); + tseq(i) := EVAL(malfn.ast, fn_env); + END LOOP; + ELSE + FOR i IN 1..fargs.COUNT() LOOP + tseq(i) := do_builtin(f, + mal_vals(fargs(i))); + END LOOP; + END IF; + RETURN types.seq(M, 8, tseq); + WHEN fname = 'throw' THEN + err_val := args(1); + raise_application_error(-20000, 'MalException', TRUE); + ELSE + RETURN core.do_core_func(M, H, fn, args); + END CASE; + END; + + + -- print + FUNCTION PRINT(exp integer) RETURN varchar IS + BEGIN + RETURN printer.pr_str(M, H, exp); + END; + + -- repl + FUNCTION REP(line varchar) RETURN varchar IS + BEGIN + RETURN PRINT(EVAL(READ(line), repl_env)); + END; + +BEGIN + -- initialize memory pools + M := types.mem_new(); + H := types.map_entry_table(); + E := env_pkg.env_entry_table(); + + repl_env := env_pkg.env_new(M, E, NULL); + + argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; + + -- core.EXT: defined using PL/SQL + core_ns := core.get_core_ns(); + FOR cidx IN 1..core_ns.COUNT LOOP + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, core_ns(cidx)), + types.func(M, core_ns(cidx))); + END LOOP; + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, 'eval'), + types.func(M, 'do_eval')); + x := env_pkg.env_set(M, E, repl_env, + types.symbol(M, '*ARGV*'), + types.slice(M, argv, 1)); + + -- core.mal: defined using the language itself + line := REP('(def! *host-language* "PL/SQL")'); + line := REP('(def! not (fn* (a) (if a false true)))'); + line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); + line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); + + IF argv.COUNT() > 0 THEN + BEGIN + line := REP('(load-file "' || + TREAT(M(argv(1)) AS mal_str_T).val_str || + '")'); + io.close(1); -- close output stream + RETURN 0; + EXCEPTION WHEN OTHERS THEN + io.writeline('Error: ' || SQLERRM); + io.writeline(dbms_utility.format_error_backtrace); + io.close(1); -- close output stream + RAISE; + END; + END IF; + + line := REP('(println (str "Mal [" *host-language* "]"))'); + WHILE true LOOP + BEGIN + line := io.readline('user> ', 0); + IF line = EMPTY_CLOB() THEN CONTINUE; END IF; + IF line IS NOT NULL THEN + io.writeline(REP(line)); + END IF; + + EXCEPTION WHEN OTHERS THEN + IF SQLCODE = -20001 THEN -- io read stream closed + io.close(1); -- close output stream + RETURN 0; + END IF; + IF SQLCODE <> -20000 THEN + io.writeline('Error: ' || SQLERRM); + ELSE + io.writeline('Error: ' || printer.pr_str(M, H, err_val)); + END IF; + io.writeline(dbms_utility.format_error_backtrace); + END; + END LOOP; +END; + +END mal; +/ +show errors; + +quit; diff --git a/impls/plsql/types.sql b/impls/plsql/types.sql new file mode 100644 index 0000000000..fb142c79c4 --- /dev/null +++ b/impls/plsql/types.sql @@ -0,0 +1,638 @@ +-- --------------------------------------------------------- +-- persistent values + +BEGIN + EXECUTE IMMEDIATE 'DROP TYPE mal_T FORCE'; +EXCEPTION + WHEN OTHERS THEN IF SQLCODE != -4043 THEN RAISE; END IF; +END; +/ + +-- list of types for type_id +-- 0: nil +-- 1: false +-- 2: true +-- 3: integer +-- 4: float +-- 5: string +-- 6: long string (CLOB) +-- 7: symbol +-- 8: list +-- 9: vector +-- 10: hashmap +-- 11: function +-- 12: malfunc +-- 13: atom + +-- nil (0), false (1), true (2) +CREATE OR REPLACE TYPE mal_T FORCE AS OBJECT ( + type_id integer +) NOT FINAL; +/ + +-- general nested table of mal values (integers) +-- used frequently for argument passing +CREATE OR REPLACE TYPE mal_vals FORCE AS TABLE OF integer; +/ + + +-- integer (3) +CREATE OR REPLACE TYPE mal_int_T FORCE UNDER mal_T ( + val_int integer +) FINAL; +/ + +-- string/keyword (5,6), symbol (7) +CREATE OR REPLACE TYPE mal_str_T FORCE UNDER mal_T ( + val_str varchar2(4000) +) NOT FINAL; +/ + +CREATE OR REPLACE TYPE mal_long_str_T FORCE UNDER mal_str_T ( + val_long_str CLOB -- long character object (for larger than 4000 chars) +) FINAL; +/ +show errors; + +-- list (8), vector (9) +CREATE OR REPLACE TYPE mal_seq_T FORCE UNDER mal_T ( + val_seq mal_vals, + meta integer +) FINAL; +/ + +CREATE OR REPLACE TYPE mal_map_T FORCE UNDER mal_T ( + map_idx integer, -- index into map entry table + meta integer +) FINAL; +/ + +-- malfunc (12) +CREATE OR REPLACE TYPE mal_func_T FORCE UNDER mal_T ( + ast integer, + params integer, + env integer, + is_macro integer, + meta integer +) FINAL; +/ + +-- atom (13) +CREATE OR REPLACE TYPE mal_atom_T FORCE UNDER mal_T ( + val integer -- index into mal_table +); +/ + + +-- --------------------------------------------------------- + +CREATE OR REPLACE PACKAGE types IS + -- memory pool for mal_objects (non-hash-map) + TYPE mal_table IS TABLE OF mal_T; + + -- memory pool for hash-map objects + TYPE map_entry IS TABLE OF integer INDEX BY varchar2(256); + TYPE map_entry_table IS TABLE OF map_entry; + + -- general functions + FUNCTION mem_new RETURN mal_table; + + FUNCTION tf(val boolean) RETURN integer; + FUNCTION equal_Q(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + a integer, b integer) RETURN boolean; + + FUNCTION clone(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + obj integer, + meta integer DEFAULT 1) RETURN integer; + + -- scalar functions + FUNCTION int(M IN OUT NOCOPY mal_table, num integer) RETURN integer; + FUNCTION string(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; + FUNCTION string_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; + FUNCTION symbol(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; + FUNCTION keyword(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; + FUNCTION keyword_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; + FUNCTION number_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; + FUNCTION function_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; + FUNCTION macro_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; + + -- sequence functions + FUNCTION seq(M IN OUT NOCOPY mal_table, + type_id integer, + items mal_vals, + meta integer DEFAULT 1) RETURN integer; + FUNCTION list(M IN OUT NOCOPY mal_table) RETURN integer; + FUNCTION list(M IN OUT NOCOPY mal_table, + a integer) RETURN integer; + FUNCTION list(M IN OUT NOCOPY mal_table, + a integer, b integer) RETURN integer; + FUNCTION list(M IN OUT NOCOPY mal_table, + a integer, b integer, c integer) RETURN integer; + + FUNCTION first(M IN OUT NOCOPY mal_table, + seq integer) RETURN integer; + FUNCTION slice(M IN OUT NOCOPY mal_table, + seq integer, + idx integer, + last integer DEFAULT NULL) RETURN integer; + FUNCTION slice(M IN OUT NOCOPY mal_table, + items mal_vals, + idx integer) RETURN integer; + FUNCTION islice(items mal_vals, + idx integer) RETURN mal_vals; + FUNCTION nth(M IN OUT NOCOPY mal_table, + seq integer, idx integer) RETURN integer; + + FUNCTION count(M IN OUT NOCOPY mal_table, + seq integer) RETURN integer; + + FUNCTION atom_new(M IN OUT NOCOPY mal_table, + val integer) RETURN integer; + FUNCTION atom_reset(M IN OUT NOCOPY mal_table, + atm integer, + val integer) RETURN integer; + + -- hash-map functions + FUNCTION assoc_BANG(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + midx integer, + kvs mal_vals) RETURN integer; + FUNCTION dissoc_BANG(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + midx integer, + ks mal_vals) RETURN integer; + FUNCTION hash_map(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + kvs mal_vals, + meta integer DEFAULT 1) RETURN integer; + + -- function functions + FUNCTION func(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; + FUNCTION malfunc(M IN OUT NOCOPY mal_table, + ast integer, + params integer, + env integer, + is_macro integer DEFAULT 0, + meta integer DEFAULT 1) RETURN integer; +END types; +/ +show errors; + + +CREATE OR REPLACE PACKAGE BODY types IS + +-- --------------------------------------------------------- +-- general functions + +FUNCTION mem_new RETURN mal_table IS +BEGIN + -- initialize mal type memory pool + -- 1 -> nil + -- 2 -> false + -- 3 -> true + RETURN mal_table(mal_T(0), mal_T(1), mal_T(2)); +END; + +FUNCTION tf(val boolean) RETURN integer IS +BEGIN + IF val THEN + RETURN 3; -- true + ELSE + RETURN 2; -- false + END IF; +END; + +FUNCTION equal_Q(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + a integer, b integer) RETURN boolean IS + atyp integer; + btyp integer; + aseq mal_vals; + bseq mal_vals; + amidx integer; + bmidx integer; + i integer; + k varchar2(256); +BEGIN + atyp := M(a).type_id; + btyp := M(b).type_id; + IF NOT (atyp = btyp OR (atyp IN (8,9) AND btyp IN (8,9))) THEN + RETURN FALSE; + END IF; + + CASE + WHEN atyp IN (0,1,2) THEN + RETURN TRUE; + WHEN atyp = 3 THEN + RETURN TREAT(M(a) AS mal_int_T).val_int = + TREAT(M(b) AS mal_int_T).val_int; + WHEN atyp IN (5,6,7) THEN + IF TREAT(M(a) AS mal_str_T).val_str IS NULL AND + TREAT(M(b) AS mal_str_T).val_str IS NULL THEN + RETURN TRUE; + ELSE + RETURN TREAT(M(a) AS mal_str_T).val_str = + TREAT(M(b) AS mal_str_T).val_str; + END IF; + WHEN atyp IN (8,9) THEN + aseq := TREAT(M(a) AS mal_seq_T).val_seq; + bseq := TREAT(M(b) AS mal_seq_T).val_seq; + IF aseq.COUNT <> bseq.COUNT THEN + RETURN FALSE; + END IF; + FOR i IN 1..aseq.COUNT LOOP + IF NOT equal_Q(M, H, aseq(i), bseq(i)) THEN + RETURN FALSE; + END IF; + END LOOP; + RETURN TRUE; + WHEN atyp = 10 THEN + amidx := TREAT(M(a) AS mal_map_T).map_idx; + bmidx := TREAT(M(b) AS mal_map_T).map_idx; + IF H(amidx).COUNT() <> H(bmidx).COUNT() THEN + RETURN FALSE; + END IF; + + k := H(amidx).FIRST(); + WHILE k IS NOT NULL LOOP + IF H(amidx)(k) IS NULL OR H(bmidx)(k) IS NULL THEN + RETURN FALSE; + END IF; + IF NOT equal_Q(M, H, H(amidx)(k), H(bmidx)(k)) THEN + RETURN FALSE; + END IF; + k := H(amidx).NEXT(k); + END LOOP; + RETURN TRUE; + ELSE + RETURN FALSE; + END CASE; +END; + +FUNCTION clone(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + obj integer, + meta integer DEFAULT 1) RETURN integer IS + type_id integer; + new_hm integer; + old_midx integer; + new_midx integer; + k varchar2(256); + malfn mal_func_T; +BEGIN + type_id := M(obj).type_id; + CASE + WHEN type_id IN (8,9) THEN -- list/vector + RETURN seq(M, type_id, + TREAT(M(obj) AS mal_seq_T).val_seq, + meta); + WHEN type_id = 10 THEN -- hash-map + new_hm := types.hash_map(M, H, mal_vals(), meta); + old_midx := TREAT(M(obj) AS mal_map_T).map_idx; + new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; + + k := H(old_midx).FIRST(); + WHILE k IS NOT NULL LOOP + H(new_midx)(k) := H(old_midx)(k); + k := H(old_midx).NEXT(k); + END LOOP; + + RETURN new_hm; + WHEN type_id = 12 THEN -- mal function + malfn := TREAT(M(obj) AS mal_func_T); + RETURN types.malfunc(M, + malfn.ast, + malfn.params, + malfn.env, + malfn.is_macro, + meta); + ELSE + raise_application_error(-20008, + 'clone not supported for type ' || type_id, TRUE); + END CASE; +END; + + +-- --------------------------------------------------------- +-- scalar functions + + +FUNCTION int(M IN OUT NOCOPY mal_table, num integer) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_int_T(3, num); + RETURN M.COUNT(); +END; + +FUNCTION string(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS +BEGIN + M.EXTEND(); + IF LENGTH(name) <= 4000 THEN + M(M.COUNT()) := mal_str_T(5, name); + ELSE + M(M.COUNT()) := mal_long_str_T(6, NULL, name); + END IF; + RETURN M.COUNT(); +END; + +FUNCTION string_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS + str CLOB; +BEGIN + IF M(val).type_id IN (5,6) THEN + IF M(val).type_id = 5 THEN + str := TREAT(M(val) AS mal_str_T).val_str; + ELSE + str := TREAT(M(val) AS mal_long_str_T).val_long_str; + END IF; + IF str IS NULL OR + str = EMPTY_CLOB() OR + SUBSTR(str, 1, 1) <> chr(127) THEN + RETURN TRUE; + ELSE + RETURN FALSE; + END IF; + ELSE + RETURN FALSE; + END IF; +END; + +FUNCTION symbol(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_str_T(7, name); + RETURN M.COUNT(); +END; + +FUNCTION keyword(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_str_T(5, chr(127) || name); + RETURN M.COUNT(); +END; + +FUNCTION keyword_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS + str CLOB; +BEGIN + IF M(val).type_id = 5 THEN + str := TREAT(M(val) AS mal_str_T).val_str; + IF LENGTH(str) > 0 AND SUBSTR(str, 1, 1) = chr(127) THEN + RETURN TRUE; + ELSE + RETURN FALSE; + END IF; + ELSE + RETURN FALSE; + END IF; +END; + +FUNCTION number_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS + str CLOB; +BEGIN + IF M(val).type_id IN (3,4) THEN + RETURN TRUE; + ELSE + RETURN FALSE; + END IF; +END; + +FUNCTION function_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS + str CLOB; +BEGIN + IF M(val).type_id = 11 THEN + RETURN TRUE; + ELSIF M(val).type_id = 12 THEN + RETURN TREAT(M(val) AS mal_func_T).is_macro = 0; + ELSE + RETURN FALSE; + END IF; +END; + +FUNCTION macro_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS + str CLOB; +BEGIN + IF M(val).type_id = 12 THEN + RETURN TREAT(M(val) AS mal_func_T).is_macro > 0; + ELSE + RETURN FALSE; + END IF; +END; + + +-- --------------------------------------------------------- +-- sequence functions + +FUNCTION seq(M IN OUT NOCOPY mal_table, + type_id integer, + items mal_vals, + meta integer DEFAULT 1) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_seq_T(type_id, items, meta); + RETURN M.COUNT(); +END; + +-- list: +-- return a mal list +FUNCTION list(M IN OUT NOCOPY mal_table) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_seq_T(8, mal_vals(), 1); + RETURN M.COUNT(); +END; + +FUNCTION list(M IN OUT NOCOPY mal_table, + a integer) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_seq_T(8, mal_vals(a), 1); + RETURN M.COUNT(); +END; + +FUNCTION list(M IN OUT NOCOPY mal_table, + a integer, b integer) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_seq_T(8, mal_vals(a, b), 1); + RETURN M.COUNT(); +END; + +FUNCTION list(M IN OUT NOCOPY mal_table, + a integer, b integer, c integer) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_seq_T(8, mal_vals(a, b, c), 1); + RETURN M.COUNT(); +END; + +FUNCTION first(M IN OUT NOCOPY mal_table, + seq integer) RETURN integer IS +BEGIN + RETURN TREAT(M(seq) AS mal_seq_T).val_seq(1); +END; + +FUNCTION slice(M IN OUT NOCOPY mal_table, + seq integer, + idx integer, + last integer DEFAULT NULL) RETURN integer IS + old_items mal_vals; + new_items mal_vals; + i integer; + final_idx integer; +BEGIN + old_items := TREAT(M(seq) AS mal_seq_T).val_seq; + new_items := mal_vals(); + IF last IS NULL THEN + final_idx := old_items.COUNT(); + ELSE + final_idx := last + 1; + END IF; + IF final_idx > idx THEN + new_items.EXTEND(final_idx - idx); + FOR i IN idx+1..final_idx LOOP + new_items(i-idx) := old_items(i); + END LOOP; + END IF; + M.EXTEND(); + M(M.COUNT()) := mal_seq_T(8, new_items, 1); + RETURN M.COUNT(); +END; + +FUNCTION slice(M IN OUT NOCOPY mal_table, + items mal_vals, + idx integer) RETURN integer IS + new_items mal_vals; +BEGIN + new_items := islice(items, idx); + M.EXTEND(); + M(M.COUNT()) := mal_seq_T(8, new_items, 1); + RETURN M.COUNT(); +END; + +FUNCTION islice(items mal_vals, + idx integer) RETURN mal_vals IS + new_items mal_vals; + i integer; +BEGIN + new_items := mal_vals(); + IF items.COUNT > idx THEN + new_items.EXTEND(items.COUNT - idx); + FOR i IN idx+1..items.COUNT LOOP + new_items(i-idx) := items(i); + END LOOP; + END IF; + RETURN new_items; +END; + + +FUNCTION nth(M IN OUT NOCOPY mal_table, + seq integer, idx integer) RETURN integer IS +BEGIN + RETURN TREAT(M(seq) AS mal_seq_T).val_seq(idx+1); +END; + +FUNCTION count(M IN OUT NOCOPY mal_table, + seq integer) RETURN integer IS +BEGIN + RETURN TREAT(M(seq) AS mal_seq_T).val_seq.COUNT; +END; + +-- --------------------------------------------------------- +-- hash-map functions + +FUNCTION assoc_BANG(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + midx integer, + kvs mal_vals) RETURN integer IS + i integer; +BEGIN + IF MOD(kvs.COUNT(), 2) = 1 THEN + raise_application_error(-20007, + 'odd number of arguments to assoc', TRUE); + END IF; + + i := 1; + WHILE i <= kvs.COUNT() LOOP + H(midx)(TREAT(M(kvs(i)) AS mal_str_T).val_str) := kvs(i+1); + i := i + 2; + END LOOP; + RETURN midx; +END; + +FUNCTION dissoc_BANG(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + midx integer, + ks mal_vals) RETURN integer IS + i integer; +BEGIN + FOR i IN 1..ks.COUNT() LOOP + H(midx).DELETE(TREAT(M(ks(i)) AS mal_str_T).val_str); + END LOOP; + RETURN midx; +END; + +FUNCTION hash_map(M IN OUT NOCOPY mal_table, + H IN OUT NOCOPY map_entry_table, + kvs mal_vals, + meta integer DEFAULT 1) RETURN integer IS + midx integer; +BEGIN + H.EXTEND(); + midx := H.COUNT(); + midx := assoc_BANG(M, H, midx, kvs); + + M.EXTEND(); + M(M.COUNT()) := mal_map_T(10, midx, meta); + RETURN M.COUNT(); +END; + + +-- --------------------------------------------------------- +-- function functions + +FUNCTION func(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_str_T(11, name); + RETURN M.COUNT(); +END; + +FUNCTION malfunc(M IN OUT NOCOPY mal_table, + ast integer, + params integer, + env integer, + is_macro integer DEFAULT 0, + meta integer DEFAULT 1) RETURN integer IS +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_func_T(12, ast, params, env, is_macro, meta); + RETURN M.COUNT(); +END; + + +-- --------------------------------------------------------- +-- atom functions + +FUNCTION atom_new(M IN OUT NOCOPY mal_table, + val integer) RETURN integer IS + aidx integer; +BEGIN + M.EXTEND(); + M(M.COUNT()) := mal_atom_T(13, val); + RETURN M.COUNT(); +END; + +FUNCTION atom_reset(M IN OUT NOCOPY mal_table, + atm integer, + val integer) RETURN integer IS +BEGIN + M(atm) := mal_atom_T(13, val); + RETURN val; +END; + + + +END types; +/ +show errors; diff --git a/impls/plsql/wrap.sh b/impls/plsql/wrap.sh new file mode 100755 index 0000000000..c106ecb98b --- /dev/null +++ b/impls/plsql/wrap.sh @@ -0,0 +1,122 @@ +#!/usr/bin/env bash + +RL_HISTORY_FILE=${HOME}/.mal-history +SKIP_INIT="${SKIP_INIT:-}" + +ORACLE_LOGON=${ORACLE_LOGON:-system/oracle} +SQLPLUS="sqlplus -S ${ORACLE_LOGON}" + +FILE_PID= +cleanup() { + trap - TERM QUIT INT EXIT + #echo cleanup: ${FILE_PID} + [ "${FILE_PID}" ] && kill ${FILE_PID} +} +trap "cleanup" TERM QUIT INT EXIT + + +# Load the SQL code +if [ -z "${SKIP_INIT}" ]; then + out=$(echo "" | ${SQLPLUS} @$1) + if echo "${out}" | grep -vs "^No errors.$" \ + | grep -si error >/dev/null; then + #if echo "${out}" | grep -si error >/dev/null; then + echo "${out}" + exit 1 + fi +fi + +# open I/O streams +echo -e "BEGIN io.open(0); io.open(1); END;\n/" \ + | ${SQLPLUS} >/dev/null + +# Stream from table to stdout +( +while true; do + out="$(echo "SELECT io.read(1) FROM dual;" \ + | ${SQLPLUS} 2>/dev/null)" || break + #echo "out: [${out}] (${#out})" + echo "${out}" +done +) & +STDOUT_PID=$! + +# Perform readline input into stream table when requested +( +[ -r ${RL_HISTORY_FILE} ] && history -r ${RL_HISTORY_FILE} +while true; do + prompt=$(echo "SELECT io.wait_rl_prompt(0) FROM dual;" \ + | ${SQLPLUS} 2>/dev/null) || break + # Prompt is returned single-quoted because sqlplus trims trailing + # whitespace. Remove the single quotes from the beginning and end: + prompt=${prompt%\'} + prompt=${prompt#\'} + #echo "prompt: [${prompt}]" + + IFS= read -u 0 -r -e -p "${prompt}" line || break + if [ "${line}" ]; then + history -s -- "${line}" # add to history + history -a ${RL_HISTORY_FILE} # save history to file + fi + + # Escape (double) single quotes per SQL norm + line=${line//\'/\'\'} + #echo "line: [${line}]" + ( echo -n "BEGIN io.writeline('${line}', 0); END;"; + echo -en "\n/" ) \ + | ${SQLPLUS} >/dev/null || break +done +echo -e "BEGIN io.close(0); END;\n/" \ + | ${SQLPLUS} > /dev/null +) <&0 >&1 & + + +# File read if requested +( +while true; do + files="$(echo "SELECT path FROM file_io WHERE in_or_out = 'in';" \ + | ${SQLPLUS} 2>/dev/null \ + | grep -v "^no rows selected")" || break + for f in ${files}; do + if [ ! -r ${f} ]; then + echo "UPDATE file_io SET error = 'Cannot read ''${f}''' WHERE path = '${f}' AND in_or_out = 'in';" \ + | ${SQLPLUS} >/dev/null + continue; + fi + IFS= read -rd '' content < "${f}" + # sqlplus limits lines to 2499 characters so split the update + # into chunks of the file ORed together over multiple lines + query="UPDATE file_io SET data = TO_CLOB('')" + while [ -n "${content}" ]; do + chunk="${content:0:2000}" + content="${content:${#chunk}}" + chunk="${chunk//\'/\'\'}" + chunk="${chunk//$'\n'/\\n}" + query="${query}"$'\n'" || TO_CLOB('${chunk}')" + done + query="${query}"$'\n'" WHERE path = '${f}' AND in_or_out = 'in';" + echo "${query}" | ${SQLPLUS} > /dev/null + #echo "file read: ${f}: ${?}" + done + sleep 1 +done +) & +FILE_PID=$! + +res=0 +shift +if [ $# -gt 0 ]; then + # If there are command line arguments then run a command and exit + args=$(for a in "$@"; do echo -n "\"$a\" "; done) + echo -e "SELECT mal.MAIN('(${args})') FROM dual;" \ + | ${SQLPLUS} > /dev/null + res=$? +else + # Start main loop in the background + echo "SELECT mal.MAIN() FROM dual;" \ + | ${SQLPLUS} > /dev/null + res=$? +fi +# Wait for output to flush +wait ${STDOUT_PID} +exit ${res} diff --git a/impls/powershell/Dockerfile b/impls/powershell/Dockerfile new file mode 100644 index 0000000000..1ecddb9d35 --- /dev/null +++ b/impls/powershell/Dockerfile @@ -0,0 +1,32 @@ +FROM ubuntu:16.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Nothing additional needed for python +RUN apt-get -y install libunwind8 libicu55 + +# For dist packaging +RUN curl -L -O https://github.com/PowerShell/PowerShell/releases/download/v6.0.0-alpha.9/powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ + dpkg -i powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ + rm powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb + +ENV HOME=/mal diff --git a/impls/powershell/Makefile b/impls/powershell/Makefile new file mode 100644 index 0000000000..b8722e6d92 --- /dev/null +++ b/impls/powershell/Makefile @@ -0,0 +1,4 @@ +all: + true + +clean: diff --git a/impls/powershell/core.psm1 b/impls/powershell/core.psm1 new file mode 100644 index 0000000000..fee0ca9b71 --- /dev/null +++ b/impls/powershell/core.psm1 @@ -0,0 +1,179 @@ +function time_ms { + $ms = [double]::Parse((Get-Date (get-date).ToUniversalTime() -UFormat %s)) + [int64] ($ms * 1000) +} + +function get($hm, $key) { + if ($hm -eq $null) { + $null + } else { + $hm.values.Item($key) + } +} + +function concat { + $res = @() + foreach($a in $args) { + $res = $res + $a.values + } + new-list $res +} + +function vec($seq) { + if(vector? $seq) { + return $seq + } else { + return new-vector($seq.values) + } +} + +function nth($lst, $idx) { + if ($idx -ge $lst.values.Count) { + throw "nth: index out of range" + } + $lst.nth($idx) +} + + +function do_map($f, $l) { + if (malfunc?($f)) { + $f = $f.fn + } + new-list @($l.values | ForEach-Object { &$f $_ }) +} + +function do_apply($f) { + if (malfunc?($f)) { + $f = $f.fn + } + if ($args.Count -gt 1) { + $fargs = $args[0..($args.Count-2)] + $args[-1].values + } else { + $fargs = $args[$args.Count-1].values + } + &$f @fargs +} + +function conj($lst) { + if (list? $lst) { + [Array]::Reverse($args) + return new-list ($args + $lst.values) + } else { + return new-vector ($lst.values + $args) + } +} + +function seq($obj) { + if ($obj -eq $null) { + return $null + } elseif (list? $obj) { + if ($obj.values.Count -gt 0) { + return $obj + } else { + return $null + } + } elseif (vector? $obj) { + if ($obj.values.Count -gt 0) { + return new-list $obj.values + } else { + return $null + } + } elseif (string? $obj) { + if ($obj.Length -gt 0) { + return new-list ($obj -split '')[1..$obj.Length] + } else { + return $null + } + return new-list $obj + } else { + throw "seq: called on non-sequence" + } +} + +function swap_BANG($a, $f) { + if (malfunc?($f)) { + $f = $f.fn + } + $fargs = @($a.value) + $args + if ($fargs.Count -eq 0) { + $a.value = &$f + } else { + $a.value = &$f @fargs + } + $a.value +} + + +$core_ns = @{ + "=" = { param($a, $b); equal? $a $b }; + "throw" = Get-Command mal_throw; + + "nil?" = { param($a); $a -eq $null }; + "true?" = { param($a); $a -is [Boolean] -and $a -eq $true }; + "false?" = { param($a); $a -is [Boolean] -and $a -eq $false }; + "number?" = { param($a); $a -is [int32] }; + "string?" = { param($a); string? $a }; + "symbol" = Get-Command new-symbol; + "symbol?" = { param($a); symbol? $a }; + "keyword" = Get-Command new-keyword; + "keyword?" = { param($a); keyword? $a }; + "fn?" = { param($a); (fn? $a) -or ((malfunc? $a) -and + (-not $a.macro)) }; + "macro?" = { param($a); (malfunc? $a) -and $a.macro }; + + "pr-str" = { pr_seq $args $true " " }; + "str" = { pr_seq $args $false "" }; + "prn" = { Write-Host (pr_seq $args $true " "); $null }; + "println" = { Write-Host (pr_seq $args $false " "); $null }; + "read-string" = { read_str $args[0] }; + "readline" = { Write-Host $args[0] -NoNewline; [Console]::Readline() }; + "slurp" = { Get-Content -Path $args[0] -Raw }; + + "<" = { param($a, $b); $a -lt $b }; + "<=" = { param($a, $b); $a -le $b }; + ">" = { param($a, $b); $a -gt $b }; + ">=" = { param($a, $b); $a -ge $b }; + "+" = { param($a, $b); $a + $b }; + "-" = { param($a, $b); $a - $b }; + "*" = { param($a, $b); $a * $b }; + "/" = { param($a, $b); $a / $b }; + "time-ms" = Get-Command time_ms; + + "list" = { new-list $args }; + "list?" = Get-Command list?; + "vector" = { new-vector $args }; + "vector?" = Get-Command vector?; + "hash-map" = { new-hashmap $args }; + "map?" = Get-Command hashmap?; + "assoc" = { param($a); assoc_BANG $a.copy() $args }; + "dissoc" = { param($a); dissoc_BANG $a.copy() $args }; + "get" = { param($a,$b); get $a $b }; + "contains?" = { param($a,$b); $a.values.Contains($b) }; + "keys" = Get-Command keys; + "vals" = Get-Command vals; + + "sequential?" = Get-Command sequential?; + "cons" = { param($a, $b); new-list (@($a) + $b.values) }; + "concat" = Get-Command concat; + "vec" = Get-Command vec; + "nth" = Get-Command nth; + "first" = { param($a); if ($a -eq $null) { $null } else { $a.first() } }; + "rest" = { param($a); if ($a -eq $null) { new-list @() } else { $a.rest() } }; + "empty?" = { param($a); $a -eq $null -or $a.values.Count -eq 0 }; + "count" = { param($a); $a.values.Count }; + "apply" = Get-Command do_apply; + "map" = Get-Command do_map; + + "conj" = Get-Command conj; + "seq" = Get-Command seq; + + "meta" = { param($a); $a.meta }; + "with-meta" = { param($a, $b); $c = $a.copy(); $c.meta = $b; $c }; + "atom" = { param($a); new-atom($a) }; + "atom?" = { param($a); atom?($a) }; + "deref" = { param($a); $a.value }; + "reset!" = { param($a, $b); $a.value = $b; $b }; + "swap!" = Get-Command swap_BANG; +} + +Export-ModuleMember -Variable core_ns diff --git a/impls/powershell/env.psm1 b/impls/powershell/env.psm1 new file mode 100644 index 0000000000..60d90abe80 --- /dev/null +++ b/impls/powershell/env.psm1 @@ -0,0 +1,57 @@ +Import-Module $PSScriptRoot/types.psm1 + +Class Env { + [HashTable] $data + [Env] $outer + + Env([Env] $out, $binds, $exprs) { + # Case-sensitive hash table + $this.data = New-Object System.Collections.HashTable + $this.outer = $out + + if ($binds -ne $null) { + for ($i = 0; $i -lt $binds.Length; $i++) { + if ($binds[$i].value -eq "&") { + if ($exprs.Length -gt $i) { + $rest = $exprs[$i..($exprs.Length-1)] + } else { + $rest = @() + } + $this.data[$binds[($i+1)].value] = new-list($rest) + break + } else { + $this.data[$binds[$i].value] = $exprs[$i] + } + } + } + } + + [Object] set($key, $value) { + $this.data[$key] = $value + return $value + } + + [Env] find($key) { + if ($this.data.Contains($key)) { + return $this + } elseif ($this.outer -ne $null) { + return $this.outer.find($key) + } else { + return $null + } + } + + [Object] get($key) { + $e = $this.find($key) + if ($e -ne $null) { + return $e.data[$key] + } else { + throw "'$($key)' not found" + } + } +} + +function new-env([Env] $out, $binds, $exprs) { + [Env]::new($out, $binds, $exprs) +} + diff --git a/impls/powershell/printer.psm1 b/impls/powershell/printer.psm1 new file mode 100644 index 0000000000..b41172002b --- /dev/null +++ b/impls/powershell/printer.psm1 @@ -0,0 +1,59 @@ + +function pr_str { + param($obj, $print_readably = $true) + if ($obj -eq $null) { + return "nil" + } + + switch ($obj.GetType().Name) { + "String" { + if ($obj[0] -eq "$([char]0x29e)") { + return ":$($obj.substring(1))" + } elseif ($print_readably) { + $s = $obj -replace "\\", "\\" + $s = $s -replace "`"", "\`"" + $s = $s -replace "`n", "\n" + return "`"$s`"" + } else { + return "$obj" + } + } + "Vector" { + $res = @($obj.values | ForEach-Object { (pr_str $_ $print_readably) }) + return "[" + ($res -join " ") + "]" + } + "List" { + $res = @($obj.values | ForEach-Object { (pr_str $_ $print_readably) }) + return "(" + ($res -join " ") + ")" + } + "HashMap" { + $res = @() + foreach ($k in $obj.values.Keys) { + $res += pr_str $k $print_readably + $res += pr_str $obj.values[$k] $print_readably + } + return "{" + ($res -join " ") + "}" + } + "Symbol" { + return $obj.value + } + "Boolean" { + return $obj.ToString().ToLower() + } + "Atom" { + return "(atom $(pr_str $obj.value $print_readably))" + } + "PSCustomObject" { + return "(fn* $(pr_str (new-list $obj.params) $print_readably) $(pr_str $obj.ast $print_readably))" + } + default { + return $obj.ToString() + } + } +} + +function pr_seq { + param($seq, $print_readably, $sep) + $lst = foreach($a in $seq) { pr_str $a $print_readably } + $lst -join $sep +} diff --git a/impls/powershell/reader.psm1 b/impls/powershell/reader.psm1 new file mode 100644 index 0000000000..06ac18bdd4 --- /dev/null +++ b/impls/powershell/reader.psm1 @@ -0,0 +1,130 @@ +Import-Module $PSScriptRoot/types.psm1 + +Class Reader { + [String[]] $tokens + [int] $pos + + Reader([String[]] $toks) { + $this.tokens = $toks + $this.pos = 0 + } + + [String] peek() { + return $this.tokens[$this.pos] + } + + [String] next() { + return $this.tokens[$this.pos++] + } +} + + +function tokenize { + $r = [regex]"[\s,]*(~@|[\[\]{}()'``~^@]|`"(?:\\.|[^\\`"])*`"?|;.*|[^\s\[\]{}('`"``,;)]*)" + $r.Matches($args) | + Where-Object { $_.Groups.Item(1).Value.Length -gt 0 -and + $_.Groups.Item(1).Value[0] -ne ";" } | + Foreach-Object { $_.Groups.Item(1).Value } +} + +function read_atom([Reader] $rdr) { + $token = $rdr.next() + if ($token -match "^-?[0-9]+$") { + return [convert]::ToInt32($token, 10) + } elseif ($token -match "^`"(?:\\.|[^\\`"])*`"$") { + $s = $token.Substring(1,$token.Length-2) + $s = $s -replace "\\\\", "$([char]0x29e)" + $s = $s -replace "\\`"", "`"" + $s = $s -replace "\\n", "`n" + $s = $s -replace "$([char]0x29e)", "\" + return $s + } elseif ($token -match "^`".*") { + throw "expected '`"', got EOF" + } elseif ($token -match "^:.*") { + return "$([char]0x29e)$($token.substring(1))" + } elseif ($token -eq "true") { + return $true + } elseif ($token -eq "false") { + return $false + } elseif ($token -eq "nil") { + return $null + } else { + return new-symbol($token) + } +} + +function read_seq([Reader] $rdr, $start, $end) { + $seq = @() + $token = $rdr.next() + if ($token -ne $start) { + throw "expected '$start'" + } + while (($token = $rdr.peek()) -ne $end) { + if ($token -eq "") { + throw "expected '$end', got EOF" + } + $form = read_form $rdr + $seq += $form + } + $token = $rdr.next() + return ,$seq +} + +function read_list([Reader] $rdr) { + return new-list (read_seq $rdr "(" ")") +} + +function read_vector([Reader] $rdr) { + return new-vector (read_seq $rdr "[" "]") +} + +function read_hash_map([Reader] $rdr) { + return new-hashmap (read_seq $rdr "{" "}") +} + +function read_form([Reader] $rdr) { + $token = $rdr.peek() + switch ($token) { + # reader macros/transforms + "'" { $_ = $rdr.next(); + return new-list @((new-symbol "quote"), + (read_form $rdr)) } + "``" { $_ = $rdr.next(); + return new-list @((new-symbol "quasiquote"), + (read_form $rdr)) } + "~" { $_ = $rdr.next(); + return (new-list @((new-symbol "unquote"), + (read_form $rdr))) } + "~@" { $_ = $rdr.next(); + return (new-list @((new-symbol "splice-unquote"), + (read_form $rdr))) } + "^" { $_ = $rdr.next(); + $meta = read_form $rdr + return (new-list @((new-symbol "with-meta"), + (read_form $rdr), + $meta)) } + "@" { $_ = $rdr.next(); + return (new-list @((new-symbol "deref"), + (read_form $rdr))) } + + # list + ")" { throw "unexpected ')'" } + "(" { return read_list $rdr } + + # vector + "]" { throw "unexpected ']'" } + "[" { return read_vector $rdr } + + # hashmap + "}" { throw "unexpected '}'" } + "{" { return read_hash_map $rdr } + + default { return read_atom $rdr } + } +} + +function read_str { + $toks = tokenize($args[0]) + if ($toks.Length -eq 0) { return $null } + read_form([Reader]::new($toks)) +} diff --git a/impls/powershell/run b/impls/powershell/run new file mode 100755 index 0000000000..7adde42817 --- /dev/null +++ b/impls/powershell/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec powershell $(dirname $0)/${STEP:-stepA_mal}.ps1 "${@}" diff --git a/impls/powershell/step0_repl.ps1 b/impls/powershell/step0_repl.ps1 new file mode 100644 index 0000000000..e02f371f13 --- /dev/null +++ b/impls/powershell/step0_repl.ps1 @@ -0,0 +1,8 @@ +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + "$line" +} diff --git a/impls/powershell/step1_read_print.ps1 b/impls/powershell/step1_read_print.ps1 new file mode 100644 index 0000000000..b34ab774a1 --- /dev/null +++ b/impls/powershell/step1_read_print.ps1 @@ -0,0 +1,37 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function EVAL($ast, $env) { + return $ast +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +function REP([String] $str) { + return PRINT (EVAL (READ $str) @{}) +} + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step2_eval.ps1 b/impls/powershell/step2_eval.ps1 new file mode 100644 index 0000000000..fda5246c32 --- /dev/null +++ b/impls/powershell/step2_eval.ps1 @@ -0,0 +1,66 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function EVAL($ast, $env) { + # Write-Host "EVAL: $(pr_str $ast)" + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env[$ast.value] } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) + return &$f @fargs +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +# Case sensitive hashtable +$repl_env = New-Object System.Collections.HashTable +$repl_env["+"] = { param($a, $b); $a + $b } +$repl_env["-"] = { param($a, $b); $a - $b } +$repl_env["*"] = { param($a, $b); $a * $b } +$repl_env["/"] = { param($a, $b); $a / $b } + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step3_env.ps1 b/impls/powershell/step3_env.ps1 new file mode 100644 index 0000000000..a1df5c9da5 --- /dev/null +++ b/impls/powershell/step3_env.ps1 @@ -0,0 +1,89 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function EVAL($ast, $env) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + return EVAL $a2 $let_env + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) + return &$f @fargs + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env +$_ = $repl_env.set("+", { param($a, $b); $a + $b }) +$_ = $repl_env.set("-", { param($a, $b); $a - $b }) +$_ = $repl_env.set("*", { param($a, $b); $a * $b }) +$_ = $repl_env.set("/", { param($a, $b); $a / $b }) + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step4_if_fn_do.ps1 b/impls/powershell/step4_if_fn_do.ps1 new file mode 100644 index 0000000000..06cdeff179 --- /dev/null +++ b/impls/powershell/step4_if_fn_do.ps1 @@ -0,0 +1,116 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 +Import-Module $PSScriptRoot/core.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function EVAL($ast, $env) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + return EVAL $a2 $let_env + } + "do" { + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + return (EVAL $ast.values[$i] $env) + } + "if" { + $cond = (EVAL $a1 $env) + if ($cond -eq $null -or + ($cond -is [Boolean] -and $cond -eq $false)) { + return (EVAL $ast.nth(3) $env) + } else { + return (EVAL $a2 $env) + } + } + "fn*" { + # Save EVAL into a variable that will get closed over + $feval = Get-Command EVAL + return { + return (&$feval $a2 (new-env $env $a1.values $args)) + }.GetNewClosure() + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) + return &$f @fargs + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +# core.EXT: defined using PowerShell +foreach ($kv in $core_ns.GetEnumerator()) { + $_ = $repl_env.set($kv.Key, $kv.Value) +} + +# core.mal: defined using the language itself +$_ = REP('(def! not (fn* (a) (if a false true)))') + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step5_tco.ps1 b/impls/powershell/step5_tco.ps1 new file mode 100644 index 0000000000..23466680a6 --- /dev/null +++ b/impls/powershell/step5_tco.ps1 @@ -0,0 +1,126 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 +Import-Module $PSScriptRoot/core.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + $env = $let_env + $ast = $a2 # TCO + } + "do" { + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + $ast = $ast.values[$i] # TCO + } + "if" { + $cond = (EVAL $a1 $env) + if ($cond -eq $null -or + ($cond -is [Boolean] -and $cond -eq $false)) { + $ast = $ast.nth(3) # TCO + } else { + $ast = $a2 # TCO + } + } + "fn*" { + # Save EVAL into a variable that will get closed over + $feval = Get-Command EVAL + $fn = { + return (&$feval $a2 (new-env $env $a1.values $args)) + }.GetNewClosure() + return new-malfunc $a2 $a1.values $env $fn + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) + if (malfunc? $f) { + $env = (new-env $f.env $f.params $fargs) + $ast = $f.ast # TCO + } else { + return &$f @fargs + } + } + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +# core.EXT: defined using PowerShell +foreach ($kv in $core_ns.GetEnumerator()) { + $_ = $repl_env.set($kv.Key, $kv.Value) +} + +# core.mal: defined using the language itself +$_ = REP('(def! not (fn* (a) (if a false true)))') + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step6_file.ps1 b/impls/powershell/step6_file.ps1 new file mode 100644 index 0000000000..5ea6951dbf --- /dev/null +++ b/impls/powershell/step6_file.ps1 @@ -0,0 +1,135 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 +Import-Module $PSScriptRoot/core.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + $env = $let_env + $ast = $a2 # TCO + } + "do" { + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + $ast = $ast.values[$i] # TCO + } + "if" { + $cond = (EVAL $a1 $env) + if ($cond -eq $null -or + ($cond -is [Boolean] -and $cond -eq $false)) { + $ast = $ast.nth(3) # TCO + } else { + $ast = $a2 # TCO + } + } + "fn*" { + # Save EVAL into a variable that will get closed over + $feval = Get-Command EVAL + $fn = { + return (&$feval $a2 (new-env $env $a1.values $args)) + }.GetNewClosure() + return new-malfunc $a2 $a1.values $env $fn + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) + if (malfunc? $f) { + $env = (new-env $f.env $f.params $fargs) + $ast = $f.ast # TCO + } else { + return &$f @fargs + } + } + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +# core.EXT: defined using PowerShell +foreach ($kv in $core_ns.GetEnumerator()) { + $_ = $repl_env.set($kv.Key, $kv.Value) +} +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) + +# core.mal: defined using the language itself +$_ = REP('(def! not (fn* (a) (if a false true)))') +$_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + + +if ($args.Count -gt 0) { + $_ = REP('(load-file "' + $args[0] + '")') + exit 0 +} + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step7_quote.ps1 b/impls/powershell/step7_quote.ps1 new file mode 100644 index 0000000000..6a52bc60e4 --- /dev/null +++ b/impls/powershell/step7_quote.ps1 @@ -0,0 +1,177 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 +Import-Module $PSScriptRoot/core.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) +} +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) + } else { + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values + } + } + default { return $ast } + } +} + +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + $env = $let_env + $ast = $a2 # TCO + } + "quote" { + return $a1 + } + "quasiquote" { + $ast = quasiquote $a1 + } + "do" { + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + $ast = $ast.values[$i] # TCO + } + "if" { + $cond = (EVAL $a1 $env) + if ($cond -eq $null -or + ($cond -is [Boolean] -and $cond -eq $false)) { + $ast = $ast.nth(3) # TCO + } else { + $ast = $a2 # TCO + } + } + "fn*" { + # Save EVAL into a variable that will get closed over + $feval = Get-Command EVAL + $fn = { + return (&$feval $a2 (new-env $env $a1.values $args)) + }.GetNewClosure() + return new-malfunc $a2 $a1.values $env $fn + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) + if (malfunc? $f) { + $env = (new-env $f.env $f.params $fargs) + $ast = $f.ast # TCO + } else { + return &$f @fargs + } + } + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +# core.EXT: defined using PowerShell +foreach ($kv in $core_ns.GetEnumerator()) { + $_ = $repl_env.set($kv.Key, $kv.Value) +} +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) + +# core.mal: defined using the language itself +$_ = REP('(def! not (fn* (a) (if a false true)))') +$_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + + +if ($args.Count -gt 0) { + $_ = REP('(load-file "' + $args[0] + '")') + exit 0 +} + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step8_macros.ps1 b/impls/powershell/step8_macros.ps1 new file mode 100644 index 0000000000..b32e0dcc29 --- /dev/null +++ b/impls/powershell/step8_macros.ps1 @@ -0,0 +1,189 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 +Import-Module $PSScriptRoot/core.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) +} +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) + } else { + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values + } + } + default { return $ast } + } +} + +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + $env = $let_env + $ast = $a2 # TCO + } + "quote" { + return $a1 + } + "quasiquote" { + $ast = quasiquote $a1 + } + "defmacro!" { + $m = EVAL $a2 $env + $m = $m.copy() + $m.macro = $true + return $env.set($a1.value, $m) + } + "do" { + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + $ast = $ast.values[$i] # TCO + } + "if" { + $cond = (EVAL $a1 $env) + if ($cond -eq $null -or + ($cond -is [Boolean] -and $cond -eq $false)) { + $ast = $ast.nth(3) # TCO + } else { + $ast = $a2 # TCO + } + } + "fn*" { + # Save EVAL into a variable that will get closed over + $feval = Get-Command EVAL + $fn = { + return (&$feval $a2 (new-env $env $a1.values $args)) + }.GetNewClosure() + return new-malfunc $a2 $a1.values $env $fn + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values) + if ($f.macro) { + $ast = &$f.fn @fargs # TCO + continue + } + $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) + if (malfunc? $f) { + $env = (new-env $f.env $f.params $fargs) + $ast = $f.ast # TCO + } else { + return &$f @fargs + } + } + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +# core.EXT: defined using PowerShell +foreach ($kv in $core_ns.GetEnumerator()) { + $_ = $repl_env.set($kv.Key, $kv.Value) +} +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) + +# core.mal: defined using the language itself +$_ = REP('(def! not (fn* (a) (if a false true)))') +$_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +$_ = REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw `"odd number of forms to cond`")) (cons 'cond (rest (rest xs)))))))") + + +if ($args.Count -gt 0) { + $_ = REP('(load-file "' + $args[0] + '")') + exit 0 +} + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + Write-Host "Exception: $($_.Exception.Message)" + } +} diff --git a/impls/powershell/step9_try.ps1 b/impls/powershell/step9_try.ps1 new file mode 100644 index 0000000000..648614ed4b --- /dev/null +++ b/impls/powershell/step9_try.ps1 @@ -0,0 +1,209 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 +Import-Module $PSScriptRoot/core.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) +} +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) + } else { + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values + } + } + default { return $ast } + } +} + +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + $env = $let_env + $ast = $a2 # TCO + } + "quote" { + return $a1 + } + "quasiquote" { + $ast = quasiquote $a1 + } + "defmacro!" { + $m = EVAL $a2 $env + $m = $m.copy() + $m.macro = $true + return $env.set($a1.value, $m) + } + "try*" { + try { + return EVAL $a1 $env + } catch { + if ($a2 -and ($a2.nth(0).value -ceq "catch*")) { + if ($_.Exception.GetType().Name -eq "MalException") { + $e = @($_.Exception.object) + } else { + $e = @($_.Exception.Message) + } + return (EVAL $a2.nth(2) (new-env $env @($a2.nth(1)) $e)) + } else { + throw + } + } + } + "do" { + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + $ast = $ast.values[$i] # TCO + } + "if" { + $cond = (EVAL $a1 $env) + if ($cond -eq $null -or + ($cond -is [Boolean] -and $cond -eq $false)) { + $ast = $ast.nth(3) # TCO + } else { + $ast = $a2 # TCO + } + } + "fn*" { + # Save EVAL into a variable that will get closed over + $feval = Get-Command EVAL + $fn = { + return (&$feval $a2 (new-env $env $a1.values $args)) + }.GetNewClosure() + return new-malfunc $a2 $a1.values $env $fn + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values) + if ($f.macro) { + $ast = &$f.fn @fargs # TCO + continue + } + $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) + if (malfunc? $f) { + $env = (new-env $f.env $f.params $fargs) + $ast = $f.ast # TCO + } else { + return &$f @fargs + } + } + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +# core.EXT: defined using PowerShell +foreach ($kv in $core_ns.GetEnumerator()) { + $_ = $repl_env.set($kv.Key, $kv.Value) +} +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) + +# core.mal: defined using the language itself +$_ = REP('(def! not (fn* (a) (if a false true)))') +$_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +$_ = REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw `"odd number of forms to cond`")) (cons 'cond (rest (rest xs)))))))") + + +if ($args.Count -gt 0) { + $_ = REP('(load-file "' + $args[0] + '")') + exit 0 +} + +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + if ($_.Exception.GetType().Name -eq "MalException") { + Write-Host "Exception: $(pr_str $_.Exception.object)" + } else { + Write-Host "Exception: $($_.Exception.Message)" + } + } +} diff --git a/impls/powershell/stepA_mal.ps1 b/impls/powershell/stepA_mal.ps1 new file mode 100644 index 0000000000..ec7fb5331f --- /dev/null +++ b/impls/powershell/stepA_mal.ps1 @@ -0,0 +1,211 @@ +$ErrorActionPreference = "Stop" + +Import-Module $PSScriptRoot/types.psm1 +Import-Module $PSScriptRoot/reader.psm1 +Import-Module $PSScriptRoot/printer.psm1 +Import-Module $PSScriptRoot/env.psm1 +Import-Module $PSScriptRoot/core.psm1 + +# READ +function READ([String] $str) { + return read_str($str) +} + +# EVAL +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) +} +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) + } else { + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values + } + } + default { return $ast } + } +} + +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch + "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } + "HashMap" { + $hm = new-hashmap @() + foreach ($k in $ast.values.Keys) { + $hm.values[$k] = EVAL $ast.values[$k] $env + } + return $hm + } + default { return $ast } + } + + if (empty? $ast) { return $ast } + + $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) + switch -casesensitive ($a0.value) { + "def!" { + return $env.set($a1.value, (EVAL $a2 $env)) + } + "let*" { + $let_env = new-env $env + for ($i=0; $i -lt $a1.values.Count; $i+=2) { + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) + } + $env = $let_env + $ast = $a2 # TCO + } + "quote" { + return $a1 + } + "quasiquote" { + $ast = quasiquote $a1 + } + "defmacro!" { + $m = EVAL $a2 $env + $m = $m.copy() + $m.macro = $true + return $env.set($a1.value, $m) + } + "try*" { + try { + return EVAL $a1 $env + } catch { + if ($a2 -and ($a2.nth(0).value -ceq "catch*")) { + if ($_.Exception.GetType().Name -eq "MalException") { + $e = @($_.Exception.object) + } else { + $e = @($_.Exception.Message) + } + return (EVAL $a2.nth(2) (new-env $env @($a2.nth(1)) $e)) + } else { + throw + } + } + } + "do" { + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + $ast = $ast.values[$i] # TCO + } + "if" { + $cond = (EVAL $a1 $env) + if ($cond -eq $null -or + ($cond -is [Boolean] -and $cond -eq $false)) { + $ast = $ast.nth(3) # TCO + } else { + $ast = $a2 # TCO + } + } + "fn*" { + # Save EVAL into a variable that will get closed over + $feval = Get-Command EVAL + $fn = { + return (&$feval $a2 (new-env $env $a1.values $args)) + }.GetNewClosure() + return new-malfunc $a2 $a1.values $env $fn + } + default { + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values) + if ($f.macro) { + $ast = &$f.fn @fargs # TCO + continue + } + $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) + if (malfunc? $f) { + $env = (new-env $f.env $f.params $fargs) + $ast = $f.ast # TCO + } else { + return &$f @fargs + } + } + } + } +} + +# PRINT +function PRINT($exp) { + return pr_str $exp $true +} + +# REPL +$repl_env = new-env + +function REP([String] $str) { + return PRINT (EVAL (READ $str) $repl_env) +} + +# core.EXT: defined using PowerShell +foreach ($kv in $core_ns.GetEnumerator()) { + $_ = $repl_env.set($kv.Key, $kv.Value) +} +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) + +# core.mal: defined using the language itself +$_ = REP('(def! *host-language* "powershell")') +$_ = REP('(def! not (fn* (a) (if a false true)))') +$_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +$_ = REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw `"odd number of forms to cond`")) (cons 'cond (rest (rest xs)))))))") + + +if ($args.Count -gt 0) { + $_ = REP('(load-file "' + $args[0] + '")') + exit 0 +} + +$_ = REP('(println (str "Mal [" *host-language* "]"))') +while ($true) { + Write-Host "user> " -NoNewline + $line = [Console]::ReadLine() + if ($line -eq $null) { + break + } + try { + Write-Host (REP($line)) + } catch { + if ($_.Exception.GetType().Name -eq "MalException") { + Write-Host "Exception: $(pr_str $_.Exception.object)" + } else { + Write-Host "Exception: $($_.Exception.Message)" + } + } +} diff --git a/impls/powershell/types.psm1 b/impls/powershell/types.psm1 new file mode 100644 index 0000000000..e6b4d668aa --- /dev/null +++ b/impls/powershell/types.psm1 @@ -0,0 +1,338 @@ +# +# Exceptions +# +Class MalException : Exception { + [Object] $object + + MalException($obj) { + $this.object = $obj + } +} + +function mal_throw($obj) { + throw [MalException] $obj +} + +# +# Symbols +# + +Class Symbol { + [String] $value + + Symbol([String] $val) { + $this.value = $val + } + + copy() { $this } +} + +function new-symbol([String] $val) { + [Symbol]::new($val) +} + +function symbol?($obj) { + $obj -is [Symbol] +} + +# +# Strings +# + +function string?($obj) { + ($obj -is [String]) -and ($obj[0] -ne "$([char]0x29e)") +} + +# +# Keywords +# + +function new-keyword($obj) { + if (keyword? $obj) { + $obj + } else { + "$([char]0x29e)$obj" + } +} + +function keyword?($obj) { + ($obj -is [String]) -and ($obj[0] -eq "$([char]0x29e)") +} + + +# +# Lists +# + +Class List { + #[System.Collections.ArrayList] $values + [Object[]] $values + [Object] $meta + + List() { + $this.values = @() + #$this.values = New-Object System.Collections.ArrayList + } + + List([Object[]] $vals) { + #List([System.Collections.ArrayList] $vals) { + $this.values = $vals + } + + [List] copy() { + return [List]::new($this.values) + } + + [void] push([Object] $val) { + $this.values.Add($val) + } + + [Object] first() { + return $this.values[0] + } + + [List] rest() { + if ($this.values.Count -le 1) { + return [List]::new(@()) + } else { + return [List]::new($this.values[1..($this.values.Count)]) + } + } + + [Object] last() { + if ($this.values.Count -eq 0) { + return $null + } else { + return $this.values[$this.values.Count-1] + } + } + + [Object] nth([int64] $idx) { + return $this.values[$idx] + } +} + +function new-list([Object[]] $vals) { +#function new-list([System.Collections.ArrayList] $vals) { + if ($vals.Count -eq 0) { + return [List]::new() + } else { + return [List]::new($vals) + } +} + +function list?($obj) { + $obj -is [List] -and -not ($obj -is [Vector]) +} + + +# +# Vectors +# + +Class Vector : List { + Vector() { + $this.values = @() + #$this.values = New-Object System.Collections.ArrayList + } + + Vector([Object[]] $vals) { + #Vector([System.Collections.ArrayList] $vals) { + $this.values = $vals + } + + [Vector] copy() { + return [Vector]::new($this.values) + } + +} + +function new-vector([Object[]] $vals) { + if ($vals.Count -eq 0) { + return [Vector]::new() + } else { + return [Vector]::new($vals) + } +} + +function vector?($obj) { + $obj -is [Vector] +} + + +# +# HashMaps +# + +Class HashMap { + [Hashtable] $values + [Object] $meta + + HashMap() { + # Case-sensitive hashtable + $this.values = New-Object System.Collections.HashTable + } + + HashMap([Hashtable] $vals) { + $this.values = $vals + } + + [HashMap] copy() { + return [HashMap]::new($this.values.clone()) + } + +} + +function assoc_BANG($hm, $kvs) { + $ht = $hm.values + for ($i = 0; $i -lt $kvs.Count; $i+=2) { + $ht[$kvs[$i]] = $kvs[($i+1)] + } + return $hm +} + +function dissoc_BANG($hm, $ks) { + $ht = $hm.values + foreach ($k in $ks) { + $ht.Remove($k) + } + return $hm +} + + +function new-hashmap([Object[]] $vals) { + $hm = [HashMap]::new() + assoc_BANG $hm $vals +} + +function hashmap?($obj) { + $obj -is [HashMap] +} + +function keys($hm) { + return new-list @($hm.values.GetEnumerator() | ForEach-Object { $_.Key }) +} + +function vals($hm) { + return new-list @($hm.values.GetEnumerator() | ForEach-Object { $_.Value }) +} + + +# +# Atoms + +Class Atom { + [Object] $value + + Atom([Object] $val) { + $this.value = $val + } +} + +function new-atom([Object] $val) { + [Atom]::new($val) +} + +function atom?($obj) { + $obj -is [Atom] +} + + +# Functions + +Class MalFunc { + [Object] $ast + [Object[]] $params + [Object] $env + [scriptBlock] $fn + [Boolean] $macro + [Object] $meta + + MalFunc($ast, $params, $env, $fn, $macro, $meta){ + $this.ast = $ast + $this.params = $params + $this.env = $env + $this.fn = $fn + $this.macro = $macro + $this.meta = $meta + } + + [MalFunc] copy() { + return [MalFunc]::new($this.ast, $this.params, $this.env, $this.fn, + $this.macro, $this.meta) + } + +} + +function new-malfunc($ast, $params, $env, $fn, $macro, $meta) { + [MalFunc]::new($ast, $params, $env, $fn, $macro, $meta) +} + +function malfunc?($obj) { + $obj -is [MalFunc] +} + +function fn?($obj) { + $obj -is [System.Management.Automation.ScriptBlock] -or $obj -is [System.Management.Automation.CommandInfo] +} +# +# General functions +# +function equal?($a, $b) { + if ($a -eq $null -and $b -eq $null) { + return $true + } elseif ($a -eq $null -or $b -eq $null) { + return $false + } + $ta, $tb = $a.GetType().Name, $b.GetType().Name + if (-not (($ta -eq $tb) -or ((sequential?($a)) -and (sequential?($b))))) { + return $false + } + switch ($ta) { + { $_ -eq "List" -or $_ -eq "Vector" } { + if ($a.values.Count -ne $b.values.Count) { + return $false + } + for ($i = 0; $i -lt $a.value.Count; $i++) { + if (-not (equal? $a.values[$i] $b.values[$i])) { + return $false + } + } + return $true + } + "HashMap" { + $hta, $htb = $a.values, $b.values + $alen = ($hta.GetEnumerator | Measure-Object).Count + $blen = ($htb.GetEnumerator | Measure-Object).Count + if ($alen -ne $blen) { + return $false + } + foreach ($kv in $hta.GetEnumerator()) { + if (-not (equal? $kv.Value $htb[$kv.Key])) { + return $false + } + } + return $true + } + "Symbol" { + return $a.value -ceq $b.value + } + default { + return $a -ceq $b + } + } +} + + +# +# Sequence functions +# +function sequential?($obj) { + $obj -is [List] +} + +function empty?($obj) { + $obj.values.Count -eq 0 +} + + diff --git a/impls/prolog/Dockerfile b/impls/prolog/Dockerfile new file mode 100644 index 0000000000..93cbf7cad7 --- /dev/null +++ b/impls/prolog/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install swi-prolog-nox diff --git a/impls/prolog/Makefile b/impls/prolog/Makefile new file mode 100644 index 0000000000..7f29186f04 --- /dev/null +++ b/impls/prolog/Makefile @@ -0,0 +1,2 @@ +# Stub Makefile to make Travis test mode happy. +all clean: diff --git a/impls/prolog/core.pl b/impls/prolog/core.pl new file mode 100644 index 0000000000..8f78b61cb1 --- /dev/null +++ b/impls/prolog/core.pl @@ -0,0 +1,264 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +wrap_failure(Goal, Args, Res) :- + check(call(Goal,Args, Res), + "~a: wrong arguments: ~L", [Goal, Args]). + +bool(Goal, true) :- call(Goal), !. +bool(_, false). + +'nil?'([X], R) :- bool(=(nil,X), R). + +'false?'([X], R) :- bool(=(false, X), R). + +'true?'([X], R) :- bool(=(true, X), R). + +% Numbers + +'number?'([X], R) :- bool(integer(X), R). + +add([X, Y], R) :- integer(X), integer(Y), R is X + Y. + +sub([X, Y], R) :- integer(X), integer(Y), R is X - Y. + +mul([X, Y], R) :- integer(X), integer(Y), R is X * Y. + +div([X, Y], R) :- integer(X), integer(Y), Y \= 0, R is X / Y. + +'<='([X, Y], R) :- integer(X), integer(Y), bool(=<(X, Y), R). + +ge( [X, Y], R) :- integer(X), integer(Y), bool(>=(X, Y), R). + +lt( [X, Y], R) :- integer(X), integer(Y), bool(<(X, Y), R). + +gt( [X, Y], R) :- integer(X), integer(Y), bool(>(X, Y), R). + +% Symbols + +'symbol?'([false], false). +'symbol?'([nil], false). +'symbol?'([true], false). +'symbol?'([X], R) :- bool(atom(X), R). + +symbol([X], R) :- string(X), atom_string(R, X). + +% Keywords + +'keyword?'([X], R) :- bool(=(X, mal_kwd(_)), R). + +keyword([X], mal_kwd(X)) :- string(X). +keyword([R], R) :- R = mal_kwd(_). + +% Sequences + +'list?'([X], R) :- bool(list(_, X), R). + +'vector?'([X], R) :- bool(vector(_, X), R). + +'sequential?'([X], R) :- bool(unbox_seq(X, _), R). + +'empty?'([X], R) :- bool(unbox_seq(X, []), R). + +count([X], R) :- unbox_seq(X, S), !, length(S, R). +count([nil], 0). + +vec([X], R) :- unbox_seq(X, S), vector(S, R). + +cons([X, Y], R) :- unbox_seq(Y, Ys), list([X | Ys], R). + +concat(Xs, Z) :- maplist(unbox_seq, Xs, Ys), append(Ys, Zs), list(Zs, Z). + +nth([Sequence, Index], Element) :- + unbox_seq(Sequence, Xs), + check(nth0(Index, Xs, Element), + "nth: index ~d out of bounds of ~F", [Index, Sequence]). + +first([X], Y) :- unbox_seq(X, Xs), !, + (Xs = [Y | _] -> true ; Y = nil). +first([nil], nil). + +rest([X], R) :- unbox_seq(X, Xs), !, + (Xs = [_ | Rs] -> true ; Rs = []), + list(Rs, R). +rest([nil], R) :- list([], R). + +map([Fn, Seq], R) :- + unbox_seq(Seq, Xs), + mal_fn(Goal, Fn), + maplist(enlist_apply(Goal), Xs, Rs), list(Rs, R). + +enlist_apply(Goal, X, R) :- call(Goal, [X], R). + +conj([Vector | Ys], R) :- vector(Xs, Vector), !, + append(Xs, Ys, Zs), + vector(Zs, R). +conj([List | Ys], R) :- list(Xs, List), + foldl(cons, Ys, Xs, Zs), list(Zs, R). + +cons(X, Xs, [X | Xs]). + +seq([X], nil) :- unbox_seq(X, []). +seq([X], X) :- list(_, X). +seq([X], R) :- vector(Xs, X), !, list(Xs, R). +seq([""], nil). +seq([S], R) :- string(S), !, + string_chars(S, Chars), + maplist(atom_string, Chars, Strings), + list(Strings, R). +seq([nil], nil). + +% Maps (there is little not much we can do out of types). + +'map?'([X], R) :- bool(is_map(X), R). + +get([Map, Key], R) :- get(Map, Key, R). +get([_, _], nil). + +'contains?'([Map, Key], R) :- bool(get(Map, Key, _), R). + +dissoc([Map | Keys], Res) :- foldl(dissoc, Keys, Map, Res). + +% Atoms + +'atom?'([X], R) :- bool(mal_atom(_, X), R). + +atom([A], R) :- mal_atom(A, R). + +deref([A], R) :- mal_atom(R, A). + +'reset!'([A, R], R) :- mal_atom(_, A), set_mal_atom_value(A, R). + +'swap!'([Atom, Function | Args], R) :- + mal_atom(Old, Atom), + mal_fn(Goal, Function), + call(Goal, [Old | Args], R), + set_mal_atom_value(Atom, R). + +apply([Fn | Xs], R) :- + flatten_last(Xs, Args), + (mal_fn(Goal, Fn) ; (mal_macro(F, Fn), mal_fn(Goal, F))), + call(Goal, Args, R). + +flatten_last([X], Xs) :- unbox_seq(X, Xs). +flatten_last([X | Xs], [X | Ys]) :- flatten_last(Xs, Ys). + +% Strings + +'string?'([X], R) :- bool(string(X), R). + +'pr-str'(Args, R) :- with_output_to(string(R), print_list(t, " ", Args)). + +str( Args, R) :- with_output_to(string(R), print_list(f, "", Args)). + +prn( Args, nil) :- print_list(t, " ", Args), nl. + +println( Args, nil) :- print_list(f, " ", Args), nl. + +'read-string'([S], R) :- string(S), read_str(S, R). + +slurp([Path], R) :- + string(Path), + (read_file_to_string(Path, R, []) -> true ; R = nil). + +readline([Prompt], R) :- + string(Prompt), + write(Prompt), + read_line_to_string(current_input, R), + (R = end_of_file -> R = nil ; true). + +throw([X], nil) :- throw(mal_error(X)). + +'time-ms'([], Ms) :- get_time(S), Ms is round(1_000*S). + +eq([X, Y], R) :- bool(mal_equal(X, Y), R). + +'fn?'([X], R) :- bool(mal_fn(_, X), R). + +'macro?'([X], R) :- bool(mal_macro(_, X), R). + +'prolog-asserta'([String], nil) :- + string(String), + catch((read_term_from_atom(String, Term, []), + asserta(Term)), + Error, + throwf("prolog-asserta: ~w", [Error])). + +'prolog-call'([String], Res) :- + string(String), + catch((read_term_from_atom(String, Term, []), + call(Term, Res)), + Error, + throwf("prolog-call: ~w", [Error])), + check(valid_mal(Res), "prolog-call: invalid result: ~w", [Res]). + +core_ns([ + % naming exceptions + '+', add, + '-', sub, + '*', mul, + '/', div, + '=', eq, + '<', lt, + '>=', ge, + '>', gt, + % step 4 + '<=', '<=', + prn, prn, + list, list, + 'list?', 'list?', + 'empty?', 'empty?', + count, count, + 'pr-str', 'pr-str', + str, str, + println, println, + % step 6 + 'read-string', 'read-string', + slurp, slurp, + atom, atom, + 'atom?', 'atom?', + deref, deref, + 'reset!', 'reset!', + 'swap!', 'swap!', + % step 7 + cons, cons, + concat, concat, + vec, vec, + % step 8 + nth, nth, + first, first, + rest, rest, + % step 9 + throw, throw, + apply, apply, + map, map, + 'nil?', 'nil?', + 'true?', 'true?', + 'false?', 'false?', + 'symbol?', 'symbol?', + symbol, symbol, + keyword, keyword, + 'keyword?', 'keyword?', + vector, vector, + 'vector?', 'vector?', + 'sequential?', 'sequential?', + 'hash-map', 'hash-map', + 'map?', 'map?', + assoc, assoc, + dissoc, dissoc, + get, get, + 'contains?', 'contains?', + keys, keys, + vals, vals, + % step A + readline, readline, + meta, meta, + 'with-meta', 'with-meta', + 'time-ms', 'time-ms', + conj, conj, + 'string?', 'string?', + 'number?', 'number?', + 'fn?', 'fn?', + 'macro?', 'macro?', + seq, seq, + 'prolog-asserta', 'prolog-asserta', + 'prolog-call', 'prolog-call']). diff --git a/impls/prolog/env.pl b/impls/prolog/env.pl new file mode 100644 index 0000000000..c12102ad4b --- /dev/null +++ b/impls/prolog/env.pl @@ -0,0 +1,31 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- format_predicate('V', env_format(_Arg,_Env)). + +env(mal_env(Assoc, t)) :- empty_assoc(Assoc). + +env(Outer, mal_env(Assoc, Outer)) :- empty_assoc(Assoc). + +env_get(mal_env(Assoc, _), Key, Value) :- get_assoc(Key, Assoc, Value). +env_get(mal_env(_, Outer), Key, Value) :- env_get(Outer, Key, Value). + +env_set(Env, Key, Value) :- + Env = mal_env(Old, _), + put_assoc(Key, Old, Value, New), + setarg(1, Env, New). + +env_format(_Arg, mal_env(Assoc, _Outer)) :- + assoc_to_list(Assoc, Pairs), + maplist(env_format_pair, Pairs). + +env_format_pair(K - V) :- format(" ~a:~F", [K, V]). + +% Does *not* check that the keys are symbols. This is done once when +% the fn* structure is created. +env_bind(_Env, [], []). +env_bind(Env, ['&', K], Vs) :- !, + list(Vs, List), + env_set(Env, K, List). +env_bind(Env, [K | Ks], [V | Vs]) :- + env_set(Env, K, V), + env_bind(Env, Ks, Vs). diff --git a/impls/prolog/printer.pl b/impls/prolog/printer.pl new file mode 100644 index 0000000000..cc57e34327 --- /dev/null +++ b/impls/prolog/printer.pl @@ -0,0 +1,62 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- format_predicate('F', format_mal_form(_Arg,_Form)). +:- format_predicate('L', format_mal_list(_Arg,_Forms)). +format_mal_list(_Arg, Forms) :- print_list(t, " ", Forms). +format_mal_form(_Arg, Form) :- pr_str(t, Form). + +pr_str(t, String) :- string(String), !, + write("\""), + string_codes(String, Codes), + maplist(pr_str_escape, Codes), + write("\""). + +pr_str(_, Atomic) :- atomic(Atomic), !, + % number, symbol, nil, true, false, unreadable string. + write(Atomic). + +pr_str(_, mal_kwd(Keyword)) :- !, + put_char(:), + write(Keyword). + +pr_str(Readably, Vector) :- vector(Elements, Vector), !, + write("["), + print_list(Readably, " ", Elements), + write("]"). + +pr_str(Readably, List) :- list(Elements, List), !, + write("("), + print_list(Readably, " ", Elements), + write(")"). + +pr_str(Readably, Map) :- map_to_key_value_list(Map, Key_Value_List), !, + write("{"), + print_list(Readably, " ", Key_Value_List), + write("}"). + +pr_str(_, Fn) :- mal_fn(_Goal, Fn), !, write(""). + +pr_str(_, Macro) :- mal_macro(_Fn, Macro), !, + write(""). + +pr_str(_, Atom) :- mal_atom(Value, Atom), !, + format("(atom ~F)", [Value]). + +pr_str(_, Invalid) :- + format(string(Msg), "pr_str detected an invalid form: ~w\n", [Invalid]), + print_message(warning, Msg), + abort. + +pr_str_escape(0'\n) :- write("\\n"). +pr_str_escape(0'") :- write("\\\""). +pr_str_escape(0'\\) :- write("\\\\"). +pr_str_escape(C) :- put_code(C). + +print_list(_, _, []). +print_list(Readably, Separator, [X | Xs]) :- + pr_str(Readably, X), + maplist(print_list_append(Readably, Separator), Xs). + +print_list_append(Readably, Separator, Element) :- + write(Separator), + pr_str(Readably, Element). diff --git a/impls/prolog/reader.pl b/impls/prolog/reader.pl new file mode 100644 index 0000000000..63846c5a22 --- /dev/null +++ b/impls/prolog/reader.pl @@ -0,0 +1,66 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- use_module(library(dcg/basics)). + +read_str(String, Form) :- + string_codes(String, Codes), + check(phrase(read_form(Form), Codes, _Rest), + "unbalanced expression: '~s'", [String]). + +read_form(Res) --> zero_or_more_separators, ( + `(`, !, read_list(`)`, Forms), { list(Forms, Res) } + | `[`, !, read_list(`]`, Forms), { vector(Forms, Res) } + | `{`, !, read_list(`}`, Forms), { 'hash-map'(Forms, Res) } + | `\``, !, read_form(Form), { list([quasiquote, Form], Res) } + | `\'`, !, read_form(Form), { list([quote, Form], Res) } + | `^`, !, read_form(Meta), read_form(Data), { list(['with-meta', Data, Meta], Res) } + | `:`, !, at_least_one_symcode(Codes), { string_codes(String, Codes), + Res = mal_kwd(String) } + | `\"`, !, until_quotes(Codes), { string_codes(Res, Codes) } + | `@`, !, read_form(Form), { list([deref, Form], Res) } + | `~@`, !, read_form(Form), { list(['splice-unquote', Form], Res) } + | `~`, !, read_form(Form), { list([unquote, Form], Res) } + | integer(Res) + | at_least_one_symcode(Cs), { atom_codes(Res, Cs) }). + +read_list(Closing, [Form | Forms]) --> read_form(Form), !, read_list(Closing, Forms). +read_list(Closing, []) --> zero_or_more_separators, Closing. + +zero_or_more_separators --> separator, !, zero_or_more_separators + | []. + +separator --> [C], { sepcode(C) }, !. +separator --> `;`, string_without(`\n`, _Comment). + +at_least_one_symcode([C | Cs]) --> [C], { symcode(C) }, zero_or_more_symcodes(Cs). + +until_quotes([]) --> [0'"]. +until_quotes([0'\n | Cs]) --> `\\n`, !, until_quotes(Cs). +until_quotes([0'" | Cs]) --> `\\\"`, !, until_quotes(Cs). +until_quotes([0'\\ | Cs]) --> `\\\\`, !, until_quotes(Cs). +until_quotes([C | Cs]) --> [C], until_quotes(Cs). + +zero_or_more_symcodes(Cs) --> at_least_one_symcode(Cs), !. +zero_or_more_symcodes([]) --> []. + +sepcode(0',). +sepcode(0' ). +sepcode(0'\n). + +symcode(C) :- code_type(C, alnum). +symcode(0'!). +symcode(0'#). +symcode(0'$). +symcode(0'%). +symcode(0'&). +symcode(0'*). +symcode(0'+). +symcode(0'-). +symcode(0'/). +symcode(0'<). +symcode(0'=). +symcode(0'>). +symcode(0'?). +symcode(0'_). +symcode(0'|). +symcode(0':). diff --git a/impls/prolog/run b/impls/prolog/run new file mode 100755 index 0000000000..6a9b5f1fe4 --- /dev/null +++ b/impls/prolog/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec swipl $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" diff --git a/impls/prolog/step0_repl.pl b/impls/prolog/step0_repl.pl new file mode 100644 index 0000000000..c05cb1ced9 --- /dev/null +++ b/impls/prolog/step0_repl.pl @@ -0,0 +1,41 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +% Read + +mal_read(Line) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true). % fails for duplicate lines + +% Eval + +eval(Ast, Ast). + +% Print + +print(Ast) :- writeln(Ast). + +% REP + +rep :- + mal_read(Ast), + eval(Ast, Evaluated), + print(Evaluated). + +% Main program + +repl :- + rep, + repl. + +main(_Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + catch(repl, exit_repl, nl), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step1_read_print.pl b/impls/prolog/step1_read_print.pl new file mode 100644 index 0000000000..daff2e16d3 --- /dev/null +++ b/impls/prolog/step1_read_print.pl @@ -0,0 +1,44 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval + +eval(Ast, Ast). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep :- + mal_read(Ast), + eval(Ast, Evaluated), + print(Evaluated). + +% Main program + +repl :- + catch(rep, mal_error(Message), writeln(Message)), + repl. + +main(_Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + catch(repl, exit_repl, nl), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step2_eval.pl b/impls/prolog/step2_eval.pl new file mode 100644 index 0000000000..598fe8c133 --- /dev/null +++ b/impls/prolog/step2_eval.pl @@ -0,0 +1,86 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res). + +% The eval function itself. + +% Uncomment this to get a trace. +%% eval(_, Ast, _) :- +%% format("EVAL: ~F\n", [Ast]), +%% fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(get_assoc(Symbol, Env, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(Message), writeln(Message)), + repl(Env). + +add([X, Y], Res) :- integer(X), integer(Y), Res is X + Y. +sub([X, Y], Res) :- integer(X), integer(Y), Res is X - Y. +mul([X, Y], Res) :- integer(X), integer(Y), Res is X * Y. +div([X, Y], Res) :- integer(X), integer(Y), Y \== 0, Res is X / Y. + +main(_Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + mal_fn(add, Add), + mal_fn(sub, Sub), + mal_fn(mul, Mul), + mal_fn(div, Div), + list_to_assoc(['+' - Add, '-' - Sub, '*' - Mul, '/' - Div], Env), + + catch(repl(Env), exit_repl, nl), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step3_env.pl b/impls/prolog/step3_env.pl new file mode 100644 index 0000000000..100b31a7f0 --- /dev/null +++ b/impls/prolog/step3_env.pl @@ -0,0 +1,111 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([env, printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval non-empty list depending on their first element. + +eval_list(Env, 'def!', Args, Res) :- !, + check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "def!: ~F is not a symbol", [Key]), + eval(Env, Form, Res), + env_set(Env, Key, Res). + +eval_list(Env, 'let*', Args, Res) :- !, + check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), + env(Env, Let_Env), + check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), + eval(Let_Env, Form, Res). + +let_loop(Env, Key, Form) :- !, + check(atom(Key), "let*: ~F is not a key", [Key]), + eval(Env, Form, Value), + env_set(Env, Key, Value). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res). + +% The eval function itself. + +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(Message), writeln(Message)), + repl(Env). + +add([X, Y], Res) :- integer(X), integer(Y), Res is X + Y. +sub([X, Y], Res) :- integer(X), integer(Y), Res is X - Y. +mul([X, Y], Res) :- integer(X), integer(Y), Res is X * Y. +div([X, Y], Res) :- integer(X), integer(Y), Y \== 0, Res is X / Y. + +define_core_function(Env, Symbol, Core_Function) :- + mal_fn(Core_Function, Form), + env_set(Env, Symbol, Form). + +main(_Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + env(Env), + map_keyvals(define_core_function(Env), ['+', add, '-', sub, '*', mul, '/', div]), + + catch(repl(Env), exit_repl, nl), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step4_if_fn_do.pl b/impls/prolog/step4_if_fn_do.pl new file mode 100644 index 0000000000..b481e639e0 --- /dev/null +++ b/impls/prolog/step4_if_fn_do.pl @@ -0,0 +1,146 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([core, env, printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval non-empty list depending on their first element. +:- discontiguous eval_list/4. + +eval_list(Env, 'def!', Args, Res) :- !, + check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "def!: ~F is not a symbol", [Key]), + eval(Env, Form, Res), + env_set(Env, Key, Res). + +eval_list(Env, 'let*', Args, Res) :- !, + check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), + env(Env, Let_Env), + check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), + eval(Let_Env, Form, Res). + +let_loop(Env, Key, Form) :- !, + check(atom(Key), "let*: ~F is not a key", [Key]), + eval(Env, Form, Value), + env_set(Env, Key, Value). + +eval_list(Env, if, Args, Res) :- !, + check(if_assign_args(Args, Form, Then, Else), + "if: expects 2 or 3 arguments, got: ~L", [Args]), + eval(Env, Form, Test), + if_select(Test, Then, Else, Selected), + eval(Env, Selected, Res). + +if_assign_args([Form, Then, Else], Form, Then, Else). +if_assign_args([Form, Then], Form, Then, nil). + +if_select(false, _, Else, Else) :- !. +if_select(nil, _, Else, Else) :- !. +if_select(_, Then, _, Then). + +eval_list(Env, 'fn*', Args, Res) :- !, + check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), + check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), + mal_fn(apply_fn(Keys, Form, Env), Res). + +apply_fn(Keys, Form, Env, Args, Res) :- + env(Env, Apply_Env), + check(env_bind(Apply_Env, Keys, Args), + "cannot apply fn*[~L] to [~L]", [Keys, Args]), + eval(Apply_Env, Form, Res). + +eval_list(Env, do, Args, Res) :- !, + foldl(do_loop(Env), Args, nil, Res). + +do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res). + +% The eval function itself. + +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(Message), writeln(Message)), + repl(Env). + +re(Env, String) :- + read_str(String, Ast), + eval(Env, Ast, _). + +define_core_function(Env, Symbol, Core_Function) :- + mal_fn(wrap_failure(Core_Function), Form), + env_set(Env, Symbol, Form). + +main(_Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + env(Env), + core_ns(Core_Ns), + map_keyvals(define_core_function(Env), Core_Ns), + define_core_function(Env, eval, core_eval(Env)), + + re(Env, "(def! not (fn* [a] (if a false true)))"), + + catch(repl(Env), exit_repl, nl), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step6_file.pl b/impls/prolog/step6_file.pl new file mode 100644 index 0000000000..8c262cef37 --- /dev/null +++ b/impls/prolog/step6_file.pl @@ -0,0 +1,163 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([core, env, printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval non-empty list depending on their first element. +:- discontiguous eval_list/4. + +eval_list(Env, 'def!', Args, Res) :- !, + check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "def!: ~F is not a symbol", [Key]), + eval(Env, Form, Res), + env_set(Env, Key, Res). + +eval_list(Env, 'let*', Args, Res) :- !, + check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), + env(Env, Let_Env), + check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), + eval(Let_Env, Form, Res). + +let_loop(Env, Key, Form) :- !, + check(atom(Key), "let*: ~F is not a key", [Key]), + eval(Env, Form, Value), + env_set(Env, Key, Value). + +eval_list(Env, if, Args, Res) :- !, + check(if_assign_args(Args, Form, Then, Else), + "if: expects 2 or 3 arguments, got: ~L", [Args]), + eval(Env, Form, Test), + if_select(Test, Then, Else, Selected), + eval(Env, Selected, Res). + +if_assign_args([Form, Then, Else], Form, Then, Else). +if_assign_args([Form, Then], Form, Then, nil). + +if_select(false, _, Else, Else) :- !. +if_select(nil, _, Else, Else) :- !. +if_select(_, Then, _, Then). + +eval_list(Env, 'fn*', Args, Res) :- !, + check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), + check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), + mal_fn(apply_fn(Keys, Form, Env), Res). + +apply_fn(Keys, Form, Env, Args, Res) :- + env(Env, Apply_Env), + check(env_bind(Apply_Env, Keys, Args), + "cannot apply fn*[~L] to [~L]", [Keys, Args]), + eval(Apply_Env, Form, Res). + +eval_list(Env, do, Args, Res) :- !, + foldl(do_loop(Env), Args, nil, Res). + +do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res). + +% The eval function itself. + +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(Message), writeln(Message)), + repl(Env). + +re(Env, String) :- + read_str(String, Ast), + eval(Env, Ast, _). + +define_core_function(Env, Symbol, Core_Function) :- + mal_fn(wrap_failure(Core_Function), Form), + env_set(Env, Symbol, Form). + +core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). + +main(Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + env(Env), + core_ns(Core_Ns), + map_keyvals(define_core_function(Env), Core_Ns), + define_core_function(Env, eval, core_eval(Env)), + + re(Env, "(def! not (fn* [a] (if a false true)))"), + re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), + + ( maplist(atom_string, Argv, [Script | Args]) + + -> % If Argv starts with a script, set arguments and load it. + list(Args, Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + format(string(Load_Script), "(load-file \"~s\")", [Script]), + re(Env, Load_Script) + + ; % else read from standard input. + list([], Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + catch(repl(Env), exit_repl, nl) + ), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step7_quote.pl b/impls/prolog/step7_quote.pl new file mode 100644 index 0000000000..03887cb58b --- /dev/null +++ b/impls/prolog/step7_quote.pl @@ -0,0 +1,198 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([core, env, printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval non-empty list depending on their first element. +:- discontiguous eval_list/4. + +eval_list(Env, 'def!', Args, Res) :- !, + check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "def!: ~F is not a symbol", [Key]), + eval(Env, Form, Res), + env_set(Env, Key, Res). + +eval_list(Env, 'let*', Args, Res) :- !, + check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), + env(Env, Let_Env), + check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), + eval(Let_Env, Form, Res). + +let_loop(Env, Key, Form) :- !, + check(atom(Key), "let*: ~F is not a key", [Key]), + eval(Env, Form, Value), + env_set(Env, Key, Value). + +eval_list(Env, if, Args, Res) :- !, + check(if_assign_args(Args, Form, Then, Else), + "if: expects 2 or 3 arguments, got: ~L", [Args]), + eval(Env, Form, Test), + if_select(Test, Then, Else, Selected), + eval(Env, Selected, Res). + +if_assign_args([Form, Then, Else], Form, Then, Else). +if_assign_args([Form, Then], Form, Then, nil). + +if_select(false, _, Else, Else) :- !. +if_select(nil, _, Else, Else) :- !. +if_select(_, Then, _, Then). + +eval_list(Env, 'fn*', Args, Res) :- !, + check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), + check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), + mal_fn(apply_fn(Keys, Form, Env), Res). + +apply_fn(Keys, Form, Env, Args, Res) :- + env(Env, Apply_Env), + check(env_bind(Apply_Env, Keys, Args), + "cannot apply fn*[~L] to [~L]", [Keys, Args]), + eval(Apply_Env, Form, Res). + +eval_list(Env, do, Args, Res) :- !, + foldl(do_loop(Env), Args, nil, Res). + +do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). + +eval_list(_, quote, Args, Res) :- !, + check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). + +eval_list(Env, quasiquote, Args, Res) :- !, + check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), + quasiquote(X, Y), + eval(Env, Y, Res). + +quasiquote(List, Res) :- + list(Xs, List), !, + ( Xs = [unquote | Args] + -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) + ; list([], Empty), + foldr(qq_loop, Empty, Xs, Res)). +quasiquote(Vector, Res) :- + vector(Xs, Vector), !, + list([], Empty), + foldr(qq_loop, Empty, Xs, Y), + list([vec, Y], Res). +quasiquote(nil, nil). +quasiquote(true, true). +quasiquote(false, false). +quasiquote(Symbol_Or_Map, Res) :- + (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, + list([quote, Symbol_Or_Map], Res). +quasiquote(Anything_Else, Anything_Else). + +qq_loop(Elt, Acc, Res) :- + list(['splice-unquote' | Args], Elt), !, + check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), + list([concat, X, Acc], Res). +qq_loop(Elt, Acc, Res) :- + quasiquote(Elt, Quasiquoted), + list([cons, Quasiquoted, Acc], Res). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res). + +% The eval function itself. + +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(Message), writeln(Message)), + repl(Env). + +re(Env, String) :- + read_str(String, Ast), + eval(Env, Ast, _). + +define_core_function(Env, Symbol, Core_Function) :- + mal_fn(wrap_failure(Core_Function), Form), + env_set(Env, Symbol, Form). + +core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). + +main(Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + env(Env), + core_ns(Core_Ns), + map_keyvals(define_core_function(Env), Core_Ns), + define_core_function(Env, eval, core_eval(Env)), + + re(Env, "(def! not (fn* [a] (if a false true)))"), + re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), + + ( maplist(atom_string, Argv, [Script | Args]) + + -> % If Argv starts with a script, set arguments and load it. + list(Args, Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + format(string(Load_Script), "(load-file \"~s\")", [Script]), + re(Env, Load_Script) + + ; % else read from standard input. + list([], Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + catch(repl(Env), exit_repl, nl) + ), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step8_macros.pl b/impls/prolog/step8_macros.pl new file mode 100644 index 0000000000..6e0099309e --- /dev/null +++ b/impls/prolog/step8_macros.pl @@ -0,0 +1,214 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([core, env, printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval non-empty list depending on their first element. +:- discontiguous eval_list/4. + +eval_list(Env, 'def!', Args, Res) :- !, + check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "def!: ~F is not a symbol", [Key]), + eval(Env, Form, Res), + env_set(Env, Key, Res). + +eval_list(Env, 'let*', Args, Res) :- !, + check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), + env(Env, Let_Env), + check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), + eval(Let_Env, Form, Res). + +let_loop(Env, Key, Form) :- !, + check(atom(Key), "let*: ~F is not a key", [Key]), + eval(Env, Form, Value), + env_set(Env, Key, Value). + +eval_list(Env, if, Args, Res) :- !, + check(if_assign_args(Args, Form, Then, Else), + "if: expects 2 or 3 arguments, got: ~L", [Args]), + eval(Env, Form, Test), + if_select(Test, Then, Else, Selected), + eval(Env, Selected, Res). + +if_assign_args([Form, Then, Else], Form, Then, Else). +if_assign_args([Form, Then], Form, Then, nil). + +if_select(false, _, Else, Else) :- !. +if_select(nil, _, Else, Else) :- !. +if_select(_, Then, _, Then). + +eval_list(Env, 'fn*', Args, Res) :- !, + check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), + check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), + mal_fn(apply_fn(Keys, Form, Env), Res). + +apply_fn(Keys, Form, Env, Args, Res) :- + env(Env, Apply_Env), + check(env_bind(Apply_Env, Keys, Args), + "cannot apply fn*[~L] to [~L]", [Keys, Args]), + eval(Apply_Env, Form, Res). + +eval_list(Env, do, Args, Res) :- !, + foldl(do_loop(Env), Args, nil, Res). + +do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). + +eval_list(_, quote, Args, Res) :- !, + check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). + +eval_list(Env, quasiquote, Args, Res) :- !, + check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), + quasiquote(X, Y), + eval(Env, Y, Res). + +quasiquote(List, Res) :- + list(Xs, List), !, + ( Xs = [unquote | Args] + -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) + ; list([], Empty), + foldr(qq_loop, Empty, Xs, Res)). +quasiquote(Vector, Res) :- + vector(Xs, Vector), !, + list([], Empty), + foldr(qq_loop, Empty, Xs, Y), + list([vec, Y], Res). +quasiquote(nil, nil). +quasiquote(true, true). +quasiquote(false, false). +quasiquote(Symbol_Or_Map, Res) :- + (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, + list([quote, Symbol_Or_Map], Res). +quasiquote(Anything_Else, Anything_Else). + +qq_loop(Elt, Acc, Res) :- + list(['splice-unquote' | Args], Elt), !, + check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), + list([concat, X, Acc], Res). +qq_loop(Elt, Acc, Res) :- + quasiquote(Elt, Quasiquoted), + list([cons, Quasiquoted, Acc], Res). + +eval_list(Env, 'defmacro!', Args, Res) :- !, + check(Args = [Key, Form], + "defmacro!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "defmacro!: ~F is not a key", [Key]), + eval(Env, Form, Fn), + check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]), + mal_macro(Fn, Res), + env_set(Env, Key, Res). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + ( mal_macro(F, Fn) + -> % If the Fn macro refers to F, apply F then evaluate, + mal_fn(Goal, F), + call(Goal, Rest, New_Ast), + eval(Env, New_Ast, Res) + ; % else evaluate arguments, apply Fn. + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res)). + +% The eval function itself. + +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(Message), writeln(Message)), + repl(Env). + +re(Env, String) :- + read_str(String, Ast), + eval(Env, Ast, _). + +define_core_function(Env, Symbol, Core_Function) :- + mal_fn(wrap_failure(Core_Function), Form), + env_set(Env, Symbol, Form). + +core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). + +main(Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + env(Env), + core_ns(Core_Ns), + map_keyvals(define_core_function(Env), Core_Ns), + define_core_function(Env, eval, core_eval(Env)), + + re(Env, "(def! not (fn* [a] (if a false true)))"), + re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), + re(Env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), + + ( maplist(atom_string, Argv, [Script | Args]) + + -> % If Argv starts with a script, set arguments and load it. + list(Args, Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + format(string(Load_Script), "(load-file \"~s\")", [Script]), + re(Env, Load_Script) + + ; % else read from standard input. + list([], Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + catch(repl(Env), exit_repl, nl) + ), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/step9_try.pl b/impls/prolog/step9_try.pl new file mode 100644 index 0000000000..006cdc7284 --- /dev/null +++ b/impls/prolog/step9_try.pl @@ -0,0 +1,227 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([core, env, printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval non-empty list depending on their first element. +:- discontiguous eval_list/4. + +eval_list(Env, 'def!', Args, Res) :- !, + check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "def!: ~F is not a symbol", [Key]), + eval(Env, Form, Res), + env_set(Env, Key, Res). + +eval_list(Env, 'let*', Args, Res) :- !, + check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), + env(Env, Let_Env), + check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), + eval(Let_Env, Form, Res). + +let_loop(Env, Key, Form) :- !, + check(atom(Key), "let*: ~F is not a key", [Key]), + eval(Env, Form, Value), + env_set(Env, Key, Value). + +eval_list(Env, if, Args, Res) :- !, + check(if_assign_args(Args, Form, Then, Else), + "if: expects 2 or 3 arguments, got: ~L", [Args]), + eval(Env, Form, Test), + if_select(Test, Then, Else, Selected), + eval(Env, Selected, Res). + +if_assign_args([Form, Then, Else], Form, Then, Else). +if_assign_args([Form, Then], Form, Then, nil). + +if_select(false, _, Else, Else) :- !. +if_select(nil, _, Else, Else) :- !. +if_select(_, Then, _, Then). + +eval_list(Env, 'fn*', Args, Res) :- !, + check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), + check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), + mal_fn(apply_fn(Keys, Form, Env), Res). + +apply_fn(Keys, Form, Env, Args, Res) :- + env(Env, Apply_Env), + check(env_bind(Apply_Env, Keys, Args), + "cannot apply fn*[~L] to [~L]", [Keys, Args]), + eval(Apply_Env, Form, Res). + +eval_list(Env, do, Args, Res) :- !, + foldl(do_loop(Env), Args, nil, Res). + +do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). + +eval_list(_, quote, Args, Res) :- !, + check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). + +eval_list(Env, quasiquote, Args, Res) :- !, + check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), + quasiquote(X, Y), + eval(Env, Y, Res). + +quasiquote(List, Res) :- + list(Xs, List), !, + ( Xs = [unquote | Args] + -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) + ; list([], Empty), + foldr(qq_loop, Empty, Xs, Res)). +quasiquote(Vector, Res) :- + vector(Xs, Vector), !, + list([], Empty), + foldr(qq_loop, Empty, Xs, Y), + list([vec, Y], Res). +quasiquote(nil, nil). +quasiquote(true, true). +quasiquote(false, false). +quasiquote(Symbol_Or_Map, Res) :- + (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, + list([quote, Symbol_Or_Map], Res). +quasiquote(Anything_Else, Anything_Else). + +qq_loop(Elt, Acc, Res) :- + list(['splice-unquote' | Args], Elt), !, + check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), + list([concat, X, Acc], Res). +qq_loop(Elt, Acc, Res) :- + quasiquote(Elt, Quasiquoted), + list([cons, Quasiquoted, Acc], Res). + +eval_list(Env, 'try*', Args, Res) :- !, + ( Args = [Test] + -> eval(Env, Test, Res) + ; check(Args = [Test, Catch], + "try*: expects 1 or 2 arguments, got: ~L", [Args]), + check(list(['catch*', Key, Form], Catch), + "try*: ~F is not a catch* list", [Catch]), + check(atom(Key), "catch*: ~F is not a key", [Key]), + catch(eval(Env, Test, Res), mal_error(Error), + (env(Env, Try_Env), + env_set(Try_Env, Key, Error), + eval(Try_Env, Form, Res)))). + +eval_list(Env, 'defmacro!', Args, Res) :- !, + check(Args = [Key, Form], + "defmacro!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "defmacro!: ~F is not a key", [Key]), + eval(Env, Form, Fn), + check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]), + mal_macro(Fn, Res), + env_set(Env, Key, Res). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + ( mal_macro(F, Fn) + -> % If the Fn macro refers to F, apply F then evaluate, + mal_fn(Goal, F), + call(Goal, Rest, New_Ast), + eval(Env, New_Ast, Res) + ; % else evaluate arguments, apply Fn. + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res)). + +% The eval function itself. + +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(X), format("Exception: ~F\n", [X])), + repl(Env). + +re(Env, String) :- + read_str(String, Ast), + eval(Env, Ast, _). + +define_core_function(Env, Symbol, Core_Function) :- + mal_fn(wrap_failure(Core_Function), Form), + env_set(Env, Symbol, Form). + +core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). + +main(Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + env(Env), + core_ns(Core_Ns), + map_keyvals(define_core_function(Env), Core_Ns), + define_core_function(Env, eval, core_eval(Env)), + + re(Env, "(def! not (fn* [a] (if a false true)))"), + re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), + re(Env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), + + ( maplist(atom_string, Argv, [Script | Args]) + + -> % If Argv starts with a script, set arguments and load it. + list(Args, Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + format(string(Load_Script), "(load-file \"~s\")", [Script]), + re(Env, Load_Script) + + ; % else read from standard input. + list([], Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + catch(repl(Env), exit_repl, nl) + ), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/stepA_mal.pl b/impls/prolog/stepA_mal.pl new file mode 100644 index 0000000000..a0b27763af --- /dev/null +++ b/impls/prolog/stepA_mal.pl @@ -0,0 +1,230 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- initialization(main, main). + +:- consult([core, env, printer, reader, types, utils]). + +% Read + +mal_read(Ast) :- + write("user> "), + read_line_to_string(current_input, Line), + (Line = end_of_file -> throw(exit_repl) ; true), + (rl_add_history(Line) -> true ; true), % fails for duplicate lines + read_str(Line, Ast). + +% Eval non-empty list depending on their first element. +:- discontiguous eval_list/4. + +eval_list(Env, 'def!', Args, Res) :- !, + check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "def!: ~F is not a symbol", [Key]), + eval(Env, Form, Res), + env_set(Env, Key, Res). + +eval_list(Env, 'let*', Args, Res) :- !, + check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), + env(Env, Let_Env), + check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), + eval(Let_Env, Form, Res). + +let_loop(Env, Key, Form) :- !, + check(atom(Key), "let*: ~F is not a key", [Key]), + eval(Env, Form, Value), + env_set(Env, Key, Value). + +eval_list(Env, if, Args, Res) :- !, + check(if_assign_args(Args, Form, Then, Else), + "if: expects 2 or 3 arguments, got: ~L", [Args]), + eval(Env, Form, Test), + if_select(Test, Then, Else, Selected), + eval(Env, Selected, Res). + +if_assign_args([Form, Then, Else], Form, Then, Else). +if_assign_args([Form, Then], Form, Then, nil). + +if_select(false, _, Else, Else) :- !. +if_select(nil, _, Else, Else) :- !. +if_select(_, Then, _, Then). + +eval_list(Env, 'fn*', Args, Res) :- !, + check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), + check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), + check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), + mal_fn(apply_fn(Keys, Form, Env), Res). + +apply_fn(Keys, Form, Env, Args, Res) :- + env(Env, Apply_Env), + check(env_bind(Apply_Env, Keys, Args), + "cannot apply fn*[~L] to [~L]", [Keys, Args]), + eval(Apply_Env, Form, Res). + +eval_list(Env, do, Args, Res) :- !, + foldl(do_loop(Env), Args, nil, Res). + +do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). + +eval_list(_, quote, Args, Res) :- !, + check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). + +eval_list(Env, quasiquote, Args, Res) :- !, + check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), + quasiquote(X, Y), + eval(Env, Y, Res). + +quasiquote(List, Res) :- + list(Xs, List), !, + ( Xs = [unquote | Args] + -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) + ; list([], Empty), + foldr(qq_loop, Empty, Xs, Res)). +quasiquote(Vector, Res) :- + vector(Xs, Vector), !, + list([], Empty), + foldr(qq_loop, Empty, Xs, Y), + list([vec, Y], Res). +quasiquote(nil, nil). +quasiquote(true, true). +quasiquote(false, false). +quasiquote(Symbol_Or_Map, Res) :- + (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, + list([quote, Symbol_Or_Map], Res). +quasiquote(Anything_Else, Anything_Else). + +qq_loop(Elt, Acc, Res) :- + list(['splice-unquote' | Args], Elt), !, + check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), + list([concat, X, Acc], Res). +qq_loop(Elt, Acc, Res) :- + quasiquote(Elt, Quasiquoted), + list([cons, Quasiquoted, Acc], Res). + +eval_list(Env, 'try*', Args, Res) :- !, + ( Args = [Test] + -> eval(Env, Test, Res) + ; check(Args = [Test, Catch], + "try*: expects 1 or 2 arguments, got: ~L", [Args]), + check(list(['catch*', Key, Form], Catch), + "try*: ~F is not a catch* list", [Catch]), + check(atom(Key), "catch*: ~F is not a key", [Key]), + catch(eval(Env, Test, Res), mal_error(Error), + (env(Env, Try_Env), + env_set(Try_Env, Key, Error), + eval(Try_Env, Form, Res)))). + +eval_list(Env, 'defmacro!', Args, Res) :- !, + check(Args = [Key, Form], + "defmacro!: expects 2 arguments, got: ~L", [Args]), + check(atom(Key), "defmacro!: ~F is not a key", [Key]), + eval(Env, Form, Fn), + check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]), + mal_macro(Fn, Res), + env_set(Env, Key, Res). + +% apply phase + +eval_list(Env, First, Rest, Res) :- + eval(Env, First, Fn), + ( mal_macro(F, Fn) + -> % If the Fn macro refers to F, apply F then evaluate, + mal_fn(Goal, F), + call(Goal, Rest, New_Ast), + eval(Env, New_Ast, Res) + ; % else evaluate arguments, apply Fn. + check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), + maplist(eval(Env), Rest, Args), + call(Goal, Args, Res)). + +% The eval function itself. + +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. + +eval(Env, List, Res) :- + list([First | Args], List), !, + eval_list(Env, First, Args, Res). + +eval(_, nil, nil). +eval(_, true, true). +eval(_, false, false). +eval(Env, Symbol, Res) :- + atom(Symbol), !, + check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). + +eval(Env, Vector, Res) :- + vector(Xs, Vector), !, + maplist(eval(Env), Xs, Ys), + vector(Ys, Res). + +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). + +eval(_, Anything_Else, Anything_Else). + +% Print + +print(Ast) :- format("~F\n", [Ast]). + +% REP + +rep(Env) :- + mal_read(Ast), + eval(Env, Ast, Evaluated), + print(Evaluated). + +% Main program + +repl(Env) :- + catch(rep(Env), mal_error(X), format("Exception: ~F\n", [X])), + repl(Env). + +re(Env, String) :- + read_str(String, Ast), + eval(Env, Ast, _). + +define_core_function(Env, Symbol, Core_Function) :- + mal_fn(wrap_failure(Core_Function), Form), + env_set(Env, Symbol, Form). + +core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). + +main(Argv) :- + getenv("HOME", Home), + string_concat(Home, "/.mal-history", History), + (exists_file(History) -> rl_read_history(History) ; true), + + env(Env), + core_ns(Core_Ns), + map_keyvals(define_core_function(Env), Core_Ns), + define_core_function(Env, eval, core_eval(Env)), + + env_set(Env, '*host-language*', "prolog"), + + re(Env, "(def! not (fn* [a] (if a false true)))"), + re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), + re(Env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), + + ( maplist(atom_string, Argv, [Script | Args]) + + -> % If Argv starts with a script, set arguments and load it. + list(Args, Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + format(string(Load_Script), "(load-file \"~s\")", [Script]), + re(Env, Load_Script) + + ; % else read from standard input. + list([], Mal_Argv), + env_set(Env, '*ARGV*', Mal_Argv), + + re(Env, "(println (str \"Mal [\" *host-language* \"]\"))"), + catch(repl(Env), exit_repl, nl) + ), + + (rl_write_history(History) -> true ; true). diff --git a/impls/prolog/tests/stepA_mal.mal b/impls/prolog/tests/stepA_mal.mal new file mode 100644 index 0000000000..9b4dabdd7a --- /dev/null +++ b/impls/prolog/tests/stepA_mal.mal @@ -0,0 +1,29 @@ +;; Testing basic prolog interop + +(prolog-call "1+") +;/.*prolog-call: .*syntax_error.* +(prolog-call "atom_length(\"ab\")") +;=>2 +(prolog-call "atom_concat(\"ab\", \"cd\")") +;=>abcd +(prolog-call "number_string(42)") +;=>"42" +(prolog-call "=(mal_kwd(\"kw\"))") +;=>:kw +(prolog-call "list([a, b])") +;=>(a b) +(prolog-call "vector([a, b])") +;=>[a b] +(prolog-call "'hash-map'([\"a\", 1])") +;=>{"a" 1} +(meta (prolog-call "=(mal_vector([a, b], 12))")) +;=>12 +(prolog-call "=(mal_list([1, mal_formed(1)]))") +;/.*prolog-call: invalid result.* + +(prolog-asserta "(mal_setenv(Name, Value, nil) :- setenv(Name, Value))") +;=>nil +(prolog-call "mal_setenv(\"answer\", 42)") +;=>nil +(prolog-call "getenv(\"answer\")") +;=>42 diff --git a/impls/prolog/types.pl b/impls/prolog/types.pl new file mode 100644 index 0000000000..57312d12a3 --- /dev/null +++ b/impls/prolog/types.pl @@ -0,0 +1,181 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +:- discontiguous mal_equal/2. +:- discontiguous 'with-meta'/2. +:- discontiguous meta/2. +:- discontiguous valid_mal/1. + +% A MAL number is represented by a Prolog integer. + +% A MAL symbol is represented by a Prolog atom, +% including `false`, `nil` and `true`. + +% A MAL string is represented by a Prolog string. + +% A MAL keyword is represented as mal_kwd(String), and there is no +% reason to encapsulate this information. + +% The remaining representations are encapsulated because they may have +% to evolve, and interfer directly with metadata. + +mal_equal(X, X) :- atomic(X), !. +mal_equal(mal_kwd(S), mal_kwd(S)) :- !. + +valid_mal(X) :- integer(X), !. +valid_mal(X) :- atom(X), !. +valid_mal(X) :- string(X), !. +valid_mal(mal_kwd(S)) :- !, string(S). + +% Sequences + +% list(?Forms, ?List) +% Bi-directional conversion between a list of MAL forms and a MAL list. +% At least one of the two arguments must be instantiated. +% Fails if the second argument is instantiated but not a MAL list. +% vector(?Forms, ?Vector) +% Similar for MAL vectors. + +list(Forms, mal_list(Forms)) :- !. +list(Forms, mal_list(Forms, _Meta)) :- !. + +vector(Forms, mal_vector(Forms)) :- !. +vector(Forms, mal_vector(Forms, _Meta)) :- !. + +mal_equal(S1, S2) :- + unbox_seq(S1, L1), !, + unbox_seq(S2, L2), + maplist(mal_equal, L1, L2). + +'with-meta'([X, Meta], mal_list( Forms, Meta)) :- list( Forms, X), !. +'with-meta'([X, Meta], mal_vector(Forms, Meta)) :- vector(Forms, X), !. + +meta([mal_list(_, Meta)], Meta) :- !. +meta([mal_vector(_, Meta)], Meta) :- !. + +valid_mal(mal_list(F)) :- !, maplist(valid_mal, F). +valid_mal(mal_list(F, M)) :- !, maplist(valid_mal, F), valid_mal(M). +valid_mal(mal_vector(F)) :- !, maplist(valid_mal, F). +valid_mal(mal_vector(F, M)) :- !, maplist(valid_mal, F), valid_mal(M). + +% Maps + +% Other files should not directly depend on Assoc, as there may be +% good reasons to change the map representation. + +'hash-map'(Key_Value_List, mal_map(Res)) :- + empty_assoc(Assoc), + check(foldl_keyvals(assoc, Assoc, Key_Value_List, Res), + "hash-map: odd count of key and values in ~L", [Key_Value_List]). + +is_map(mal_map(_Assoc)) :- !. +is_map(mal_map(_Assoc, _Meta)) :- !. + +is_key(Key) :- string(Key), !. +is_key(mal_kwd(_)) :- !. + +unbox_map(mal_map(Assoc), Assoc) :- !. +unbox_map(mal_map(Assoc, _Meta), Assoc) :- !. + +get(Map, Key, Res) :- + unbox_map(Map, Assoc), + is_key(Key), + get_assoc(Key, Assoc, Res). + +assoc([Map | Key_Value_List], mal_map(Res)) :- + unbox_map(Map, Assoc), + check(foldl_keyvals(assoc, Assoc, Key_Value_List, Res), + "assoc: odd count of key and values in [~L]", [Key_Value_List]). + +assoc(Assoc, Key, Value, Res) :- + check(is_key(Key), "map keys must be strings or symbol, not ~F", [Key]), + put_assoc(Key, Assoc, Value, Res). + +% This order of parameter is convenient with foldl. +dissoc(Key, Map, mal_map(Res)) :- + unbox_map(Map, Assoc), + is_key(Key), + % del_assoc fails if the key did previously exist, + % and we do not want to search twice. + (del_assoc(Key, Assoc, _Value, Res) -> true ; Res = Assoc). + +map_map(Goal, Map, mal_map(Res)) :- + unbox_map(Map, Assoc), + map_assoc(Goal, Assoc, Res). + +keys([Map], Res) :- + unbox_map(Map, Assoc), + assoc_to_keys(Assoc, Keys), + list(Keys, Res). + +vals([Map], Res) :- + unbox_map(Map, Assoc), + assoc_to_values(Assoc, Vals), + list(Vals, Res). + +% MAL map -> key/value Prolog list +% Fail if the form is not a map. +map_to_key_value_list(Map, Forms) :- + unbox_map(Map, Assoc), + assoc_to_list(Assoc, Pairs), + foldr(convert_pair, [], Pairs, Forms). + +convert_pair(Key - Value, Acc, [Key, Value | Acc]). + +mal_equal(Map1, Map2) :- + unbox_map(Map1, Assoc1), !, + unbox_map(Map2, Assoc2), + % map_assoc(mal_equal) does not work here because its result + % depends on the internal structure. + assoc_to_list(Assoc1, Pairs1), + assoc_to_list(Assoc2, Pairs2), + maplist(map_pair_equal, Pairs1, Pairs2). + +map_pair_equal(K1 - V1, K2 - V2) :- K1 = K2, mal_equal(V1, V2). + +'with-meta'([X, Meta], mal_map(Assoc, Meta)) :- unbox_map(X, Assoc), !. + +meta([mal_map(_, Meta)], Meta) :- !. + +valid_mal(mal_map(Assoc)) :- !, + is_assoc(Assoc), + assoc_to_list(Assoc, Pairs), + maplist(valid_mal_pair, Pairs). +valid_mal(mal_map(Assoc, Meta)) :- !, + is_assoc(Assoc), + assoc_to_list(Assoc, Pairs), + maplist(valid_mal_pair, Pairs), + valid_mal(Meta). + +valid_mal_pair(K - V) :- is_key(K), valid_mal(V). + +% Functions + +% Goal is called with call(Goal, [Arg1, Arg2..], Res). +% It should never fail, and use mal_error/1 to report problems. + +mal_fn(Goal, mal_fn(Goal)) :- !. +mal_fn(Goal, mal_fn(Goal, _Meta)) :- !. + +'with-meta'([mal_fn(Goal), Meta], mal_fn(Goal, Meta)) :- !. +'with-meta'([mal_fn(Goal, _Meta), Meta], mal_fn(Goal, Meta)) :- !. + +meta([mal_fn(_,Meta)], Meta) :- !. + +valid_mal(mal_fn(_)) :- !. +valid_mal(mal_fn(_, Meta)) :- !, valid_mal(Meta). + +% Macros + +mal_macro(Fn, mal_macro(Fn)). + +% Atoms + +mal_atom(Value, mal_atom(Value)). + +set_mal_atom_value(Atom, Value) :- setarg(1, Atom, Value). + +valid_mal(mal_atom(Value)) :- !, valid_mal(Value). + +% Catch-all clause for objects without metadata. + +meta([_], nil) :- !. diff --git a/impls/prolog/utils.pl b/impls/prolog/utils.pl new file mode 100644 index 0000000000..854fe3551b --- /dev/null +++ b/impls/prolog/utils.pl @@ -0,0 +1,46 @@ +% -*- mode: prolog; -*- select prolog mode in the emacs text editor + +% Convenient shortcuts, especially during steps 1 to 6. + +% Similar to "assert", but raise an non-fatal error. +check(Condition, _, _) :- call(Condition), !. +check(_, Format, Arguments) :- throwf(Format, Arguments). + +throwf(Format, Arguments) :- + format(string(Message), Format, Arguments), + throw(mal_error(Message)). + +% Convenient shortcut: unbox(+Sequence, -List). + +unbox_seq(Sequence, Forms) :- list(Forms, Sequence). +unbox_seq(Sequence, Forms) :- vector(Forms, Sequence). + +% Abstract some loops. + +% foldr(Goal, Vn, [X1, X2,...,Xn], V0) :- +% Goal(Xn, Vn, Vn-1), +% ... +% Goal(X2, V2, V1), +% Goal(X1, V1, V0), +foldr(_, Vn, [], Vn). +foldr(Goal, Vn, [X|Xs], V0) :- + foldr(Goal, Vn, Xs, V1), + call(Goal, X, V1, V0). + +% foldl_keyvals(Goal, Init, [K1, V1, K2, V2, K3, V3], Acc3) :- +% Goal(Init, K1, V1, Acc1), +% Goal(Acc1, K2, V2, Acc2), +% Goal(Acc2, K3, V3, Acc3). +foldl_keyvals(_, Init, [], Init). +foldl_keyvals(Goal, Init, [K, V | KVs], Res) :- + call(Goal, Init, K, V, Acc), + foldl_keyvals(Goal, Acc, KVs, Res). + +% map_keyvals(Goal, [K1, V1, K2, V2, K3, V3]) :- +% Goal(K1, V1), +% Goal(K2, V2), +% Goal(K3, V3). +map_keyvals(_, []). +map_keyvals(Goal, [K, V | KVs]) :- + call(Goal, K, V), + map_keyvals(Goal, KVs). diff --git a/impls/ps/Dockerfile b/impls/ps/Dockerfile new file mode 100644 index 0000000000..7c41d1f942 --- /dev/null +++ b/impls/ps/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# PostScript/ghostscript +RUN apt-get -y install ghostscript diff --git a/impls/ps/Makefile b/impls/ps/Makefile new file mode 100644 index 0000000000..98a0d37408 --- /dev/null +++ b/impls/ps/Makefile @@ -0,0 +1,20 @@ +SOURCES_BASE = types.ps reader.ps printer.ps +SOURCES_LISP = env.ps core.ps stepA_mal.ps +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.ps mal + +mal.ps: $(SOURCES) + cat $+ | grep -v "runlibfile$$" > $@ + +mal: mal.ps + echo "#!/bin/sh" > $@ + echo "\":\" pop pop pop pop %#; exec gs -d'#!'=null -d'\":\"'=null -q -dNODISPLAY -- \"\$$0\" \"\$$@\"" >> $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.ps mal diff --git a/ps/core.ps b/impls/ps/core.ps similarity index 79% rename from ps/core.ps rename to impls/ps/core.ps index 52c9b055b3..a6b6b9e853 100644 Binary files a/ps/core.ps and b/impls/ps/core.ps differ diff --git a/impls/ps/env.ps b/impls/ps/env.ps new file mode 100644 index 0000000000..3d7614d04c Binary files /dev/null and b/impls/ps/env.ps differ diff --git a/ps/interop.ps b/impls/ps/interop.ps similarity index 100% rename from ps/interop.ps rename to impls/ps/interop.ps diff --git a/ps/printer.ps b/impls/ps/printer.ps similarity index 94% rename from ps/printer.ps rename to impls/ps/printer.ps index 52d6c1ece2..817bece428 100644 Binary files a/ps/printer.ps and b/impls/ps/printer.ps differ diff --git a/ps/reader.ps b/impls/ps/reader.ps similarity index 92% rename from ps/reader.ps rename to impls/ps/reader.ps index 4b268c04be..f1d33a1820 100644 Binary files a/ps/reader.ps and b/impls/ps/reader.ps differ diff --git a/impls/ps/run b/impls/ps/run new file mode 100755 index 0000000000..a961d13c7f --- /dev/null +++ b/impls/ps/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec gs -q -I$(dirname $0) -dNOSAFER -dNODISPLAY -- $(dirname $0)/${STEP:-stepA_mal}.ps "${@}" diff --git a/ps/step0_repl.ps b/impls/ps/step0_repl.ps similarity index 87% rename from ps/step0_repl.ps rename to impls/ps/step0_repl.ps index d26844c56a..b7c2f175b1 100644 Binary files a/ps/step0_repl.ps and b/impls/ps/step0_repl.ps differ diff --git a/ps/step1_read_print.ps b/impls/ps/step1_read_print.ps similarity index 91% rename from ps/step1_read_print.ps rename to impls/ps/step1_read_print.ps index 858987caca..efc563a2f2 100644 Binary files a/ps/step1_read_print.ps and b/impls/ps/step1_read_print.ps differ diff --git a/impls/ps/step2_eval.ps b/impls/ps/step2_eval.ps new file mode 100644 index 0000000000..48c9dc914a Binary files /dev/null and b/impls/ps/step2_eval.ps differ diff --git a/impls/ps/step3_env.ps b/impls/ps/step3_env.ps new file mode 100644 index 0000000000..89d2a8ca4d Binary files /dev/null and b/impls/ps/step3_env.ps differ diff --git a/impls/ps/step4_if_fn_do.ps b/impls/ps/step4_if_fn_do.ps new file mode 100644 index 0000000000..68307fab08 Binary files /dev/null and b/impls/ps/step4_if_fn_do.ps differ diff --git a/impls/ps/step5_tco.ps b/impls/ps/step5_tco.ps new file mode 100644 index 0000000000..7a224223b2 Binary files /dev/null and b/impls/ps/step5_tco.ps differ diff --git a/impls/ps/step6_file.ps b/impls/ps/step6_file.ps new file mode 100644 index 0000000000..fcf3473185 Binary files /dev/null and b/impls/ps/step6_file.ps differ diff --git a/impls/ps/step7_quote.ps b/impls/ps/step7_quote.ps new file mode 100644 index 0000000000..45eef62f7d Binary files /dev/null and b/impls/ps/step7_quote.ps differ diff --git a/impls/ps/step8_macros.ps b/impls/ps/step8_macros.ps new file mode 100644 index 0000000000..07a64b0500 Binary files /dev/null and b/impls/ps/step8_macros.ps differ diff --git a/impls/ps/step9_try.ps b/impls/ps/step9_try.ps new file mode 100644 index 0000000000..4e72356d25 Binary files /dev/null and b/impls/ps/step9_try.ps differ diff --git a/impls/ps/stepA_mal.ps b/impls/ps/stepA_mal.ps new file mode 100644 index 0000000000..5254e4ff80 Binary files /dev/null and b/impls/ps/stepA_mal.ps differ diff --git a/impls/ps/tests/step5_tco.mal b/impls/ps/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/ps/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/ps/tests/stepA_mal.mal b/impls/ps/tests/stepA_mal.mal new file mode 100644 index 0000000000..fd1ed03f5e --- /dev/null +++ b/impls/ps/tests/stepA_mal.mal @@ -0,0 +1,25 @@ +;; Testing basic ps interop + +(ps* "7") +;=>(7) + +(ps* "(7)") +;=>("7") + +(ps* "7 8 9 3 array astore") +;=>((7 8 9)) + +(ps* "1 1 eq") +;=>(true) + +(ps* "/sym") +;=>(sym) + +(ps* "1 1 eq { (yep) }{ (nope) } ifelse") +;=>("yep") + +(ps* "1 0 eq { (yep) }{ (nope) } ifelse") +;=>("nope") + +(ps* "1 2 3 pop pop pop") +;=>nil diff --git a/ps/types.ps b/impls/ps/types.ps similarity index 83% rename from ps/types.ps rename to impls/ps/types.ps index 1f6903ee35..ad07002b54 100644 Binary files a/ps/types.ps and b/impls/ps/types.ps differ diff --git a/impls/purs/.gitignore b/impls/purs/.gitignore new file mode 100644 index 0000000000..38ad64c272 --- /dev/null +++ b/impls/purs/.gitignore @@ -0,0 +1,12 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago + +/step*.js diff --git a/impls/purs/Dockerfile b/impls/purs/Dockerfile new file mode 100644 index 0000000000..1eb013ea33 --- /dev/null +++ b/impls/purs/Dockerfile @@ -0,0 +1,38 @@ +FROM ubuntu:21.10 + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# For building node modules +RUN apt-get -y install g++ + +# Add nodesource apt repo config for 10.x stable +RUN apt-get -y install gnupg +RUN curl -sL https://deb.nodesource.com/setup_12.x | bash - + +# Install nodejs +RUN apt-get -y install nodejs + +# Install purescript and deps +RUN apt-get install -y git libtinfo5 +RUN npm install -g --unsafe-perm purescript spago + +ENV NPM_CONFIG_CACHE /mal/.npm +ENV HOME /mal \ No newline at end of file diff --git a/impls/purs/Makefile b/impls/purs/Makefile new file mode 100644 index 0000000000..5de690be1b --- /dev/null +++ b/impls/purs/Makefile @@ -0,0 +1,35 @@ +BINS = step0_repl.js step1_read_print.js step2_eval.js step3_env.js \ + step4_if_fn_do.js step5_tco.js step6_file.js step7_quote.js \ + step8_macros.js step9_try.js stepA_mal.js + +OTHER_SRCS = src/Readline.js src/Readline.purs src/Types.purs src/Reader.purs \ + src/Printer.purs src/Env.purs src/Core.purs + + +all: $(BINS) + +$(BINS): %.js: src/%.purs $(OTHER_SRCS) node_modules/readline-sync + spago bundle-app --main $($(<:src/%=%)) --to $@ + + +node_modules/readline-sync: + npm install + + +##################### + +step0_repl.purs = Mal.Step0 +step1_read_print.purs = Mal.Step1 +step2_eval.purs = Mal.Step2 +step3_env.purs = Mal.Step3 +step4_if_fn_do.purs = Mal.Step4 +step5_tco.purs = Mal.Step5 +step6_file.purs = Mal.Step6 +step7_quote.purs = Mal.Step7 +step8_macros.purs = Mal.Step8 +step9_try.purs = Mal.Step9 +stepA_mal.purs = Mal.StepA + + +clean: + rm -rf step*.js output/* \ No newline at end of file diff --git a/impls/purs/package.json b/impls/purs/package.json new file mode 100644 index 0000000000..65adf18429 --- /dev/null +++ b/impls/purs/package.json @@ -0,0 +1,5 @@ +{ + "dependencies": { + "readline-sync": "^1.4.10" + } +} diff --git a/impls/purs/packages.dhall b/impls/purs/packages.dhall new file mode 100644 index 0000000000..7b4147e645 --- /dev/null +++ b/impls/purs/packages.dhall @@ -0,0 +1,104 @@ +{- +Welcome to your new Dhall package-set! + +Below are instructions for how to edit this file for most use +cases, so that you don't need to know Dhall to use it. + +## Use Cases + +Most will want to do one or both of these options: +1. Override/Patch a package's dependency +2. Add a package not already in the default package set + +This file will continue to work whether you use one or both options. +Instructions for each option are explained below. + +### Overriding/Patching a package + +Purpose: +- Change a package's dependency to a newer/older release than the + default package set's release +- Use your own modified version of some dependency that may + include new API, changed API, removed API by + using your custom git repo of the library rather than + the package set's repo + +Syntax: +where `entityName` is one of the following: +- dependencies +- repo +- version +------------------------------- +let upstream = -- +in upstream + with packageName.entityName = "new value" +------------------------------- + +Example: +------------------------------- +let upstream = -- +in upstream + with halogen.version = "master" + with halogen.repo = "https://example.com/path/to/git/repo.git" + + with halogen-vdom.version = "v4.0.0" + with halogen-vdom.dependencies = [ "extra-dependency" ] # halogen-vdom.dependencies +------------------------------- + +### Additions + +Purpose: +- Add packages that aren't already included in the default package set + +Syntax: +where `` is: +- a tag (i.e. "v4.0.0") +- a branch (i.e. "master") +- commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977") +------------------------------- +let upstream = -- +in upstream + with new-package-name = + { dependencies = + [ "dependency1" + , "dependency2" + ] + , repo = + "https://example.com/path/to/git/repo.git" + , version = + "" + } +------------------------------- + +Example: +------------------------------- +let upstream = -- +in upstream + with benchotron = + { dependencies = + [ "arrays" + , "exists" + , "profunctor" + , "strings" + , "quickcheck" + , "lcg" + , "transformers" + , "foldable-traversable" + , "exceptions" + , "node-fs" + , "node-buffer" + , "node-readline" + , "datetime" + , "now" + ] + , repo = + "https://github.com/hdgarrood/purescript-benchotron.git" + , version = + "v7.0.0" + } +------------------------------- +-} +let upstream = + https://github.com/purescript/package-sets/releases/download/psc-0.14.2-20210713/packages.dhall sha256:654c3148cb995f642c73b4508d987d9896e2ad3ea1d325a1e826c034c0d3cd7b + +in upstream diff --git a/impls/purs/run b/impls/purs/run new file mode 100755 index 0000000000..510f226881 --- /dev/null +++ b/impls/purs/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" \ No newline at end of file diff --git a/impls/purs/spago.dhall b/impls/purs/spago.dhall new file mode 100644 index 0000000000..2334ad7617 --- /dev/null +++ b/impls/purs/spago.dhall @@ -0,0 +1,43 @@ +{- +Welcome to a Spago project! +You can edit this file as you like. + +Need help? See the following resources: +- Spago documentation: https://github.com/purescript/spago +- Dhall language tour: https://docs.dhall-lang.org/tutorials/Language-Tour.html + +When creating a new Spago project, you can use +`spago init --no-comments` or `spago init -C` +to generate this file without the comments in this block. +-} +{ name = "mal-purescript" +, dependencies = + [ "arrays" + , "console" + , "control" + , "datetime" + , "effect" + , "either" + , "exceptions" + , "foldable-traversable" + , "freet" + , "identity" + , "integers" + , "lists" + , "maybe" + , "node-buffer" + , "node-fs" + , "now" + , "ordered-collections" + , "parsing" + , "prelude" + , "psci-support" + , "refs" + , "strings" + , "tailrec" + , "transformers" + , "tuples" + ] +, packages = ./packages.dhall +, sources = [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/impls/purs/src/Core.purs b/impls/purs/src/Core.purs new file mode 100644 index 0000000000..b5060032f0 --- /dev/null +++ b/impls/purs/src/Core.purs @@ -0,0 +1,515 @@ +module Core (ns) where + +import Prelude + +import Data.DateTime.Instant (unInstant) +import Data.Int (ceil, toNumber) +import Data.List (List(..), concat, drop, foldM, fromFoldable, length, reverse, (:)) +import Data.Map.Internal as Map +import Data.Maybe (Maybe(..)) +import Data.String (take) +import Data.String.CodeUnits (singleton) +import Data.Time.Duration (Milliseconds(..), toDuration) +import Data.Traversable (traverse) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Class (liftEffect) +import Effect.Console (log) +import Effect.Exception (throw) +import Effect.Now (now) +import Effect.Ref as Ref +import Reader (readStr) +import Node.Encoding (Encoding(..)) +import Node.FS.Sync (readTextFile) +import Printer (keyValuePairs, printList, printListReadably, printStrReadably) +import Readline (readLine) +import Types (Key(..), MalExpr(..), MalFn, Meta(..), keyToString, stringToCharList, toAtom, toHashMap, toList, toVector) + + + +ns :: List (Tuple String MalFn) +ns = fromFoldable + [ Tuple "throw" throw' + + , Tuple "true?" $ pred1 trueQ + , Tuple "false?" $ pred1 falseQ + + , Tuple "=" eqQ + , Tuple "+" $ numOp (+) + , Tuple "-" $ numOp (-) + , Tuple "*" $ numOp (*) + , Tuple "/" $ numOp (/) + , Tuple "<" $ cmpOp (<) + , Tuple "<=" $ cmpOp (<=) + , Tuple ">" $ cmpOp (>) + , Tuple ">=" $ cmpOp (>=) + , Tuple "number?" $ pred1 numberQ + + , Tuple "pr-str" prStr + , Tuple "str" str + , Tuple "string?" $ pred1 stringQ + , Tuple "prn" prn + , Tuple "println" println + , Tuple "slurp" slurp + , Tuple "readline" readline' + , Tuple "read-string" readString + , Tuple "time-ms" timeMs + + , Tuple "symbol?" $ pred1 symbolQ + , Tuple "symbol" symbol + , Tuple "keyword?" $ pred1 keywordQ + , Tuple "keyword" keyword + + , Tuple "list" list + , Tuple "list?" $ pred1 listQ + , Tuple "nil?" $ pred1 nilQ + , Tuple "empty?" $ pred1 emptyQ + , Tuple "count" count + , Tuple "sequential?" $ pred1 sequentialQ + , Tuple "cons" cons + , Tuple "concat" concat' + , Tuple "nth" nth + , Tuple "first" first + , Tuple "rest" rest + , Tuple "apply" apply' + , Tuple "map" map' + , Tuple "map?" $ pred1 mapQ + , Tuple "conj" conj' + , Tuple "seq" seq + + , Tuple "vec" vec + , Tuple "vector" vector + , Tuple "vector?" $ pred1 vectorQ + + , Tuple "hash-map" hashMap + , Tuple "assoc" assoc + , Tuple "dissoc" dissoc + , Tuple "get" get + , Tuple "contains?" containsQ + , Tuple "keys" keys + , Tuple "vals" vals + + , Tuple "meta" meta + , Tuple "with-meta" withMeta + + , Tuple "atom" atom + , Tuple "atom?" $ pred1 atomQ + , Tuple "deref" deref + , Tuple "reset!" resetB + , Tuple "swap!" swapB + + , Tuple "macro?" $ pred1 macroQ + + , Tuple "fn?" $ pred1 fnQ + ] + + + +-- General functions + +eqQ :: MalFn +eqQ (a:b:Nil) = pure $ MalBoolean $ a == b +eqQ _ = throw "illegal arguments to =" + + + +-- Error/Exception functions + +throw' :: MalFn +throw' (e:Nil) = throw =<< printStrReadably e +throw' _ = throw "illegal arguments to throw" + + + +-- Boolean functions + +trueQ :: MalExpr -> Boolean +trueQ (MalBoolean true) = true +trueQ _ = false + + +falseQ :: MalExpr -> Boolean +falseQ (MalBoolean false) = true +falseQ _ = false + + +-- Numeric functions + +numOp ∷ (Number → Number → Number) → MalFn +numOp op (MalInt n1 : MalInt n2 : Nil) = pure $ MalInt $ ceil $ op (toNumber n1) (toNumber n2) +numOp op (MalInt n1 : MalTime n2 : Nil) = pure $ MalInt $ ceil $ op (toNumber n1) n2 +numOp op (MalTime n1 : MalInt n2 : Nil) = pure $ MalInt $ ceil $ op n1 (toNumber n2) +numOp op (MalTime n1 : MalTime n2 : Nil) = pure $ MalTime $ op n1 n2 +numOp _ _ = throw "invalid operator" + + +cmpOp ∷ (Number → Number → Boolean) → List MalExpr → Effect MalExpr +cmpOp op (MalInt n1 : MalInt n2 : Nil) = pure $ MalBoolean $ op (toNumber n1) (toNumber n2) +cmpOp op (MalInt n1 : MalTime n2 : Nil) = pure $ MalBoolean $ op (toNumber n1) n2 +cmpOp op (MalTime n1 : MalInt n2 : Nil) = pure $ MalBoolean $ op n1 (toNumber n2) +cmpOp op (MalTime n1 : MalTime n2 : Nil) = pure $ MalBoolean $ op n1 n2 +cmpOp _ _ = throw "invalid operator" + + +numberQ :: MalExpr -> Boolean +numberQ (MalInt _) = true +numberQ (MalTime _) = true +numberQ _ = false + + + +-- String functions + +prStr :: MalFn +prStr a = liftEffect $ MalString <$> printList a + + +str :: MalFn +str a = liftEffect $ MalString <$> printListReadably "" a + + +stringQ :: MalExpr -> Boolean +stringQ (MalString "") = true +stringQ (MalString s) = take 1 s /= ":" +stringQ _ = false + + +prn :: MalFn +prn args = liftEffect $ do + log =<< printList args + pure MalNil + + +println :: MalFn +println args = liftEffect $ do + log =<< printListReadably " " args + pure MalNil + + +slurp :: MalFn +slurp (MalString path : Nil) = MalString <$> liftEffect (readTextFile UTF8 path) +slurp _ = throw "invalid arguments to slurp" + + +readline' :: MalFn +readline' (MalString prompt : Nil) = MalString <$> readLine prompt +readline' _ = throw "invalid arguments to readline" + + +readString :: MalFn +readString (MalString s : Nil) = readStr s +readString _ = throw "invalid read-string" + + +timeMs :: MalFn +timeMs Nil = do + n <- now + pure $ MalTime $ (unwap <<< toDuration <<< unInstant) n + where + + unwap :: Milliseconds -> Number + unwap (Milliseconds n) = n + +timeMs _ = throw "invalid time-ms" + + + +-- Scalar functions + +symbolQ :: MalExpr -> Boolean +symbolQ (MalSymbol _) = true +symbolQ _ = false + + +symbol :: MalFn +symbol (MalString s : Nil) = pure $ MalSymbol s +symbol _ = throw "symbol called with non-string" + + +keywordQ :: MalExpr -> Boolean +keywordQ (MalKeyword s) = take 1 s == ":" +keywordQ _ = false + + +keyword :: MalFn +keyword (kw@(MalString s) : Nil) | take 1 s == ":" = pure kw +keyword (MalString s : Nil) = pure $ MalKeyword (":" <> s) +keyword (kw@(MalKeyword s) : Nil) | take 1 s == ":" = pure kw +keyword (MalKeyword s : Nil) = pure $ MalKeyword (":" <> s) +keyword _ = throw "keyword called with non-string" + + + +-- List functions + +list :: MalFn +list = pure <<< toList + + +listQ :: MalExpr -> Boolean +listQ (MalList _ _ ) = true +listQ _ = false + + +nilQ :: MalExpr -> Boolean +nilQ MalNil = true +nilQ _ = false + + +emptyQ :: MalExpr -> Boolean +emptyQ (MalList _ Nil) = true +emptyQ (MalVector _ Nil) = true +emptyQ _ = false + + +count :: MalFn +count (MalNil:Nil) = pure $ MalInt 0 +count (MalList _ ex : Nil) = pure $ MalInt $ length ex +count (MalVector _ ex : Nil) = pure $ MalInt $ length ex +count _ = throw "non-sequence passed to count" + + +sequentialQ :: MalExpr -> Boolean +sequentialQ (MalList _ _) = true +sequentialQ (MalVector _ _) = true +sequentialQ _ = false + + +cons :: MalFn +cons (x:Nil) = pure $ toList $ x:Nil +cons (x : MalList _ xs : Nil) = pure $ toList $ x:xs +cons (x : MalVector _ xs : Nil) = pure $ toList $ x:xs +cons _ = throw "illegal call to cons" + + +concat' :: MalFn +concat' args = toList <<< concat <$> traverse unwrapSeq args + where + + unwrapSeq :: MalExpr -> Effect (List MalExpr) + unwrapSeq (MalList _ xs) = pure xs + unwrapSeq (MalVector _ xs) = pure xs + unwrapSeq _ = throw "invalid concat" + + +nth :: MalFn +nth (MalList _ xs : MalInt n : Nil) = + case drop n xs of + x:_ -> pure x + Nil -> throw "nth: index out of range" +nth (MalVector _ xs : MalInt n : Nil) = + case drop n xs of + x:_ -> pure x + Nil -> throw "nth: index out of range" +nth _ = throw "invalid call to nth" + + +first :: MalFn +first (MalNil:Nil) = pure MalNil +first (MalList _ Nil : Nil) = pure MalNil +first (MalList _ (x:_) : Nil) = pure x +first (MalVector _ Nil : Nil) = pure MalNil +first (MalVector _ (x:_) : Nil) = pure x +first _ = throw "illegal call to first" + + +rest :: MalFn +rest (MalNil:Nil) = pure $ toList Nil +rest (MalList _ Nil : Nil) = pure $ toList Nil +rest (MalList _ (_:xs) : Nil) = pure $ toList xs +rest (MalVector _ Nil : Nil) = pure $ toList Nil +rest (MalVector _ (_:xs) : Nil) = pure $ toList xs +rest _ = throw "illegal call to rest" + + +apply' :: MalFn +apply' (MalFunction {fn:f} : as) = f =<< concatLast as + where + concatLast :: List MalExpr -> Effect (List MalExpr) + concatLast (MalList _ lst : Nil) = pure lst + concatLast (MalVector _ lst : Nil) = pure lst + concatLast (x:xs) = (:) x <$> concatLast xs + concatLast _ = throw "last argument of apply must be a sequence" +apply' _ = throw "Illegal call to apply" + + +map' :: MalFn +map' (MalFunction {fn:f} : MalList _ args : Nil) = toList <$> traverse (\x -> f (x:Nil)) args +map' (MalFunction {fn:f} : MalVector _ args : Nil) = toList <$> traverse (\x -> f (x:Nil)) args +map' _ = throw "Illegal call to map" + + +mapQ :: MalExpr -> Boolean +mapQ (MalHashMap _ _) = true +mapQ _ = false + + +conj' :: MalFn +conj' (MalList _ es : args) = pure $ toList $ reverse args <> es +conj' (MalVector _ es : args) = pure $ toVector $ es <> args +conj' _ = throw "illegal arguments to conj" + + +seq :: MalFn +seq (MalNil:Nil) = pure MalNil +seq (MalList _ Nil : Nil) = pure MalNil +seq (MalList _ es : Nil) = pure $ toList es +seq (MalVector _ Nil : Nil) = pure MalNil +seq (MalVector _ es : Nil) = pure $ toList es +seq (MalString "" : Nil) = pure MalNil +seq (MalString s : Nil) = pure $ toList $ map (MalString <<< singleton) (stringToCharList s) +seq _ = throw "seq: called on non-sequence" + + + +-- Vector functions + +vec :: MalFn +vec (MalList _ xs : Nil) = pure $ toVector xs +vec (MalVector _ xs : Nil) = pure $ toVector xs +vec Nil = throw "vec: arg type" +vec _ = throw "vec: arg type" + + +vector :: MalFn +vector = pure <<< toVector + + +vectorQ :: MalExpr -> Boolean +vectorQ (MalVector _ _) = true +vectorQ _ = false + + + +-- Hash Map functions + +hashMap :: MalFn +hashMap kvs = + case keyValuePairs kvs of + Just pairs -> pure $ toHashMap $ Map.fromFoldable pairs + Nothing -> throw "invalid call to hash-map" + + +assoc :: MalFn +assoc (MalHashMap _ hm : kvs) = + case keyValuePairs kvs of + Just pairs -> pure $ toHashMap $ Map.union (Map.fromFoldable pairs) hm + Nothing -> throw "invalid assoc" +assoc _ = throw "invalid call to assoc" + + +dissoc :: MalFn +dissoc (MalHashMap _ hm : ks) = toHashMap <$> foldM remover hm ks + where + remover :: Map.Map Key MalExpr -> MalExpr -> Effect (Map.Map Key MalExpr) + remover m (MalKeyword k) = pure $ Map.delete (KeywordKey k) m + remover m (MalString k) = pure $ Map.delete (StringKey k) m + remover _ _ = throw "invalid dissoc" +dissoc _ = throw "invalid call to dissoc" + + +get :: MalFn +get (MalHashMap _ hm : MalString k : Nil) = + pure case Map.lookup (StringKey k) hm of + Just mv -> mv + Nothing -> MalNil +get (MalHashMap _ hm : MalKeyword k : Nil) = + pure case Map.lookup (KeywordKey k) hm of + Just mv -> mv + Nothing -> MalNil +get (MalNil : MalString _ : Nil) = pure MalNil +get _ = throw "invalid call to get" + + +containsQ :: MalFn +containsQ (MalHashMap _ hm : MalString k : Nil) = pure $ MalBoolean $ Map.member (StringKey k) hm +containsQ (MalHashMap _ hm : MalKeyword k : Nil) = pure $ MalBoolean $ Map.member (KeywordKey k) hm +containsQ (MalNil : MalString _ : Nil) = pure $ MalBoolean false +containsQ _ = throw "invalid call to contains?" + + +keys :: MalFn +keys (MalHashMap _ hm : Nil) = pure $ toList $ keyToString <$> Map.keys hm +keys _ = throw "invalid call to keys" + + +vals :: MalFn +vals (MalHashMap _ hm : Nil) = pure $ toList $ Map.values hm +vals _ = throw "invalid call to vals" + + + +-- Metadata functions + +meta :: MalFn +meta (MalList (Meta m) _ : Nil) = pure m +meta (MalVector (Meta m) _ : Nil) = pure m +meta (MalHashMap (Meta m) _ : Nil) = pure m +meta (MalAtom (Meta m) _ : Nil) = pure m +meta (MalFunction {meta:m} : Nil) = pure m +meta _ = throw "invalid meta call" + + +withMeta :: MalFn +withMeta (MalList _ es : m : Nil) = pure $ MalList (Meta m) es +withMeta (MalVector _ es : m : Nil) = pure $ MalVector (Meta m) es +withMeta (MalHashMap _ es : m : Nil) = pure $ MalHashMap (Meta m) es +withMeta (MalAtom _ es : m : Nil) = pure $ MalAtom (Meta m) es +withMeta ((MalFunction f) : m : Nil) = pure $ MalFunction $ f {meta = m} +withMeta _ = throw "invalid with-meta call" + + + +-- Atom functions + +atom :: MalFn +atom (v:Nil) = toAtom <$> liftEffect (Ref.new v) +atom _ = throw "invalid atom call" + + +atomQ :: MalExpr -> Boolean +atomQ (MalAtom _ _) = true +atomQ _ = false + + +deref :: MalFn +deref (MalAtom _ ref : Nil) = liftEffect $ Ref.read ref +deref _ = throw "invalid deref call" + + +resetB :: MalFn +resetB (MalAtom _ ref : val : Nil) = liftEffect $ Ref.write val ref *> pure val +resetB _ = throw "invalid reset!" + + +swapB :: MalFn +swapB (MalAtom _ ref : MalFunction {fn:f} : args) = do + val <- liftEffect $ Ref.read ref + newVal <- f $ val:args + liftEffect $ Ref.write newVal ref + pure newVal +swapB _ = throw "Illegal swap!" + + + +-- Macro + +macroQ :: MalExpr -> Boolean +macroQ (MalFunction {macro:true}) = true +macroQ _ = false + + + +-- Function + +fnQ :: MalExpr -> Boolean +fnQ (MalFunction {macro:false}) = true +fnQ _ = false + + + +-- Utils + +pred1 :: (MalExpr -> Boolean) -> MalFn +pred1 f (x:Nil) = pure $ MalBoolean $ f x +pred1 _ _ = throw "illegal call to unary predicate" \ No newline at end of file diff --git a/impls/purs/src/Env.purs b/impls/purs/src/Env.purs new file mode 100644 index 0000000000..b75e71e0b5 --- /dev/null +++ b/impls/purs/src/Env.purs @@ -0,0 +1,46 @@ +module Env where + +import Prelude + +import Data.List (List(..), (:)) +import Data.Map (fromFoldable, insert, lookup) +import Data.Maybe (Maybe(..)) +import Effect (Effect) +import Effect.Console (error) +import Effect.Ref as Ref +import Types (Local, MalExpr, RefEnv, toList) + + + +-- Environment + +initEnv :: Local +initEnv = fromFoldable Nil + + +newEnv :: RefEnv -> Effect RefEnv +newEnv re = flip (:) re <$> Ref.new initEnv + + + +-- VARIABLE + +get :: RefEnv -> String -> Effect (Maybe MalExpr) +get Nil _ = pure Nothing +get (ref:outer) ky = do + envs <- Ref.read ref + case lookup ky envs of + Nothing -> get outer ky + ex -> pure ex + + +sets :: RefEnv -> List String -> List MalExpr -> Effect Boolean +sets _ Nil Nil = pure true +sets env ("&":k:Nil) exs = set env k (toList exs) *> pure true +sets env (ky:kys) (ex:exs) = set env ky ex *> sets env kys exs +sets _ _ _ = pure false + + +set :: RefEnv -> String -> MalExpr -> Effect Unit +set (re:_) ky ex = Ref.modify_ (insert ky ex) re +set Nil _ _ = error "assertion failed in env_set" \ No newline at end of file diff --git a/impls/purs/src/Printer.purs b/impls/purs/src/Printer.purs new file mode 100644 index 0000000000..d9011e05e9 --- /dev/null +++ b/impls/purs/src/Printer.purs @@ -0,0 +1,82 @@ +module Printer where + +import Prelude + +import Data.List (List(..), (:)) +import Data.Map (toUnfoldable) +import Data.Maybe (Maybe(..)) +import Data.String.CodeUnits (singleton) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Ref as Ref +import Types (Key(..), MalExpr(..), flatTuples, flatStrings, stringToCharList) + + + +-- PRINT STRING + +printStr :: MalExpr -> Effect String +printStr MalNil = pure "nil" +printStr (MalBoolean b) = pure $ show b +printStr (MalInt n) = pure $ show n +printStr (MalTime n) = pure $ show n +printStr (MalString str) = pure $ "\"" <> (str # stringToCharList # map unescape # flatStrings) <> "\"" +printStr (MalKeyword key) = pure key +printStr (MalAtom _ r) = "(atom " <<> (Ref.read r >>= printStr) <>> ")" +printStr (MalSymbol name) = pure name +printStr (MalList _ xs) = "(" <<> printList xs <>> ")" +printStr (MalVector _ vs) = "[" <<> printList vs <>> "]" +printStr (MalHashMap _ hm) = "{" <<> (hm # toUnfoldable # flatTuples # printList) <>> "}" +printStr (MalFunction _) = pure "#" + + +printList :: List MalExpr -> Effect String +printList Nil = pure "" +printList (x:Nil) = printStr x +printList (x:xs) = printStr x <> pure " " <> printList xs + + + +-- PRINT STRING READABLY + +printStrReadably :: MalExpr -> Effect String +printStrReadably (MalString str) = pure str +printStrReadably (MalList _ xs) = "(" <<> printListReadably " " xs <>> ")" +printStrReadably (MalVector _ vs) = "[" <<> printListReadably " " vs <>> "]" +printStrReadably (MalHashMap _ hm) = "{" <<> (hm # toUnfoldable # flatTuples # printListReadably " ") <>> "}" +printStrReadably ex = printStr ex + + +printListReadably :: String -> List MalExpr -> Effect String +printListReadably _ Nil = pure "" +printListReadably _ (x:Nil) = printStrReadably x +printListReadably sep (x:xs) = printStrReadably x <> pure sep <> printListReadably sep xs + + + +-- UTILS + +unescape :: Char -> String +unescape '\n' = "\\n" +unescape '\\' = "\\\\" +unescape '"' = "\\\"" +unescape c = singleton c + + +keyValuePairs :: List MalExpr -> Maybe (List (Tuple Key MalExpr)) +keyValuePairs Nil = pure Nil +keyValuePairs (MalString k : v : kvs) = (:) (Tuple (StringKey k) v) <$> keyValuePairs kvs +keyValuePairs (MalKeyword k : v : kvs) = (:) (Tuple (KeywordKey k) v) <$> keyValuePairs kvs +keyValuePairs _ = Nothing + + +leftConcat :: forall m s. Bind m => Applicative m => Semigroup s => s -> m s -> m s +leftConcat op f = (<>) <$> pure op <*> f + +infixr 5 leftConcat as <<> + + +rightConcat :: forall m s. Apply m => Semigroup s => Applicative m => m s -> s -> m s +rightConcat f cl = (<>) <$> f <*> pure cl + +infixr 5 rightConcat as <>> \ No newline at end of file diff --git a/impls/purs/src/Reader.purs b/impls/purs/src/Reader.purs new file mode 100644 index 0000000000..03e4795553 --- /dev/null +++ b/impls/purs/src/Reader.purs @@ -0,0 +1,173 @@ +module Reader (readStr) where + +import Prelude + +import Control.Alt ((<|>)) +import Control.Lazy (fix) +import Data.Either (Either(..)) +import Data.Int (fromString) +import Data.List (List(..), many, (:)) +import Data.Maybe (Maybe(..), fromMaybe) +import Effect (Effect) +import Effect.Exception (throw) +import Printer (keyValuePairs) +import Text.Parsing.Parser (Parser, fail, runParser) +import Text.Parsing.Parser.Combinators (endBy, skipMany, skipMany1, try) +import Text.Parsing.Parser.String (char, noneOf, oneOf, string) +import Text.Parsing.Parser.Token (digit, letter) +import Types (MalExpr(..), charListToString, listToMap, toHashMap, toList, toVector) + + +spaces :: Parser String Unit +spaces = skipMany1 $ oneOf [',', ' ', '\n'] + + +comment :: Parser String Unit +comment = char ';' *> (skipMany $ noneOf [ '\r', '\n' ]) + + +ignored :: Parser String Unit +ignored = skipMany $ spaces <|> comment + + +symbol :: Parser String Char +symbol = oneOf ['!', '#', '$', '%', '&', '|', '*', '+', '-', '/', ':', '<', '=', '>', '?', '@', '^', '_', '~'] + + +nat :: Parser String Int +nat = do + first <- digit + rest <- many digit + pure <<< fromMaybe 0 <<< fromString <<< charListToString $ first : rest + + +escape :: Parser String Char +escape = char '\\' + *> oneOf ['\\', '\"', 'n'] + <#> case _ of + 'n' -> '\n' + x -> x + + +nonEscape :: Parser String Char +nonEscape = noneOf [ '\"', '\\' ] + + + +-- ATOM + +readAtom :: Parser String MalExpr +readAtom = readNumber + <|> try readNegativeNumber + <|> readString + <|> readKeyword + <|> readSymbol + + +readNumber :: Parser String MalExpr +readNumber = MalInt <$> nat + + +readNegativeNumber :: Parser String MalExpr +readNegativeNumber = MalInt <<< negate <$> (char '-' *> nat) + + +readString :: Parser String MalExpr +readString = MalString <$> charListToString <$> (char '"' *> many (escape <|> nonEscape) <* char '"') + + +readKeyword :: Parser String MalExpr +readKeyword = + MalKeyword <$> charListToString + <$> ((:) ':') + <$> (char ':' *> many (letter <|> digit <|> symbol)) + + +readSymbol :: Parser String MalExpr +readSymbol = f <$> (letter <|> symbol) <*> many (letter <|> digit <|> symbol) + where + + f first rest = charListToString (first:rest) + # case _ of + "true" -> MalBoolean true + "false" -> MalBoolean false + "nil" -> MalNil + s -> MalSymbol s + + + +-- + +readList :: Parser String MalExpr +readList = fix $ \_ -> + toList <$> (char '(' *> ignored *> endBy readForm ignored <* char ')') + + + +-- + +readVector :: Parser String MalExpr +readVector = fix $ \_ -> + toVector <$> (char '[' *> ignored *> endBy readForm ignored <* char ']') + + + +-- + +readHashMap :: Parser String MalExpr +readHashMap = fix $ \_ + -> char '{' *> ignored *> endBy readForm ignored <* char '}' + <#> keyValuePairs + >>= case _ of + Just ts -> pure $ toHashMap $ listToMap ts + Nothing -> fail "invalid contents inside map braces" + + + +-- MACROS + +readMacro :: Parser String MalExpr +readMacro = fix $ \_ -> + macro "\'" "quote" + <|> macro "`" "quasiquote" + <|> try (macro "~@" "splice-unquote") + <|> macro "~" "unquote" + <|> macro "@" "deref" + <|> readWithMeta + + +macro :: String -> String -> Parser String MalExpr +macro tok sym = addPrefix sym <$> (string tok *> readForm) + where + + addPrefix :: String -> MalExpr -> MalExpr + addPrefix s x = toList $ MalSymbol s : x : Nil + + +readWithMeta :: Parser String MalExpr +readWithMeta = addPrefix <$> (char '^' *> readForm) <*> readForm + where + + addPrefix :: MalExpr -> MalExpr -> MalExpr + addPrefix m x = toList $ MalSymbol "with-meta" : x : m : Nil + + + +-- + +readForm :: Parser String MalExpr +readForm = fix $ \_ -> ignored + *> ( readMacro + <|> readList + <|> readVector + <|> readHashMap + <|> readAtom) + + + +-- + +readStr :: String -> Effect MalExpr +readStr str = case runParser str readForm of + Left _ -> throw "EOF" + Right val -> pure val \ No newline at end of file diff --git a/impls/purs/src/Readline.js b/impls/purs/src/Readline.js new file mode 100644 index 0000000000..34620123ed --- /dev/null +++ b/impls/purs/src/Readline.js @@ -0,0 +1,17 @@ +"use strict"; + +var readlineSync = require('readline-sync') + +exports.readLine = function (x) { + return function () { + const result = readlineSync.question(x); + + if(readlineSync.getRawInput() === String.fromCharCode(0)){ + return ":q" + } + return result; + } +} + + +exports.argv = process.argv; \ No newline at end of file diff --git a/impls/purs/src/Readline.purs b/impls/purs/src/Readline.purs new file mode 100644 index 0000000000..960a7e5e99 --- /dev/null +++ b/impls/purs/src/Readline.purs @@ -0,0 +1,16 @@ +module Readline where + +import Prelude + +import Data.List (List, drop, fromFoldable) +import Effect (Effect) + + + +foreign import readLine :: String -> Effect String + + +foreign import argv :: Array String + +args :: List String +args = drop 2 $ fromFoldable argv \ No newline at end of file diff --git a/impls/purs/src/Types.purs b/impls/purs/src/Types.purs new file mode 100644 index 0000000000..32c184f969 --- /dev/null +++ b/impls/purs/src/Types.purs @@ -0,0 +1,135 @@ +module Types where + +import Prelude + +import Data.Array as Array +import Data.Foldable (class Foldable) +import Data.List (List(..), foldr, (:)) +import Data.List as List +import Data.Map (Map) +import Data.Map.Internal as Map +import Data.Maybe (Maybe(..)) +import Data.String.CodeUnits (fromCharArray, toCharArray) +import Data.Traversable (foldl) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Ref (Ref) +import Effect.Ref as Ref + + +data MalExpr + = MalNil + | MalBoolean Boolean + | MalInt Int + | MalTime Time + | MalString String + | MalKeyword String + | MalSymbol String + | MalAtom Meta (Ref MalExpr) + | MalList Meta (List MalExpr) + | MalVector Meta (List MalExpr) + | MalHashMap Meta (Map Key MalExpr) + | MalFunction { fn :: MalFn + , ast :: MalExpr + , env :: RefEnv + , params :: List String + , macro :: Boolean + , meta :: MalExpr + } + +type Time = Number + + +instance Eq MalExpr where + eq MalNil MalNil = true + eq (MalBoolean a) (MalBoolean b) = a == b + eq (MalInt a) (MalInt b) = a == b + eq (MalTime a) (MalTime b) = a == b + eq (MalString a) (MalString b) = a == b + eq (MalKeyword a) (MalKeyword b) = a == b + eq (MalSymbol a) (MalSymbol b) = a == b + + eq (MalList _ a) (MalList _ b) = a == b + eq (MalVector _ a) (MalList _ b) = a == b + eq (MalList _ a) (MalVector _ b) = a == b + + eq (MalVector _ a) (MalVector _ b) = a == b + eq (MalHashMap _ a) (MalHashMap _ b) = a == b + eq _ _ = false + + +data Key = StringKey String + | KeywordKey String + +derive instance Eq Key +derive instance Ord Key + + +type MalFn = List MalExpr -> Effect MalExpr + + +type Local = Map String MalExpr +type RefEnv = List (Ref.Ref Local) + + + +-- Metas + +newtype Meta = Meta MalExpr + + +toList :: List MalExpr -> MalExpr +toList = MalList (Meta MalNil) + + +toVector :: List MalExpr -> MalExpr +toVector = MalVector (Meta MalNil) + + +toAtom :: Ref MalExpr -> MalExpr +toAtom = MalAtom (Meta MalNil) + + +toHashMap :: Map Key MalExpr -> MalExpr +toHashMap = MalHashMap (Meta MalNil) + + + +-- Utils + +listToMap :: List (Tuple Key MalExpr) -> Map Key MalExpr +listToMap = Map.fromFoldable + + +charListToString :: List Char -> String +charListToString = fromCharArray <<< Array.fromFoldable + + +stringToCharList :: String -> List Char +stringToCharList = List.fromFoldable <<< toCharArray + + +flatStrings :: List String -> String +flatStrings = foldr (<>) "" + + +flatTuples :: List (Tuple Key MalExpr) -> List MalExpr +flatTuples ((Tuple (StringKey a) b) : xs) = MalString a : b : flatTuples xs +flatTuples ((Tuple (KeywordKey a) b) : xs) = MalKeyword a : b : flatTuples xs +flatTuples _ = Nil + + +foldrM :: forall a m b f. Foldable f => Monad m => (a -> b -> m b) -> b -> f a -> m b +foldrM f z0 xs = foldl c pure xs z0 + where c k x z = f x z >>= k + + +keyToString :: Key -> MalExpr +keyToString (StringKey k) = MalString k +keyToString (KeywordKey k) = MalKeyword k + + +keyValuePairs :: List MalExpr -> Maybe (List (Tuple String MalExpr)) +keyValuePairs Nil = pure Nil +keyValuePairs (MalString k : v : kvs) = (:) (Tuple k v) <$> keyValuePairs kvs +keyValuePairs _ = Nothing \ No newline at end of file diff --git a/impls/purs/src/step0_repl.purs b/impls/purs/src/step0_repl.purs new file mode 100644 index 0000000000..f9cc6be1de --- /dev/null +++ b/impls/purs/src/step0_repl.purs @@ -0,0 +1,51 @@ +module Mal.Step0 where + +import Prelude +import Effect (Effect) +import Effect.Console (log) +import Readline (readLine) + + +-- MAIN + +main :: Effect Unit +main = loop + + + +-- EVAL + +eval :: String -> String +eval s = s + + + +-- REPL + +rep :: String -> String +rep = read >>> eval >>> print + +loop :: Effect Unit +loop = do + line <- readLine "user> " + case line of + "" -> loop + ":q" -> pure unit + _ -> do + log line + loop + + + +-- READ + +read :: String -> String +read s = s + + + +-- PRINT + +print :: String -> String +print s = s + diff --git a/impls/purs/src/step1_read_print.purs b/impls/purs/src/step1_read_print.purs new file mode 100644 index 0000000000..13c104e893 --- /dev/null +++ b/impls/purs/src/step1_read_print.purs @@ -0,0 +1,61 @@ +module Mal.Step1 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Data.Either (Either(..)) +import Effect (Effect) +import Effect.Console (error, log) +import Printer (printStr) +import Reader (readStr) +import Readline (readLine) +import Types (MalExpr) + + +-- MAIN + +main :: Effect Unit +main = loop + + + +-- EVAL + +eval :: MalExpr -> MalExpr +eval s = s + + + +-- REPL + +rep :: String -> Effect Unit +rep str = do + result <- try $ read str + case result of + Left err -> error $ show err + Right exp -> print (eval exp) >>= log + + +loop :: Effect Unit +loop = do + line <- readLine "user> " + case line of + "" -> loop + ":q" -> pure unit + _ -> do + rep line + loop + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr \ No newline at end of file diff --git a/impls/purs/src/step2_eval.purs b/impls/purs/src/step2_eval.purs new file mode 100644 index 0000000000..fc77088349 --- /dev/null +++ b/impls/purs/src/step2_eval.purs @@ -0,0 +1,108 @@ +module Mal.Step2 where + +import Prelude + +import Data.Either (Either(..)) +import Data.List (List(..), (:)) +import Data.Map (Map, lookup) +import Data.Map as Map +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Console (error, log) +import Effect.Exception (throw, try) +import Reader (readStr) +import Printer (printStr) +import Readline (readLine) +import Types (MalExpr(..), MalFn, toHashMap, toVector) + + +-- MAIN + +main :: Effect Unit +main = loop + + + +-- EVAL + +evalCallFn :: List MalExpr -> Effect MalExpr +evalCallFn ast = do + es <- traverse eval ast + case es of + MalFunction {fn:f}: args -> f args + _ -> throw $ "invalid function" + + +eval :: MalExpr -> Effect MalExpr +eval (MalSymbol s) = case lookup s replEnv of + Just f -> pure f + Nothing -> throw "invalid function" +eval (MalList _ es@(_ : _)) = evalCallFn es +eval (MalVector _ es) = toVector <$> (traverse eval es) +eval (MalHashMap _ es) = toHashMap <$> (traverse eval es) +eval ast = pure ast + + + +-- ENV + +type ReplEnv = Map String MalExpr + +replEnv :: ReplEnv +replEnv = Map.fromFoldable + [ (Tuple "+" (fn (+))) + , (Tuple "-" (fn (-))) + , (Tuple "*" (fn (*))) + , (Tuple "/" (fn (/))) + ] + +fn :: (Int -> Int -> Int) -> MalExpr +fn op = + MalFunction + { fn : g op + , ast : MalNil + , env : Nil + , params : Nil + , macro : false + , meta : MalNil + } + where + g :: (Int -> Int -> Int) -> MalFn + g op' ((MalInt n1) : (MalInt n2) : Nil) = pure $ MalInt $ op' n1 n2 + g _ _ = throw "invalid operator" + + + +-- REPL + +rep :: String -> Effect Unit +rep str = do + result <- try $ eval =<< read str + case result of + Left err -> error $ show err + Right exp -> print exp >>= log + + +loop :: Effect Unit +loop = do + line <- readLine "user> " + case line of + "" -> loop + ":q" -> pure unit + _ -> rep line *> loop + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr \ No newline at end of file diff --git a/impls/purs/src/step3_env.purs b/impls/purs/src/step3_env.purs new file mode 100644 index 0000000000..68820b4739 --- /dev/null +++ b/impls/purs/src/step3_env.purs @@ -0,0 +1,150 @@ +module Mal.Step3 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Data.Either (Either(..)) +import Data.List (List(..), (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse) +import Effect (Effect) +import Effect.Console (error, log) +import Effect.Exception (throw) +import Env as Env +import Reader (readStr) +import Printer (printStr) +import Readline (readLine) +import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toVector) + + +-- MAIN + +main :: Effect Unit +main = do + re <- Env.newEnv Nil + setArithOp re + loop re + + + +-- EVAL + +evalCallFn :: RefEnv -> List MalExpr -> Effect MalExpr +evalCallFn env ast = do + es <- traverse (eval env) ast + case es of + MalFunction {fn:f} : args -> f args + _ -> throw "invalid function" + + +eval :: RefEnv -> MalExpr -> Effect MalExpr +eval env ast = do + dbgeval <- Env.get env "DEBUG-EVAL" + case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ es@(_ : _) -> evalCallFn env es + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + +evalDef :: RefEnv -> List MalExpr -> Effect MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + +evalLet :: RefEnv -> List MalExpr -> Effect MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + +letBind :: RefEnv -> List MalExpr -> Effect Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + Env.set env ky =<< eval env e + letBind env es +letBind _ _ = throw "invalid let*" + + + +-- REPL + +rep :: RefEnv -> String -> Effect String +rep env str = print =<< eval env =<< read str + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setArithOp :: RefEnv -> Effect Unit +setArithOp env = do + Env.set env "+" =<< fn (+) + Env.set env "-" =<< fn (-) + Env.set env "*" =<< fn (*) + Env.set env "/" =<< fn (/) + + +fn :: (Int -> Int -> Int) -> Effect MalExpr +fn op = do + newEnv <- Env.newEnv Nil + pure $ MalFunction + { fn : g op + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + where + + g :: (Int -> Int -> Int) -> MalFn + g op' ((MalInt n1) : (MalInt n2) : Nil) = pure $ MalInt $ op' n1 n2 + g _ _ = throw "invalid operator" + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr \ No newline at end of file diff --git a/impls/purs/src/step4_if_fn_do.purs b/impls/purs/src/step4_if_fn_do.purs new file mode 100644 index 0000000000..8a208f1a44 --- /dev/null +++ b/impls/purs/src/step4_if_fn_do.purs @@ -0,0 +1,196 @@ +module Mal.Step4 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Core as Core +import Data.Either (Either(..)) +import Data.List (List(..), foldM, (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Console (error, log) +import Effect.Exception (throw) +import Env as Env +import Reader (readStr) +import Printer (printStr) +import Readline (readLine) +import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toVector) + + + +-- MAIN + +main :: Effect Unit +main = do + re <- Env.newEnv Nil + _ <- traverse (setFn re) Core.ns + _ <- rep re "(def! not (fn* (a) (if a false true)))" + loop re + + + +-- EVAL + +evalCallFn :: RefEnv -> List MalExpr -> Effect MalExpr +evalCallFn env ast = do + es <- traverse (eval env) ast + case es of + MalFunction {fn:f} : args -> f args + _ -> throw "invalid function" + + +eval :: RefEnv -> MalExpr -> Effect MalExpr +eval env ast = do + dbgeval <- Env.get env "DEBUG-EVAL" + case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ (MalSymbol "if" : es) -> evalIf env es + MalList _ (MalSymbol "do" : es) -> evalDo env es + MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es + MalList _ es@(_ : _) -> evalCallFn env es + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + +evalDef :: RefEnv -> List MalExpr -> Effect MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + +evalLet :: RefEnv -> List MalExpr -> Effect MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + + +letBind :: RefEnv -> List MalExpr -> Effect Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + Env.set env ky =<< eval env e + letBind env es +letBind _ _ = throw "invalid let*" + + +evalIf :: RefEnv -> List MalExpr -> Effect MalExpr +evalIf env (b:t:e:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> e + MalBoolean false -> e + _ -> t +evalIf env (b:t:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> MalNil + MalBoolean false -> MalNil + _ -> t +evalIf _ _ = throw "invalid if" + + +evalDo :: RefEnv -> List MalExpr -> Effect MalExpr +evalDo env es = foldM (const $ eval env) MalNil es + + +evalFnMatch :: RefEnv -> List MalExpr -> Effect MalExpr +evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body +evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body +evalFnMatch _ _ = throw "invalid fn*" + + +evalFn :: RefEnv -> List MalExpr -> MalExpr -> Effect MalExpr +evalFn env params body = do + paramsStr <- traverse unwrapSymbol params + pure $ MalFunction { fn : fn paramsStr body + , ast : body + , env : env + , params : paramsStr + , macro : false + , meta : MalNil + } + where + + fn :: List String -> MalExpr -> MalFn + fn params' body' = \args -> do + fnEnv <- Env.newEnv env + ok <- Env.sets fnEnv params' args + if ok + then eval fnEnv body' + else throw "actual parameters do not match signature " + + unwrapSymbol :: MalExpr -> Effect String + unwrapSymbol (MalSymbol s) = pure s + unwrapSymbol _ = throw "fn* parameter must be symbols" + + + +-- REPL + +rep :: RefEnv -> String -> Effect String +rep env str = print =<< eval env =<< read str + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setFn :: RefEnv -> Tuple String MalFn -> Effect Unit +setFn env (Tuple sym f) = do + newEnv <- Env.newEnv Nil + Env.set env sym $ MalFunction + { fn : f + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr \ No newline at end of file diff --git a/impls/purs/src/step5_tco.purs b/impls/purs/src/step5_tco.purs new file mode 100644 index 0000000000..14870f5fff --- /dev/null +++ b/impls/purs/src/step5_tco.purs @@ -0,0 +1,235 @@ +module Mal.Step5 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Control.Monad.Free.Trans (FreeT, runFreeT) +import Control.Monad.Rec.Class (class MonadRec) +import Core as Core +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.List (List(..), foldM, (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse, traverse_) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Console (error, log) +import Effect.Exception as Ex +import Env as Env +import Printer (printStr) +import Reader (readStr) +import Readline (readLine) +import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toVector) + + +-- TYPES + +type Eval a = FreeT Identity Effect a + + + +-- MAIN + +main :: Effect Unit +main = do + re <- Env.newEnv Nil + traverse_ (setFn re) Core.ns + rep_ re "(def! not (fn* (a) (if a false true)))" + loop re + + + +-- EVAL + +eval :: RefEnv -> MalExpr -> Eval MalExpr +eval env ast = do + dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") + liftEffect case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- liftEffect $ Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ (MalSymbol "if" : es) -> evalIf env es + MalList _ (MalSymbol "do" : es) -> evalDo env es + MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es + MalList _ es@(_ : _) -> evalCallFn env es + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + +evalDef :: RefEnv -> List MalExpr -> Eval MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + liftEffect $ Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + +evalLet :: RefEnv -> List MalExpr -> Eval MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + + +letBind :: RefEnv -> List MalExpr -> Eval Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + ex <- eval env e + liftEffect $ Env.set env ky ex + letBind env es +letBind _ _ = throw "invalid let*" + + +evalIf :: RefEnv -> List MalExpr -> Eval MalExpr +evalIf env (b:t:e:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> e + MalBoolean false -> e + _ -> t +evalIf env (b:t:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> MalNil + MalBoolean false -> MalNil + _ -> t +evalIf _ _ = throw "invalid if" + + +evalDo :: RefEnv -> List MalExpr -> Eval MalExpr +evalDo env es = foldM (const $ eval env) MalNil es + + +evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr +evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body +evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body +evalFnMatch _ _ = throw "invalid fn*" + + +evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr +evalFn env params body = do + paramsStr <- traverse unwrapSymbol params + pure $ MalFunction { fn : fn paramsStr body + , ast : body + , env : env + , params : paramsStr + , macro : false + , meta : MalNil + } + where + + fn :: List String -> MalExpr -> MalFn + fn params' body' = \args -> do + fnEnv <- Env.newEnv env + ok <- Env.sets fnEnv params' args + if ok + then runEval $ eval fnEnv body' + else throw "actual parameters do not match signature " + + unwrapSymbol :: MalExpr -> Eval String + unwrapSymbol (MalSymbol s) = pure s + unwrapSymbol _ = throw "fn* parameter must be symbols" + + + +-- REPL + +rep_ :: RefEnv -> String -> Effect Unit +rep_ env str = rep env str *> pure unit + + +rep :: RefEnv -> String -> Effect String +rep env str = do + ast <- read str + result <- runEval $ eval env ast + print result + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setFn :: RefEnv -> Tuple String MalFn -> Effect Unit +setFn env (Tuple sym f) = do + newEnv <- Env.newEnv Nil + Env.set env sym $ MalFunction + { fn : f + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + + + +-- CALL FUNCTION + +evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr +evalCallFn env ast = do + es <- traverse (eval env) ast + case es of + MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args + MalFunction {ast:ast', params:params', env:env'} : args -> do + newEnv <- liftEffect $ Env.newEnv env' + _ <- liftEffect $ Env.sets newEnv params' args + eval newEnv ast' + _ -> throw "invalid function" + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr + + + +-- Utils + +runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a +runEval = runFreeT $ pure <<< runIdentity + + +runIdentity :: ∀ a. Identity a -> a +runIdentity (Identity a) = a + + +throw :: ∀ m a. MonadEffect m => String -> m a +throw = liftEffect <<< Ex.throw \ No newline at end of file diff --git a/impls/purs/src/step6_file.purs b/impls/purs/src/step6_file.purs new file mode 100644 index 0000000000..c612f5f47e --- /dev/null +++ b/impls/purs/src/step6_file.purs @@ -0,0 +1,248 @@ +module Mal.Step6 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Control.Monad.Free.Trans (FreeT, runFreeT) +import Control.Monad.Rec.Class (class MonadRec) +import Core as Core +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.List (List(..), foldM, (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse, traverse_) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Console (error, log) +import Effect.Exception as Ex +import Env as Env +import Printer (printStr) +import Reader (readStr) +import Readline (args, readLine) +import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toList, toVector) + + +-- TYPES + +type Eval a = FreeT Identity Effect a + + + +-- MAIN + +main :: Effect Unit +main = do + env <- Env.newEnv Nil + traverse_ (setFn env) Core.ns + setFn env $ Tuple "eval" $ setEval env + rep_ env "(def! not (fn* (a) (if a false true)))" + rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + case args of + Nil -> do + Env.set env "*ARGV*" $ toList Nil + loop env + script:scriptArgs -> do + Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs + rep_ env $ "(load-file \"" <> script <> "\")" + + + +-- REPL + +rep_ :: RefEnv -> String -> Effect Unit +rep_ env str = rep env str *> pure unit + + +rep :: RefEnv -> String -> Effect String +rep env str = do + ast <- read str + result <- runEval $ eval env ast + print result + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setFn :: RefEnv -> Tuple String MalFn -> Effect Unit +setFn env (Tuple sym f) = do + newEnv <- Env.newEnv Nil + Env.set env sym $ MalFunction + { fn : f + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + + +setEval :: RefEnv -> MalFn +setEval env (ast:Nil) = runEval $ eval env ast +setEval _ _ = throw "illegal call of eval" + + + +-- EVAL + +eval :: RefEnv -> MalExpr -> Eval MalExpr +eval env ast = do + dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") + liftEffect case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- liftEffect $ Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ (MalSymbol "if" : es) -> evalIf env es + MalList _ (MalSymbol "do" : es) -> evalDo env es + MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es + MalList _ es@(_ : _) -> evalCallFn env es + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + +evalDef :: RefEnv -> List MalExpr -> Eval MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + liftEffect $ Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + +evalLet :: RefEnv -> List MalExpr -> Eval MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + + +letBind :: RefEnv -> List MalExpr -> Eval Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + ex <- eval env e + liftEffect $ Env.set env ky ex + letBind env es +letBind _ _ = throw "invalid let*" + + +evalIf :: RefEnv -> List MalExpr -> Eval MalExpr +evalIf env (b:t:e:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> e + MalBoolean false -> e + _ -> t +evalIf env (b:t:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> MalNil + MalBoolean false -> MalNil + _ -> t +evalIf _ _ = throw "invalid if" + + +evalDo :: RefEnv -> List MalExpr -> Eval MalExpr +evalDo env es = foldM (const $ eval env) MalNil es + + +evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr +evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body +evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body +evalFnMatch _ _ = throw "invalid fn*" + + +evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr +evalFn env params body = do + paramsStr <- traverse unwrapSymbol params + pure $ MalFunction { fn : fn paramsStr body + , ast : body + , env : env + , params : paramsStr + , macro : false + , meta : MalNil + } + where + + fn :: List String -> MalExpr -> MalFn + fn params' body' = \args -> do + fnEnv <- Env.newEnv env + ok <- Env.sets fnEnv params' args + if ok + then runEval $ eval fnEnv body' + else throw "actual parameters do not match signature " + + unwrapSymbol :: MalExpr -> Eval String + unwrapSymbol (MalSymbol s) = pure s + unwrapSymbol _ = throw "fn* parameter must be symbols" + + + +-- CALL FUNCTION + +evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr +evalCallFn env ast = do + es <- traverse (eval env) ast + case es of + MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args + MalFunction {ast:ast', params:params', env:env'} : args -> do + newEnv <- liftEffect $ Env.newEnv env' + _ <- liftEffect $ Env.sets newEnv params' args + eval newEnv ast' + _ -> throw "invalid function" + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr + + + +-- Utils + +runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a +runEval = runFreeT $ pure <<< runIdentity + + +runIdentity :: ∀ a. Identity a -> a +runIdentity (Identity a) = a + + +throw :: ∀ m a. MonadEffect m => String -> m a +throw = liftEffect <<< Ex.throw \ No newline at end of file diff --git a/impls/purs/src/step7_quote.purs b/impls/purs/src/step7_quote.purs new file mode 100644 index 0000000000..1cd938e710 --- /dev/null +++ b/impls/purs/src/step7_quote.purs @@ -0,0 +1,296 @@ +module Mal.Step7 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Control.Monad.Free.Trans (FreeT, runFreeT) +import Control.Monad.Rec.Class (class MonadRec) +import Core as Core +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.List (List(..), foldM, (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse, traverse_) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Console (error, log) +import Effect.Exception as Ex +import Env as Env +import Printer (printStr) +import Reader (readStr) +import Readline (args, readLine) +import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) + + +-- TYPES + +type Eval a = FreeT Identity Effect a + + +-- MAIN + +main :: Effect Unit +main = do + env <- Env.newEnv Nil + traverse_ (setFn env) Core.ns + setFn env $ Tuple "eval" $ setEval env + rep_ env "(def! not (fn* (a) (if a false true)))" + rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + case args of + Nil -> do + Env.set env "*ARGV*" $ toList Nil + loop env + script:scriptArgs -> do + Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs + rep_ env $ "(load-file \"" <> script <> "\")" + + + +-- REPL + +rep_ :: RefEnv -> String -> Effect Unit +rep_ env str = rep env str *> pure unit + + +rep :: RefEnv -> String -> Effect String +rep env str = do + ast <- read str + result <- runEval $ eval env ast + print result + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setFn :: RefEnv -> Tuple String MalFn -> Effect Unit +setFn env (Tuple sym f) = do + newEnv <- Env.newEnv Nil + Env.set env sym $ MalFunction + { fn : f + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + + +setEval :: RefEnv -> MalFn +setEval env (ast:Nil) = runEval $ eval env ast +setEval _ _ = throw "illegal call of eval" + + + +-- EVAL + +eval :: RefEnv -> MalExpr -> Eval MalExpr +eval env ast = do + dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") + liftEffect case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- liftEffect $ Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ (MalSymbol "if" : es) -> evalIf env es + MalList _ (MalSymbol "do" : es) -> evalDo env es + MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es + MalList _ (MalSymbol "quote" : es) -> evalQuote env es + MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es + MalList _ es@(_ : _) -> evalCallFn env es + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + + +-- Def + +evalDef :: RefEnv -> List MalExpr -> Eval MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + liftEffect $ Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + + +-- Let + +evalLet :: RefEnv -> List MalExpr -> Eval MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + +letBind :: RefEnv -> List MalExpr -> Eval Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + ex <- eval env e + liftEffect $ Env.set env ky ex + letBind env es +letBind _ _ = throw "invalid let*" + + + +-- If + +evalIf :: RefEnv -> List MalExpr -> Eval MalExpr +evalIf env (b:t:e:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> e + MalBoolean false -> e + _ -> t +evalIf env (b:t:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> MalNil + MalBoolean false -> MalNil + _ -> t +evalIf _ _ = throw "invalid if" + + + +-- Do + +evalDo :: RefEnv -> List MalExpr -> Eval MalExpr +evalDo env es = foldM (const $ eval env) MalNil es + + + +-- Function + +evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr +evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body +evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body +evalFnMatch _ _ = throw "invalid fn*" + + +evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr +evalFn env params body = do + paramsStr <- traverse unwrapSymbol params + pure $ MalFunction { fn : fn paramsStr body + , ast : body + , env : env + , params : paramsStr + , macro : false + , meta : MalNil + } + where + + fn :: List String -> MalExpr -> MalFn + fn params' body' = \args -> do + fnEnv <- Env.newEnv env + ok <- Env.sets fnEnv params' args + if ok + then runEval $ eval fnEnv body' + else throw "actual parameters do not match signature " + + unwrapSymbol :: MalExpr -> Eval String + unwrapSymbol (MalSymbol s) = pure s + unwrapSymbol _ = throw "fn* parameter must be symbols" + + + +-- Quote + +evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuote _ (e:Nil) = pure e +evalQuote _ _ = throw "invalid quote" + + +evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuasiquote env (e:Nil) = eval env =<< quasiquote e +evalQuasiquote _ _ = throw "invalid quasiquote" + + +quasiquote :: MalExpr -> Eval MalExpr +quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x +quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" +quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs +quasiquote (MalVector _ xs) = do + lst <- foldrM qqIter (toList Nil) xs + pure $ toList $ MalSymbol "vec" : lst : Nil +quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast = pure ast + + +qqIter :: MalExpr -> MalExpr -> Eval MalExpr +qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil +qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + pure $ toList $ MalSymbol "cons" : qqted : acc : Nil + + + +-- CALL FUNCTION + +evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr +evalCallFn env ast = do + es <- traverse (eval env) ast + case es of + MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args + MalFunction {ast:ast', params:params', env:env'} : args -> do + newEnv <- liftEffect $ Env.newEnv env' + _ <- liftEffect $ Env.sets newEnv params' args + eval newEnv ast' + _ -> throw "invalid function" + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr + + + +-- Utils + +runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a +runEval = runFreeT $ pure <<< runIdentity + + +runIdentity :: ∀ a. Identity a -> a +runIdentity (Identity a) = a + + +throw :: ∀ m a. MonadEffect m => String -> m a +throw = liftEffect <<< Ex.throw \ No newline at end of file diff --git a/impls/purs/src/step8_macros.purs b/impls/purs/src/step8_macros.purs new file mode 100644 index 0000000000..1fbb214beb --- /dev/null +++ b/impls/purs/src/step8_macros.purs @@ -0,0 +1,318 @@ +module Mal.Step8 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Control.Monad.Free.Trans (FreeT, runFreeT) +import Control.Monad.Rec.Class (class MonadRec) +import Core as Core +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.List (List(..), foldM, (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse, traverse_) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Console (error, log) +import Effect.Exception as Ex +import Env as Env +import Printer (printStr) +import Reader (readStr) +import Readline (args, readLine) +import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) + + +-- TYPES + +type Eval a = FreeT Identity Effect a + + +-- MAIN + +main :: Effect Unit +main = do + env <- Env.newEnv Nil + traverse_ (setFn env) Core.ns + setFn env $ Tuple "eval" $ setEval env + rep_ env "(def! not (fn* (a) (if a false true)))" + rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + rep_ env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + case args of + Nil -> do + Env.set env "*ARGV*" $ toList Nil + loop env + script:scriptArgs -> do + Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs + rep_ env $ "(load-file \"" <> script <> "\")" + + + +-- REPL + +rep_ :: RefEnv -> String -> Effect Unit +rep_ env str = rep env str *> pure unit + + +rep :: RefEnv -> String -> Effect String +rep env str = do + ast <- read str + result <- runEval $ eval env ast + print result + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setFn :: RefEnv -> Tuple String MalFn -> Effect Unit +setFn env (Tuple sym f) = do + newEnv <- Env.newEnv Nil + Env.set env sym $ MalFunction + { fn : f + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + + +setEval :: RefEnv -> MalFn +setEval env (ast:Nil) = runEval $ eval env ast +setEval _ _ = throw "illegal call of eval" + + + +-- EVAL + +eval :: RefEnv -> MalExpr -> Eval MalExpr +eval env ast = do + dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") + liftEffect case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- liftEffect $ Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ (MalSymbol "if" : es) -> evalIf env es + MalList _ (MalSymbol "do" : es) -> evalDo env es + MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es + MalList _ (MalSymbol "quote" : es) -> evalQuote env es + MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es + MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es + MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + + +-- DEF + +evalDef :: RefEnv -> List MalExpr -> Eval MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + liftEffect $ Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + + +-- LET + +evalLet :: RefEnv -> List MalExpr -> Eval MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + +letBind :: RefEnv -> List MalExpr -> Eval Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + ex <- eval env e + liftEffect $ Env.set env ky ex + letBind env es +letBind _ _ = throw "invalid let*" + + + +-- IF + +evalIf :: RefEnv -> List MalExpr -> Eval MalExpr +evalIf env (b:t:e:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> e + MalBoolean false -> e + _ -> t +evalIf env (b:t:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> MalNil + MalBoolean false -> MalNil + _ -> t +evalIf _ _ = throw "invalid if" + + + +-- DO + +evalDo :: RefEnv -> List MalExpr -> Eval MalExpr +evalDo env es = foldM (const $ eval env) MalNil es + + + +-- FUNCTION + +evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr +evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body +evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body +evalFnMatch _ _ = throw "invalid fn*" + + +evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr +evalFn env params body = do + paramsStr <- traverse unwrapSymbol params + pure $ MalFunction { fn : fn paramsStr body + , ast : body + , env : env + , params : paramsStr + , macro : false + , meta : MalNil + } + where + + fn :: List String -> MalExpr -> MalFn + fn params' body' = \args -> do + fnEnv <- Env.newEnv env + ok <- Env.sets fnEnv params' args + if ok + then runEval $ eval fnEnv body' + else throw "actual parameters do not match signature " + + unwrapSymbol :: MalExpr -> Eval String + unwrapSymbol (MalSymbol s) = pure s + unwrapSymbol _ = throw "fn* parameter must be symbols" + + + +-- QUOTE + +evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuote _ (e:Nil) = pure e +evalQuote _ _ = throw "invalid quote" + + +evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuasiquote env (e:Nil) = eval env =<< quasiquote e +evalQuasiquote _ _ = throw "invalid quasiquote" + + +quasiquote :: MalExpr -> Eval MalExpr +quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x +quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" +quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs +quasiquote (MalVector _ xs) = do + lst <- foldrM qqIter (toList Nil) xs + pure $ toList $ MalSymbol "vec" : lst : Nil +quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast = pure ast + + +qqIter :: MalExpr -> MalExpr -> Eval MalExpr +qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil +qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + pure $ toList $ MalSymbol "cons" : qqted : acc : Nil + + + +-- MACRO + +evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr +evalDefmacro env (MalSymbol a : b : Nil) = do + f <- eval env b + case f of + MalFunction fn@{macro:false} -> do + let m = MalFunction $ fn {macro = true} + liftEffect $ Env.set env a m + pure m + _ -> throw "defmacro! on non-function" +evalDefmacro _ _ = throw "invalid defmacro!" + + +-- CALL FUNCTION + +evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr +evalCallFn env rawFunc rawArgs = do + func <- eval env rawFunc + case func of + MalFunction {fn:f, macro:true} -> do + newAst <- liftEffect $ f rawArgs + eval env newAst + MalFunction {fn:f, ast:MalNil} -> do + args <- traverse (eval env) rawArgs + liftEffect $ f args + MalFunction {ast:ast', params:params', env:env'} -> do + args <- traverse (eval env) rawArgs + newEnv <- liftEffect $ Env.newEnv env' + _ <- liftEffect $ Env.sets newEnv params' args + eval newEnv ast' + _ -> throw "invalid function" + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr + + + +-- Utils + +runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a +runEval = runFreeT $ pure <<< runIdentity + + +runIdentity :: ∀ a. Identity a -> a +runIdentity (Identity a) = a + + +throw :: ∀ m a. MonadEffect m => String -> m a +throw = liftEffect <<< Ex.throw \ No newline at end of file diff --git a/impls/purs/src/step9_try.purs b/impls/purs/src/step9_try.purs new file mode 100644 index 0000000000..14f20911ed --- /dev/null +++ b/impls/purs/src/step9_try.purs @@ -0,0 +1,337 @@ +module Mal.Step9 where + +import Prelude + +import Control.Monad.Error.Class (try) +import Control.Monad.Free.Trans (FreeT, runFreeT) +import Control.Monad.Rec.Class (class MonadRec) +import Core as Core +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.List (List(..), foldM, (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse, traverse_) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Console (error, log) +import Effect.Exception as Ex +import Env as Env +import Printer (printStr) +import Reader (readStr) +import Readline (args, readLine) +import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) + + + +-- TYPES + +type Eval a = FreeT Identity Effect a + + + +-- MAIN + +main :: Effect Unit +main = do + env <- Env.newEnv Nil + traverse_ (setFn env) Core.ns + setFn env $ Tuple "eval" $ setEval env + rep_ env "(def! not (fn* (a) (if a false true)))" + rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + rep_ env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + case args of + Nil -> do + Env.set env "*ARGV*" $ toList Nil + loop env + script:scriptArgs -> do + Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs + rep_ env $ "(load-file \"" <> script <> "\")" + + + +-- REPL + +rep_ :: RefEnv -> String -> Effect Unit +rep_ env str = rep env str *> pure unit + + +rep :: RefEnv -> String -> Effect String +rep env str = do + ast <- read str + result <- runEval $ eval env ast + print result + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setFn :: RefEnv -> Tuple String MalFn -> Effect Unit +setFn env (Tuple sym f) = do + newEnv <- Env.newEnv Nil + Env.set env sym $ MalFunction + { fn : f + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + + +setEval :: RefEnv -> MalFn +setEval env (ast:Nil) = runEval $ eval env ast +setEval _ _ = throw "illegal call of eval" + + + +-- EVAL + +eval :: RefEnv -> MalExpr -> Eval MalExpr +eval env ast = do + dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") + liftEffect case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- liftEffect $ Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ (MalSymbol "if" : es) -> evalIf env es + MalList _ (MalSymbol "do" : es) -> evalDo env es + MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es + MalList _ (MalSymbol "quote" : es) -> evalQuote env es + MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es + MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es + MalList _ (MalSymbol "try*" : es) -> liftEffect $ evalTry env es + MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + + +-- Def + +evalDef :: RefEnv -> List MalExpr -> Eval MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + liftEffect $ Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + + +-- Let + +evalLet :: RefEnv -> List MalExpr -> Eval MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + +letBind :: RefEnv -> List MalExpr -> Eval Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + ex <- eval env e + liftEffect $ Env.set env ky ex + letBind env es +letBind _ _ = throw "invalid let*" + + + +-- If + +evalIf :: RefEnv -> List MalExpr -> Eval MalExpr +evalIf env (b:t:e:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> e + MalBoolean false -> e + _ -> t +evalIf env (b:t:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> MalNil + MalBoolean false -> MalNil + _ -> t +evalIf _ _ = throw "invalid if" + + + +-- Do + +evalDo :: RefEnv -> List MalExpr -> Eval MalExpr +evalDo env es = foldM (const $ eval env) MalNil es + + + +-- Function + +evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr +evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body +evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body +evalFnMatch _ _ = throw "invalid fn*" + + +evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr +evalFn env params body = do + paramsStr <- traverse unwrapSymbol params + pure $ MalFunction { fn : fn paramsStr body + , ast : body + , env : env + , params : paramsStr + , macro : false + , meta : MalNil + } + where + + fn :: List String -> MalExpr -> MalFn + fn params' body' = \args -> do + fnEnv <- Env.newEnv env + ok <- Env.sets fnEnv params' args + if ok + then runEval $ eval fnEnv body' + else throw "actual parameters do not match signature " + + unwrapSymbol :: MalExpr -> Eval String + unwrapSymbol (MalSymbol s) = pure s + unwrapSymbol _ = throw "fn* parameter must be symbols" + + + +-- Quote + +evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuote _ (e:Nil) = pure e +evalQuote _ _ = throw "invalid quote" + + +evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuasiquote env (e:Nil) = eval env =<< quasiquote e +evalQuasiquote _ _ = throw "invalid quasiquote" + + +quasiquote :: MalExpr -> Eval MalExpr +quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x +quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" +quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs +quasiquote (MalVector _ xs) = do + lst <- foldrM qqIter (toList Nil) xs + pure $ toList $ MalSymbol "vec" : lst : Nil +quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast = pure ast + + +qqIter :: MalExpr -> MalExpr -> Eval MalExpr +qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil +qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + pure $ toList $ MalSymbol "cons" : qqted : acc : Nil + + + +-- Macro + +evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr +evalDefmacro env (MalSymbol a : b : Nil) = do + f <- eval env b + case f of + MalFunction fn@{macro:false} -> do + let m = MalFunction $ fn {macro = true} + liftEffect $ Env.set env a m + pure m + _ -> throw "defmacro! on non-function" +evalDefmacro _ _ = throw "invalid defmacro!" + + +-- Try + +evalTry :: RefEnv -> List MalExpr -> Effect MalExpr +evalTry env (a:Nil) = runEval $ eval env a +evalTry env (thw : MalList _ (MalSymbol "catch*" : MalSymbol e : b : Nil) : Nil) = do + res <- try $ runEval $ eval env thw + case res of + Left err -> do + tryEnv <- Env.newEnv env + Env.set tryEnv e $ MalString $ Ex.message err -- FIXME: + runEval $ eval tryEnv b + Right v -> pure v +evalTry _ _ = Ex.throw "invalid try*" + + + +-- CALL FUNCTION + +evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr +evalCallFn env rawFunc rawArgs = do + func <- eval env rawFunc + case func of + MalFunction {fn:f, macro:true} -> do + newAst <- liftEffect $ f rawArgs + eval env newAst + MalFunction {fn:f, ast:MalNil} -> do + args <- traverse (eval env) rawArgs + liftEffect $ f args + MalFunction {ast:ast', params:params', env:env'} -> do + args <- traverse (eval env) rawArgs + newEnv <- liftEffect $ Env.newEnv env' + _ <- liftEffect $ Env.sets newEnv params' args + eval newEnv ast' + _ -> throw "invalid function" + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr + + + +-- Utils + +runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a +runEval = runFreeT $ pure <<< runIdentity + + +runIdentity :: ∀ a. Identity a -> a +runIdentity (Identity a) = a + + +throw :: ∀ m a. MonadEffect m => String -> m a +throw = liftEffect <<< Ex.throw \ No newline at end of file diff --git a/impls/purs/src/stepA_mal.purs b/impls/purs/src/stepA_mal.purs new file mode 100644 index 0000000000..9fded3caa7 --- /dev/null +++ b/impls/purs/src/stepA_mal.purs @@ -0,0 +1,340 @@ +module Mal.StepA where + +import Prelude + +import Control.Monad.Error.Class (try) +import Control.Monad.Free.Trans (FreeT, runFreeT) +import Control.Monad.Rec.Class (class MonadRec) +import Core as Core +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.List (List(..), foldM, (:)) +import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse, traverse_) +import Data.Tuple (Tuple(..)) +import Effect (Effect) +import Effect.Class (class MonadEffect, liftEffect) +import Effect.Console (error, log) +import Effect.Exception as Ex +import Env as Env +import Printer (printStr) +import Reader (readStr) +import Readline (args, readLine) +import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) + + + +-- TYPES + +type Eval a = FreeT Identity Effect a + + + +-- MAIN + +main :: Effect Unit +main = do + let as = args + env <- Env.newEnv Nil + traverse_ (setFn env) Core.ns + setFn env (Tuple "eval" $ setEval env) + rep_ env "(def! *host-language* \"purescript\")" + rep_ env "(def! not (fn* (a) (if a false true)))" + rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + rep_ env "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" + case as of + Nil -> do + Env.set env "*ARGV*" $ toList Nil + rep_ env "(println (str \"Mal [\" *host-language* \"]\"))" + loop env + script:args -> do + Env.set env "*ARGV*" $ toList $ MalString <$> args + rep_ env $ "(load-file \"" <> script <> "\")" + + + +-- REPL + +rep_ :: RefEnv -> String -> Effect Unit +rep_ env str = rep env str *> pure unit + + +rep :: RefEnv -> String -> Effect String +rep env str = do + ast <- read str + result <- runEval $ eval env ast + print result + + +loop :: RefEnv -> Effect Unit +loop env = do + line <- readLine "user> " + case line of + "" -> loop env + ":q" -> pure unit + _ -> do + result <- try $ rep env line + case result of + Right exp -> log exp + Left err -> error $ show err + loop env + + +setFn :: RefEnv -> Tuple String MalFn -> Effect Unit +setFn env (Tuple sym f) = do + newEnv <- Env.newEnv Nil + Env.set env sym $ MalFunction + { fn : f + , ast : MalNil + , env : newEnv + , params : Nil + , macro : false + , meta : MalNil + } + + +setEval :: RefEnv -> MalFn +setEval env (ast:Nil) = runEval $ eval env ast +setEval _ _ = throw "illegal call of eval" + + + +-- EVAL + +eval :: RefEnv -> MalExpr -> Eval MalExpr +eval env ast = do + dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") + liftEffect case dbgeval of + Nothing -> pure unit + Just MalNil -> pure unit + Just (MalBoolean false) -> pure unit + _ -> do + image <- print ast + log ("EVAL: " <> image) + case ast of + MalSymbol s -> do + result <- liftEffect $ Env.get env s + case result of + Just k -> pure k + Nothing -> throw $ "'" <> s <> "'" <> " not found" + MalList _ (MalSymbol "def!" : es) -> evalDef env es + MalList _ (MalSymbol "let*" : es) -> evalLet env es + MalList _ (MalSymbol "if" : es) -> evalIf env es + MalList _ (MalSymbol "do" : es) -> evalDo env es + MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es + MalList _ (MalSymbol "quote" : es) -> evalQuote env es + MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es + MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es + MalList _ (MalSymbol "try*" : es) -> liftEffect $ evalTry env es + MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs + MalVector _ es -> toVector <$> traverse (eval env) es + MalHashMap _ es -> toHashMap <$> traverse (eval env) es + _ -> pure ast + + + +-- Def + +evalDef :: RefEnv -> List MalExpr -> Eval MalExpr +evalDef env (MalSymbol v : e : Nil) = do + evd <- eval env e + liftEffect $ Env.set env v evd + pure evd +evalDef _ _ = throw "invalid def!" + + + +-- Let + +evalLet :: RefEnv -> List MalExpr -> Eval MalExpr +evalLet env (MalList _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet env (MalVector _ ps : e : Nil) = do + letEnv <- liftEffect $ Env.newEnv env + letBind letEnv ps + eval letEnv e +evalLet _ _ = throw "invalid let*" + + +letBind :: RefEnv -> List MalExpr -> Eval Unit +letBind _ Nil = pure unit +letBind env (MalSymbol ky : e : es) = do + ex <- eval env e + liftEffect $ Env.set env ky ex + letBind env es +letBind _ _ = throw "invalid let*" + + + +-- If + +evalIf :: RefEnv -> List MalExpr -> Eval MalExpr +evalIf env (b:t:e:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> e + MalBoolean false -> e + _ -> t +evalIf env (b:t:Nil) = do + cond <- eval env b + eval env case cond of + MalNil -> MalNil + MalBoolean false -> MalNil + _ -> t +evalIf _ _ = throw "invalid if" + + + +-- Do + +evalDo :: RefEnv -> List MalExpr -> Eval MalExpr +evalDo env es = foldM (const $ eval env) MalNil es + + + +-- Function + +evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr +evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body +evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body +evalFnMatch _ _ = throw "invalid fn*" + + +evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr +evalFn env params body = do + paramsStr <- traverse unwrapSymbol params + pure $ MalFunction { fn : fn paramsStr body + , ast : body + , env : env + , params : paramsStr + , macro : false + , meta : MalNil + } + where + + fn :: List String -> MalExpr -> MalFn + fn params' body' = \args -> do + fnEnv <- Env.newEnv env + ok <- Env.sets fnEnv params' args + if ok + then runEval $ eval fnEnv body' + else throw "actual parameters do not match signature " + + unwrapSymbol :: MalExpr -> Eval String + unwrapSymbol (MalSymbol s) = pure s + unwrapSymbol _ = throw "fn* parameter must be symbols" + + + +-- Quote + +evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuote _ (e:Nil) = pure e +evalQuote _ _ = throw "invalid quote" + + +evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr +evalQuasiquote env (e:Nil) = eval env =<< quasiquote e +evalQuasiquote _ _ = throw "invalid quasiquote" + + +quasiquote :: MalExpr -> Eval MalExpr +quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x +quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" +quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs +quasiquote (MalVector _ xs) = do + lst <- foldrM qqIter (toList Nil) xs + pure $ toList $ MalSymbol "vec" : lst : Nil +quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil +quasiquote ast = pure ast + + +qqIter :: MalExpr -> MalExpr -> Eval MalExpr +qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil +qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + pure $ toList $ MalSymbol "cons" : qqted : acc : Nil + + + +-- Macro + +evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr +evalDefmacro env (MalSymbol a : b : Nil) = do + f <- eval env b + case f of + MalFunction fn@{macro:false} -> do + let m = MalFunction $ fn {macro = true} + liftEffect $ Env.set env a m + pure m + _ -> throw "defmacro! on non-function" +evalDefmacro _ _ = throw "invalid defmacro!" + + +-- Try + +evalTry :: RefEnv -> List MalExpr -> Effect MalExpr +evalTry env (a:Nil) = runEval $ eval env a +evalTry env (thw : MalList _ (MalSymbol "catch*" : MalSymbol e : b : Nil) : Nil) = do + res <- try $ runEval $ eval env thw + case res of + Left err -> do + tryEnv <- Env.newEnv env + Env.set tryEnv e $ MalString $ Ex.message err -- FIXME: + runEval $ eval tryEnv b + Right v -> pure v +evalTry _ _ = Ex.throw "invalid try*" + + + +-- CALL FUNCTION + +evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr +evalCallFn env rawFunc rawArgs = do + func <- eval env rawFunc + case func of + MalFunction {fn:f, macro:true} -> do + newAst <- liftEffect $ f rawArgs + eval env newAst + MalFunction {fn:f, ast:MalNil} -> do + args <- traverse (eval env) rawArgs + liftEffect $ f args + MalFunction {ast:ast', params:params', env:env'} -> do + args <- traverse (eval env) rawArgs + newEnv <- liftEffect $ Env.newEnv env' + _ <- liftEffect $ Env.sets newEnv params' args + eval newEnv ast' + _ -> throw "invalid function" + + + +-- READ + +read :: String -> Effect MalExpr +read = readStr + + + +-- PRINT + +print :: MalExpr -> Effect String +print = printStr + + + +-- Utils + +runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a +runEval = runFreeT $ pure <<< runIdentity + + +runIdentity :: ∀ a. Identity a -> a +runIdentity (Identity a) = a + + +throw :: ∀ m a. MonadEffect m => String -> m a +throw = liftEffect <<< Ex.throw \ No newline at end of file diff --git a/impls/python2/Dockerfile b/impls/python2/Dockerfile new file mode 100644 index 0000000000..ee4d7777e5 --- /dev/null +++ b/impls/python2/Dockerfile @@ -0,0 +1,25 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install python2 + +# For dist packaging +RUN apt-get -y install zip diff --git a/impls/python2/Makefile b/impls/python2/Makefile new file mode 100644 index 0000000000..2403ecd25f --- /dev/null +++ b/impls/python2/Makefile @@ -0,0 +1,22 @@ +SOURCES_BASE = mal_readline.py mal_types.py reader.py printer.py +SOURCES_LISP = env.py core.py stepA_mal.py +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.pyz mal + +SHELL := bash +mal.pyz: $(SOURCES) + cp stepA_mal.py __main__.py + zip -q - __main__.py $+ > $@ + rm __main__.py + +mal: mal.pyz + echo '#!/usr/bin/env python' > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.pyz mal diff --git a/impls/python2/core.py b/impls/python2/core.py new file mode 100644 index 0000000000..a013bba4c8 --- /dev/null +++ b/impls/python2/core.py @@ -0,0 +1,199 @@ +import operator +import time +from itertools import chain + +import mal_types as types +from mal_types import MalException, List, Vector +import mal_readline +import reader +import printer + +# Errors/Exceptions +def throw(obj): raise MalException(obj) + + +# String functions +def pr_str(*args): + return printer.pr_list(args, " ", True) + +def do_str(*args): + return printer.pr_list(args, "", False) + +def prn(*args): + print(printer.pr_list(args, " ", True)) + return None + +def println(*args): + print(printer.pr_list(args, " ", False)) + return None + +def core_readline(prompt): + try: + return mal_readline.readline(prompt) + except EOFError: + return None + +def slurp(path): + with open(path) as f: + return f.read() + +# Hash map functions +def assoc(src_hm, *key_vals): + hm = types.Hash_Map(src_hm) + hm.update(types.asPairs(key_vals)) + return hm + +def dissoc(src_hm, *keys): + hm = types.Hash_Map(src_hm) + for key in keys: + hm.pop(key, None) + return hm + +def get(hm, key): + if hm is not None: + return hm.get(key) + else: + return None + +contains_Q = types.Hash_Map.__contains__ + +keys = List + +def vals(hm): return List(hm.values()) + + +# Sequence functions +def cons(x, seq): return concat((x,), seq) + +def concat(*lsts): return List(chain(*lsts)) + +nth = tuple.__getitem__ + +def first(lst): + if lst: + return lst[0] + else: # lst is nil or empty + return None + +def rest(lst): + if lst: + it = iter(lst) + next(it) + return List(it) + else: # lst is nil or empty + return List() + +empty_Q = operator.not_ + +def count(lst): + if types._nil_Q(lst): return 0 + else: return len(lst) + +def apply(f, *args): return f(*chain(args[:-1], args[-1])) + +def mapf(f, lst): return List(map(f, lst)) + +def conj(lst, *args): + if types._list_Q(lst): + return concat(reversed(args), lst) + else: + return Vector(chain(lst, args)) + +def seq(obj): + if not obj: + return None # obj is nil, (), [] or "" + if types._list_Q(obj): + return obj + elif types._vector_Q(obj) or types._string_Q(obj): + return List(obj) + else: throw ("seq: called on non-sequence") + +# Metadata functions +def with_meta(obj, meta): + new_obj = types._clone(obj) + new_obj.__meta__ = meta + return new_obj + +def meta(obj): + return getattr(obj, "__meta__", None) + + +# Atoms functions +def deref(atm): return atm.val +def reset_BANG(atm,val): + atm.val = val + return atm.val +def swap_BANG(atm,f,*args): + atm.val = f(atm.val,*args) + return atm.val + + +ns = { + '=': types._equal_Q, + 'throw': throw, + 'nil?': types._nil_Q, + 'true?': types._true_Q, + 'false?': types._false_Q, + 'number?': types._number_Q, + 'string?': types._string_Q, + 'symbol': types._symbol, + 'symbol?': types._symbol_Q, + 'keyword': types._keyword, + 'keyword?': types._keyword_Q, + 'fn?': lambda x: (types._function_Q(x) and not hasattr(x, '_ismacro_')), + 'macro?': lambda x: (types._function_Q(x) and + hasattr(x, '_ismacro_')), + + 'pr-str': pr_str, + 'str': do_str, + 'prn': prn, + 'println': println, + 'readline': core_readline, + 'read-string': reader.read_str, + 'slurp': slurp, + '<': operator.lt, + '<=': operator.le, + '>': operator.gt, + '>=': operator.ge, + '+': operator.add, + '-': operator.sub, + '*': operator.mul, + '/': operator.floordiv, + 'time-ms': lambda : int(time.time() * 1000), + + 'list': types._list, + 'list?': types._list_Q, + 'vector': types._vector, + 'vector?': types._vector_Q, + 'hash-map': types._hash_map, + 'map?': types._hash_map_Q, + 'assoc': assoc, + 'dissoc': dissoc, + 'get': get, + 'contains?': contains_Q, + 'keys': keys, + 'vals': vals, + + 'sequential?': types._sequential_Q, + 'cons': cons, + 'concat': concat, + 'vec': Vector, + 'nth': nth, + 'first': first, + 'rest': rest, + 'empty?': empty_Q, + 'count': count, + 'apply': apply, + 'map': mapf, + + 'conj': conj, + 'seq': seq, + + 'with-meta': with_meta, + 'meta': meta, + 'atom': types._atom, + 'atom?': types._atom_Q, + 'deref': deref, + 'reset!': reset_BANG, + 'swap!': swap_BANG, +} diff --git a/impls/python2/env.py b/impls/python2/env.py new file mode 100644 index 0000000000..d20e19fdc8 --- /dev/null +++ b/impls/python2/env.py @@ -0,0 +1,33 @@ +# Environment +from mal_types import List + +class Env(): + def __init__(self, outer=None, binds=None, exprs=None): + """If binds is not None, exprs must be an iterable..""" + self.data = {} + self.outer = outer + + if binds: + exprs_it = iter(exprs) + for i in range(len(binds)): + if binds[i] == "&": + # binds may be a non-list iterable + self.data[binds[i+1]] = List(exprs_it) + break + else: + self.data[binds[i]] = next(exprs_it) + + def set(self, key, value): + self.data[key] = value + return value + + def get(self, key, return_nil=False): + # Python prefers iteration over recursion. + env = self + while key not in env.data: + env = env.outer + if env is None: + if return_nil: + return None + raise Exception("'" + key + "' not found") + return env.data[key] diff --git a/impls/python2/mal_readline.py b/impls/python2/mal_readline.py new file mode 100644 index 0000000000..818c174e28 --- /dev/null +++ b/impls/python2/mal_readline.py @@ -0,0 +1,23 @@ +# Importing this module is sufficient for the 'input' builtin command +# to support readline. + +import atexit +import os.path +from readline import read_history_file, set_history_length, write_history_file +import sys + +if sys.version_info[0] < 3: + _exc = Exception + readline = raw_input +else: + _exc = FileNotFoundError + readline = input + +histfile = os.path.join(os.path.expanduser("~"), ".mal-history") +try: + read_history_file(histfile) +except _exc: + pass +set_history_length(1000) + +atexit.register(write_history_file, histfile) diff --git a/impls/python2/mal_types.py b/impls/python2/mal_types.py new file mode 100644 index 0000000000..d7aade4734 --- /dev/null +++ b/impls/python2/mal_types.py @@ -0,0 +1,104 @@ +import copy + +# General functions + +def _equal_Q(a, b): + if _sequential_Q(a): + return _sequential_Q(b) \ + and len(a) == len(b) \ + and all(_equal_Q(a[k], b[k]) for k in range(len(a))) + elif _hash_map_Q(a): + return _hash_map_Q(b) \ + and len(a) == len(b) \ + and all(k in b and _equal_Q(v, b[k]) for k, v in a.items()) + else: + return type(a) == type(b) \ + and a == b + +def _sequential_Q(seq): return _list_Q(seq) or _vector_Q(seq) + +def _clone(obj): + if callable(obj): + def fn(*args): + return obj(*args) + if hasattr(obj, '__ast__'): + fn.__ast__ = obj.__ast__ + fn.__gen_env__ = obj.__gen_env__ + return fn + return copy.copy(obj) + +# +# Exception type +# + +class MalException(Exception): + def __init__(self, object): + self.object = object + +# Scalars +def _nil_Q(exp): return exp is None +def _true_Q(exp): return exp is True +def _false_Q(exp): return exp is False +def _string_Q(exp): + return type(exp) == str and not exp.startswith(keywordPrefix) +def _number_Q(exp): return type(exp) == int + +# Symbols +class Symbol(str): pass +_symbol = Symbol +def _symbol_Q(exp): return type(exp) == Symbol + +# Keywords +# A specially prefixed string +keywordPrefix = '\x7F' +def _keyword(str): + if str.startswith(keywordPrefix): + return str + else: + return keywordPrefix + str +def _keyword_Q(exp): + return type(exp) == str and exp.startswith(keywordPrefix) + +# Functions +# are just python functions, with +# * no attributes (core functions) +# * __ast__ and __gen_env__ attributes (user-defined functions) +# * __ast__, __gen_env__ and _ismacro_ attributes (macro). +_function_Q = callable + +# lists +class List(tuple): + pass +def _list(*vals): return List(vals) +def _list_Q(exp): return type(exp) == List + + +# vectors +class Vector(tuple): + pass +def _vector(*vals): return Vector(vals) +def _vector_Q(exp): return type(exp) == Vector + +# Hash maps +class Hash_Map(dict): pass +def _hash_map(*key_vals): + return Hash_Map(asPairs(key_vals)) +def _hash_map_Q(exp): return type(exp) == Hash_Map + +def asPairs(iterable): + """ k0, v0, k1, v1.. -> (k0, v0), (k1, v1).. """ + it = iter(iterable) + return zip(it, it) + +# atoms +class Atom(object): + def __init__(self, val): + self.val = val +_atom = Atom +def _atom_Q(exp): return type(exp) == Atom + +def py_to_mal(obj): + if type(obj) == list: return List(obj) + if type(obj) == tuple: return List(obj) + elif type(obj) == dict: return Hash_Map(obj) + else: return obj diff --git a/impls/python2/printer.py b/impls/python2/printer.py new file mode 100644 index 0000000000..435e0f2706 --- /dev/null +++ b/impls/python2/printer.py @@ -0,0 +1,36 @@ +from itertools import chain + +import mal_types as types + +def _escape(s): + return s.replace('\\', '\\\\').replace('"', '\\"').replace('\n', '\\n') + +def _pr_str(obj, print_readably=True): + _r = print_readably + if types._list_Q(obj): + return "(" + pr_list(obj, " ", _r) + ")" + elif types._vector_Q(obj): + return "[" + pr_list(obj, " ", _r) + "]" + elif types._hash_map_Q(obj): + ret = pr_list(chain.from_iterable(obj.items()), " ", _r) + return "{" + ret + "}" + elif types._keyword_Q(obj): + return ':' + obj[1:] + elif types._string_Q(obj): + if _r: + return '"' + _escape(obj) + '"' + else: + return obj + elif types._nil_Q(obj): + return "nil" + elif types._true_Q(obj): + return "true" + elif types._false_Q(obj): + return "false" + elif types._atom_Q(obj): + return "(atom " + _pr_str(obj.val,_r) + ")" + else: + return str(obj) + +def pr_list(iterable, separator, readably): + return separator.join(_pr_str(exp, readably) for exp in iterable) diff --git a/impls/python2/reader.py b/impls/python2/reader.py new file mode 100644 index 0000000000..6f76563870 --- /dev/null +++ b/impls/python2/reader.py @@ -0,0 +1,109 @@ +import re + +from mal_types import (_symbol, _keyword, _list, List, Vector, Hash_Map, asPairs) + +class Blank(Exception): pass + +class Reader(): + def __init__(self, tokens, position=0): + self.tokens = tokens + self.position = position + + def next(self): + self.position += 1 + return self.tokens[self.position-1] + + def peek(self): + if len(self.tokens) > self.position: + return self.tokens[self.position] + else: + return None + +def tokenize(str): + tre = re.compile(r"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:[\\].|[^\\"])*"?|;.*|[^\s\[\]{}()'"`@,;]+)"""); + return [t for t in re.findall(tre, str) if t[0] != ';'] + +def _unescape(s): + return s.replace('\\\\', '\b').replace('\\"', '"').replace('\\n', '\n').replace('\b', '\\') + +def read_atom(reader): + int_re = re.compile(r"-?[0-9]+$") + float_re = re.compile(r"-?[0-9][0-9.]*$") + string_re = re.compile(r'"(?:[\\].|[^\\"])*"') + token = reader.next() + if re.match(int_re, token): return int(token) + elif re.match(float_re, token): return int(token) + elif re.match(string_re, token):return _unescape(token[1:-1]) + elif token[0] == '"': raise Exception("expected '\"', got EOF") + elif token[0] == ':': return _keyword(token[1:]) + elif token == "nil": return None + elif token == "true": return True + elif token == "false": return False + else: return _symbol(token) + +def read_sequence(reader, start='(', end=')'): + token = reader.next() + if token != start: raise Exception("expected '" + start + "'") + + token = reader.peek() + while token != end: + if not token: raise Exception("expected '" + end + "', got EOF") + yield read_form(reader) + token = reader.peek() + reader.next() + +def read_hash_map(reader): + lst = read_sequence(reader, '{', '}') + return Hash_Map(asPairs(lst)) + +def read_list(reader): + return List(read_sequence(reader, '(', ')')) + +def read_vector(reader): + return Vector(read_sequence(reader, '[', ']')) + +def read_form(reader): + token = reader.peek() + # reader macros/transforms + if token[0] == ';': + reader.next() + return None + elif token == '\'': + reader.next() + return _list(_symbol('quote'), read_form(reader)) + elif token == '`': + reader.next() + return _list(_symbol('quasiquote'), read_form(reader)) + elif token == '~': + reader.next() + return _list(_symbol('unquote'), read_form(reader)) + elif token == '~@': + reader.next() + return _list(_symbol('splice-unquote'), read_form(reader)) + elif token == '^': + reader.next() + meta = read_form(reader) + return _list(_symbol('with-meta'), read_form(reader), meta) + elif token == '@': + reader.next() + return _list(_symbol('deref'), read_form(reader)) + + # list + elif token == ')': raise Exception("unexpected ')'") + elif token == '(': return read_list(reader) + + # vector + elif token == ']': raise Exception("unexpected ']'"); + elif token == '[': return read_vector(reader); + + # hash-map + elif token == '}': raise Exception("unexpected '}'"); + elif token == '{': return read_hash_map(reader); + + # atom + else: return read_atom(reader); + +def read_str(str): + tokens = tokenize(str) + if len(tokens) == 0: raise Blank("Blank Line") + return read_form(Reader(tokens)) diff --git a/impls/python2/run b/impls/python2/run new file mode 100755 index 0000000000..095e1963d0 --- /dev/null +++ b/impls/python2/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec python2 $(dirname $0)/${STEP:-stepA_mal}.py "${@}" diff --git a/impls/python2/step0_repl.py b/impls/python2/step0_repl.py new file mode 100644 index 0000000000..328d4b0b08 --- /dev/null +++ b/impls/python2/step0_repl.py @@ -0,0 +1,29 @@ +import sys, traceback +import mal_readline + +# read +def READ(str): + return str + +# eval +def EVAL(ast): + return ast + +# print +def PRINT(exp): + return exp + +# repl +def REP(str): + return PRINT(EVAL(READ(str))) + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except Exception: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python2/step1_read_print.py b/impls/python2/step1_read_print.py new file mode 100644 index 0000000000..c26383db89 --- /dev/null +++ b/impls/python2/step1_read_print.py @@ -0,0 +1,29 @@ +import sys, traceback +import mal_readline +import reader, printer + +# read +READ = reader.read_str + +# eval +def EVAL(ast): + return ast + +# print +PRINT = printer._pr_str + +# repl +def REP(str): + return PRINT(EVAL(READ(str))) + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python2/step2_eval.py b/impls/python2/step2_eval.py new file mode 100644 index 0000000000..ede2ccb512 --- /dev/null +++ b/impls/python2/step2_eval.py @@ -0,0 +1,55 @@ +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer + +# read +READ = reader.read_str + +# eval +def EVAL(ast, env): + # print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + try: + return env[ast] + except: + raise Exception("'" + ast + "' not found") + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + f = EVAL(ast[0], env) + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) + +# print +PRINT = printer._pr_str + +# repl +repl_env = {} +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +repl_env['+'] = lambda a,b: a+b +repl_env['-'] = lambda a,b: a-b +repl_env['*'] = lambda a,b: a*b +repl_env['/'] = lambda a,b: a//b + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python2/step3_env.py b/impls/python2/step3_env.py new file mode 100644 index 0000000000..1bbac127e5 --- /dev/null +++ b/impls/python2/step3_env.py @@ -0,0 +1,72 @@ +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env + +# read +READ = reader.read_str + +# eval +def EVAL(ast, env): + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + return EVAL(a2, let_env) + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +repl_env.set(types._symbol('+'), lambda a,b: a+b) +repl_env.set(types._symbol('-'), lambda a,b: a-b) +repl_env.set(types._symbol('*'), lambda a,b: a*b) +repl_env.set(types._symbol('/'), lambda a,b: a//b) + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python2/step4_if_fn_do.py b/impls/python2/step4_if_fn_do.py new file mode 100644 index 0000000000..7845121364 --- /dev/null +++ b/impls/python2/step4_if_fn_do.py @@ -0,0 +1,93 @@ +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +READ = reader.read_str + +# eval +def EVAL(ast, env): + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + return EVAL(a2, let_env) + elif "do" == a0: + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + return EVAL(ast[-1], env) + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: + return EVAL(ast[3], env) + else: + return None + else: + return EVAL(a2, env) + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python2/step5_tco.py b/impls/python2/step5_tco.py new file mode 100644 index 0000000000..e045200945 --- /dev/null +++ b/impls/python2/step5_tco.py @@ -0,0 +1,108 @@ +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +READ = reader.read_str + +# eval +def EVAL(ast, env): + while True: + + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + ast = a2 + env = let_env + continue # TCO + elif "do" == a0: + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + ast = ast[-1] + continue # TCO + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None + else: + ast = a2 + continue # TCO + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO + else: + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python2/step6_file.py b/impls/python2/step6_file.py new file mode 100644 index 0000000000..aed6e09f27 --- /dev/null +++ b/impls/python2/step6_file.py @@ -0,0 +1,115 @@ +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +READ = reader.read_str + +# eval +def EVAL(ast, env): + while True: + + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + ast = a2 + env = let_env + continue # TCO + elif "do" == a0: + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + ast = ast[-1] + continue # TCO + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None + else: + ast = a2 + continue # TCO + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO + else: + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) +repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + +if len(sys.argv) >= 2: + REP('(load-file "' + sys.argv[1] + '")') + sys.exit(0) + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python2/step7_quote.py b/impls/python2/step7_quote.py new file mode 100644 index 0000000000..21fe4e3436 --- /dev/null +++ b/impls/python2/step7_quote.py @@ -0,0 +1,148 @@ +import functools +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +READ = reader.read_str + +# eval +def qq_loop(acc, elt): + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) + else: + return types._list(types._symbol('cons'), quasiquote(elt), acc) + +def qq_foldr(seq): + return functools.reduce(qq_loop, reversed(seq), types._list()) + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': + return ast[1] + else: + return qq_foldr(ast) + elif types._hash_map_Q(ast) or types._symbol_Q(ast): + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) + else: + return ast + +def EVAL(ast, env): + while True: + + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + ast = a2 + env = let_env + continue # TCO + elif "quote" == a0: + return ast[1] + elif "quasiquote" == a0: + ast = quasiquote(ast[1]) + continue # TCO + elif "do" == a0: + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + ast = ast[-1] + continue # TCO + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None + else: + ast = a2 + continue # TCO + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO + else: + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) +repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + +if len(sys.argv) >= 2: + REP('(load-file "' + sys.argv[1] + '")') + sys.exit(0) + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python2/step8_macros.py b/impls/python2/step8_macros.py new file mode 100644 index 0000000000..604b779534 --- /dev/null +++ b/impls/python2/step8_macros.py @@ -0,0 +1,161 @@ +import functools +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +READ = reader.read_str + +# eval +def qq_loop(acc, elt): + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) + else: + return types._list(types._symbol('cons'), quasiquote(elt), acc) + +def qq_foldr(seq): + return functools.reduce(qq_loop, reversed(seq), types._list()) + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': + return ast[1] + else: + return qq_foldr(ast) + elif types._hash_map_Q(ast) or types._symbol_Q(ast): + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) + else: + return ast + +def EVAL(ast, env): + while True: + + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + ast = a2 + env = let_env + continue # TCO + elif "quote" == a0: + return ast[1] + elif "quasiquote" == a0: + ast = quasiquote(ast[1]) + continue # TCO + elif 'defmacro!' == a0: + func = EVAL(ast[2], env) + func = types._clone(func) + func._ismacro_ = True + return env.set(ast[1], func) + elif "do" == a0: + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + ast = ast[-1] + continue # TCO + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None + else: + ast = a2 + continue # TCO + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO + else: + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) +repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP("""(defmacro! cond (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""") + +if len(sys.argv) >= 2: + REP('(load-file "' + sys.argv[1] + '")') + sys.exit(0) + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python2/step9_try.py b/impls/python2/step9_try.py new file mode 100644 index 0000000000..5d149f6b6c --- /dev/null +++ b/impls/python2/step9_try.py @@ -0,0 +1,180 @@ +import functools +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +READ = reader.read_str + +# eval +def qq_loop(acc, elt): + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) + else: + return types._list(types._symbol('cons'), quasiquote(elt), acc) + +def qq_foldr(seq): + return functools.reduce(qq_loop, reversed(seq), types._list()) + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': + return ast[1] + else: + return qq_foldr(ast) + elif types._hash_map_Q(ast) or types._symbol_Q(ast): + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) + else: + return ast + +def EVAL(ast, env): + while True: + + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + ast = a2 + env = let_env + continue # TCO + elif "quote" == a0: + return ast[1] + elif "quasiquote" == a0: + ast = quasiquote(ast[1]) + continue # TCO + elif 'defmacro!' == a0: + func = EVAL(ast[2], env) + func = types._clone(func) + func._ismacro_ = True + return env.set(ast[1], func) + elif "try*" == a0: + if len(ast) < 3: + ast = ast[1] + continue # TCO + else: + a1, a2 = ast[1], ast[2] + err = None + try: + return EVAL(a1, env) + except types.MalException as exc: + err = exc.object + except Exception as exc: + err = exc.args[0] + catch_env = Env(env, [a2[1]], [err]) + ast = a2[2] + env = catch_env + continue # TCO + elif "do" == a0: + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + ast = ast[-1] + continue # TCO + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None + else: + ast = a2 + continue # TCO + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO + else: + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) +repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))") +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP("""(defmacro! cond (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""") + +if len(sys.argv) >= 2: + REP('(load-file "' + sys.argv[1] + '")') + sys.exit(0) + +# repl loop +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except types.MalException as e: + print("Error:", printer._pr_str(e.object)) + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python2/stepA_mal.py b/impls/python2/stepA_mal.py new file mode 100644 index 0000000000..75914fe620 --- /dev/null +++ b/impls/python2/stepA_mal.py @@ -0,0 +1,191 @@ +import functools +import sys, traceback +import mal_readline +import mal_types as types +import reader, printer +from env import Env +import core + +# read +READ = reader.read_str + +# eval +def qq_loop(acc, elt): + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) + else: + return types._list(types._symbol('cons'), quasiquote(elt), acc) + +def qq_foldr(seq): + return functools.reduce(qq_loop, reversed(seq), types._list()) + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': + return ast[1] + else: + return qq_foldr(ast) + elif types._hash_map_Q(ast) or types._symbol_Q(ast): + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) + else: + return ast + +def EVAL(ast, env): + while True: + + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + printer._pr_str(ast)) + + if types._symbol_Q(ast): + return env.get(ast) + elif types._vector_Q(ast): + return types.Vector(EVAL(a, env) for a in ast) + elif types._hash_map_Q(ast): + return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + + if types._symbol_Q(a0): + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) + ast = a2 + env = let_env + continue # TCO + elif "quote" == a0: + return ast[1] + elif "quasiquote" == a0: + ast = quasiquote(ast[1]) + continue # TCO + elif 'defmacro!' == a0: + func = EVAL(ast[2], env) + func = types._clone(func) + func._ismacro_ = True + return env.set(ast[1], func) + elif "py!*" == a0: + exec(compile(ast[1], '', 'single'), globals()) + return None + elif "py*" == a0: + return types.py_to_mal(eval(ast[1])) + elif "." == a0: + el = (EVAL(ast[i], env) for i in range(2, len(ast))) + f = eval(ast[1]) + return f(*el) + elif "try*" == a0: + if len(ast) < 3: + ast = ast[1] + continue # TCO + else: + a1, a2 = ast[1], ast[2] + err = None + try: + return EVAL(a1, env) + except types.MalException as exc: + err = exc.object + except Exception as exc: + err = exc.args[0] + catch_env = Env(env, [a2[1]], [err]) + ast = a2[2] + env = catch_env + continue # TCO + elif "do" == a0: + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + ast = ast[-1] + continue # TCO + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None + else: + ast = a2 + continue # TCO + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO + if hasattr(f, '__ast__'): + ast = f.__ast__ + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO + else: + return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') + +# print +PRINT = printer._pr_str + +# repl +repl_env = Env() +def REP(str): + return PRINT(EVAL(READ(str), repl_env)) + +# core.py: defined using python +for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) +repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) + +# core.mal: defined using the language itself +REP('(def! *host-language* "python2")') +REP("(def! not (fn* (a) (if a false true)))") +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP("""(defmacro! cond (fn* (& xs) + (if (> (count xs) 0) + (list 'if (first xs) + (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""") + +if len(sys.argv) >= 2: + REP('(load-file "' + sys.argv[1] + '")') + sys.exit(0) + +# repl loop +REP('(println (str "Mal [" *host-language* "]"))') +while True: + try: + line = mal_readline.readline("user> ") + print(REP(line)) + except EOFError: + print() + break + except reader.Blank: continue + except types.MalException as e: + print("Error:", printer._pr_str(e.object)) + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python2/tests/step5_tco.mal b/impls/python2/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/python2/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/python2/tests/stepA_mal.mal b/impls/python2/tests/stepA_mal.mal new file mode 100644 index 0000000000..44669f8582 --- /dev/null +++ b/impls/python2/tests/stepA_mal.mal @@ -0,0 +1,23 @@ +;; Testing Python interop + +;; Testing Python expressions +(py* "7") +;=>7 +(py* "'7'") +;=>"7" +(py* "[7,8,9]") +;=>(7 8 9) +(py* "' '.join(['X'+c+'Y' for c in ['a','b','c']])") +;=>"XaY XbY XcY" +(py* "[1 + x for x in [1,2,3]]") +;=>(2 3 4) + +;; Testing Python statements +(py!* "print('hello')") +;/hello +;=>nil + +(py!* "foo = 19 % 4") +;=>nil +(py* "foo") +;=>3 diff --git a/impls/python3/.gitignore b/impls/python3/.gitignore new file mode 100644 index 0000000000..f604396b62 --- /dev/null +++ b/impls/python3/.gitignore @@ -0,0 +1,3 @@ +.vscode/ +.mypy_cache/ +.idea/ diff --git a/impls/python3/Dockerfile b/impls/python3/Dockerfile new file mode 100644 index 0000000000..8e6001a69f --- /dev/null +++ b/impls/python3/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# For checking: +# RUN apt-get -y install flake8 mypy pylint diff --git a/impls/python3/Makefile b/impls/python3/Makefile new file mode 100644 index 0000000000..19fa6d5381 --- /dev/null +++ b/impls/python3/Makefile @@ -0,0 +1,26 @@ +# make check sources=reader.py may be convenient +sources ?= *.py + +f8 += D100 # Missing docstring in public module +f8 += D101 # Missing docstring in public class +f8 += D102 # Missing docstring in public method +f8 += D103 # Missing docstring in public function +f8 += D105 # Missing docstring in magic method +f8 += D107 # Missing docstring in __init__ +f8 += I100 # order of import statements (incompatible with pylint) +f8 += W503 # line break before binary operator (incompatible with 504) +pl += missing-module-docstring +pl += missing-class-docstring +pl += missing-function-docstring +pl += R0801 # Similar lines in 2 files (steps...) + +all: + +check: + pylint --disable=$(shell echo $(pl) | sed 's/ /,/g') $(sources) + mypy $(sources) + flake8 --ignore=$(shell echo $(f8) | sed 's/ /,/g') $(sources) + +clean: + rm -f *~ + rm -fr __pycache__/ .mypy_cache/ diff --git a/impls/python3/core.py b/impls/python3/core.py new file mode 100644 index 0000000000..42ef7c2926 --- /dev/null +++ b/impls/python3/core.py @@ -0,0 +1,527 @@ +import collections.abc +import dataclasses +import itertools +import time +import operator +import typing +from collections.abc import Callable, Sequence + +import mal_readline + +from mal_types import (Atom, Boolean, Error, Fn, Form, Keyword, List, + Macro, Map, Nil, Number, PythonCall, String, + Symbol, ThrownException, Vector, pr_seq) + +import reader + + +ns: dict[str, Form] = {} + + +def built_in(name: str) -> Callable[[PythonCall], None]: + """Register in ns and add context to Errors.""" + + def decorate(old_f: PythonCall) -> None: + + def new_f(args: Sequence[Form]) -> Form: + try: + return old_f(args) + except Error as exc: + if hasattr(exc, "add_note"): + exc.add_note('The ' + name + ' core function received [' + + pr_seq(args) + ' ] as arguments.') + raise + + ns[name] = Fn(new_f) + + return decorate + + +def equality(value: Form) -> PythonCall: + + def new_f(args: Sequence[Form]) -> Form: + match args: + case [form]: + return Boolean(form == value) + case _: + raise Error('bad arguments') + + return new_f + + +built_in('nil?')(equality(Nil.NIL)) +built_in('false?')(equality(Boolean.FALSE)) +built_in('true?')(equality(Boolean.TRUE)) + + +def membership(*classes: type) -> PythonCall: + + def new_f(args: Sequence[Form]) -> Form: + match args: + case [form]: + return Boolean(isinstance(form, classes)) + case _: + raise Error('bad arguments') + + return new_f + + +built_in('number?')(membership(Number)) +built_in('symbol?')(membership(Symbol)) +built_in('keyword?')(membership(Keyword)) +built_in('string?')(membership(String)) +built_in('list?')(membership(List)) +built_in('map?')(membership(Map)) +built_in('atom?')(membership(Atom)) +built_in('vector?')(membership(Vector)) +built_in('macro?')(membership(Macro)) +built_in('sequential?')(membership(List, Vector)) +built_in('fn?')(membership(Fn)) + + +def arithmetic(old_f: Callable[[int, int], int]) -> PythonCall: + + def new_f(args: Sequence[Form]) -> Form: + match args: + case [Number() as left, Number() as right]: + return Number(old_f(left, right)) + case _: + raise Error('bad arguments') + + return new_f + + +built_in('+')(arithmetic(operator.add)) +built_in('-')(arithmetic(operator.sub)) +built_in('*')(arithmetic(operator.mul)) +built_in('/')(arithmetic(operator.floordiv)) + + +def comparison(old_f: Callable[[int, int], bool]) -> PythonCall: + + def new_f(args: Sequence[Form]) -> Form: + match args: + case [Number() as left, Number() as right]: + return Boolean(old_f(left, right)) + case _: + raise Error('bad arguments') + + return new_f + + +built_in('<')(comparison(operator.lt)) +built_in('<=')(comparison(operator.le)) +built_in('>')(comparison(operator.gt)) +built_in('>=')(comparison(operator.ge)) + + +@built_in('=') +def _(args: Sequence[Form]) -> Form: + match args: + case [left, right]: + return Boolean(left == right) + case _: + raise Error('bad arguments') + + +built_in('list')(List) +built_in('vector')(Vector) + + +@built_in('prn') +def _(args: Sequence[Form]) -> Form: + print(pr_seq(args)) + return Nil.NIL + + +@built_in('pr-str') +def _(args: Sequence[Form]) -> Form: + return String(pr_seq(args)) + + +@built_in('println') +def _(args: Sequence[Form]) -> Form: + print(pr_seq(args, readably=False)) + return Nil.NIL + + +@built_in('empty?') +def _(args: Sequence[Form]) -> Form: + match args: + case [List() | Vector() as seq]: + return Boolean(not seq) + case _: + raise Error('bad arguments') + + +@built_in('count') +def _(args: Sequence[Form]) -> Form: + match args: + case [List() | Vector() as seq]: + return Number(len(seq)) + case [Nil()]: + return Number(0) + case _: + raise Error('bad arguments') + + +@built_in('read-string') +def _(args: Sequence[Form]) -> Form: + match args: + case [String(line)]: + return reader.read(line) + case _: + raise Error('bad arguments') + + +@built_in('slurp') +def _(args: Sequence[Form]) -> Form: + match args: + case [String(file_name)]: + with open(file_name, 'r', encoding='utf-8') as the_file: + return String(the_file.read()) + case _: + raise Error('bad arguments') + + +@built_in('str') +def _(args: Sequence[Form]) -> Form: + return String(pr_seq(args, readably=False, sep='')) + + +@built_in('atom') +def _(args: Sequence[Form]) -> Form: + match args: + case [form]: + return Atom(form) + case _: + raise Error('bad arguments') + + +@built_in('deref') +def _(args: Sequence[Form]) -> Form: + match args: + case [Atom(val)]: + return val + case _: + raise Error('bad arguments') + + +@built_in('reset!') +def _(args: Sequence[Form]) -> Form: + match args: + case [Atom() as atm, form]: + atm.val = form + return form + case _: + raise Error('bad arguments') + + +@built_in('vec') +def _(args: Sequence[Form]) -> Form: + match args: + case [List() as seq]: + return Vector(seq) + case [Vector() as seq]: + return seq + case _: + raise Error('bad arguments') + + +@built_in('cons') +def _(args: Sequence[Form]) -> Form: + match args: + case [head, List() | Vector() as tail]: + return List((head, *tail)) + case _: + raise Error('bad arguments') + + +def cast_sequence(arg: Form) -> List | Vector: + match arg: + case List() | Vector(): + return arg + case _: + raise Error(f'{arg} is not a sequence') + + +@built_in('concat') +def _(args: Sequence[Form]) -> Form: + return List(itertools.chain.from_iterable(cast_sequence(x) for x in args)) + + +@built_in('nth') +def _(args: Sequence[Form]) -> Form: + match args: + case [List() | Vector() as seq, Number() as idx]: + # Python would accept index = -1. + if 0 <= idx < len(seq): + return seq[idx] + raise Error(f'index {idx} not in range of {seq}') + case _: + raise Error('bad arguments') + + +@built_in('apply') +def _(args: Sequence[Form]) -> Form: + match args: + case [Fn(call) | Macro(call), *some, + List() | Vector() as more]: + return call((*some, *more)) + case _: + raise Error('bad arguments') + + +@built_in('map') +def _(args: Sequence[Form]) -> Form: + match args: + case [Fn(call), List() | Vector() as seq]: + return List(call((x, )) for x in seq) + case _: + raise Error('bad arguments') + + +@built_in('throw') +def _(args: Sequence[Form]) -> Form: + match args: + case [form]: + raise ThrownException(form) + case _: + raise Error('bad arguments') + + +@built_in('keyword') +def _(args: Sequence[Form]) -> Form: + match args: + case [String(string)]: + return Keyword(string) + case [Keyword() as keyword]: + return keyword + case _: + raise Error('bad arguments') + + +@built_in('symbol') +def _(args: Sequence[Form]) -> Form: + match args: + case [String(string)]: + return Symbol(string) + case [Symbol() as symbol]: + return symbol + case _: + raise Error('bad arguments') + + +@built_in('readline') +def _(args: Sequence[Form]) -> Form: + match args: + case [String(prompt)]: + try: + return String(mal_readline.input_(prompt)) + except EOFError: + return Nil.NIL + case _: + raise Error('bad arguments') + + +@built_in('time-ms') +def _(args: Sequence[Form]) -> Form: + if args: + raise Error('bad arguments') + return Number(time.time() * 1000.0) + + +@built_in('meta') +def _(args: Sequence[Form]) -> Form: + match args: + case [Fn() | List() | Vector() | Map() as form]: + return form.meta + case _: + raise Error('bad arguments') + + +@built_in('with-meta') +def _(args: Sequence[Form]) -> Form: + # container = type(container)(container, meta=meta) confuses mypy. + match args: + case [List() as container, meta]: + return List(container, meta=meta) + case [Vector() as container, meta]: + return Vector(container, meta=meta) + case [Map() as container, meta]: + return Map(container, meta) + case [Fn() as container, meta]: + return dataclasses.replace(container, meta=meta) + case _: + raise Error('bad arguments') + + +@built_in('seq') +def _(args: Sequence[Form]) -> Form: + match args: + case [List() as seq]: + return seq if seq else Nil.NIL + case [Vector() as seq]: + return List(seq) if seq else Nil.NIL + case [String(string)]: + return List(String(c) for c in string) if string else Nil.NIL + case [Nil()]: + return Nil.NIL + case _: + raise Error('bad arguments') + + +@built_in('conj') +def conj(args: Sequence[Form]) -> Form: + match args: + case [Vector() as seq, *forms]: + return Vector((*seq, *forms)) + case [List() as seq, *forms]: + return List((*reversed(forms), *seq)) + case _: + raise Error('bad arguments') + + +@built_in('get') +def _(args: Sequence[Form]) -> Form: + match args: + case [Map() as mapping, Keyword() | String() as key]: + return mapping.get(key, Nil.NIL) + case [Nil(), Keyword() | String()]: + return Nil.NIL + case _: + raise Error('bad arguments') + + +@built_in('first') +def _(args: Sequence[Form]) -> Form: + match args: + case [List() | Vector() as seq]: + return seq[0] if seq else Nil.NIL + case [Nil()]: + return Nil.NIL + case _: + raise Error('bad arguments') + + +@built_in('rest') +def _(args: Sequence[Form]) -> Form: + match args: + case [List() | Vector() as seq]: + return List(seq[1:]) + case [Nil()]: + return List() + case _: + raise Error('bad arguments') + + +@built_in('hash-map') +def _(args: Sequence[Form]) -> Form: + return Map(Map.cast_items(args)) + + +@built_in('assoc') +def _(args: Sequence[Form]) -> Form: + match args: + case [Map() as mapping, *binds]: + return Map(itertools.chain(mapping.items(), Map.cast_items(binds))) + case _: + raise Error('bad arguments') + + +@built_in('contains?') +def _(args: Sequence[Form]) -> Form: + match args: + case [Map() as mapping, Keyword() | String() as key]: + return Boolean(key in mapping) + case _: + raise Error('bad arguments') + + +@built_in('keys') +def _(args: Sequence[Form]) -> Form: + match args: + case [Map() as mapping]: + return List(mapping.keys()) + case _: + raise Error('bad arguments') + + +@built_in('vals') +def _(args: Sequence[Form]) -> Form: + match args: + case [Map() as mapping]: + return List(mapping.values()) + case _: + raise Error('bad arguments') + + +@built_in('dissoc') +def _(args: Sequence[Form]) -> Form: + match args: + case [Map() as mapping, *keys]: + result = Map(mapping) + for key in keys: + if not isinstance(key, (Keyword, String)): + raise Error(f'{key} is not a valid map key') + if key in result: + del result[key] + return result + case _: + raise Error('bad arguments') + + +@built_in('swap!') +def _(args: Sequence[Form]) -> Form: + match args: + case [Atom(old) as atm, Fn(call), *more]: + new = call((old, *more)) + atm.val = new + return new + case _: + raise Error('bad arguments') + + +@built_in('py!*') +def _(args: Sequence[Form]) -> Form: + match args: + case [String(python_statement)]: + # pylint: disable-next=exec-used + exec(compile(python_statement, '', 'single'), globals()) + return Nil.NIL + case _: + raise Error('bad arguments') + + +def py2mal(obj: typing.Any) -> Form: + match obj: + case None: + return Nil.NIL + case bool(): + return Boolean(obj) + case int(): + return Number(obj) + case str(): + return String(obj) + case Sequence(): + return List(py2mal(x) for x in obj) + case collections.abc.Mapping(): + result = Map() + for py_key, py_val in obj.items(): + key = py2mal(py_key) + if not isinstance(key, (Keyword, String)): + raise Error(f'{key} is not a valid map key') + result[key] = py2mal(py_val) + return Map() + case _: + raise Error(f'failed to translate {obj}') + + +@built_in('py*') +def _(args: Sequence[Form]) -> Form: + match args: + case [String(python_expression)]: + # pylint: disable-next=eval-used + return py2mal(eval(python_expression)) + case _: + raise Error('bad arguments') diff --git a/impls/python3/env.py b/impls/python3/env.py new file mode 100644 index 0000000000..4ed0b84984 --- /dev/null +++ b/impls/python3/env.py @@ -0,0 +1,20 @@ +# Env is defined in mal_types.py in order to avoid a circular dependency. +from collections.abc import Sequence + +from mal_types import Env, Error, Form, List, pr_seq + + +def call_env(env: Env, parms: Sequence[str], args: Sequence[Form]) -> Env: + match parms: + case [*required, '&', rest]: + if len(args) < len(required): + raise Error('not enough arguments for fn*[' + + ' '.join(parms) + ']: ' + pr_seq(args)) + fn_env = env.new_child(dict(zip(required, args))) + fn_env[rest] = List(args[len(required):]) + return fn_env + case _: + if len(args) != len(parms): + raise Error('bad argument count for fn*[' + + ' '.join(parms) + ']: ' + pr_seq(args)) + return env.new_child(dict(zip(parms, args))) diff --git a/impls/python3/mal_readline.py b/impls/python3/mal_readline.py new file mode 100644 index 0000000000..13b286afba --- /dev/null +++ b/impls/python3/mal_readline.py @@ -0,0 +1,21 @@ +# Importing this module is sufficient for the 'input' builtin command +# to support readline. + +import atexit +import os.path +import readline + +histfile = os.path.join(os.path.expanduser('~'), '.mal-history') +try: + readline.read_history_file(histfile) +except FileNotFoundError: + pass +readline.set_history_length(1000) +atexit.register(readline.write_history_file, histfile) + + +def input_(prompt: str) -> str: + line = input(prompt) + if line: + readline.add_history(line) + return line diff --git a/impls/python3/mal_types.py b/impls/python3/mal_types.py new file mode 100644 index 0000000000..25645099f5 --- /dev/null +++ b/impls/python3/mal_types.py @@ -0,0 +1,185 @@ +# Named mal_types because 'types' is already a standard python module. + +import collections +import dataclasses +import enum +import itertools +import re +import typing +from collections.abc import Callable, Iterable, Iterator, Mapping, Sequence + +# The selected representations ensure that the Python == equality +# matches the MAL = equality. + +# pr_str is implemented here without printer.py because +# __str__ is idiomatic and gives formatted error messages soon +# (that is, without circular dependencies or evil tricks). +# So there are three ways to format a MAL object. +# str(form) +# the default, used by pr_seq or format strings like f'{form}' +# implemented by form.__str__(readably=True) +# form.__str__(readably=False) +# used by some core functions via pr_seq +# implemented by form.__str__(readably=False) +# repr(form) +# the python representation for debugging + + +class Nil(enum.Enum): + NIL = None + + def __str__(self, readably: bool = True) -> str: + return 'nil' + + +class Boolean(enum.Enum): + FALSE = False + TRUE = True + + def __str__(self, readably: bool = True) -> str: + return 'true' if self is self.TRUE else 'false' + + +class Number(int): + + def __str__(self, readably: bool = True) -> str: + return super().__str__() + + +class Symbol(str): + + def __str__(self, readably: bool = True) -> str: + # pylint: disable=invalid-str-returned + return self + + +# The two other string types are wrapped in dataclasses in order to +# avoid problems with == (symbols) and pattern matching (list and +# vectors). +@dataclasses.dataclass(frozen=True, slots=True) +class String: + val: str + + @staticmethod + def _repl(match: re.Match[str]) -> str: + char = match.group() + return '\\' + ('n' if char == '\n' else char) + + def __str__(self, readably: bool = True) -> str: + return '"' + re.sub(r'[\\"\n]', String._repl, self.val) + '"' \ + if readably else self.val + + +@dataclasses.dataclass(frozen=True, slots=True) +class Keyword: + val: str + + def __str__(self, readably: bool = True) -> str: + return ':' + self.val + + +class List(tuple['Form', ...]): + # Avoid a name clash with typing.List. This improves mypy output. + + def __init__(self, _: Iterable['Form'] = (), + meta: 'Form' = Nil.NIL) -> None: + """Add a meta field, tuple.__new__ does the rest.""" + self.meta = meta + + def __str__(self, readably: bool = True) -> str: + return '(' + pr_seq(self, readably) + ')' + + +class Vector(tuple['Form', ...]): + + def __init__(self, _: Iterable['Form'] = (), + meta: 'Form' = Nil.NIL) -> None: + """Add a meta field, tuple.__new__ does the rest.""" + self.meta = meta + + def __str__(self, readably: bool = True) -> str: + return '[' + pr_seq(self, readably) + ']' + + +class Map(dict[Keyword | String, 'Form']): + + def __init__(self, + arg: Iterable[tuple[Keyword | String, 'Form']] + | Mapping[Keyword | String, 'Form'] = (), + meta: 'Form' = Nil.NIL, + ) -> None: + dict.__init__(self, arg) + self.meta = meta + + def __str__(self, readably: bool = True) -> str: + return '{' + pr_seq(itertools.chain.from_iterable(self.items()), + readably) + '}' + + @staticmethod + def cast_items(args: Iterable['Form'] + ) -> Iterator[tuple[Keyword | String, 'Form']]: + key: Keyword | String | None = None + for form in args: + if key: + yield key, form + key = None + elif isinstance(form, (Keyword, String)): + key = form + else: + raise Error(f'{key} is not a valid map key') + if key: + raise Error(f'odd count in map binds, no value for {form}') + + +Env = collections.ChainMap[str, 'Form'] +PythonCall = Callable[[Sequence['Form']], 'Form'] + + +class TCOEnv(typing.NamedTuple): + body: 'Form' + fenv: Callable[[Sequence['Form']], Env] + + +@dataclasses.dataclass(frozen=True, slots=True) +class Fn: + call: PythonCall + tco_env: TCOEnv | None = None + meta: 'Form' = Nil.NIL + + def __str__(self, readably: bool = True) -> str: + return '#' + + +@dataclasses.dataclass(frozen=True, slots=True) +class Macro: + call: PythonCall + + def __str__(self, readably: bool = True) -> str: + return '#' + + +@dataclasses.dataclass(slots=True) +class Atom: + val: 'Form' + + def __str__(self, readably: bool = True) -> str: + return f'(atom {self.val})' + + +Form = (Atom | Boolean | Fn | Keyword | Macro | List + | Map | Nil | Number | String | Symbol | Vector) + + +class Error(Exception): + """Local exceptions, as recommended by pylint.""" + + +@dataclasses.dataclass(frozen=True, slots=True) +class ThrownException(Exception): + form: Form + + +def pr_seq(args: Iterable[Form], readably: bool = True, sep: str = ' ') -> str: + # This would be OK if the signature was usual. + # pylint: disable-next=unnecessary-dunder-call + return sep.join(x.__str__(readably) for x in args) diff --git a/impls/python3/reader.py b/impls/python3/reader.py new file mode 100644 index 0000000000..28aed158bb --- /dev/null +++ b/impls/python3/reader.py @@ -0,0 +1,175 @@ +import re +from collections.abc import Callable, Iterator, Mapping +from re import Match + +from mal_types import (Boolean, Error, Form, Keyword, List, Map, Nil, + Number, String, Symbol, Vector) + +# The `token` decorator adds regular expression groups all along this file. +# The name of a group is the name of the decorated funtion, allowing +# `read_form` to call it when it founds the token. +# The global regular expression is compiled once when the module is loaded. +token_groups: list[str] = [] + + +class Lexer: + # Consume unnamed groups, but do not report them. + # Report None at the end of the input. + + def __init__(self, source: str) -> None: + self._tokens = (t for t in pattern.finditer(source) if t.lastgroup) + self._peek: Match[str] | None = None + self.consume() + + def consume(self) -> None: + try: + self._peek = next(self._tokens) + except StopIteration: + self._peek = None + + def peek(self) -> re.Match[str] | None: + return self._peek + + +def token(regex: str): + """Bind a regular expression to a function in this module. Form constuctor. + + The lexer does not report tokens with None as constructor. + """ + + def decorator(fun: Callable[[Lexer, Match[str]], Form] | None): + if fun: + group = f'(?P<{fun.__name__}>{regex})' + else: + group = f'(?:{regex})' + token_groups.append(group) + return fun + + return decorator + + +def context(match: Match[str]) -> str: + """Format some information for error reporting.""" + start_idx = match.start() - 10 + if 0 < start_idx: + start = '...' + match.string[start_idx:match.start()] + else: + start = match.string[:match.start()] + end_idx = match.end() + 20 + if end_idx < len(match.string): + end = match.string[match.end():end_idx] + '...' + else: + end = match.string[match.end():] + return f': {start}{match.group()}{end}' + + +token(r'(?:[\s,]|;[^\n\r]*)+')(None) + + +def unescape(match: Match[str]) -> str: + """Map a backslash sequence to a character for strings.""" + char = match.string[match.end() - 1] + return '\n' if char == 'n' else char + + +@token(r'"(?:(?:[^"\\]|\\.)*")?') +def string(_: Lexer, tok: Match[str]) -> Form: + start, end = tok.span() + if end - start == 1: + raise Error('read: unbalanced string delimiter' + context(tok)) + return String(re.sub(r'\\.', unescape, tok.string[start + 1:end - 1])) + + +def read_list(lexer: Lexer, closing: str, pos: Match[str]) -> Iterator[Form]: + while not ((tok := lexer.peek()) and tok.group() == closing): + yield read_form(lexer, pos) + lexer.consume() + + +@token(r'\(') +def list_start(lexer: Lexer, tok: Match[str]) -> Form: + return List(read_list(lexer, ')', tok)) + + +@token(r'\[') +def vector_start(lexer: Lexer, tok: Match[str]) -> Form: + return Vector(read_list(lexer, ']', tok)) + + +@token(r'\{') +def map_start(lexer: Lexer, tok: Match[str]) -> Form: + return Map(Map.cast_items(read_list(lexer, '}', tok))) + + +single_macros = { + "'": 'quote', + '`': 'quasiquote', + '@': 'deref', + '~': 'unquote', + '~@': 'splice-unquote', +} + + +@token("['`@]|~@?") +def macro(lexer: Lexer, tok: Match[str]) -> Form: + return List((Symbol(single_macros[tok.group()]), read_form(lexer, tok))) + + +@token(r'\^') +def with_meta(lexer: Lexer, tok: Match[str]) -> Form: + tmp = read_form(lexer, tok) + return List((Symbol('with-meta'), read_form(lexer, tok), tmp)) + + +@token('[])}]') +def list_end(_: Lexer, tok: Match[str]) -> Form: + raise Error('read: unbalanced list/vector/map terminator' + context(tok)) + + +@token(r'-?\d+') +def number(_: Lexer, tok: Match[str]) -> Form: + return Number(tok.group()) + + +almost_symbols: Mapping[str, Form] = { + 'nil': Nil.NIL, + 'false': Boolean.FALSE, + 'true': Boolean.TRUE, +} + + +@token(r"""[^]\s"'(),;@[^`{}~]+""") +def symbol(_: Lexer, tok: Match[str]) -> Form: + start, end = tok.span() + if tok.string[start] == ':': + return Keyword(tok.string[start + 1:end]) + value = tok.group() + return almost_symbols.get(value) or Symbol(value) + + +@token('.') +def should_never_match(lexer: Lexer, tok: Match[str]) -> Form: + assert False, f'{lexer} {tok}' + + +def read_form(lexer: Lexer, pos: Match[str] | None) -> Form: + """Parse a form from `lexer`, reporting errors as if started from `pos`.""" + if (tok := lexer.peek()): + lexer.consume() + assert tok.lastgroup, f'{lexer} {tok}' + assert tok.lastgroup in globals(), f'{lexer} {tok}' + return globals()[tok.lastgroup](lexer, tok) + if pos: + raise Error('read: unbalanced form, started' + context(pos)) + raise Error('read: the whole input was empty') + + +def read(source: str) -> Form: + lexer = Lexer(source) + result = read_form(lexer, None) + if tok := lexer.peek(): + raise Error('read: trailing items after the form' + context(tok)) + return result + + +pattern = re.compile('|'.join(token_groups)) diff --git a/impls/python3/run b/impls/python3/run new file mode 100755 index 0000000000..1e7632cd57 --- /dev/null +++ b/impls/python3/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec python3 $(dirname $0)/${STEP:-stepA_mal}.py "${@}" diff --git a/impls/python3/step0_repl.py b/impls/python3/step0_repl.py new file mode 100644 index 0000000000..238f6e0b91 --- /dev/null +++ b/impls/python3/step0_repl.py @@ -0,0 +1,29 @@ +import mal_readline + + +def read(source: str) -> str: + return source + + +def eval_(ast: str) -> str: + return ast + + +def print_(form: str) -> str: + return form + + +def rep(source: str) -> str: + return print_(eval_(read(source))) + + +def main() -> None: + while True: + try: + print(rep(mal_readline.input_('user> '))) + except EOFError: + break + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step1_read_print.py b/impls/python3/step1_read_print.py new file mode 100644 index 0000000000..5fa5161420 --- /dev/null +++ b/impls/python3/step1_read_print.py @@ -0,0 +1,31 @@ +import traceback + +import mal_readline + +from mal_types import Form + +import reader + + +def eval_(ast: Form) -> Form: + # print(repr(ast)) # the result of read, as python + return ast + + +def rep(source: str) -> str: + return str(eval_(reader.read(source))) + + +def main() -> None: + while True: + try: + print(rep(mal_readline.input_('user> '))) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step2_eval.py b/impls/python3/step2_eval.py new file mode 100644 index 0000000000..75cf1c66d8 --- /dev/null +++ b/impls/python3/step2_eval.py @@ -0,0 +1,88 @@ +import traceback +from collections.abc import Mapping, Sequence + +import mal_readline + +from mal_types import (Error, Fn, Form, List, + Map, Number, Symbol, + Vector, pr_seq) + +import reader + +Env = Mapping[str, Fn] + + +def eval_(ast: Form, env: Env) -> Form: + # print(f'EVAL: {ast}', repr(ast) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + match eval_(first, env): + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def add(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left + right) + case _: + raise Error('+: bad arguments' + pr_seq(args)) + + +def sub(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left - right) + case _: + raise Error('-: bad arguments' + pr_seq(args)) + + +def mul(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left * right) + case _: + raise Error('*: bad arguments' + pr_seq(args)) + + +def floordiv(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left // right) + case _: + raise Error('/: bad arguments' + pr_seq(args)) + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env: Env = { + '+': Fn(add), '-': Fn(sub), '*': Fn(mul), '/': Fn(floordiv), + } + + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step3_env.py b/impls/python3/step3_env.py new file mode 100644 index 0000000000..e1641b0f13 --- /dev/null +++ b/impls/python3/step3_env.py @@ -0,0 +1,124 @@ +import traceback +from collections.abc import Sequence + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, + Map, Nil, Number, Symbol, + Vector, pr_seq) + +import reader + + +def eval_def(args: Sequence[Form], env: Env) -> Form: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> Form: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return eval_(form, let_env) + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, +} + + +def eval_(ast: Form, env: Env) -> Form: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + return spec(args, env) + match eval_(first, env): + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def add(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left + right) + case _: + raise Error('+: bad arguments' + pr_seq(args)) + + +def sub(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left - right) + case _: + raise Error('-: bad arguments' + pr_seq(args)) + + +def mul(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left * right) + case _: + raise Error('*: bad arguments' + pr_seq(args)) + + +def floordiv(args: Sequence[Form]) -> Form: + match args: + case [Number(left), Number(right)]: + return Number(left // right) + case _: + raise Error('/: bad arguments' + pr_seq(args)) + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env({ + '+': Fn(add), '-': Fn(sub), '*': Fn(mul), '/': Fn(floordiv), + }) + + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step4_if_fn_do.py b/impls/python3/step4_if_fn_do.py new file mode 100644 index 0000000000..49f1375a16 --- /dev/null +++ b/impls/python3/step4_if_fn_do.py @@ -0,0 +1,137 @@ +import traceback +from collections.abc import Sequence + +import core + +from env import call_env + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, + Map, Nil, Symbol, + Vector, pr_seq) + +import reader + + +def eval_def(args: Sequence[Form], env: Env) -> Form: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> Form: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return eval_(form, let_env) + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +def eval_do(args: Sequence[Form], env: Env) -> Form: + match args: + case [*forms, last]: + for form in forms: + eval_(form, env) + return eval_(last, env) + case _: + raise Error('do: no argument') + + +def eval_if(args: Sequence[Form], env: Env) -> Form: + if 2 <= len(args) <= 3: + if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): + if len(args) == 3: + return eval_(args[2], env) + return Nil.NIL + return eval_(args[1], env) + raise Error('if: bad argument count: ' + pr_seq(args)) + + +def eval_fn(args: Sequence[Form], env: Env) -> Form: + match args: + case [List() | Vector() as forms, body]: + # The new structure convinces mypy. + parms = [] + for parm in forms: + if not isinstance(parm, Symbol): + raise Error(f'fn*: {parm} is not a symbol') + parms.append(parm) + + def call(f_args: Sequence[Form]) -> Form: + return eval_(body, call_env(env, parms, f_args)) + + return Fn(call) + case _: + raise Error('fn*: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, + 'do': eval_do, + 'if': eval_if, + 'fn*': eval_fn, +} + + +def eval_(ast: Form, env: Env) -> Form: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + return spec(args, env) + match eval_(first, env): + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env(core.ns) # Modifying ns is OK. + + rep('(def! not (fn* (a) (if a false true)))', repl_env) + + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step5_tco.py b/impls/python3/step5_tco.py new file mode 100644 index 0000000000..4cea3821a6 --- /dev/null +++ b/impls/python3/step5_tco.py @@ -0,0 +1,151 @@ +import traceback +from collections.abc import Sequence + +import core + +from env import call_env + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, + Map, Nil, Symbol, TCOEnv, + Vector, pr_seq) + +import reader + +# Special forms return either a final result or a new TCO context. +SpecialResult = tuple[Form, Env | None] + + +def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value, None + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return form, let_env + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [*forms, last]: + for form in forms: + eval_(form, env) + return last, env + case _: + raise Error('do: no argument') + + +def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: + if 2 <= len(args) <= 3: + if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): + if len(args) == 3: + return args[2], env + return Nil.NIL, None + return args[1], env + raise Error('if: bad argument count: ' + pr_seq(args)) + + +def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as forms, body]: + # The new structure convinces mypy. + parms = [] + for parm in forms: + if not isinstance(parm, Symbol): + raise Error(f'fn*: {parm} is not a symbol') + parms.append(parm) + + def fenv(f_args: Sequence[Form]) -> Env: + return call_env(env, parms, f_args) + + def call(f_args: Sequence[Form]) -> Form: + return eval_(body, fenv(f_args)) + + return Fn(call, TCOEnv(body, fenv)), None + case _: + raise Error('fn*: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, + 'do': eval_do, + 'if': eval_if, + 'fn*': eval_fn, +} + + +def eval_(ast: Form, env: Env) -> Form: + while True: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + ast, maybe_env = spec(args, env) + if maybe_env is None: + return ast + env = maybe_env + else: + match eval_(first, env): + case Fn(tco_env=TCOEnv(body, fenv)): + ast = body + env = fenv(tuple(eval_(x, env) for x in args)) + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env(core.ns) # Modifying ns is OK. + + rep('(def! not (fn* (a) (if a false true)))', repl_env) + + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step6_file.py b/impls/python3/step6_file.py new file mode 100644 index 0000000000..a0c99e4f7a --- /dev/null +++ b/impls/python3/step6_file.py @@ -0,0 +1,167 @@ +import sys +import traceback +from collections.abc import Sequence + +import core + +from env import call_env + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, + Map, Nil, String, Symbol, TCOEnv, + Vector, pr_seq) + +import reader + +# Special forms return either a final result or a new TCO context. +SpecialResult = tuple[Form, Env | None] + + +def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value, None + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return form, let_env + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [*forms, last]: + for form in forms: + eval_(form, env) + return last, env + case _: + raise Error('do: no argument') + + +def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: + if 2 <= len(args) <= 3: + if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): + if len(args) == 3: + return args[2], env + return Nil.NIL, None + return args[1], env + raise Error('if: bad argument count: ' + pr_seq(args)) + + +def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as forms, body]: + # The new structure convinces mypy. + parms = [] + for parm in forms: + if not isinstance(parm, Symbol): + raise Error(f'fn*: {parm} is not a symbol') + parms.append(parm) + + def fenv(f_args: Sequence[Form]) -> Env: + return call_env(env, parms, f_args) + + def call(f_args: Sequence[Form]) -> Form: + return eval_(body, fenv(f_args)) + + return Fn(call, TCOEnv(body, fenv)), None + case _: + raise Error('fn*: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, + 'do': eval_do, + 'if': eval_if, + 'fn*': eval_fn, +} + + +def eval_(ast: Form, env: Env) -> Form: + while True: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + ast, maybe_env = spec(args, env) + if maybe_env is None: + return ast + env = maybe_env + else: + match eval_(first, env): + case Fn(tco_env=TCOEnv(body, fenv)): + ast = body + env = fenv(tuple(eval_(x, env) for x in args)) + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env(core.ns) # Modifying ns is OK. + + @core.built_in('eval') + def _(args: Sequence[Form]) -> Form: + match args: + case [form]: + return eval_(form, repl_env) + case _: + raise Error('bad arguments') + + rep('(def! not (fn* (a) (if a false true)))', repl_env) + rep("""(def! load-file (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) + match sys.argv: + case _, file_name, *args: + repl_env['*ARGV*'] = List(String(a) for a in args) + rep(f'(load-file "{file_name}")', repl_env) + case _: + repl_env['*ARGV*'] = List() + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step7_quote.py b/impls/python3/step7_quote.py new file mode 100644 index 0000000000..2c9eebe06d --- /dev/null +++ b/impls/python3/step7_quote.py @@ -0,0 +1,216 @@ +import functools +import sys +import traceback +from collections.abc import Sequence + +import core + +from env import call_env + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, + Map, Nil, String, Symbol, TCOEnv, + Vector, pr_seq) + +import reader + +# Special forms return either a final result or a new TCO context. +SpecialResult = tuple[Form, Env | None] + + +def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value, None + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return form, let_env + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [*forms, last]: + for form in forms: + eval_(form, env) + return last, env + case _: + raise Error('do: no argument') + + +def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: + if 2 <= len(args) <= 3: + if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): + if len(args) == 3: + return args[2], env + return Nil.NIL, None + return args[1], env + raise Error('if: bad argument count: ' + pr_seq(args)) + + +def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as forms, body]: + # The new structure convinces mypy. + parms = [] + for parm in forms: + if not isinstance(parm, Symbol): + raise Error(f'fn*: {parm} is not a symbol') + parms.append(parm) + + def fenv(f_args: Sequence[Form]) -> Env: + return call_env(env, parms, f_args) + + def call(f_args: Sequence[Form]) -> Form: + return eval_(body, fenv(f_args)) + + return Fn(call, TCOEnv(body, fenv)), None + case _: + raise Error('fn*: bad arguments: ' + pr_seq(args)) + + +def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: + match args: + case [form]: + return form, None + case _: + raise Error('quote: bad arguments: ' + pr_seq(args)) + + +def qq_loop(acc: List, elt: Form) -> List: + match elt: + case List([Symbol('splice-unquote'), form]): + return List((Symbol('concat'), form, acc)) + case List([Symbol('splice-unquote'), *args]): + raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) + case _: + return List((Symbol('cons'), quasiquote(elt), acc)) + + +def qq_foldr(forms: Sequence[Form]) -> List: + return functools.reduce(qq_loop, reversed(forms), List()) + + +def quasiquote(ast: Form) -> Form: + match ast: + case Map() | Symbol(): + return List((Symbol('quote'), ast)) + case Vector(): + return List((Symbol('vec'), qq_foldr(ast))) + case List([Symbol('unquote'), form]): + return form + case List([Symbol('unquote'), *args]): + raise Error('unquote: bad arguments: ' + pr_seq(args)) + case List(): + return qq_foldr(ast) + case _: + return ast + + +def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [form]: + return quasiquote(form), env + case _: + raise Error('quasiquote: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, + 'do': eval_do, + 'if': eval_if, + 'fn*': eval_fn, + 'quote': eval_quote, + 'quasiquote': eval_quasiquote, +} + + +def eval_(ast: Form, env: Env) -> Form: + while True: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + ast, maybe_env = spec(args, env) + if maybe_env is None: + return ast + env = maybe_env + else: + match eval_(first, env): + case Fn(tco_env=TCOEnv(body, fenv)): + ast = body + env = fenv(tuple(eval_(x, env) for x in args)) + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env(core.ns) # Modifying ns is OK. + + @core.built_in('eval') + def _(args: Sequence[Form]) -> Form: + match args: + case [form]: + return eval_(form, repl_env) + case _: + raise Error('bad arguments') + + rep('(def! not (fn* (a) (if a false true)))', repl_env) + rep("""(def! load-file (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) + match sys.argv: + case _, file_name, *args: + repl_env['*ARGV*'] = List(String(a) for a in args) + rep(f'(load-file "{file_name}")', repl_env) + case _: + repl_env['*ARGV*'] = List() + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step8_macros.py b/impls/python3/step8_macros.py new file mode 100644 index 0000000000..9fcd1ad34c --- /dev/null +++ b/impls/python3/step8_macros.py @@ -0,0 +1,236 @@ +import functools +import sys +import traceback +from collections.abc import Sequence + +import core + +from env import call_env + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, Macro, + Map, Nil, String, Symbol, TCOEnv, + Vector, pr_seq) + +import reader + +# Special forms return either a final result or a new TCO context. +SpecialResult = tuple[Form, Env | None] + + +def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value, None + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return form, let_env + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [*forms, last]: + for form in forms: + eval_(form, env) + return last, env + case _: + raise Error('do: no argument') + + +def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: + if 2 <= len(args) <= 3: + if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): + if len(args) == 3: + return args[2], env + return Nil.NIL, None + return args[1], env + raise Error('if: bad argument count: ' + pr_seq(args)) + + +def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as forms, body]: + # The new structure convinces mypy. + parms = [] + for parm in forms: + if not isinstance(parm, Symbol): + raise Error(f'fn*: {parm} is not a symbol') + parms.append(parm) + + def fenv(f_args: Sequence[Form]) -> Env: + return call_env(env, parms, f_args) + + def call(f_args: Sequence[Form]) -> Form: + return eval_(body, fenv(f_args)) + + return Fn(call, TCOEnv(body, fenv)), None + case _: + raise Error('fn*: bad arguments: ' + pr_seq(args)) + + +def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: + match args: + case [form]: + return form, None + case _: + raise Error('quote: bad arguments: ' + pr_seq(args)) + + +def qq_loop(acc: List, elt: Form) -> List: + match elt: + case List([Symbol('splice-unquote'), form]): + return List((Symbol('concat'), form, acc)) + case List([Symbol('splice-unquote'), *args]): + raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) + case _: + return List((Symbol('cons'), quasiquote(elt), acc)) + + +def qq_foldr(forms: Sequence[Form]) -> List: + return functools.reduce(qq_loop, reversed(forms), List()) + + +def quasiquote(ast: Form) -> Form: + match ast: + case Map() | Symbol(): + return List((Symbol('quote'), ast)) + case Vector(): + return List((Symbol('vec'), qq_foldr(ast))) + case List([Symbol('unquote'), form]): + return form + case List([Symbol('unquote'), *args]): + raise Error('unquote: bad arguments: ' + pr_seq(args)) + case List(): + return qq_foldr(ast) + case _: + return ast + + +def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [form]: + return quasiquote(form), env + case _: + raise Error('quasiquote: bad arguments: ' + pr_seq(args)) + + +def eval_defmacro(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + fun = eval_(form, env) + if not isinstance(fun, Fn): + raise Error(f'defmacro!: {fun} is not a function') + macro = Macro(fun.call) + env[key] = macro + return macro, None + case _: + raise Error('defmacro!: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, + 'do': eval_do, + 'if': eval_if, + 'fn*': eval_fn, + 'quote': eval_quote, + 'quasiquote': eval_quasiquote, + 'defmacro!': eval_defmacro, +} + + +def eval_(ast: Form, env: Env) -> Form: + while True: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + ast, maybe_env = spec(args, env) + if maybe_env is None: + return ast + env = maybe_env + else: + match eval_(first, env): + case Macro(call): + ast = call(args) + case Fn(tco_env=TCOEnv(body, fenv)): + ast = body + env = fenv(tuple(eval_(x, env) for x in args)) + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env(core.ns) # Modifying ns is OK. + + @core.built_in('eval') + def _(args: Sequence[Form]) -> Form: + match args: + case [form]: + return eval_(form, repl_env) + case _: + raise Error('bad arguments') + + rep('(def! not (fn* (a) (if a false true)))', repl_env) + rep("""(def! load-file (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) + rep("""(defmacro! cond (fn* (& xs) (if (> (count xs) 0) + (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""", repl_env) + match sys.argv: + case _, file_name, *args: + repl_env['*ARGV*'] = List(String(a) for a in args) + rep(f'(load-file "{file_name}")', repl_env) + case _: + repl_env['*ARGV*'] = List() + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/step9_try.py b/impls/python3/step9_try.py new file mode 100644 index 0000000000..699b4d1d40 --- /dev/null +++ b/impls/python3/step9_try.py @@ -0,0 +1,252 @@ +import functools +import sys +import traceback +from collections.abc import Sequence + +import core + +from env import call_env + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, Macro, + Map, Nil, String, Symbol, TCOEnv, + ThrownException, Vector, pr_seq) + +import reader + +# Special forms return either a final result or a new TCO context. +SpecialResult = tuple[Form, Env | None] + + +def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value, None + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return form, let_env + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [*forms, last]: + for form in forms: + eval_(form, env) + return last, env + case _: + raise Error('do: no argument') + + +def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: + if 2 <= len(args) <= 3: + if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): + if len(args) == 3: + return args[2], env + return Nil.NIL, None + return args[1], env + raise Error('if: bad argument count: ' + pr_seq(args)) + + +def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as forms, body]: + # The new structure convinces mypy. + parms = [] + for parm in forms: + if not isinstance(parm, Symbol): + raise Error(f'fn*: {parm} is not a symbol') + parms.append(parm) + + def fenv(f_args: Sequence[Form]) -> Env: + return call_env(env, parms, f_args) + + def call(f_args: Sequence[Form]) -> Form: + return eval_(body, fenv(f_args)) + + return Fn(call, TCOEnv(body, fenv)), None + case _: + raise Error('fn*: bad arguments: ' + pr_seq(args)) + + +def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: + match args: + case [form]: + return form, None + case _: + raise Error('quote: bad arguments: ' + pr_seq(args)) + + +def qq_loop(acc: List, elt: Form) -> List: + match elt: + case List([Symbol('splice-unquote'), form]): + return List((Symbol('concat'), form, acc)) + case List([Symbol('splice-unquote'), *args]): + raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) + case _: + return List((Symbol('cons'), quasiquote(elt), acc)) + + +def qq_foldr(forms: Sequence[Form]) -> List: + return functools.reduce(qq_loop, reversed(forms), List()) + + +def quasiquote(ast: Form) -> Form: + match ast: + case Map() | Symbol(): + return List((Symbol('quote'), ast)) + case Vector(): + return List((Symbol('vec'), qq_foldr(ast))) + case List([Symbol('unquote'), form]): + return form + case List([Symbol('unquote'), *args]): + raise Error('unquote: bad arguments: ' + pr_seq(args)) + case List(): + return qq_foldr(ast) + case _: + return ast + + +def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [form]: + return quasiquote(form), env + case _: + raise Error('quasiquote: bad arguments: ' + pr_seq(args)) + + +def eval_defmacro(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + fun = eval_(form, env) + if not isinstance(fun, Fn): + raise Error(f'defmacro!: {fun} is not a function') + macro = Macro(fun.call) + env[key] = macro + return macro, None + case _: + raise Error('defmacro!: bad arguments: ' + pr_seq(args)) + + +def eval_try(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [test]: + return test, env + case [test, List([Symbol('catch*'), Symbol() as key, handler])]: + try: + return eval_(test, env), None + except ThrownException as exc: + return handler, env.new_child({key: exc.form}) + except Error as exc: + return handler, env.new_child({key: String(str(exc))}) + case _: + raise Error('try*: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, + 'do': eval_do, + 'if': eval_if, + 'fn*': eval_fn, + 'quote': eval_quote, + 'quasiquote': eval_quasiquote, + 'defmacro!': eval_defmacro, + 'try*': eval_try, +} + + +def eval_(ast: Form, env: Env) -> Form: + while True: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + ast, maybe_env = spec(args, env) + if maybe_env is None: + return ast + env = maybe_env + else: + match eval_(first, env): + case Macro(call): + ast = call(args) + case Fn(tco_env=TCOEnv(body, fenv)): + ast = body + env = fenv(tuple(eval_(x, env) for x in args)) + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env(core.ns) # Modifying ns is OK. + + @core.built_in('eval') + def _(args: Sequence[Form]) -> Form: + match args: + case [form]: + return eval_(form, repl_env) + case _: + raise Error('bad arguments') + + rep('(def! not (fn* (a) (if a false true)))', repl_env) + rep("""(def! load-file (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) + rep("""(defmacro! cond (fn* (& xs) (if (> (count xs) 0) + (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""", repl_env) + match sys.argv: + case _, file_name, *args: + repl_env['*ARGV*'] = List(String(a) for a in args) + rep(f'(load-file "{file_name}")', repl_env) + case _: + repl_env['*ARGV*'] = List() + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/stepA_mal.py b/impls/python3/stepA_mal.py new file mode 100644 index 0000000000..29691fb995 --- /dev/null +++ b/impls/python3/stepA_mal.py @@ -0,0 +1,259 @@ +# pylint: disable=invalid-name +# Disabled because the file name contains a capital letter. Ideally, +# we would check the rest of the module, but this does not matter much +# as step9 is almost identical. + +import functools +import sys +import traceback +from collections.abc import Sequence + +import core + +from env import call_env + +import mal_readline + +from mal_types import (Boolean, Env, Error, Fn, Form, List, Macro, + Map, Nil, String, Symbol, TCOEnv, + ThrownException, Vector, pr_seq) + +import reader + +# Special forms return either a final result or a new TCO context. +SpecialResult = tuple[Form, Env | None] + + +def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + value = eval_(form, env) + env[key] = value + return value, None + case _: + raise Error('def!: bad arguments: ' + pr_seq(args)) + + +def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as binds, form]: + if len(binds) % 2: + raise Error('let*: odd bind count: ' + pr_seq(binds)) + let_env = env.new_child() + for i in range(0, len(binds), 2): + key = binds[i] + if not isinstance(key, Symbol): + raise Error(f'let*: {key} is not a symbol') + let_env[key] = eval_(binds[i + 1], let_env) + return form, let_env + case _: + raise Error('let*: bad arguments: ' + pr_seq(args)) + + +def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [*forms, last]: + for form in forms: + eval_(form, env) + return last, env + case _: + raise Error('do: no argument') + + +def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: + if 2 <= len(args) <= 3: + if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): + if len(args) == 3: + return args[2], env + return Nil.NIL, None + return args[1], env + raise Error('if: bad argument count: ' + pr_seq(args)) + + +def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [List() | Vector() as forms, body]: + # The new structure convinces mypy. + parms = [] + for parm in forms: + if not isinstance(parm, Symbol): + raise Error(f'fn*: {parm} is not a symbol') + parms.append(parm) + + def fenv(f_args: Sequence[Form]) -> Env: + return call_env(env, parms, f_args) + + def call(f_args: Sequence[Form]) -> Form: + return eval_(body, fenv(f_args)) + + return Fn(call, TCOEnv(body, fenv)), None + case _: + raise Error('fn*: bad arguments: ' + pr_seq(args)) + + +def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: + match args: + case [form]: + return form, None + case _: + raise Error('quote: bad arguments: ' + pr_seq(args)) + + +def qq_loop(acc: List, elt: Form) -> List: + match elt: + case List([Symbol('splice-unquote'), form]): + return List((Symbol('concat'), form, acc)) + case List([Symbol('splice-unquote'), *args]): + raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) + case _: + return List((Symbol('cons'), quasiquote(elt), acc)) + + +def qq_foldr(forms: Sequence[Form]) -> List: + return functools.reduce(qq_loop, reversed(forms), List()) + + +def quasiquote(ast: Form) -> Form: + match ast: + case Map() | Symbol(): + return List((Symbol('quote'), ast)) + case Vector(): + return List((Symbol('vec'), qq_foldr(ast))) + case List([Symbol('unquote'), form]): + return form + case List([Symbol('unquote'), *args]): + raise Error('unquote: bad arguments: ' + pr_seq(args)) + case List(): + return qq_foldr(ast) + case _: + return ast + + +def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [form]: + return quasiquote(form), env + case _: + raise Error('quasiquote: bad arguments: ' + pr_seq(args)) + + +def eval_defmacro(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [Symbol() as key, form]: + fun = eval_(form, env) + if not isinstance(fun, Fn): + raise Error(f'defmacro!: {fun} is not a function') + macro = Macro(fun.call) + env[key] = macro + return macro, None + case _: + raise Error('defmacro!: bad arguments: ' + pr_seq(args)) + + +def eval_try(args: Sequence[Form], env: Env) -> SpecialResult: + match args: + case [test]: + return test, env + case [test, List([Symbol('catch*'), Symbol() as key, handler])]: + try: + return eval_(test, env), None + except ThrownException as exc: + return handler, env.new_child({key: exc.form}) + except Error as exc: + return handler, env.new_child({key: String(str(exc))}) + case _: + raise Error('try*: bad arguments: ' + pr_seq(args)) + + +specials = { + 'def!': eval_def, + 'let*': eval_let, + 'do': eval_do, + 'if': eval_if, + 'fn*': eval_fn, + 'quote': eval_quote, + 'quasiquote': eval_quasiquote, + 'defmacro!': eval_defmacro, + 'try*': eval_try, +} + + +def eval_(ast: Form, env: Env) -> Form: + while True: + if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): + print(f'EVAL: {ast}') # , repr(ast)) + for outer in env.maps: + print(' ENV:', ' '.join(f'{k}: {v}' + for k, v in reversed(outer.items()))[:75]) + match ast: + case Symbol(): + if (value := env.get(ast)) is not None: + return value + raise Error(f"'{ast}' not found") + case Map(): + return Map((k, eval_(v, env)) for k, v in ast.items()) + case Vector(): + return Vector(eval_(x, env) for x in ast) + case List([first, *args]): + if isinstance(first, Symbol) and (spec := specials.get(first)): + ast, maybe_env = spec(args, env) + if maybe_env is None: + return ast + env = maybe_env + else: + match eval_(first, env): + case Macro(call): + ast = call(args) + case Fn(tco_env=TCOEnv(body, fenv)): + ast = body + env = fenv(tuple(eval_(x, env) for x in args)) + case Fn(call): + return call(tuple(eval_(x, env) for x in args)) + case not_fun: + raise Error(f'cannot apply {not_fun}') + case _: + return ast + + +def rep(source: str, env: Env) -> str: + return str(eval_(reader.read(source), env)) + + +def main() -> None: + repl_env = Env(core.ns) # Modifying ns is OK. + + @core.built_in('eval') + def _(args: Sequence[Form]) -> Form: + match args: + case [form]: + return eval_(form, repl_env) + case _: + raise Error('bad arguments') + + rep('(def! not (fn* (a) (if a false true)))', repl_env) + rep("""(def! load-file (fn* (f) + (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) + rep("""(defmacro! cond (fn* (& xs) (if (> (count xs) 0) + (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) + (throw "odd number of forms to cond")) + (cons 'cond (rest (rest xs)))))))""", repl_env) + rep('(def! *host-language* "python3")', repl_env) + match sys.argv: + case _, file_name, *args: + repl_env['*ARGV*'] = List(String(a) for a in args) + rep(f'(load-file "{file_name}")', repl_env) + case _: + repl_env['*ARGV*'] = List() + rep('(println (str "Mal [" *host-language* "]"))', repl_env) + while True: + try: + print(rep(mal_readline.input_('user> '), repl_env)) + except EOFError: + break + # pylint: disable-next=broad-exception-caught + except Exception as exc: + traceback.print_exception(exc, limit=10) + + +if __name__ == '__main__': + main() diff --git a/impls/python3/tests/__init__.py b/impls/python3/tests/__init__.py new file mode 100644 index 0000000000..e69de29bb2 diff --git a/impls/python3/tests/step5_tco.mal b/impls/python3/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/python3/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/python3/tests/stepA_mal.mal b/impls/python3/tests/stepA_mal.mal new file mode 100644 index 0000000000..8d8731a87e --- /dev/null +++ b/impls/python3/tests/stepA_mal.mal @@ -0,0 +1,32 @@ +*host-language* +;=>"python3" + +;; Testing Python interop + +;; Testing Python expressions + +(py* "7") +;=>7 + +(py* "'7'") +;=>"7" + +(py* "[7,8,9]") +;=>(7 8 9) + +(py* "' '.join(f'X{c}Y' for c in 'abc')") +;=>"XaY XbY XcY" + +(py* "list(1 + x for x in range(1, 4))") +;=>(2 3 4) + +;; Testing Python statements + +(py!* "print('hello')") +;/hello +;=>nil + +(py!* "foo = 19 % 4") +;=>nil +(py* "foo") +;=>3 diff --git a/impls/python3/tests/test_step2.py b/impls/python3/tests/test_step2.py new file mode 100644 index 0000000000..5afc6a4147 --- /dev/null +++ b/impls/python3/tests/test_step2.py @@ -0,0 +1,12 @@ +import unittest + +import step2_eval + + +class TestStep3(unittest.TestCase): + def test_step3_let_multiple(self): + self.assertEqual('{"a" 15}', step2_eval.rep('{"a" (+ 7 8)} ')) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_step3.py b/impls/python3/tests/test_step3.py new file mode 100644 index 0000000000..ca5a709deb --- /dev/null +++ b/impls/python3/tests/test_step3.py @@ -0,0 +1,154 @@ +import unittest + +import mal_types +import step3_env +from env import Env +from mal_types import MalList, MalInt +from mal_types import MalSymbol +from mal_types import MalUnknownSymbolException, MalInvalidArgumentException + + +class TestStep3(unittest.TestCase): + def test_env_find(self): + e = Env(None) + e.set("key", MalInt(1)) + result = e.find("key") + self.assertTrue(e is result) + + def test_env_find_outer(self): + outer = Env(None) + e = Env(outer) + outer.set("key", MalInt(1)) + result = e.find("key") + self.assertTrue(result is outer) + + def test_env_find_no_key(self): + e = Env(None) + self.assertEqual(None, e.find("key")) + + def test_env_get(self): + env = Env(None) + expression = MalInt(1) + env.set("key", expression) + self.assertTrue(env.get("key") is expression) + + def test_env_get_error(self): + env = Env(None) + try: + env.get("key") + self.fail("Expected an exeception") + except MalUnknownSymbolException: + pass + + def test_MalFunctionCompiled(self): + self.assertEqual( + "3", + str( + mal_types.MalFunctionCompiled( + lambda a: MalInt(a[0].native() + a[1].native()) + ).call([mal_types.MalInt(1), mal_types.MalInt(2)]) + ), + ) + + def test_eval_invalid(self): + with self.assertRaises(MalInvalidArgumentException): + step3_env.EVAL(MalList([MalInt(1), MalInt(2)]), Env(None)) + + def test_eval_1_plus_1(self): + env = Env(None) + env.set( + "+", + mal_types.MalFunctionCompiled( + lambda a: MalInt(a[0].native() + a[1].native()) + ), + ) + self.assertEqual( + 2, + step3_env.EVAL( + MalList([MalSymbol("+"), MalInt(1), MalInt(1)]), env + ).native(), + ) + + def test_def(self): + env = Env(None) + self.assertEqual( + 1, + step3_env.EVAL( + MalList([MalSymbol("def!"), MalSymbol("a"), MalInt(1)]), env + ).native(), + ) + self.assertEqual(1, env.get("a").native()) + + def test_mallist_native(self): + x = MalInt(1) + self.assertEqual([x], MalList([x]).native()) + + def test_let_basic(self): + env = Env(None) + self.assertEqual( + 2, + step3_env.EVAL( + MalList( + [ + MalSymbol("let*"), + MalList([MalSymbol("c"), MalInt(2)]), + MalSymbol("c"), + ] + ), + env, + ).native(), + ) + + def test_let_advanced(self): + env = Env(None) + env.set( + "+", + mal_types.MalFunctionCompiled( + lambda a: MalInt(a[0].native() + a[1].native()) + ), + ) + self.assertEqual( + 4, + step3_env.EVAL( + MalList( + [ + MalSymbol("let*"), + MalList([MalSymbol("c"), MalInt(2)]), + MalList([MalSymbol("+"), MalSymbol("c"), MalInt(2)]), + ] + ), + env, + ).native(), + ) + + def test_let_multiple(self): + env = Env(None) + env.set( + "+", + mal_types.MalFunctionCompiled( + lambda a: MalInt(a[0].native() + a[1].native()) + ), + ) + self.assertEqual( + 5, + step3_env.EVAL( + MalList( + [ + MalSymbol("let*"), + MalList([MalSymbol("c"), MalInt(2), MalSymbol("d"), MalInt(3)]), + MalList([MalSymbol("+"), MalSymbol("c"), MalSymbol("d")]), + ] + ), + env, + ).native(), + ) + + def test_step3_let_multiple(self): + self.assertEqual("5", step3_env.rep("(let* (c 2 d 3) (+ c d))")) + + def test_step3_let_nested_backref(self): + self.assertEqual("6", step3_env.rep("(let* (c 2 d c) (+ c (+ d 2)))")) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_step4.py b/impls/python3/tests/test_step4.py new file mode 100644 index 0000000000..800f5598d1 --- /dev/null +++ b/impls/python3/tests/test_step4.py @@ -0,0 +1,212 @@ +import unittest + +import step4_if_fn_do +from env import Env +from mal_types import MalInvalidArgumentException +from mal_types import MalList, MalInt, MalFunctionCompiled, MalBoolean +from mal_types import MalSymbol + + +class TestStep4(unittest.TestCase): + def test_step4_nil(self): + self.assertEqual("nil", step4_if_fn_do.rep("nil")) + + def test_step4_boolean(self): + self.assertEqual("true", step4_if_fn_do.rep("true")) + self.assertEqual("false", step4_if_fn_do.rep("false")) + + def test_print_function(self): + self.assertEqual("#", str(MalFunctionCompiled(lambda x: MalInt(0)))) + + def test_if_basic_true(self): + env = Env(None) + self.assertEqual( + 4321, + step4_if_fn_do.EVAL( + MalList( + [MalSymbol("if"), MalBoolean(True), MalInt(4321), MalInt(1234)] + ), + env, + ).native(), + ) + + def test_if_basic_false(self): + env = Env(None) + self.assertEqual( + 1234, + step4_if_fn_do.EVAL( + MalList( + [MalSymbol("if"), MalBoolean(False), MalInt(4321), MalInt(1234)] + ), + env, + ).native(), + ) + + def test_if_basic_false_no_fourth_arg(self): + env = Env(None) + self.assertEqual( + "nil", + str( + step4_if_fn_do.EVAL( + MalList([MalSymbol("if"), MalBoolean(False), MalInt(4321)]), env + ) + ), + ) + + def test_env_constructor_binds(self): + env = Env(outer=None, binds=[MalSymbol("a")], exprs=[MalInt(3)]) + self.assertEqual(3, env.get("a").native()) + + def test_env_constructor_binds_multiple(self): + env = Env( + outer=None, + binds=[MalSymbol("a"), MalSymbol("b")], + exprs=[MalInt(44), MalInt(32)], + ) + self.assertEqual(44, env.get("a").native()) + self.assertEqual(32, env.get("b").native()) + + def test_step4_do(self): + self.assertEqual("44", step4_if_fn_do.rep("(do 1 2 3 44)")) + self.assertEqual("21", step4_if_fn_do.rep("(do 21)")) + + def test_step4_fn(self): + self.assertEqual("#", step4_if_fn_do.rep("(fn* (a) 0)")) + + def test_step4_use_fn(self): + self.assertEqual("7", step4_if_fn_do.rep("((fn* (a) a) 7)")) + + def test_step4_use_fn_multiple(self): + self.assertEqual("8", step4_if_fn_do.rep("((fn* (a b) a) 8 9)")) + + def test_step4_use_fn_multiple_nested(self): + self.assertEqual("10", step4_if_fn_do.rep("((fn* (a b) (+ a (+ b 1))) 4 5)")) + + def test_step4_use_fn_func_param(self): + self.assertEqual( + "8", step4_if_fn_do.rep("((fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7)") + ) + + def test_step4_prn(self): + self.assertEqual("nil", step4_if_fn_do.rep("(prn 4)")) + + def test_step4_list(self): + self.assertEqual("(1 2 (3 4) 5)", step4_if_fn_do.rep("(list 1 2 (list 3 4) 5)")) + + def test_step4_listP(self): + self.assertEqual("true", step4_if_fn_do.rep("(list? (list 1 2))")) + self.assertEqual("false", step4_if_fn_do.rep("(list? 4)")) + + def test_step4_empty(self): + self.assertEqual("true", step4_if_fn_do.rep("(empty? (list))")) + + def test_step4_count(self): + self.assertEqual("0", step4_if_fn_do.rep("(count (list))")) + self.assertEqual("2", step4_if_fn_do.rep("(count (list 1 2))")) + self.assertEqual("0", step4_if_fn_do.rep("(count nil)")) + + def test_step4_equal(self): + self.assertEqual("true", step4_if_fn_do.rep("(= 0 0)")) + self.assertEqual("true", step4_if_fn_do.rep("(= (list 1) (list 1))")) + self.assertEqual("false", step4_if_fn_do.rep("(= (list 1) (list 1 2))")) + self.assertEqual( + "true", + step4_if_fn_do.rep("(= (list (list 1) (list 2)) (list (list 1) (list 2)))"), + ) + self.assertEqual("true", step4_if_fn_do.rep("(= nil nil)")) + + def test_step4_less(self): + self.assertEqual("true", step4_if_fn_do.rep("(< 1 2)")) + self.assertEqual("false", step4_if_fn_do.rep("(< 2 1)")) + self.assertEqual("false", step4_if_fn_do.rep("(< 1 1)")) + try: + step4_if_fn_do.rep("(< 1 nil)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + try: + step4_if_fn_do.rep("(< nil 1)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + + def test_step4_less_equal(self): + self.assertEqual("true", step4_if_fn_do.rep("(<= 1 2)")) + self.assertEqual("false", step4_if_fn_do.rep("(<= 2 1)")) + self.assertEqual("true", step4_if_fn_do.rep("(<= 1 1)")) + try: + step4_if_fn_do.rep("(<= 1 nil)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + try: + step4_if_fn_do.rep("(<= nil 1)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + + def test_step4_more(self): + self.assertEqual("false", step4_if_fn_do.rep("(> 1 2)")) + self.assertEqual("true", step4_if_fn_do.rep("(> 2 1)")) + self.assertEqual("false", step4_if_fn_do.rep("(> 1 1)")) + try: + step4_if_fn_do.rep("(> 1 nil)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + try: + step4_if_fn_do.rep("(> nil 1)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + + def test_step4_more_equal(self): + self.assertEqual("false", step4_if_fn_do.rep("(>= 1 2)")) + self.assertEqual("true", step4_if_fn_do.rep("(>= 2 1)")) + self.assertEqual("true", step4_if_fn_do.rep("(>= 1 1)")) + try: + step4_if_fn_do.rep("(>= 1 nil)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + try: + step4_if_fn_do.rep("(>= nil 1)") + self.fail("Expected exception") + except MalInvalidArgumentException: + pass + + def test_step4_closures(self): + self.assertEqual( + "12", step4_if_fn_do.rep("(( (fn* (a) (fn* (b) (+ a b))) 5) 7)") + ) + self.assertEqual( + "#", + step4_if_fn_do.rep("(def! gen-plus5 (fn* () (fn* (b) (+ 5 b))))"), + ) + self.assertEqual( + "#", + step4_if_fn_do.rep("(def! gen-plus5 (fn* () (fn* (b) (+ 5 b))))"), + ) + self.assertEqual("#", step4_if_fn_do.rep("(def! plus5 (gen-plus5))")) + self.assertEqual("12", step4_if_fn_do.rep("(plus5 7)")) + + def test_step4_variadic_a(self): + self.assertEqual( + "3", step4_if_fn_do.rep("( (fn* (& more) (count more)) 1 2 3)") + ) + + def test_step4_variadic_b(self): + self.assertEqual("0", step4_if_fn_do.rep("((fn* (& more) (count more)))")) + + def test_step4_quoted_string(self): + self.assertEqual('"\\""', step4_if_fn_do.rep('"\\""')) + + def test_step4_str(self): + self.assertEqual('"(1 a 2 3)"', step4_if_fn_do.rep('(str (list 1 "a" 2 3))')) + + def test_step4_equal_vector_list(self): + self.assertEqual("true", step4_if_fn_do.rep("(=[] (list))")) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_step5.py b/impls/python3/tests/test_step5.py new file mode 100644 index 0000000000..214cd150ab --- /dev/null +++ b/impls/python3/tests/test_step5.py @@ -0,0 +1,21 @@ +import unittest + +import step5_tco + + +class TestStep5(unittest.TestCase): + def test_step5_tco(self): + self.assertEqual( + "#", + step5_tco.rep( + "(def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc)))))" + ), + ) + self.assertEqual("55", step5_tco.rep("(sum2 10 0)")) + self.assertEqual("nil", step5_tco.rep("(def! res2 nil)")) + self.assertEqual("500500", step5_tco.rep("(def! res2 (sum2 1000 0))")) + self.assertEqual("500500", step5_tco.rep("res2")) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_step6.py b/impls/python3/tests/test_step6.py new file mode 100644 index 0000000000..8a6425adfb --- /dev/null +++ b/impls/python3/tests/test_step6.py @@ -0,0 +1,72 @@ +import unittest + +import reader +import step6_file +from env import Env +from mal_types import MalList, MalAtom, MalInt +from mal_types import MalSyntaxException, MalString + + +class TestStep6(unittest.TestCase): + def test_step6_string_unbalanced(self): + with self.assertRaises(MalSyntaxException): + step6_file.rep('"foo') + + def test_step6_standard_string(self): + self.assertEqual( + '"foo"', step6_file.EVAL(MalString('"foo"'), Env(None)).native() + ) + self.assertEqual('"foo"', step6_file.rep('"foo"').__str__()) + self.assertEqual('"foo"', MalString('"foo"').native()) + self.assertEqual('"\\"foo\\""', MalString('"foo"').__str__()) + + def test_step6_reader_read_string(self): + read = reader.read('(read-string "(1 2 (3 4) nil)")') + self.assertTrue(isinstance(read, MalList)) + arg = read.native()[1] + self.assertTrue(isinstance(arg, MalString)) + native_str = arg.native() + self.assertEqual("(1 2 (3 4) nil)", native_str) + + def test_step6_read_string_no_escapes(self): + self.assertEqual( + "(1 2 (3 4) nil)", step6_file.rep('(read-string "(1 2 (3 4) nil)")') + ) + + def test_step6_slurp(self): + self.assertEqual( + '"A line of text\\n"', step6_file.rep('(slurp "../../tests/test.txt")') + ) + + def test_step6_eval(self): + self.assertEqual("2", step6_file.rep('(eval (read-string "(+ 1 1)"))')) + + def test_step6_str(self): + self.assertEqual('"abc2def ghi"', step6_file.rep('(str "abc" 2 "def" " ghi")')) + + def test_step6_atom_type(self): + atom = step6_file.EVAL(MalAtom(MalInt(1)), Env(None)) + self.assertEqual(1, atom.native().native()) + + def test_step6_read_atom(self): + atom = step6_file.EVAL(step6_file.READ("(atom 1)"), step6_file.repl_env) + self.assertEqual(1, atom.native().native()) + + def test_step6_atom_deref(self): + self.assertEqual("1", step6_file.rep("(deref (atom 1))")) + + def test_step6_atom_p(self): + self.assertEqual("true", step6_file.rep("(atom? (atom 1))")) + self.assertEqual("false", step6_file.rep("(atom? (+ 1 2))")) + + def test_step6_reset(self): + self.assertEqual("3", step6_file.rep("(do (def! a (atom 2)) (reset! a 3))")) + + def test_step6_swap(self): + self.assertEqual("#", step6_file.rep("(def! inc3 (fn* (a) (+ 3 a)))")) + self.assertEqual("(atom 2)", step6_file.rep("(def! a (atom 2))")) + self.assertEqual("3", step6_file.rep("(swap! a + 1)")) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_step7.py b/impls/python3/tests/test_step7.py new file mode 100644 index 0000000000..192916a225 --- /dev/null +++ b/impls/python3/tests/test_step7.py @@ -0,0 +1,27 @@ +import unittest + +import step7_quote + + +class TestStep7(unittest.TestCase): + def test_step7_cons(self): + self.assertEqual("(1)", step7_quote.rep("(cons 1 (list))")) + + def test_step7_concat(self): + self.assertEqual("()", step7_quote.rep("(concat)")) + + def test_step7_quote(self): + self.assertEqual("(+ 1 2)", step7_quote.rep("(quote (+ 1 2))")) + + def test_step7_quasiquote(self): + self.assertEqual( + "(+ 1 3)", step7_quote.rep("(quasiquote (+ 1 (unquote (+ 1 2))))") + ) + + def test_step7_quasiquote_advanced(self): + self.assertEqual("(2)", step7_quote.rep("(def! c '(2))")) + self.assertEqual("(1 2 3)", step7_quote.rep("`[1 ~@c 3]")) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_step8.py b/impls/python3/tests/test_step8.py new file mode 100644 index 0000000000..7bddaf4b82 --- /dev/null +++ b/impls/python3/tests/test_step8.py @@ -0,0 +1,100 @@ +import unittest + +import core +import step8_macros +from env import Env +from mal_types import MalFunctionCompiled, MalInt, MalFunctionRaw, MalList +from mal_types import MalInvalidArgumentException, MalIndexError + + +class TestStep8(unittest.TestCase): + def setUp(self) -> None: + self._repl_env = step8_macros.init_repl_env() + + def rep(self, input: str) -> str: + return step8_macros.rep(input, self._repl_env) + + def test_step8_is_macro(self): + self.assertEqual(False, MalFunctionCompiled(lambda a: MalInt(1)).is_macro()) + self.assertEqual( + False, + MalFunctionRaw(core.ns["+"], MalInt(1), MalList([]), Env(None)).is_macro(), + ) + + def test_step8_defmacro(self): + self.assertEqual("#", self.rep("(defmacro! one (fn* () 1))")) + + def test_step8_quote_reader_macro(self): + self.assertEqual("(+ 1 2)", self.rep("'(+ 1 2)")) + + def test_step8_quasiquote_unquote_reader_macros(self): + self.assertEqual("(+ 1 3)", self.rep("`(+ 1 ~(+ 1 2))")) + + def test_step8_repl_env_isolation(self): + env1 = step8_macros.init_repl_env() + step8_macros.rep("(def! a 2)", env1) + env2 = step8_macros.init_repl_env() + step8_macros.rep("(def! a 3)", env2) + self.assertEqual("2", step8_macros.rep("a", env1)) + self.assertEqual("3", step8_macros.rep("a", env2)) + self.assertEqual("6", step8_macros.rep("(eval (list + a 3))", env2)) + + def test_step8_is_macro_call(self): + self.rep("(defmacro! macro (fn* () 1))") + self.rep("(def! func (fn* () 1))") + self.rep("(def! q 4)") + macro = step8_macros.READ("(macro)") + func = step8_macros.READ("(func)") + other1 = step8_macros.READ("(x)") + other2 = step8_macros.READ("(1)") + other3 = step8_macros.READ("(2)") + other4 = step8_macros.READ("(q)") + self.assertTrue(step8_macros.is_macro_call(macro, self._repl_env)) + self.assertFalse(step8_macros.is_macro_call(func, self._repl_env)) + self.assertFalse(step8_macros.is_macro_call(other1, self._repl_env)) + self.assertFalse(step8_macros.is_macro_call(other2, self._repl_env)) + self.assertFalse(step8_macros.is_macro_call(other3, self._repl_env)) + self.assertFalse(step8_macros.is_macro_call(other4, self._repl_env)) + + def test_step8_macroexpand(self): + self.rep("(def! func (fn* () 1))") + func = step8_macros.READ("(func)") + self.assertEqual("(func)", str(step8_macros.macroexpand(func, self._repl_env))) + self.rep("(defmacro! macro (fn* () 1))") + macro = step8_macros.READ("(macro)") + self.assertEqual("1", str(step8_macros.macroexpand(macro, self._repl_env))) + self.rep("(defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a)))") + self.assertEqual("(if true 7 8)", self.rep("(macroexpand (unless true 8 7))")) + + def test_step8_not(self): + self.assertEqual("true", self.rep("(not (not true))")) + self.assertEqual("true", self.rep("(not nil)")) + self.assertEqual("false", self.rep("(not 1)")) + self.assertEqual("true", self.rep("(not false)")) + + def test_step8_let(self): + self.assertEqual("2", self.rep("(let* (a 1 b 2) b)")) + + def test_step8_first(self): + self.assertEqual("2", self.rep("(first (list 2 3 4))")) + self.assertEqual("nil", self.rep("(first (list))")) + self.assertEqual("nil", self.rep("(first nil)")) + with self.assertRaises(MalInvalidArgumentException): + self.rep("(first 1)") + + def test_step8_rest(self): + self.assertEqual("(2 3)", self.rep("(rest (list 1 2 3))")) + self.assertEqual("()", self.rep("(rest (list))")) + self.assertEqual("()", self.rep("(rest nil)")) + with self.assertRaises(MalInvalidArgumentException): + self.rep("(rest 1)") + + def test_step8_nth(self): + self.assertEqual("3", self.rep("(nth '(1 2 3) 2)")) + + with self.assertRaises(MalIndexError): + self.rep("(nth () 1)") + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_step9.py b/impls/python3/tests/test_step9.py new file mode 100644 index 0000000000..b216c85594 --- /dev/null +++ b/impls/python3/tests/test_step9.py @@ -0,0 +1,143 @@ +import unittest + +import step9_try +from mal_types import MalException, MalIndexError, MalInvalidArgumentException + + +class TestStep9(unittest.TestCase): + def setUp(self) -> None: + self._repl_env = step9_try.init_repl_env() + + def rep(self, input: str) -> str: + return step9_try.rep(input, self._repl_env) + + def test_step9_throw(self): + with self.assertRaises(MalException): + self.assertEqual("foo", self.rep('(throw "err1")')) + + def test_step9_try_catch(self): + self.assertEqual("123", self.rep("(try* 123 (catch* e 456))")) + self.assertEqual( + "nil", self.rep('(try* (abc 1 2) (catch* exc (prn "exc is:" exc)))') + ) + + def test_step9_nth(self): + self.assertEqual("3", self.rep("(nth '(1 2 3) 2)")) + + with self.assertRaises(MalIndexError): + self.rep("(nth () 1)") + + def test_step9_apply(self): + self.assertEqual("(1 1)", self.rep("(apply list '(1 1))")) + self.assertEqual("(1 2 1 2)", self.rep("(apply list 1 2 '(1 2))")) + + def test_step9_map(self): + self.assertEqual("((1) (2))", self.rep("(map list '(1 2))")) + + def test_step9_symbol_q(self): + self.assertEqual("true", self.rep("(symbol? 'x)")) + self.assertEqual("false", self.rep("(symbol? nil)")) + + def test_step9_nil(self): + self.assertEqual("true", self.rep("(nil? nil)")) + self.assertEqual("false", self.rep("(nil? 1)")) + + def test_step9_true(self): + self.assertEqual("true", self.rep("(true? true)")) + self.assertEqual("false", self.rep("(true? false)")) + self.assertEqual("false", self.rep("(true? nil)")) + self.assertEqual("false", self.rep("(true? 1)")) + + def test_step9_false(self): + self.assertEqual("true", self.rep("(false? false)")) + self.assertEqual("false", self.rep("(false? true)")) + self.assertEqual("false", self.rep("(false? nil)")) + self.assertEqual("false", self.rep("(false? 1)")) + + def test_step9_throw_hash_map(self): + with self.assertRaises(MalException): + self.rep('(throw {:msg "err2"})') + + def test_step9_symbol(self): + self.assertEqual("abc", self.rep('(symbol "abc")')) + + def test_step9_complex_apply(self): + self.assertEqual("9", self.rep("(apply + 4 [5])")) + + def test_step9_get(self): + self.assertEqual("nil", self.rep('(get nil "a")')) + self.assertEqual("nil", self.rep('(get (hash-map) "a")')) + + def test_step9_complex_str(self): + self.assertEqual('"A{:abc val}Z"', self.rep('(str "A" {:abc "val"} "Z")')) + + def test_step9_sequential_q(self): + self.assertEqual("true", self.rep("(sequential? (list 1 2 3))")) + self.assertEqual("true", self.rep("(sequential? ())")) + self.assertEqual("false", self.rep("(sequential? nil)")) + self.assertEqual("false", self.rep("(sequential? 1)")) + self.assertEqual("true", self.rep("(sequential? [1 2 3])")) + self.assertEqual("true", self.rep("(sequential? [])")) + self.assertEqual("false", self.rep("(sequential? {})")) + + def test_step9_vector(self): + self.assertEqual("[1 2 3]", self.rep("(vector 1 2 3)")) + self.assertEqual("[]", self.rep("(vector)")) + self.assertEqual("[[1 2]]", self.rep("(vector [1 2])")) + self.assertEqual("[nil]", self.rep("(vector nil)")) + + def test_step9_hash_map(self): + self.assertEqual("{}", self.rep("(hash-map)")) + self.assertEqual('{"a" 1}', self.rep('(hash-map "a" 1)')) + self.assertEqual('{"a" 1 "b" 2}', self.rep('(hash-map "a" 1 "b" 2)')) + + def test_step9_assoc(self): + with self.assertRaises(MalInvalidArgumentException): + self.rep("(assoc)") + self.assertEqual("1", self.rep("(assoc 1)")) + self.assertEqual("nil", self.rep("(assoc nil)")) + self.assertEqual("{}", self.rep("(assoc {})")) + self.assertEqual('{"a" 1}', self.rep('(assoc {} "a" 1)')) + self.assertEqual('{"b" 2 "a" 1}', self.rep('(assoc {"b" 2} "a" 1)')) + self.assertEqual('{"b" 2 "a" 1 "c" 3}', self.rep('(assoc {"b" 2} "a" 1 "c" 3)')) + self.assertEqual('{"b" 3}', self.rep('(assoc {"b" 2} "b" 3)')) + self.assertEqual("{:bcd 234}", self.rep("(assoc {} :bcd 234)")) + + def test_step9_contains_q(self): + with self.assertRaises(MalInvalidArgumentException): + self.rep("(contains?)") + with self.assertRaises(MalInvalidArgumentException): + self.rep("(contains? 1)") + with self.assertRaises(MalInvalidArgumentException): + self.rep("(contains? nil)") + with self.assertRaises(MalInvalidArgumentException): + self.rep("(contains? nil nil)") + self.assertEqual("false", self.rep("(contains? {} nil)")) + self.assertEqual("true", self.rep('(contains? {"a" 1} "a")')) + self.assertEqual("true", self.rep('(contains? {"a" 1 :b 2} :b)')) + + def test_step9_keys(self): + with self.assertRaises(MalInvalidArgumentException): + self.rep("(keys)") + with self.assertRaises(MalInvalidArgumentException): + self.rep("(keys 1)") + self.assertEqual('("a")', self.rep('(keys {"a" 1})')) + self.assertEqual('("a" :b)', self.rep('(keys {"a" 1 :b 2})')) + + def test_step9_vals(self): + with self.assertRaises(MalInvalidArgumentException): + self.rep("(vals)") + with self.assertRaises(MalInvalidArgumentException): + self.rep("(vals 1)") + self.assertEqual("(1)", self.rep('(vals {"a" 1})')) + self.assertEqual("(1 2)", self.rep('(vals {"a" 1 :b 2})')) + + def test_step9_dissoc(self): + self.assertEqual('{"c" 3}', self.rep('(dissoc {"a" 1 "b" 2 "c" 3} "a" "b")')) + self.assertEqual( + '{"c" 3}', self.rep('(dissoc {"a" 1 "b" 2 "c" 3} "a" "b" "d")') + ) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/python3/tests/test_stepA.py b/impls/python3/tests/test_stepA.py new file mode 100644 index 0000000000..8f67cda115 --- /dev/null +++ b/impls/python3/tests/test_stepA.py @@ -0,0 +1,67 @@ +import unittest + +import stepA_mal + + +class TestStepA(unittest.TestCase): + def setUp(self) -> None: + self._repl_env = stepA_mal.init_repl_env() + + def rep(self, input: str) -> str: + return stepA_mal.rep(input, self._repl_env) + + def test_stepA_host_language(self): + self.assertEqual('"python.2"', self.rep("*host-language*")) + + def test_stepA_eval_vector(self): + self.assertEqual("[1 2 3]", self.rep("[1 2 (+ 1 2)]")) + + def test_reader_multiple_lines(self): + self.assertEqual("3", self.rep("(do\n1\n2\n3\n)")) + + def test_read_string_multiple_lines(self): + self.assertEqual( + "(do 2 nil)", + self.rep('(read-string (str "(do \n" ";; read\n" "2\n" "\n nil)"))'), + ) + + def test_read_hash_map(self): + self.assertEqual("{}", self.rep("{}")) + self.assertEqual('{"a" 1}', self.rep('{"a" 1}')) + self.assertEqual('{"1" 2 "3" 4}', self.rep('{"1" 2 "3" 4}')) + + def test_get(self): + self.assertEqual("1", self.rep('(get {"+" 1} "+")')) + + def test_keyword(self): + self.assertEqual(":keyword", self.rep(":keyword")) + + def test_deref_reader_macro(self): + self.assertEqual("1", self.rep("@(atom 1)")) + + def test_splice_unquote_reader_macro(self): + self.assertEqual("(splice-unquote (1 2 3))", str(stepA_mal.READ("~@(1 2 3)"))) + + def test_swap_assoc_get(self): + self.assertEqual( + '(atom {"+" #})', self.rep('(def! e (atom {"+" +}))') + ) + self.assertEqual( + '{"+" # "-" #}', self.rep('(swap! e assoc "-" -)') + ) + self.assertEqual("15", self.rep('( (get @e "+") 7 8)')) + self.assertEqual("3", self.rep('( (get @e "-") 11 8)')) + self.assertEqual( + '{"+" # "-" # "foo" ()}', + self.rep('(swap! e assoc "foo" (list))'), + ) + self.assertEqual("()", self.rep('(get @e "foo")')) + self.assertEqual( + '{"+" # "-" # "foo" () "bar" (1 2 3)}', + self.rep('(swap! e assoc "bar" \'(1 2 3))'), + ) + self.assertEqual("(1 2 3)", self.rep('(get @e "bar")')) + + +if __name__ == "__main__": + unittest.main() diff --git a/impls/r/Dockerfile b/impls/r/Dockerfile new file mode 100644 index 0000000000..ab45325191 --- /dev/null +++ b/impls/r/Dockerfile @@ -0,0 +1,22 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install curl gcc libc-dev libreadline-dev r-base-core diff --git a/impls/r/Makefile b/impls/r/Makefile new file mode 100644 index 0000000000..1b7e65e27f --- /dev/null +++ b/impls/r/Makefile @@ -0,0 +1,35 @@ +SOURCES_BASE = readline.r types.r reader.r printer.r +SOURCES_LISP = env.r core.r stepA_mal.r +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +STEPS = step0_repl.r step1_read_print.r step2_eval.r step3_env.r \ + step4_if_fn_do.r step5_tco.r step6_file.r \ + step7_quote.r step8_macros.r step9_try.r stepA_mal.r + +all: libs + +dist: mal.r mal + +mal.r: $(SOURCES) + cat $+ | grep -v " source(" > $@ + +mal: mal.r + echo "#!/usr/bin/env Rscript" > $@ + cat $< >> $@ + chmod +x $@ + +$(STEPS): libs + +.PHONY: +libs: lib/rdyncall + +lib/rdyncall: + curl -O http://cran.r-project.org/src/contrib/Archive/rdyncall/rdyncall_0.7.5.tar.gz + mkdir -p lib + R CMD INSTALL rdyncall_0.7.5.tar.gz -l lib/ + rm rdyncall_0.7.5.tar.gz + +clean: + rm -f mal.r mal + + diff --git a/r/core.r b/impls/r/core.r similarity index 85% rename from r/core.r rename to impls/r/core.r index dab36e3675..9a12de3a96 100644 --- a/r/core.r +++ b/impls/r/core.r @@ -95,6 +95,21 @@ conj <- function(obj, ...) { } } +do_seq <- function(obj) { + if (.list_q(obj)) { + if (length(obj) == 0) nil else obj + } else if (.vector_q(obj)) { + if (length(obj) == 0) nil else new.listl(.clone(obj)) + } else if (.string_q(obj)) { + if (nchar(obj) == 0) nil else new.listl(strsplit(obj, "")[[1]]) + } else if (class(obj) == "nil") { + nil + } else { + throw("seq: called on non-sequence") + } +} + + # Metadata functions with_meta <- function(obj, m) { new_obj <- .clone(obj) @@ -125,10 +140,14 @@ core_ns <- list( "nil?"=.nil_q, "true?"=.true_q, "false?"=.false_q, + "string?"=.string_q, "symbol"=new.symbol, "symbol?"=.symbol_q, "keyword"=new.keyword, "keyword?"=.keyword_q, + "number?"=.number_q, + "fn?"=.fn_q, + "macro?"=.macro_q, "pr-str"=pr_str, "str"=str, @@ -163,14 +182,17 @@ core_ns <- list( "sequential?"=.sequential_q, "cons"=cons, "concat"=do_concat, + "vec"=new.vectorl, "nth"=nth, - "first"=function(a) if (length(a) < 1) nil else a[[1]], - "rest"=function(a) new.listl(slice(a,2)), + "first"=function(a) if (.nil_q(a) || length(a) < 1) nil else a[[1]], + "rest"=function(a) if (.nil_q(a)) new.list() else new.listl(slice(a,2)), "empty?"=function(a) .sequential_q(a) && length(a) == 0, "count"=function(a) if (.nil_q(a)) 0 else length(a), "apply"=do_apply, "map"=map, + "conj"=conj, + "seq"=do_seq, "with-meta"=with_meta, "meta"=meta, diff --git a/r/env.r b/impls/r/env.r similarity index 100% rename from r/env.r rename to impls/r/env.r diff --git a/r/printer.r b/impls/r/printer.r similarity index 91% rename from r/printer.r rename to impls/r/printer.r index 71deef7d58..ed8cbd42a4 100644 --- a/r/printer.r +++ b/impls/r/printer.r @@ -29,6 +29,9 @@ if(!exists("..types..")) source("types.r") "character"={ if (substring(exp,1,1) == "\u029e") { concat(":", substring(exp,2)) + } else if (substring(exp,1,8) == "") { + # terrible hack, appears in 3.1.1 on Utopic + concat(":", substring(exp,9)) } else if (print_readably) { paste("\"", gsub("\\n", "\\\\n", diff --git a/r/reader.r b/impls/r/reader.r similarity index 90% rename from r/reader.r rename to impls/r/reader.r index 7f20288dcd..dd782991f8 100644 --- a/r/reader.r +++ b/impls/r/reader.r @@ -21,7 +21,7 @@ Reader.next <- function(rdr) { } tokenize <- function(str) { - re <- "[\\s,]*(~@|[\\[\\]\\{\\}\\(\\)'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\\s\\[\\]\\{\\}\\('\"`,;\\)]*)" + re <- "[\\s,]*(~@|[\\[\\]\\{\\}\\(\\)'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]\\{\\}\\('\"`,;\\)]*)" m <- lapply(regmatches(str, gregexpr(re, str, perl=TRUE)), function(e) sub("^[\\s,]+", "", e, perl=TRUE)) res <- list() @@ -42,10 +42,14 @@ read_atom <- function(rdr) { as.integer(token) } else if (re_match("^-?[0-9][0-9.]*$", token)) { as.double(token) + } else if (re_match("^\"(?:\\\\.|[^\\\\\"])*\"$", token)) { + gsub("\x7f", "\\\\", + gsub("\\\\n", "\n", + gsub("\\\\\"", "\"", + gsub("\\\\\\\\", "\x7f", + substr(token, 2, nchar(token)-1))))) } else if (substr(token,1,1) == "\"") { - gsub("\\\\n", "\\n", - gsub("\\\\\"", "\"", - substr(token, 2, nchar(token)-1))) + throw("expected '\"', got EOF") } else if (substr(token,1,1) == ":") { new.keyword(substring(token,2)) } else if (token == "nil") { diff --git a/impls/r/readline.r b/impls/r/readline.r new file mode 100644 index 0000000000..795984c213 --- /dev/null +++ b/impls/r/readline.r @@ -0,0 +1,44 @@ +..readline.. <- TRUE + +HISTORY_FILE = paste(path.expand("~"), "/.mal-history", sep="") + +library(rdyncall, lib.loc="lib/") + +#.rllib <- dynfind(c("edit")) +.rllib <- dynfind(c("readline")) +.call_readline <- .dynsym(.rllib,"readline") +.call_add_history <- .dynsym(.rllib,"add_history") + +.state <- new.env() +.state$rl_history_loaded = FALSE + +.readline <- function(prompt) { + res <- .dyncall(.call_readline, "Z)p", prompt) + if (is.nullptr(res)) { + return(NULL) + } else { + return(ptr2str(res)) + } +} + +readline <- function(prompt) { + if (!.state$rl_history_loaded) { + .state$rl_history_loaded <- TRUE + + if (file.access(HISTORY_FILE, 4) == 0) { + lines <- scan(HISTORY_FILE, what="", sep="\n", quiet=TRUE) + for(add_line in lines) { + .dyncall(.call_add_history, "Z)v", add_line) + } + } + } + + line <- .readline(prompt) + if (is.null(line)) return(NULL) + .dyncall(.call_add_history, "Z)v", line) + if (file.access(HISTORY_FILE, 2) == 0) { + write(line, file=HISTORY_FILE, append=TRUE) + } + + line +} diff --git a/impls/r/run b/impls/r/run new file mode 100755 index 0000000000..916876f09d --- /dev/null +++ b/impls/r/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec Rscript $(dirname $0)/${STEP:-stepA_mal}.r "${@}" diff --git a/r/step0_repl.r b/impls/r/step0_repl.r similarity index 100% rename from r/step0_repl.r rename to impls/r/step0_repl.r diff --git a/r/step1_read_print.r b/impls/r/step1_read_print.r similarity index 100% rename from r/step1_read_print.r rename to impls/r/step1_read_print.r diff --git a/impls/r/step2_eval.r b/impls/r/step2_eval.r new file mode 100644 index 0000000000..aa457c7cdc --- /dev/null +++ b/impls/r/step2_eval.r @@ -0,0 +1,62 @@ +if(!exists("..readline..")) source("readline.r") +if(!exists("..types..")) source("types.r") +if(!exists("..reader..")) source("reader.r") +if(!exists("..printer..")) source("printer.r") + +READ <- function(str) { + return(read_str(str)) +} + +EVAL <- function(ast, env) { + + # cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + + if (.symbol_q(ast)) { + return(Env.get(env, ast)) + } else if (.list_q(ast)) { + # exit this switch + } else if (.vector_q(ast)) { + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) + } else if (.hash_map_q(ast)) { + lst <- list() + for(k in ls(ast)) { + lst[[length(lst)+1]] = k + lst[[length(lst)+1]] = EVAL(ast[[k]], env) + } + return(new.hash_mapl(lst)) + } else { + return(ast) + } + + # apply list + if (length(ast) == 0) { + return(ast) + } + f <- EVAL(ast[[1]], env) + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) + return(do.call(f, args)) +} + +PRINT <- function(exp) { + return(.pr_str(exp, TRUE)) +} + +repl_env <- new.env() +repl_env[["+"]] <- function(a,b) a+b +repl_env[["-"]] <- function(a,b) a-b +repl_env[["*"]] <- function(a,b) a*b +repl_env[["/"]] <- function(a,b) a/b + +rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) + +repeat { + line <- readline("user> ") + if (is.null(line)) { cat("\n"); break } + tryCatch({ + cat(rep(line),"\n", sep="") + }, error=function(err) { + cat("Error: ", get_error(err),"\n", sep="") + }) + # R debug/fatal with tracebacks: + #cat(rep(line),"\n", sep="") +} diff --git a/r/step3_env.r b/impls/r/step3_env.r similarity index 75% rename from r/step3_env.r rename to impls/r/step3_env.r index 142f43dd9d..37519e825b 100644 --- a/r/step3_env.r +++ b/impls/r/step3_env.r @@ -8,30 +8,33 @@ READ <- function(str) { return(read_str(str)) } -eval_ast <- function(ast, env) { +EVAL <- function(ast, env) { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + if (.symbol_q(ast)) { - Env.get(env, ast) + return(Env.get(env, ast)) } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) + # exit this switch } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } - new.hash_mapl(lst) + return(new.hash_mapl(lst)) } else { - ast + return(ast) } -} -EVAL <- function(ast, env) { - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } + if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), @@ -50,9 +53,9 @@ EVAL <- function(ast, env) { } return(EVAL(a2, let_env)) } else { - el <- eval_ast(ast, env) - f <- el[[1]] - return(do.call(f,slice(el,2))) + f <- EVAL(a0, env) + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) + return(do.call(f, args)) } } diff --git a/r/step4_if_fn_do.r b/impls/r/step4_if_fn_do.r similarity index 75% rename from r/step4_if_fn_do.r rename to impls/r/step4_if_fn_do.r index 567e18d70b..8948f2aa33 100644 --- a/r/step4_if_fn_do.r +++ b/impls/r/step4_if_fn_do.r @@ -9,30 +9,33 @@ READ <- function(str) { return(read_str(str)) } -eval_ast <- function(ast, env) { +EVAL <- function(ast, env) { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + if (.symbol_q(ast)) { - Env.get(env, ast) + return(Env.get(env, ast)) } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) + # exit this switch } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } - new.hash_mapl(lst) + return(new.hash_mapl(lst)) } else { - ast + return(ast) } -} -EVAL <- function(ast, env) { - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } + if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), @@ -52,8 +55,10 @@ EVAL <- function(ast, env) { } return(EVAL(a2, let_env)) } else if (a0sym == "do") { - el <- eval_ast(slice(ast,2), env) - return(el[[length(el)]]) + if (2 < length(ast)) + for(i in seq(2, length(ast) - 1)) + EVAL(ast[[i]], env) + return(EVAL(ast[[length(ast)]], env)) } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { @@ -67,9 +72,9 @@ EVAL <- function(ast, env) { EVAL(a2, new.Env(env, a1, list(...))) }) } else { - el <- eval_ast(ast, env) - f <- el[[1]] - return(do.call(f,slice(el,2))) + f <- EVAL(a0, env) + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) + return(do.call(f, args)) } } diff --git a/r/step5_tco.r b/impls/r/step5_tco.r similarity index 76% rename from r/step5_tco.r rename to impls/r/step5_tco.r index 913c78fbd9..b6db00747b 100644 --- a/r/step5_tco.r +++ b/impls/r/step5_tco.r @@ -9,32 +9,35 @@ READ <- function(str) { return(read_str(str)) } -eval_ast <- function(ast, env) { +EVAL <- function(ast, env) { + + repeat { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + if (.symbol_q(ast)) { - Env.get(env, ast) + return(Env.get(env, ast)) } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) + # exit this switch } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } - new.hash_mapl(lst) + return(new.hash_mapl(lst)) } else { - ast + return(ast) } -} -EVAL <- function(ast, env) { - repeat { - - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } + if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), @@ -55,7 +58,9 @@ EVAL <- function(ast, env) { ast <- a2 env <- let_env } else if (a0sym == "do") { - eval_ast(slice(ast,2,length(ast)-1), env) + if (2 < length(ast)) + for(i in seq(2, length(ast) - 1)) + EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) @@ -68,13 +73,13 @@ EVAL <- function(ast, env) { } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { - el <- eval_ast(ast, env) - f <- el[[1]] + f <- EVAL(a0, env) + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast - env <- f$gen_env(slice(el,2)) + env <- f$gen_env(args) } else { - return(do.call(f,slice(el,2))) + return(do.call(f, args)) } } diff --git a/r/step6_file.r b/impls/r/step6_file.r similarity index 76% rename from r/step6_file.r rename to impls/r/step6_file.r index a1e59477ae..4184351f48 100644 --- a/r/step6_file.r +++ b/impls/r/step6_file.r @@ -10,32 +10,35 @@ READ <- function(str) { return(read_str(str)) } -eval_ast <- function(ast, env) { +EVAL <- function(ast, env) { + + repeat { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + if (.symbol_q(ast)) { - Env.get(env, ast) + return(Env.get(env, ast)) } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) + # exit this switch } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } - new.hash_mapl(lst) + return(new.hash_mapl(lst)) } else { - ast + return(ast) } -} -EVAL <- function(ast, env) { - repeat { - - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } + if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), @@ -56,7 +59,9 @@ EVAL <- function(ast, env) { ast <- a2 env <- let_env } else if (a0sym == "do") { - eval_ast(slice(ast,2,length(ast)-1), env) + if (2 < length(ast)) + for(i in seq(2, length(ast) - 1)) + EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) @@ -69,13 +74,13 @@ EVAL <- function(ast, env) { } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { - el <- eval_ast(ast, env) - f <- el[[1]] + f <- EVAL(a0, env) + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast - env <- f$gen_env(slice(el,2)) + env <- f$gen_env(args) } else { - return(do.call(f,slice(el,2))) + return(do.call(f, args)) } } @@ -98,11 +103,11 @@ Env.set(repl_env, "*ARGV*", new.list()) # core.mal: defined using the language itself . <- rep("(def! not (fn* (a) (if a false true)))") -. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") +. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") args <- commandArgs(trailingOnly = TRUE) if (length(args) > 0) { - Env.set(repl_env, "*ARGV*", new.listl(slice(list(args),2))) + Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) . <- rep(concat("(load-file \"", args[[1]], "\")")) quit(save="no", status=0) } diff --git a/impls/r/step7_quote.r b/impls/r/step7_quote.r new file mode 100644 index 0000000000..a5dd3828c0 --- /dev/null +++ b/impls/r/step7_quote.r @@ -0,0 +1,165 @@ +if(!exists("..readline..")) source("readline.r") +if(!exists("..types..")) source("types.r") +if(!exists("..reader..")) source("reader.r") +if(!exists("..printer..")) source("printer.r") +if(!exists("..env..")) source("env.r") +if(!exists("..core..")) source("core.r") + +# read +READ <- function(str) { + return(read_str(str)) +} + +# eval +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc +} + +quasiquote <- function(ast) { + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) + } else { + ast + } +} + +EVAL <- function(ast, env) { + + repeat { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + + if (.symbol_q(ast)) { + return(Env.get(env, ast)) + } else if (.list_q(ast)) { + # exit this switch + } else if (.vector_q(ast)) { + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) + } else if (.hash_map_q(ast)) { + lst <- list() + for(k in ls(ast)) { + lst[[length(lst)+1]] = k + lst[[length(lst)+1]] = EVAL(ast[[k]], env) + } + return(new.hash_mapl(lst)) + } else { + return(ast) + } + + if (length(ast) == 0) { return(ast) } + + # apply list + switch(paste("l",length(ast),sep=""), + l0={ return(ast) }, + l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, + l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, + { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) + if (length(a0) > 1) a0sym <- "__<*fn*>__" + else a0sym <- as.character(a0) + if (a0sym == "def!") { + res <- EVAL(a2, env) + return(Env.set(env, a1, res)) + } else if (a0sym == "let*") { + let_env <- new.Env(env) + for(i in seq(1,length(a1),2)) { + Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) + } + ast <- a2 + env <- let_env + } else if (a0sym == "quote") { + return(a1) + } else if (a0sym == "quasiquote") { + ast <- quasiquote(a1) + } else if (a0sym == "do") { + if (2 < length(ast)) + for(i in seq(2, length(ast) - 1)) + EVAL(ast[[i]], env) + ast <- ast[[length(ast)]] + } else if (a0sym == "if") { + cond <- EVAL(a1, env) + if (.nil_q(cond) || identical(cond, FALSE)) { + if (length(ast) < 4) return(nil) + ast <- ast[[4]] + } else { + ast <- a2 + } + } else if (a0sym == "fn*") { + return(malfunc(EVAL, a2, env, a1)) + } else { + f <- EVAL(a0, env) + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) + if (class(f) == "MalFunc") { + ast <- f$ast + env <- f$gen_env(args) + } else { + return(do.call(f, args)) + } + } + + } +} + +# print +PRINT <- function(exp) { + return(.pr_str(exp, TRUE)) +} + +# repl loop +repl_env <- new.Env() +rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) + +# core.r: defined using R +for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } +Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) +Env.set(repl_env, "*ARGV*", new.list()) + +# core.mal: defined using the language itself +. <- rep("(def! not (fn* (a) (if a false true)))") +. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) > 0) { + Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) + . <- rep(concat("(load-file \"", args[[1]], "\")")) + quit(save="no", status=0) +} + +repeat { + line <- readline("user> ") + if (is.null(line)) { cat("\n"); break } + tryCatch({ + cat(rep(line),"\n", sep="") + }, error=function(err) { + cat("Error: ", get_error(err),"\n", sep="") + }) + # R debug/fatal with tracebacks: + #cat(rep(line),"\n", sep="") +} diff --git a/impls/r/step8_macros.r b/impls/r/step8_macros.r new file mode 100644 index 0000000000..aa5f6cc926 --- /dev/null +++ b/impls/r/step8_macros.r @@ -0,0 +1,175 @@ +if(!exists("..readline..")) source("readline.r") +if(!exists("..types..")) source("types.r") +if(!exists("..reader..")) source("reader.r") +if(!exists("..printer..")) source("printer.r") +if(!exists("..env..")) source("env.r") +if(!exists("..core..")) source("core.r") + +# read +READ <- function(str) { + return(read_str(str)) +} + +# eval +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc +} + +quasiquote <- function(ast) { + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) + } else { + ast + } +} + +EVAL <- function(ast, env) { + + repeat { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + + if (.symbol_q(ast)) { + return(Env.get(env, ast)) + } else if (.list_q(ast)) { + # exit this switch + } else if (.vector_q(ast)) { + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) + } else if (.hash_map_q(ast)) { + lst <- list() + for(k in ls(ast)) { + lst[[length(lst)+1]] = k + lst[[length(lst)+1]] = EVAL(ast[[k]], env) + } + return(new.hash_mapl(lst)) + } else { + return(ast) + } + + if (length(ast) == 0) { return(ast) } + + # apply list + switch(paste("l",length(ast),sep=""), + l0={ return(ast) }, + l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, + l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, + { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) + if (length(a0) > 1) a0sym <- "__<*fn*>__" + else a0sym <- as.character(a0) + if (a0sym == "def!") { + res <- EVAL(a2, env) + return(Env.set(env, a1, res)) + } else if (a0sym == "let*") { + let_env <- new.Env(env) + for(i in seq(1,length(a1),2)) { + Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) + } + ast <- a2 + env <- let_env + } else if (a0sym == "quote") { + return(a1) + } else if (a0sym == "quasiquote") { + ast <- quasiquote(a1) + } else if (a0sym == "defmacro!") { + func <- EVAL(a2, env) + func$ismacro = TRUE + return(Env.set(env, a1, func)) + } else if (a0sym == "do") { + if (2 < length(ast)) + for(i in seq(2, length(ast) - 1)) + EVAL(ast[[i]], env) + ast <- ast[[length(ast)]] + } else if (a0sym == "if") { + cond <- EVAL(a1, env) + if (.nil_q(cond) || identical(cond, FALSE)) { + if (length(ast) < 4) return(nil) + ast <- ast[[4]] + } else { + ast <- a2 + } + } else if (a0sym == "fn*") { + return(malfunc(EVAL, a2, env, a1)) + } else { + f <- EVAL(a0, env) + if (.macro_q(f)) { + ast <- fapply(f, slice(ast, 2)) + next + } + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) + if (class(f) == "MalFunc") { + ast <- f$ast + env <- f$gen_env(args) + } else { + return(do.call(f, args)) + } + } + + } +} + +# print +PRINT <- function(exp) { + return(.pr_str(exp, TRUE)) +} + +# repl loop +repl_env <- new.Env() +rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) + +# core.r: defined using R +for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } +Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) +Env.set(repl_env, "*ARGV*", new.list()) + +# core.mal: defined using the language itself +. <- rep("(def! not (fn* (a) (if a false true)))") +. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +. <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) > 0) { + Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) + . <- rep(concat("(load-file \"", args[[1]], "\")")) + quit(save="no", status=0) +} + +repeat { + line <- readline("user> ") + if (is.null(line)) { cat("\n"); break } + tryCatch({ + cat(rep(line),"\n", sep="") + }, error=function(err) { + cat("Error: ", get_error(err),"\n", sep="") + }) + # R debug/fatal with tracebacks: + #cat(rep(line),"\n", sep="") +} diff --git a/impls/r/step9_try.r b/impls/r/step9_try.r new file mode 100644 index 0000000000..c557f8adc1 --- /dev/null +++ b/impls/r/step9_try.r @@ -0,0 +1,193 @@ +if(!exists("..readline..")) source("readline.r") +if(!exists("..types..")) source("types.r") +if(!exists("..reader..")) source("reader.r") +if(!exists("..printer..")) source("printer.r") +if(!exists("..env..")) source("env.r") +if(!exists("..core..")) source("core.r") + +# read +READ <- function(str) { + return(read_str(str)) +} + +# eval +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc +} + +quasiquote <- function(ast) { + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) + } else { + ast + } +} + +EVAL <- function(ast, env) { + + repeat { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + + if (.symbol_q(ast)) { + return(Env.get(env, ast)) + } else if (.list_q(ast)) { + # exit this switch + } else if (.vector_q(ast)) { + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) + } else if (.hash_map_q(ast)) { + lst <- list() + for(k in ls(ast)) { + lst[[length(lst)+1]] = k + lst[[length(lst)+1]] = EVAL(ast[[k]], env) + } + return(new.hash_mapl(lst)) + } else { + return(ast) + } + + if (length(ast) == 0) { return(ast) } + + # apply list + switch(paste("l",length(ast),sep=""), + l0={ return(ast) }, + l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, + l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, + { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) + if (length(a0) > 1) a0sym <- "__<*fn*>__" + else a0sym <- as.character(a0) + if (a0sym == "def!") { + res <- EVAL(a2, env) + return(Env.set(env, a1, res)) + } else if (a0sym == "let*") { + let_env <- new.Env(env) + for(i in seq(1,length(a1),2)) { + Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) + } + ast <- a2 + env <- let_env + } else if (a0sym == "quote") { + return(a1) + } else if (a0sym == "quasiquote") { + ast <- quasiquote(a1) + } else if (a0sym == "defmacro!") { + func <- EVAL(a2, env) + func$ismacro = TRUE + return(Env.set(env, a1, func)) + } else if (a0sym == "try*") { + edata <- new.env() + tryCatch({ + return(EVAL(a1, env)) + }, error=function(err) { + edata$exc <- get_error(err) + }) + if ((!is.null(a2)) && a2[[1]] == "catch*") { + return(EVAL(a2[[3]], new.Env(env, + new.list(a2[[2]]), + new.list(edata$exc)))) + } else { + throw(edata$exc) + } + } else if (a0sym == "do") { + if (2 < length(ast)) + for(i in seq(2, length(ast) - 1)) + EVAL(ast[[i]], env) + ast <- ast[[length(ast)]] + } else if (a0sym == "if") { + cond <- EVAL(a1, env) + if (.nil_q(cond) || identical(cond, FALSE)) { + if (length(ast) < 4) return(nil) + ast <- ast[[4]] + } else { + ast <- a2 + } + } else if (a0sym == "fn*") { + return(malfunc(EVAL, a2, env, a1)) + } else { + f <- EVAL(a0, env) + if (.macro_q(f)) { + ast <- fapply(f, slice(ast, 2)) + next + } + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) + if (class(f) == "MalFunc") { + ast <- f$ast + env <- f$gen_env(args) + } else { + return(do.call(f, args)) + } + } + + } +} + +# print +PRINT <- function(exp) { + return(.pr_str(exp, TRUE)) +} + +# repl loop +repl_env <- new.Env() +rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) + +# core.r: defined using R +for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } +Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) +Env.set(repl_env, "*ARGV*", new.list()) + +# core.mal: defined using the language itself +. <- rep("(def! not (fn* (a) (if a false true)))") +. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +. <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) > 0) { + Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) + tryCatch({ + . <- rep(concat("(load-file \"", args[[1]], "\")")) + }, error=function(err) { + cat("Error: ", get_error(err),"\n", sep="") + }) + quit(save="no", status=0) +} + +repeat { + line <- readline("user> ") + if (is.null(line)) { cat("\n"); break } + tryCatch({ + cat(rep(line),"\n", sep="") + }, error=function(err) { + cat("Error: ", .pr_str(get_error(err),TRUE),"\n", sep="") + }) + # R debug/fatal with tracebacks: + #cat(rep(line),"\n", sep="") +} diff --git a/impls/r/stepA_mal.r b/impls/r/stepA_mal.r new file mode 100644 index 0000000000..be2398fe7e --- /dev/null +++ b/impls/r/stepA_mal.r @@ -0,0 +1,195 @@ +if(!exists("..readline..")) source("readline.r") +if(!exists("..types..")) source("types.r") +if(!exists("..reader..")) source("reader.r") +if(!exists("..printer..")) source("printer.r") +if(!exists("..env..")) source("env.r") +if(!exists("..core..")) source("core.r") + +# read +READ <- function(str) { + return(read_str(str)) +} + +# eval +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc +} + +quasiquote <- function(ast) { + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) + } else { + ast + } +} + +EVAL <- function(ast, env) { + + repeat { + + dbgevalenv <- Env.find(env, "DEBUG-EVAL") + if (!.nil_q(dbgevalenv)) { + dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") + if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) + cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") + } + + if (.symbol_q(ast)) { + return(Env.get(env, ast)) + } else if (.list_q(ast)) { + # exit this switch + } else if (.vector_q(ast)) { + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) + } else if (.hash_map_q(ast)) { + lst <- list() + for(k in ls(ast)) { + lst[[length(lst)+1]] = k + lst[[length(lst)+1]] = EVAL(ast[[k]], env) + } + return(new.hash_mapl(lst)) + } else { + return(ast) + } + + if (length(ast) == 0) { return(ast) } + + # apply list + switch(paste("l",length(ast),sep=""), + l0={ return(ast) }, + l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, + l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, + { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) + if (length(a0) > 1) a0sym <- "__<*fn*>__" + else a0sym <- as.character(a0) + if (a0sym == "def!") { + res <- EVAL(a2, env) + return(Env.set(env, a1, res)) + } else if (a0sym == "let*") { + let_env <- new.Env(env) + for(i in seq(1,length(a1),2)) { + Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) + } + ast <- a2 + env <- let_env + } else if (a0sym == "quote") { + return(a1) + } else if (a0sym == "quasiquote") { + ast <- quasiquote(a1) + } else if (a0sym == "defmacro!") { + func <- EVAL(a2, env) + func$ismacro = TRUE + return(Env.set(env, a1, func)) + } else if (a0sym == "try*") { + edata <- new.env() + tryCatch({ + return(EVAL(a1, env)) + }, error=function(err) { + edata$exc <- get_error(err) + }) + if ((!is.null(a2)) && a2[[1]] == "catch*") { + return(EVAL(a2[[3]], new.Env(env, + new.list(a2[[2]]), + new.list(edata$exc)))) + } else { + throw(edata$exc) + } + } else if (a0sym == "do") { + if (2 < length(ast)) + for(i in seq(2, length(ast) - 1)) + EVAL(ast[[i]], env) + ast <- ast[[length(ast)]] + } else if (a0sym == "if") { + cond <- EVAL(a1, env) + if (.nil_q(cond) || identical(cond, FALSE)) { + if (length(ast) < 4) return(nil) + ast <- ast[[4]] + } else { + ast <- a2 + } + } else if (a0sym == "fn*") { + return(malfunc(EVAL, a2, env, a1)) + } else { + f <- EVAL(a0, env) + if (.macro_q(f)) { + ast <- fapply(f, slice(ast, 2)) + next + } + args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) + if (class(f) == "MalFunc") { + ast <- f$ast + env <- f$gen_env(args) + } else { + return(do.call(f, args)) + } + } + + } +} + +# print +PRINT <- function(exp) { + return(.pr_str(exp, TRUE)) +} + +# repl loop +repl_env <- new.Env() +rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) + +# core.r: defined using R +for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } +Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) +Env.set(repl_env, "*ARGV*", new.list()) + +# core.mal: defined using the language itself +. <- rep("(def! *host-language* \"R\")") +. <- rep("(def! not (fn* (a) (if a false true)))") +. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +. <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) > 0) { + Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) + tryCatch({ + . <- rep(concat("(load-file \"", args[[1]], "\")")) + }, error=function(err) { + cat("Error: ", get_error(err),"\n", sep="") + }) + quit(save="no", status=0) +} + +. <- rep("(println (str \"Mal [\" *host-language* \"]\"))") +repeat { + line <- readline("user> ") + if (is.null(line)) { cat("\n"); break } + tryCatch({ + cat(rep(line),"\n", sep="") + }, error=function(err) { + cat("Error: ", .pr_str(get_error(err),TRUE),"\n", sep="") + }) + # R debug/fatal with tracebacks: + #cat(rep(line),"\n", sep="") +} diff --git a/impls/r/tests/step5_tco.mal b/impls/r/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/r/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/r/types.r b/impls/r/types.r similarity index 82% rename from r/types.r rename to impls/r/types.r index 92d135792c..9d8c29a913 100644 --- a/r/types.r +++ b/impls/r/types.r @@ -40,6 +40,15 @@ slice <- function(seq, start=1, end=-1) { } TRUE }, + "HashMap"={ + ks1 <- ls(a) + ks2 <- ls(b) + if (length(ks1) != length(ks2)) return(FALSE) + for(k in ks1) { + if (!.equal_q(a[[k]],b[[k]])) return(FALSE) + } + TRUE + }, { a == b }) @@ -79,14 +88,28 @@ nil <- structure("malnil", class="nil") .nil_q <- function(obj) "nil" == class(obj) .true_q <- function(obj) "logical" == class(obj) && obj == TRUE .false_q <- function(obj) "logical" == class(obj) && obj == FALSE -new.symbol <- function(name) structure(name, class="Symbol") +.string_q <- function(obj) { + "character" == class(obj) && + !("\u029e" == substr(obj,1,1) || + "" == substring(obj,1,8)) +} +new.symbol <- function(name) structure(name, class="Symbol") .symbol_q <- function(obj) "Symbol" == class(obj) -new.keyword <- function(name) concat("\u029e", name) + +new.keyword <- function(name) { + if (.keyword_q(name)) return (name) + concat("\u029e", name) +} + .keyword_q <- function(obj) { - "character" == class(obj) && "\u029e" == substr(obj,1,1) + "character" == class(obj) && + ("\u029e" == substr(obj,1,1) || + "" == substring(obj,1,8)) } +.number_q <- function(obj) "numeric" == class(obj) || "integer" == class(obj) + # Functions malfunc <- function(eval, ast, env, params) { @@ -111,6 +134,9 @@ fapply <- function(mf, args) { } } +.fn_q <- function(obj) "function" == class(obj) || (.malfunc_q(obj) && !obj$ismacro) +.macro_q <- function(obj) .malfunc_q(obj) && obj$ismacro + # Lists new.list <- function(...) new.listl(list(...)) new.listl <- function(lst) { class(lst) <- "List"; lst } diff --git a/impls/racket/Dockerfile b/impls/racket/Dockerfile new file mode 100644 index 0000000000..d2dedd9451 --- /dev/null +++ b/impls/racket/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Racket +RUN apt-get -y install libedit-dev racket diff --git a/impls/racket/Makefile b/impls/racket/Makefile new file mode 100644 index 0000000000..89bcac4ae0 --- /dev/null +++ b/impls/racket/Makefile @@ -0,0 +1,14 @@ +SOURCES_BASE = types.rkt reader.rkt printer.rkt +SOURCES_LISP = env.rkt core.rkt stepA_mal.rkt +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + +dist: mal + +mal: $(SOURCES) + raco exe stepA_mal.rkt + mv stepA_mal $@ + +clean: + rm -f mal diff --git a/racket/core.rkt b/impls/racket/core.rkt similarity index 77% rename from racket/core.rkt rename to impls/racket/core.rkt index 1cb41bfb38..1c69df2955 100644 --- a/racket/core.rkt +++ b/impls/racket/core.rkt @@ -10,12 +10,25 @@ exc))) ;; Sequence functions +(define do_apply + (lambda a + (let* ([f (first a)] + [lst (_to_list (last a))] + [args (append (take (drop a 1) (- (length a) 2)) lst)]) + (apply f args)))) + (define conj (lambda a (if (vector? (first a)) (vector-append (first a) (list->vector (rest a))) (append (reverse (rest a)) (first a))))) +(define (seq obj) + (cond [(_nil? obj) nil] + [(_string? obj) (if (eq? 0 (string-length obj)) nil (map string (string->list obj)))] + [(_empty? obj) nil] + [else (_to_list obj)])) + ;; Meta functions (define (meta obj) (cond [(malfunc? obj) (malfunc-meta obj)] @@ -44,10 +57,16 @@ 'nil? _nil? 'true? (lambda (x) (eq? x #t)) 'false? (lambda (x) (eq? x #f)) + 'number? number? 'symbol (lambda (s) (if (symbol? s) s (string->symbol s))) 'symbol? symbol? + 'string? _string? 'keyword (lambda (s) (if (_keyword? s) s (_keyword s))) 'keyword? _keyword? + 'fn? (lambda (s) (if (malfunc? s) + (not (malfunc-macro? s)) + (procedure? s))) + 'macro? (lambda (s) (and (malfunc? s) (malfunc-macro? s))) 'pr-str (lambda a (pr_lst a #t " ")) 'str (lambda a (pr_lst a #f "")) @@ -83,14 +102,16 @@ 'sequential? _sequential? 'cons (lambda a (cons (first a) (_to_list (second a)))) 'concat (lambda a (apply append (map _to_list a))) + 'vec (lambda a (let* ([x (first a)]) (if (vector? x) x (list->vector x)))) 'nth _nth 'first _first 'rest _rest 'empty? _empty? 'count _count - 'apply apply + 'apply do_apply 'map (lambda (f s) (_to_list (_map f s))) 'conj conj + 'seq seq 'meta meta 'with-meta with-meta diff --git a/impls/racket/env.rkt b/impls/racket/env.rkt new file mode 100644 index 0000000000..9868933f30 --- /dev/null +++ b/impls/racket/env.rkt @@ -0,0 +1,33 @@ +#lang racket + +(provide Env%) + +(require "types.rkt") + +(define Env% + (class object% + (init outer binds exprs) + (super-new) + (define _outer outer) + (define _binds (_to_list binds)) + (define _exprs (_to_list exprs)) + (define data (make-hash)) + (let ([vargs (member '& _binds)]) + (if vargs + (begin + (map (lambda (b e) (hash-set! data b e)) + (drop-right _binds 2) + (take _exprs (- (length _binds) 2))) + (hash-set! data + (last _binds) + (drop _exprs (- (length _binds) 2)))) + (map (lambda (b e) (hash-set! data b e)) + _binds + _exprs))) + + (define/public (set k v) + (hash-set! data k v) + v) + (define/public (get k) + (hash-ref data k + (lambda () (unless (null? _outer) (send _outer get k))))))) diff --git a/racket/printer.rkt b/impls/racket/printer.rkt similarity index 100% rename from racket/printer.rkt rename to impls/racket/printer.rkt diff --git a/racket/reader.rkt b/impls/racket/reader.rkt similarity index 89% rename from racket/reader.rkt rename to impls/racket/reader.rkt index 6db2e67054..d0cb6c1547 100644 --- a/racket/reader.rkt +++ b/impls/racket/reader.rkt @@ -22,7 +22,7 @@ (define (tokenize str) (filter-not (lambda (s) (or (equal? s "") (equal? (substring s 0 1) ";"))) - (regexp-match* #px"[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)" + (regexp-match* #px"[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)" str #:match-select cadr))) (define (read_atom rdr) @@ -31,12 +31,10 @@ (string->number token)] [(regexp-match #px"^-?[0-9][0-9.]*$" token) (string->number token)] - [(regexp-match #px"^\".*\"$" token) - (string-replace - (string-replace - (substring token 1 (- (string-length token) 1)) - "\\\"" "\"") - "\\n" "\n")] + [(regexp-match #px"^\"(?:\\\\.|[^\\\\\"])*\"$" token) + (with-input-from-string token read)] + [(regexp-match #px"^\".*$" token) + (raise "expected '\"', got EOF")] [(regexp-match #px"^:" token) (_keyword (substring token 1))] [(equal? "nil" token) nil] [(equal? "true" token) #t] @@ -46,7 +44,7 @@ (define (read_list_entries rdr end) (let ([tok (send rdr peek)]) (cond - [(eq? tok '()) (raise (string-append "expected '" end "'"))] + [(eq? tok '()) (raise (string-append "expected '" end "', got EOF"))] [(equal? end tok) '()] [else (cons (read_form rdr) (read_list_entries rdr end))]))) @@ -57,7 +55,7 @@ (let ([lst (read_list_entries rdr end)]) (send rdr next) lst) - (raise (string-append "expected '" start "'"))))) + (raise (string-append "expected '" start "', got EOF"))))) (define (read_form rdr) (let ([token (send rdr peek)]) diff --git a/impls/racket/readline.rkt b/impls/racket/readline.rkt new file mode 100644 index 0000000000..fe2a72b02c --- /dev/null +++ b/impls/racket/readline.rkt @@ -0,0 +1,36 @@ +#lang racket + +(provide readline) + +(require (prefix-in readline: readline/readline)) + +(require "types.rkt") + +(define history-loaded #f) +(define HISTORY-FILE (format "~a/.mal-history" (find-system-path 'home-dir))) + +(define (load-history path) + (with-handlers + ([exn:fail? (lambda (e) #t)]) + (map + (lambda (line) (readline:add-history line)) + (string-split + (port->string (open-input-file path)) + #px"\n")))) + +(define (readline prompt) + (when (not history-loaded) + (set! history-loaded #t) + (load-history HISTORY-FILE)) + (let ([line (readline:readline prompt)]) + (if (eq? eof line) + nil + (begin + (readline:add-history line) + (with-handlers + ([exn:fail? (lambda (e) #t)]) + (with-output-to-file + HISTORY-FILE + (lambda () (printf "~a~n" line)) + #:exists 'append)) + line)))) diff --git a/impls/racket/run b/impls/racket/run new file mode 100755 index 0000000000..fa0719bdce --- /dev/null +++ b/impls/racket/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec racket $(dirname $0)/${STEP:-stepA_mal}.rkt "${@}" diff --git a/racket/step0_repl.rkt b/impls/racket/step0_repl.rkt similarity index 90% rename from racket/step0_repl.rkt rename to impls/racket/step0_repl.rkt index d09d5ba4c2..643d132fa2 100755 --- a/racket/step0_repl.rkt +++ b/impls/racket/step0_repl.rkt @@ -1,7 +1,7 @@ #!/usr/bin/env racket #lang racket -(require "types.rkt") +(require "readline.rkt" "types.rkt") ;; read (define (READ str) diff --git a/racket/step1_read_print.rkt b/impls/racket/step1_read_print.rkt similarity index 100% rename from racket/step1_read_print.rkt rename to impls/racket/step1_read_print.rkt diff --git a/racket/step2_eval.rkt b/impls/racket/step2_eval.rkt similarity index 77% rename from racket/step2_eval.rkt rename to impls/racket/step2_eval.rkt index ce4d563368..7ea1ce8f5d 100755 --- a/racket/step2_eval.rkt +++ b/impls/racket/step2_eval.rkt @@ -8,27 +8,25 @@ (read_str str)) ;; eval -(define (eval-ast ast env) +(define (EVAL ast env) + ; (printf "EVAL: ~a~n" (pr_str ast true)) (cond [(symbol? ast) (or (hash-ref env ast (lambda () (raise (string-append "'" (symbol->string ast) "' not found")))))] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] + [(list? ast) + (if (empty? ast) + ast + (let ([f (EVAL (first ast) env)] + [args (map (lambda (x) (EVAL x env)) (rest ast))]) + (apply f args)))] [else ast])) -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - - (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) - (apply f args)))) - ;; print (define (PRINT exp) (pr_str exp true)) diff --git a/impls/racket/step3_env.rkt b/impls/racket/step3_env.rkt new file mode 100755 index 0000000000..8ecd818507 --- /dev/null +++ b/impls/racket/step3_env.rkt @@ -0,0 +1,66 @@ +#!/usr/bin/env racket +#lang racket + +(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" + "env.rkt") + +;; read +(define (READ str) + (read_str str)) + +;; eval +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) + (cond + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] + [(hash? ast) (make-hash + (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] + [(list? ast) + (if (empty? ast) + ast + (let ([a0 (_nth ast 0)]) + (cond + [(eq? 'def! a0) + (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] + [(eq? 'let* a0) + (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) + (_map (lambda (b_e) + (send let-env set (_first b_e) + (EVAL (_nth b_e 1) let-env))) + (_partition 2 (_to_list (_nth ast 1)))) + (EVAL (_nth ast 2) let-env))] + [else + (let ([f (EVAL a0 env)] + [args (map (lambda (x) (EVAL x env)) (rest ast))]) + (apply f args))])))] + [else ast])) + +;; print +(define (PRINT exp) + (pr_str exp true)) + +;; repl +(define repl-env + (new Env% + [outer null] + [binds '(+ - * /)] + [exprs (list + - * /)])) +(define (rep str) + (PRINT (EVAL (READ str) repl-env))) + +(define (repl-loop) + (let ([line (readline "user> ")]) + (when (not (eq? nil line)) + (with-handlers + ([string? (lambda (exc) (printf "Error: ~a~n" exc))] + [blank-exn? (lambda (exc) null)]) + (printf "~a~n" (rep line))) + (repl-loop)))) +(repl-loop) diff --git a/racket/step4_if_fn_do.rkt b/impls/racket/step4_if_fn_do.rkt similarity index 75% rename from racket/step4_if_fn_do.rkt rename to impls/racket/step4_if_fn_do.rkt index 8401397eb5..44af35c119 100755 --- a/racket/step4_if_fn_do.rkt +++ b/impls/racket/step4_if_fn_do.rkt @@ -9,18 +9,22 @@ (read_str str)) ;; eval -(define (eval-ast ast env) +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - + [(list? ast) + (if (empty? ast) + ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) @@ -33,7 +37,7 @@ (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'do a0) - (last (eval-ast (rest ast) env))] + (last (map (lambda (x) (EVAL x env)) (drop ast 1)))] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) @@ -46,10 +50,11 @@ (new Env% [outer env] [binds (_nth ast 1)] [exprs args])))] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) - (apply f args))])))) + [else + (let ([f (EVAL a0 env)] + [args (map (lambda (x) (EVAL x env)) (rest ast))]) + (apply f args))])))] + [else ast])) ;; print (define (PRINT exp) diff --git a/racket/step5_tco.rkt b/impls/racket/step5_tco.rkt similarity index 78% rename from racket/step5_tco.rkt rename to impls/racket/step5_tco.rkt index 0fbdf9c954..880e05ae5c 100755 --- a/racket/step5_tco.rkt +++ b/impls/racket/step5_tco.rkt @@ -9,18 +9,22 @@ (read_str str)) ;; eval -(define (eval-ast ast env) +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - + [(list? ast) + (if (empty? ast) + ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) @@ -33,7 +37,7 @@ (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'do a0) - (eval-ast (drop (drop-right ast 1) 1) env) + (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) @@ -49,16 +53,17 @@ [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) + [else + (let ([f (EVAL a0 env)] + [args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) - (apply f args)))])))) + (apply f args)))])))] + [else ast])) ;; print (define (PRINT exp) diff --git a/racket/step6_file.rkt b/impls/racket/step6_file.rkt similarity index 78% rename from racket/step6_file.rkt rename to impls/racket/step6_file.rkt index 627fb9a570..6e1645bce9 100755 --- a/racket/step6_file.rkt +++ b/impls/racket/step6_file.rkt @@ -9,18 +9,22 @@ (read_str str)) ;; eval -(define (eval-ast ast env) +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - + [(list? ast) + (if (empty? ast) + ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) @@ -33,7 +37,7 @@ (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'do a0) - (eval-ast (drop (drop-right ast 1) 1) env) + (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) @@ -49,16 +53,17 @@ [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) + [else + (let ([f (EVAL a0 env)] + [args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) - (apply f args)))])))) + (apply f args)))])))] + [else ast])) ;; print (define (PRINT exp) @@ -75,11 +80,11 @@ ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) (send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) -(send repl-env set '*ARGV* (list)) +(send repl-env set '*ARGV* (_rest (current-command-line-arguments))) ;; core.mal: defined using the language itself (rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") ) diff --git a/impls/racket/step7_quote.rkt b/impls/racket/step7_quote.rkt new file mode 100755 index 0000000000..d9257f4889 --- /dev/null +++ b/impls/racket/step7_quote.rkt @@ -0,0 +1,129 @@ +#!/usr/bin/env racket +#lang racket + +(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" + "env.rkt" "core.rkt") + +;; read +(define (READ str) + (read_str str)) + +;; eval + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) + +(define (quasiquote ast) + (cond + [(or (symbol? ast) (hash? ast)) + (list 'quote ast)] + + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] + + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] + + [else + (foldr qq-loop null ast)])) + +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) + (cond + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] + [(hash? ast) (make-hash + (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] + [(list? ast) + (if (empty? ast) + ast + (let ([a0 (_nth ast 0)]) + (cond + [(eq? 'def! a0) + (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] + [(eq? 'let* a0) + (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) + (_map (lambda (b_e) + (send let-env set (_first b_e) + (EVAL (_nth b_e 1) let-env))) + (_partition 2 (_to_list (_nth ast 1)))) + (EVAL (_nth ast 2) let-env))] + [(eq? 'quote a0) + (_nth ast 1)] + [(eq? 'quasiquote a0) + (EVAL (quasiquote (_nth ast 1)) env)] + [(eq? 'do a0) + (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) + (EVAL (last ast) env)] + [(eq? 'if a0) + (let ([cnd (EVAL (_nth ast 1) env)]) + (if (or (eq? cnd nil) (eq? cnd #f)) + (if (> (length ast) 3) + (EVAL (_nth ast 3) env) + nil) + (EVAL (_nth ast 2) env)))] + [(eq? 'fn* a0) + (malfunc + (lambda args (EVAL (_nth ast 2) + (new Env% [outer env] + [binds (_nth ast 1)] + [exprs args]))) + (_nth ast 2) env (_nth ast 1) #f nil)] + [else + (let ([f (EVAL a0 env)] + [args (map (lambda (x) (EVAL x env)) (rest ast))]) + (if (malfunc? f) + (EVAL (malfunc-ast f) + (new Env% + [outer (malfunc-env f)] + [binds (malfunc-params f)] + [exprs args])) + (apply f args)))])))] + [else ast])) + +;; print +(define (PRINT exp) + (pr_str exp true)) + +;; repl +(define repl-env + (new Env% [outer null] [binds null] [exprs null])) +(define (rep str) + (PRINT (EVAL (READ str) repl-env))) + +(for () ;; ignore return values + +;; core.rkt: defined using Racket +(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) +(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) +(send repl-env set '*ARGV* (_rest (current-command-line-arguments))) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +) + +(define (repl-loop) + (let ([line (readline "user> ")]) + (when (not (eq? nil line)) + (with-handlers + ([string? (lambda (exc) (printf "Error: ~a~n" exc))] + [blank-exn? (lambda (exc) null)]) + (printf "~a~n" (rep line))) + (repl-loop)))) +(let ([args (current-command-line-arguments)]) + (if (> (vector-length args) 0) + (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) + (repl-loop))) diff --git a/impls/racket/step8_macros.rkt b/impls/racket/step8_macros.rkt new file mode 100755 index 0000000000..864093047e --- /dev/null +++ b/impls/racket/step8_macros.rkt @@ -0,0 +1,136 @@ +#!/usr/bin/env racket +#lang racket + +(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" + "env.rkt" "core.rkt") + +;; read +(define (READ str) + (read_str str)) + +;; eval + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) + +(define (quasiquote ast) + (cond + [(or (symbol? ast) (hash? ast)) + (list 'quote ast)] + + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] + + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] + + [else + (foldr qq-loop null ast)])) + +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) + (cond + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] + [(hash? ast) (make-hash + (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] + [(list? ast) + (if (empty? ast) + ast + (let ([a0 (_nth ast 0)]) + (cond + [(eq? 'def! a0) + (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] + [(eq? 'let* a0) + (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) + (_map (lambda (b_e) + (send let-env set (_first b_e) + (EVAL (_nth b_e 1) let-env))) + (_partition 2 (_to_list (_nth ast 1)))) + (EVAL (_nth ast 2) let-env))] + [(eq? 'quote a0) + (_nth ast 1)] + [(eq? 'quasiquote a0) + (EVAL (quasiquote (_nth ast 1)) env)] + [(eq? 'defmacro! a0) + (let* ([func (EVAL (_nth ast 2) env)] + [mac (struct-copy malfunc func [macro? #t])]) + (send env set (_nth ast 1) mac))] + [(eq? 'do a0) + (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) + (EVAL (last ast) env)] + [(eq? 'if a0) + (let ([cnd (EVAL (_nth ast 1) env)]) + (if (or (eq? cnd nil) (eq? cnd #f)) + (if (> (length ast) 3) + (EVAL (_nth ast 3) env) + nil) + (EVAL (_nth ast 2) env)))] + [(eq? 'fn* a0) + (malfunc + (lambda args (EVAL (_nth ast 2) + (new Env% [outer env] + [binds (_nth ast 1)] + [exprs args]))) + (_nth ast 2) env (_nth ast 1) #f nil)] + [else + (let ([f (EVAL a0 env)]) + (if (and (malfunc? f) (malfunc-macro? f)) + (EVAL (apply f (rest ast)) env) + (let ([args (map (lambda (x) (EVAL x env)) (rest ast))]) + (if (malfunc? f) + (EVAL (malfunc-ast f) + (new Env% + [outer (malfunc-env f)] + [binds (malfunc-params f)] + [exprs args])) + (apply f args)))))])))] + [else ast])) + +;; print +(define (PRINT exp) + (pr_str exp true)) + +;; repl +(define repl-env + (new Env% [outer null] [binds null] [exprs null])) +(define (rep str) + (PRINT (EVAL (READ str) repl-env))) + +(for () ;; ignore return values + +;; core.rkt: defined using Racket +(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) +(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) +(send repl-env set '*ARGV* (_rest (current-command-line-arguments))) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +) + +(define (repl-loop) + (let ([line (readline "user> ")]) + (when (not (eq? nil line)) + (with-handlers + ([string? (lambda (exc) (printf "Error: ~a~n" exc))] + [blank-exn? (lambda (exc) null)]) + (printf "~a~n" (rep line))) + (repl-loop)))) +(let ([args (current-command-line-arguments)]) + (if (> (vector-length args) 0) + (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) + (repl-loop))) diff --git a/impls/racket/step9_try.rkt b/impls/racket/step9_try.rkt new file mode 100755 index 0000000000..c8534d3b2b --- /dev/null +++ b/impls/racket/step9_try.rkt @@ -0,0 +1,153 @@ +#!/usr/bin/env racket +#lang racket + +(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" + "env.rkt" "core.rkt") + +;; read +(define (READ str) + (read_str str)) + +;; eval + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) + +(define (quasiquote ast) + (cond + [(or (symbol? ast) (hash? ast)) + (list 'quote ast)] + + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] + + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] + + [else + (foldr qq-loop null ast)])) + +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) + (cond + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] + [(hash? ast) (make-hash + (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] + [(list? ast) + (if (empty? ast) + ast + (let ([a0 (_nth ast 0)]) + (cond + [(eq? 'def! a0) + (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] + [(eq? 'let* a0) + (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) + (_map (lambda (b_e) + (send let-env set (_first b_e) + (EVAL (_nth b_e 1) let-env))) + (_partition 2 (_to_list (_nth ast 1)))) + (EVAL (_nth ast 2) let-env))] + [(eq? 'quote a0) + (_nth ast 1)] + [(eq? 'quasiquote a0) + (EVAL (quasiquote (_nth ast 1)) env)] + [(eq? 'defmacro! a0) + (let* ([func (EVAL (_nth ast 2) env)] + [mac (struct-copy malfunc func [macro? #t])]) + (send env set (_nth ast 1) mac))] + [(eq? 'try* a0) + (if (or (< (length ast) 3) + (not (eq? 'catch* (_nth (_nth ast 2) 0)))) + (EVAL (_nth ast 1) env) + (let ([efn (lambda (exc) + (EVAL (_nth (_nth ast 2) 2) + (new Env% + [outer env] + [binds (list (_nth (_nth ast 2) 1))] + [exprs (list exc)])))]) + (with-handlers + ([mal-exn? (lambda (exc) (efn (mal-exn-val exc)))] + [string? (lambda (exc) (efn exc))] + [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) + (EVAL (_nth ast 1) env))))] + [(eq? 'do a0) + (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) + (EVAL (last ast) env)] + [(eq? 'if a0) + (let ([cnd (EVAL (_nth ast 1) env)]) + (if (or (eq? cnd nil) (eq? cnd #f)) + (if (> (length ast) 3) + (EVAL (_nth ast 3) env) + nil) + (EVAL (_nth ast 2) env)))] + [(eq? 'fn* a0) + (malfunc + (lambda args (EVAL (_nth ast 2) + (new Env% [outer env] + [binds (_nth ast 1)] + [exprs args]))) + (_nth ast 2) env (_nth ast 1) #f nil)] + [else + (let ([f (EVAL a0 env)]) + (if (and (malfunc? f) (malfunc-macro? f)) + (EVAL (apply f (rest ast)) env) + (let ([args (map (lambda (x) (EVAL x env)) (rest ast))]) + (if (malfunc? f) + (EVAL (malfunc-ast f) + (new Env% + [outer (malfunc-env f)] + [binds (malfunc-params f)] + [exprs args])) + (apply f args)))))])))] + [else ast])) + +;; print +(define (PRINT exp) + (pr_str exp true)) + +;; repl +(define repl-env + (new Env% [outer null] [binds null] [exprs null])) +(define (rep str) + (PRINT (EVAL (READ str) repl-env))) + +(for () ;; ignore return values + +;; core.rkt: defined using Racket +(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) +(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) +(send repl-env set '*ARGV* (_rest (current-command-line-arguments))) + +;; core.mal: defined using the language itself +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +) + +(define (repl-loop) + (let ([line (readline "user> ")]) + (when (not (eq? nil line)) + (with-handlers + ([string? (lambda (exc) (printf "Error: ~a~n" exc))] + [mal-exn? (lambda (exc) (printf "Error: ~a~n" + (pr_str (mal-exn-val exc) true)))] + [blank-exn? (lambda (exc) null)]) + (printf "~a~n" (rep line))) + (repl-loop)))) +(let ([args (current-command-line-arguments)]) + (if (> (vector-length args) 0) + (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) + (repl-loop))) diff --git a/impls/racket/stepA_mal.rkt b/impls/racket/stepA_mal.rkt new file mode 100755 index 0000000000..c94bb80137 --- /dev/null +++ b/impls/racket/stepA_mal.rkt @@ -0,0 +1,158 @@ +#!/usr/bin/env racket +#lang racket + +(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" + "env.rkt" "core.rkt") + +;; read +(define (READ str) + (read_str str)) + +;; eval + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) + +(define (quasiquote ast) + (cond + [(or (symbol? ast) (hash? ast)) + (list 'quote ast)] + + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] + + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] + + [else + (foldr qq-loop null ast)])) + +(define (EVAL ast env) + (let ([dbgeval (send env get 'DEBUG-EVAL)]) + (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) + (printf "EVAL: ~a~n" (pr_str ast true)))) + (cond + [(symbol? ast) + (let ([val (send env get ast)]) + (if (void? val) + (raise (string-append "'" (symbol->string ast) "' not found")) + val))] + [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] + [(hash? ast) (make-hash + (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] + [(list? ast) + (if (empty? ast) + ast + (let ([a0 (_nth ast 0)]) + (cond + [(eq? 'def! a0) + (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] + [(eq? 'let* a0) + (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) + (_map (lambda (b_e) + (send let-env set (_first b_e) + (EVAL (_nth b_e 1) let-env))) + (_partition 2 (_to_list (_nth ast 1)))) + (EVAL (_nth ast 2) let-env))] + [(eq? 'quote a0) + (_nth ast 1)] + [(eq? 'quasiquote a0) + (EVAL (quasiquote (_nth ast 1)) env)] + [(eq? 'defmacro! a0) + (let* ([func (EVAL (_nth ast 2) env)] + [mac (struct-copy malfunc func [macro? #t])]) + (send env set (_nth ast 1) mac))] + [(eq? 'try* a0) + (if (or (< (length ast) 3) + (not (eq? 'catch* (_nth (_nth ast 2) 0)))) + (EVAL (_nth ast 1) env) + (let ([efn (lambda (exc) + (EVAL (_nth (_nth ast 2) 2) + (new Env% + [outer env] + [binds (list (_nth (_nth ast 2) 1))] + [exprs (list exc)])))]) + (with-handlers + ([mal-exn? (lambda (exc) (efn (mal-exn-val exc)))] + [string? (lambda (exc) (efn exc))] + [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) + (EVAL (_nth ast 1) env))))] + [(eq? 'do a0) + (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) + (EVAL (last ast) env)] + [(eq? 'if a0) + (let ([cnd (EVAL (_nth ast 1) env)]) + (if (or (eq? cnd nil) (eq? cnd #f)) + (if (> (length ast) 3) + (EVAL (_nth ast 3) env) + nil) + (EVAL (_nth ast 2) env)))] + [(eq? 'fn* a0) + (malfunc + (lambda args (EVAL (_nth ast 2) + (new Env% [outer env] + [binds (_nth ast 1)] + [exprs args]))) + (_nth ast 2) env (_nth ast 1) #f nil)] + [else + (let ([f (EVAL a0 env)]) + (if (and (malfunc? f) (malfunc-macro? f)) + (EVAL (apply f (rest ast)) env) + (let ([args (map (lambda (x) (EVAL x env)) (rest ast))]) + (if (malfunc? f) + (EVAL (malfunc-ast f) + (new Env% + [outer (malfunc-env f)] + [binds (malfunc-params f)] + [exprs args])) + (apply f args)))))])))] + [else ast])) + +;; print +(define (PRINT exp) + (pr_str exp true)) + +;; repl +(define repl-env + (new Env% [outer null] [binds null] [exprs null])) +(define (rep str) + (PRINT (EVAL (READ str) repl-env))) + +(for () ;; ignore return values + +;; core.rkt: defined using Racket +(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) +(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) +(send repl-env set '*ARGV* (_rest (current-command-line-arguments))) + +;; core.mal: defined using the language itself +(rep "(def! *host-language* \"racket\")") +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +) + +(define (repl-loop) + (let ([line (readline "user> ")]) + (when (not (eq? nil line)) + (with-handlers + ([string? (lambda (exc) (printf "Error: ~a~n" exc))] + [mal-exn? (lambda (exc) (printf "Error: ~a~n" + (pr_str (mal-exn-val exc) true)))] + [blank-exn? (lambda (exc) null)]) + (printf "~a~n" (rep line))) + (repl-loop)))) +(let ([args (current-command-line-arguments)]) + (if (> (vector-length args) 0) + (begin + (send repl-env set '*ARGV* (vector->list (vector-drop args 1))) + (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")")))) + (begin + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (repl-loop)))) diff --git a/impls/racket/tests/step5_tco.mal b/impls/racket/tests/step5_tco.mal new file mode 100644 index 0000000000..93286cd766 --- /dev/null +++ b/impls/racket/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Racket: skipping non-TCO recursion +;; Reason: completes up to 1,000,000 diff --git a/racket/types.rkt b/impls/racket/types.rkt similarity index 80% rename from racket/types.rkt rename to impls/racket/types.rkt index 6ca29e6bdd..22f7498548 100644 --- a/racket/types.rkt +++ b/impls/racket/types.rkt @@ -4,7 +4,7 @@ malfunc malfunc? malfunc-fn malfunc-ast malfunc-env malfunc-params malfunc-macro? malfunc-meta _partition _equal? _printf - nil _nil? _keyword _keyword? + nil _nil? _keyword _keyword? _string? _to_list _sequential? _count _empty? _nth _first _rest _map _assoc _dissoc _get atom atom? atom-val set-atom-val!) @@ -34,13 +34,23 @@ (rest (drop xs n))) (cons first-chunk (_partition n rest))))) +(define (_equal_seqs? seq_a seq_b) + (let ([a (_to_list seq_a)] + [b (_to_list seq_b)]) + (and (= (length a) (length b)) + (andmap (lambda (va vb) (_equal? va vb)) a b)))) + +(define (_equal_hashes? a b) + (if (= (hash-count a) (hash-count b)) + (let ([keys (hash-keys a)]) + (andmap (lambda (k) (_equal? (_get a k) (_get b k))) keys)) + #f)) + (define (_equal? a b) (cond - [(and (list? a) (vector? b)) - (equal? a (vector->list b))] - [(and (vector? a) (list? b)) - (equal? (vector->list a) b)] - [else (equal? a b)])) + [(and (_sequential? a) (_sequential? b)) (_equal_seqs? a b)] + [(and (hash? a) (hash? b)) (_equal_hashes? a b)] + [else (equal? a b)])) ;; printf with flush (define _printf (lambda a (apply printf a) (flush-output))) @@ -52,6 +62,9 @@ (define (_keyword? k) (and (string? k) (regexp-match? #px"^\u029e" k))) +;; Strings +(define (_string? s) + (and (string? s) (not (_keyword? s)))) ;; Lists and vectors diff --git a/impls/rexx/.gitignore b/impls/rexx/.gitignore new file mode 100644 index 0000000000..8b0a0636a6 --- /dev/null +++ b/impls/rexx/.gitignore @@ -0,0 +1 @@ +*.rexxpp diff --git a/impls/rexx/Dockerfile b/impls/rexx/Dockerfile new file mode 100644 index 0000000000..2a1bd54bd6 --- /dev/null +++ b/impls/rexx/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install cpp regina-rexx + +ENV HOME /mal diff --git a/impls/rexx/Makefile b/impls/rexx/Makefile new file mode 100644 index 0000000000..b5a49b3b94 --- /dev/null +++ b/impls/rexx/Makefile @@ -0,0 +1,24 @@ +SRCS = step0_repl.rexx step1_read_print.rexx step2_eval.rexx step3_env.rexx \ + step4_if_fn_do.rexx step5_tco.rexx step6_file.rexx step7_quote.rexx \ + step8_macros.rexx step9_try.rexx stepA_mal.rexx +PREPROCESSED = $(SRCS:%.rexx=%.rexxpp) + +all: $(PREPROCESSED) dist + +dist: mal + +mal: mal.rexxpp + echo "#!/usr/bin/rexx -a" > $@ + cat $< >> $@ + chmod +x $@ + +mal.rexxpp: stepA_mal.rexxpp + cp -a $+ $@ + +$(PREPROCESSED): %.rexxpp: %.rexx readline.rexx types.rexx reader.rexx printer.rexx env.rexx core.rexx + cpp -CC -P -nostdinc $< > $@ + +clean: + rm -f mal.rexx mal *.rexxpp + +.PHONY: all dist clean diff --git a/impls/rexx/core.rexx b/impls/rexx/core.rexx new file mode 100644 index 0000000000..f92fd221b8 --- /dev/null +++ b/impls/rexx/core.rexx @@ -0,0 +1,514 @@ +#ifndef __core__ +#define __core__ + +#include "types.rexx" + +mal_equal?: procedure expose values. /* mal_equal?(a, b) */ + return new_boolean(equal?(arg(1), arg(2))) + +mal_throw: procedure expose values. err /* mal_throw(a) */ + err = "__MAL_EXCEPTION__" arg(1) + return "ERR" + +mal_nil?: procedure expose values. /* mal_nil?(a) */ + return new_boolean(nil?(arg(1))) + +mal_true?: procedure expose values. /* mal_true?(a) */ + return new_boolean(true?(arg(1))) + +mal_false?: procedure expose values. /* mal_false?(a) */ + return new_boolean(false?(arg(1))) + +mal_string?: procedure expose values. /* mal_string?(a) */ + return new_boolean(string?(arg(1))) + +mal_symbol: procedure expose values. /* mal_symbol(a) */ + return new_symbol(obj_val(arg(1))) + +mal_symbol?: procedure expose values. /* mal_symbol?(a) */ + return new_boolean(symbol?(arg(1))) + +mal_keyword: procedure expose values. /* mal_keyword(a) */ + return new_keyword(obj_val(arg(1))) + +mal_keyword?: procedure expose values. /* mal_keyword?(a) */ + return new_boolean(keyword?(arg(1))) + +mal_number?: procedure expose values. /* mal_number?(a) */ + return new_boolean(number?(arg(1))) + +mal_fn?: procedure expose values. /* mal_fn?(a) */ + return new_boolean(nativefn?(arg(1)) | (func?(arg(1)) & (func_is_macro(arg(1)) \= 1))) + +mal_macro?: procedure expose values. /* mal_macro?(a) */ + return new_boolean(func_macro?(arg(1))) + +mal_pr_str: procedure expose values. /* mal_pr_str(...) */ + res = "" + do i=1 to arg() + element = pr_str(arg(i), 1) + if i == 1 then + res = element + else + res = res || " " || element + end + return new_string(res) + +mal_str: procedure expose values. /* mal_str(...) */ + res = "" + do i=1 to arg() + element = pr_str(arg(i), 0) + if i == 1 then + res = element + else + res = res || element + end + return new_string(res) + +mal_prn: procedure expose values. /* mal_prn(...) */ + res = "" + do i=1 to arg() + element = pr_str(arg(i), 1) + if i == 1 then + res = element + else + res = res || " " || element + end + say res + return new_nil() + +mal_println: procedure expose values. /* mal_println(...) */ + res = "" + do i=1 to arg() + element = pr_str(arg(i), 0) + if i == 1 then + res = element + else + res = res || " " || element + end + say res + return new_nil() + +mal_read_string: procedure expose values. err /* mal_read_string(str) */ + return read_str(obj_val(arg(1))) + +mal_readline: procedure expose values. /* mal_readline(prompt) */ + line = readline(obj_val(arg(1))) + if length(line) > 0 then return new_string(line) + if lines() > 0 then return new_string("") + return new_nil() + +mal_slurp: procedure expose values. /* mal_read_string(filename) */ + file_content = charin(obj_val(arg(1)), 1, 100000) + return new_string(file_content) + +mal_lt: procedure expose values. /* mal_lt(a, b) */ + return new_boolean(obj_val(arg(1)) < obj_val(arg(2))) + +mal_lte: procedure expose values. /* mal_lte(a, b) */ + return new_boolean(obj_val(arg(1)) <= obj_val(arg(2))) + +mal_gt: procedure expose values. /* mal_gt(a, b) */ + return new_boolean(obj_val(arg(1)) > obj_val(arg(2))) + +mal_gte: procedure expose values. /* mal_gte(a, b) */ + return new_boolean(obj_val(arg(1)) >= obj_val(arg(2))) + +mal_add: procedure expose values. /* mal_add(a, b) */ + return new_number(obj_val(arg(1)) + obj_val(arg(2))) + +mal_sub: procedure expose values. /* mal_sub(a, b) */ + return new_number(obj_val(arg(1)) - obj_val(arg(2))) + +mal_mul: procedure expose values. /* mal_mul(a, b) */ + return new_number(obj_val(arg(1)) * obj_val(arg(2))) + +mal_div: procedure expose values. /* mal_div(a, b) */ + return new_number(obj_val(arg(1)) / obj_val(arg(2))) + +mal_time_ms: procedure expose values. /* mal_time_ms() */ + return new_number(trunc(time('E') * 1000)) + +mal_list: procedure expose values. /* mal_list(...) */ + res = "" + do i=1 to arg() + if i == 1 then + res = arg(i) + else + res = res || " " || arg(i) + end + return new_list(res) + +mal_list?: procedure expose values. /* mal_list?(a) */ + return new_boolean(list?(arg(1))) + +mal_vector: procedure expose values. /* mal_vector(...) */ + res = "" + do i=1 to arg() + if i == 1 then + res = arg(i) + else + res = res || " " || arg(i) + end + return new_vector(res) + +mal_vector?: procedure expose values. /* mal_vector?(a) */ + return new_boolean(vector?(arg(1))) + +mal_hash_map: procedure expose values. /* mal_hash_map(...) */ + res = "" + do i=1 to arg() + if i == 1 then + res = arg(i) + else + res = res || " " || arg(i) + end + return new_hashmap(res) + +mal_map?: procedure expose values. /* mal_map?(a) */ + return new_boolean(hashmap?(arg(1))) + +mal_assoc: procedure expose values. /* mal_assoc(a, ...) */ + hm = arg(1) + res = "" + do i=2 to arg() by 2 + key_val = arg(i) || " " || arg(i + 1) + if res == 2 then + res = key_val + else + res = res || " " || key_val + end + hm_val = obj_val(hm) + do i=1 to words(hm_val) by 2 + if \contains?(res, word(hm_val, i)) then + res = res || " " || word(hm_val, i) || " " || word(hm_val, i + 1) + end + return new_hashmap(res) + +mal_dissoc: procedure expose values. /* mal_dissoc(a, ...) */ + hm = arg(1) + res = "" + hm_val = obj_val(hm) + do i=1 to words(hm_val) by 2 + key = word(hm_val, i) + found = 0 + do j=2 to arg() + if equal?(key, arg(j)) then do + found = 1 + leave + end + end + if \found then do + if length(res) > 0 then res = res || " " + res = res || key || " " || word(hm_val, i + 1) + end + end + return new_hashmap(res) + +mal_get: procedure expose values. /* mal_get(a, b) */ + res = hashmap_get(obj_val(arg(1)), arg(2)) + if res == "" then + return new_nil() + else + return res + +mal_contains?: procedure expose values. /* mal_contains?(a, b) */ + return new_boolean(contains?(obj_val(arg(1)), arg(2))) + +mal_keys: procedure expose values. /* mal_keys(a) */ + hm_val = obj_val(arg(1)) + seq = "" + do i=1 to words(hm_val) by 2 + if i == 1 then + seq = word(hm_val, i) + else + seq = seq || " " || word(hm_val, i) + end + return new_list(seq) + +mal_vals: procedure expose values. /* mal_vals(a) */ + hm_val = obj_val(arg(1)) + seq = "" + do i=2 to words(hm_val) by 2 + if i == 1 then + seq = word(hm_val, i) + else + seq = seq || " " || word(hm_val, i) + end + return new_list(seq) + +mal_sequential?: procedure expose values. /* mal_sequential?(a) */ + return new_boolean(sequential?(arg(1))) + +mal_cons: procedure expose values. /* mal_cons(a, b) */ + return new_list(arg(1) || " " || obj_val(arg(2))) + +mal_concat: procedure expose values. /* mal_concat(...) */ + seq = "" + do i=1 to arg() + if i == 1 then + seq = obj_val(arg(i)) + else + seq = seq || " " || obj_val(arg(i)) + end + return new_list(seq) + +mal_vec: procedure expose values. /* mal_vec(a) */ + return new_vector(obj_val(arg(1))) + +mal_nth: procedure expose values. err /* mal_nth(list, index) */ + list_val = obj_val(arg(1)) + i = obj_val(arg(2)) + if i >= words(list_val) then do + err = "nth: index out of range" + return "ERR" + end + return word(list_val, i + 1) + +mal_first: procedure expose values. /* mal_first(a) */ + if nil?(arg(1)) then return new_nil() + list_val = obj_val(arg(1)) + if words(list_val) == 0 then return new_nil() + return word(list_val, 1) + +mal_rest: procedure expose values. /* mal_rest(a) */ + return new_list(subword(obj_val(arg(1)), 2)) + +mal_empty?: procedure expose values. /* mal_empty?(a) */ + if nil?(arg(1)) then return new_true() + return new_boolean(count_elements(arg(1)) == 0) + +mal_count: procedure expose values. /* mal_count(a) */ + if nil?(arg(1)) then return new_number(0) + return new_number(count_elements(arg(1))) + +apply_function: procedure expose values. env. err /* apply_function(fn, lst) */ + f = arg(1) + call_args = arg(2) + select + when nativefn?(f) then do + call_args_val = obj_val(call_args) + call_list = "" + do i=1 to words(call_args_val) + element = '"' || word(call_args_val, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + apply_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + return eval(func_body_ast(f), apply_env_idx) + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + +mal_apply: procedure expose values. env. err /* mal_apply(fn, ..., lst) */ + fn = arg(1) + seq = "" + do i=2 to (arg() - 1) + if i == 2 then + seq = arg(i) + else + seq = seq || " " || arg(i) + end + if arg() > 1 then do + seq = seq || " " || obj_val(arg(arg())) + end + return apply_function(fn, new_list(seq)) + +mal_map: procedure expose values. env. err /* mal_map(f, lst) */ + fn = arg(1) + lst_val = obj_val(arg(2)) + res = "" + do i=1 to words(lst_val) + element = word(lst_val, i) + mapped_element = apply_function(fn, new_list(element)) + if mapped_element == "ERR" then return "ERR" + if i == 1 then + res = mapped_element + else + res = res || " " || mapped_element + end + return new_list(res) + +mal_conj: procedure expose values. env. err /* mal_conj(a, ...) */ + a = arg(1) + select + when list?(a) then do + do i=2 to arg() + a = mal_cons(arg(i), a) + end + return a + end + when vector?(a) then do + seq = obj_val(a) + do i=2 to arg() + if length(seq) > 0 then seq = seq || " " + seq = seq || arg(i) + end + return new_vector(seq) + end + otherwise + err = "conj requires list or vector" + return "ERR" + end + +mal_seq: procedure expose values. env. err /* mal_conj(a) */ + a = arg(1) + select + when string?(a) then do + str = obj_val(a) + if length(str) == 0 then return new_nil() + seq = "" + do i=1 to length(str) + element = new_string(substr(str, i, 1)) + if i == 1 then + seq = element + else + seq = seq || " " || element + end + return new_list(seq) + end + when list?(a) then do + if count_elements(a) == 0 then return new_nil() + return a + end + when vector?(a) then do + if count_elements(a) == 0 then return new_nil() + return new_list(obj_val(a)) + end + when nil?(a) then return new_nil() + otherwise + err = "seq requires string or list or vector or nil" + return "ERR" + end + +mal_with_meta: procedure expose values. /* mal_with_meta(a, b) */ + new_obj = obj_clone_and_set_meta(arg(1), arg(2)) + if new_obj == "" then return arg(1) + return new_obj + +mal_meta: procedure expose values. /* mal_meta(a) */ + meta = obj_meta(arg(1)) + if meta == "" then return new_nil() + return meta + +mal_atom: procedure expose values. /* mal_atom(a) */ + return new_atom(arg(1)) + +mal_atom?: procedure expose values. /* mal_atom?(a) */ + return new_boolean(atom?(arg(1))) + +mal_deref: procedure expose values. /* mal_deref(a) */ + return obj_val(arg(1)) + +mal_reset!: procedure expose values. /* mal_reset!(a, new_val) */ + return atom_set(arg(1), arg(2)) + +mal_swap!: procedure expose values. env. err /* mal_swap!(a, fn, ...) */ + atom = arg(1) + fn = arg(2) + atom_val = obj_val(atom) + seq = atom_val + do i=3 to arg() + seq = seq || " " || arg(i) + end + new_val = apply_function(fn, new_list(seq)) + if new_val == "ERR" then return "ERR" + return atom_set(atom, new_val) + +mal_rexx_eval: procedure expose values. /* mal_rexx_eval(..., a) */ + do i=1 to (arg() - 1) + interpret obj_val(arg(i)) + end + last_arg = arg(arg()) + if nil?(last_arg) then return new_nil() + last_arg_str = obj_val(last_arg) + if length(last_arg_str) == 0 then return new_nil() + rexx_eval_res = "" + interpret "rexx_eval_res = " || last_arg_str + if datatype(rexx_eval_res) == "NUM" then + return new_number(rexx_eval_res) + else + return new_string(rexx_eval_res) + +get_core_ns: procedure /* get_core_ns() */ + return "= mal_equal?" , + "throw mal_throw" , + , + "nil? mal_nil?" , + "true? mal_true?" , + "false? mal_false?" , + "string? mal_string?" , + "symbol mal_symbol" , + "symbol? mal_symbol?" , + "keyword mal_keyword" , + "keyword? mal_keyword?" , + "number? mal_number?" , + "fn? mal_fn?" , + "macro? mal_macro?" , + , + "pr-str mal_pr_str" , + "str mal_str" , + "prn mal_prn" , + "println mal_println" , + "read-string mal_read_string" , + "readline mal_readline" , + "slurp mal_slurp" , + , + "< mal_lt" , + "<= mal_lte" , + "> mal_gt" , + ">= mal_gte" , + "+ mal_add" , + "- mal_sub" , + "* mal_mul" , + "/ mal_div" , + "time-ms mal_time_ms" , + , + "list mal_list" , + "list? mal_list?" , + "vector mal_vector" , + "vector? mal_vector?" , + "hash-map mal_hash_map" , + "map? mal_map?" , + "assoc mal_assoc" , + "dissoc mal_dissoc" , + "get mal_get" , + "contains? mal_contains?" , + "keys mal_keys" , + "vals mal_vals" , + , + "sequential? mal_sequential?" , + "cons mal_cons" , + "concat mal_concat" , + "vec mal_vec" , + "nth mal_nth" , + "first mal_first" , + "rest mal_rest" , + "empty? mal_empty?" , + "count mal_count" , + "apply mal_apply" , + "map mal_map" , + , + "conj mal_conj" , + "seq mal_seq" , + , + "meta mal_meta" , + "with-meta mal_with_meta" , + "atom mal_atom" , + "atom? mal_atom?" , + "deref mal_deref" , + "reset! mal_reset!" , + "swap! mal_swap!" , + , + "rexx-eval mal_rexx_eval" + +#endif diff --git a/impls/rexx/env.rexx b/impls/rexx/env.rexx new file mode 100644 index 0000000000..4dec7e62bf --- /dev/null +++ b/impls/rexx/env.rexx @@ -0,0 +1,59 @@ +#ifndef __env__ +#define __env__ + +env. = "" +env.0 = 0 + +new_env_index: procedure expose env. /* new_env_index() */ + env.0 = env.0 + 1 + return env.0 + +new_env: procedure expose env. values. /* new_env(outer_env_idx [, binds, exprs]) */ + outer_env_idx = arg(1) + binds = arg(2) + exprs = arg(3) + idx = new_env_index() + env.idx.outer = outer_env_idx + env.idx.data. = "" + if binds \= "" then do + binds_val = obj_val(binds) + exprs_val = obj_val(exprs) + do i=1 to words(binds_val) + varname = obj_val(word(binds_val, i)) + if varname == "&" then do + rest_args_list = new_list(subword(exprs_val, i)) + varname = obj_val(word(binds_val, i + 1)) + x = env_set(idx, varname, rest_args_list) + leave + end + else + x = env_set(idx, varname, word(exprs_val, i)) + end + end + return idx + +env_set: procedure expose env. /* env_set(env_idx, key, val) */ + env_idx = arg(1) + key = arg(2) + val = arg(3) + env.env_idx.data.key = val + return val + +env_find: procedure expose env. /* env_find(env_idx, key) */ + env_idx = arg(1) + key = arg(2) + if env.env_idx.data.key \= "" then return env_idx + if env.env_idx.outer > 0 then return env_find(env.env_idx.outer, key) + return 0 + +env_get: procedure expose env. err /* env_get(env_idx, key) */ + env_idx = arg(1) + key = arg(2) + found_env_idx = env_find(env_idx, key) + if found_env_idx == 0 then do + err = "'" || key || "' not found" + return "ERR" + end + return env.found_env_idx.data.key + +#endif diff --git a/impls/rexx/printer.rexx b/impls/rexx/printer.rexx new file mode 100644 index 0000000000..e7922ef0ab --- /dev/null +++ b/impls/rexx/printer.rexx @@ -0,0 +1,54 @@ +#ifndef __printer__ +#define __printer__ + +#include "types.rexx" + +format_string: procedure /* format_string(str, readable) */ + str = arg(1) + readable = arg(2) + if readable then do + res = changestr('5C'x, str, "\\") + res = changestr('"', res, '\"') + res = changestr('0A'x, res, "\n") + return '"' || res || '"' + end + else + return str + +format_sequence: procedure expose values. /* format_sequence(val, open_char, close_char, readable) */ + val = arg(1) + open_char = arg(2) + close_char = arg(3) + readable = arg(4) + res = "" + do i=1 to words(val) + element = word(val, i) + if i > 1 then res = res || " " + res = res || pr_str(element, readable) + end + return open_char || res || close_char + +pr_str: procedure expose values. /* pr_str(ast, readable) */ + ast = arg(1) + readable = arg(2) + type = obj_type(ast) + val = obj_val(ast) + select + when type == "nill" then return "nil" + when type == "true" then return "true" + when type == "fals" then return "false" + when type == "numb" then return val + when type == "symb" then return val + when type == "stri" then return format_string(val, readable) + when type == "keyw" then return ":" || val + when type == "list" then return format_sequence(val, "(", ")", readable) + when type == "vect" then return format_sequence(val, "[", "]", readable) + when type == "hash" then return format_sequence(val, "{", "}", readable) + when type == "nafn" then return "#" + when type == "func" then return "#" + when type == "atom" then return "(atom " || pr_str(val, readable) || ")" + otherwise + return "#" + end + +#endif diff --git a/impls/rexx/reader.rexx b/impls/rexx/reader.rexx new file mode 100644 index 0000000000..cb8e8e8832 --- /dev/null +++ b/impls/rexx/reader.rexx @@ -0,0 +1,206 @@ +#ifndef __reader__ +#define __reader__ + +#include "types.rexx" + +next_token: procedure expose pos /* next_token(str) */ + TAB = '09'x + LF = '0A'x + CR = '0D'x + SEPARATOR_CHARS = TAB || LF || CR || " []{}()'`,;" || '"' + WHITESPACE_CHARS = TAB || LF || CR || " ," + str = arg(1) + token = "" + ch = substr(str, pos, 1) + select + when pos(ch, WHITESPACE_CHARS) > 0 then + pos = pos + 1 + when pos(ch, "[]{}()'`^@") > 0 then do + pos = pos + 1 + token = ch + end + when ch == '~' then do + if substr(str, pos + 1, 1) == '@' then do + pos = pos + 2 + token = "~@" + end + else do + pos = pos + 1 + token = "~" + end + end + when ch == ";" then do + do while pos <= length(str) + ch = substr(str, pos, 1) + if (ch == LF) | (ch == CR) then + leave + else + pos = pos + 1 + end + end + when ch == '"' then do + tmppos = pos + 1 + do while tmppos < length(str) + ch = substr(str, tmppos, 1) + select + when ch == '"' then + leave + when ch == '5C'x then /* backslash */ + tmppos = tmppos + 2 + otherwise + tmppos = tmppos + 1 + end + end + token = substr(str, pos, tmppos - pos + 1) + pos = tmppos + 1 + end + otherwise + tmppos = pos + do while tmppos <= length(str) + ch = substr(str, tmppos, 1) + if pos(ch, SEPARATOR_CHARS) > 0 then + leave + else + token = token || ch + tmppos = tmppos + 1 + end + pos = tmppos + end + return token + +tokenize: procedure expose tokens. /* tokenize(str) */ + str = arg(1) + tokens. = "" + num_of_tokens = 0 + str_to_tokenize = str + pos = 1 + do while pos <= length(str) + token = next_token(str_to_tokenize) + if length(token) > 0 then do + num_of_tokens = num_of_tokens + 1 + tokens.num_of_tokens = token + end + end + tokens.0 = num_of_tokens + return num_of_tokens + +is_number: procedure /* is_number(token) */ + token = arg(1) + ch = substr(token, 1, 1) + DIGITS = "0123456789" + if pos(ch, DIGITS) > 0 then return 1 + if (ch == '-') & (pos(substr(token, 2, 1), DIGITS) > 0) then return 1 + return 0 + +parse_string: procedure /* parse_string(token) */ + token = arg(1) + res = substr(token, 2, length(token) - 2) /* Remove quotes */ + res = changestr("\\", res, '01'x) + res = changestr("\n", res, '0A'x) + res = changestr('\"', res, '"') + res = changestr('01'x, res, '5C'x) + return res + +parse_keyword: procedure /* parse_keyword(token) */ + token = arg(1) + return substr(token, 2) /* Remove initial ":" */ + +read_atom: procedure expose values. tokens. pos err /* read_atom() */ + token = tokens.pos + pos = pos + 1 + select + when is_number(token) then return new_number(token) + when token == "nil" then return new_nil() + when token == "true" then return new_true() + when token == "false" then return new_false() + when substr(token, 1, 1) == ':' then return new_keyword(parse_keyword(token)) + when substr(token, 1, 1) == '"' then do + if substr(token, length(token), 1) \== '"' then do + end_char = '"' + err = "expected '" || end_char || "', got EOF" + return "ERR" + end + return new_string(parse_string(token)) + end + otherwise + return new_symbol(token) + end + +read_sequence: procedure expose values. tokens. pos err /* read_sequence(type, end_char) */ + type = arg(1) + end_char = arg(2) + pos = pos + 1 /* Consume the open paren */ + token = tokens.pos + seq = "" + do while (pos <= tokens.0) & (token \== end_char) + element = read_form() + if element == "ERR" then return "ERR" + if seq == "" then + seq = element + else + seq = seq || " " || element + token = tokens.pos + if token == "" then do + err = "expected '" || end_char || "', got EOF" + return "ERR" + end + end + pos = pos + 1 /* Consume the close paren */ + return new_seq(type, seq) + +reader_macro: procedure expose values. tokens. pos /* reader_macro(symbol) */ + symbol = arg(1) + pos = pos + 1 /* Consume the macro token */ + element = read_form() + if element == "ERR" then return "ERR" + seq = new_symbol(symbol) || " " || element + return new_list(seq) + +reader_with_meta_macro: procedure expose values. tokens. pos /* reader_with_meta_macro() */ + pos = pos + 1 /* Consume the macro token */ + meta = read_form() + if meta == "ERR" then return "ERR" + element = read_form() + if element == "ERR" then return "ERR" + seq = new_symbol("with-meta") || " " || element || " " || meta + return new_list(seq) + +read_form: procedure expose values. tokens. pos err /* read_form() */ + token = tokens.pos + select + when token == "'" then return reader_macro("quote") + when token == '`' then return reader_macro("quasiquote") + when token == '~' then return reader_macro("unquote") + when token == '~@' then return reader_macro("splice-unquote") + when token == '@' then return reader_macro("deref") + when token == '^' then return reader_with_meta_macro() + when token == '(' then return read_sequence("list", ")") + when token == ')' then do + err = "unexpected ')'" + return "ERR" + end + when token == '[' then return read_sequence("vect", "]") + when token == ']' then do + err = "unexpected ']'" + return "ERR" + end + when token == '{' then return read_sequence("hash", "}") + when token == '}' then do + err = "unexpected '}'" + return "ERR" + end + otherwise + return read_atom() + end + +read_str: procedure expose values. err /* read_str(line) */ + line = arg(1) + tokens. = "" + num_of_tokens = tokenize(line) + if num_of_tokens == 0 then + return "" + ast. = "" + pos = 1 + return read_form() + +#endif diff --git a/impls/rexx/readline.rexx b/impls/rexx/readline.rexx new file mode 100644 index 0000000000..4482bd7e5b --- /dev/null +++ b/impls/rexx/readline.rexx @@ -0,0 +1,8 @@ +#ifndef __readline__ +#define __readline__ + +readline: procedure /* readline(prompt) */ + call charout , arg(1) + return linein() + +#endif diff --git a/impls/rexx/run b/impls/rexx/run new file mode 100755 index 0000000000..b911329610 --- /dev/null +++ b/impls/rexx/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec rexx -a $(dirname $0)/${STEP:-stepA_mal}.rexxpp "${@}" diff --git a/impls/rexx/step0_repl.rexx b/impls/rexx/step0_repl.rexx new file mode 100644 index 0000000000..7ae0168c1c --- /dev/null +++ b/impls/rexx/step0_repl.rexx @@ -0,0 +1,23 @@ +call main +exit + +#include "readline.rexx" + +read: procedure /* read(str) */ + return arg(1) + +eval: procedure /* eval(exp, env) */ + return arg(1) + +print: procedure /* print(exp) */ + return arg(1) + +rep: procedure /* rep(str) */ + return print(eval(read(arg(1), ""))) + +main: + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then + call lineout , rep(input_line) + end diff --git a/impls/rexx/step1_read_print.rexx b/impls/rexx/step1_read_print.rexx new file mode 100644 index 0000000000..3101d67286 --- /dev/null +++ b/impls/rexx/step1_read_print.rexx @@ -0,0 +1,35 @@ +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +eval: procedure expose values. /* eval(exp, env) */ + return arg(1) + +print: procedure expose values. /* print(exp) */ + return pr_str(arg(1), 1) + +rep: procedure expose values. env. err /* rep(str) */ + ast = read(arg(1)) + if ast == "ERR" then return "ERR" + exp = eval(ast) + return print(exp) + +main: + values. = "" + values.0 = 0 + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step2_eval.rexx b/impls/rexx/step2_eval.rexx new file mode 100644 index 0000000000..d35b852736 --- /dev/null +++ b/impls/rexx/step2_eval.rexx @@ -0,0 +1,129 @@ +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + + -- call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then do + varname = astval + if env.varname == "" then do + err = "'" || varname || "' not found" + return "ERR" + end + return env.varname + end + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || f || "(" || call_list || ")" + return res + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +rep: procedure expose values. env. err /* rep(str) */ + ast = read(arg(1)) + if ast == "ERR" then return "ERR" + exp = eval(ast) + if exp == "ERR" then return "ERR" + return print(exp) + +mal_add: procedure expose values. /* mal_add(a, b) */ + return new_number(obj_val(arg(1)) + obj_val(arg(2))) + +mal_sub: procedure expose values. /* mal_sub(a, b) */ + return new_number(obj_val(arg(1)) - obj_val(arg(2))) + +mal_mul: procedure expose values. /* mal_mul(a, b) */ + return new_number(obj_val(arg(1)) * obj_val(arg(2))) + +mal_div: procedure expose values. /* mal_div(a, b) */ + return new_number(obj_val(arg(1)) / obj_val(arg(2))) + +main: + values. = "" + values.0 = 0 + env. = "" + key = "+" ; env.key = "mal_add" + key = "-" ; env.key = "mal_sub" + key = "*" ; env.key = "mal_mul" + key = "/" ; env.key = "mal_div" + err = "" + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step3_env.rexx b/impls/rexx/step3_env.rexx new file mode 100644 index 0000000000..800d261c6c --- /dev/null +++ b/impls/rexx/step3_env.rexx @@ -0,0 +1,154 @@ +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + return eval(word(astval, 3), letenv_idx) + end + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || f || "(" || call_list || ")" + return res + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +mal_add: procedure expose values. /* mal_add(a, b) */ + return new_number(obj_val(arg(1)) + obj_val(arg(2))) + +mal_sub: procedure expose values. /* mal_sub(a, b) */ + return new_number(obj_val(arg(1)) - obj_val(arg(2))) + +mal_mul: procedure expose values. /* mal_mul(a, b) */ + return new_number(obj_val(arg(1)) * obj_val(arg(2))) + +mal_div: procedure expose values. /* mal_div(a, b) */ + return new_number(obj_val(arg(1)) / obj_val(arg(2))) + +main: + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + x = env_set(repl_env_idx, "+", "mal_add") + x = env_set(repl_env_idx, "-", "mal_sub") + x = env_set(repl_env_idx, "*", "mal_mul") + x = env_set(repl_env_idx, "/", "mal_div") + err = "" + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step4_if_fn_do.rexx b/impls/rexx/step4_if_fn_do.rexx new file mode 100644 index 0000000000..3ddc276ed9 --- /dev/null +++ b/impls/rexx/step4_if_fn_do.rexx @@ -0,0 +1,179 @@ +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" +#include "core.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + return eval(word(astval, 3), letenv_idx) + end + when a0sym == "do" then do + res = "ERR" + do i=2 to words(astval) + res = eval(word(astval, i), env_idx) + if res == "ERR" then return "ERR" + end + return res + end + when a0sym == "if" then do + condval = eval(word(astval, 2), env_idx) + if false?(condval) | nil?(condval) then + if words(astval) >= 4 then + return eval(word(astval, 4), env_idx) + else + return new_nil() + else + return eval(word(astval, 3), env_idx) + end + when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + select + when nativefn?(f) then do + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + call_args = new_list(lst) + return eval(func_body_ast(f), new_env(func_env_idx(f), func_binds(f), call_args)) + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +main: + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + + /* core.rexx: defined using Rexx */ + core_ns = get_core_ns() + do i=1 to words(core_ns) by 2 + x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) + end + + /* core.mal: defined using the language itself */ + x = re("(def! not (fn* (a) (if a false true)))") + + err = "" + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step5_tco.rexx b/impls/rexx/step5_tco.rexx new file mode 100644 index 0000000000..9854de2f67 --- /dev/null +++ b/impls/rexx/step5_tco.rexx @@ -0,0 +1,186 @@ +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" +#include "core.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + do forever + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + env_idx = letenv_idx + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "do" then do + do i=2 to (words(astval) - 1) + res = eval(word(astval, i), env_idx) + if res == "ERR" then return "ERR" + end + ast = word(astval, words(astval)) + /* TCO */ + end + when a0sym == "if" then do + condval = eval(word(astval, 2), env_idx) + if false?(condval) | nil?(condval) then + if words(astval) >= 4 then + ast = word(astval, 4) + else + return new_nil() + else + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + select + when nativefn?(f) then do + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + call_args = new_list(lst) + env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = func_body_ast(f) + /* TCO */ + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + end + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +main: + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + + /* core.rexx: defined using Rexx */ + core_ns = get_core_ns() + do i=1 to words(core_ns) by 2 + x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) + end + + /* core.mal: defined using the language itself */ + x = re("(def! not (fn* (a) (if a false true)))") + + err = "" + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step6_file.rexx b/impls/rexx/step6_file.rexx new file mode 100644 index 0000000000..9cedb31b75 --- /dev/null +++ b/impls/rexx/step6_file.rexx @@ -0,0 +1,217 @@ +/* Save command-line arguments from the top-level program before entering a procedure */ +command_line_args. = "" +command_line_args.0 = arg() +do i=1 to command_line_args.0 + command_line_args.i = arg(i) +end + +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" +#include "core.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + do forever + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + env_idx = letenv_idx + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "do" then do + do i=2 to (words(astval) - 1) + res = eval(word(astval, i), env_idx) + if res == "ERR" then return "ERR" + end + ast = word(astval, words(astval)) + /* TCO */ + end + when a0sym == "if" then do + condval = eval(word(astval, 2), env_idx) + if false?(condval) | nil?(condval) then + if words(astval) >= 4 then + ast = word(astval, 4) + else + return new_nil() + else + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + select + when nativefn?(f) then do + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + call_args = new_list(lst) + env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = func_body_ast(f) + /* TCO */ + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + end + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +mal_eval: procedure expose values. env. err /* mal_eval(ast) */ + ast = arg(1) + if ast == "ERR" then return "ERR" + return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ + +build_args_list: procedure expose values. command_line_args. /* build_args_list() */ + seq = "" + do i=2 to command_line_args.0 + s = new_string(command_line_args.i) + if i == 1 then + seq = s + else + seq = seq || " " || s + end + return new_list(seq) + +main: + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + + /* core.rexx: defined using Rexx */ + core_ns = get_core_ns() + do i=1 to words(core_ns) by 2 + x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) + end + x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) + x = env_set(repl_env_idx, "*ARGV*", build_args_list()) + + /* core.mal: defined using the language itself */ + x = re("(def! not (fn* (a) (if a false true)))") + x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + + err = "" + if command_line_args.0 > 0 then do + x = re('(load-file "' || command_line_args.1 || '")') + return + end + + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step7_quote.rexx b/impls/rexx/step7_quote.rexx new file mode 100644 index 0000000000..d1ad12406a --- /dev/null +++ b/impls/rexx/step7_quote.rexx @@ -0,0 +1,262 @@ +/* Save command-line arguments from the top-level program before entering a procedure */ +command_line_args. = "" +command_line_args.0 = arg() +do i=1 to command_line_args.0 + command_line_args.i = arg(i) +end + +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" +#include "core.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) <> 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc + +quasiquote: procedure expose values. env. err /* quasiquote(ast) */ + ast = arg(1) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + do forever + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + env_idx = letenv_idx + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquote" then do + ast = quasiquote(word(astval, 2)) + /* TCO */ + end + when a0sym == "do" then do + do i=2 to (words(astval) - 1) + res = eval(word(astval, i), env_idx) + if res == "ERR" then return "ERR" + end + ast = word(astval, words(astval)) + /* TCO */ + end + when a0sym == "if" then do + condval = eval(word(astval, 2), env_idx) + if false?(condval) | nil?(condval) then + if words(astval) >= 4 then + ast = word(astval, 4) + else + return new_nil() + else + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + select + when nativefn?(f) then do + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + call_args = new_list(lst) + env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = func_body_ast(f) + /* TCO */ + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + end + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +mal_eval: procedure expose values. env. err /* mal_eval(ast) */ + ast = arg(1) + if ast == "ERR" then return "ERR" + return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ + +build_args_list: procedure expose values. command_line_args. /* build_args_list() */ + seq = "" + do i=2 to command_line_args.0 + s = new_string(command_line_args.i) + if i == 1 then + seq = s + else + seq = seq || " " || s + end + return new_list(seq) + +main: + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + + /* core.rexx: defined using Rexx */ + core_ns = get_core_ns() + do i=1 to words(core_ns) by 2 + x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) + end + x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) + x = env_set(repl_env_idx, "*ARGV*", build_args_list()) + + /* core.mal: defined using the language itself */ + x = re("(def! not (fn* (a) (if a false true)))") + x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + + err = "" + if command_line_args.0 > 0 then do + x = re('(load-file "' || command_line_args.1 || '")') + return + end + + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step8_macros.rexx b/impls/rexx/step8_macros.rexx new file mode 100644 index 0000000000..2f3856f3b0 --- /dev/null +++ b/impls/rexx/step8_macros.rexx @@ -0,0 +1,278 @@ +/* Save command-line arguments from the top-level program before entering a procedure */ +command_line_args. = "" +command_line_args.0 = arg() +do i=1 to command_line_args.0 + command_line_args.i = arg(i) +end + +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" +#include "core.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) <> 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc + +quasiquote: procedure expose values. env. err /* quasiquote(ast) */ + ast = arg(1) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + do forever + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + env_idx = letenv_idx + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquote" then do + ast = quasiquote(word(astval, 2)) + /* TCO */ + end + when a0sym == "defmacro!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, func_mark_as_macro(a2)) + end + when a0sym == "do" then do + do i=2 to (words(astval) - 1) + res = eval(word(astval, i), env_idx) + if res == "ERR" then return "ERR" + end + ast = word(astval, words(astval)) + /* TCO */ + end + when a0sym == "if" then do + condval = eval(word(astval, 2), env_idx) + if false?(condval) | nil?(condval) then + if words(astval) >= 4 then + ast = word(astval, 4) + else + return new_nil() + else + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + if func_macro?(f) then do + call_args = mal_rest(ast) + mac_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = eval(func_body_ast(f), mac_env_idx) + /* TCO */ + end + else do + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + select + when nativefn?(f) then do + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + call_args = new_list(lst) + env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = func_body_ast(f) + /* TCO */ + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + end + end + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +mal_eval: procedure expose values. env. err /* mal_eval(ast) */ + ast = arg(1) + if ast == "ERR" then return "ERR" + return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ + +build_args_list: procedure expose values. command_line_args. /* build_args_list() */ + seq = "" + do i=2 to command_line_args.0 + s = new_string(command_line_args.i) + if i == 1 then + seq = s + else + seq = seq || " " || s + end + return new_list(seq) + +main: + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + + /* core.rexx: defined using Rexx */ + core_ns = get_core_ns() + do i=1 to words(core_ns) by 2 + x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) + end + x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) + x = env_set(repl_env_idx, "*ARGV*", build_args_list()) + + /* core.mal: defined using the language itself */ + x = re("(def! not (fn* (a) (if a false true)))") + x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + x = re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " || '"' || "odd number of forms to cond" || '"' || ")) (cons 'cond (rest (rest xs)))))))"); + + err = "" + if command_line_args.0 > 0 then do + x = re('(load-file "' || command_line_args.1 || '")') + return + end + + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then + call lineout , "Error: " || err + else + call lineout , res + end + end diff --git a/impls/rexx/step9_try.rexx b/impls/rexx/step9_try.rexx new file mode 100644 index 0000000000..3e1c563163 --- /dev/null +++ b/impls/rexx/step9_try.rexx @@ -0,0 +1,300 @@ +/* Save command-line arguments from the top-level program before entering a procedure */ +command_line_args. = "" +command_line_args.0 = arg() +do i=1 to command_line_args.0 + command_line_args.i = arg(i) +end + +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" +#include "core.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) <> 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc + +quasiquote: procedure expose values. env. err /* quasiquote(ast) */ + ast = arg(1) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + do forever + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + env_idx = letenv_idx + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquote" then do + ast = quasiquote(word(astval, 2)) + /* TCO */ + end + when a0sym == "defmacro!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, func_mark_as_macro(a2)) + end + when a0sym == "try*" then do + res = eval(word(astval, 2), env_idx) + if words(astval) < 3 then return res + if res == "ERR" then do + if word(err, 1) == "__MAL_EXCEPTION__" then + errobj = word(err, 2) + else + errobj = new_string(err) + catchlst = obj_val(word(astval, 3)) + catch_env_idx = new_env(env_idx, new_list(word(catchlst, 2)), new_list(errobj)) + err = "" + return eval(word(catchlst, 3), catch_env_idx) + end + else + return res + end + when a0sym == "do" then do + do i=2 to (words(astval) - 1) + res = eval(word(astval, i), env_idx) + if res == "ERR" then return "ERR" + end + ast = word(astval, words(astval)) + /* TCO */ + end + when a0sym == "if" then do + condval = eval(word(astval, 2), env_idx) + if false?(condval) | nil?(condval) then + if words(astval) >= 4 then + ast = word(astval, 4) + else + return new_nil() + else + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + if func_macro?(f) then do + call_args = mal_rest(ast) + mac_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = eval(func_body_ast(f), mac_env_idx) + /* TCO */ + end + else do + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + select + when nativefn?(f) then do + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + call_args = new_list(lst) + env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = func_body_ast(f) + /* TCO */ + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + end + end + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +mal_eval: procedure expose values. env. err /* mal_eval(ast) */ + ast = arg(1) + if ast == "ERR" then return "ERR" + return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ + +build_args_list: procedure expose values. command_line_args. /* build_args_list() */ + seq = "" + do i=2 to command_line_args.0 + s = new_string(command_line_args.i) + if i == 1 then + seq = s + else + seq = seq || " " || s + end + return new_list(seq) + +main: + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + + /* core.rexx: defined using Rexx */ + core_ns = get_core_ns() + do i=1 to words(core_ns) by 2 + x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) + end + x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) + x = env_set(repl_env_idx, "*ARGV*", build_args_list()) + + /* core.mal: defined using the language itself */ + x = re("(def! not (fn* (a) (if a false true)))") + x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + x = re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " || '"' || "odd number of forms to cond" || '"' || ")) (cons 'cond (rest (rest xs)))))))"); + + err = "" + if command_line_args.0 > 0 then do + x = re('(load-file "' || command_line_args.1 || '")') + return + end + + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then do + if word(err, 1) == "__MAL_EXCEPTION__" then + errstr = pr_str(word(err, 2), 0) + else + errstr = err + call lineout , "Error: " || errstr + err = "" + end + else + call lineout , res + end + end diff --git a/impls/rexx/stepA_mal.rexx b/impls/rexx/stepA_mal.rexx new file mode 100644 index 0000000000..1b47c40843 --- /dev/null +++ b/impls/rexx/stepA_mal.rexx @@ -0,0 +1,303 @@ +/* Save command-line arguments from the top-level program before entering a procedure */ +command_line_args. = "" +command_line_args.0 = arg() +do i=1 to command_line_args.0 + command_line_args.i = arg(i) +end + +call main +exit + +#include "readline.rexx" +#include "reader.rexx" +#include "printer.rexx" +#include "types.rexx" +#include "env.rexx" +#include "core.rexx" + +read: procedure expose values. err /* read(str) */ + return read_str(arg(1)) + +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) <> 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc + +quasiquote: procedure expose values. env. err /* quasiquote(ast) */ + ast = arg(1) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end + +eval: procedure expose values. env. err /* eval(ast) */ + ast = arg(1) + env_idx = arg(2) + do forever + + debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) + if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, + call lineout , ("EVAL: " || print(ast)) + + type = obj_type(ast) + astval = obj_val(ast) + select + when type == "symb" then return env_get(env_idx, astval) + when type == "list" & words(astval) > 0 then do + -- proceed after this select statement + end + when type == "vect" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_vector(res) + end + when type == "hash" then do + res = "" + do i=1 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 1 then + res = res || " " || element + else + res = element + end + return new_hashmap(res) + end + otherwise + return ast + end + + -- ast is a non-empty list + + a0 = word(astval, 1) + a0sym = obj_val(a0) + select + when a0sym == "def!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, a2) + end + when a0sym == "let*" then do + a1lst = obj_val(word(astval, 2)) + letenv_idx = new_env(env_idx) + do i=1 to words(a1lst) by 2 + k = obj_val(word(a1lst, i)) + v = eval(word(a1lst, i + 1), letenv_idx) + if v == "ERR" then return "ERR" + unused = env_set(letenv_idx, k, v) + end + env_idx = letenv_idx + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquote" then do + ast = quasiquote(word(astval, 2)) + /* TCO */ + end + when a0sym == "defmacro!" then do + a1sym = obj_val(word(astval, 2)) + a2 = eval(word(astval, 3), env_idx) + if a2 == "ERR" then return "ERR" + return env_set(env_idx, a1sym, func_mark_as_macro(a2)) + end + when a0sym == "try*" then do + res = eval(word(astval, 2), env_idx) + if words(astval) < 3 then return res + if res == "ERR" then do + if word(err, 1) == "__MAL_EXCEPTION__" then + errobj = word(err, 2) + else + errobj = new_string(err) + catchlst = obj_val(word(astval, 3)) + catch_env_idx = new_env(env_idx, new_list(word(catchlst, 2)), new_list(errobj)) + err = "" + return eval(word(catchlst, 3), catch_env_idx) + end + else + return res + end + when a0sym == "do" then do + do i=2 to (words(astval) - 1) + res = eval(word(astval, i), env_idx) + if res == "ERR" then return "ERR" + end + ast = word(astval, words(astval)) + /* TCO */ + end + when a0sym == "if" then do + condval = eval(word(astval, 2), env_idx) + if false?(condval) | nil?(condval) then + if words(astval) >= 4 then + ast = word(astval, 4) + else + return new_nil() + else + ast = word(astval, 3) + /* TCO */ + end + when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) + otherwise + f = eval(a0, env_idx) + if f == "ERR" then return "ERR" + + if func_macro?(f) then do + call_args = mal_rest(ast) + mac_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = eval(func_body_ast(f), mac_env_idx) + /* TCO */ + end + else do + + -- Evaluate the arguments and store them to lst. + lst = "" + do i=2 to words(astval) + element = eval(word(astval, i), env_idx) + if element == "ERR" then return "ERR" + if i > 2 then + lst = lst || " " || element + else + lst = element + end + + select + when nativefn?(f) then do + call_args = lst + call_list = "" + do i=1 to words(call_args) + element = '"' || word(call_args, i) || '"' + if i > 1 then + call_list = call_list || ', ' || element + else + call_list = element + end + res = "" + interpret "res = " || obj_val(f) || "(" || call_list || ")" + return res + end + when func?(f) then do + call_args = new_list(lst) + env_idx = new_env(func_env_idx(f), func_binds(f), call_args) + ast = func_body_ast(f) + /* TCO */ + end + otherwise + err = "Unsupported function object type: " || obj_type(f) + return "ERR" + end + end + end + end + +print: procedure expose values. /* print(ast) */ + return pr_str(arg(1), 1) + +re: procedure expose values. env. err repl_env_idx /* re(str) */ + str = arg(1) + ast = read(str) + if ast == "ERR" then return "ERR" + return eval(ast, repl_env_idx) + +rep: procedure expose values. env. err repl_env_idx /* rep(str) */ + str = arg(1) + exp = re(str) + if exp == "ERR" then return "ERR" + return print(exp) + +mal_eval: procedure expose values. env. err /* mal_eval(ast) */ + ast = arg(1) + if ast == "ERR" then return "ERR" + return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ + +build_args_list: procedure expose values. command_line_args. /* build_args_list() */ + seq = "" + do i=2 to command_line_args.0 + s = new_string(command_line_args.i) + if i == 1 then + seq = s + else + seq = seq || " " || s + end + return new_list(seq) + +main: + x = time('R') /* Reset the internal stopwatch; used by `time-ms` */ + values. = "" + values.0 = 0 + env. = "" + env.0 = 0 + repl_env_idx = new_env(0) + + /* core.rexx: defined using Rexx */ + core_ns = get_core_ns() + do i=1 to words(core_ns) by 2 + x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) + end + x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) + x = env_set(repl_env_idx, "*ARGV*", build_args_list()) + + /* core.mal: defined using the language itself */ + x = re('(def! *host-language* "rexx")') + x = re("(def! not (fn* (a) (if a false true)))") + x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') + x = re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " || '"' || "odd number of forms to cond" || '"' || ")) (cons 'cond (rest (rest xs)))))))"); + + err = "" + if command_line_args.0 > 0 then do + x = re('(load-file "' || command_line_args.1 || '")') + return + end + + x = re('(println (str "Mal [" *host-language* "]"))') + do while lines() > 0 /* 1 == 1 */ + input_line = readline('user> ') + if length(input_line) > 0 then do + res = rep(input_line) + if res == "ERR" then do + if word(err, 1) == "__MAL_EXCEPTION__" then + errstr = pr_str(word(err, 2), 0) + else + errstr = err + call lineout , "Error: " || errstr + err = "" + end + else + call lineout , res + end + end diff --git a/impls/rexx/tests/step5_tco.mal b/impls/rexx/tests/step5_tco.mal new file mode 100644 index 0000000000..51604d627e --- /dev/null +++ b/impls/rexx/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; REXX: skipping non-TCO recursion +;; Reason: regina rexx interpreter segfaults (unrecoverable) diff --git a/impls/rexx/tests/stepA_mal.mal b/impls/rexx/tests/stepA_mal.mal new file mode 100644 index 0000000000..21a3f86050 --- /dev/null +++ b/impls/rexx/tests/stepA_mal.mal @@ -0,0 +1,23 @@ +;; Testing basic Rexx interop +;; +;; Note that in Rexx "everything is a string". Numeric outputs are converted to +;; Mal numbers. + +(rexx-eval "3 ** 4") +;=>81 + +(rexx-eval "words('a bb ' || 'ccc dddd')") +;=>4 + +(rexx-eval "d2x(254)") +;=>"FE" + +(rexx-eval "say 'hello' 12.34 upper('rexx')" nil) +;/hello 12.34 REXX +;=>nil + +(rexx-eval "foo = 8" "foo + 3") +;=>11 + +(rexx-eval "parse version s1 s2 s3 s4 s5" "'rexx_version=' || s2") +;=>"rexx_version=5.00" diff --git a/impls/rexx/types.rexx b/impls/rexx/types.rexx new file mode 100644 index 0000000000..c643e5f7b6 --- /dev/null +++ b/impls/rexx/types.rexx @@ -0,0 +1,255 @@ +#ifndef __types__ +#define __types__ + +values. = "" +values.0 = 0 + +new_value_index: procedure expose values. /* new_value_index() */ + values.0 = values.0 + 1 + return values.0 + +obj_type: procedure /* obj_type(obj) */ + obj = arg(1) + return left(obj, 4) + +obj_val: procedure expose values. /* obj_val(obj) */ + obj = arg(1) + type = obj_type(obj) + val = substr(obj, 6) + select + when type == "numb" | type == "nill" | type == "true" | type == "fals" then return val + otherwise + return values.val + end + +obj_meta: procedure expose values. /* obj_meta(obj) */ + obj = arg(1) + type = obj_type(obj) + if type == "numb" | type == "nill" | type == "true" | type == "fals" then return "" + ind = substr(obj, 6) + return values.meta.ind + +obj_clone_and_set_meta: procedure expose values. /* obj_clone_and_set_meta(obj, new_meta) */ + obj = arg(1) + new_meta = arg(2) + type = obj_type(obj) + if type == "numb" | type == "nill" | type == "true" | type == "fals" then return "" + orig_ind = substr(obj, 6) + new_idx = new_value_index() + values.new_idx = values.orig_ind + values.meta.new_idx = new_meta + return type || "_" || new_idx + +new_number: procedure /* new_number(n) */ + n = arg(1) + return "numb_" || n + +number?: procedure /* number?(obj) */ + return obj_type(arg(1)) == "numb" + +new_nil: procedure /* new_nil() */ + return "nill_0" + +nil?: procedure /* nil?(obj) */ + return obj_type(arg(1)) == "nill" + +new_true: procedure /* new_true() */ + return "true_0" + +true?: procedure /* true?(obj) */ + return obj_type(arg(1)) == "true" + +new_false: procedure /* new_false() */ + return "fals_0" + +false?: procedure /* false?(obj) */ + return obj_type(arg(1)) == "fals" + +new_boolean: procedure /* new_boolean(cond) */ + if arg(1) then + return new_true() + else + return new_false() + +new_symbol: procedure expose values. /* new_symbol(str) */ + str = arg(1) + idx = new_value_index() + values.idx = str + return "symb_" || idx + +symbol?: procedure /* symbol?(obj) */ + return obj_type(arg(1)) == "symb" + +new_string: procedure expose values. /* new_string(str) */ + str = arg(1) + idx = new_value_index() + values.idx = str + return "stri_" || idx + +string?: procedure /* string?(obj) */ + return obj_type(arg(1)) == "stri" + +new_keyword: procedure expose values. /* new_keyword(str) */ + str = arg(1) + idx = new_value_index() + values.idx = str + return "keyw_" || idx + +keyword?: procedure /* keyword?(obj) */ + return obj_type(arg(1)) == "keyw" + +new_seq: procedure expose values. /* new_seq(type, seq) */ + type = arg(1) + seq = arg(2) + idx = new_value_index() + values.idx = seq + return type || "_" || idx + +new_list: procedure expose values. /* new_list(seq) */ + seq = arg(1) + return new_seq("list", seq) + +list?: procedure /* list?(obj) */ + return obj_type(arg(1)) == "list" + +new_vector: procedure expose values. /* new_vector(seq) */ + seq = arg(1) + return new_seq("vect", seq) + +vector?: procedure /* vector?(obj) */ + return obj_type(arg(1)) == "vect" + +sequential?: procedure /* sequential?(obj) */ + return (list?(arg(1)) | vector?(arg(1))) + +count_elements: procedure expose values. /* count_elements(lst) */ + return words(obj_val(arg(1))) + +new_hashmap: procedure expose values. /* new_hashmap(seq) */ + seq = arg(1) + return new_seq("hash", seq) + +hashmap?: procedure /* hashmap?(obj) */ + return obj_type(arg(1)) == "hash" + +contains?: procedure expose values. /* contains?(hm_val, key) */ + hm_val = arg(1) + key = arg(2) + do i=1 to words(hm_val) by 2 + if equal?(key, word(hm_val, i)) then return 1 + end + return 0 + +hashmap_get: procedure expose values. /* hashmap_get(hm_val, key) */ + hm_val = arg(1) + key = arg(2) + do i=1 to words(hm_val) by 2 + if equal?(key, word(hm_val, i)) then return word(hm_val, i + 1) + end + return "" + +new_nativefn: procedure expose values. /* new_hashmap(native_func_name) */ + native_func_name = arg(1) + idx = new_value_index() + values.idx = native_func_name + return "nafn_" || idx + +nativefn?: procedure /* nativefn?(obj) */ + return obj_type(arg(1)) == "nafn" + +new_func: procedure expose values. /* new_func(body_ast, env_idx, binds) */ + body_ast = arg(1) + env_idx = arg(2) + binds = arg(3) + is_macro = 0 + idx = new_value_index() + values.idx = body_ast env_idx binds is_macro + return "func_" || idx + +func?: procedure /* func?(obj) */ + return obj_type(arg(1)) == "func" + +func_macro?: procedure expose values. /* func_macro?(obj) */ + return func?(arg(1)) & (func_is_macro(arg(1)) == 1) + +func_body_ast: procedure expose values. /* func_body_ast(func_obj) */ + return word(obj_val(arg(1)), 1) + +func_env_idx: procedure expose values. /* func_env_idx(func_obj) */ + return word(obj_val(arg(1)), 2) + +func_binds: procedure expose values. /* func_binds(func_obj) */ + return word(obj_val(arg(1)), 3) + +func_is_macro: procedure expose values. /* func_is_macro(func_obj) */ + return word(obj_val(arg(1)), 4) + +func_mark_as_macro: procedure expose values. /* func_mark_as_macro(func_obj) */ + body_ast = func_body_ast(arg(1)) + env_idx = func_env_idx(arg(1)) + binds = func_binds(arg(1)) + is_macro = 1 + idx = new_value_index() + values.idx = body_ast env_idx binds is_macro + return "func_" || idx + +new_atom: procedure expose values. /* new_atom(obj) */ + obj = arg(1) + idx = new_value_index() + values.idx = obj + return "atom_" || idx + +atom?: procedure /* atom?(obj) */ + return obj_type(arg(1)) == "atom" + +atom_set: procedure expose values. /* atom_set(atom, new_value) */ + atom = arg(1) + new_value = arg(2) + idx = substr(atom, 6) + values.idx = new_value + return new_value + +equal_hashmap?: procedure expose values. /* equal_hashmap?(a, b) */ + hma_val = obj_val(arg(1)) + hmb_val = obj_val(arg(2)) + if words(hma_val) \= words(hmb_val) then return 0 + do i=1 to words(hma_val) by 2 + a_key = word(hma_val, i) + a_val = word(hma_val, i + 1) + b_val = hashmap_get(hmb_val, a_key) + if b_val == "" then return 0 + if \equal?(a_val, b_val) then return 0 + end + return 1 + +equal_sequential?: procedure expose values. /* equal_sequential?(a, b) */ + a_val = obj_val(arg(1)) + b_val = obj_val(arg(2)) + if words(a_val) \= words(b_val) then return 0 + do i=1 to words(a_val) + if \equal?(word(a_val, i), word(b_val, i)) then return 0 + end + return 1 + +equal?: procedure expose values. /* equal?(a, b) */ + a = arg(1) + b = arg(2) + a_type = obj_type(a) + b_type = obj_type(b) + a_val = obj_val(a) + b_val = obj_val(b) + select + when nil?(a) then return nil?(b) + when true?(a) then return true?(b) + when false?(a) then return false?(b) + when (a_type == "numb" & b_type = "numb") | , + (a_type == "symb" & b_type = "symb") | , + (a_type == "stri" & b_type = "stri") | , + (a_type == "keyw" & b_type = "keyw") then return (obj_val(a) == obj_val(b)) + when (sequential?(a) & sequential?(b)) then return equal_sequential?(a, b) + when (hashmap?(a) & hashmap?(b)) then return equal_hashmap?(a, b) + otherwise + return 0 + end + +#endif diff --git a/impls/rpython/Dockerfile b/impls/rpython/Dockerfile new file mode 100644 index 0000000000..29f97d58e0 --- /dev/null +++ b/impls/rpython/Dockerfile @@ -0,0 +1,47 @@ +FROM ubuntu:vivid +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# For building rpython +RUN apt-get -y install g++ + +# pypy +RUN apt-get -y install software-properties-common +RUN add-apt-repository ppa:pypy +RUN apt-get -y update +RUN apt-get -y install pypy + +# rpython +RUN apt-get -y install mercurial libffi-dev pkg-config libz-dev libbz2-dev \ + libsqlite3-dev libncurses-dev libexpat1-dev libssl-dev libgdbm-dev tcl-dev + +RUN mkdir -p /opt/pypy && \ + curl -L https://bitbucket.org/pypy/pypy/downloads/pypy2-v5.6.0-src.tar.bz2 | tar -xjf - -C /opt/pypy/ --strip-components=1 + #curl https://bitbucket.org/pypy/pypy/get/tip.tar.gz | tar -xzf - -C /opt/pypy/ --strip-components=1 +RUN cd /opt/pypy && make && rm -rf /tmp/usession* + +RUN ln -sf /opt/pypy/rpython/bin/rpython /usr/local/bin/rpython +RUN ln -sf /opt/pypy/pypy-c /usr/local/bin/pypy +RUN chmod -R ugo+rw /opt/pypy/rpython/_cache + +RUN apt-get -y autoremove pypy + diff --git a/impls/rpython/Makefile b/impls/rpython/Makefile new file mode 100644 index 0000000000..95a38adfd6 --- /dev/null +++ b/impls/rpython/Makefile @@ -0,0 +1,32 @@ + +RPYTHON = rpython + +UPPER_STEPS = step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal +STEPS = step0_repl step1_read_print step2_eval step3_env $(UPPER_STEPS) + +all: $(STEPS) + +dist: mal + +mal: stepA_mal + cp $< $@ + +%: %.py + $(RPYTHON) --output=$@ $< + +STEP0_DEPS = mal_readline.py +STEP1_DEPS = $(STEP0_DEPS) mal_types.py reader.py printer.py +STEP3_DEPS = $(STEP1_DEPS) env.py +STEP4_DEPS = $(STEP3_DEPS) core.py + +step0_repl: $(STEP0_DEPS) +step1_read_print step2_eval: $(STEP1_DEPS) +step3_env: $(STEP3_DEPS) +$(UPPER_STEPS): $(STEP4_DEPS) + +.PHONY: clean + +clean: + rm -f mal $(STEPS) *.pyc + rm -rf __pycache__ + diff --git a/impls/rpython/core.py b/impls/rpython/core.py new file mode 100644 index 0000000000..6df848b5d6 --- /dev/null +++ b/impls/rpython/core.py @@ -0,0 +1,445 @@ +#import copy, time +import time + +import mal_types as types +from mal_types import (throw_str, + MalType, MalMeta, nil, true, false, + MalInt, MalSym, MalStr, + MalList, MalVector, MalHashMap, + MalAtom, MalFunc) +import mal_readline +import reader +import printer + +# General functions +def wrap_tf(tf): + if tf: return true + else: return false + +def do_equal(args): return wrap_tf(types._equal_Q(args[0], args[1])) + +# Errors/Exceptions +def throw(args): + raise types.MalException(args[0]) + +# Scalar functions +def nil_Q(args): return wrap_tf(types._nil_Q(args[0])) +def true_Q(args): return wrap_tf(types._true_Q(args[0])) +def false_Q(args): return wrap_tf(types._false_Q(args[0])) +def string_Q(args): return wrap_tf(types._string_Q(args[0])) +def symbol(args): + a0 = args[0] + if isinstance(a0, MalStr): + return types._symbol(a0.value) + elif isinstance(a0, MalSym): + return a0 + else: + throw_str("symbol called on non-string/non-symbol") +def symbol_Q(args): return wrap_tf(types._symbol_Q(args[0])) +def keyword(args): return types._keyword(args[0]) +def keyword_Q(args): return wrap_tf(types._keyword_Q(args[0])) +def number_Q(args): return wrap_tf(types._int_Q(args[0])) +def function_Q(args): return wrap_tf(types._function_Q(args[0]) and not args[0].ismacro) +def macro_Q(args): return wrap_tf(types._function_Q(args[0]) and args[0].ismacro) + + +# String functions +def pr_str(args): + parts = [] + for exp in args.values: parts.append(printer._pr_str(exp, True)) + return MalStr(u" ".join(parts)) + +def do_str(args): + parts = [] + for exp in args.values: parts.append(printer._pr_str(exp, False)) + return MalStr(u"".join(parts)) + +def prn(args): + parts = [] + for exp in args.values: parts.append(printer._pr_str(exp, True)) + print(u" ".join(parts)) + return nil + +def println(args): + parts = [] + for exp in args.values: parts.append(printer._pr_str(exp, False)) + print(u" ".join(parts)) + return nil + +def do_readline(args): + prompt = args[0] + if not isinstance(prompt, MalStr): + throw_str("readline prompt is not a string") + try: + return MalStr(unicode(mal_readline.readline(str(prompt.value)))) + except EOFError: + return nil + +def read_str(args): + a0 = args[0] + if not isinstance(a0, MalStr): + throw_str("read-string of non-string") + return reader.read_str(str(a0.value)) + +def slurp(args): + a0 = args[0] + if not isinstance(a0, MalStr): + throw_str("slurp with non-string filename") + return MalStr(unicode(open(str(a0.value)).read())) + +# Number functions +def lt(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str("< called on non-integer") + return wrap_tf(a.value < b.value) +def lte(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str("<= called on non-integer") + return wrap_tf(a.value <= b.value) +def gt(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str("> called on non-integer") + return wrap_tf(a.value > b.value) +def gte(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str(">= called on non-integer") + return wrap_tf(a.value >= b.value) + +def plus(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str("+ called on non-integer") + return MalInt(a.value+b.value) +def minus(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str("- called on non-integer") + return MalInt(a.value-b.value) +def multiply(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str("* called on non-integer") + return MalInt(a.value*b.value) +def divide(args): + a, b = args[0], args[1] + if not isinstance(a, MalInt) or not isinstance(b, MalInt): + throw_str("/ called on non-integer") + if b.value == 0: + throw_str("divide by zero") + return MalInt(int(a.value/b.value)) + +def time_ms(args): + return MalInt(int(time.time() * 1000)) + + +# Hash map functions +def do_hash_map(ml): + return types._hash_mapl(ml.values) + +def hash_map_Q(args): + return wrap_tf(types._hash_map_Q(args[0])) + +def assoc(args): + src_hm, key_vals = args[0], args.rest() + new_dct = src_hm.dct.copy() + for i in range(0,len(key_vals),2): + k = key_vals[i] + if not isinstance(k, MalStr): + throw_str("assoc called with non-string/non-keyword key") + new_dct[k.value] = key_vals[i+1] + return MalHashMap(new_dct) + +def dissoc(args): + src_hm, keys = args[0], args.rest() + new_dct = src_hm.dct.copy() + for k in keys.values: + if not isinstance(k, MalStr): + throw_str("dissoc called with non-string/non-keyword key") + if k.value in new_dct: + del new_dct[k.value] + return MalHashMap(new_dct) + +def get(args): + obj, key = args[0], args[1] + if obj is nil: + return nil + elif isinstance(obj, MalHashMap): + if not isinstance(key, MalStr): + throw_str("get called on hash-map with non-string/non-keyword key") + if obj and key.value in obj.dct: + return obj.dct[key.value] + else: + return nil + elif isinstance(obj, MalList): + if not isinstance(key, MalInt): + throw_str("get called on list/vector with non-string/non-keyword key") + return obj.values[key.value] + else: + throw_str("get called on invalid type") + +def contains_Q(args): + hm, key = args[0], args[1] + if not isinstance(key, MalStr): + throw_str("contains? called on hash-map with non-string/non-keyword key") + return wrap_tf(key.value in hm.dct) + +def keys(args): + hm = args[0] + keys = [] + for k in hm.dct.keys(): keys.append(MalStr(k)) + return MalList(keys) + +def vals(args): + hm = args[0] + return MalList(hm.dct.values()) + + +# Sequence functions +def do_list(ml): + return ml + +def list_Q(args): + return wrap_tf(types._list_Q(args[0])) + +def do_vector(ml): + return MalVector(ml.values) + +def vector_Q(args): + return wrap_tf(types._vector_Q(args[0])) + +def empty_Q(args): + seq = args[0] + if isinstance(seq, MalList): + return wrap_tf(len(seq) == 0) + elif seq is nil: + return true + else: + throw_str("empty? called on non-sequence") + +def count(args): + seq = args[0] + if isinstance(seq, MalList): + return MalInt(len(seq)) + elif seq is nil: + return MalInt(0) + else: + throw_str("count called on non-sequence") + +def sequential_Q(args): + return wrap_tf(types._sequential_Q(args[0])) + +def vec(args): + seq = args[0] + if isinstance(seq, MalList): + return MalVector(seq.values) + else: + throw_str("vec called on non-sequence") + +def cons(args): + x, seq = args[0], args[1] + if not isinstance(seq, MalList): + throw_str("cons called with non-list/non-vector") + return MalList([x] + seq.values) + +def concat(args): + new_lst = [] + for l in args.values: + if not isinstance(l, MalList): + throw_str("concat called with non-list/non-vector") + new_lst = new_lst + l.values + return MalList(new_lst) + +def nth(args): + lst, idx = args[0], args[1] + if not isinstance(lst, MalList): + throw_str("nth called with non-list/non-vector") + if not isinstance(idx, MalInt): + throw_str("nth called with non-int index") + if idx.value < len(lst): return lst[idx.value] + else: throw_str("nth: index out of range") + +def first(args): + a0 = args[0] + if a0 is nil: + return nil + elif not isinstance(a0, MalList): + throw_str("first called with non-list/non-vector") + if len(a0) == 0: return nil + else: return a0[0] + +def rest(args): + a0 = args[0] + if a0 is nil: + return MalList([]) + elif not isinstance(a0, MalList): + throw_str("rest called with non-list/non-vector") + if len(a0) == 0: return MalList([]) + else: return a0.rest() + +def apply(args): + f, fargs = args[0], args.rest() + last_arg = fargs.values[-1] + if not isinstance(last_arg, MalList): + throw_str("map called with non-list") + all_args = fargs.values[0:-1] + last_arg.values + return f.apply(MalList(all_args)) + +def mapf(args): + f, lst = args[0], args[1] + if not isinstance(lst, MalList): + throw_str("map called with non-list") + res = [] + for a in lst.values: + res.append(f.apply(MalList([a]))) + return MalList(res) + +# retains metadata +def conj(args): + lst, args = args[0], args.rest() + new_lst = None + if types._list_Q(lst): + vals = args.values[:] + vals.reverse() + new_lst = MalList(vals + lst.values) + elif types._vector_Q(lst): + new_lst = MalVector(lst.values + list(args.values)) + else: + throw_str("conj on non-list/non-vector") + new_lst.meta = lst.meta + return new_lst + +def seq(args): + a0 = args[0] + if isinstance(a0, MalVector): + if len(a0) == 0: return nil + return MalList(a0.values) + elif isinstance(a0, MalList): + if len(a0) == 0: return nil + return a0 + elif types._string_Q(a0): + assert isinstance(a0, MalStr) + if len(a0) == 0: return nil + return MalList([MalStr(unicode(c)) for c in a0.value]) + elif a0 is nil: + return nil + else: + throw_str("seq: called on non-sequence") + +# Metadata functions +def with_meta(args): + obj, meta = args[0], args[1] + if isinstance(obj, MalMeta): + new_obj = types._clone(obj) + new_obj.meta = meta + return new_obj + else: + throw_str("with-meta not supported on type") + +def meta(args): + obj = args[0] + if isinstance(obj, MalMeta): + return obj.meta + else: + throw_str("meta not supported on type") + + +# Atoms functions +def do_atom(args): + return MalAtom(args[0]) +def atom_Q(args): + return wrap_tf(types._atom_Q(args[0])) +def deref(args): + atm = args[0] + if not isinstance(atm, MalAtom): + throw_str("deref called on non-atom") + return atm.value +def reset_BANG(args): + atm, val = args[0], args[1] + if not isinstance(atm, MalAtom): + throw_str("reset! called on non-atom") + atm.value = val + return atm.value +def swap_BANG(args): + atm, f, fargs = args[0], args[1], args.slice(2) + if not isinstance(atm, MalAtom): + throw_str("swap! called on non-atom") + if not isinstance(f, MalFunc): + throw_str("swap! called with non-function") + all_args = [atm.value] + fargs.values + atm.value = f.apply(MalList(all_args)) + return atm.value + + +ns = { + '=': do_equal, + 'throw': throw, + 'nil?': nil_Q, + 'true?': true_Q, + 'false?': false_Q, + 'string?': string_Q, + 'symbol': symbol, + 'symbol?': symbol_Q, + 'keyword': keyword, + 'keyword?': keyword_Q, + 'number?': number_Q, + 'fn?': function_Q, + 'macro?': macro_Q, + + 'pr-str': pr_str, + 'str': do_str, + 'prn': prn, + 'println': println, + 'readline': do_readline, + 'read-string': read_str, + 'slurp': slurp, + '<': lt, + '<=': lte, + '>': gt, + '>=': gte, + '+': plus, + '-': minus, + '*': multiply, + '/': divide, + 'time-ms': time_ms, + + 'list': do_list, + 'list?': list_Q, + 'vector': do_vector, + 'vector?': vector_Q, + 'hash-map': do_hash_map, + 'map?': hash_map_Q, + 'assoc': assoc, + 'dissoc': dissoc, + 'get': get, + 'contains?': contains_Q, + 'keys': keys, + 'vals': vals, + + 'sequential?': sequential_Q, + 'vec': vec, + 'cons': cons, + 'concat': concat, + 'nth': nth, + 'first': first, + 'rest': rest, + 'empty?': empty_Q, + 'count': count, + 'apply': apply, + 'map': mapf, + + 'conj': conj, + 'seq': seq, + + 'with-meta': with_meta, + 'meta': meta, + 'atom': do_atom, + 'atom?': atom_Q, + 'deref': deref, + 'reset!': reset_BANG, + 'swap!': swap_BANG + } + diff --git a/impls/rpython/env.py b/impls/rpython/env.py new file mode 100644 index 0000000000..2e5c2ba2fb --- /dev/null +++ b/impls/rpython/env.py @@ -0,0 +1,37 @@ +from mal_types import MalType, MalSym, MalList, throw_str + +# Environment +class Env(): + def __init__(self, outer=None, binds=None, exprs=None): + self.data = {} + self.outer = outer or None + + if binds: + assert isinstance(binds, MalList) and isinstance(exprs, MalList) + for i in range(len(binds)): + bind = binds[i] + if not isinstance(bind, MalSym): + throw_str("env bind value is not a symbol") + if bind.value == u"&": + bind = binds[i+1] + if not isinstance(bind, MalSym): + throw_str("env bind value is not a symbol") + self.data[bind.value] = exprs.slice(i) + break + else: + self.data[bind.value] = exprs[i] + + def set(self, key, value): + assert isinstance(key, MalSym) + assert isinstance(value, MalType) + self.data[key.value] = value + return value + + def get(self, key): + assert isinstance(key, unicode) + env = self + while True: + value = env.data.get(key, None) + if value is not None: return value + env = env.outer + if env is None: return None diff --git a/impls/rpython/mal_readline.py b/impls/rpython/mal_readline.py new file mode 100644 index 0000000000..1502fce367 --- /dev/null +++ b/impls/rpython/mal_readline.py @@ -0,0 +1,36 @@ +#import os, readline as pyreadline +# +#histfile = os.path.expanduser("~/.mal-history") +# +#def init(): +# try: +# with open(histfile, "r") as hf: +# for line in hf.readlines(): +# pyreadline.add_history(line.rstrip("\r\n")) +# pass +# except IOError: +# #print("Could not open %s" % histfile) +# pass +# +#def readline(prompt="user> "): +# try: +# line = raw_input(prompt) +# pyreadline.add_history(line) +# with open(histfile, "a") as hf: +# hf.write(line + "\n") +# except IOError: +# pass +# except EOFError: +# return None +# return line + +import os +def readline(prompt): + res = '' + os.write(1, prompt) + while True: + buf = os.read(0, 255) + if not buf: raise EOFError() + res += buf + if res[-1] == '\n': return res[:-1] + diff --git a/impls/rpython/mal_types.py b/impls/rpython/mal_types.py new file mode 100644 index 0000000000..20d626d751 --- /dev/null +++ b/impls/rpython/mal_types.py @@ -0,0 +1,273 @@ +import sys, copy, types as pytypes +IS_RPYTHON = sys.argv[0].endswith('rpython') + +if IS_RPYTHON: + from rpython.rlib.listsort import TimSort +else: + import re + +# General functions + +class StringSort(TimSort): + def lt(self, a, b): + assert isinstance(a, unicode) + assert isinstance(b, unicode) + return a < b + +def _equal_Q(a, b): + assert isinstance(a, MalType) and isinstance(b, MalType) + ota, otb = a.__class__, b.__class__ + if not (ota is otb or (_sequential_Q(a) and _sequential_Q(b))): + return False + if isinstance(a, MalSym) and isinstance(b, MalSym): + return a.value == b.value + elif isinstance(a, MalStr) and isinstance(b, MalStr): + return a.value == b.value + elif isinstance(a, MalInt) and isinstance(b, MalInt): + return a.value == b.value + elif _list_Q(a) or _vector_Q(a): + if len(a) != len(b): return False + for i in range(len(a)): + if not _equal_Q(a[i], b[i]): return False + return True + elif _hash_map_Q(a): + assert isinstance(a, MalHashMap) + assert isinstance(b, MalHashMap) + akeys = a.dct.keys() + bkeys = b.dct.keys() + if len(akeys) != len(bkeys): return False + + StringSort(akeys).sort() + StringSort(bkeys).sort() + for i in range(len(akeys)): + ak, bk = akeys[i], bkeys[i] + assert isinstance(ak, unicode) + assert isinstance(bk, unicode) + if ak != bk: return False + av, bv = a.dct[ak], b.dct[bk] + if not _equal_Q(av, bv): return False + return True + elif a is b: + return True + else: + throw_str("no = op defined for %s" % a.__class__.__name__) + +def _sequential_Q(seq): return _list_Q(seq) or _vector_Q(seq) + +def _clone(obj): + if isinstance(obj, MalFunc): + return MalFunc(obj.fn, obj.ast, obj.env, obj.params, + obj.EvalFunc, obj.ismacro) + elif isinstance(obj, MalList): + return obj.__class__(obj.values) + elif isinstance(obj, MalHashMap): + return MalHashMap(obj.dct) + elif isinstance(obj, MalAtom): + return MalAtom(obj.value) + else: + raise Exception("_clone on invalid type") + +def _replace(match, sub, old_str): + new_str = u"" + idx = 0 + while idx < len(old_str): + midx = old_str.find(match, idx) + if midx < 0: break + assert midx >= 0 and midx < len(old_str) + new_str = new_str + old_str[idx:midx] + new_str = new_str + sub + idx = midx + len(match) + new_str = new_str + old_str[idx:] + return new_str + +# +# Mal Types +# + +class MalException(Exception): + def __init__(self, object): + self.object = object + +def throw_str(s): + raise MalException(MalStr(unicode(s))) + + +### Parent types +class MalType(): pass +class MalMeta(MalType): pass + +### Scalars +class MalNil(MalType): pass +nil = MalNil() +def _nil_Q(exp): + assert isinstance(exp, MalType) + return exp is nil + +class MalTrue(MalType): pass +true = MalTrue() +def _true_Q(exp): + assert isinstance(exp, MalType) + return exp is true + +class MalFalse(MalType): pass +false = MalFalse() +def _false_Q(exp): + assert isinstance(exp, MalType) + return exp is false + +# Numbers +class MalInt(MalType): + def __init__(self, value): + assert isinstance(value, int) + self.value = value +def _int_Q(exp): + assert isinstance(exp, MalType) + return exp.__class__ is MalInt + +# String +class MalStr(MalType): + def __init__(self, value): + assert isinstance(value, unicode) + self.value = value + def __len__(self): + return len(self.value) +def _string_Q(exp): + assert isinstance(exp, MalType) + return exp.__class__ is MalStr and not _keyword_Q(exp) + +# Keywords +# A specially prefixed string +def _keyword(mstr): + assert isinstance(mstr, MalType) + if isinstance(mstr, MalStr): + val = mstr.value + if val[0] == u"\u029e": return mstr + else: return MalStr(u"\u029e" + val) + else: + throw_str("_keyword called on non-string") +# Create keyword from unicode string +def _keywordu(strn): + assert isinstance(strn, unicode) + return MalStr(u"\u029e" + strn) +def _keyword_Q(exp): + if isinstance(exp, MalStr) and len(exp.value) > 0: + return exp.value[0] == u"\u029e" + else: + return False + +# Symbols +class MalSym(MalMeta): + def __init__(self, value): + assert isinstance(value, unicode) + self.value = value + self.meta = nil +def _symbol(strn): + assert isinstance(strn, unicode) + return MalSym(strn) +def _symbol_Q(exp): + assert isinstance(exp, MalType) + return exp.__class__ is MalSym + +# lists +class MalList(MalMeta): + def __init__(self, vals): + assert isinstance(vals, list) + self.values = vals + self.meta = nil + def append(self, val): + self.values.append(val) + def rest(self): + return MalList(self.values[1:]) + def __len__(self): + return len(self.values) + def __getitem__(self, i): + assert isinstance(i, int) + return self.values[i] + def slice(self, start): + return MalList(self.values[start:len(self.values)]) + def slice2(self, start, end): + assert end >= 0 + return MalList(self.values[start:end]) +def _list(*vals): return MalList(list(vals)) +def _listl(lst): return MalList(lst) +def _list_Q(exp): + assert isinstance(exp, MalType) + return exp.__class__ is MalList + +### vectors +class MalVector(MalList): + pass +def _vector(*vals): return MalVector(list(vals)) +def _vectorl(lst): return MalVector(lst) +def _vector_Q(exp): + assert isinstance(exp, MalType) + return exp.__class__ is MalVector + +### hash maps +class MalHashMap(MalMeta): + def __init__(self, dct): + self.dct = dct + self.meta = nil + def append(self, val): + self.dct.append(val) + def __getitem__(self, k): + assert isinstance(k, unicode) + if not isinstance(k, unicode): + throw_str("hash-map lookup by non-string/non-keyword") + return self.dct[k] + def __setitem__(self, k, v): + if not isinstance(k, unicode): + throw_str("hash-map key must be string or keyword") + assert isinstance(v, MalType) + self.dct[k] = v + return v +def _hash_mapl(kvs): + dct = {} + for i in range(0, len(kvs), 2): + k = kvs[i] + if not isinstance(k, MalStr): + throw_str("hash-map key must be string or keyword") + v = kvs[i+1] + dct[k.value] = v + return MalHashMap(dct) +def _hash_map_Q(exp): + assert isinstance(exp, MalType) + return exp.__class__ is MalHashMap + +# Functions +# env import must happen after MalSym and MalList definitions to allow +# circular dependency +from env import Env +class MalFunc(MalMeta): + def __init__(self, fn, ast=None, env=None, params=None, + EvalFunc=None, ismacro=False): + if fn is None and EvalFunc is None: + throw_str("MalFunc requires either fn or EvalFunc") + self.fn = fn + self.ast = ast + self.env = env + self.params = params + self.EvalFunc = EvalFunc + self.ismacro = ismacro + self.meta = nil + def apply(self, args): + if self.EvalFunc: + return self.EvalFunc(self.ast, self.gen_env(args)) + else: + return self.fn(args) + def gen_env(self, args): + return Env(self.env, self.params, args) +def _function_Q(exp): + assert isinstance(exp, MalType) + return exp.__class__ is MalFunc + + +# atoms +class MalAtom(MalMeta): + def __init__(self, value): + self.value = value + self.meta = nil + def get_value(self): + return self.value +def _atom(val): return MalAtom(val) +def _atom_Q(exp): return exp.__class__ is MalAtom diff --git a/impls/rpython/printer.py b/impls/rpython/printer.py new file mode 100644 index 0000000000..67b607b9da --- /dev/null +++ b/impls/rpython/printer.py @@ -0,0 +1,60 @@ +import sys +IS_RPYTHON = sys.argv[0].endswith('rpython') + +if IS_RPYTHON: + from rpython.rlib.rsre import rsre_re as re +else: + import re + +import mal_types as types +from mal_types import (MalType, MalStr, MalSym, MalInt, + nil, true, false, MalAtom, MalFunc) + +def _pr_a_str(s, print_readably=True): + if len(s) > 0 and s[0] == u'\u029e': + return u':' + s[1:] + elif print_readably: + return u'"' + types._replace(u'\n', u'\\n', + types._replace(u'\"', u'\\"', + types._replace(u'\\', u'\\\\', s))) + u'"' + else: + return s + +def _pr_str(obj, print_readably=True): + assert isinstance(obj, MalType) + _r = print_readably + if types._list_Q(obj): + res = [] + for e in obj.values: + res.append(_pr_str(e,_r)) + return u"(" + u" ".join(res) + u")" + elif types._vector_Q(obj): + res = [] + for e in obj.values: + res.append(_pr_str(e,_r)) + return u"[" + u" ".join(res) + u"]" + elif types._hash_map_Q(obj): + ret = [] + for k in obj.dct.keys(): + ret.append(_pr_a_str(k,_r)) + ret.append(_pr_str(obj.dct[k],_r)) + return u"{" + u" ".join(ret) + u"}" + elif isinstance(obj, MalStr): + return _pr_a_str(obj.value,_r) + elif obj is nil: + return u"nil" + elif obj is true: + return u"true" + elif obj is false: + return u"false" + elif types._atom_Q(obj): + return u"(atom " + _pr_str(obj.get_value(),_r) + u")" + elif isinstance(obj, MalSym): + return obj.value + elif isinstance(obj, MalInt): + return unicode(str(obj.value)) + elif isinstance(obj, MalFunc): + return u"#" + else: + return u"unknown" + diff --git a/impls/rpython/reader.py b/impls/rpython/reader.py new file mode 100644 index 0000000000..6fd81c595e --- /dev/null +++ b/impls/rpython/reader.py @@ -0,0 +1,138 @@ +import sys +IS_RPYTHON = sys.argv[0].endswith('rpython') + +if IS_RPYTHON: + from rpython.rlib.rsre import rsre_re as re +else: + import re + +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, _keywordu, + _list, _listl, _vectorl, _hash_mapl) + +class Blank(Exception): pass + +class Reader(): + def __init__(self, tokens, position=0): + self.tokens = tokens + self.position = position + + def next(self): + self.position += 1 + return self.tokens[self.position-1] + + def peek(self): + if len(self.tokens) > self.position: + return self.tokens[self.position] + else: + return None + +def tokenize(str): + re_str = "[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\s\[\]{}()'\"`@,;]+)" + if IS_RPYTHON: + tok_re = re_str + else: + tok_re = re.compile(re_str) + return [t for t in re.findall(tok_re, str) if t[0] != ';'] + +def read_atom(reader): + if IS_RPYTHON: + int_re = '-?[0-9]+$' + float_re = '-?[0-9][0-9.]*$' + str_re = '"(?:[\\\\].|[^\\\\"])*"' + else: + int_re = re.compile('-?[0-9]+$') + float_re = re.compile('-?[0-9][0-9.]*$') + str_re = re.compile('"(?:[\\\\].|[^\\\\"])*"') + token = reader.next() + if re.match(int_re, token): return MalInt(int(token)) +## elif re.match(float_re, token): return int(token) + elif re.match(str_re, token): + end = len(token)-1 + if end <= 1: + return MalStr(u"") + else: + s = unicode(token[1:end]) + s = types._replace(u'\\\\', u"\u029e", s) + s = types._replace(u'\\"', u'"', s) + s = types._replace(u'\\n', u"\n", s) + s = types._replace(u"\u029e", u"\\", s) + return MalStr(s) + elif token[0] == '"': + types.throw_str("expected '\"', got EOF") + elif token[0] == ':': return _keywordu(unicode(token[1:])) + elif token == "nil": return types.nil + elif token == "true": return types.true + elif token == "false": return types.false + else: return MalSym(unicode(token)) + +def read_sequence(reader, start='(', end=')'): + ast = [] + token = reader.next() + if token != start: types.throw_str("expected '" + start + "'") + + token = reader.peek() + while token != end: + if not token: types.throw_str("expected '" + end + "', got EOF") + ast.append(read_form(reader)) + token = reader.peek() + reader.next() + return ast + +def read_list(reader): + lst = read_sequence(reader, '(', ')') + return _listl(lst) + +def read_vector(reader): + lst = read_sequence(reader, '[', ']') + return _vectorl(lst) + +def read_hash_map(reader): + lst = read_sequence(reader, '{', '}') + return _hash_mapl(lst) + +def read_form(reader): + token = reader.peek() + # reader macros/transforms + if token[0] == ';': + reader.next() + return None + elif token == '\'': + reader.next() + return _list(MalSym(u'quote'), read_form(reader)) + elif token == '`': + reader.next() + return _list(MalSym(u'quasiquote'), read_form(reader)) + elif token == '~': + reader.next() + return _list(MalSym(u'unquote'), read_form(reader)) + elif token == '~@': + reader.next() + return _list(MalSym(u'splice-unquote'), read_form(reader)) + elif token == '^': + reader.next() + meta = read_form(reader) + return _list(MalSym(u'with-meta'), read_form(reader), meta) + elif token == '@': + reader.next() + return _list(MalSym(u'deref'), read_form(reader)) + + # list + elif token == ')': types.throw_str("unexpected ')'") + elif token == '(': return read_list(reader) + + # vector + elif token == ']': types.throw_str("unexpected ']'"); + elif token == '[': return read_vector(reader); + + # hash-map + elif token == '}': types.throw_str("unexpected '}'"); + elif token == '{': return read_hash_map(reader); + + # atom + else: return read_atom(reader); + +def read_str(str): + tokens = tokenize(str) + if len(tokens) == 0: raise Blank("Blank Line") + return read_form(Reader(tokens)) diff --git a/impls/rpython/run b/impls/rpython/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/rpython/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/rpython/step0_repl.py b/impls/rpython/step0_repl.py new file mode 100644 index 0000000000..1a6ef4be9e --- /dev/null +++ b/impls/rpython/step0_repl.py @@ -0,0 +1,42 @@ +#import sys, traceback +import mal_readline + +# read +def READ(str): + return str + +# eval +def EVAL(ast, env): + #print("EVAL %s" % printer._pr_str(ast)) + return ast + +# print +def PRINT(exp): + return exp + +# repl +def REP(str): + return PRINT(EVAL(READ(str), {})) + +def entry_point(argv): + #mal_readline.init() + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line)) + except EOFError as e: + break + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step1_read_print.py b/impls/rpython/step1_read_print.py new file mode 100644 index 0000000000..fe39fd07fc --- /dev/null +++ b/impls/rpython/step1_read_print.py @@ -0,0 +1,48 @@ +#import sys, traceback +import mal_readline +import mal_types as types +import reader, printer + +# read +def READ(str): + return reader.read_str(str) + +# eval +def EVAL(ast, env): + #print("EVAL %s" % printer._pr_str(ast)) + return ast + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +def REP(str): + return PRINT(EVAL(READ(str), {})) + +def entry_point(argv): + #mal_readline.init() + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step2_eval.py b/impls/rpython/step2_eval.py new file mode 100644 index 0000000000..63841b9dfd --- /dev/null +++ b/impls/rpython/step2_eval.py @@ -0,0 +1,105 @@ +#import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + _keywordu, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer + +# read +def READ(str): + return reader.read_str(str) + +# eval +def EVAL(ast, env): + # print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + if ast.value in env: + return env[ast.value] + else: + raise Exception(u"'" + ast.value + u"' not found") + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + f = EVAL(ast[0], env) + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +repl_env = {} +def REP(str, env): + return PRINT(EVAL(READ(str), env)) + +def plus(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(a.value+b.value) +def minus(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(a.value-b.value) +def multiply(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(a.value*b.value) +def divide(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(int(a.value/b.value)) +repl_env[u'+'] = MalFunc(plus) +repl_env[u'-'] = MalFunc(minus) +repl_env[u'*'] = MalFunc(multiply) +repl_env[u'/'] = MalFunc(divide) + +def entry_point(argv): + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step3_env.py b/impls/rpython/step3_env.py new file mode 100644 index 0000000000..514b66ea68 --- /dev/null +++ b/impls/rpython/step3_env.py @@ -0,0 +1,123 @@ +#import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + _symbol, _keywordu, + nil, false, throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env + +# read +def READ(str): + return reader.read_str(str) + +# eval +def EVAL(ast, env): + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if not isinstance(a0, MalSym): + raise Exception("attempt to apply on non-symbol") + + if u"def!" == a0.value: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0.value: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + return EVAL(a2, let_env) + else: + f = EVAL(a0, env) + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +repl_env = Env() +def REP(str, env): + return PRINT(EVAL(READ(str), env)) + +def plus(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(a.value+b.value) +def minus(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(a.value-b.value) +def multiply(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(a.value*b.value) +def divide(args): + a, b = args[0], args[1] + assert isinstance(a, MalInt) + assert isinstance(b, MalInt) + return MalInt(int(a.value/b.value)) +repl_env.set(_symbol(u'+'), MalFunc(plus)) +repl_env.set(_symbol(u'-'), MalFunc(minus)) +repl_env.set(_symbol(u'*'), MalFunc(multiply)) +repl_env.set(_symbol(u'/'), MalFunc(divide)) + +def entry_point(argv): + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step4_if_fn_do.py b/impls/rpython/step4_if_fn_do.py new file mode 100644 index 0000000000..cc4fd7632f --- /dev/null +++ b/impls/rpython/step4_if_fn_do.py @@ -0,0 +1,125 @@ +import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + nil, true, false, _symbol, _keywordu, + throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def EVAL(ast, env): + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if isinstance(a0, MalSym): + a0sym = a0.value + else: + a0sym = u"__<*fn*>__" + + if u"def!" == a0sym: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0sym: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + return EVAL(a2, let_env) + elif u"do" == a0sym: + if len(ast) == 0: + return nil + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) + return EVAL(ast[-1], env) + elif u"if" == a0sym: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is nil or cond is false: + if len(ast) > 3: return EVAL(ast[3], env) + else: return nil + else: + return EVAL(a2, env) + elif u"fn*" == a0sym: + a1, a2 = ast[1], ast[2] + return MalFunc(None, a2, env, a1, EVAL) + else: + f = EVAL(a0, env) + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +def entry_point(argv): + repl_env = Env() + def REP(str, env): + return PRINT(EVAL(READ(str), env)) + + # core.py: defined using python + for k, v in core.ns.items(): + repl_env.set(_symbol(unicode(k)), MalFunc(v)) + + # core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step5_tco.py b/impls/rpython/step5_tco.py new file mode 100644 index 0000000000..8b118a976c --- /dev/null +++ b/impls/rpython/step5_tco.py @@ -0,0 +1,131 @@ +import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + nil, true, false, _symbol, _keywordu, + throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def EVAL(ast, env): + while True: + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if isinstance(a0, MalSym): + a0sym = a0.value + else: + a0sym = u"__<*fn*>__" + + if u"def!" == a0sym: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0sym: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env # Continue loop (TCO) + elif u"do" == a0sym: + if len(ast) == 0: + return nil + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) + ast = ast[-1] # Continue loop (TCO) + elif u"if" == a0sym: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is nil or cond is false: + if len(ast) > 3: ast = ast[3] # Continue loop (TCO) + else: return nil + else: + ast = a2 # Continue loop (TCO) + elif u"fn*" == a0sym: + a1, a2 = ast[1], ast[2] + return MalFunc(None, a2, env, a1, EVAL) + else: + f = EVAL(a0, env) + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + if f.ast: + ast = f.ast + env = f.gen_env(args) # Continue loop (TCO) + else: + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +def entry_point(argv): + repl_env = Env() + def REP(str, env): + return PRINT(EVAL(READ(str), env)) + + # core.py: defined using python + for k, v in core.ns.items(): + repl_env.set(_symbol(unicode(k)), MalFunc(v)) + + # core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step6_file.py b/impls/rpython/step6_file.py new file mode 100644 index 0000000000..93e25e3387 --- /dev/null +++ b/impls/rpython/step6_file.py @@ -0,0 +1,146 @@ +import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + nil, true, false, _symbol, _keywordu, + throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def EVAL(ast, env): + while True: + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if isinstance(a0, MalSym): + a0sym = a0.value + else: + a0sym = u"__<*fn*>__" + + if u"def!" == a0sym: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0sym: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env # Continue loop (TCO) + elif u"do" == a0sym: + if len(ast) == 0: + return nil + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) + ast = ast[-1] # Continue loop (TCO) + elif u"if" == a0sym: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is nil or cond is false: + if len(ast) > 3: ast = ast[3] # Continue loop (TCO) + else: return nil + else: + ast = a2 # Continue loop (TCO) + elif u"fn*" == a0sym: + a1, a2 = ast[1], ast[2] + return MalFunc(None, a2, env, a1, EVAL) + else: + f = EVAL(a0, env) + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + if f.ast: + ast = f.ast + env = f.gen_env(args) # Continue loop (TCO) + else: + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +class MalEval(MalFunc): + def apply(self, args): + return self.EvalFunc(args[0], self.env) + +def entry_point(argv): + repl_env = Env() + def REP(str, env): + return PRINT(EVAL(READ(str), env)) + + # core.py: defined using python + for k, v in core.ns.items(): + repl_env.set(_symbol(unicode(k)), MalFunc(v)) + repl_env.set(types._symbol(u'eval'), + MalEval(None, env=repl_env, EvalFunc=EVAL)) + mal_args = [] + if len(argv) >= 3: + for a in argv[2:]: mal_args.append(MalStr(unicode(a))) + repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) + + # core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + + if len(argv) >= 2: + REP('(load-file "' + argv[1] + '")', repl_env) + return 0 + + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step7_quote.py b/impls/rpython/step7_quote.py new file mode 100644 index 0000000000..dddb269961 --- /dev/null +++ b/impls/rpython/step7_quote.py @@ -0,0 +1,177 @@ +import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + nil, true, false, _symbol, _keywordu, + throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): + return _list(_symbol(u"quote"), ast) + else: + return ast + +def EVAL(ast, env): + while True: + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if isinstance(a0, MalSym): + a0sym = a0.value + else: + a0sym = u"__<*fn*>__" + + if u"def!" == a0sym: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0sym: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env # Continue loop (TCO) + elif u"quote" == a0sym: + return ast[1] + elif u"quasiquote" == a0sym: + ast = quasiquote(ast[1]) # Continue loop (TCO) + elif u"do" == a0sym: + if len(ast) == 0: + return nil + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) + ast = ast[-1] # Continue loop (TCO) + elif u"if" == a0sym: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is nil or cond is false: + if len(ast) > 3: ast = ast[3] # Continue loop (TCO) + else: return nil + else: + ast = a2 # Continue loop (TCO) + elif u"fn*" == a0sym: + a1, a2 = ast[1], ast[2] + return MalFunc(None, a2, env, a1, EVAL) + else: + f = EVAL(a0, env) + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + if f.ast: + ast = f.ast + env = f.gen_env(args) # Continue loop (TCO) + else: + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +class MalEval(MalFunc): + def apply(self, args): + return self.EvalFunc(args[0], self.env) + +def entry_point(argv): + repl_env = Env() + def REP(str, env): + return PRINT(EVAL(READ(str), env)) + + # core.py: defined using python + for k, v in core.ns.items(): + repl_env.set(_symbol(unicode(k)), MalFunc(v)) + repl_env.set(types._symbol(u'eval'), + MalEval(None, env=repl_env, EvalFunc=EVAL)) + mal_args = [] + if len(argv) >= 3: + for a in argv[2:]: mal_args.append(MalStr(unicode(a))) + repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) + + # core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + + if len(argv) >= 2: + REP('(load-file "' + argv[1] + '")', repl_env) + return 0 + + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step8_macros.py b/impls/rpython/step8_macros.py new file mode 100644 index 0000000000..df560958ec --- /dev/null +++ b/impls/rpython/step8_macros.py @@ -0,0 +1,187 @@ +import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + nil, true, false, _symbol, _keywordu, + throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): + return _list(_symbol(u"quote"), ast) + else: + return ast + +def EVAL(ast, env): + while True: + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if isinstance(a0, MalSym): + a0sym = a0.value + else: + a0sym = u"__<*fn*>__" + + if u"def!" == a0sym: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0sym: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env # Continue loop (TCO) + elif u"quote" == a0sym: + return ast[1] + elif u"quasiquote" == a0sym: + ast = quasiquote(ast[1]) # Continue loop (TCO) + elif u"defmacro!" == a0sym: + func = EVAL(ast[2], env) + return env.set(ast[1], + MalFunc(func.fn, ast=func.ast, env=func.env, + params=func.params, EvalFunc=func.EvalFunc, + ismacro=True)) + elif u"do" == a0sym: + if len(ast) == 0: + return nil + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) + ast = ast[-1] # Continue loop (TCO) + elif u"if" == a0sym: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is nil or cond is false: + if len(ast) > 3: ast = ast[3] # Continue loop (TCO) + else: return nil + else: + ast = a2 # Continue loop (TCO) + elif u"fn*" == a0sym: + a1, a2 = ast[1], ast[2] + return MalFunc(None, a2, env, a1, EVAL) + else: + f = EVAL(a0, env) + if f.ismacro: + ast = f.apply(ast.rest()) # Continue loop (TCO) + continue + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + if f.ast: + ast = f.ast + env = f.gen_env(args) # Continue loop (TCO) + else: + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +class MalEval(MalFunc): + def apply(self, args): + return self.EvalFunc(args[0], self.env) + +def entry_point(argv): + repl_env = Env() + def REP(str, env): + return PRINT(EVAL(READ(str), env)) + + # core.py: defined using python + for k, v in core.ns.items(): + repl_env.set(_symbol(unicode(k)), MalFunc(v)) + repl_env.set(types._symbol(u'eval'), + MalEval(None, env=repl_env, EvalFunc=EVAL)) + mal_args = [] + if len(argv) >= 3: + for a in argv[2:]: mal_args.append(MalStr(unicode(a))) + repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) + + # core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if len(argv) >= 2: + REP('(load-file "' + argv[1] + '")', repl_env) + return 0 + + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/step9_try.py b/impls/rpython/step9_try.py new file mode 100644 index 0000000000..dfc62d1d90 --- /dev/null +++ b/impls/rpython/step9_try.py @@ -0,0 +1,205 @@ +import sys, traceback +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + nil, true, false, _symbol, _keywordu, + throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): + return _list(_symbol(u"quote"), ast) + else: + return ast + +def EVAL(ast, env): + while True: + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if isinstance(a0, MalSym): + a0sym = a0.value + else: + a0sym = u"__<*fn*>__" + + if u"def!" == a0sym: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0sym: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env # Continue loop (TCO) + elif u"quote" == a0sym: + return ast[1] + elif u"quasiquote" == a0sym: + ast = quasiquote(ast[1]) # Continue loop (TCO) + elif u"defmacro!" == a0sym: + func = EVAL(ast[2], env) + return env.set(ast[1], + MalFunc(func.fn, ast=func.ast, env=func.env, + params=func.params, EvalFunc=func.EvalFunc, + ismacro=True)) + elif u"try*" == a0sym: + if len(ast) < 3: + return EVAL(ast[1], env); + a1, a2 = ast[1], ast[2] + a20 = a2[0] + if isinstance(a20, MalSym): + if a20.value == u"catch*": + try: + return EVAL(a1, env); + except types.MalException as exc: + exc = exc.object + catch_env = Env(env, _list(a2[1]), _list(exc)) + return EVAL(a2[2], catch_env) + except Exception as exc: + exc = MalStr(unicode("%s" % exc)) + catch_env = Env(env, _list(a2[1]), _list(exc)) + return EVAL(a2[2], catch_env) + return EVAL(a1, env); + elif u"do" == a0sym: + if len(ast) == 0: + return nil + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) + ast = ast[-1] # Continue loop (TCO) + elif u"if" == a0sym: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is nil or cond is false: + if len(ast) > 3: ast = ast[3] # Continue loop (TCO) + else: return nil + else: + ast = a2 # Continue loop (TCO) + elif u"fn*" == a0sym: + a1, a2 = ast[1], ast[2] + return MalFunc(None, a2, env, a1, EVAL) + else: + f = EVAL(a0, env) + if f.ismacro: + ast = f.apply(ast.rest()) # Continue loop (TCO) + continue + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + if f.ast: + ast = f.ast + env = f.gen_env(args) # Continue loop (TCO) + else: + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +class MalEval(MalFunc): + def apply(self, args): + return self.EvalFunc(args[0], self.env) + +def entry_point(argv): + repl_env = Env() + def REP(str, env): + return PRINT(EVAL(READ(str), env)) + + # core.py: defined using python + for k, v in core.ns.items(): + repl_env.set(_symbol(unicode(k)), MalFunc(v)) + repl_env.set(types._symbol(u'eval'), + MalEval(None, env=repl_env, EvalFunc=EVAL)) + mal_args = [] + if len(argv) >= 3: + for a in argv[2:]: mal_args.append(MalStr(unicode(a))) + repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) + + # core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if len(argv) >= 2: + REP('(load-file "' + argv[1] + '")', repl_env) + return 0 + + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + #print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/stepA_mal.py b/impls/rpython/stepA_mal.py new file mode 100644 index 0000000000..680a98cc6a --- /dev/null +++ b/impls/rpython/stepA_mal.py @@ -0,0 +1,219 @@ +import sys +IS_RPYTHON = sys.argv[0].endswith('rpython') + +if IS_RPYTHON: + #from rpython.rlib.debug import fatalerror + from rpython.rtyper.lltypesystem import lltype + from rpython.rtyper.lltypesystem.lloperation import llop +else: + import traceback + +import mal_readline +import mal_types as types +from mal_types import (MalSym, MalInt, MalStr, + nil, true, false, _symbol, _keywordu, + throw_str, + MalList, _list, MalVector, MalHashMap, MalFunc) +import reader, printer +from env import Env +import core + +# read +def READ(str): + return reader.read_str(str) + +# eval +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc + +def quasiquote(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): + return _list(_symbol(u"quote"), ast) + else: + return ast + +def EVAL(ast, env): + while True: + if env.get(u"DEBUG-EVAL") not in (None, nil, false): + print(u"EVAL: " + printer._pr_str(ast)) + if types._symbol_Q(ast): + assert isinstance(ast, MalSym) + value = env.get(ast.value) + if value is None: + throw_str("'" + str(ast.value) + "' not found") + return value + elif types._vector_Q(ast): + res = [] + for a in ast.values: + res.append(EVAL(a, env)) + return MalVector(res) + elif types._hash_map_Q(ast): + new_dct = {} + for k in ast.dct.keys(): + new_dct[k] = EVAL(ast.dct[k], env) + return MalHashMap(new_dct) + elif not types._list_Q(ast): + return ast # primitive value, return unchanged + else: + # apply list + if len(ast) == 0: return ast + a0 = ast[0] + if isinstance(a0, MalSym): + a0sym = a0.value + else: + a0sym = u"__<*fn*>__" + + if u"def!" == a0sym: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif u"let*" == a0sym: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + ast = a2 + env = let_env # Continue loop (TCO) + elif u"quote" == a0sym: + return ast[1] + elif u"quasiquote" == a0sym: + ast = quasiquote(ast[1]) # Continue loop (TCO) + elif u"defmacro!" == a0sym: + func = EVAL(ast[2], env) + return env.set(ast[1], + MalFunc(func.fn, ast=func.ast, env=func.env, + params=func.params, EvalFunc=func.EvalFunc, + ismacro=True)) + elif u"try*" == a0sym: + if len(ast) < 3: + return EVAL(ast[1], env); + a1, a2 = ast[1], ast[2] + a20 = a2[0] + if isinstance(a20, MalSym): + if a20.value == u"catch*": + try: + return EVAL(a1, env); + except types.MalException as exc: + exc = exc.object + catch_env = Env(env, _list(a2[1]), _list(exc)) + return EVAL(a2[2], catch_env) + except Exception as exc: + exc = MalStr(unicode("%s" % exc)) + catch_env = Env(env, _list(a2[1]), _list(exc)) + return EVAL(a2[2], catch_env) + return EVAL(a1, env); + elif u"do" == a0sym: + if len(ast) == 0: + return nil + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) + ast = ast[-1] # Continue loop (TCO) + elif u"if" == a0sym: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is nil or cond is false: + if len(ast) > 3: ast = ast[3] # Continue loop (TCO) + else: return nil + else: + ast = a2 # Continue loop (TCO) + elif u"fn*" == a0sym: + a1, a2 = ast[1], ast[2] + return MalFunc(None, a2, env, a1, EVAL) + else: + f = EVAL(a0, env) + if f.ismacro: + ast = f.apply(ast.rest()) # Continue loop (TCO) + continue + args_list = [] + for i in range(1, len(ast)): + args_list.append(EVAL(ast[i], env)) + args = MalList(args_list) + if isinstance(f, MalFunc): + if f.ast: + ast = f.ast + env = f.gen_env(args) # Continue loop (TCO) + else: + return f.apply(args) + else: + raise Exception("%s is not callable" % f) + +# print +def PRINT(exp): + return printer._pr_str(exp) + +# repl +class MalEval(MalFunc): + def apply(self, args): + return self.EvalFunc(args[0], self.env) + +def entry_point(argv): + repl_env = Env() + def REP(str, env): + return PRINT(EVAL(READ(str), env)) + + # core.py: defined using python + for k, v in core.ns.items(): + repl_env.set(_symbol(unicode(k)), MalFunc(v)) + repl_env.set(types._symbol(u'eval'), + MalEval(None, env=repl_env, EvalFunc=EVAL)) + mal_args = [] + if len(argv) >= 3: + for a in argv[2:]: mal_args.append(MalStr(unicode(a))) + repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) + + # core.mal: defined using the language itself + REP("(def! *host-language* \"rpython\")", repl_env) + REP("(def! not (fn* (a) (if a false true)))", repl_env) + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + + if len(argv) >= 2: + REP('(load-file "' + argv[1] + '")', repl_env) + return 0 + + REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) + while True: + try: + line = mal_readline.readline("user> ") + if line == "": continue + print(REP(line, repl_env)) + except EOFError as e: + break + except reader.Blank: + continue + except types.MalException as e: + print(u"Error: %s" % printer._pr_str(e.object, False)) + except Exception as e: + print("Error: %s" % e) + if IS_RPYTHON: + llop.debug_print_traceback(lltype.Void) + else: + print("".join(traceback.format_exception(*sys.exc_info()))) + return 0 + +# _____ Define and setup target ___ +def target(*args): + return entry_point + +# Just run entry_point if not RPython compilation +import sys +if not sys.argv[0].endswith('rpython'): + entry_point(sys.argv) diff --git a/impls/rpython/tests/step5_tco.mal b/impls/rpython/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/rpython/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/ruby.2/Dockerfile b/impls/ruby.2/Dockerfile new file mode 100644 index 0000000000..3c2786c33d --- /dev/null +++ b/impls/ruby.2/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install ruby diff --git a/impls/ruby.2/Makefile b/impls/ruby.2/Makefile new file mode 100644 index 0000000000..9e87fdd142 --- /dev/null +++ b/impls/ruby.2/Makefile @@ -0,0 +1,19 @@ +SOURCES_BASE = errors.rb types.rb reader.rb printer.rb +SOURCES_LISP = env.rb core.rb stepA_mal.rb +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.rb mal + +mal.rb: $(SOURCES) + cat $+ | grep -v "^require_relative" > $@ + +mal: mal.rb + echo "#!/usr/bin/env ruby" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.rb mal diff --git a/impls/ruby.2/core.rb b/impls/ruby.2/core.rb new file mode 100644 index 0000000000..bbbbbc8144 --- /dev/null +++ b/impls/ruby.2/core.rb @@ -0,0 +1,538 @@ +require "readline" + +require_relative "types" + +module Mal + module Core + extend self + + def ns + { + Types::Symbol.for("+") => Types::Builtin.new("+") do |a, b| + a + b + end, + + Types::Symbol.for("-") => Types::Builtin.new("-") { |a, b| a - b }, + Types::Symbol.for("*") => Types::Builtin.new("*") { |a, b| a * b }, + Types::Symbol.for("/") => Types::Builtin.new("/") { |a, b| a / b }, + + Types::Symbol.for("list") => Types::Builtin.new("list") do |*mal| + list = Types::List.new + mal.each { |m| list << m } + list + end, + + Types::Symbol.for("list?") => Types::Builtin.new("list?") do |list = nil| + list.is_a?(Types::List) ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("vector?") => Types::Builtin.new("vector?") do |vector = nil| + vector.is_a?(Types::Vector) ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("string?") => Types::Builtin.new("string?") do |string = nil| + string.is_a?(Types::String) ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("number?") => Types::Builtin.new("number?") do |number = nil| + number.is_a?(Types::Number) ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("fn?") => Types::Builtin.new("fn?") do |fn = nil| + fn.is_a?(Types::Callable) && !fn.is_macro? ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("macro?") => Types::Builtin.new("macro?") do |macro = nil| + macro.is_a?(Types::Callable) && macro.is_macro? ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("empty?") => Types::Builtin.new("empty?") do |list_or_vector = nil| + is_empty = + case list_or_vector + when Types::List, Types::Vector + list_or_vector.empty? + else + true + end + + is_empty ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("count") => Types::Builtin.new("count") do |*mal| + count = + if mal.any? + case mal.first + when Types::List, Types::Vector + mal.first.size + else + 0 + end + else + 0 + end + + Types::Number.new(count) + end, + + Types::Symbol.for("=") => Types::Builtin.new("=") do |a, b| + if a.nil? || b.nil? + Types::False.instance + else + if a == b + Types::True.instance + else + Types::False.instance + end + end + end, + + Types::Symbol.for("<") => Types::Builtin.new("<") do |a, b| + if a.nil? || b.nil? + Types::False.instance + else + if a.is_a?(Types::Number) && b.is_a?(Types::Number) + if a.value < b.value + Types::True.instance + else + Types::False.instance + end + else + Types::False.instance + end + end + end, + + Types::Symbol.for("<=") => Types::Builtin.new("<=") do |a, b| + if a.nil? || b.nil? + Types::False.instance + else + if a.is_a?(Types::Number) && b.is_a?(Types::Number) + if a.value <= b.value + Types::True.instance + else + Types::False.instance + end + else + Types::False.instance + end + end + end, + + Types::Symbol.for(">") => Types::Builtin.new(">") do |a, b| + if a.nil? || b.nil? + Types::False.instance + else + if a.is_a?(Types::Number) && b.is_a?(Types::Number) + if a.value > b.value + Types::True.instance + else + Types::False.instance + end + else + Types::False.instance + end + end + end, + + Types::Symbol.for(">=") => Types::Builtin.new(">=") do |a, b| + if a.nil? || b.nil? + Types::False.instance + else + if a.is_a?(Types::Number) && b.is_a?(Types::Number) + if a.value >= b.value + Types::True.instance + else + Types::False.instance + end + else + Types::False.instance + end + end + end, + + Types::Symbol.for("pr-str") => Types::Builtin.new("pr-str") do |*mal| + Types::String.new(mal.map { |m| Mal.pr_str(m, true) }.join(" ")) + end, + + Types::Symbol.for("str") => Types::Builtin.new("str") do |*mal| + Types::String.new(mal.map { |m| Mal.pr_str(m, false) }.join("")) + end, + + Types::Symbol.for("prn") => Types::Builtin.new("prn") do |*mal| + puts mal.map { |m| Mal.pr_str(m, true) }.join(" ") + Types::Nil.instance + end, + + Types::Symbol.for("println") => Types::Builtin.new("println") do |*mal| + puts mal.map { |m| Mal.pr_str(m, false) }.join(" ") + Types::Nil.instance + end, + + Types::Symbol.for("read-string") => Types::Builtin.new("read-string") do |string = nil| + if string.is_a?(Types::String) + Mal.read_str(string.value) + else + Types::Nil.instance + end + end, + + Types::Symbol.for("slurp") => Types::Builtin.new("slurp") do |file = nil| + if file.is_a?(Types::String) + if File.exist?(file.value) + Types::String.new(File.read(file.value)) + else + raise FileNotFoundError, file.value + end + else + Types::Nil.instance + end + end, + + Types::Symbol.for("atom") => Types::Builtin.new("atom") do |mal| + Types::Atom.new(mal) + end, + + Types::Symbol.for("atom?") => Types::Builtin.new("atom?") do |maybe_atom| + maybe_atom.is_a?(Types::Atom) ? Types::True.instance : Types::False.instance + end, + + Types::Symbol.for("deref") => Types::Builtin.new("deref") do |maybe_atom| + maybe_atom.is_a?(Types::Atom) ? maybe_atom.value : Types::Nil.instance + end, + + Types::Symbol.for("reset!") => Types::Builtin.new("reset!") do |atom, value| + if value.nil? + value = Types::Nil.instance + end + + atom.value = value + end, + + Types::Symbol.for("swap!") => Types::Builtin.new("swap!") do |atom, fn, *args| + atom.value = fn.call(Types::Args.new([atom.value, *args])) + end, + + Types::Symbol.for("cons") => Types::Builtin.new("cons") do |val, list_or_vector| + Types::List.new([val, *list_or_vector]) + end, + + Types::Symbol.for("concat") => Types::Builtin.new("concat") do |*mal| + list = Types::List.new + + mal.each do |l| + list.concat(l) + end + + list + end, + + Types::Symbol.for("vec") => Types::Builtin.new("vec") do |list_or_vector| + case list_or_vector + when Types::List + vec = Types::Vector.new + + list_or_vector.each do |m| + vec << m + end + + vec + when Types::Vector + list_or_vector + else + raise TypeError, "invalid `vec` arguments, must be vector or list" + end + end, + + Types::Symbol.for("nth") => Types::Builtin.new("nth") do |list_or_vector, index| + result = list_or_vector[index.value] + raise IndexError, "Index #{index.value} is out of bounds" if result.nil? + result + end, + + Types::Symbol.for("first") => Types::Builtin.new("first") do |list_or_vector| + if !list_or_vector.nil? && list_or_vector != Types::Nil.instance + result = list_or_vector.first + + if result.nil? + result = Types::Nil.instance + end + + result + else + Types::Nil.instance + end + end, + + Types::Symbol.for("rest") => Types::Builtin.new("rest") do |list_or_vector| + Types::List.new ( + case list_or_vector + when Types::List, Types::Vector + if list_or_vector.empty? + [] + else + list_or_vector[1..] + end + when Types::Nil + [] + else + raise TypeError, "Unable to `rest`, too nervous" + end + ) + end, + + Types::Symbol.for("throw") => Types::Builtin.new("throw") do |to_throw| + raise MalError, to_throw + end, + + Types::Symbol.for("apply") => Types::Builtin.new("apply") do |fn, *rest| + args = Types::Args.new + + rest.flatten(1).each do |a| + args << a + end + + fn.call(args) + end, + + Types::Symbol.for("map") => Types::Builtin.new("map") do |fn, *rest| + results = Types::List.new + + rest.flatten(1).each do |a| + results << fn.call(Types::Args.new([a])) + end + + results + end, + + Types::Symbol.for("nil?") => Types::Builtin.new("nil?") do |mal| + if mal == Types::Nil.instance + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("true?") => Types::Builtin.new("true?") do |mal| + if mal == Types::True.instance + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("false?") => Types::Builtin.new("false?") do |mal| + if mal == Types::False.instance + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("symbol?") => Types::Builtin.new("symbol?") do |mal| + if mal.is_a?(Types::Symbol) + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("keyword?") => Types::Builtin.new("keyword?") do |mal| + if mal.is_a?(Types::Keyword) + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("symbol") => Types::Builtin.new("symbol") do |string| + if string + Types::Symbol.for(string.value) + else + Types::Nil.instance + end + end, + + Types::Symbol.for("keyword") => Types::Builtin.new("keyword") do |keyword| + if keyword + Types::Keyword.for(keyword.value) + else + Types::Nil.instance + end + end, + + Types::Symbol.for("vector") => Types::Builtin.new("vector") do |*items| + vector = Types::Vector.new + + items.each do |i| + vector << i + end + + vector + end, + + Types::Symbol.for("sequential?") => Types::Builtin.new("sequential?") do |list_or_vector| + case list_or_vector + when Types::List, Types::Vector + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("hash-map") => Types::Builtin.new("hash-map") do |*items| + raise UnbalancedHashmapError, "unbalanced hashmap error, arguments must be even" if items&.size&.odd? + + hashmap = Types::Hashmap.new + + items.each_slice(2) do |(k, v)| + hashmap[k] = v + end + + hashmap + end, + + Types::Symbol.for("map?") => Types::Builtin.new("map?") do |mal| + if mal.is_a?(Types::Hashmap) + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("assoc") => Types::Builtin.new("assoc") do |hashmap, *items| + raise UnbalancedHashmapError, "unbalanced hashmap error, arguments must be even" if items.size&.odd? + + new_hashmap = hashmap.dup + + items.each_slice(2) do |(k, v)| + new_hashmap[k] = v + end + + new_hashmap + end, + + Types::Symbol.for("dissoc") => Types::Builtin.new("dissoc") do |hashmap, *keys| + new_hashmap = Types::Hashmap.new + + hashmap.keys.each do |k| + next if keys.include?(k) + new_hashmap[k] = hashmap[k] + end + + new_hashmap + end, + + Types::Symbol.for("get") => Types::Builtin.new("get") do |hashmap, key| + if Types::Hashmap === hashmap && key && hashmap.key?(key) + hashmap[key] + else + Types::Nil.instance + end + end, + + Types::Symbol.for("contains?") => Types::Builtin.new("contains?") do |hashmap, key| + if Types::Hashmap === hashmap && key && hashmap.key?(key) + Types::True.instance + else + Types::False.instance + end + end, + + Types::Symbol.for("keys") => Types::Builtin.new("keys") do |hashmap| + if Types::Hashmap === hashmap + Types::List.new(hashmap.keys) + else + Types::Nil.instance + end + end, + + Types::Symbol.for("vals") => Types::Builtin.new("vals") do |hashmap| + if Types::Hashmap === hashmap + Types::List.new(hashmap.values) + else + Types::Nil.instance + end + end, + + Types::Symbol.for("readline") => Types::Builtin.new("readline") do |prompt = nil| + prompt = + if prompt.nil? + "user> " + else + prompt.value + end + + input = Readline.readline(prompt) + + if input.nil? + Types::Nil.instance + else + Types::String.new(input) + end + end, + + Types::Symbol.for("meta") => Types::Builtin.new("meta") do |value| + case value + when Types::List, Types::Vector, Types::Hashmap, Types::Callable + value.meta + else + Types::Nil.instance + end + end, + + Types::Symbol.for("with-meta") => Types::Builtin.new("with-meta") do |value, meta| + case value + when Types::List, Types::Vector, Types::Hashmap, Types::Callable + new_value = value.dup + new_value.meta = meta + new_value + else + raise TypeError, "Unable to use meta with #{Mal.pr_str(value)}" + end + end, + + Types::Symbol.for("time-ms") => Types::Builtin.new("time-ms") do + Types::Number.new((Time.now.to_f.round(3) * 1000).to_i) + end, + + Types::Symbol.for("conj") => Types::Builtin.new("conj") do |list_or_vector, *new_elems| + case list_or_vector + when Types::List + Types::List.new([*new_elems.reverse, *list_or_vector]) + when Types::Vector + Types::Vector.new([*list_or_vector, *new_elems]) + else + raise TypeError, "Unable to `conj` with <#{Mal.pr_str(list_or_vector)}>, must be list or vector" + end + end, + + Types::Symbol.for("seq") => Types::Builtin.new("seq") do |sequential| + case sequential + when Types::List + if sequential.any? + sequential + else + Types::Nil.instance + end + when Types::Vector + if sequential.any? + Types::List.new(sequential) + else + Types::Nil.instance + end + when Types::String + if !sequential.value.empty? + Types::List.new(sequential.value.chars.map { |c| Types::String.new(c) }) + else + Types::Nil.instance + end + when Types::Nil + Types::Nil.instance + else + raise TypeError, "Unable to `seq` with <#{Mal.pr_str(sequential)}>, must be list, vector, string, or nil" + end + end + } + end + end +end diff --git a/impls/ruby.2/env.rb b/impls/ruby.2/env.rb new file mode 100644 index 0000000000..0e8d612545 --- /dev/null +++ b/impls/ruby.2/env.rb @@ -0,0 +1,39 @@ +require_relative "errors" +require_relative "types" + +module Mal + class Env + def initialize(outer = nil, binds = Types::List.new, exprs = Types::List.new) + @outer = outer + @data = {} + + spread_next = false + binds.each_with_index do |b, i| + if b.value == "&" + spread_next = true + else + if spread_next + set(b, Types::List.new(exprs[(i - 1)..]) || Types::Nil.instance) + break + else + set(b, exprs[i] || Types::Nil.instance) + end + end + end + end + + def set(k, v) + @data[k] = v + end + + def get(k) + if @data.key?(k) + @data[k] + elsif !@outer.nil? + @outer.get(k) + else + 0 + end + end + end +end diff --git a/impls/ruby.2/errors.rb b/impls/ruby.2/errors.rb new file mode 100644 index 0000000000..71bd718224 --- /dev/null +++ b/impls/ruby.2/errors.rb @@ -0,0 +1,53 @@ +module Mal + class Error < ::StandardError; end + class TypeError < ::TypeError; end + + class MalError < Error + attr_reader :value + + def initialize(value) + @value = value + end + + def message + value.inspect + end + end + + class FileNotFoundError < Error; end + class IndexError < TypeError; end + class SkipCommentError < Error; end + + class InvalidHashmapKeyError < TypeError; end + class InvalidIfExpressionError < TypeError; end + class InvalidLetBindingsError < TypeError; end + class InvalidReaderPositionError < Error; end + class InvalidTypeError < TypeError; end + + class NotCallableError < Error; end + + class SymbolNotFoundError < Error; end + class SyntaxError < TypeError; end + + class UnbalancedEscapingError < Error; end + class UnbalancedHashmapError < Error; end + class UnbalancedListError < Error; end + class UnbalancedStringError < Error; end + class UnbalancedVectorError < Error; end + + class UnknownError < Error + attr_reader :original_error + + def initialize(original_error) + @original_error = original_error + end + + def inspect + "UnknownError :: #{original_error.inspect}" + end + + def message + "UnknownError<#{original_error.class}> :: #{original_error.message}" + end + end +end diff --git a/impls/ruby.2/printer.rb b/impls/ruby.2/printer.rb new file mode 100644 index 0000000000..256e5a058e --- /dev/null +++ b/impls/ruby.2/printer.rb @@ -0,0 +1,55 @@ +require_relative "errors" +require_relative "types" + +module Mal + extend self + + def pr_str(mal, print_readably = false) + case mal + when Types::List + "(#{mal.map { |m| pr_str(m, print_readably) }.join(" ")})" + when Types::Vector + "[#{mal.map { |m| pr_str(m, print_readably) }.join(" ")}]" + when Types::Hashmap + "{#{mal.map { |k, v| [pr_str(k, print_readably), pr_str(v, print_readably)].join(" ") }.join(" ")}}" + when Types::Keyword + if print_readably + pr_str_keyword(mal) + else + ":#{mal.value}" + end + when Types::String + if print_readably + pr_str_string(mal) + else + mal.value + end + when Types::Atom + "(atom #{pr_str(mal.value, print_readably)})" + when Types::Base, Types::Callable + mal.inspect + else + raise InvalidTypeError, "unable to print value <#{mal.inspect}>" + end + end + + def pr_str_keyword(mal) + value = mal.value.dup + + value.gsub!('\\','\\\\\\\\') + value.gsub!("\n",'\n') + value.gsub!('"','\"') + + ":#{value}" + end + + def pr_str_string(mal) + value = mal.value.dup + + value.gsub!('\\','\\\\\\\\') + value.gsub!("\n",'\n') + value.gsub!('"','\"') + + "\"#{value}\"" + end +end diff --git a/impls/ruby.2/reader.rb b/impls/ruby.2/reader.rb new file mode 100644 index 0000000000..be572c61f5 --- /dev/null +++ b/impls/ruby.2/reader.rb @@ -0,0 +1,268 @@ +require_relative "errors" +require_relative "types" + +module Mal + extend self + + TOKEN_REGEX = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ + + def read_atom(reader) + case reader.peek + when /\A"(?:\\.|[^\\"])*"\z/ + read_string(reader) + when /\A"/ + raise UnbalancedStringError, "unbalanced string << #{reader.peek.inspect} >>" + when /\A:/ + read_keyword(reader) + when "nil" + read_nil(reader) + when "true" + read_true(reader) + when "false" + read_false(reader) + when /\A-?\d+(\.\d+)?/ + read_number(reader) + when /\A;/ + raise SkipCommentError + else + read_symbol(reader) + end + end + + def read_deref(reader) + list = Types::List.new + list << Types::Symbol.for("deref") + list << read_form(reader) + list + end + + def read_false(reader) + reader.advance! + Types::False.instance + end + + def read_form(reader) + case reader.peek + when "'" + read_quote(reader.advance!) + when "`" + read_quasiquote(reader.advance!) + when "~" + read_unquote(reader.advance!) + when "~@" + read_splice_unquote(reader.advance!) + when "@" + read_deref(reader.advance!) + when "^" + read_with_metadata(reader.advance!) + when "(" + read_list(reader.advance!) + when "[" + read_vector(reader.advance!) + when "{" + read_hashmap(reader.advance!) + else + read_atom(reader) + end + end + + def read_hashmap(reader) + hashmap = Types::Hashmap.new + + until reader.peek == "}" + key = read_form(reader) + + unless Types::String === key || Types::Keyword === key + raise InvalidHashmapKeyError, "invalid hashmap key, must be string or keyword" + end + + if reader.peek != "}" + value = read_form(reader) + else + raise UnbalancedHashmapError, "unbalanced hashmap error, missing closing '}'" + end + + hashmap[key] = value + end + + reader.advance! + hashmap + rescue Error => e + case e + when InvalidReaderPositionError + raise UnbalancedHashmapError, "unbalanced hashmap error, missing closing '}'" + else + raise e + end + end + + def read_keyword(reader) + value = reader.next.dup[1...] + substitute_escaped_chars!(value) + + Types::Keyword.for(value) + end + + def read_list(reader) + list = Types::List.new + + until reader.peek == ")" + list << read_form(reader) + end + + reader.advance! + list + rescue Error => e + case e + when InvalidReaderPositionError + raise UnbalancedListError, "unbalanced list error, missing closing ')'" + else + raise e + end + end + + def read_nil(reader) + reader.advance! + Types::Nil.instance + end + + def read_number(reader) + case reader.peek + when /\d+\.\d+/ + Types::Number.new(reader.next.to_f) + when /\d+/ + Types::Number.new(reader.next.to_i) + else + raise InvalidTypeError, "invalid number syntax, only supports integers/floats" + end + end + + def read_quasiquote(reader) + list = Types::List.new + list << Types::Symbol.for("quasiquote") + list << read_form(reader) + list + end + + def read_quote(reader) + list = Types::List.new + list << Types::Symbol.for("quote") + list << read_form(reader) + list + end + + def read_splice_unquote(reader) + list = Types::List.new + list << Types::Symbol.for("splice-unquote") + list << read_form(reader) + list + end + + def read_str(input) + tokenized = tokenize(input) + raise SkipCommentError if tokenized.empty? + read_form(Reader.new(tokenized)) + end + + def read_string(reader) + raw_value = reader.next.dup + + value = raw_value[1...-1] + substitute_escaped_chars!(value) + + if raw_value.length <= 1 || raw_value[-1] != '"' + raise UnbalancedStringError, "unbalanced string error, missing closing '\"'" + end + + Types::String.new(value) + end + + def read_symbol(reader) + Types::Symbol.for(reader.next) + end + + def read_true(reader) + reader.advance! + Types::True.instance + end + + def read_unquote(reader) + list = Types::List.new + list << Types::Symbol.for("unquote") + list << read_form(reader) + list + end + + def read_vector(reader) + vector = Types::Vector.new + + until reader.peek == "]" + vector << read_form(reader) + end + + reader.advance! + vector + rescue Error => e + case e + when InvalidReaderPositionError + raise UnbalancedVectorError, "unbalanced vector error, missing closing ']'" + else + raise e + end + end + + def read_with_metadata(reader) + list = Types::List.new + list << Types::Symbol.for("with-meta") + + first = read_form(reader) + second = read_form(reader) + + list << second + list << first + + list + end + + def tokenize(input) + input.scan(TOKEN_REGEX).flatten.each_with_object([]) do |token, tokens| + if token != "" && !token.start_with?(";") + tokens << token + end + end + end + + class Reader + attr_reader :tokens + + def initialize(tokens) + @position = 0 + @tokens = tokens + end + + def advance! + @position += 1 + self + end + + def next + value = peek + @position += 1 + value + end + + def peek + if @position > @tokens.size - 1 + raise InvalidReaderPositionError, "invalid reader position error, unable to parse mal expression" + end + + @tokens[@position] + end + end + + private + + def substitute_escaped_chars!(string_or_keyword) + string_or_keyword.gsub!(/\\./, {"\\\\" => "\\", "\\n" => "\n", "\\\"" => '"'}) + end +end diff --git a/impls/ruby.2/run b/impls/ruby.2/run new file mode 100755 index 0000000000..980db0d659 --- /dev/null +++ b/impls/ruby.2/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec ruby $(dirname $0)/${STEP:-stepA_mal}.rb "${@}" diff --git a/impls/ruby.2/step0_repl.rb b/impls/ruby.2/step0_repl.rb new file mode 100644 index 0000000000..de1e08ec78 --- /dev/null +++ b/impls/ruby.2/step0_repl.rb @@ -0,0 +1,25 @@ +require "readline" + +module Mal + extend self + + def READ(input) + input + end + + def EVAL(input) + input + end + + def PRINT(input) + input + end + + def rep(input) + PRINT(EVAL(READ(input))) + end +end + +while input = Readline.readline("user> ") + puts Mal.rep(input) +end diff --git a/impls/ruby.2/step1_read_print.rb b/impls/ruby.2/step1_read_print.rb new file mode 100644 index 0000000000..7cd24c5b9d --- /dev/null +++ b/impls/ruby.2/step1_read_print.rb @@ -0,0 +1,45 @@ +require "readline" + +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def READ(input) + read_str(input) + end + + def EVAL(input) + input + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input))) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + rescue SkipCommentError + nil + end +end + +while input = Readline.readline("user> ") + puts Mal.rep(input) +end + +puts diff --git a/impls/ruby.2/step2_eval.rb b/impls/ruby.2/step2_eval.rb new file mode 100644 index 0000000000..681068ebd4 --- /dev/null +++ b/impls/ruby.2/step2_eval.rb @@ -0,0 +1,91 @@ +require "readline" + +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + @repl_env = { + '+' => -> (a, b) { a + b }, + '-' => -> (a, b) { a - b }, + '*' => -> (a, b) { a * b }, + '/' => -> (a, b) { a / b }, + } + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + # puts "EVAL: #{pr_str(ast, true)}" + + + case ast + when Types::Symbol + if @repl_env.key?(ast.value) + @repl_env[ast.value] + else + raise SymbolNotFoundError, "Error! Symbol #{ast.value} not found." + end + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } + maybe_callable = evaluated.first + + if maybe_callable.respond_to?(:call) + maybe_callable.call(*evaluated[1..]) + else + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + else + return ast + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + end + +end + +while input = Readline.readline("user> ") + puts Mal.rep(input) +end + +puts + + diff --git a/impls/ruby.2/step3_env.rb b/impls/ruby.2/step3_env.rb new file mode 100644 index 0000000000..59d08f0868 --- /dev/null +++ b/impls/ruby.2/step3_env.rb @@ -0,0 +1,121 @@ +require "readline" + +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + @repl_env = Env.new + @repl_env.set(Types::Symbol.for('+'), -> (a, b) { a + b }) + @repl_env.set(Types::Symbol.for('-'), -> (a, b) { a - b }) + @repl_env.set(Types::Symbol.for('*'), -> (a, b) { a * b }) + @repl_env.set(Types::Symbol.for('/'), -> (a, b) { a / b }) + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + EVAL(val, e) + else + Types::Nil.instance + end + else + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } + maybe_callable = evaluated.first + + if maybe_callable.respond_to?(:call) + maybe_callable.call(*evaluated[1..]) + else + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + end + else + return ast + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + end + +end + +while input = Readline.readline("user> ") + puts Mal.rep(input) +end + +puts + + diff --git a/impls/ruby.2/step4_if_fn_do.rb b/impls/ruby.2/step4_if_fn_do.rb new file mode 100644 index 0000000000..506026facb --- /dev/null +++ b/impls/ruby.2/step4_if_fn_do.rb @@ -0,0 +1,165 @@ +require "readline" + +require_relative "core" +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def boot_repl! + @repl_env = Env.new + + Core.ns.each do |k, v| + @repl_env.set(k, v) + end + + Mal.rep("(def! not (fn* (a) (if a false true)))") + end + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + EVAL(val, e) + else + Types::Nil.instance + end + when Types::Symbol.for("do") + _, *values = ast + + if !values.nil? + evaluated = Types::List.new + + values.each do |v| + evaluated << EVAL(v, environment) + end + + evaluated.last + else + Types::Nil.instance + end + when Types::Symbol.for("if") + _, condition, when_true, when_false = ast + + case EVAL(condition, environment) + when Types::False.instance, Types::Nil.instance + if !when_false.nil? + EVAL(when_false, environment) + else + Types::Nil.instance + end + else + if !when_true.nil? + EVAL(when_true, environment) + else + raise InvalidIfExpressionError + end + end + when Types::Symbol.for("fn*") + _, binds, to_eval = ast + + Types::Function.new(to_eval, binds, environment) do |*exprs| + EVAL(to_eval, Env.new(environment, binds, exprs)) + end + else + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } + maybe_callable = evaluated.first + + if maybe_callable.respond_to?(:call) + maybe_callable.call(Types::Args.new(evaluated[1..])) + else + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + end + else + return ast + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + end + +end + +Mal.boot_repl! + +while input = Readline.readline("user> ") + puts Mal.rep(input) +end + +puts + + diff --git a/impls/ruby.2/step5_tco.rb b/impls/ruby.2/step5_tco.rb new file mode 100644 index 0000000000..311468527a --- /dev/null +++ b/impls/ruby.2/step5_tco.rb @@ -0,0 +1,179 @@ +require "readline" + +require_relative "core" +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def boot_repl! + @repl_env = Env.new + + Core.ns.each do |k, v| + @repl_env.set(k, v) + end + + Mal.rep("(def! not (fn* (a) (if a false true)))") + end + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + loop do + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + return environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + # Continue loop + ast = val + environment = e + else + return Types::Nil.instance + end + when Types::Symbol.for("do") + _, *values = ast + + if !values.nil? && values.any? + values[0...-1].each do |v| + EVAL(v, environment) + end + + # Continue loop + ast = values.last + else + return Types::Nil.instance + end + when Types::Symbol.for("if") + _, condition, when_true, when_false = ast + + case EVAL(condition, environment) + when Types::False.instance, Types::Nil.instance + if !when_false.nil? + # Continue loop + ast = when_false + else + return Types::Nil.instance + end + else + if !when_true.nil? + # Continue loop + ast = when_true + else + raise InvalidIfExpressionError + end + end + when Types::Symbol.for("fn*") + _, binds, to_eval = ast + + return Types::Function.new(to_eval, binds, environment) do |*exprs| + EVAL(to_eval, Env.new(environment, binds, exprs)) + end + else + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + args = Types::List.new + ast[1..].each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? + # Continue loop + ast = maybe_callable.ast + environment = Env.new( + maybe_callable.env, + maybe_callable.params, + args, + ) + else + return maybe_callable.call(Types::Args.new(args)) + end + end + else + return ast + end + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + end + +end + +Mal.boot_repl! + +while input = Readline.readline("user> ") + puts Mal.rep(input) +end + +puts + + diff --git a/impls/ruby.2/step6_file.rb b/impls/ruby.2/step6_file.rb new file mode 100644 index 0000000000..4efc9e8449 --- /dev/null +++ b/impls/ruby.2/step6_file.rb @@ -0,0 +1,203 @@ +require "readline" + +require_relative "core" +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def boot_repl! + @repl_env = Env.new + + Core.ns.each do |k, v| + @repl_env.set(k, v) + end + + @repl_env.set( + Types::Symbol.for("eval"), + + Types::Builtin.new("eval") do |mal| + Mal.EVAL(mal, @repl_env) + end + ) + + Mal.rep("(def! not (fn* (a) (if a false true)))") + Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + Mal.rep("(def! *ARGV* (list))") if !run_application? + end + + def run_application? + ARGV.any? + end + + def run! + Mal.rep("(def! *ARGV* (list #{ARGV[1..].map(&:inspect).join(" ")}))") + Mal.rep("(load-file #{ARGV.first.inspect})") + end + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + loop do + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + return environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + # Continue loop + ast = val + environment = e + else + return Types::Nil.instance + end + when Types::Symbol.for("do") + _, *values = ast + + if !values.nil? && values.any? + values[0...-1].each do |v| + EVAL(v, environment) + end + + # Continue loop + ast = values.last + else + return Types::Nil.instance + end + when Types::Symbol.for("if") + _, condition, when_true, when_false = ast + + case EVAL(condition, environment) + when Types::False.instance, Types::Nil.instance + if !when_false.nil? + # Continue loop + ast = when_false + else + return Types::Nil.instance + end + else + if !when_true.nil? + # Continue loop + ast = when_true + else + raise InvalidIfExpressionError + end + end + when Types::Symbol.for("fn*") + _, binds, to_eval = ast + + return Types::Function.new(to_eval, binds, environment) do |*exprs| + EVAL(to_eval, Env.new(environment, binds, exprs)) + end + else + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + args = Types::List.new + ast[1..].each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? + # Continue loop + ast = maybe_callable.ast + environment = Env.new( + maybe_callable.env, + maybe_callable.params, + args, + ) + else + return maybe_callable.call(Types::Args.new(args)) + end + end + else + return ast + end + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + rescue SkipCommentError + nil + end + +end + +Mal.boot_repl! + +if Mal.run_application? + Mal.run! +else + while input = Readline.readline("user> ") + val = Mal.rep(input) + puts val unless val.nil? + end + + puts +end diff --git a/impls/ruby.2/step7_quote.rb b/impls/ruby.2/step7_quote.rb new file mode 100644 index 0000000000..7d362fa806 --- /dev/null +++ b/impls/ruby.2/step7_quote.rb @@ -0,0 +1,253 @@ +require "readline" + +require_relative "core" +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def boot_repl! + @repl_env = Env.new + + Core.ns.each do |k, v| + @repl_env.set(k, v) + end + + @repl_env.set( + Types::Symbol.for("eval"), + + Types::Builtin.new("eval") do |mal| + Mal.EVAL(mal, @repl_env) + end + ) + + Mal.rep("(def! not (fn* (a) (if a false true)))") + Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + Mal.rep("(def! *ARGV* (list))") if !run_application? + end + + def run_application? + ARGV.any? + end + + def run! + Mal.rep("(def! *ARGV* (list #{ARGV[1..].map(&:inspect).join(" ")}))") + Mal.rep("(load-file #{ARGV.first.inspect})") + end + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + loop do + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + return environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + # Continue loop + ast = val + environment = e + else + return Types::Nil.instance + end + when Types::Symbol.for("do") + _, *values = ast + + if !values.nil? && values.any? + values[0...-1].each do |v| + EVAL(v, environment) + end + + # Continue loop + ast = values.last + else + return Types::Nil.instance + end + when Types::Symbol.for("if") + _, condition, when_true, when_false = ast + + case EVAL(condition, environment) + when Types::False.instance, Types::Nil.instance + if !when_false.nil? + # Continue loop + ast = when_false + else + return Types::Nil.instance + end + else + if !when_true.nil? + # Continue loop + ast = when_true + else + raise InvalidIfExpressionError + end + end + when Types::Symbol.for("fn*") + _, binds, to_eval = ast + + return Types::Function.new(to_eval, binds, environment) do |*exprs| + EVAL(to_eval, Env.new(environment, binds, exprs)) + end + when Types::Symbol.for("quote") + _, ret = ast + return ret + when Types::Symbol.for("quasiquote") + _, ast_rest = ast + ast = quasiquote(ast_rest) + else + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + args = Types::List.new + ast[1..].each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? + # Continue loop + ast = maybe_callable.ast + environment = Env.new( + maybe_callable.env, + maybe_callable.params, + args, + ) + else + return maybe_callable.call(Types::Args.new(args)) + end + end + else + return ast + end + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + rescue SkipCommentError + nil + end + + def quasiquote_list(mal) + result = Types::List.new + + mal.reverse_each do |elt| + if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") + result = Types::List.new([ + Types::Symbol.for("concat"), + elt[1], + result + ]) + else + result = Types::List.new([ + Types::Symbol.for("cons"), + quasiquote(elt), + result + ]) + end + end + + result + end + + def quasiquote(mal) + case mal + when Types::List + if mal.first == Types::Symbol.for("unquote") + mal[1] + else + quasiquote_list(mal) + end + when Types::Vector + Types::List.new([ + Types::Symbol.for("vec"), + quasiquote_list(mal) + ]) + when Types::Hashmap, Types::Symbol + Types::List.new([ + Types::Symbol.for("quote"), + mal + ]) + else + mal + end + end +end + +Mal.boot_repl! + +if Mal.run_application? + Mal.run! +else + while input = Readline.readline("user> ") + val = Mal.rep(input) + puts val unless val.nil? + end + + puts +end diff --git a/impls/ruby.2/step8_macros.rb b/impls/ruby.2/step8_macros.rb new file mode 100644 index 0000000000..1ed751d010 --- /dev/null +++ b/impls/ruby.2/step8_macros.rb @@ -0,0 +1,280 @@ +require "readline" + +require_relative "core" +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def boot_repl! + @repl_env = Env.new + + Core.ns.each do |k, v| + @repl_env.set(k, v) + end + + @repl_env.set( + Types::Symbol.for("eval"), + + Types::Builtin.new("eval") do |mal| + Mal.EVAL(mal, @repl_env) + end + ) + + Mal.rep("(def! not (fn* (a) (if a false true)))") + Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + Mal.rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if !run_application? + Mal.rep("(def! *ARGV* (list))") + Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") + end + end + + def run_application? + ARGV.any? + end + + def run! + Mal.rep("(def! *ARGV* (list #{ARGV[1..].map(&:inspect).join(" ")}))") + Mal.rep("(load-file #{ARGV.first.inspect})") + end + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + loop do + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + return environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("defmacro!") + _, sym, val = ast + result = EVAL(val, environment) + + case result + when Types::Function + return environment.set(sym, result.to_macro) + else + raise TypeError + end + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + # Continue loop + ast = val + environment = e + else + return Types::Nil.instance + end + when Types::Symbol.for("do") + _, *values = ast + + if !values.nil? && values.any? + values[0...-1].each do |v| + EVAL(v, environment) + end + + # Continue loop + ast = values.last + else + return Types::Nil.instance + end + when Types::Symbol.for("if") + _, condition, when_true, when_false = ast + + case EVAL(condition, environment) + when Types::False.instance, Types::Nil.instance + if !when_false.nil? + # Continue loop + ast = when_false + else + return Types::Nil.instance + end + else + if !when_true.nil? + # Continue loop + ast = when_true + else + raise InvalidIfExpressionError + end + end + when Types::Symbol.for("fn*") + _, binds, to_eval = ast + + return Types::Function.new(to_eval, binds, environment) do |*exprs| + EVAL(to_eval, Env.new(environment, binds, exprs)) + end + when Types::Symbol.for("quote") + _, ret = ast + return ret + when Types::Symbol.for("quasiquote") + _, ast_rest = ast + ast = quasiquote(ast_rest) + else + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + raw_args = ast[1..] + if maybe_callable.is_macro? + if raw_args.any? + ast = maybe_callable.call(Types::Args.new(raw_args)) + else + ast = maybe_callable.call + end + next + end + args = Types::List.new + raw_args.each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? + # Continue loop + ast = maybe_callable.ast + environment = Env.new( + maybe_callable.env, + maybe_callable.params, + args, + ) + else + return maybe_callable.call(Types::Args.new(args)) + end + end + else + return ast + end + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + rescue SkipCommentError + nil + rescue TypeError + nil + end + + def quasiquote_list(mal) + result = Types::List.new + + mal.reverse_each do |elt| + if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") + result = Types::List.new([ + Types::Symbol.for("concat"), + elt[1], + result + ]) + else + result = Types::List.new([ + Types::Symbol.for("cons"), + quasiquote(elt), + result + ]) + end + end + + result + end + + def quasiquote(mal) + case mal + when Types::List + if mal.first == Types::Symbol.for("unquote") + mal[1] + else + quasiquote_list(mal) + end + when Types::Vector + Types::List.new([ + Types::Symbol.for("vec"), + quasiquote_list(mal) + ]) + when Types::Hashmap, Types::Symbol + Types::List.new([ + Types::Symbol.for("quote"), + mal + ]) + else + mal + end + end + +end + +Mal.boot_repl! + +if Mal.run_application? + Mal.run! +else + while input = Readline.readline("user> ") + val = Mal.rep(input) + puts val unless val.nil? + end + + puts +end diff --git a/impls/ruby.2/step9_try.rb b/impls/ruby.2/step9_try.rb new file mode 100644 index 0000000000..f2c901921b --- /dev/null +++ b/impls/ruby.2/step9_try.rb @@ -0,0 +1,320 @@ +require "readline" + +require_relative "core" +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def boot_repl! + @repl_env = Env.new + + Core.ns.each do |k, v| + @repl_env.set(k, v) + end + + @repl_env.set( + Types::Symbol.for("eval"), + + Types::Builtin.new("eval") do |mal| + Mal.EVAL(mal, @repl_env) + end + ) + + Mal.rep("(def! not (fn* (a) (if a false true)))") + Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + Mal.rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if !run_application? + Mal.rep("(def! *ARGV* (list))") + Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") + end + end + + def run_application? + ARGV.any? + end + + def run! + args = ARGV[1..].map(&:inspect) + + if args.any? + Mal.rep("(def! *ARGV* (list #{args.join(" ")}))") + else + Mal.rep("(def! *ARGV* (list))") + end + + file = File.absolute_path(ARGV.first) + + Dir.chdir(File.dirname(file)) do + Mal.rep("(load-file #{file.inspect})") + end + end + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + loop do + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + return environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("defmacro!") + _, sym, val = ast + result = EVAL(val, environment) + + case result + when Types::Function + return environment.set(sym, result.to_macro) + else + raise TypeError + end + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + # Continue loop + ast = val + environment = e + else + return Types::Nil.instance + end + when Types::Symbol.for("do") + _, *values = ast + + if !values.nil? && values.any? + values[0...-1].each do |v| + EVAL(v, environment) + end + + # Continue loop + ast = values.last + else + return Types::Nil.instance + end + when Types::Symbol.for("if") + _, condition, when_true, when_false = ast + + case EVAL(condition, environment) + when Types::False.instance, Types::Nil.instance + if !when_false.nil? + # Continue loop + ast = when_false + else + return Types::Nil.instance + end + else + if !when_true.nil? + # Continue loop + ast = when_true + else + raise InvalidIfExpressionError + end + end + when Types::Symbol.for("fn*") + _, binds, to_eval = ast + + return Types::Function.new(to_eval, binds, environment) do |*exprs| + EVAL(to_eval, Env.new(environment, binds, exprs)) + end + when Types::Symbol.for("quote") + _, ret = ast + return ret + when Types::Symbol.for("quasiquote") + _, ast_rest = ast + ast = quasiquote(ast_rest) + when Types::Symbol.for("try*") + _, to_try, catch_list = ast + + begin + return EVAL(to_try, environment) + rescue => e + raise e if catch_list.nil? || catch_list&.empty? + raise SyntaxError, "try* missing proper catch*" unless catch_list&.first == Types::Symbol.for("catch*") + + _, exception_symbol, exception_handler = catch_list + + value = + if e.is_a?(MalError) + e.value + else + Types::String.new(e.message) + end + + return EVAL( + exception_handler, + Env.new( + environment, + Types::List.new([exception_symbol]), + Types::List.new([value]) + ) + ) + end + else + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + raw_args = ast[1..] + if maybe_callable.is_macro? + if raw_args.any? + ast = maybe_callable.call(Types::Args.new(raw_args)) + else + ast = maybe_callable.call + end + next + end + args = Types::List.new + raw_args.each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? + # Continue loop + ast = maybe_callable.ast + environment = Env.new( + maybe_callable.env, + maybe_callable.params, + args, + ) + else + return maybe_callable.call(Types::Args.new(args)) + end + end + else + return ast + end + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + rescue MalError => e + "Error: #{pr_str(e.value, true)}" + rescue Error, TypeError => e + "#{e.class} -- #{e.message}" + rescue SkipCommentError + nil + end + + def quasiquote_list(mal) + result = Types::List.new + + mal.reverse_each do |elt| + if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") + result = Types::List.new([ + Types::Symbol.for("concat"), + elt[1], + result + ]) + else + result = Types::List.new([ + Types::Symbol.for("cons"), + quasiquote(elt), + result + ]) + end + end + + result + end + + def quasiquote(mal) + case mal + when Types::List + if mal.first == Types::Symbol.for("unquote") + mal[1] + else + quasiquote_list(mal) + end + when Types::Vector + Types::List.new([ + Types::Symbol.for("vec"), + quasiquote_list(mal) + ]) + when Types::Hashmap, Types::Symbol + Types::List.new([ + Types::Symbol.for("quote"), + mal + ]) + else + mal + end + end + +end + +Mal.boot_repl! + +if Mal.run_application? + Mal.run! +else + while input = Readline.readline("user> ") + val = Mal.rep(input) + puts val unless val.nil? + end + + puts +end diff --git a/impls/ruby.2/stepA_mal.rb b/impls/ruby.2/stepA_mal.rb new file mode 100644 index 0000000000..6ccb1ca05d --- /dev/null +++ b/impls/ruby.2/stepA_mal.rb @@ -0,0 +1,324 @@ +require "readline" + +require_relative "core" +require_relative "env" +require_relative "errors" +require_relative "printer" +require_relative "reader" + +module Mal + extend self + + def boot_repl! + @repl_env = Env.new + + Core.ns.each do |k, v| + @repl_env.set(k, v) + end + + @repl_env.set( + Types::Symbol.for("eval"), + + Types::Builtin.new("eval") do |mal| + Mal.EVAL(mal, @repl_env) + end + ) + + Mal.rep("(def! not (fn* (a) (if a false true)))") + Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + Mal.rep("(def! *host-language* \"ruby.2\")") + Mal.rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if !run_application? + Mal.rep("(def! *ARGV* (list))") + Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") + end + end + + def run_application? + ARGV.any? + end + + def run! + args = ARGV[1..].map(&:inspect) + + if args.any? + Mal.rep("(def! *ARGV* (list #{args.join(" ")}))") + else + Mal.rep("(def! *ARGV* (list))") + end + + file = File.absolute_path(ARGV.first) + + Dir.chdir(File.dirname(file)) do + Mal.rep("(load-file #{file.inspect})") + end + end + + def READ(input) + read_str(input) + end + + def EVAL(ast, environment) + loop do + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + case ast.first + when Types::Symbol.for("def!") + _, sym, val = ast + return environment.set(sym, EVAL(val, environment)) + when Types::Symbol.for("defmacro!") + _, sym, val = ast + result = EVAL(val, environment) + + case result + when Types::Function + return environment.set(sym, result.to_macro) + else + raise TypeError, "defmacro! must be bound to a function" + end + when Types::Symbol.for("let*") + e = Env.new(environment) + _, bindings, val = ast + bindings = bindings.dup # TODO note bugfix let bindings w/ TCO loop and destructive mutation (shift) + + unless Types::List === bindings || Types::Vector === bindings + raise InvalidLetBindingsError, "let* bindings must be a list or vector" + end + + until bindings.empty? + k, v = bindings.shift(2) + + raise InvalidLetBindingsError, "Invalid let* bindings 'nil' key" if k.nil? + v = Types::Nil.instance if v.nil? + + e.set(k, EVAL(v, e)) + end + + if !val.nil? + # Continue loop + ast = val + environment = e + else + return Types::Nil.instance + end + when Types::Symbol.for("do") + _, *values = ast + + if !values.nil? && values.any? + values[0...-1].each do |v| + EVAL(v, environment) + end + + # Continue loop + ast = values.last + else + return Types::Nil.instance + end + when Types::Symbol.for("if") + _, condition, when_true, when_false = ast + + case EVAL(condition, environment) + when Types::False.instance, Types::Nil.instance + if !when_false.nil? + # Continue loop + ast = when_false + else + return Types::Nil.instance + end + else + if !when_true.nil? + # Continue loop + ast = when_true + else + raise InvalidIfExpressionError, "No expression to evaluate when true" + end + end + when Types::Symbol.for("fn*") + _, binds, to_eval = ast + + return Types::Function.new(to_eval, binds, environment) do |*exprs| + EVAL(to_eval, Env.new(environment, binds, exprs)) + end + when Types::Symbol.for("quote") + _, ret = ast + return ret + when Types::Symbol.for("quasiquote") + _, ast_rest = ast + ast = quasiquote(ast_rest) + when Types::Symbol.for("try*") + _, to_try, catch_list = ast + + begin + return EVAL(to_try, environment) + rescue => e + raise e if catch_list.nil? || catch_list&.empty? + raise SyntaxError, "try* missing proper catch*" unless catch_list&.first == Types::Symbol.for("catch*") + + _, exception_symbol, exception_handler = catch_list + + value = + if e.is_a?(MalError) + e.value + else + Types::String.new(e.message) + end + + return EVAL( + exception_handler, + Env.new( + environment, + Types::List.new([exception_symbol]), + Types::List.new([value]) + ) + ) + end + else + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + raw_args = ast[1..] + if maybe_callable.is_macro? + if raw_args.any? + ast = maybe_callable.call(Types::Args.new(raw_args)) + else + ast = maybe_callable.call + end + next + end + args = Types::List.new + raw_args.each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? + # Continue loop + ast = maybe_callable.ast + environment = Env.new( + maybe_callable.env, + maybe_callable.params, + args, + ) + elsif args.any? + return maybe_callable.call(Types::Args.new(args)) + else + return maybe_callable.call(Types::Args.new) + end + end + else + return ast + end + end + end + + def PRINT(input) + pr_str(input, true) + end + + def rep(input) + PRINT(EVAL(READ(input), @repl_env)) + rescue InvalidHashmapKeyError => e + "Error! Hashmap keys can only be strings or keywords." + rescue NotCallableError => e + e.message + rescue SymbolNotFoundError => e + e.message + rescue UnbalancedEscapingError => e + "Error! Detected unbalanced escaping. Check for matching '\\'." + rescue UnbalancedHashmapError => e + "Error! Detected unbalanced list. Check for matching '}'." + rescue UnbalancedListError => e + "Error! Detected unbalanced list. Check for matching ')'." + rescue UnbalancedStringError => e + "Error! Detected unbalanced string. Check for matching '\"'." + rescue UnbalancedVectorError => e + "Error! Detected unbalanced list. Check for matching ']'." + rescue MalError => e + "Error: #{pr_str(e.value, true)}" + rescue Error, TypeError => e + "#{e.class} -- #{e.message}" + rescue SkipCommentError + nil + end + + def quasiquote_list(mal) + result = Types::List.new + + mal.reverse_each do |elt| + if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") + result = Types::List.new([ + Types::Symbol.for("concat"), + elt[1], + result + ]) + else + result = Types::List.new([ + Types::Symbol.for("cons"), + quasiquote(elt), + result + ]) + end + end + + result + end + + def quasiquote(mal) + case mal + when Types::List + if mal.first == Types::Symbol.for("unquote") + mal[1] + else + quasiquote_list(mal) + end + when Types::Vector + Types::List.new([ + Types::Symbol.for("vec"), + quasiquote_list(mal) + ]) + when Types::Hashmap, Types::Symbol + Types::List.new([ + Types::Symbol.for("quote"), + mal + ]) + else + mal + end + end + +end + +Mal.boot_repl! + +if Mal.run_application? + Mal.run! +else + while input = Readline.readline("user> ") + val = Mal.rep(input) + puts val unless val.nil? + end + + puts +end diff --git a/impls/ruby.2/types.rb b/impls/ruby.2/types.rb new file mode 100644 index 0000000000..d50c50b433 --- /dev/null +++ b/impls/ruby.2/types.rb @@ -0,0 +1,217 @@ +module Mal + module Types + class Args < ::Array + end + + class List < ::Array + def meta + @meta ||= Types::Nil.instance + end + + def meta=(value) + @meta = value + end + + def to_list + self + end + end + + class Vector < ::Array + def meta + @meta ||= Types::Nil.instance + end + + def meta=(value) + @meta = value + end + + def to_list + List.new(self) + end + end + + class Hashmap < ::Hash + def meta + @meta ||= Types::Nil.instance + end + + def meta=(value) + @meta = value + end + end + + class Base < ::Struct.new(:value) + def inspect + value.inspect + end + end + + class String < Base; end + + class Atom < Base + def inspect + "Atom<#{value.inspect}>" + end + end + + class Keyword < Base + def self.for(value) + @_keywords ||= {} + + if @_keywords.key?(value) + @_keywords[value] + else + @_keywords[value] = new(value) + end + end + end + + class Number < Base + def +(other) + self.class.new(value + other.value) + end + + def -(other) + self.class.new(value - other.value) + end + + def *(other) + self.class.new(value * other.value) + end + + def /(other) + self.class.new(value / other.value) + end + end + + class Symbol < Base + def self.for(value) + @_symbols ||= {} + + if @_symbols.key?(value) + @_symbols[value] + else + @_symbols[value] = new(value) + end + end + + def inspect + value + end + end + + class Nil < Base + def self.instance + @_instance ||= new(nil) + end + + def inspect + "nil" + end + end + + class True < Base + def self.instance + @_instance ||= new(true) + end + end + + class False < Base + def self.instance + @_instance ||= new(false) + end + end + + class Callable + def initialize(&block) + @fn = block + end + + def call(args = nil) + args = Types::Args.new if args.nil? + raise unless args.is_a?(Types::Args) + @fn.call(*args) + end + + def inspect + raise NotImplementedError, "invalid callable" + end + + def is_mal_fn? + false + end + + def is_macro? + false + end + + def meta + @meta ||= Types::Nil.instance + end + + def meta=(value) + @meta = value + end + end + + class Builtin < Callable + attr_reader :name + + def initialize(name, &block) + @name = name + @fn = block + end + + def inspect + "#" + end + end + + class Function < Callable + attr_reader :ast, :params, :env + + def initialize(ast, params, env, &block) + @ast = ast + @params = params + @env = env + @fn = block + end + + def inspect + "#" + end + + def is_mal_fn? + true + end + + def to_macro + Macro.new(ast, params, env, &@fn) + end + end + + class Macro < Callable + attr_reader :ast, :params, :env + + def initialize(ast, params, env, &block) + @ast = ast + @params = params + @env = env + @fn = block + end + + def inspect + "#" + end + + def is_mal_fn? + true + end + + def is_macro? + true + end + end + end +end diff --git a/impls/ruby/Dockerfile b/impls/ruby/Dockerfile new file mode 100644 index 0000000000..0f03d9acf4 --- /dev/null +++ b/impls/ruby/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin +LABEL org.opencontainers.image.source=https://github.com/kanaka/mal +LABEL org.opencontainers.image.description="mal test container: ruby" + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install ruby diff --git a/impls/ruby/Makefile b/impls/ruby/Makefile new file mode 100644 index 0000000000..13470a4e3d --- /dev/null +++ b/impls/ruby/Makefile @@ -0,0 +1,19 @@ +SOURCES_BASE = mal_readline.rb types.rb reader.rb printer.rb +SOURCES_LISP = env.rb core.rb stepA_mal.rb +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.rb mal + +mal.rb: $(SOURCES) + cat $+ | grep -v "^require_relative" > $@ + +mal: mal.rb + echo "#!/usr/bin/env ruby" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.rb mal diff --git a/impls/ruby/core.rb b/impls/ruby/core.rb new file mode 100644 index 0000000000..4322df0162 --- /dev/null +++ b/impls/ruby/core.rb @@ -0,0 +1,73 @@ +require "readline" +require_relative "reader" +require_relative "printer" + +$core_ns = { + :"=" => lambda {|a,b| a == b}, + :throw => lambda {|a| raise MalException.new(a), "Mal Exception"}, + :nil? => lambda {|a| a == nil}, + :true? => lambda {|a| a == true}, + :false? => lambda {|a| a == false}, + :string? => lambda {|a| (a.is_a? String) && "\u029e" != a[0]}, + :symbol => lambda {|a| a.to_sym}, + :symbol? => lambda {|a| a.is_a? Symbol}, + :keyword => lambda {|a| (a.is_a? String) && "\u029e" == a[0] ? a : "\u029e"+a}, + :keyword? => lambda {|a| (a.is_a? String) && "\u029e" == a[0]}, + :number? => lambda {|a| a.is_a? Numeric}, + :fn? => lambda {|a| (a.is_a? Proc) && (!(a.is_a? Function) || !a.is_macro)}, + :macro? => lambda {|a| (a.is_a? Function) && a.is_macro}, + + :"pr-str" => lambda {|*a| a.map {|e| _pr_str(e, true)}.join(" ")}, + :str => lambda {|*a| a.map {|e| _pr_str(e, false)}.join("")}, + :prn => lambda {|*a| puts(a.map {|e| _pr_str(e, true)}.join(" "))}, + :println => lambda {|*a| puts(a.map {|e| _pr_str(e, false)}.join(" "))}, + :readline => lambda {|a| Readline.readline(a,true)}, + :"read-string" => lambda {|a| read_str(a)}, + :slurp => lambda {|a| File.read(a)}, + :< => lambda {|a,b| a < b}, + :<= => lambda {|a,b| a <= b}, + :> => lambda {|a,b| a > b}, + :>= => lambda {|a,b| a >= b}, + :+ => lambda {|a,b| a + b}, + :- => lambda {|a,b| a - b}, + :* => lambda {|a,b| a * b}, + :/ => lambda {|a,b| a / b}, + :"time-ms" => lambda {|| (Time.now.to_f * 1000).to_i}, + + :list => lambda {|*a| List.new a}, + :list? => lambda {|*a| a[0].is_a? List}, + :vector => lambda {|*a| Vector.new a}, + :vector? => lambda {|*a| a[0].is_a? Vector}, + :"hash-map" =>lambda {|*a| Hash[a.each_slice(2).to_a]}, + :map? => lambda {|a| a.is_a? Hash}, + :assoc => lambda {|*a| a[0].merge(Hash[a.drop(1).each_slice(2).to_a])}, + :dissoc => lambda {|*a| h = a[0].clone; a.drop(1).each{|k| h.delete k}; h}, + :get => lambda {|a,b| return nil if a == nil; a[b]}, + :contains? => lambda {|a,b| a.key? b}, + :keys => lambda {|a| List.new a.keys}, + :vals => lambda {|a| List.new a.values}, + + :sequential? => lambda {|a| sequential?(a)}, + :vec => lambda {|a| Vector.new a}, + :cons => lambda {|a,b| List.new(b.clone.insert(0,a))}, + :concat => lambda {|*a| List.new(a && a.reduce(:+) || [])}, + :nth => lambda {|a,b| raise "nth: index out of range" if b >= a.size; a[b]}, + :first => lambda {|a| a.nil? ? nil : a[0]}, + :rest => lambda {|a| List.new(a.nil? || a.size == 0 ? [] : a.drop(1))}, + :empty? => lambda {|a| a.size == 0}, + :count => lambda {|a| return 0 if a == nil; a.size}, + :apply => lambda {|*a| a[0][*a[1..-2].concat(a[-1])]}, + :map => lambda {|a,b| List.new(b.map {|e| a[e]})}, + + :conj => lambda {|*a| a[0].clone.conj(a.drop(1))}, + :seq => lambda {|a| a.nil? ? nil : a.size == 0 ? nil : a.seq}, + + :"with-meta" => lambda {|a,b| x = a.clone; x.meta = b; x}, + :meta => lambda {|a| a.meta}, + :atom => lambda {|a| Atom.new(a)}, + :atom? => lambda {|a| a.is_a? Atom}, + :deref => lambda {|a| a.val}, + :reset! => lambda {|a,b| a.val = b}, + :swap! => lambda {|*a| a[0].val = a[1][*[a[0].val].concat(a.drop(2))]}, +} + diff --git a/impls/ruby/env.rb b/impls/ruby/env.rb new file mode 100644 index 0000000000..b3f6c43328 --- /dev/null +++ b/impls/ruby/env.rb @@ -0,0 +1,43 @@ +class Env + attr_accessor :data + def initialize(outer=nil, binds=[], exprs=[]) + @data = {} + @outer = outer + binds.each_index do |i| + if binds[i] == :"&" + data[binds[i+1]] = List.new exprs.drop(i) + break + else + data[binds[i]] = exprs[i] + end + end + return self + end + + def find(key) + if @data.key? key + return self + elsif @outer + return @outer.find(key) + else + return nil + end + end + + def set(key, value) + @data[key] = value + return value + end + + def get(key) + env = find(key) + raise "'" + key.to_s + "' not found" if not env + env.data[key] + end + + def get_or_nil(key) + env = find(key) + return nil if not env + env.data[key] + end +end diff --git a/impls/ruby/mal_readline.rb b/impls/ruby/mal_readline.rb new file mode 100644 index 0000000000..89b6777892 --- /dev/null +++ b/impls/ruby/mal_readline.rb @@ -0,0 +1,22 @@ +require "readline" + +$history_loaded = false +$histfile = "#{ENV['HOME']}/.mal-history" + +def _readline(prompt) + if !$history_loaded && File.exist?($histfile) + $history_loaded = true + if File.readable?($histfile) + File.readlines($histfile).each {|l| Readline::HISTORY.push(l.chomp)} + end + end + + if line = Readline.readline(prompt, true) + if File.writable?($histfile) + File.open($histfile, 'a+') {|f| f.write(line+"\n")} + end + return line + else + return nil + end +end diff --git a/ruby/printer.rb b/impls/ruby/printer.rb similarity index 100% rename from ruby/printer.rb rename to impls/ruby/printer.rb diff --git a/impls/ruby/reader.rb b/impls/ruby/reader.rb new file mode 100644 index 0000000000..bc87be4fae --- /dev/null +++ b/impls/ruby/reader.rb @@ -0,0 +1,86 @@ +require_relative "types" + +class Reader + def initialize(tokens) + @position = 0 + @tokens = tokens + end + def peek + return @tokens[@position] + end + def next + @position += 1 + return @tokens[@position-1] + end +end + + +def tokenize(str) + re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ + return str.scan(re).map{|m| m[0]}.select{ |t| + t != "" && t[0..0] != ";" + } +end + +def parse_str(t) # trim and unescape + return t[1..-2].gsub(/\\./, {"\\\\" => "\\", "\\n" => "\n", "\\\"" => '"'}) +end + +def read_atom(rdr) + token = rdr.next + return case token + when /^-?[0-9]+$/ then token.to_i # integer + when /^-?[0-9][0-9.]*$/ then token.to_f # float + when /^"(?:\\.|[^\\"])*"$/ then parse_str(token) # string + when /^"/ then raise "expected '\"', got EOF" + when /^:/ then "\u029e" + token[1..-1] # keyword + when "nil" then nil + when "true" then true + when "false" then false + else token.to_sym # symbol + end +end + +def read_list(rdr, klass, start="(", last =")") + ast = klass.new + token = rdr.next() + if token != start + raise "expected '" + start + "'" + end + while (token = rdr.peek) != last + if not token + raise "expected '" + last + "', got EOF" + end + ast.push(read_form(rdr)) + end + rdr.next + return ast +end + +def read_form(rdr) + return case rdr.peek + when ";" then nil + when "'" then rdr.next; List.new [:quote, read_form(rdr)] + when "`" then rdr.next; List.new [:quasiquote, read_form(rdr)] + when "~" then rdr.next; List.new [:unquote, read_form(rdr)] + when "~@" then rdr.next; List.new [:"splice-unquote", read_form(rdr)] + when "^" then rdr.next; meta = read_form(rdr); + List.new [:"with-meta", read_form(rdr), meta] + when "@" then rdr.next; List.new [:deref, read_form(rdr)] + + when "(" then read_list(rdr, List, "(", ")") + when ")" then raise "unexpected ')'" + when "[" then read_list(rdr, Vector, "[", "]") + when "]" then raise "unexpected ']'" + when "{" then Hash[read_list(rdr, List, "{", "}").each_slice(2).to_a] + when "}" then raise "unexpected '}'" + else read_atom(rdr) + end +end + +def read_str(str) + tokens = tokenize(str) + return nil if tokens.size == 0 + return read_form(Reader.new(tokens)) +end + diff --git a/impls/ruby/run b/impls/ruby/run new file mode 100755 index 0000000000..980db0d659 --- /dev/null +++ b/impls/ruby/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec ruby $(dirname $0)/${STEP:-stepA_mal}.rb "${@}" diff --git a/ruby/step0_repl.rb b/impls/ruby/step0_repl.rb similarity index 100% rename from ruby/step0_repl.rb rename to impls/ruby/step0_repl.rb diff --git a/ruby/step1_read_print.rb b/impls/ruby/step1_read_print.rb similarity index 100% rename from ruby/step1_read_print.rb rename to impls/ruby/step1_read_print.rb diff --git a/impls/ruby/step2_eval.rb b/impls/ruby/step2_eval.rb new file mode 100644 index 0000000000..95a2fedd6a --- /dev/null +++ b/impls/ruby/step2_eval.rb @@ -0,0 +1,60 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" + +# read +def READ(str) + return read_str(str) +end + +# eval +def EVAL(ast, env) + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast + in Symbol + raise "'" + ast.to_s + "' not found" if not env.key? ast + return env[ast] + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] + + else # Empty list or scalar + return ast + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = {} +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +repl_env[:+] = lambda {|a,b| a + b} +repl_env[:-] = lambda {|a,b| a - b} +repl_env[:*] = lambda {|a,b| a * b} +repl_env[:/] = lambda {|a,b| a / b} + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace.join("\n\t")}" + end +end diff --git a/impls/ruby/step3_env.rb b/impls/ruby/step3_env.rb new file mode 100644 index 0000000000..69f80cdf80 --- /dev/null +++ b/impls/ruby/step3_env.rb @@ -0,0 +1,70 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" + +# read +def READ(str) + return read_str(str) +end + +# eval +def EVAL(ast, env) + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + return EVAL(a2, let_env) + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] + + else # Empty list or scalar + return ast + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +repl_env.set(:+, lambda {|a,b| a + b}) +repl_env.set(:-, lambda {|a,b| a - b}) +repl_env.set(:*, lambda {|a,b| a * b}) +repl_env.set(:/, lambda {|a,b| a / b}) + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace.join("\n\t")}" + end +end diff --git a/impls/ruby/step4_if_fn_do.rb b/impls/ruby/step4_if_fn_do.rb new file mode 100644 index 0000000000..af8e7c5666 --- /dev/null +++ b/impls/ruby/step4_if_fn_do.rb @@ -0,0 +1,87 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" +require_relative "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def EVAL(ast, env) + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + return EVAL(a2, let_env) + in [:do, *] + ast[1..-2].map{|a| EVAL(a, env)} + return EVAL(ast.last, env) + in [:if, a1, a2, *] + cond = EVAL(a1, env) + if cond + return EVAL(a2, env) + else + return EVAL(ast[3], env) + end + in :"fn*", a1, a2 + return lambda {|*args| + EVAL(a2, Env.new(env, a1, List.new(args))) + } + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] + + else # Empty list or scalar + return ast + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end + +# core.mal: defined using the language itself +RE["(def! not (fn* (a) (if a false true)))"] + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace.join("\n\t")}" + end +end diff --git a/impls/ruby/step5_tco.rb b/impls/ruby/step5_tco.rb new file mode 100644 index 0000000000..32114c151e --- /dev/null +++ b/impls/ruby/step5_tco.rb @@ -0,0 +1,98 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" +require_relative "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + in [:do, *] + ast[1..-2].map{|a| EVAL(a, env)} + ast = ast.last # Continue loop (TCO) + in [:if, a1, a2, *] + cond = EVAL(a1, env) + if cond + ast = a2 # Continue loop (TCO) + else + ast = ast[3] # Continue loop (TCO) + end + in :"fn*", a1, a2 + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, List.new(args))) + } + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + if f.class == Function + ast = f.ast + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) + else + return f[*args.map{|a| EVAL(a, env)}] + end + + else # Empty list or scalar + return ast + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end + +# core.mal: defined using the language itself +RE["(def! not (fn* (a) (if a false true)))"] + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace[0..100].join("\n\t")}" + end +end diff --git a/impls/ruby/step6_file.rb b/impls/ruby/step6_file.rb new file mode 100644 index 0000000000..4bd5af33cf --- /dev/null +++ b/impls/ruby/step6_file.rb @@ -0,0 +1,106 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" +require_relative "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + in [:do, *] + ast[1..-2].map{|a| EVAL(a, env)} + ast = ast.last # Continue loop (TCO) + in [:if, a1, a2, *] + cond = EVAL(a1, env) + if cond + ast = a2 # Continue loop (TCO) + else + ast = ast[3] # Continue loop (TCO) + end + in :"fn*", a1, a2 + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, List.new(args))) + } + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + if f.class == Function + ast = f.ast + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) + else + return f[*args.map{|a| EVAL(a, env)}] + end + + else # Empty list or scalar + return ast + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end +repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) +repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) + +# core.mal: defined using the language itself +RE["(def! not (fn* (a) (if a false true)))"] +RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] + +if ARGV.size > 0 + RE["(load-file \"" + ARGV[0] + "\")"] + exit 0 +end + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace[0..100].join("\n\t")}" + end +end diff --git a/impls/ruby/step7_quote.rb b/impls/ruby/step7_quote.rb new file mode 100644 index 0000000000..d97fba2fe2 --- /dev/null +++ b/impls/ruby/step7_quote.rb @@ -0,0 +1,139 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" +require_relative "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if elt in List[:"splice-unquote", quoted] + acc = List.new [:concat, quoted, acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc +end + +def quasiquote(ast) + case ast + when List + if ast in List[:unquote, quoted] # ↠fixed pattern + quoted + else + qq_loop(ast) + end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash, Symbol + List.new [:quote, ast] + else + ast + end +end + +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + in :quote, a1 + return a1 + in :quasiquote, a1 + ast = quasiquote(a1); # Continue loop (TCO) + in [:do, *] + ast[1..-2].map{|a| EVAL(a, env)} + ast = ast.last # Continue loop (TCO) + in [:if, a1, a2, *] + cond = EVAL(a1, env) + if cond + ast = a2 # Continue loop (TCO) + else + ast = ast[3] # Continue loop (TCO) + end + in :"fn*", a1, a2 + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, List.new(args))) + } + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + if f.class == Function + ast = f.ast + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) + else + return f[*args.map{|a| EVAL(a, env)}] + end + + else # Empty list or scalar + return ast + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end +repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) +repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) + +# core.mal: defined using the language itself +RE["(def! not (fn* (a) (if a false true)))"] +RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] + +if ARGV.size > 0 + RE["(load-file \"" + ARGV[0] + "\")"] + exit 0 +end + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace[0..100].join("\n\t")}" + end +end diff --git a/impls/ruby/step8_macros.rb b/impls/ruby/step8_macros.rb new file mode 100644 index 0000000000..04485ca5ee --- /dev/null +++ b/impls/ruby/step8_macros.rb @@ -0,0 +1,148 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" +require_relative "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if elt in List[:"splice-unquote", quoted] + acc = List.new [:concat, quoted, acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc +end + +def quasiquote(ast) + case ast + when List + if ast in List[:unquote, quoted] # ↠fixed pattern + quoted + else + qq_loop(ast) + end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash, Symbol + List.new [:quote, ast] + else + ast + end +end + +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + in :quote, a1 + return a1 + in :quasiquote, a1 + ast = quasiquote(a1); # Continue loop (TCO) + in :defmacro!, a1, a2 + func = EVAL(a2, env).clone + func.is_macro = true + return env.set(a1, func) + in [:do, *] + ast[1..-2].map{|a| EVAL(a, env)} + ast = ast.last # Continue loop (TCO) + in [:if, a1, a2, *] + cond = EVAL(a1, env) + if cond + ast = a2 # Continue loop (TCO) + else + ast = ast[3] # Continue loop (TCO) + end + in :"fn*", a1, a2 + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, List.new(args))) + } + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + if f.class == Function + if f.is_macro + ast = f[*args] + next # Continue loop (TCO) + end + ast = f.ast + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) + else + return f[*args.map{|a| EVAL(a, env)}] + end + + else # Empty list or scalar + return ast + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end +repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) +repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) + +# core.mal: defined using the language itself +RE["(def! not (fn* (a) (if a false true)))"] +RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] +RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] + +if ARGV.size > 0 + RE["(load-file \"" + ARGV[0] + "\")"] + exit 0 +end + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + puts "Error: #{e}" + puts "\t#{e.backtrace[0..100].join("\n\t")}" + end +end diff --git a/impls/ruby/step9_try.rb b/impls/ruby/step9_try.rb new file mode 100644 index 0000000000..e615bd5405 --- /dev/null +++ b/impls/ruby/step9_try.rb @@ -0,0 +1,166 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" +require_relative "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if elt in List[:"splice-unquote", quoted] + acc = List.new [:concat, quoted, acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc +end + +def quasiquote(ast) + case ast + when List + if ast in List[:unquote, quoted] # ↠fixed pattern + quoted + else + qq_loop(ast) + end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash, Symbol + List.new [:quote, ast] + else + ast + end +end + +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + in :quote, a1 + return a1 + in :quasiquote, a1 + ast = quasiquote(a1); # Continue loop (TCO) + in :defmacro!, a1, a2 + func = EVAL(a2, env).clone + func.is_macro = true + return env.set(a1, func) + in [:"try*", a1, [:"catch*", key, handler]] + begin + return EVAL(a1, env) + rescue Exception => exc + if exc.is_a? MalException + exc = exc.data + else + exc = exc.message + end + ast = handler + env = Env.new(env, [key], [exc]) # Continue loop (TCO) + end + in [:"try*", a1] + ast = a1 # Continue loop (TCO) + in [:do, *] + ast[1..-2].map{|a| EVAL(a, env)} + ast = ast.last # Continue loop (TCO) + in [:if, a1, a2, *] + cond = EVAL(a1, env) + if cond + ast = a2 # Continue loop (TCO) + else + ast = ast[3] # Continue loop (TCO) + end + in :"fn*", a1, a2 + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, List.new(args))) + } + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + if f.class == Function + if f.is_macro + ast = f[*args] + next # Continue loop (TCO) + end + ast = f.ast + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) + else + return f[*args.map{|a| EVAL(a, env)}] + end + + else # Empty list or scalar + return ast + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end +repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) +repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) + +# core.mal: defined using the language itself +RE["(def! not (fn* (a) (if a false true)))"] +RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] +RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] + +if ARGV.size > 0 + RE["(load-file \"" + ARGV[0] + "\")"] + exit 0 +end + +# repl loop +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + if e.is_a? MalException + puts "Error: #{_pr_str(e.data, true)}" + else + puts "Error: #{e}" + end + puts "\t#{e.backtrace[0..100].join("\n\t")}" + end +end diff --git a/impls/ruby/stepA_mal.rb b/impls/ruby/stepA_mal.rb new file mode 100644 index 0000000000..3c33d025cc --- /dev/null +++ b/impls/ruby/stepA_mal.rb @@ -0,0 +1,174 @@ +require_relative "mal_readline" +require_relative "types" +require_relative "reader" +require_relative "printer" +require_relative "env" +require_relative "core" + +# read +def READ(str) + return read_str(str) +end + +# eval +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if elt in List[:"splice-unquote", quoted] + acc = List.new [:concat, quoted, acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc +end + +def quasiquote(ast) + case ast + when List + if ast in List[:unquote, quoted] # ↠fixed pattern + quoted + else + qq_loop(ast) + end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash, Symbol + List.new [:quote, ast] + else + ast + end +end + +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + case ast + in Symbol + return env.get(ast) + in Vector + return Vector.new ast.map{|a| EVAL(a, env)} + in Hash + new_hm = {} + ast.each{|k,v| new_hm[k] = EVAL(v, env)} + return new_hm + + # apply list + + in :def!, a1, a2 + return env.set(a1, EVAL(a2, env)) + in :"let*", a1, a2 + let_env = Env.new(env) + a1.each_slice(2) do |a,e| + let_env.set(a, EVAL(e, let_env)) + end + env = let_env + ast = a2 # Continue loop (TCO) + in :quote, a1 + return a1 + in :quasiquote, a1 + ast = quasiquote(a1); # Continue loop (TCO) + in :defmacro!, a1, a2 + func = EVAL(a2, env).clone + func.is_macro = true + return env.set(a1, func) + in :"rb*", a1 + res = eval(a1) + return case res + when Array; List.new res + else; res + end + in [:"try*", a1, [:"catch*", key, handler]] + begin + return EVAL(a1, env) + rescue Exception => exc + if exc.is_a? MalException + exc = exc.data + else + exc = exc.message + end + ast = handler + env = Env.new(env, [key], [exc]) # Continue loop (TCO) + end + in [:"try*", a1] + ast = a1 # Continue loop (TCO) + in [:do, *] + ast[1..-2].map{|a| EVAL(a, env)} + ast = ast.last # Continue loop (TCO) + in [:if, a1, a2, *] + cond = EVAL(a1, env) + if cond + ast = a2 # Continue loop (TCO) + else + ast = ast[3] # Continue loop (TCO) + end + in :"fn*", a1, a2 + return Function.new(a2, env, a1) {|*args| + EVAL(a2, Env.new(env, a1, List.new(args))) + } + in [a0, *] + f = EVAL(a0, env) + args = ast.drop(1) + if f.class == Function + if f.is_macro + ast = f[*args] + next # Continue loop (TCO) + end + ast = f.ast + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) + else + return f[*args.map{|a| EVAL(a, env)}] + end + + else # Empty list or scalar + return ast + end + + end +end + +# print +def PRINT(exp) + return _pr_str(exp, true) +end + +# repl +repl_env = Env.new +RE = lambda {|str| EVAL(READ(str), repl_env) } +REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } + +# core.rb: defined using ruby +$core_ns.each do |k,v| repl_env.set(k,v) end +repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) +repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) + +# core.mal: defined using the language itself +RE["(def! *host-language* \"ruby\")"] +RE["(def! not (fn* (a) (if a false true)))"] +RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] +RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] + +if ARGV.size > 0 + RE["(load-file \"" + ARGV[0] + "\")"] + exit 0 +end + +# repl loop +RE["(println (str \"Mal [\" *host-language* \"]\"))"] +while line = _readline("user> ") + begin + puts REP[line] + rescue Exception => e + if e.is_a? MalException + puts "Error: #{_pr_str(e.data, true)}" + else + puts "Error: #{e}" + end + puts "\t#{e.backtrace[0..100].join("\n\t")}" + end +end diff --git a/impls/ruby/tests/step5_tco.mal b/impls/ruby/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/ruby/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/ruby/tests/stepA_mal.mal b/impls/ruby/tests/stepA_mal.mal new file mode 100644 index 0000000000..79cca1984b --- /dev/null +++ b/impls/ruby/tests/stepA_mal.mal @@ -0,0 +1,27 @@ +;; Testing basic ruby interop + +(rb* "7") +;=>7 + +(rb* "'7'") +;=>"7" + +(rb* "[7,8,9]") +;=>(7 8 9) + +(rb* "{\"abc\" => 789}") +;=>{"abc" 789} + +(rb* "print 'hello\n'") +;/hello +;=>nil + +(rb* "$foo=8;") +(rb* "$foo") +;=>8 + +(rb* "['a','b','c'].map{|x| 'X'+x+'Y'}.join(' ')") +;=>"XaY XbY XcY" + +(rb* "[1,2,3].map{|x| 1+x}") +;=>(2 3 4) diff --git a/impls/ruby/types.rb b/impls/ruby/types.rb new file mode 100644 index 0000000000..23f7d9b841 --- /dev/null +++ b/impls/ruby/types.rb @@ -0,0 +1,75 @@ +require_relative "env" + +class MalException < StandardError + attr_reader :data + def initialize(data) + @data = data + end +end + +class String # re-open and add seq + def seq() + return List.new self.split("") + end +end + +class List < Array + attr_accessor :meta + def conj(xs) + xs.each{|x| self.unshift(x)} + return self + end + def seq() + return self + end +end + +class Vector < Array + attr_accessor :meta + def conj(xs) + self.push(*xs) + return self + end + def seq() + return List.new self + end +end + +class Hash # re-open and add meta + attr_accessor :meta +end + +def sequential?(obj) + return obj.is_a?(List) || obj.is_a?(Vector) +end + +class Proc # re-open and add meta + attr_accessor :meta +end + +class Function < Proc + attr_accessor :ast + attr_accessor :env + attr_accessor :params + attr_accessor :is_macro + + def initialize(ast=nil, env=nil, params=nil, &block) + super() + @ast = ast + @env = env + @params = params + @is_macro = false + end + + def gen_env(args) + return Env.new(@env, @params, args) + end +end + +class Atom + attr_accessor :meta + attr_accessor :val + def initialize(val) + @val = val + end +end diff --git a/impls/rust/.gitignore b/impls/rust/.gitignore new file mode 100644 index 0000000000..9fe342cbf4 --- /dev/null +++ b/impls/rust/.gitignore @@ -0,0 +1 @@ +./target diff --git a/impls/rust/Cargo.toml b/impls/rust/Cargo.toml new file mode 100644 index 0000000000..ff79075001 --- /dev/null +++ b/impls/rust/Cargo.toml @@ -0,0 +1,56 @@ +[package] +name = "rust2" +version = "0.1.0" +authors = ["root"] + +[dependencies] +rustyline = "14.0" + +regex = "1.7" +itertools = "0.13" +fnv = "1.0.6" + + +[[bin]] +name = "step0_repl" +path = "step0_repl.rs" + +[[bin]] +name = "step1_read_print" +path = "step1_read_print.rs" + +[[bin]] +name = "step2_eval" +path = "step2_eval.rs" + +[[bin]] +name = "step3_env" +path = "step3_env.rs" + +[[bin]] +name = "step4_if_fn_do" +path = "step4_if_fn_do.rs" + +[[bin]] +name = "step5_tco" +path = "step5_tco.rs" + +[[bin]] +name = "step6_file" +path = "step6_file.rs" + +[[bin]] +name = "step7_quote" +path = "step7_quote.rs" + +[[bin]] +name = "step8_macros" +path = "step8_macros.rs" + +[[bin]] +name = "step9_try" +path = "step9_try.rs" + +[[bin]] +name = "stepA_mal" +path = "stepA_mal.rs" diff --git a/impls/rust/Dockerfile b/impls/rust/Dockerfile new file mode 100644 index 0000000000..9719af7b5d --- /dev/null +++ b/impls/rust/Dockerfile @@ -0,0 +1,29 @@ +FROM ubuntu:25.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install cargo \ + librust-fnv-dev \ + librust-itertools-dev \ + librust-regex-dev \ + librust-rustyline-dev \ + rust-clippy rustfmt + +ENV CARGO_HOME /mal diff --git a/impls/rust/Makefile b/impls/rust/Makefile new file mode 100644 index 0000000000..8dab30f396 --- /dev/null +++ b/impls/rust/Makefile @@ -0,0 +1,35 @@ + +EXEC_DIR := target/release + +UPPER_STEPS := $(EXEC_DIR)/step4_if_fn_do \ + $(EXEC_DIR)/step5_tco \ + $(EXEC_DIR)/step6_file \ + $(EXEC_DIR)/step7_quote \ + $(EXEC_DIR)/step8_macros \ + $(EXEC_DIR)/step9_try \ + $(EXEC_DIR)/stepA_mal +STEP0 := $(EXEC_DIR)/step0_repl +STEP1-2 := $(EXEC_DIR)/step1_read_print \ + $(EXEC_DIR)/step2_eval +STEP3 := $(EXEC_DIR)/step3_env +STEPS := $(STEP0) $(STEP1-2) $(STEP3) $(UPPER_STEPS) + +all: $(STEPS) + +$(STEPS): $(EXEC_DIR)/%: %.rs + cargo build --release --bin $* + +$(STEPS): readline.rs +$(STEP1-2) $(STEP3) $(UPPER_STEPS): types.rs reader.rs printer.rs +$(STEP3) $(UPPER_STEPS): env.rs +$(UPPER_STEPS): core.rs + +lint: + rustfmt *.rs + cargo clippy + +.PHONY: clean lint all + +clean: + rm -fr target/ + rm -f .mal-history *~ Cargo.lock diff --git a/impls/rust/core.rs b/impls/rust/core.rs new file mode 100644 index 0000000000..4891035cbd --- /dev/null +++ b/impls/rust/core.rs @@ -0,0 +1,403 @@ +use std::fs::File; +use std::io::Read; +use std::rc::Rc; +use std::time::{SystemTime, UNIX_EPOCH}; + +use crate::printer::pr_seq; +use crate::reader::read_str; +use crate::types::MalVal::{ + Atom, Bool, Func, Hash, Int, Kwd, List, MalFunc, Nil, Str, Sym, Vector, +}; +use crate::types::{ + list, FuncStruct, MalArgs, MalRet, MalVal, _assoc, error, func, hash_map, unwrap_map_key, + vector, wrap_map_key, +}; +use readline; + +macro_rules! fn_t_int_int { + ($ret:ident, $fn:expr) => {{ + |a: MalArgs| match (&a[0], &a[1]) { + (Int(a0), Int(a1)) => Ok($ret($fn(a0, a1))), + _ => error("expecting (int,int) args"), + } + }}; +} + +macro_rules! fn_is_type { + ($($ps:pat),*) => {{ + |a:MalArgs| { Ok(Bool(match a[0] { $($ps => true,)* _ => false})) } + }}; + ($p:pat if $e:expr) => {{ + |a:MalArgs| { Ok(Bool(match a[0] { $p if $e => true, _ => false})) } + }}; + ($p:pat if $e:expr,$($ps:pat),*) => {{ + |a:MalArgs| { Ok(Bool(match a[0] { $p if $e => true, $($ps => true,)* _ => false})) } + }}; +} + +macro_rules! fn_str { + ($fn:expr) => {{ + |a: MalArgs| match &a[0] { + Str(a0) => $fn(&a0), + _ => error("expecting (str) arg"), + } + }}; +} + +fn symbol(a: MalArgs) -> MalRet { + match a[0] { + Str(ref s) => Ok(Sym(s.to_string())), + _ => error("illegal symbol call"), + } +} + +fn readline(p: &str) -> MalRet { + match readline::readline(p) { + Some(s) => Ok(Str(s)), + None => Ok(Nil), + } +} + +fn slurp(f: &str) -> MalRet { + let mut s = String::new(); + match File::open(f).and_then(|mut f| f.read_to_string(&mut s)) { + Ok(_) => Ok(Str(s)), + Err(e) => error(&e.to_string()), + } +} + +fn time_ms(_a: MalArgs) -> MalRet { + let ms_e = match SystemTime::now().duration_since(UNIX_EPOCH) { + Ok(d) => d, + Err(e) => return error(&format!("{:?}", e)), + }; + Ok(Int( + ms_e.as_secs() as i64 * 1000 + ms_e.subsec_nanos() as i64 / 1_000_000 + )) +} + +fn get(a: MalArgs) -> MalRet { + match a[0] { + Nil => Ok(Nil), + Hash(ref hm, _) => match hm.get(&wrap_map_key(&a[1])?) { + Some(mv) => Ok(mv.clone()), + None => Ok(Nil), + }, + _ => error("illegal get args"), + } +} + +fn assoc(a: MalArgs) -> MalRet { + match a[0] { + Hash(ref hm, _) => _assoc((**hm).clone(), a[1..].to_vec()), + _ => error("assoc on non-Hash Map"), + } +} + +fn dissoc(a: MalArgs) -> MalRet { + match a[0] { + Hash(ref hm, _) => { + let mut new_hm = (**hm).clone(); + for k in a[1..].iter() { + let _ = new_hm.remove(&wrap_map_key(k)?); + } + Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) + } + _ => error("dissoc on non-Hash Map"), + } +} + +fn contains_q(a: MalArgs) -> MalRet { + match a[0] { + Hash(ref hm, _) => Ok(Bool(hm.contains_key(&wrap_map_key(&a[1])?))), + _ => error("illegal get args"), + } +} + +fn keys(a: MalArgs) -> MalRet { + match a[0] { + Hash(ref hm, _) => Ok(list(hm.keys().map(|k| unwrap_map_key(k)).collect())), + _ => error("keys requires Hash Map"), + } +} + +fn vals(a: MalArgs) -> MalRet { + match a[0] { + Hash(ref hm, _) => Ok(list(hm.values().cloned().collect())), + _ => error("vals requires Hash Map"), + } +} + +fn vec(a: MalArgs) -> MalRet { + match a[0] { + List(ref v, _) => Ok(Vector(v.clone(), Rc::new(Nil))), + Vector(_, _) => Ok(a[0].clone()), + _ => error("non-seq passed to vec"), + } +} + +fn cons(a: MalArgs) -> MalRet { + match &a[1] { + List(v, _) | Vector(v, _) => { + let mut new_v = vec![a[0].clone()]; + new_v.extend_from_slice(v); + Ok(list(new_v)) + } + _ => error("cons expects seq as second arg"), + } +} + +fn concat(a: MalArgs) -> MalRet { + let mut new_v = vec![]; + for seq in a.iter() { + match seq { + List(v, _) | Vector(v, _) => new_v.extend_from_slice(v), + _ => return error("non-seq passed to concat"), + } + } + Ok(list(new_v)) +} + +fn nth(a: MalArgs) -> MalRet { + match (&a[0], &a[1]) { + (List(seq, _) | Vector(seq, _), Int(idx)) => match seq.get(*idx as usize) { + Some(result) => Ok(result.clone()), + None => error("nth: index out of range"), + }, + _ => error("invalid args to nth"), + } +} + +fn first(a: MalArgs) -> MalRet { + match a[0] { + List(ref seq, _) | Vector(ref seq, _) if seq.len() > 0 => Ok(seq[0].clone()), + List(_, _) | Vector(_, _) | Nil => Ok(Nil), + _ => error("invalid args to first"), + } +} + +fn rest(a: MalArgs) -> MalRet { + match a[0] { + List(ref seq, _) | Vector(ref seq, _) if seq.len() > 1 => Ok(list(seq[1..].to_vec())), + List(_, _) | Vector(_, _) | Nil => Ok(list!()), + _ => error("invalid args to first"), + } +} + +fn apply(a: MalArgs) -> MalRet { + match a[a.len() - 1] { + List(ref v, _) | Vector(ref v, _) => { + let f = &a[0]; + let mut fargs = a[1..a.len() - 1].to_vec(); + fargs.extend_from_slice(v); + f.apply(fargs) + } + _ => error("apply called with non-seq"), + } +} + +fn map(a: MalArgs) -> MalRet { + match a[1] { + List(ref v, _) | Vector(ref v, _) => { + let mut res = vec![]; + for mv in v.iter() { + res.push(a[0].apply(vec![mv.clone()])?) + } + Ok(list(res)) + } + _ => error("map called with non-seq"), + } +} + +fn conj(a: MalArgs) -> MalRet { + match a[0] { + List(ref v, _) => { + let sl = a[1..].iter().rev().cloned().collect::>(); + Ok(list([&sl[..], v].concat())) + } + Vector(ref v, _) => Ok(vector([v, &a[1..]].concat())), + _ => error("conj: called with non-seq"), + } +} + +fn seq(a: MalArgs) -> MalRet { + match a[0] { + ref l @ List(ref v, _) if v.len() > 0 => Ok(l.clone()), + Vector(ref v, _) if v.len() > 0 => Ok(list(v.to_vec())), + Str(ref s) if !s.is_empty() => Ok(list(s.chars().map(|c| Str(c.to_string())).collect())), + List(_, _) | Vector(_, _) | Str(_) | Nil => Ok(Nil), + _ => error("seq: called with non-seq"), + } +} + +fn keyword(a: MalArgs) -> MalRet { + match a[0] { + Kwd(_) => Ok(a[0].clone()), + Str(ref s) => Ok(Kwd(String::from(s))), + _ => error("invalid type for keyword"), + } +} + +pub fn empty_q(a: MalArgs) -> MalRet { + match a[0] { + List(ref l, _) | Vector(ref l, _) => Ok(Bool(l.len() == 0)), + Nil => Ok(Bool(true)), + _ => error("invalid type for empty?"), + } +} + +pub fn count(a: MalArgs) -> MalRet { + match a[0] { + List(ref l, _) | Vector(ref l, _) => Ok(Int(l.len() as i64)), + Nil => Ok(Int(0)), + _ => error("invalid type for count"), + } +} + +pub fn atom(a: MalArgs) -> MalRet { + Ok(Atom(Rc::new(std::cell::RefCell::new(a[0].clone())))) +} + +pub fn deref(a: MalArgs) -> MalRet { + match a[0] { + Atom(ref a) => Ok(a.borrow().clone()), + _ => error("attempt to deref a non-Atom"), + } +} + +pub fn reset_bang(a: MalArgs) -> MalRet { + match a[0] { + Atom(ref atm) => { + *atm.borrow_mut() = a[1].clone(); + Ok(a[1].clone()) + } + _ => error("attempt to reset! a non-Atom"), + } +} + +pub fn swap_bang(a: MalArgs) -> MalRet { + match a[0] { + Atom(ref atm) => { + let mut fargs = a[2..].to_vec(); + fargs.insert(0, atm.borrow().clone()); + let result = a[1].apply(fargs)?; + *atm.borrow_mut() = result.clone(); + Ok(result) + } + _ => error("attempt to swap! a non-Atom"), + } +} + +pub fn get_meta(a: MalArgs) -> MalRet { + match a[0] { + List(_, ref meta) | Vector(_, ref meta) | Hash(_, ref meta) => Ok((**meta).clone()), + Func(_, ref meta) => Ok((**meta).clone()), + MalFunc(FuncStruct { ref meta, .. }) => Ok((**meta).clone()), + _ => error("meta not supported by type"), + } +} + +pub fn with_meta(a: MalArgs) -> MalRet { + let m = Rc::new(a[1].clone()); + match a[0] { + List(ref l, _) => Ok(List(l.clone(), m)), + Vector(ref l, _) => Ok(Vector(l.clone(), m)), + Hash(ref l, _) => Ok(Hash(l.clone(), m)), + Func(ref l, _) => Ok(Func(*l, m)), + MalFunc(ref f @ FuncStruct { .. }) => Ok(MalFunc(FuncStruct { + meta: m, + ..f.clone() + })), + _ => error("with-meta not supported by type"), + } +} + +pub fn ns() -> Vec<(&'static str, MalVal)> { + vec![ + ("=", func(|a| Ok(Bool(a[0] == a[1])))), + ("throw", func(|a| Err(a[0].clone()))), + ("nil?", func(fn_is_type!(Nil))), + ("true?", func(fn_is_type!(Bool(true)))), + ("false?", func(fn_is_type!(Bool(false)))), + ("symbol", func(symbol)), + ("symbol?", func(fn_is_type!(Sym(_)))), + ("string?", func(fn_is_type!(Str(_)))), + ("keyword", func(keyword)), + ("keyword?", func(fn_is_type!(Kwd(_)))), + ("number?", func(fn_is_type!(Int(_)))), + ( + "fn?", + func(fn_is_type!( + MalFunc(FuncStruct { + is_macro: false, + .. + }), + Func(_, _) + )), + ), + ( + "macro?", + func(fn_is_type!(MalFunc(FuncStruct { is_macro: true, .. }))), + ), + ("pr-str", func(|a| Ok(Str(pr_seq(&a, true, "", "", " "))))), + ("str", func(|a| Ok(Str(pr_seq(&a, false, "", "", ""))))), + ( + "prn", + func(|a| { + println!("{}", pr_seq(&a, true, "", "", " ")); + Ok(Nil) + }), + ), + ( + "println", + func(|a| { + println!("{}", pr_seq(&a, false, "", "", " ")); + Ok(Nil) + }), + ), + ("read-string", func(fn_str!(read_str))), + ("readline", func(fn_str!(readline))), + ("slurp", func(fn_str!(slurp))), + ("<", func(fn_t_int_int!(Bool, |i, j| { i < j }))), + ("<=", func(fn_t_int_int!(Bool, |i, j| { i <= j }))), + (">", func(fn_t_int_int!(Bool, |i, j| { i > j }))), + (">=", func(fn_t_int_int!(Bool, |i, j| { i >= j }))), + ("+", func(fn_t_int_int!(Int, |i, j| { i + j }))), + ("-", func(fn_t_int_int!(Int, |i, j| { i - j }))), + ("*", func(fn_t_int_int!(Int, |i, j| { i * j }))), + ("/", func(fn_t_int_int!(Int, |i, j| { i / j }))), + ("time-ms", func(time_ms)), + ("sequential?", func(fn_is_type!(List(_, _), Vector(_, _)))), + ("list", func(|a| Ok(list(a)))), + ("list?", func(fn_is_type!(List(_, _)))), + ("vector", func(|a| Ok(vector(a)))), + ("vector?", func(fn_is_type!(Vector(_, _)))), + ("hash-map", func(hash_map)), + ("map?", func(fn_is_type!(Hash(_, _)))), + ("assoc", func(assoc)), + ("dissoc", func(dissoc)), + ("get", func(get)), + ("contains?", func(contains_q)), + ("keys", func(keys)), + ("vals", func(vals)), + ("vec", func(vec)), + ("cons", func(cons)), + ("concat", func(concat)), + ("empty?", func(empty_q)), + ("nth", func(nth)), + ("first", func(first)), + ("rest", func(rest)), + ("count", func(count)), + ("apply", func(apply)), + ("map", func(map)), + ("conj", func(conj)), + ("seq", func(seq)), + ("meta", func(get_meta)), + ("with-meta", func(with_meta)), + ("atom", func(atom)), + ("atom?", func(fn_is_type!(Atom(_)))), + ("deref", func(deref)), + ("reset!", func(reset_bang)), + ("swap!", func(swap_bang)), + ] +} diff --git a/impls/rust/env.rs b/impls/rust/env.rs new file mode 100644 index 0000000000..2fad179021 --- /dev/null +++ b/impls/rust/env.rs @@ -0,0 +1,73 @@ +use std::cell::RefCell; +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; + +use crate::types::MalVal::{List, Sym, Vector}; +use crate::types::{error, list, MalRet, MalVal}; + +pub struct EnvStruct { + data: RefCell>, + outer: Option, +} + +pub type Env = Rc; + +// TODO: it would be nice to use impl here but it doesn't work on +// a deftype (i.e. Env) + +pub fn env_new(outer: Option) -> Env { + Rc::new(EnvStruct { + data: RefCell::new(FnvHashMap::default()), + outer, + }) +} + +// TODO: mbinds and exprs as & types +pub fn env_bind(outer: Env, mbinds: &MalVal, exprs: Vec) -> Result { + let env = env_new(Some(outer)); + match mbinds { + List(binds, _) | Vector(binds, _) => { + for (i, b) in binds.iter().enumerate() { + match b { + Sym(s) if s == "&" => { + env_set(&env, &binds[i + 1], list(exprs[i..].to_vec()))?; + break; + } + _ => { + env_set(&env, b, exprs[i].clone())?; + } + } + } + Ok(env) + } + _ => error("env_bind binds not List/Vector"), + } +} + +pub fn env_get(env: &Env, key: &str) -> Option { + let mut mut_env = env; + loop { + if let Some(value) = mut_env.data.borrow().get(key) { + return Some(value.clone()); + } else if let Some(outer) = &mut_env.outer { + mut_env = outer; + } else { + return None; + } + } +} + +pub fn env_set(env: &Env, key: &MalVal, val: MalVal) -> MalRet { + match key { + Sym(s) => { + env_sets(env, s, val.clone()); + Ok(val) + } + _ => error("Env.set called with non-Str"), + } +} + +pub fn env_sets(env: &Env, key: &str, val: MalVal) { + env.data.borrow_mut().insert(key.to_string(), val); +} diff --git a/impls/rust/printer.rs b/impls/rust/printer.rs new file mode 100644 index 0000000000..59d5c695fa --- /dev/null +++ b/impls/rust/printer.rs @@ -0,0 +1,56 @@ +use crate::types::MalVal::{ + Atom, Bool, Func, Hash, Int, Kwd, List, MalFunc, Nil, Str, Sym, Vector, +}; +use crate::types::{unwrap_map_key, FuncStruct, MalVal}; + +fn escape_str(s: &str) -> String { + s.chars() + .map(|c| match c { + '"' => "\\\"".to_string(), + '\n' => "\\n".to_string(), + '\\' => "\\\\".to_string(), + _ => c.to_string(), + }) + .collect::>() + .join("") +} + +impl MalVal { + pub fn pr_str(&self, print_readably: bool) -> String { + match self { + Nil => String::from("nil"), + Bool(true) => String::from("true"), + Bool(false) => String::from("false"), + Int(i) => format!("{}", i), + //Float(f) => format!("{}", f), + Kwd(s) => format!(":{}", s), + Str(s) => { + if print_readably { + format!("\"{}\"", escape_str(s)) + } else { + s.clone() + } + } + Sym(s) => s.clone(), + List(l, _) => pr_seq(l, print_readably, "(", ")", " "), + Vector(l, _) => pr_seq(l, print_readably, "[", "]", " "), + Hash(hm, _) => { + let l: Vec = hm + .iter() + .flat_map(|(k, v)| vec![unwrap_map_key(k), v.clone()]) + .collect(); + pr_seq(&l, print_readably, "{", "}", " ") + } + Func(_, _) => String::from("#"), + MalFunc(FuncStruct { + ast: a, params: p, .. + }) => format!("(fn* {} {})", p.pr_str(true), a.pr_str(true)), + Atom(a) => format!("(atom {})", a.borrow().pr_str(true)), + } + } +} + +pub fn pr_seq(seq: &[MalVal], print_readably: bool, start: &str, end: &str, join: &str) -> String { + let strs: Vec = seq.iter().map(|x| x.pr_str(print_readably)).collect(); + format!("{}{}{}", start, strs.join(join), end) +} diff --git a/impls/rust/reader.rs b/impls/rust/reader.rs new file mode 100644 index 0000000000..929558e8aa --- /dev/null +++ b/impls/rust/reader.rs @@ -0,0 +1,146 @@ +use regex::{Captures, Regex}; +use std::rc::Rc; + +use crate::types::MalVal::{Bool, Int, Kwd, List, Nil, Str, Sym}; +use crate::types::{error, hash_map, list, vector, MalRet, MalVal}; + +#[derive(Debug, Clone)] +struct Reader { + tokens: Vec, + pos: usize, +} + +impl Reader { + fn next(&mut self) -> Result { + self.pos += 1; + Ok(self + .tokens + .get(self.pos - 1) + .ok_or_else(|| Str("underflow".to_string()))? + .to_string()) + } + fn peek(&self) -> Result { + Ok(self + .tokens + .get(self.pos) + .ok_or_else(|| Str("underflow".to_string()))? + .to_string()) + } +} + +thread_local! { + static TOKENIZE_RE: Regex = Regex::new( + r###"[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]+)"### + ).unwrap(); + static UNESCAPE_RE: Regex = Regex::new(r#"\\(.)"#).unwrap(); + static INT_RE: Regex = Regex::new(r"^-?[0-9]+$").unwrap(); + static STR_RE: Regex = Regex::new(r#""(?:\\.|[^\\"])*""#).unwrap(); +} + +fn tokenize(str: &str) -> Vec { + TOKENIZE_RE.with(|re| { + let mut res = vec![]; + for cap in re.captures_iter(str) { + if cap[1].starts_with(';') { + continue; + } + res.push(String::from(&cap[1])); + } + res + }) +} + +fn unescape_str(s: &str) -> String { + UNESCAPE_RE.with(|re| { + re.replace_all(s, |caps: &Captures| { + if &caps[1] == "n" { "\n" } else { &caps[1] }.to_string() + }) + .to_string() + }) +} + +fn read_atom(rdr: &mut Reader) -> MalRet { + let token = rdr.next()?; + match &token[..] { + "nil" => Ok(Nil), + "false" => Ok(Bool(false)), + "true" => Ok(Bool(true)), + _ => { + if INT_RE.with(|re| re.is_match(&token)) { + Ok(Int(token.parse().unwrap())) + } else if STR_RE.with(|re| re.is_match(&token)) { + Ok(Str(unescape_str(&token[1..token.len() - 1]))) + } else if token.starts_with('\"') { + error("expected '\"', got EOF") + } else if let Some(keyword) = token.strip_prefix(':') { + Ok(Kwd(String::from(keyword))) + } else { + Ok(Sym(token.to_string())) + } + } + } +} + +fn read_seq(rdr: &mut Reader, end: &str) -> Result, MalVal> { + let mut seq: Vec = vec![]; + rdr.next()?; + loop { + let token = match rdr.peek() { + Ok(t) => t, + Err(_) => return error(&format!("expected '{}', got EOF", end)), + }; + if token == end { + break; + } + seq.push(read_form(rdr)?); + } + let _ = rdr.next(); + Ok(seq) +} + +fn read_form(rdr: &mut Reader) -> MalRet { + let token = rdr.peek()?; + match &token[..] { + "'" => { + let _ = rdr.next(); + Ok(list!(Sym("quote".to_string()), read_form(rdr)?)) + } + "`" => { + let _ = rdr.next(); + Ok(list!(Sym("quasiquote".to_string()), read_form(rdr)?)) + } + "~" => { + let _ = rdr.next(); + Ok(list!(Sym("unquote".to_string()), read_form(rdr)?)) + } + "~@" => { + let _ = rdr.next(); + Ok(list!(Sym("splice-unquote".to_string()), read_form(rdr)?)) + } + "^" => { + let _ = rdr.next(); + let meta = read_form(rdr)?; + Ok(list!(Sym("with-meta".to_string()), read_form(rdr)?, meta)) + } + "@" => { + let _ = rdr.next(); + Ok(list!(Sym("deref".to_string()), read_form(rdr)?)) + } + ")" => error("unexpected ')'"), + "(" => Ok(list(read_seq(rdr, ")")?)), + "]" => error("unexpected ']'"), + "[" => Ok(vector(read_seq(rdr, "]")?)), + "}" => error("unexpected '}'"), + "{" => hash_map(read_seq(rdr, "}")?.to_vec()), + _ => read_atom(rdr), + } +} + +pub fn read_str(str: &str) -> MalRet { + let tokens = tokenize(str); + //println!("tokens: {:?}", tokens); + if tokens.is_empty() { + return error("no input"); + } + read_form(&mut Reader { pos: 0, tokens }) +} diff --git a/impls/rust/readline.rs b/impls/rust/readline.rs new file mode 100644 index 0000000000..fab6f693bc --- /dev/null +++ b/impls/rust/readline.rs @@ -0,0 +1,43 @@ +extern crate rustyline; + +// A global variable makes more sense than passing the readline editor +// as an argument to *every* core function just for readline. + +struct S { + e: rustyline::Editor<(), rustyline::history::DefaultHistory>, +} + +impl Drop for S { + fn drop(&mut self) { + self.e.save_history(".mal-history").unwrap() + } +} + +thread_local! { + static ED : std::cell::RefCell = { + let mut e = rustyline::Editor::new().unwrap(); + if e.load_history(".mal-history").is_err() { + println!("No previous history."); + } + std::cell::RefCell::new(S{e}) + } +} + +pub fn readline(prompt: &str) -> Option { + ED.with_borrow_mut(|s| { + let r = s.e.readline(prompt); + if let Err(rustyline::error::ReadlineError::Eof) = r { + None + } else { + let mut line = r.unwrap(); + // Remove any trailing \n or \r\n + while line.ends_with('\n') || line.ends_with('\r') { + line.pop(); + } + if !line.is_empty() { + let _ = s.e.add_history_entry(&line); + } + Some(line.to_string()) + } + }) +} diff --git a/impls/rust/run b/impls/rust/run new file mode 100755 index 0000000000..d67524c747 --- /dev/null +++ b/impls/rust/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/target/release/${STEP:-stepA_mal} "${@}" diff --git a/impls/rust/step0_repl.rs b/impls/rust/step0_repl.rs new file mode 100644 index 0000000000..9fb22be941 --- /dev/null +++ b/impls/rust/step0_repl.rs @@ -0,0 +1,15 @@ +#![allow(non_snake_case)] + +mod readline; + +fn main() { + // `()` can be used when no completer is required + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + println!("{}", line); + } + } + println!(); +} diff --git a/impls/rust/step1_read_print.rs b/impls/rust/step1_read_print.rs new file mode 100644 index 0000000000..7a8445623f --- /dev/null +++ b/impls/rust/step1_read_print.rs @@ -0,0 +1,51 @@ +#![allow(non_snake_case)] + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +#[allow(dead_code)] +mod types; +use crate::types::{MalRet, MalVal}; +#[allow(dead_code)] +mod env; +mod printer; +mod reader; + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval +fn eval(ast: MalVal) -> MalRet { + Ok(ast) +} + +// print +fn print(ast: MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str) -> Result { + let ast = read(str)?; + let exp = eval(ast)?; + Ok(print(exp)) +} + +fn main() { + // `()` can be used when no completer is required + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); +} diff --git a/impls/rust/step2_eval.rs b/impls/rust/step2_eval.rs new file mode 100644 index 0000000000..fd42af8011 --- /dev/null +++ b/impls/rust/step2_eval.rs @@ -0,0 +1,113 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +#[allow(dead_code)] +mod types; +use crate::types::MalVal::{Func, Hash, Int, List, Nil, Sym, Vector}; +use crate::types::{error, func, vector, MalArgs, MalRet, MalVal}; +#[allow(dead_code)] +mod env; +mod printer; +mod reader; + +pub type Env = FnvHashMap; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval +fn eval(ast: &MalVal, env: &Env) -> MalRet { + // println!("EVAL: {}", print(&ast)); + match ast { + Sym(s) => match env.get(s) { + Some(r) => Ok(r.clone()), + None => error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + Ok(vector(lst)) + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + let f = eval(a0, env)?; + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + f.apply(args) + } + _ => Ok(ast.clone()), + } +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn int_op(op: fn(i64, i64) -> i64, a: MalArgs) -> MalRet { + match (a[0].clone(), a[1].clone()) { + (Int(a0), Int(a1)) => Ok(Int(op(a0, a1))), + _ => error("invalid int_op args"), + } +} + +fn main() { + // `()` can be used when no completer is required + + let mut repl_env = Env::default(); + repl_env.insert("+".to_string(), func(|a: MalArgs| int_op(|i, j| i + j, a))); + repl_env.insert("-".to_string(), func(|a: MalArgs| int_op(|i, j| i - j, a))); + repl_env.insert("*".to_string(), func(|a: MalArgs| int_op(|i, j| i * j, a))); + repl_env.insert("/".to_string(), func(|a: MalArgs| int_op(|i, j| i / j, a))); + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, &repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); +} diff --git a/impls/rust/step3_env.rs b/impls/rust/step3_env.rs new file mode 100644 index 0000000000..d22a55debd --- /dev/null +++ b/impls/rust/step3_env.rs @@ -0,0 +1,137 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +#[allow(dead_code)] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, Int, List, Nil, Sym, Vector}; +use crate::types::{error, func, vector, MalArgs, MalRet, MalVal}; +#[allow(dead_code)] +mod env; +mod printer; +mod reader; +use crate::env::{env_get, env_new, env_set, env_sets, Env}; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval +fn eval(ast: &MalVal, env: &Env) -> MalRet { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => Ok(r), + None => error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + Ok(vector(lst)) + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => env_set(env, &l[1], eval(&l[2], env)?), + Sym(a0sym) if a0sym == "let*" => { + let let_env = &env_new(Some(env.clone())); + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, let_env)?; + env_set(let_env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + eval(a2, let_env) + } + _ => { + let f = eval(a0, env)?; + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + f.apply(args) + } + } + } + _ => Ok(ast.clone()), + } +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn int_op(op: fn(i64, i64) -> i64, a: MalArgs) -> MalRet { + match (a[0].clone(), a[1].clone()) { + (Int(a0), Int(a1)) => Ok(Int(op(a0, a1))), + _ => error("invalid int_op args"), + } +} + +fn main() { + // `()` can be used when no completer is required + + let repl_env = env_new(None); + env_sets(&repl_env, "+", func(|a: MalArgs| int_op(|i, j| i + j, a))); + env_sets(&repl_env, "-", func(|a: MalArgs| int_op(|i, j| i - j, a))); + env_sets(&repl_env, "*", func(|a: MalArgs| int_op(|i, j| i * j, a))); + env_sets(&repl_env, "/", func(|a: MalArgs| int_op(|i, j| i / j, a))); + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, &repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); +} diff --git a/impls/rust/step4_if_fn_do.rs b/impls/rust/step4_if_fn_do.rs new file mode 100644 index 0000000000..051b20152b --- /dev/null +++ b/impls/rust/step4_if_fn_do.rs @@ -0,0 +1,176 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Sym, Vector}; +use crate::types::{error, vector, FuncStruct, MalArgs, MalRet, MalVal}; +mod env; +mod printer; +mod reader; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; +#[macro_use] +mod core; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + MalFunc(FuncStruct { + ref ast, + ref env, + ref params, + .. + }) => { + let fn_env = &env_bind(env.clone(), params, args)?; + eval(ast, fn_env) + } + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval +fn eval(ast: &MalVal, env: &Env) -> MalRet { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => Ok(r), + None => error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + Ok(vector(lst)) + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => env_set(env, &l[1], eval(&l[2], env)?), + Sym(a0sym) if a0sym == "let*" => { + let let_env = &env_new(Some(env.clone())); + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, let_env)?; + env_set(let_env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + eval(a2, let_env) + } + Sym(a0sym) if a0sym == "do" => { + for i in 1..l.len() - 1 { + let _ = eval(&l[i], env)?; + } + eval(l.last().unwrap_or(&Nil), env) + } + Sym(a0sym) if a0sym == "if" => { + let cond = eval(&l[1], env)?; + match cond { + Bool(false) | Nil if l.len() >= 4 => eval(&l[3], env), + Bool(false) | Nil => Ok(Nil), + _ if l.len() >= 3 => eval(&l[2], env), + _ => Ok(Nil), + } + } + Sym(a0sym) if a0sym == "fn*" => { + let (a1, a2) = (l[1].clone(), l[2].clone()); + Ok(MalFunc(FuncStruct { + ast: Rc::new(a2), + env: env.clone(), + params: Rc::new(a1), + is_macro: false, + meta: Rc::new(Nil), + })) + } + _ => { + let f = eval(a0, env)?; + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + f.apply(args) + } + } + } + _ => Ok(ast.clone()), + } +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn re(str: &str, env: &Env) { + if let Ok(ast) = read(str) { + if eval(&ast, env).is_ok() { + return; + } + } + panic!("error during startup"); +} + +fn main() { + // `()` can be used when no completer is required + + // core.rs: defined using rust + let repl_env = env_new(None); + for (k, v) in core::ns() { + env_sets(&repl_env, k, v); + } + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", &repl_env); + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, &repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); +} diff --git a/impls/rust/step5_tco.rs b/impls/rust/step5_tco.rs new file mode 100644 index 0000000000..f266af4ab2 --- /dev/null +++ b/impls/rust/step5_tco.rs @@ -0,0 +1,218 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Sym, Vector}; +use crate::types::{error, vector, FuncStruct, MalArgs, MalRet, MalVal}; +mod env; +mod printer; +mod reader; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; +#[macro_use] +mod core; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + MalFunc(FuncStruct { + ref ast, + ref env, + ref params, + .. + }) => { + let fn_env = &env_bind(env.clone(), params, args)?; + eval(ast, fn_env) + } + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval +fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { + let mut ast = orig_ast; + let mut env = orig_env; + // These variables ensure a sufficient lifetime for the data + // referenced by ast and env. + let mut live_ast; + let mut live_env; + + 'tco: loop { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => return Ok(r), + None => return error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + return Ok(vector(lst)); + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => { + return env_set(env, &l[1], eval(&l[2], env)?); + } + Sym(a0sym) if a0sym == "let*" => { + live_env = env_new(Some(env.clone())); + env = &live_env; + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, env)?; + env_set(env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + live_ast = a2.clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "do" => { + for i in 1..l.len() - 1 { + let _ = eval(&l[i], env)?; + } + live_ast = l.last().unwrap_or(&Nil).clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "if" => { + let cond = eval(&l[1], env)?; + match cond { + Bool(false) | Nil if l.len() >= 4 => { + live_ast = l[3].clone(); + ast = &live_ast; + continue 'tco; + } + Bool(false) | Nil => return Ok(Nil), + _ if l.len() >= 3 => { + live_ast = l[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return Ok(Nil), + } + } + Sym(a0sym) if a0sym == "fn*" => { + let (a1, a2) = (l[1].clone(), l[2].clone()); + return Ok(MalFunc(FuncStruct { + ast: Rc::new(a2), + env: env.clone(), + params: Rc::new(a1), + is_macro: false, + meta: Rc::new(Nil), + })); + } + _ => match eval(a0, env)? { + f @ Func(_, _) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + return f.apply(args); + } + MalFunc(FuncStruct { + ast: mast, + env: menv, + params: mparams, + .. + }) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + live_env = env_bind(menv.clone(), &mparams, args)?; + env = &live_env; + live_ast = (*mast).clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("attempt to call non-function"), + }, + } + } + _ => return Ok(ast.clone()), + }; + } // end 'tco loop +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn re(str: &str, env: &Env) { + if let Ok(ast) = read(str) { + if eval(&ast, env).is_ok() { + return; + } + } + panic!("error during startup"); +} + +fn main() { + // `()` can be used when no completer is required + + // core.rs: defined using rust + let repl_env = env_new(None); + for (k, v) in core::ns() { + env_sets(&repl_env, k, v); + } + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", &repl_env); + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, &repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); +} diff --git a/impls/rust/step6_file.rs b/impls/rust/step6_file.rs new file mode 100644 index 0000000000..99b76188e3 --- /dev/null +++ b/impls/rust/step6_file.rs @@ -0,0 +1,242 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; +use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; +mod env; +mod printer; +mod reader; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; +#[macro_use] +mod core; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + MalFunc(FuncStruct { + ref ast, + ref env, + ref params, + .. + }) => { + let fn_env = &env_bind(env.clone(), params, args)?; + eval(ast, fn_env) + } + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval +fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { + let mut ast = orig_ast; + let mut env = orig_env; + // These variables ensure a sufficient lifetime for the data + // referenced by ast and env. + let mut live_ast; + let mut live_env; + + 'tco: loop { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => return Ok(r), + None => return error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + return Ok(vector(lst)); + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => { + return env_set(env, &l[1], eval(&l[2], env)?); + } + Sym(a0sym) if a0sym == "let*" => { + live_env = env_new(Some(env.clone())); + env = &live_env; + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, env)?; + env_set(env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + live_ast = a2.clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "do" => { + for i in 1..l.len() - 1 { + let _ = eval(&l[i], env)?; + } + live_ast = l.last().unwrap_or(&Nil).clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "if" => { + let cond = eval(&l[1], env)?; + match cond { + Bool(false) | Nil if l.len() >= 4 => { + live_ast = l[3].clone(); + ast = &live_ast; + continue 'tco; + } + Bool(false) | Nil => return Ok(Nil), + _ if l.len() >= 3 => { + live_ast = l[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return Ok(Nil), + } + } + Sym(a0sym) if a0sym == "fn*" => { + let (a1, a2) = (l[1].clone(), l[2].clone()); + return Ok(MalFunc(FuncStruct { + ast: Rc::new(a2), + env: env.clone(), + params: Rc::new(a1), + is_macro: false, + meta: Rc::new(Nil), + })); + } + _ => match eval(a0, env)? { + f @ Func(_, _) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + return f.apply(args); + } + MalFunc(FuncStruct { + ast: mast, + env: menv, + params: mparams, + .. + }) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + live_env = env_bind(menv.clone(), &mparams, args)?; + env = &live_env; + live_ast = (*mast).clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("attempt to call non-function"), + }, + } + } + _ => return Ok(ast.clone()), + }; + } // end 'tco loop +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn re(str: &str, env: &Env) { + if let Ok(ast) = read(str) { + if eval(&ast, env).is_ok() { + return; + } + } + panic!("error during startup"); +} + +thread_local! { + static REPL_ENV: Env = env_new(None); +} + +fn main() { + REPL_ENV.with(|repl_env| { + let mut args = std::env::args(); + let arg1 = args.nth(1); + + // `()` can be used when no completer is required + + // core.rs: defined using rust + env_sets( + repl_env, + "eval", + types::func(|a| REPL_ENV.with(|e| eval(&a[0], e))), + ); + for (k, v) in core::ns() { + env_sets(repl_env, k, v); + } + env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re( + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + repl_env, + ); + + if let Some(f) = arg1 { + // Invoked with arguments + re(&format!("(load-file \"{}\")", f), repl_env); + std::process::exit(0); + } + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); + }) +} diff --git a/impls/rust/step7_quote.rs b/impls/rust/step7_quote.rs new file mode 100644 index 0000000000..93d1bc6938 --- /dev/null +++ b/impls/rust/step7_quote.rs @@ -0,0 +1,285 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; +use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; +mod env; +mod printer; +mod reader; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; +#[macro_use] +mod core; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + MalFunc(FuncStruct { + ref ast, + ref env, + ref params, + .. + }) => { + let fn_env = &env_bind(env.clone(), params, args)?; + eval(ast, fn_env) + } + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list!(); + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list!(Sym("concat".to_string()), v[1].clone(), acc); + continue; + } + } + } + } + acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); + } + acc +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + qq_iter(v) + } + Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), + Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), + _ => ast.clone(), + } +} + +fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { + let mut ast = orig_ast; + let mut env = orig_env; + // These variables ensure a sufficient lifetime for the data + // referenced by ast and env. + let mut live_ast; + let mut live_env; + + 'tco: loop { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => return Ok(r), + None => return error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + return Ok(vector(lst)); + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => { + return env_set(env, &l[1], eval(&l[2], env)?); + } + Sym(a0sym) if a0sym == "let*" => { + live_env = env_new(Some(env.clone())); + env = &live_env; + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, env)?; + env_set(env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + live_ast = a2.clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), + Sym(a0sym) if a0sym == "quasiquote" => { + live_ast = quasiquote(&l[1]); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "do" => { + for i in 1..l.len() - 1 { + let _ = eval(&l[i], env)?; + } + live_ast = l.last().unwrap_or(&Nil).clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "if" => { + let cond = eval(&l[1], env)?; + match cond { + Bool(false) | Nil if l.len() >= 4 => { + live_ast = l[3].clone(); + ast = &live_ast; + continue 'tco; + } + Bool(false) | Nil => return Ok(Nil), + _ if l.len() >= 3 => { + live_ast = l[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return Ok(Nil), + } + } + Sym(a0sym) if a0sym == "fn*" => { + let (a1, a2) = (l[1].clone(), l[2].clone()); + return Ok(MalFunc(FuncStruct { + ast: Rc::new(a2), + env: env.clone(), + params: Rc::new(a1), + is_macro: false, + meta: Rc::new(Nil), + })); + } + _ => match eval(a0, env)? { + f @ Func(_, _) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + return f.apply(args); + } + MalFunc(FuncStruct { + ast: mast, + env: menv, + params: mparams, + .. + }) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + live_env = env_bind(menv.clone(), &mparams, args)?; + env = &live_env; + live_ast = (*mast).clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("attempt to call non-function"), + }, + } + } + _ => return Ok(ast.clone()), + }; + } // end 'tco loop +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn re(str: &str, env: &Env) { + if let Ok(ast) = read(str) { + if eval(&ast, env).is_ok() { + return; + } + } + panic!("error during startup"); +} + +thread_local! { + static REPL_ENV: Env = env_new(None); +} + +fn main() { + REPL_ENV.with(|repl_env| { + let mut args = std::env::args(); + let arg1 = args.nth(1); + + // `()` can be used when no completer is required + + // core.rs: defined using rust + env_sets( + repl_env, + "eval", + types::func(|a| REPL_ENV.with(|e| eval(&a[0], e))), + ); + for (k, v) in core::ns() { + env_sets(repl_env, k, v); + } + env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re( + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + repl_env, + ); + + if let Some(f) = arg1 { + // Invoked with arguments + re(&format!("(load-file \"{}\")", f), repl_env); + std::process::exit(0); + } + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); + }) +} diff --git a/impls/rust/step8_macros.rs b/impls/rust/step8_macros.rs new file mode 100644 index 0000000000..0e53b9a4a2 --- /dev/null +++ b/impls/rust/step8_macros.rs @@ -0,0 +1,306 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; +use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; +mod env; +mod printer; +mod reader; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; +#[macro_use] +mod core; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + MalFunc(FuncStruct { + ref ast, + ref env, + ref params, + .. + }) => { + let fn_env = &env_bind(env.clone(), params, args)?; + eval(ast, fn_env) + } + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list!(); + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list!(Sym("concat".to_string()), v[1].clone(), acc); + continue; + } + } + } + } + acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); + } + acc +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + qq_iter(v) + } + Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), + Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), + _ => ast.clone(), + } +} + +fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { + let mut ast = orig_ast; + let mut env = orig_env; + // These variables ensure a sufficient lifetime for the data + // referenced by ast and env. + let mut live_ast; + let mut live_env; + + 'tco: loop { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => return Ok(r), + None => return error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + return Ok(vector(lst)); + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => { + return env_set(env, &l[1], eval(&l[2], env)?); + } + Sym(a0sym) if a0sym == "let*" => { + live_env = env_new(Some(env.clone())); + env = &live_env; + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, env)?; + env_set(env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + live_ast = a2.clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), + Sym(a0sym) if a0sym == "quasiquote" => { + live_ast = quasiquote(&l[1]); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "defmacro!" => { + let (a1, a2) = (&l[1], &l[2]); + let r = eval(a2, env)?; + match r { + MalFunc(f) => { + return env_set( + env, + a1, + MalFunc(FuncStruct { + is_macro: true, + ..f.clone() + }), + ) + } + _ => return error("set_macro on non-function"), + } + } + Sym(a0sym) if a0sym == "do" => { + for i in 1..l.len() - 1 { + let _ = eval(&l[i], env)?; + } + live_ast = l.last().unwrap_or(&Nil).clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "if" => { + let cond = eval(&l[1], env)?; + match cond { + Bool(false) | Nil if l.len() >= 4 => { + live_ast = l[3].clone(); + ast = &live_ast; + continue 'tco; + } + Bool(false) | Nil => return Ok(Nil), + _ if l.len() >= 3 => { + live_ast = l[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return Ok(Nil), + } + } + Sym(a0sym) if a0sym == "fn*" => { + let (a1, a2) = (l[1].clone(), l[2].clone()); + return Ok(MalFunc(FuncStruct { + ast: Rc::new(a2), + env: env.clone(), + params: Rc::new(a1), + is_macro: false, + meta: Rc::new(Nil), + })); + } + _ => match eval(a0, env)? { + f @ MalFunc(FuncStruct { is_macro: true, .. }) => { + let new_ast = f.apply(l[1..].to_vec())?; + live_ast = new_ast; + ast = &live_ast; + continue 'tco; + } + f @ Func(_, _) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + return f.apply(args); + } + MalFunc(FuncStruct { + ast: mast, + env: menv, + params: mparams, + .. + }) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + live_env = env_bind(menv.clone(), &mparams, args)?; + env = &live_env; + live_ast = (*mast).clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("attempt to call non-function"), + }, + } + } + _ => return Ok(ast.clone()), + }; + } // end 'tco loop +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn re(str: &str, env: &Env) { + if let Ok(ast) = read(str) { + if eval(&ast, env).is_ok() { + return; + } + } + panic!("error during startup"); +} + +thread_local! { + static REPL_ENV: Env = env_new(None); +} + +fn main() { + REPL_ENV.with(|repl_env| { + let mut args = std::env::args(); + let arg1 = args.nth(1); + + // `()` can be used when no completer is required + + // core.rs: defined using rust + env_sets(repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e)))); + for (k, v) in core::ns() { + env_sets(repl_env, k, v); + } + env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re( + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + repl_env, + ); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + repl_env); + + if let Some(f) = arg1 { + // Invoked with arguments + re(&format!("(load-file \"{}\")", f), repl_env); + std::process::exit(0); + } + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); + }) +} diff --git a/impls/rust/step9_try.rs b/impls/rust/step9_try.rs new file mode 100644 index 0000000000..6bb04041f9 --- /dev/null +++ b/impls/rust/step9_try.rs @@ -0,0 +1,327 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; +use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; +mod env; +mod printer; +mod reader; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; +#[macro_use] +mod core; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + MalFunc(FuncStruct { + ref ast, + ref env, + ref params, + .. + }) => { + let fn_env = &env_bind(env.clone(), params, args)?; + eval(ast, fn_env) + } + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list!(); + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list!(Sym("concat".to_string()), v[1].clone(), acc); + continue; + } + } + } + } + acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); + } + acc +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + qq_iter(v) + } + Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), + Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), + _ => ast.clone(), + } +} + +fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { + let mut ast = orig_ast; + let mut env = orig_env; + // These variables ensure a sufficient lifetime for the data + // referenced by ast and env. + let mut live_ast; + let mut live_env; + + 'tco: loop { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => return Ok(r), + None => return error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + return Ok(vector(lst)); + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => { + return env_set(env, &l[1], eval(&l[2], env)?); + } + Sym(a0sym) if a0sym == "let*" => { + live_env = env_new(Some(env.clone())); + env = &live_env; + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, env)?; + env_set(env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + live_ast = a2.clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), + Sym(a0sym) if a0sym == "quasiquote" => { + live_ast = quasiquote(&l[1]); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "defmacro!" => { + let (a1, a2) = (&l[1], &l[2]); + let r = eval(a2, env)?; + match r { + MalFunc(f) => { + return env_set( + env, + a1, + MalFunc(FuncStruct { + is_macro: true, + ..f.clone() + }), + ) + } + _ => return error("set_macro on non-function"), + } + } + Sym(a0sym) if a0sym == "try*" => { + if l.len() < 3 { + live_ast = l[1].clone(); + ast = &live_ast; + continue 'tco; + } + match eval(&l[1], env) { + Err(exc) => match &l[2] { + List(c, _) => { + live_env = env_new(Some(env.clone())); + env = &live_env; + env_set(env, &c[1], exc)?; + live_ast = c[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("invalid catch block"), + }, + res => return res, + } + } + Sym(a0sym) if a0sym == "do" => { + for i in 1..l.len() - 1 { + let _ = eval(&l[i], env)?; + } + live_ast = l.last().unwrap_or(&Nil).clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "if" => { + let cond = eval(&l[1], env)?; + match cond { + Bool(false) | Nil if l.len() >= 4 => { + live_ast = l[3].clone(); + ast = &live_ast; + continue 'tco; + } + Bool(false) | Nil => return Ok(Nil), + _ if l.len() >= 3 => { + live_ast = l[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return Ok(Nil), + } + } + Sym(a0sym) if a0sym == "fn*" => { + let (a1, a2) = (l[1].clone(), l[2].clone()); + return Ok(MalFunc(FuncStruct { + ast: Rc::new(a2), + env: env.clone(), + params: Rc::new(a1), + is_macro: false, + meta: Rc::new(Nil), + })); + } + _ => match eval(a0, env)? { + f @ MalFunc(FuncStruct { is_macro: true, .. }) => { + let new_ast = f.apply(l[1..].to_vec())?; + live_ast = new_ast; + ast = &live_ast; + continue 'tco; + } + f @ Func(_, _) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + return f.apply(args); + } + MalFunc(FuncStruct { + ast: mast, + env: menv, + params: mparams, + .. + }) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + live_env = env_bind(menv.clone(), &mparams, args)?; + env = &live_env; + live_ast = (*mast).clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("attempt to call non-function"), + }, + } + } + _ => return Ok(ast.clone()), + }; + } // end 'tco loop +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn re(str: &str, env: &Env) { + if let Ok(ast) = read(str) { + if eval(&ast, env).is_ok() { + return; + } + } + panic!("error during startup"); +} + +thread_local! { + static REPL_ENV: Env = env_new(None); +} + +fn main() { + REPL_ENV.with(|repl_env| { + let mut args = std::env::args(); + let arg1 = args.nth(1); + + // `()` can be used when no completer is required + + // core.rs: defined using rust + env_sets(repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e)))); + for (k, v) in core::ns() { + env_sets(repl_env, k, v); + } + env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); + + // core.mal: defined using the language itself + re("(def! not (fn* (a) (if a false true)))", repl_env); + re( + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + repl_env, + ); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + repl_env); + + if let Some(f) = arg1 { + // Invoked with arguments + re(&format!("(load-file \"{}\")", f), repl_env); + std::process::exit(0); + } + + // main repl loop + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); + }) +} diff --git a/impls/rust/stepA_mal.rs b/impls/rust/stepA_mal.rs new file mode 100644 index 0000000000..f43af0d027 --- /dev/null +++ b/impls/rust/stepA_mal.rs @@ -0,0 +1,329 @@ +#![allow(non_snake_case)] + +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +extern crate fnv; +extern crate itertools; +extern crate regex; + +mod readline; +#[macro_use] +mod types; +use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; +use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; +mod env; +mod printer; +mod reader; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; +#[macro_use] +mod core; + +impl MalVal { + pub fn apply(&self, args: MalArgs) -> MalRet { + match self { + Func(f, _) => f(args), + MalFunc(FuncStruct { + ref ast, + ref env, + ref params, + .. + }) => { + let fn_env = &env_bind(env.clone(), params, args)?; + eval(ast, fn_env) + } + _ => error("attempt to call non-function"), + } + } +} + +// read +fn read(str: &str) -> MalRet { + reader::read_str(str) +} + +// eval + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list!(); + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list!(Sym("concat".to_string()), v[1].clone(), acc); + continue; + } + } + } + } + acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); + } + acc +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + qq_iter(v) + } + Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), + Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), + _ => ast.clone(), + } +} + +fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { + let mut ast = orig_ast; + let mut env = orig_env; + // These variables ensure a sufficient lifetime for the data + // referenced by ast and env. + let mut live_ast; + let mut live_env; + + 'tco: loop { + match env_get(env, "DEBUG-EVAL") { + None | Some(Bool(false)) | Some(Nil) => (), + _ => println!("EVAL: {}", print(ast)), + } + match ast { + Sym(s) => match env_get(env, s) { + Some(r) => return Ok(r), + None => return error(&format!("'{}' not found", s)), + }, + Vector(v, _) => { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + lst.push(eval(a, env)?); + } + return Ok(vector(lst)); + } + Hash(hm, _) => { + let mut new_hm: FnvHashMap = FnvHashMap::default(); + for (k, v) in hm.iter() { + new_hm.insert(k.to_string(), eval(v, env)?); + } + return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); + } + List(l, _) => { + if l.is_empty() { + return Ok(ast.clone()); + } + let a0 = &l[0]; + match a0 { + Sym(a0sym) if a0sym == "def!" => { + return env_set(env, &l[1], eval(&l[2], env)?); + } + Sym(a0sym) if a0sym == "let*" => { + live_env = env_new(Some(env.clone())); + env = &live_env; + let (a1, a2) = (&l[1], &l[2]); + match a1 { + List(binds, _) | Vector(binds, _) => { + for (b, e) in binds.iter().tuples() { + let val = eval(e, env)?; + env_set(env, b, val)?; + } + } + _ => { + return error("let* with non-List bindings"); + } + }; + live_ast = a2.clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), + Sym(a0sym) if a0sym == "quasiquote" => { + live_ast = quasiquote(&l[1]); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "defmacro!" => { + let (a1, a2) = (&l[1], &l[2]); + let r = eval(a2, env)?; + match r { + MalFunc(f) => { + return env_set( + env, + a1, + MalFunc(FuncStruct { + is_macro: true, + ..f.clone() + }), + ) + } + _ => return error("set_macro on non-function"), + } + } + Sym(a0sym) if a0sym == "try*" => { + if l.len() < 3 { + live_ast = l[1].clone(); + ast = &live_ast; + continue 'tco; + } + match eval(&l[1], env) { + Err(exc) => match &l[2] { + List(c, _) => { + live_env = env_new(Some(env.clone())); + env = &live_env; + env_set(env, &c[1], exc)?; + live_ast = c[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("invalid catch block"), + }, + res => return res, + } + } + Sym(a0sym) if a0sym == "do" => { + for i in 1..l.len() - 1 { + let _ = eval(&l[i], env)?; + } + live_ast = l.last().unwrap_or(&Nil).clone(); + ast = &live_ast; + continue 'tco; + } + Sym(a0sym) if a0sym == "if" => { + let cond = eval(&l[1], env)?; + match cond { + Bool(false) | Nil if l.len() >= 4 => { + live_ast = l[3].clone(); + ast = &live_ast; + continue 'tco; + } + Bool(false) | Nil => return Ok(Nil), + _ if l.len() >= 3 => { + live_ast = l[2].clone(); + ast = &live_ast; + continue 'tco; + } + _ => return Ok(Nil), + } + } + Sym(a0sym) if a0sym == "fn*" => { + let (a1, a2) = (l[1].clone(), l[2].clone()); + return Ok(MalFunc(FuncStruct { + ast: Rc::new(a2), + env: env.clone(), + params: Rc::new(a1), + is_macro: false, + meta: Rc::new(Nil), + })); + } + _ => match eval(a0, env)? { + f @ MalFunc(FuncStruct { is_macro: true, .. }) => { + let new_ast = f.apply(l[1..].to_vec())?; + live_ast = new_ast; + ast = &live_ast; + continue 'tco; + } + f @ Func(_, _) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + return f.apply(args); + } + MalFunc(FuncStruct { + ast: mast, + env: menv, + params: mparams, + .. + }) => { + let mut args: MalArgs = vec![]; + for i in 1..l.len() { + args.push(eval(&l[i], env)?); + } + live_env = env_bind(menv.clone(), &mparams, args)?; + env = &live_env; + live_ast = (*mast).clone(); + ast = &live_ast; + continue 'tco; + } + _ => return error("attempt to call non-function"), + }, + } + } + _ => return Ok(ast.clone()), + }; + } // end 'tco loop +} + +// print +fn print(ast: &MalVal) -> String { + ast.pr_str(true) +} + +fn rep(str: &str, env: &Env) -> Result { + let ast = read(str)?; + let exp = eval(&ast, env)?; + Ok(print(&exp)) +} + +fn re(str: &str, env: &Env) { + if let Ok(ast) = read(str) { + if eval(&ast, env).is_ok() { + return; + } + } + panic!("error during startup"); +} + +thread_local! { + static REPL_ENV: Env = env_new(None); +} + +fn main() { + REPL_ENV.with(|repl_env| { + let mut args = std::env::args(); + let arg1 = args.nth(1); + + // `()` can be used when no completer is required + + // core.rs: defined using rust + env_sets(repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e)))); + for (k, v) in core::ns() { + env_sets(repl_env, k, v); + } + env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); + + // core.mal: defined using the language itself + re("(def! *host-language* \"rust\")", repl_env); + re("(def! not (fn* (a) (if a false true)))", repl_env); + re( + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + repl_env, + ); + re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + repl_env); + + if let Some(f) = arg1 { + // Invoked with arguments + re(&format!("(load-file \"{}\")", f), repl_env); + std::process::exit(0); + } + + // main repl loop + re("(println (str \"Mal [\" *host-language* \"]\"))", repl_env); + while let Some(ref line) = readline::readline("user> ") { + if !line.is_empty() { + match rep(line, repl_env) { + Ok(ref out) => println!("{}", out), + Err(ref e) => println!("Error: {}", e.pr_str(true)), + } + } + } + println!(); + }) +} diff --git a/impls/rust/types.rs b/impls/rust/types.rs new file mode 100644 index 0000000000..875de1d991 --- /dev/null +++ b/impls/rust/types.rs @@ -0,0 +1,118 @@ +use std::cell::RefCell; +use std::rc::Rc; +//use std::collections::HashMap; +use fnv::FnvHashMap; +use itertools::Itertools; + +use crate::env::Env; +use crate::types::MalVal::{Bool, Func, Hash, Int, Kwd, List, MalFunc, Nil, Str, Sym, Vector}; + +// Function closures and atoms may create cyclic dependencies, so +// reference counting should be replaced at least for these two kinds +// of references. + +#[derive(Clone)] +pub enum MalVal { + Nil, + Bool(bool), + Int(i64), + //Float(f64), + Str(String), + Sym(String), + Kwd(String), + List(Rc>, Rc), + Vector(Rc>, Rc), + Hash(Rc>, Rc), + Func(fn(MalArgs) -> MalRet, Rc), + MalFunc(FuncStruct), + Atom(Rc>), +} + +#[derive(Clone)] +pub struct FuncStruct { + pub ast: Rc, + pub env: Env, + pub params: Rc, + pub is_macro: bool, + pub meta: Rc, +} + +pub type MalArgs = Vec; +pub type MalRet = Result; + +// type utility macros + +macro_rules! list { + [$($args:expr),*] => {{ + let v: Vec = vec![$($args),*]; + List(Rc::new(v),Rc::new(Nil)) + }} +} + +// type utility functions + +pub fn error(s: &str) -> Result { + Err(Str(s.to_string())) +} + +pub fn list(seq: MalArgs) -> MalVal { + List(Rc::new(seq), Rc::new(Nil)) +} + +pub fn vector(seq: MalArgs) -> MalVal { + Vector(Rc::new(seq), Rc::new(Nil)) +} + +impl PartialEq for MalVal { + fn eq(&self, other: &MalVal) -> bool { + match (self, other) { + (Nil, Nil) => true, + (Bool(ref a), Bool(ref b)) => a == b, + (Int(ref a), Int(ref b)) => a == b, + (Str(ref a), Str(ref b)) => a == b, + (Sym(ref a), Sym(ref b)) => a == b, + (Kwd(ref a), Kwd(ref b)) => a == b, + (List(ref a, _), List(ref b, _)) + | (Vector(ref a, _), Vector(ref b, _)) + | (List(ref a, _), Vector(ref b, _)) + | (Vector(ref a, _), List(ref b, _)) => a == b, + (Hash(ref a, _), Hash(ref b, _)) => a == b, + (MalFunc { .. }, MalFunc { .. }) => false, + _ => false, + } + } +} + +pub fn func(f: fn(MalArgs) -> MalRet) -> MalVal { + Func(f, Rc::new(Nil)) +} + +pub fn _assoc(mut hm: FnvHashMap, kvs: MalArgs) -> MalRet { + if kvs.len() % 2 != 0 { + return error("odd number of elements"); + } + for (k, v) in kvs.iter().tuples() { + hm.insert(wrap_map_key(k)?, v.clone()); + } + Ok(Hash(Rc::new(hm), Rc::new(Nil))) +} + +pub fn wrap_map_key(k: &MalVal) -> Result { + match k { + Str(s) => Ok(String::from(s)), + Kwd(s) => Ok(format!("\u{29e}{}", s)), + _ => error("key is not string"), + } +} + +pub fn unwrap_map_key(s: &str) -> MalVal { + match s.strip_prefix('\u{29e}') { + Some(keyword) => Kwd(String::from(keyword)), + _ => Str(String::from(s)), + } +} + +pub fn hash_map(kvs: MalArgs) -> MalRet { + let hm: FnvHashMap = FnvHashMap::default(); + _assoc(hm, kvs) +} diff --git a/impls/scala/Dockerfile b/impls/scala/Dockerfile new file mode 100644 index 0000000000..1aa29b5dde --- /dev/null +++ b/impls/scala/Dockerfile @@ -0,0 +1,36 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Java and maven +RUN apt-get -y install openjdk-8-jdk +#RUN apt-get -y install maven2 +#ENV MAVEN_OPTS -Duser.home=/mal + +# Scala +RUN echo "deb http://dl.bintray.com/sbt/debian /" > /etc/apt/sources.list.d/sbt.list +RUN apt-get -y update + +RUN apt-get -y --force-yes install sbt +RUN apt-get -y install scala +ENV SBT_OPTS -Duser.home=/mal + diff --git a/impls/scala/Makefile b/impls/scala/Makefile new file mode 100644 index 0000000000..12ca5b834b --- /dev/null +++ b/impls/scala/Makefile @@ -0,0 +1,23 @@ +SOURCES_BASE = types.scala reader.scala printer.scala +SOURCES_LISP = env.scala core.scala stepA_mal.scala +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +TARGET_DIR=target/scala-2.11 + +all: $(TARGET_DIR)/mal.jar + +dist: mal + +mal: $(TARGET_DIR)/mal.jar + cp $< $@ + +$(TARGET_DIR)/mal.jar: + sbt assembly + +$(TARGET_DIR)/classes/step%.class: step%.scala $(SOURCES) + sbt assembly + +clean: + rm -rf mal target + +.PHONY: all dist clean diff --git a/impls/scala/assembly.sbt b/impls/scala/assembly.sbt new file mode 100644 index 0000000000..0b3ef91c19 --- /dev/null +++ b/impls/scala/assembly.sbt @@ -0,0 +1,6 @@ +import sbtassembly.AssemblyPlugin.defaultShellScript + +test in assembly := {} +assemblyJarName in assembly := "mal.jar" +mainClass in assembly := Some("stepA_mal") +assemblyOption in assembly ~= { _.copy(prependShellScript = Some(defaultShellScript)) } diff --git a/impls/scala/build.sbt b/impls/scala/build.sbt new file mode 100644 index 0000000000..c5bfda397c --- /dev/null +++ b/impls/scala/build.sbt @@ -0,0 +1,6 @@ +lazy val root = (project in file(".")). + settings( + name := "mal", + version := "0.1", + scalaVersion := "2.11.4" + ) diff --git a/scala/core.scala b/impls/scala/core.scala similarity index 81% rename from scala/core.scala rename to impls/scala/core.scala index 3317d08c9a..dc2e3f92ab 100644 --- a/scala/core.scala +++ b/impls/scala/core.scala @@ -14,16 +14,38 @@ object core { // Scalar functions def keyword(a: List[Any]) = { - "\u029e" + a(0).asInstanceOf[String] + val s = a(0).asInstanceOf[String] + if (0 < s.length && s(0) == '\u029e') s else "\u029e" + s } def keyword_Q(a: List[Any]) = { a(0) match { - case s: String => s(0) == '\u029e' + case s: String => s.length != 0 && s(0) == '\u029e' case _ => false } } + def string_Q(a: List[Any]) = { + a(0) match { + case s: String => s.length == 0 || s(0) != '\u029e' + case _ => false + } + } + + def fn_Q(a: List[Any]) = { + a(0) match { + case s: Func => true + case s: MalFunction => !s.asInstanceOf[MalFunction].ismacro + case _ => false + } + } + + def macro_Q(a: List[Any]) = { + a(0) match { + case s: MalFunction => s.asInstanceOf[MalFunction].ismacro + case _ => false + } + } // number functions def _bool_op(a: List[Any], op: (Long, Long) => Boolean) = { @@ -34,6 +56,10 @@ object core { op(a(0).asInstanceOf[Long],a(1).asInstanceOf[Long]) } + def number_Q(a: List[Any]) = { + a(0).isInstanceOf[Long] || a(0).isInstanceOf[Double] + } + // string functions def read_string(a: List[Any]) = { @@ -83,13 +109,18 @@ object core { } def first(a: List[Any]): Any = { - val lst = a(0).asInstanceOf[MalList].value - if (lst.length > 0) lst(0) else null + a(0) match { + case null => null + case ml: MalList => { + val lst = ml.value + if (lst.length > 0) lst(0) else null + } + } } def rest(a: List[Any]): Any = { a(0) match { - case null => true + case null => _list() case ml: MalList => _list(ml.drop(1).value:_*) } } @@ -108,17 +139,6 @@ object core { } } - def conj(a: List[Any]): Any = { - a(0) match { - case mv: MalVector => { - _vector(mv.value ++ a.slice(1,a.length):_*) - } - case ml: MalList => { - _list(a.slice(1,a.length).reverse ++ ml.value:_*) - } - } - } - def apply(a: List[Any]): Any = { a match { case f :: rest => { @@ -133,12 +153,40 @@ object core { def do_map(a: List[Any]): Any = { a match { case f :: seq :: Nil => { - seq.asInstanceOf[MalList].map(x => types._apply(f,List(x))) + var res = seq.asInstanceOf[MalList].map(x => types._apply(f,List(x))); + _list(res.value:_*) } case _ => throw new Exception("invalid map call") } } + def conj(a: List[Any]): Any = { + a(0) match { + case mv: MalVector => { + _vector(mv.value ++ a.slice(1,a.length):_*) + } + case ml: MalList => { + _list(a.slice(1,a.length).reverse ++ ml.value:_*) + } + } + } + + def seq(a: List[Any]): Any = { + a(0) match { + case mv: MalVector => { + if (mv.value.length == 0) null else _list(mv.value:_*) + } + case ml: MalList => { + if (ml.value.length == 0) null else ml + } + case ms: String => { + if (ms.length == 0) null else _list(ms.split("(?!^)"):_*) + } + case null => null + case _ => throw new Exception("seq: called on non-sequence") + } + } + // meta functions def with_meta(a: List[Any]): Any = { @@ -204,10 +252,14 @@ object core { "nil?" -> ((a: List[Any]) => a(0) == null), "true?" -> ((a: List[Any]) => a(0) == true), "false?" -> ((a: List[Any]) => a(0) == false), + "number?" -> number_Q _, + "string?" -> string_Q _, "symbol" -> ((a: List[Any]) => Symbol(a(0).asInstanceOf[String])), "symbol?" -> ((a: List[Any]) => a(0).isInstanceOf[Symbol]), "keyword" -> keyword _, "keyword?" -> keyword_Q _, + "fn?" -> fn_Q, + "macro?" -> macro_Q, "pr-str" -> ((a: List[Any]) => _pr_list(a, true, " ")), "str" -> ((a: List[Any]) => _pr_list(a, false, "")), @@ -243,15 +295,18 @@ object core { "sequential?" -> ((a: List[Any]) => types._sequential_Q(a(0))), "cons" -> ((a: List[Any]) => a(0) +: a(1).asInstanceOf[MalList]), "concat" -> concat _, + "vec" -> ((a: List[Any]) => _vector(a(0).asInstanceOf[MalList].value:_*)), "nth" -> nth _, "first" -> first _, "rest" -> rest _, "empty?" -> empty_Q _, "count" -> count _, - "conj" -> conj _, "apply" -> apply _, "map" -> do_map _, + "conj" -> conj _, + "seq" -> seq _, + "with-meta" -> with_meta _, "meta" -> meta _, "atom" -> ((a: List[Any]) => new types.Atom(a(0))), diff --git a/scala/env.scala b/impls/scala/env.scala similarity index 100% rename from scala/env.scala rename to impls/scala/env.scala diff --git a/scala/printer.scala b/impls/scala/printer.scala similarity index 100% rename from scala/printer.scala rename to impls/scala/printer.scala diff --git a/impls/scala/project/assembly.sbt b/impls/scala/project/assembly.sbt new file mode 100644 index 0000000000..652a3b93be --- /dev/null +++ b/impls/scala/project/assembly.sbt @@ -0,0 +1 @@ +addSbtPlugin("com.eed3si9n" % "sbt-assembly" % "0.14.6") diff --git a/scala/reader.scala b/impls/scala/reader.scala similarity index 86% rename from scala/reader.scala rename to impls/scala/reader.scala index de45923124..d4913f872b 100644 --- a/scala/reader.scala +++ b/impls/scala/reader.scala @@ -19,26 +19,33 @@ object reader { } def tokenize(str: String): Array[String] = { - val re = """[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)""".r + val re = """[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)""".r re.findAllMatchIn(str).map{ _.group(1) } .filter{ s => s != "" && s(0) != ';' } .toArray } def parse_str(s: String): String = { - s.replace("\\\"", "\"").replace("\\n", "\n") + // TODO: use re.replaceAllIn instead for single pass + s.replace("\\\\", "\u029e") + .replace("\\\"", "\"") + .replace("\\n", "\n") + .replace("\u029e", "\\") } def read_atom(rdr: Reader): Any = { val token = rdr.next() val re_int = """^(-?[0-9]+)$""".r val re_flt = """^(-?[0-9][0-9.]*)$""".r - val re_str = """^"(.*)"$""".r + val re_str = """^"((?:\\.|[^\\"])*)"$""".r + val re_str_bad = """^"(.*)$""".r val re_key = """^:(.*)$""".r return token match { case re_int(i) => i.toLong // integer case re_flt(f) => f.toDouble // float case re_str(s) => parse_str(s) // string + case re_str_bad(s) => + throw new Exception("expected '\"', got EOF") case re_key(k) => "\u029e" + k // keyword case "nil" => null case "true" => true diff --git a/impls/scala/run b/impls/scala/run new file mode 100755 index 0000000000..eb06292ab5 --- /dev/null +++ b/impls/scala/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec java -classpath "$(dirname $0)/target/scala-2.11/mal.jar" "${STEP:-stepA_mal}" "$@" diff --git a/scala/step0_repl.scala b/impls/scala/step0_repl.scala similarity index 100% rename from scala/step0_repl.scala rename to impls/scala/step0_repl.scala diff --git a/scala/step1_read_print.scala b/impls/scala/step1_read_print.scala similarity index 100% rename from scala/step1_read_print.scala rename to impls/scala/step1_read_print.scala diff --git a/scala/step2_eval.scala b/impls/scala/step2_eval.scala similarity index 77% rename from scala/step2_eval.scala rename to impls/scala/step2_eval.scala index d31d3396e2..1fb3277ee5 100644 --- a/scala/step2_eval.scala +++ b/impls/scala/step2_eval.scala @@ -7,25 +7,24 @@ object step2_eval { } // eval - def eval_ast(ast: Any, env: Map[Symbol,Any]): Any = { + def EVAL(ast: Any, env: Map[Symbol,Any]): Any = { + + // println("EVAL: " + printer._pr_str(ast,true)) + ast match { - case s : Symbol => env(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) + case s : Symbol => return env(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} + return m.map{case (k,v) => (k, EVAL(v, env))} } - case _ => ast + case _ => return ast } - } - - def EVAL(ast: Any, env: Map[Symbol,Any]): Any = { - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) // apply list - eval_ast(ast, env).asInstanceOf[MalList].value match { + if (ast.asInstanceOf[MalList].value.length == 0) + return ast + ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { var fn: List[Any] => Any = null try { diff --git a/scala/step3_env.scala b/impls/scala/step3_env.scala similarity index 79% rename from scala/step3_env.scala rename to impls/scala/step3_env.scala index 37572fe000..c3d9ae515f 100644 --- a/scala/step3_env.scala +++ b/impls/scala/step3_env.scala @@ -8,25 +8,30 @@ object step3_env { } // eval - def eval_ast(ast: Any, env: Env): Any = { + def EVAL(ast: Any, env: Env): Any = { + + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} + return m.map{case (k,v) => (k, EVAL(v, env))} } - case _ => ast + case _ => return ast } - } - - def EVAL(ast: Any, env: Env): Any = { - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) // apply list ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } @@ -39,7 +44,7 @@ object step3_env { } case _ => { // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { + ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { var fn: List[Any] => Any = null try { diff --git a/scala/step4_if_fn_do.scala b/impls/scala/step4_if_fn_do.scala similarity index 80% rename from scala/step4_if_fn_do.scala rename to impls/scala/step4_if_fn_do.scala index b6c2dc1e2b..a9d1572eea 100644 --- a/scala/step4_if_fn_do.scala +++ b/impls/scala/step4_if_fn_do.scala @@ -9,25 +9,30 @@ object step4_if_fn_do { } // eval - def eval_ast(ast: Any, env: Env): Any = { + def EVAL(ast: Any, env: Env): Any = { + + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} + return m.map{case (k,v) => (k, EVAL(v, env))} } - case _ => ast + case _ => return ast } - } - - def EVAL(ast: Any, env: Env): Any = { - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) // apply list ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } @@ -39,8 +44,8 @@ object step4_if_fn_do { return EVAL(a2, let_env) } case Symbol("do") :: rest => { - val el = eval_ast(_list(rest:_*), env) - return el.asInstanceOf[MalList].value.last + val el = rest.map(EVAL(_, env)) + return el.last } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) @@ -58,7 +63,7 @@ object step4_if_fn_do { } case _ => { // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { + ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { var fn: Func = null try { diff --git a/scala/step5_tco.scala b/impls/scala/step5_tco.scala similarity index 82% rename from scala/step5_tco.scala rename to impls/scala/step5_tco.scala index c4511e5029..247579b597 100644 --- a/scala/step5_tco.scala +++ b/impls/scala/step5_tco.scala @@ -9,28 +9,32 @@ object step5_tco { } // eval - def eval_ast(ast: Any, env: Env): Any = { - ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) - case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} - } - case _ => ast - } - } - def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + + ast match { + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} + case m: MalHashMap => { + return m.map{case (k,v) => (k, EVAL(v, env))} + } + case _ => return ast + } // apply list ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } @@ -43,7 +47,7 @@ object step5_tco { ast = a2 // continue loop (TCO) } case Symbol("do") :: rest => { - eval_ast(_list(rest.slice(0,rest.length-1):_*), env) + rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { @@ -64,7 +68,7 @@ object step5_tco { } case _ => { // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { + ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { f match { case fn: MalFunction => { diff --git a/scala/step6_file.scala b/impls/scala/step6_file.scala similarity index 83% rename from scala/step6_file.scala rename to impls/scala/step6_file.scala index 0dad7cd063..d9b356f418 100644 --- a/scala/step6_file.scala +++ b/impls/scala/step6_file.scala @@ -9,28 +9,32 @@ object step6_file { } // eval - def eval_ast(ast: Any, env: Env): Any = { - ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) - case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} - } - case _ => ast - } - } - def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + + ast match { + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} + case m: MalHashMap => { + return m.map{case (k,v) => (k, EVAL(v, env))} + } + case _ => return ast + } // apply list ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } @@ -43,7 +47,7 @@ object step6_file { ast = a2 // continue loop (TCO) } case Symbol("do") :: rest => { - eval_ast(_list(rest.slice(0,rest.length-1):_*), env) + rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { @@ -64,7 +68,7 @@ object step6_file { } case _ => { // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { + ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { f match { case fn: MalFunction => { @@ -105,7 +109,7 @@ object step6_file { // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if (args.length > 0) { REP("(load-file \"" + args(0) + "\")") diff --git a/impls/scala/step7_quote.scala b/impls/scala/step7_quote.scala new file mode 100644 index 0000000000..632ceca7ef --- /dev/null +++ b/impls/scala/step7_quote.scala @@ -0,0 +1,177 @@ +import types.{MalList, _list, _list_Q, MalVector, MalHashMap, + Func, MalFunction} +import env.Env + +object step7_quote { + // read + def READ(str: String): Any = { + reader.read_str(str) + } + + // eval + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc + } + + def quasiquote(ast: Any): Any = { + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) + } + } + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast + } + } + + def EVAL(orig_ast: Any, orig_env: Env): Any = { + var ast = orig_ast; var env = orig_env; + while (true) { + + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + + ast match { + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} + case m: MalHashMap => { + return m.map{case (k,v) => (k, EVAL(v, env))} + } + case _ => return ast + } + + // apply list + ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } + case Symbol("def!") :: a1 :: a2 :: Nil => { + return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) + } + case Symbol("let*") :: a1 :: a2 :: Nil => { + val let_env = new Env(env) + for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { + let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) + } + env = let_env + ast = a2 // continue loop (TCO) + } + case Symbol("quote") :: a1 :: Nil => { + return a1 + } + case Symbol("quasiquote") :: a1 :: Nil => { + ast = quasiquote(a1) // continue loop (TCO) + } + case Symbol("do") :: rest => { + rest.slice(0,rest.length-1).map(EVAL(_, env)) + ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) + } + case Symbol("if") :: a1 :: a2 :: rest => { + val cond = EVAL(a1, env) + if (cond == null || cond == false) { + if (rest.length == 0) return null + ast = rest(0) // continue loop (TCO) + } else { + ast = a2 // continue loop (TCO) + } + } + case Symbol("fn*") :: a1 :: a2 :: Nil => { + return new MalFunction(a2, env, a1.asInstanceOf[MalList], + (args: List[Any]) => { + EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) + } + ) + } + case _ => { + // function call + ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { + case f :: el => { + f match { + case fn: MalFunction => { + env = fn.gen_env(el) + ast = fn.ast // continue loop (TCO) + } + case fn: Func => { + return fn(el) + } + case _ => { + throw new Exception("attempt to call non-function: " + f) + } + } + } + case _ => throw new Exception("invalid apply") + } + } + } + } + } + + // print + def PRINT(exp: Any): String = { + printer._pr_str(exp, true) + } + + // repl + def main(args: Array[String]) = { + val repl_env: Env = new Env() + val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) + + // core.scala: defined using scala + core.ns.map{case (k: String,v: Any) => { + repl_env.set(Symbol(k), new Func(v)) + }} + repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) + repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + + if (args.length > 0) { + REP("(load-file \"" + args(0) + "\")") + System.exit(0) + } + + // repl loop + var line:String = null + while ({line = readLine("user> "); line != null}) { + try { + println(REP(line)) + } catch { + case e : Throwable => { + println("Error: " + e.getMessage) + println(" " + e.getStackTrace.mkString("\n ")) + } + } + } + } +} + +// vim: ts=2:sw=2 diff --git a/impls/scala/step8_macros.scala b/impls/scala/step8_macros.scala new file mode 100644 index 0000000000..f5c382de24 --- /dev/null +++ b/impls/scala/step8_macros.scala @@ -0,0 +1,186 @@ +import types.{MalList, _list, _list_Q, MalVector, MalHashMap, + Func, MalFunction} +import env.Env + +object step8_macros { + // read + def READ(str: String): Any = { + reader.read_str(str) + } + + // eval + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc + } + + def quasiquote(ast: Any): Any = { + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) + } + } + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast + } + } + + def EVAL(orig_ast: Any, orig_env: Env): Any = { + var ast = orig_ast; var env = orig_env; + while (true) { + + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + + ast match { + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} + case m: MalHashMap => { + return m.map{case (k,v) => (k, EVAL(v, env))} + } + case _ => return ast + } + + // apply list + + ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } + case Symbol("def!") :: a1 :: a2 :: Nil => { + return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) + } + case Symbol("let*") :: a1 :: a2 :: Nil => { + val let_env = new Env(env) + for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { + let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) + } + env = let_env + ast = a2 // continue loop (TCO) + } + case Symbol("quote") :: a1 :: Nil => { + return a1 + } + case Symbol("quasiquote") :: a1 :: Nil => { + ast = quasiquote(a1) // continue loop (TCO) + } + case Symbol("defmacro!") :: a1 :: a2 :: Nil => { + val f = EVAL(a2, env).asInstanceOf[MalFunction].clone() + f.ismacro = true + return env.set(a1.asInstanceOf[Symbol], f) + } + case Symbol("do") :: rest => { + rest.slice(0,rest.length-1).map(EVAL(_, env)) + ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) + } + case Symbol("if") :: a1 :: a2 :: rest => { + val cond = EVAL(a1, env) + if (cond == null || cond == false) { + if (rest.length == 0) return null + ast = rest(0) // continue loop (TCO) + } else { + ast = a2 // continue loop (TCO) + } + } + case Symbol("fn*") :: a1 :: a2 :: Nil => { + return new MalFunction(a2, env, a1.asInstanceOf[MalList], + (args: List[Any]) => { + EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) + } + ) + } + case first :: rest => { + // function call + EVAL(first, env) match { + case fn: MalFunction => { + if (fn.ismacro) { + ast = fn(rest) // continue loop (TCO) + } else { + val el = rest.map(EVAL(_, env)) + env = fn.gen_env(el) + ast = fn.ast // continue loop (TCO) + } + } + case fn: Func => { + val el = rest.map(EVAL(_, env)) + return fn(el) + } + case f => { + throw new Exception("attempt to call non-function: " + f) + } + } + } + } + } + } + + // print + def PRINT(exp: Any): String = { + printer._pr_str(exp, true) + } + + // repl + def main(args: Array[String]) = { + val repl_env: Env = new Env() + val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) + + // core.scala: defined using scala + core.ns.map{case (k: String,v: Any) => { + repl_env.set(Symbol(k), new Func(v)) + }} + repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) + repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + + if (args.length > 0) { + REP("(load-file \"" + args(0) + "\")") + System.exit(0) + } + + // repl loop + var line:String = null + while ({line = readLine("user> "); line != null}) { + try { + println(REP(line)) + } catch { + case e : Throwable => { + println("Error: " + e.getMessage) + println(" " + e.getStackTrace.mkString("\n ")) + } + } + } + } +} + +// vim: ts=2:sw=2 diff --git a/impls/scala/step9_try.scala b/impls/scala/step9_try.scala new file mode 100644 index 0000000000..f66d33f057 --- /dev/null +++ b/impls/scala/step9_try.scala @@ -0,0 +1,207 @@ +import types.{MalList, _list, _list_Q, MalVector, MalHashMap, + Func, MalFunction} +import env.Env + +object step9_try { + // read + def READ(str: String): Any = { + reader.read_str(str) + } + + // eval + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc + } + + def quasiquote(ast: Any): Any = { + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) + } + } + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast + } + } + + def EVAL(orig_ast: Any, orig_env: Env): Any = { + var ast = orig_ast; var env = orig_env; + while (true) { + + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + + ast match { + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} + case m: MalHashMap => { + return m.map{case (k,v) => (k, EVAL(v, env))} + } + case _ => return ast + } + + // apply list + + ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } + case Symbol("def!") :: a1 :: a2 :: Nil => { + return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) + } + case Symbol("let*") :: a1 :: a2 :: Nil => { + val let_env = new Env(env) + for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { + let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) + } + env = let_env + ast = a2 // continue loop (TCO) + } + case Symbol("quote") :: a1 :: Nil => { + return a1 + } + case Symbol("quasiquote") :: a1 :: Nil => { + ast = quasiquote(a1) // continue loop (TCO) + } + case Symbol("defmacro!") :: a1 :: a2 :: Nil => { + val f = EVAL(a2, env).asInstanceOf[MalFunction].clone() + f.ismacro = true + return env.set(a1.asInstanceOf[Symbol], f) + } + case Symbol("try*") :: a1 :: rest => { + try { + return EVAL(a1, env) + } catch { + case t: Throwable => { + if (rest.length == 0) throw t + rest(0).asInstanceOf[MalList].value match { + case List(Symbol("catch*"), a21, a22) => { + val exc: Any = t match { + case mex: types.MalException => mex.value + case _ => t.getMessage + } + return EVAL(a22, new Env(env, + List(a21).iterator, + List(exc).iterator)) + } + } + throw t + } + } + } + case Symbol("do") :: rest => { + rest.slice(0,rest.length-1).map(EVAL(_, env)) + ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) + } + case Symbol("if") :: a1 :: a2 :: rest => { + val cond = EVAL(a1, env) + if (cond == null || cond == false) { + if (rest.length == 0) return null + ast = rest(0) // continue loop (TCO) + } else { + ast = a2 // continue loop (TCO) + } + } + case Symbol("fn*") :: a1 :: a2 :: Nil => { + return new MalFunction(a2, env, a1.asInstanceOf[MalList], + (args: List[Any]) => { + EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) + } + ) + } + case first :: rest => { + // function call + EVAL(first, env) match { + case fn: MalFunction => { + if (fn.ismacro) { + ast = fn(rest) // continue loop (TCO) + } else { + val el = rest.map(EVAL(_, env)) + env = fn.gen_env(el) + ast = fn.ast // continue loop (TCO) + } + } + case fn: Func => { + val el = rest.map(EVAL(_, env)) + return fn(el) + } + case f => { + throw new Exception("attempt to call non-function: " + f) + } + } + } + } + } + } + + // print + def PRINT(exp: Any): String = { + printer._pr_str(exp, true) + } + + // repl + def main(args: Array[String]) = { + val repl_env: Env = new Env() + val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) + + // core.scala: defined using scala + core.ns.map{case (k: String,v: Any) => { + repl_env.set(Symbol(k), new Func(v)) + }} + repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) + repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) + + // core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + + if (args.length > 0) { + REP("(load-file \"" + args(0) + "\")") + System.exit(0) + } + + // repl loop + var line:String = null + while ({line = readLine("user> "); line != null}) { + try { + println(REP(line)) + } catch { + case e : Throwable => { + println("Error: " + e.getMessage) + println(" " + e.getStackTrace.mkString("\n ")) + } + } + } + } +} + +// vim: ts=2:sw=2 diff --git a/impls/scala/stepA_mal.scala b/impls/scala/stepA_mal.scala new file mode 100644 index 0000000000..130d5e5712 --- /dev/null +++ b/impls/scala/stepA_mal.scala @@ -0,0 +1,209 @@ +import types.{MalList, _list, _list_Q, MalVector, MalHashMap, + Func, MalFunction} +import env.Env + +object stepA_mal { + // read + def READ(str: String): Any = { + reader.read_str(str) + } + + // eval + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc + } + + def quasiquote(ast: Any): Any = { + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) + } + } + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast + } + } + + def EVAL(orig_ast: Any, orig_env: Env): Any = { + var ast = orig_ast; var env = orig_env; + while (true) { + + if (env.find(Symbol("DEBUG-EVAL")) != null) { + val dbgeval = env.get(Symbol("DEBUG-EVAL")) + if (dbgeval != null && dbgeval != false) { + println("EVAL: " + printer._pr_str(ast,true)) + } + } + + ast match { + case s : Symbol => return env.get(s) + case v: MalVector => return v.map(EVAL(_, env)) + case l: MalList => {} + case m: MalHashMap => { + return m.map{case (k,v) => (k, EVAL(v, env))} + } + case _ => return ast + } + + // apply list + + ast.asInstanceOf[MalList].value match { + case Nil => { + return ast + } + case Symbol("def!") :: a1 :: a2 :: Nil => { + return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) + } + case Symbol("let*") :: a1 :: a2 :: Nil => { + val let_env = new Env(env) + for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { + let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) + } + env = let_env + ast = a2 // continue loop (TCO) + } + case Symbol("quote") :: a1 :: Nil => { + return a1 + } + case Symbol("quasiquote") :: a1 :: Nil => { + ast = quasiquote(a1) // continue loop (TCO) + } + case Symbol("defmacro!") :: a1 :: a2 :: Nil => { + val f = EVAL(a2, env).asInstanceOf[MalFunction].clone() + f.ismacro = true + return env.set(a1.asInstanceOf[Symbol], f) + } + case Symbol("try*") :: a1 :: rest => { + try { + return EVAL(a1, env) + } catch { + case t: Throwable => { + if (rest.length == 0) throw t + rest(0).asInstanceOf[MalList].value match { + case List(Symbol("catch*"), a21, a22) => { + val exc: Any = t match { + case mex: types.MalException => mex.value + case _ => t.getMessage + } + return EVAL(a22, new Env(env, + List(a21).iterator, + List(exc).iterator)) + } + } + throw t + } + } + } + case Symbol("do") :: rest => { + rest.slice(0,rest.length-1).map(EVAL(_, env)) + ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) + } + case Symbol("if") :: a1 :: a2 :: rest => { + val cond = EVAL(a1, env) + if (cond == null || cond == false) { + if (rest.length == 0) return null + ast = rest(0) // continue loop (TCO) + } else { + ast = a2 // continue loop (TCO) + } + } + case Symbol("fn*") :: a1 :: a2 :: Nil => { + return new MalFunction(a2, env, a1.asInstanceOf[MalList], + (args: List[Any]) => { + EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) + } + ) + } + case first :: rest => { + // function call + EVAL(first, env) match { + case fn: MalFunction => { + if (fn.ismacro) { + ast = fn(rest) // continue loop (TCO) + } else { + val el = rest.map(EVAL(_, env)) + env = fn.gen_env(el) + ast = fn.ast // continue loop (TCO) + } + } + case fn: Func => { + val el = rest.map(EVAL(_, env)) + return fn(el) + } + case f => { + throw new Exception("attempt to call non-function: " + f) + } + } + } + } + } + } + + // print + def PRINT(exp: Any): String = { + printer._pr_str(exp, true) + } + + // repl + def main(args: Array[String]) = { + val repl_env: Env = new Env() + val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) + + // core.scala: defined using scala + core.ns.map{case (k: String,v: Any) => { + repl_env.set(Symbol(k), new Func(v)) + }} + repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) + repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) + + // core.mal: defined using the language itself + REP("(def! *host-language* \"scala\")") + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + + if (args.length > 0) { + REP("(load-file \"" + args(0) + "\")") + System.exit(0) + } + + // repl loop + REP("(println (str \"Mal [\" *host-language* \"]\"))") + var line:String = null + while ({line = readLine("user> "); line != null}) { + try { + println(REP(line)) + } catch { + case e : Throwable => { + println("Error: " + e.getMessage) + println(" " + e.getStackTrace.mkString("\n ")) + } + } + } + } +} + +// vim: ts=2:sw=2 diff --git a/impls/scala/tests/step5_tco.mal b/impls/scala/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/scala/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/scala/types.scala b/impls/scala/types.scala similarity index 82% rename from scala/types.scala rename to impls/scala/types.scala index 91af0683e0..b0c84f912e 100644 --- a/scala/types.scala +++ b/impls/scala/types.scala @@ -22,8 +22,20 @@ object types { def _equal_Q(a: Any, b: Any): Any = { (a, b) match { - case (a: MalList, b: MalList) => a.value == b.value - case (a: MalHashMap, b: MalHashMap) => a.value == b.value + case (a: MalList, b: MalList) => { + if (a.value.length != b.value.length) return false + for ( (x, y) <- (a.value zip b.value) ) { + if (_equal_Q(x, y) != true) return false + } + true + } + case (a: MalHashMap, b: MalHashMap) => { + if (a.value.size != b.value.size) return false + for ( (k,v) <- a.value ) { + if (_equal_Q(v,b.value(k)) != true) return false + } + true + } case _ => a == b } } @@ -100,15 +112,13 @@ object types { // Hash Maps class MalHashMap(seq: Any*) { - var flat_value: List[Any] = seq.toList - var value: Map[String,Any] = flat_value.grouped(2).map( + var value: Map[String,Any] = seq.toList.grouped(2).map( (kv: List[Any]) => (kv(0).asInstanceOf[String], kv(1))).toMap var meta: Any = null override def clone(): MalHashMap = { val new_hm = new MalHashMap() new_hm.value = value - new_hm.flat_value = flat_value new_hm.meta = meta new_hm } @@ -126,14 +136,26 @@ object types { new MalHashMap(res.flatten.toSeq:_*) } def ++(that: MalHashMap) = { - new MalHashMap((flat_value ++ that.flat_value):_*) + val new_hm = clone() + new_hm.value ++= that.value + new_hm } override def toString() = { - "{" + flat_value.map(_pr_str(_, true)).mkString(" ") + "}" + var res = mutable.MutableList[Any]() + for ((k,v) <- value) { + res += _pr_str(k, true) + res += _pr_str(v, true) + } + "{" + res.mkString(" ") + "}" } def toString(print_readably: Boolean) = { - "{" + flat_value.map(_pr_str(_, print_readably)).mkString(" ") + "}" + var res = mutable.MutableList[Any]() + for ((k,v) <- value) { + res += _pr_str(k, print_readably) + res += _pr_str(v, print_readably) + } + "{" + res.mkString(" ") + "}" } } def _hash_map(seq: Any*) = { diff --git a/impls/scheme/.gitignore b/impls/scheme/.gitignore new file mode 100644 index 0000000000..31fc0e8966 --- /dev/null +++ b/impls/scheme/.gitignore @@ -0,0 +1,11 @@ +lib/*.scm +lib/*.so +lib/*.c +lib/*.o +lib/*.meta +lib.*.scm +*.so +*.c +*.o +out/ +eggs/* \ No newline at end of file diff --git a/impls/scheme/Dockerfile b/impls/scheme/Dockerfile new file mode 100644 index 0000000000..51583034af --- /dev/null +++ b/impls/scheme/Dockerfile @@ -0,0 +1,59 @@ +FROM ubuntu:focal +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Dev tools +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install gcc g++ bison flex groff make cmake pkg-config git + +# Prepackaged Scheme implementations +RUN apt-get -y install gauche chicken-bin +RUN chicken-install r7rs + +# Chibi +RUN cd /tmp && curl -Lo chibi-0.10.tar.gz https://github.com/ashinn/chibi-scheme/archive/0.10.tar.gz \ + && tar xvzf chibi-0.10.tar.gz && cd chibi-scheme-0.10 \ + && make && make install && rm -rf /tmp/chibi-* + +# Kawa +RUN apt-get -y install openjdk-8-jdk-headless +RUN cd /tmp && curl -O http://ftp.gnu.org/pub/gnu/kawa/kawa-3.1.1.tar.gz \ + && tar xvzf kawa-3.1.1.tar.gz && cd kawa-3.1.1 \ + && ./configure && make && make install && rm -rf /tmp/kawa-3.1.1* + +# Sagittarius +RUN apt-get -y install libgc-dev zlib1g-dev libffi-dev libssl-dev +RUN cd /tmp && curl -LO https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/sagittarius-0.9.7.tar.gz \ + && tar xvzf sagittarius-0.9.7.tar.gz && cd sagittarius-0.9.7 \ + && cmake . && make && make install && rm -rf /tmp/sagittarius-0.9.7* + +# Cyclone +RUN apt-get -y install libck-dev libtommath-dev +RUN cd /tmp && git clone https://github.com/justinethier/cyclone-bootstrap \ + && cd cyclone-bootstrap \ + && make && make install && rm -rf /tmp/cyclone-bootstrap + +# Foment +RUN cd /tmp && git clone https://github.com/leftmike/foment \ + && cd foment/unix && make && cp release/foment /usr/bin/foment \ + && rm -rf /tmp/foment + +ENV HOME /mal diff --git a/impls/scheme/Makefile b/impls/scheme/Makefile new file mode 100644 index 0000000000..87b22e450e --- /dev/null +++ b/impls/scheme/Makefile @@ -0,0 +1,87 @@ +BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco +BINS += step6_file step7_quote step8_macros step9_try stepA_mal +scheme_MODE ?= chibi + +CLASSSTEPS = out/step0_repl.class out/step1_read_print.class \ + out/step3_env.class out/step4_if_fn_do.class out/step5_tco.class \ + out/step6_file.class out/step7_quote.class out/step8_macros.class \ + out/step9_try.class out/stepA_mal.class +STEPS = $(if $(filter kawa,$(scheme_MODE)),$(CLASSSTEPS),\ + $(if $(filter chicken,$(scheme_MODE)),$(BINS),\ + $(if $(filter cyclone,$(scheme_MODE)),$(BINS)))) + +KAWA_STEP1_DEPS = out/lib/util.class out/lib/reader.class \ + out/lib/printer.class out/lib/types.class +KAWA_STEP3_DEPS = $(KAWA_STEP1_DEPS) out/lib/env.class +KAWA_STEP4_DEPS = $(KAWA_STEP3_DEPS) out/lib/core.class +CHICKEN_STEP1_DEPS = lib.util.so lib.types.so lib.reader.so lib.printer.so +CHICKEN_STEP3_DEPS = $(CHICKEN_STEP1_DEPS) lib.env.so +CHICKEN_STEP4_DEPS = $(CHICKEN_STEP3_DEPS) lib.core.so +CYCLONE_STEP1_DEPS = lib/util.so lib/reader.so lib/printer.so lib/types.so +CYCLONE_STEP3_DEPS = $(CYCLONE_STEP1_DEPS) lib/env.so +CYCLONE_STEP4_DEPS = $(CYCLONE_STEP3_DEPS) lib/core.so + +STEP1_DEPS = $(if $(filter kawa,$(scheme_MODE)),$(KAWA_STEP1_DEPS),\ + $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN_STEP1_DEPS),\ + $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE_STEP1_DEPS)))) +STEP3_DEPS = $(if $(filter kawa,$(scheme_MODE)),$(KAWA_STEP3_DEPS),\ + $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN_STEP3_DEPS),\ + $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE_STEP3_DEPS)))) +STEP4_DEPS = $(if $(filter kawa,$(scheme_MODE)),$(KAWA_STEP4_DEPS),\ + $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN_STEP4_DEPS),\ + $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE_STEP4_DEPS)))) + +KAWALIB = kawa --r7rs --no-warn-unused -d out -C +KAWA = kawa --r7rs --no-warn-unused -d out --main -C +CHICKEN = csc -setup-mode -host -O3 -R r7rs +CHICKENLIB = $(CHICKEN) -D compiling-extension -J -s -regenerate-import-libraries +CYCLONELIB = cyclone -O2 +CYCLONE = $(CYCLONELIB) + +SCMLIB = $(if $(filter kawa,$(scheme_MODE)),$(KAWALIB),\ + $(if $(filter chicken,$(scheme_MODE)),$(CHICKENLIB),\ + $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONELIB)))) +SCM = $(if $(filter kawa,$(scheme_MODE)),$(KAWA),\ + $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN),\ + $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE)))) + +MKDIR = mkdir -p +SYMLINK = ln -sfr +RM = rm -f +RMR = rm -rf + +all: $(STEPS) + +.PHONY: clean +.PRECIOUS: lib/%.scm + +lib/%.scm: lib/%.sld + $(SYMLINK) $< $@ + +out/lib/%.class: lib/%.scm + $(SCMLIB) $< + +out/%.class: %.scm + $(SCM) $< + +lib.%.so: lib/%.sld + $(SCMLIB) $< -o $@ + +lib/%.so: lib/%.sld + $(SCMLIB) $< + +%: %.scm + $(SCM) $< + +out/step1_read_print.class out/step2_eval.class: $(STEP1_DEPS) +out/step3_env.class: $(STEP3_DEPS) +out/step4_if_fn_do.class out/step5_tco.class out/step6_file.class out/step7_quote.class out/step8_macros.class out/step9_try.class out/stepA_mal.class: $(STEP4_DEPS) + +step1_read_print.scm step2_eval.scm: $(STEP1_DEPS) +step3_env.scm: $(STEP3_DEPS) +step4_if_fn_do.scm step5_tco.scm step6_file.scm step7_quote.scm step8_macros.scm step9_try.scm stepA_mal.scm: $(STEP4_DEPS) + +clean: + $(RM) lib/*.scm lib/*.so lib/*.c lib/*.o lib/*.meta + $(RM) lib.*.scm *.build.sh *.install.sh *.link *.so *.c *.o $(BINS) + $(RMR) out diff --git a/impls/scheme/lib/core.sld b/impls/scheme/lib/core.sld new file mode 100644 index 0000000000..dcb8267f4f --- /dev/null +++ b/impls/scheme/lib/core.sld @@ -0,0 +1,302 @@ +(define-library (lib core) + +(export ns) + +(import (scheme base)) +(import (scheme write)) +(import (scheme file)) +(import (scheme time)) +(import (scheme read)) +(import (scheme eval)) +;; HACK: cyclone doesn't implement environments yet, but its eval +;; behaves as if you were using the repl environment +(cond-expand + (cyclone) + (else + (import (scheme repl)))) + +(import (lib types)) +(import (lib util)) +(import (lib printer)) +(import (lib reader)) + +(begin + +(define (coerce x) + (if x mal-true mal-false)) + +(define (->printed-string args print-readably sep) + (let ((items (map (lambda (arg) (pr-str arg print-readably)) args))) + (string-intersperse items sep))) + +(define (mal-equal? a b) + (let ((a-type (and (mal-object? a) (mal-type a))) + (a-value (and (mal-object? a) (mal-value a))) + (b-type (and (mal-object? b) (mal-type b))) + (b-value (and (mal-object? b) (mal-value b)))) + (cond + ((or (not a-type) (not b-type)) + mal-false) + ((and (memq a-type '(list vector)) + (memq b-type '(list vector))) + (mal-list-equal? (->list a-value) (->list b-value))) + ((and (eq? a-type 'map) (eq? b-type 'map)) + (mal-map-equal? a-value b-value)) + (else + (and (eq? a-type b-type) + (equal? a-value b-value)))))) + +(define (mal-list-equal? as bs) + (let loop ((as as) + (bs bs)) + (cond + ((and (null? as) (null? bs)) #t) + ((or (null? as) (null? bs)) #f) + (else + (if (mal-equal? (car as) (car bs)) + (loop (cdr as) (cdr bs)) + #f))))) + +(define (mal-map-ref key m . default) + (if (pair? default) + (alist-ref key m mal-equal? (car default)) + (alist-ref key m mal-equal?))) + +(define (mal-map-equal? as bs) + (if (not (= (length as) (length bs))) + #f + (let loop ((as as)) + (if (pair? as) + (let* ((item (car as)) + (key (car item)) + (value (cdr item))) + (if (mal-equal? (mal-map-ref key bs) value) + (loop (cdr as)) + #f)) + #t)))) + +(define (mal-map-dissoc m keys) + (let loop ((items m) + (acc '())) + (if (pair? items) + (let* ((item (car items)) + (key (car item))) + (if (contains? keys (lambda (x) (mal-equal? key x))) + (loop (cdr items) acc) + (loop (cdr items) (cons item acc)))) + (reverse acc)))) + +(define (mal-map-assoc m kvs) + (let ((kvs (list->alist kvs))) + (append kvs (mal-map-dissoc m (map car kvs))))) + +(define (map-in-order proc items) + (let loop ((items items) + (acc '())) + (if (null? items) + (reverse acc) + (loop (cdr items) (cons (proc (car items)) acc))))) + +(define (slurp path) + (call-with-output-string + (lambda (out) + (call-with-input-file path + (lambda (in) + (let loop () + (let ((chunk (read-string 1024 in))) + (when (not (eof-object? chunk)) + (display chunk out) + (loop))))))))) + +(define (time-ms) + (* (/ (current-jiffy) (jiffies-per-second)) 1000.0)) + +(define (->mal-object x) + (cond + ((boolean? x) (if x mal-true mal-false)) + ((char? x) (mal-string (char->string x))) + ((procedure? x) x) + ((symbol? x) (mal-symbol x)) + ((number? x) (mal-number x)) + ((string? x) (mal-string x)) + ((or (null? x) (pair? x)) + (mal-list (map ->mal-object x))) + ((vector? x) + (mal-vector (vector-map ->mal-object x))) + (else + (error "unknown type")))) + +(define (scm-eval input) + (call-with-input-string input + (lambda (port) + (cond-expand + (cyclone + (->mal-object (eval (read port)))) + (else + (->mal-object (eval (read port) (environment '(scheme base) + '(scheme write))))))))) + +(define ns + `((+ . ,(lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) + (- . ,(lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) + (* . ,(lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) + (/ . ,(lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))) + + (list . ,(lambda args (mal-list args))) + (list? . ,(lambda (x) (coerce (mal-instance-of? x 'list)))) + (empty? . ,(lambda (lis) (coerce (null? (->list (mal-value lis)))))) + (count . ,(lambda (lis) (mal-number + (if (eq? lis mal-nil) + 0 + (length (->list (mal-value lis))))))) + + (< . ,(lambda (a b) (coerce (< (mal-value a) (mal-value b))))) + (<= . ,(lambda (a b) (coerce (<= (mal-value a) (mal-value b))))) + (> . ,(lambda (a b) (coerce (> (mal-value a) (mal-value b))))) + (>= . ,(lambda (a b) (coerce (>= (mal-value a) (mal-value b))))) + (= . ,(lambda (a b) (coerce (mal-equal? a b)))) + + (pr-str . ,(lambda args (mal-string (->printed-string args #t " ")))) + (str . ,(lambda args (mal-string (->printed-string args #f "")))) + (prn . ,(lambda args + (display (->printed-string args #t " ")) + (newline) + mal-nil)) + (println . ,(lambda args + (display (->printed-string args #f " ")) + (newline) + mal-nil)) + + (read-string . ,(lambda (string) (read-str (mal-value string)))) + (slurp . ,(lambda (path) (mal-string (slurp (mal-value path))))) + (throw . ,(lambda (x) (raise (cons 'user-error x)))) + (readline . ,(lambda (prompt) (let ((output (readline (mal-value prompt)))) + (if output (mal-string output) mal-nil)))) + (time-ms . ,(lambda () (mal-number (time-ms)))) + (scm-eval . ,(lambda (input) (scm-eval (mal-value input)))) + + (atom . ,(lambda (x) (mal-atom x))) + (atom? . ,(lambda (x) (coerce (mal-instance-of? x 'atom)))) + (deref . ,(lambda (atom) (mal-value atom))) + (reset! . ,(lambda (atom x) (mal-value-set! atom x) x)) + (swap! . ,(lambda (atom fn . args) + (let* ((fn (if (func? fn) (func-fn fn) fn)) + (value (apply fn (cons (mal-value atom) args)))) + (mal-value-set! atom value) + value))) + + (cons . ,(lambda (x xs) (mal-list (cons x (->list (mal-value xs)))))) + (concat . ,(lambda args (mal-list (apply append (map (lambda (arg) (->list (mal-value arg))) args))))) + (vec . ,(lambda (x) + (case (mal-type x) + ((vector) x) + ((list) (mal-vector (list->vector (mal-value x)))) + (else (error "seq expects a sequence"))))) + (nth . ,(lambda (x n) (let ((items (->list (mal-value x))) + (index (mal-value n))) + (if (< index (length items)) + (list-ref items index) + (error (str "Out of range: " index)))))) + (first . ,(lambda (x) (if (eq? x mal-nil) + mal-nil + (let ((items (->list (mal-value x)))) + (if (null? items) + mal-nil + (car items)))))) + (rest . ,(lambda (x) (if (eq? x mal-nil) + (mal-list '()) + (let ((items (->list (mal-value x)))) + (if (null? items) + (mal-list '()) + (mal-list (cdr items))))))) + (conj . ,(lambda (coll . args) + (let ((items (mal-value coll))) + (cond + ((vector? items) + (mal-vector (vector-append items (list->vector args)))) + ((list? items) + (mal-list (append (reverse args) items))) + (else + (error "invalid collection type")))))) + (seq . ,(lambda (x) (if (eq? x mal-nil) + mal-nil + (let ((value (mal-value x))) + (case (mal-type x) + ((list) + (if (null? value) + mal-nil + x)) + ((vector) + (if (zero? (vector-length value)) + mal-nil + (mal-list (vector->list value)))) + ((string) + (if (zero? (string-length value)) + mal-nil + (mal-list (map mal-string (explode value))))) + (else + (error "invalid collection type"))))))) + + (apply . ,(lambda (f . args) (apply (if (func? f) (func-fn f) f) + (if (pair? (cdr args)) + (append (butlast args) + (->list (mal-value (last args)))) + (->list (mal-value (car args))))))) + (map . ,(lambda (f items) (mal-list (map-in-order + (if (func? f) (func-fn f) f) + (->list (mal-value items)))))) + + (nil? . ,(lambda (x) (coerce (eq? x mal-nil)))) + (true? . ,(lambda (x) (coerce (eq? x mal-true)))) + (false? . ,(lambda (x) (coerce (eq? x mal-false)))) + (number? . ,(lambda (x) (coerce (mal-instance-of? x 'number)))) + (string? . ,(lambda (x) (coerce (mal-instance-of? x 'string)))) + (symbol? . ,(lambda (x) (coerce (mal-instance-of? x 'symbol)))) + (symbol . ,(lambda (x) (mal-symbol (string->symbol (mal-value x))))) + (keyword? . ,(lambda (x) (coerce (mal-instance-of? x 'keyword)))) + (keyword . ,(lambda (x) (if (mal-instance-of? x 'keyword) + x + (mal-keyword (string->symbol (mal-value x)))))) + (vector? . ,(lambda (x) (coerce (mal-instance-of? x 'vector)))) + (vector . ,(lambda args (mal-vector (list->vector args)))) + (map? . ,(lambda (x) (coerce (mal-instance-of? x 'map)))) + (hash-map . ,(lambda args (mal-map (list->alist args)))) + (sequential? . ,(lambda (x) (coerce (and (mal-object? x) + (memq (mal-type x) + '(list vector)))))) + (fn? . ,(lambda (x) (coerce (or (procedure? x) + (and (func? x) (not (func-macro? x))))))) + (macro? . ,(lambda (x) (coerce (and (func? x) (func-macro? x))))) + + (assoc . ,(lambda (m . kvs) (mal-map (mal-map-assoc (mal-value m) kvs)))) + (dissoc . ,(lambda (m . keys) (mal-map (mal-map-dissoc (mal-value m) keys)))) + (get . ,(lambda (m key) (mal-map-ref key (mal-value m) mal-nil))) + (contains? . ,(lambda (m key) (coerce (mal-map-ref key (mal-value m))))) + (keys . ,(lambda (m) (mal-list (map car (mal-value m))))) + (vals . ,(lambda (m) (mal-list (map cdr (mal-value m))))) + + (with-meta . ,(lambda (x meta) + (cond + ((mal-object? x) + (make-mal-object (mal-type x) (mal-value x) meta)) + ((func? x) + (let ((func (make-func (func-ast x) (func-params x) + (func-env x) (func-fn x)))) + (func-macro?-set! func #f) + (func-meta-set! func meta) + func)) + (else + (error "unsupported type"))))) + (meta . ,(lambda (x) (cond + ((mal-object? x) + (or (mal-meta x) mal-nil)) + ((func? x) + (or (func-meta x) mal-nil)) + (else + mal-nil)))) + + )) + +) + +) diff --git a/impls/scheme/lib/env.sld b/impls/scheme/lib/env.sld new file mode 100644 index 0000000000..0be5439e25 --- /dev/null +++ b/impls/scheme/lib/env.sld @@ -0,0 +1,43 @@ +(define-library (lib env) + +(export make-env env-set env-get) + +(import (scheme base)) + +(import (lib util)) +(import (lib types)) + +(begin + +(define-record-type env + (%make-env outer data) + env? + (outer env-outer) + (data env-data env-data-set!)) + +(define (make-env outer . rest) + (let ((env (%make-env outer '()))) + (when (pair? rest) + (let loop ((binds (car rest)) + (exprs (cadr rest))) + (when (pair? binds) + (let ((bind (car binds))) + (if (eq? bind '&) + (env-set env (cadr binds) (mal-list exprs)) + (begin + (env-set env bind (car exprs)) + (loop (cdr binds) (cdr exprs)))))))) + env)) + +(define (env-set env key value) + (env-data-set! env (cons (cons key value) (env-data env)))) + +(define (env-get env key) + (cond + ((alist-ref key (env-data env)) => identity) + ((env-outer env) => (lambda (outer) (env-get outer key))) + (else #f))) + +) + +) diff --git a/impls/scheme/lib/printer.sld b/impls/scheme/lib/printer.sld new file mode 100644 index 0000000000..18fbfae74e --- /dev/null +++ b/impls/scheme/lib/printer.sld @@ -0,0 +1,62 @@ +(define-library (lib printer) + +(export pr-str) + +(import (scheme base)) +(import (scheme write)) + +(import (lib util)) +(import (lib types)) + +(begin + +(define (pr-str ast print-readably) + (cond + ((procedure? ast) + "#") + ((func? ast) + "#") + (else + (if (procedure? ast) + "#" + (let* ((type (and (mal-object? ast) (mal-type ast))) + (value (and (mal-object? ast) (mal-value ast)))) + (case type + ((true) "true") + ((false) "false") + ((nil) "nil") + ((number) (number->string value)) + ((string) (call-with-output-string + (lambda (port) + (if print-readably + (begin + (display #\" port) + (string-for-each + (lambda (char) + (case char + ((#\\) (display "\\\\" port)) + ((#\") (display "\\\"" port)) + ((#\newline) (display "\\n" port)) + (else (display char port)))) + value) + (display #\" port)) + (display value port))))) + ((keyword) (string-append ":" (symbol->string value))) + ((symbol) (symbol->string value)) + ((list) (pr-list value "(" ")" print-readably)) + ((vector) (pr-list (vector->list value) "[" "]" print-readably)) + ((map) (pr-list (alist->list value) "{" "}" print-readably)) + ((atom) (string-append "(atom " (pr-str value print-readably) ")")) + (else (error "unknown type")))))))) + +(define (pr-list items starter ender print-readably) + (call-with-output-string + (lambda (port) + (display starter port) + (let ((reprs (map (lambda (item) (pr-str item print-readably)) items))) + (display (string-intersperse reprs " ") port)) + (display ender port)))) + +) + +) diff --git a/impls/scheme/lib/reader.sld b/impls/scheme/lib/reader.sld new file mode 100644 index 0000000000..eb33eed169 --- /dev/null +++ b/impls/scheme/lib/reader.sld @@ -0,0 +1,183 @@ +(define-library (lib reader) + +(export read-str) + +(import (scheme base)) +(import (scheme char)) +(import (scheme read)) +(import (scheme write)) + +(import (lib util)) +(import (lib types)) + +(begin + +(define-record-type reader + (%make-reader tokens position) + reader? + (tokens %reader-tokens) + (position %reader-position %reader-position-set!)) + +(define (make-reader tokens) + (%make-reader (list->vector tokens) 0)) + +(define (peek reader) + (let ((tokens (%reader-tokens reader)) + (position (%reader-position reader))) + (if (>= position (vector-length tokens)) + #f + (vector-ref tokens position)))) + +(define (next reader) + (let ((token (peek reader))) + (when token + (%reader-position-set! reader (+ (%reader-position reader) 1))) + token)) + +(define (read-str input) + (let* ((tokens (tokenizer input)) + (reader (make-reader tokens))) + (read-form reader))) + +(define (whitespace-char? char) + (or (char-whitespace? char) (char=? char #\,))) + +(define (special-char? char) + (memv char '(#\[ #\] #\{ #\} #\( #\) #\' #\` #\~ #\^ #\@))) + +(define (non-word-char? char) + (or (whitespace-char? char) + (memv char '(#\[ #\] #\{ #\} #\( #\) #\' #\" #\` #\;)))) + +(define (tokenizer input) + (call-with-input-string input + (lambda (port) + (let loop ((tokens '())) + (if (eof-object? (peek-char port)) + (reverse tokens) + (let ((char (read-char port))) + (cond + ((whitespace-char? char) + (loop tokens)) + ((and (char=? char #\~) + (char=? (peek-char port) #\@)) + (read-char port) ; remove @ token + (loop (cons "~@" tokens))) + ((char=? char #\") + (loop (cons (tokenize-string port) tokens))) + ((char=? char #\;) + (skip-comment port) + (loop tokens)) + ((special-char? char) + (loop (cons (char->string char) tokens))) + (else + (loop (cons (tokenize-word port char) tokens)))))))))) + +(define (tokenize-string port) + (let loop ((chars '(#\"))) + (let ((char (read-char port))) + (cond + ((eof-object? char) + (list->string (reverse chars))) + ((char=? char #\\) + (let ((char (read-char port))) + (when (not (eof-object? char)) + (loop (cons char (cons #\\ chars)))))) + ((not (char=? char #\")) + (loop (cons char chars))) + ((char=? char #\") + (list->string (reverse (cons #\" chars)))))))) + +(define (skip-comment port) + (let loop () + (let ((char (peek-char port))) + (when (not (or (eof-object? char) + (char=? char #\newline))) + (read-char port) + (loop))))) + +(define (tokenize-word port char) + (let loop ((chars (list char))) + (let ((char (peek-char port))) + (if (or (eof-object? char) + (non-word-char? char)) + (list->string (reverse chars)) + (loop (cons (read-char port) chars)))))) + +(define (read-form reader) + (let ((token (peek reader))) + (cond + ((equal? token "'") + (read-macro reader 'quote)) + ((equal? token "`") + (read-macro reader 'quasiquote)) + ((equal? token "~") + (read-macro reader 'unquote)) + ((equal? token "~@") + (read-macro reader 'splice-unquote)) + ((equal? token "@") + (read-macro reader 'deref)) + ((equal? token "^") + (read-meta reader)) + ((equal? token "(") + (read-list reader ")" mal-list)) + ((equal? token "[") + (read-list reader "]" (lambda (items) (mal-vector (list->vector items))))) + ((equal? token "{") + (read-list reader "}" (lambda (items) (mal-map (list->alist items))))) + (else + (read-atom reader))))) + +(define (read-macro reader symbol) + (next reader) ; pop macro token + (mal-list (list (mal-symbol symbol) (read-form reader)))) + +(define (read-meta reader) + (next reader) ; pop macro token + (let ((form (read-form reader))) + (mal-list (list (mal-symbol 'with-meta) (read-form reader) form)))) + +(define (read-list reader ender proc) + (next reader) ; pop list start + (let loop ((items '())) + (let ((token (peek reader))) + (cond + ((equal? token ender) + (next reader) + (proc (reverse items))) + ((not token) + (error (str "expected '" ender "', got EOF"))) + (else + (loop (cons (read-form reader) items))))))) + +(define (read-atom reader) + (let ((token (next reader))) + (cond + ((not token) + (error "end of token stream" 'empty-input)) + ((equal? token "true") + mal-true) + ((equal? token "false") + mal-false) + ((equal? token "nil") + mal-nil) + ((string->number token) + => mal-number) + ((char=? (string-ref token 0) #\") + (guard + (ex ((cond-expand + ;; HACK: https://github.com/ashinn/chibi-scheme/pull/540 + (chibi + (error-object? ex)) + (else + (read-error? ex))) + (error (str "expected '" #\" "', got EOF")))) + (mal-string (call-with-input-string token read)))) + ((char=? (string-ref token 0) #\:) + (mal-keyword (string->symbol (string-copy token 1)))) + (else + (mal-symbol (string->symbol token)))))) + +) + +) diff --git a/impls/scheme/lib/types.sld b/impls/scheme/lib/types.sld new file mode 100644 index 0000000000..8eebb6f854 --- /dev/null +++ b/impls/scheme/lib/types.sld @@ -0,0 +1,70 @@ +(define-library (lib types) + +(export make-mal-object mal-object? mal-type mal-value mal-value-set! mal-meta + mal-true mal-false mal-nil + mal-number mal-string mal-symbol mal-keyword + mal-list mal-vector mal-map mal-atom + + make-func func? func-ast func-params func-env + func-fn func-macro? func-macro?-set! func-meta func-meta-set! + + mal-instance-of?) + +(import (scheme base)) + +(begin + +(define-record-type mal-object + (make-mal-object type value meta) + mal-object? + (type mal-type) + (value mal-value mal-value-set!) + (meta mal-meta mal-meta-set!)) + +(define mal-true (make-mal-object 'true #t #f)) +(define mal-false (make-mal-object 'false #f #f)) +(define mal-nil (make-mal-object 'nil #f #f)) + +(define (mal-number n) + (make-mal-object 'number n #f)) + +(define (mal-string string) + (make-mal-object 'string string #f)) + +(define (mal-symbol name) + (make-mal-object 'symbol name #f)) + +(define (mal-keyword name) + (make-mal-object 'keyword name #f)) + +(define (mal-list items) + (make-mal-object 'list items #f)) + +(define (mal-vector items) + (make-mal-object 'vector items #f)) + +(define (mal-map items) + (make-mal-object 'map items #f)) + +(define (mal-atom item) + (make-mal-object 'atom item #f)) + +(define-record-type func + (%make-func ast params env fn macro? meta) + func? + (ast func-ast) + (params func-params) + (env func-env) + (fn func-fn) + (macro? func-macro? func-macro?-set!) + (meta func-meta func-meta-set!)) + +(define (make-func ast params env fn) + (%make-func ast params env fn #f #f)) + +(define (mal-instance-of? x type) + (and (mal-object? x) (eq? (mal-type x) type))) + +) + +) diff --git a/impls/scheme/lib/util.sld b/impls/scheme/lib/util.sld new file mode 100644 index 0000000000..679d73fca9 --- /dev/null +++ b/impls/scheme/lib/util.sld @@ -0,0 +1,163 @@ +(define-library (lib util) + +(export call-with-input-string call-with-output-string + str prn debug + string-intersperse explode + char->string + list->alist alist->list alist-ref alist-map + ->list car-safe cdr-safe contains? last butlast + identity readline + + ;; HACK: cyclone doesn't have those + error-object? read-error? error-object-message error-object-irritants) + +(import (scheme base)) +(import (scheme write)) + +(begin + +;; HACK: cyclone currently implements error the SICP way +(cond-expand + (cyclone + (define (error-object? x) (and (pair? x) (string? (car x)))) + (define read-error? error-object?) + (define error-object-message car) + (define error-object-irritants cdr)) + (else)) + +(define (call-with-input-string string proc) + (let ((port (open-input-string string))) + (dynamic-wind + (lambda () #t) + (lambda () (proc port)) + (lambda () (close-input-port port))))) + +(define (call-with-output-string proc) + (let ((port (open-output-string))) + (dynamic-wind + (lambda () #t) + (lambda () (proc port) (get-output-string port)) + (lambda () (close-output-port port))))) + +(define (str . items) + (call-with-output-string + (lambda (port) + (for-each (lambda (item) (display item port)) items)))) + +(define (prn . items) + (for-each (lambda (item) (write item) (display " ")) items) + (newline)) + +(define (debug . items) + (parameterize ((current-output-port (current-error-port))) + (apply prn items))) + +(define (intersperse items sep) + (let loop ((items items) + (acc '())) + (if (null? items) + (reverse acc) + (let ((tail (cdr items))) + (if (null? tail) + (loop (cdr items) (cons (car items) acc)) + (loop (cdr items) (cons sep (cons (car items) acc)))))))) + +(define (string-intersperse items sep) + (apply string-append (intersperse items sep))) + +(define (char->string char) + (list->string (list char))) + +(define (explode string) + (map char->string (string->list string))) + +(define (list->alist items) + (let loop ((items items) + (acc '())) + (if (null? items) + (reverse acc) + (let ((key (car items))) + (when (null? (cdr items)) + (error "unbalanced list")) + (let ((value (cadr items))) + (loop (cddr items) + (cons (cons key value) acc))))))) + +(define (alist->list items) + (let loop ((items items) + (acc '())) + (if (null? items) + (reverse acc) + (let ((kv (car items))) + (loop (cdr items) + (cons (cdr kv) (cons (car kv) acc))))))) + +(define (alist-ref key alist . args) + (let ((test (if (pair? args) (car args) eqv?)) + (default (if (> (length args) 1) (cadr args) #f))) + (let loop ((items alist)) + (if (pair? items) + (let ((item (car items))) + (if (test (car item) key) + (cdr item) + (loop (cdr items)))) + default)))) + +(define (alist-map proc items) + (map (lambda (item) (proc (car item) (cdr item))) items)) + +(define (->list items) + (if (vector? items) + (vector->list items) + items)) + +(define (car-safe x) + (if (pair? x) + (car x) + '())) + +(define (cdr-safe x) + (if (pair? x) + (cdr x) + '())) + +(define (contains? items test) + (let loop ((items items)) + (if (pair? items) + (if (test (car items)) + #t + (loop (cdr items))) + #f))) + +(define (last items) + (when (null? items) + (error "empty argument")) + (let loop ((items items)) + (let ((tail (cdr items))) + (if (pair? tail) + (loop tail) + (car items))))) + +(define (butlast items) + (when (null? items) + (error "empty argument")) + (let loop ((items items) + (acc '())) + (let ((tail (cdr items))) + (if (pair? tail) + (loop tail (cons (car items) acc)) + (reverse acc))))) + +(define (identity x) x) + +(define (readline prompt) + (display prompt) + (flush-output-port) + (let ((input (read-line))) + (if (eof-object? input) + #f + input))) + +) + +) diff --git a/impls/scheme/run b/impls/scheme/run new file mode 100755 index 0000000000..8cfd055ae2 --- /dev/null +++ b/impls/scheme/run @@ -0,0 +1,26 @@ +#!/usr/bin/env bash +basedir=$(dirname $0) +step=${STEP:-stepA_mal} + +if [[ -e /usr/share/kawa/lib/kawa.jar ]]; then + kawa=/usr/share/kawa/lib/kawa.jar +elif [[ -e /usr/local/share/kawa/lib/kawa.jar ]]; then + kawa=/usr/local/share/kawa/lib/kawa.jar +fi + +if [[ $(which sash 2>/dev/null) ]]; then + sagittarius=sash +elif [[ $(which sagittarius 2>/dev/null) ]]; then + sagittarius=sagittarius +fi + +case ${scheme_MODE:-chibi} in + chibi) exec chibi-scheme -I$basedir $basedir/$step.scm "${@}" ;; + kawa) exec java -cp $kawa:$basedir/out $step "${@}" ;; + gauche) exec gosh -I$basedir $basedir/$step.scm "${@}" ;; + chicken) CHICKEN_REPOSITORY=$basedir/eggs exec $basedir/$step "${@}" ;; + sagittarius) exec $sagittarius -n -L$basedir $basedir/$step.scm "${@}" ;; + cyclone) exec $basedir/$step "${@}" ;; + foment) exec foment $basedir/$step.scm "${@}" ;; + *) echo "Invalid scheme_MODE: ${scheme_MODE}"; exit 2 ;; +esac diff --git a/impls/scheme/step0_repl.scm b/impls/scheme/step0_repl.scm new file mode 100644 index 0000000000..c02c11ea9d --- /dev/null +++ b/impls/scheme/step0_repl.scm @@ -0,0 +1,33 @@ +(import (scheme base)) +(import (scheme write)) + +(define (READ input) + input) + +(define (EVAL input) + input) + +(define (PRINT input) + input) + +(define (rep input) + (PRINT (EVAL (READ input)))) + +(define (readline prompt) + (display prompt) + (flush-output-port) + (let ((input (read-line))) + (if (eof-object? input) + #f + input))) + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (display (rep input)) + (newline) + (loop)))) + (newline)) + +(main) diff --git a/impls/scheme/step1_read_print.scm b/impls/scheme/step1_read_print.scm new file mode 100644 index 0000000000..6cb64d0d64 --- /dev/null +++ b/impls/scheme/step1_read_print.scm @@ -0,0 +1,36 @@ +(import (scheme base)) +(import (scheme write)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) + +(define (READ input) + (read-str input)) + +(define (EVAL ast) + ast) + +(define (PRINT ast) + (pr-str ast #t)) + +(define (rep input) + (PRINT (EVAL (READ input)))) + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline)))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(main) diff --git a/impls/scheme/step2_eval.scm b/impls/scheme/step2_eval.scm new file mode 100644 index 0000000000..2fe7f2b99f --- /dev/null +++ b/impls/scheme/step2_eval.scm @@ -0,0 +1,60 @@ +(import (scheme base)) +(import (scheme write)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) + +(define (READ input) + (read-str input)) + +(define (EVAL ast env) + ; (display (str "EVAL: " (pr-str ast #t) "\n")) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (alist-ref key env) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (let ((op (EVAL (car items) env)) + (ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (apply op ops))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env + `((+ . ,(lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) + (- . ,(lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) + (* . ,(lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) + (/ . ,(lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))))) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline)))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(main) diff --git a/impls/scheme/step3_env.scm b/impls/scheme/step3_env.scm new file mode 100644 index 0000000000..112b89ce3f --- /dev/null +++ b/impls/scheme/step3_env.scm @@ -0,0 +1,85 @@ +(import (scheme base)) +(import (scheme write)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) + +(define (READ input) + (read-str input)) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (case (mal-value (car items)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((let*) + (let* ((env* (make-env env)) + (binds (mal-value (cadr items))) + (binds (if (vector? binds) (vector->list binds) binds)) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) + (else + (let ((op (EVAL (car items) env)) + (ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (apply op ops))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(env-set repl-env '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) +(env-set repl-env '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) +(env-set repl-env '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) +(env-set repl-env '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline)))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(main) diff --git a/impls/scheme/step4_if_fn_do.scm b/impls/scheme/step4_if_fn_do.scm new file mode 100644 index 0000000000..6413870921 --- /dev/null +++ b/impls/scheme/step4_if_fn_do.scm @@ -0,0 +1,117 @@ +(import (scheme base)) +(import (scheme write)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) +(import (lib core)) + +(define (READ input) + (read-str input)) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (case (mal-value (car items)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((let*) + (let ((env* (make-env env)) + (binds (->list (mal-value (cadr items)))) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) + ((do) + (let ((forms (cdr items))) + (if (null? forms) + mal-nil + ;; the evaluation order of map is unspecified + (let loop ((forms forms)) + (let ((form (car forms)) + (tail (cdr forms))) + (if (null? tail) + (EVAL form env) + (begin + (EVAL form env) + (loop tail)))))))) + ((if) + (let* ((condition (EVAL (cadr items) env)) + (type (and (mal-object? condition) + (mal-type condition)))) + (if (memq type '(false nil)) + (if (< (length items) 4) + mal-nil + (EVAL (list-ref items 3) env)) + (EVAL (list-ref items 2) env)))) + ((fn*) + (let* ((binds (->list (mal-value (cadr items)))) + (binds (map mal-value binds)) + (body (list-ref items 2))) + (lambda args + (let ((env* (make-env env binds args))) + (EVAL body env*))))) + (else + (let ((op (EVAL (car items) env)) + (ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (apply op ops))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (display "[error] ") + (display (pr-str (cdr ex) #t)) + (newline))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(main) diff --git a/impls/scheme/step5_tco.scm b/impls/scheme/step5_tco.scm new file mode 100644 index 0000000000..30964e2929 --- /dev/null +++ b/impls/scheme/step5_tco.scm @@ -0,0 +1,123 @@ +(import (scheme base)) +(import (scheme write)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) +(import (lib core)) + +(define (READ input) + (read-str input)) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (case (mal-value (car items)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((let*) + (let ((env* (make-env env)) + (binds (->list (mal-value (cadr items)))) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) ; TCO + ((do) + (let ((forms (cdr items))) + (if (null? forms) + mal-nil + ;; the evaluation order of map is unspecified + (let loop ((forms forms)) + (let ((form (car forms)) + (tail (cdr forms))) + (if (null? tail) + (EVAL form env) ; TCO + (begin + (EVAL form env) + (loop tail)))))))) + ((if) + (let* ((condition (EVAL (cadr items) env)) + (type (and (mal-object? condition) + (mal-type condition)))) + (if (memq type '(false nil)) + (if (< (length items) 4) + mal-nil + (EVAL (list-ref items 3) env)) ; TCO + (EVAL (list-ref items 2) env)))) ; TCO + ((fn*) + (let* ((binds (->list (mal-value (cadr items)))) + (binds (map mal-value binds)) + (body (list-ref items 2)) + (fn (lambda args + (let ((env* (make-env env binds args))) + (EVAL body env*))))) + (make-func body binds env fn))) + (else + (let ((op (EVAL (car items) env)) + (ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (if (func? op) + (let* ((outer (func-env op)) + (binds (func-params op)) + (env* (make-env outer binds ops))) + (EVAL (func-ast op) env*)) ; TCO + (apply op ops)))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(rep "(def! not (fn* (a) (if a false true)))") + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (display "[error] ") + (display (pr-str (cdr ex) #t)) + (newline))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(main) diff --git a/impls/scheme/step6_file.scm b/impls/scheme/step6_file.scm new file mode 100644 index 0000000000..f346de4ee4 --- /dev/null +++ b/impls/scheme/step6_file.scm @@ -0,0 +1,133 @@ +(import (scheme base)) +(import (scheme write)) +(import (scheme process-context)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) +(import (lib core)) + +(define (READ input) + (read-str input)) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (let ((a0 (car items))) + (case (and (mal-object? a0) (mal-value a0)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((let*) + (let ((env* (make-env env)) + (binds (->list (mal-value (cadr items)))) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) ; TCO + ((do) + (let ((forms (cdr items))) + (if (null? forms) + mal-nil + ;; the evaluation order of map is unspecified + (let loop ((forms forms)) + (let ((form (car forms)) + (tail (cdr forms))) + (if (null? tail) + (EVAL form env) ; TCO + (begin + (EVAL form env) + (loop tail)))))))) + ((if) + (let* ((condition (EVAL (cadr items) env)) + (type (and (mal-object? condition) + (mal-type condition)))) + (if (memq type '(false nil)) + (if (< (length items) 4) + mal-nil + (EVAL (list-ref items 3) env)) ; TCO + (EVAL (list-ref items 2) env)))) ; TCO + ((fn*) + (let* ((binds (->list (mal-value (cadr items)))) + (binds (map mal-value binds)) + (body (list-ref items 2)) + (fn (lambda args + (let ((env* (make-env env binds args))) + (EVAL body env*))))) + (make-func body binds env fn))) + (else + (let ((op (EVAL a0 env)) + (ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (if (func? op) + (let* ((outer (func-env op)) + (binds (func-params op)) + (env* (make-env outer binds ops))) + (EVAL (func-ast op) env*)) ; TCO + (apply op ops))))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(define args (cdr (command-line))) + +(env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (display "[error] ") + (display (pr-str (cdr ex) #t)) + (newline))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(if (null? args) + (main) + (rep (string-append "(load-file \"" (car args) "\")"))) diff --git a/impls/scheme/step7_quote.scm b/impls/scheme/step7_quote.scm new file mode 100644 index 0000000000..a9c559bf2f --- /dev/null +++ b/impls/scheme/step7_quote.scm @@ -0,0 +1,160 @@ +(import (scheme base)) +(import (scheme write)) +(import (scheme process-context)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) +(import (lib core)) + +(define (READ input) + (read-str input)) + +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) + +(define (QUASIQUOTE ast) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (let ((a0 (car items))) + (case (and (mal-object? a0) (mal-value a0)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((let*) + (let ((env* (make-env env)) + (binds (->list (mal-value (cadr items)))) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) ; TCO + ((do) + (let ((forms (cdr items))) + (if (null? forms) + mal-nil + ;; the evaluation order of map is unspecified + (let loop ((forms forms)) + (let ((form (car forms)) + (tail (cdr forms))) + (if (null? tail) + (EVAL form env) ; TCO + (begin + (EVAL form env) + (loop tail)))))))) + ((if) + (let* ((condition (EVAL (cadr items) env)) + (type (and (mal-object? condition) + (mal-type condition)))) + (if (memq type '(false nil)) + (if (< (length items) 4) + mal-nil + (EVAL (list-ref items 3) env)) ; TCO + (EVAL (list-ref items 2) env)))) ; TCO + ((quote) (cadr items)) + ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO + ((fn*) + (let* ((binds (->list (mal-value (cadr items)))) + (binds (map mal-value binds)) + (body (list-ref items 2)) + (fn (lambda args + (let ((env* (make-env env binds args))) + (EVAL body env*))))) + (make-func body binds env fn))) + (else + (let ((op (EVAL a0 env)) + (ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (if (func? op) + (let* ((outer (func-env op)) + (binds (func-params op)) + (env* (make-env outer binds ops))) + (EVAL (func-ast op) env*)) ; TCO + (apply op ops))))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(define args (cdr (command-line))) + +(env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (display "[error] ") + (display (pr-str (cdr ex) #t)) + (newline))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(if (null? args) + (main) + (rep (string-append "(load-file \"" (car args) "\")"))) diff --git a/impls/scheme/step8_macros.scm b/impls/scheme/step8_macros.scm new file mode 100644 index 0000000000..9b36d4543d --- /dev/null +++ b/impls/scheme/step8_macros.scm @@ -0,0 +1,172 @@ +(import (scheme base)) +(import (scheme write)) +(import (scheme process-context)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) +(import (lib core)) + +(define (READ input) + (read-str input)) + +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) + +(define (QUASIQUOTE ast) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (let ((a0 (car items))) + (case (and (mal-object? a0) (mal-value a0)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((defmacro!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (when (func? value) + (func-macro?-set! value #t)) + (env-set env symbol value) + value)) + ((let*) + (let ((env* (make-env env)) + (binds (->list (mal-value (cadr items)))) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) ; TCO + ((do) + (let ((forms (cdr items))) + (if (null? forms) + mal-nil + ;; the evaluation order of map is unspecified + (let loop ((forms forms)) + (let ((form (car forms)) + (tail (cdr forms))) + (if (null? tail) + (EVAL form env) ; TCO + (begin + (EVAL form env) + (loop tail)))))))) + ((if) + (let* ((condition (EVAL (cadr items) env)) + (type (and (mal-object? condition) + (mal-type condition)))) + (if (memq type '(false nil)) + (if (< (length items) 4) + mal-nil + (EVAL (list-ref items 3) env)) ; TCO + (EVAL (list-ref items 2) env)))) ; TCO + ((quote) + (cadr items)) + ((quasiquote) + (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO + ((fn*) + (let* ((binds (->list (mal-value (cadr items)))) + (binds (map mal-value binds)) + (body (list-ref items 2)) + (fn (lambda args + (let ((env* (make-env env binds args))) + (EVAL body env*))))) + (make-func body binds env fn))) + (else + (let ((op (EVAL a0 env))) + (if (and (func? op) (func-macro? op)) + (EVAL (apply (func-fn op) (cdr items)) env) ; TCO + (let* ((ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (if (func? op) + (let* ((outer (func-env op)) + (binds (func-params op)) + (env* (make-env outer binds ops))) + (EVAL (func-ast op) env*)) ; TCO + (apply op ops))))))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(define args (cdr (command-line))) + +(env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (display "[error] ") + (display (pr-str (cdr ex) #t)) + (newline))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(if (null? args) + (main) + (rep (string-append "(load-file \"" (car args) "\")"))) diff --git a/impls/scheme/step9_try.scm b/impls/scheme/step9_try.scm new file mode 100644 index 0000000000..5a6139afb4 --- /dev/null +++ b/impls/scheme/step9_try.scm @@ -0,0 +1,187 @@ +(import (scheme base)) +(import (scheme write)) +(import (scheme process-context)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) +(import (lib core)) + +(define (READ input) + (read-str input)) + +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) + +(define (QUASIQUOTE ast) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (let ((a0 (car items))) + (case (and (mal-object? a0) (mal-value a0)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((defmacro!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (when (func? value) + (func-macro?-set! value #t)) + (env-set env symbol value) + value)) + ((try*) + (if (< (length items) 3) + (EVAL (cadr items) env) + (let ((handle-catch (lambda (value) + (let ((handler (mal-value (list-ref items 2))) + (env* (make-env env))) + (env-set env* (mal-value (cadr handler)) value) + (EVAL (list-ref handler 2) env*))))) + (guard + (ex ((error-object? ex) + (handle-catch + (mal-string (error-object-message ex)))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (handle-catch (cdr ex)))) + (EVAL (cadr items) env))))) + ((let*) + (let ((env* (make-env env)) + (binds (->list (mal-value (cadr items)))) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) ; TCO + ((do) + (let ((forms (cdr items))) + (if (null? forms) + mal-nil + ;; the evaluation order of map is unspecified + (let loop ((forms forms)) + (let ((form (car forms)) + (tail (cdr forms))) + (if (null? tail) + (EVAL form env) ; TCO + (begin + (EVAL form env) + (loop tail)))))))) + ((if) + (let* ((condition (EVAL (cadr items) env)) + (type (and (mal-object? condition) + (mal-type condition)))) + (if (memq type '(false nil)) + (if (< (length items) 4) + mal-nil + (EVAL (list-ref items 3) env)) ; TCO + (EVAL (list-ref items 2) env)))) ; TCO + ((quote) + (cadr items)) + ((quasiquote) + (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO + ((fn*) + (let* ((binds (->list (mal-value (cadr items)))) + (binds (map mal-value binds)) + (body (list-ref items 2)) + (fn (lambda args + (let ((env* (make-env env binds args))) + (EVAL body env*))))) + (make-func body binds env fn))) + (else + (let ((op (EVAL a0 env))) + (if (and (func? op) (func-macro? op)) + (EVAL (apply (func-fn op) (cdr items)) env) ; TCO + (let* ((ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (if (func? op) + (let* ((outer (func-env op)) + (binds (func-params op)) + (env* (make-env outer binds ops))) + (EVAL (func-ast op) env*)) ; TCO + (apply op ops))))))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(define args (cdr (command-line))) + +(env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(define (main) + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (display "[error] ") + (display (pr-str (cdr ex) #t)) + (newline))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(if (null? args) + (main) + (rep (string-append "(load-file \"" (car args) "\")"))) diff --git a/impls/scheme/stepA_mal.scm b/impls/scheme/stepA_mal.scm new file mode 100644 index 0000000000..722c1de57d --- /dev/null +++ b/impls/scheme/stepA_mal.scm @@ -0,0 +1,190 @@ +(import (scheme base)) +(import (scheme write)) +(import (scheme process-context)) + +(import (lib util)) +(import (lib reader)) +(import (lib printer)) +(import (lib types)) +(import (lib env)) +(import (lib core)) + +(define (READ input) + (read-str input)) + +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) + +(define (QUASIQUOTE ast) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) + +(define (EVAL ast env) + (let ((dbgeval (env-get env 'DEBUG-EVAL))) + (when (and (mal-object? dbgeval) + (not (memq (mal-type dbgeval) '(false nil)))) + (display (str "EVAL: " (pr-str ast #t) "\n")))) + (case (and (mal-object? ast) (mal-type ast)) + ((symbol) + (let ((key (mal-value ast))) + (or (env-get env key) (error (str "'" key "' not found"))))) + ((vector) + (mal-vector (vector-map (lambda (item) (EVAL item env)) + (mal-value ast)))) + ((map) + (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) + (mal-value ast)))) + ((list) + (let ((items (mal-value ast))) + (if (null? items) + ast + (let ((a0 (car items))) + (case (and (mal-object? a0) (mal-value a0)) + ((def!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (env-set env symbol value) + value)) + ((defmacro!) + (let ((symbol (mal-value (cadr items))) + (value (EVAL (list-ref items 2) env))) + (when (func? value) + (func-macro?-set! value #t)) + (env-set env symbol value) + value)) + ((try*) + (if (< (length items) 3) + (EVAL (cadr items) env) + (let ((handle-catch (lambda (value) + (let ((handler (mal-value (list-ref items 2))) + (env* (make-env env))) + (env-set env* (mal-value (cadr handler)) value) + (EVAL (list-ref handler 2) env*))))) + (guard + (ex ((error-object? ex) + (handle-catch + (mal-string (error-object-message ex)))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (handle-catch (cdr ex)))) + (EVAL (cadr items) env))))) + ((let*) + (let ((env* (make-env env)) + (binds (->list (mal-value (cadr items)))) + (form (list-ref items 2))) + (let loop ((binds binds)) + (when (pair? binds) + (let ((key (mal-value (car binds)))) + (when (null? (cdr binds)) + (error "unbalanced list")) + (let ((value (EVAL (cadr binds) env*))) + (env-set env* key value) + (loop (cddr binds)))))) + (EVAL form env*))) ; TCO + ((do) + (let ((forms (cdr items))) + (if (null? forms) + mal-nil + ;; the evaluation order of map is unspecified + (let loop ((forms forms)) + (let ((form (car forms)) + (tail (cdr forms))) + (if (null? tail) + (EVAL form env) ; TCO + (begin + (EVAL form env) + (loop tail)))))))) + ((if) + (let* ((condition (EVAL (cadr items) env)) + (type (and (mal-object? condition) + (mal-type condition)))) + (if (memq type '(false nil)) + (if (< (length items) 4) + mal-nil + (EVAL (list-ref items 3) env)) ; TCO + (EVAL (list-ref items 2) env)))) ; TCO + ((quote) + (cadr items)) + ((quasiquote) + (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO + ((fn*) + (let* ((binds (->list (mal-value (cadr items)))) + (binds (map mal-value binds)) + (body (list-ref items 2)) + (fn (lambda args + (let ((env* (make-env env binds args))) + (EVAL body env*))))) + (make-func body binds env fn))) + (else + (let ((op (EVAL a0 env))) + (if (and (func? op) (func-macro? op)) + (EVAL (apply (func-fn op) (cdr items)) env) ; TCO + (let* ((ops (map (lambda (item) (EVAL item env)) (cdr items)))) + (if (func? op) + (let* ((outer (func-env op)) + (binds (func-params op)) + (env* (make-env outer binds ops))) + (EVAL (func-ast op) env*)) ; TCO + (apply op ops))))))))))) + (else ast))) + +(define (PRINT ast) + (pr-str ast #t)) + +(define repl-env (make-env #f)) +(for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) + +(define (rep input) + (PRINT (EVAL (READ input) repl-env))) + +(define args (cdr (command-line))) + +(env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) +(env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) +(let ((scheme (or (get-environment-variable "scheme_MODE") "chibi"))) + (env-set repl-env '*host-language* (mal-string (str "scheme (" scheme ")")))) + +(rep "(def! not (fn* (a) (if a false true)))") +(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + +(define (main) + (rep "(println (str \"Mal [\" *host-language* \"]\"))") + (let loop () + (let ((input (readline "user> "))) + (when input + (guard + (ex ((error-object? ex) + (when (not (memv 'empty-input (error-object-irritants ex))) + (display "[error] ") + (display (error-object-message ex)) + (newline))) + ((and (pair? ex) (eq? (car ex) 'user-error)) + (display "[error] ") + (display (pr-str (cdr ex) #t)) + (newline))) + (display (rep input)) + (newline)) + (loop)))) + (newline)) + +(if (null? args) + (main) + (rep (string-append "(load-file \"" (car args) "\")"))) diff --git a/impls/scheme/tests/stepA_mal.mal b/impls/scheme/tests/stepA_mal.mal new file mode 100644 index 0000000000..4ba3b9fab0 --- /dev/null +++ b/impls/scheme/tests/stepA_mal.mal @@ -0,0 +1,17 @@ +;; Testing basic Scheme interop + +(scm-eval "(+ 1 1)") +;=>2 + +(scm-eval "(begin (display \"Hello World!\") (newline) 7)") +;/Hello World! +;=>7 + +(scm-eval "(string->list \"MAL\")") +;=>("M" "A" "L") + +(scm-eval "(map + '(1 2 3) '(4 5 6))") +;=>(5 7 9) + +(scm-eval "(string-map (lambda (c) (integer->char (+ 65 (modulo (+ (- (char->integer c) 65) 13) 26)))) \"ZNY\")") +;=>"MAL" diff --git a/impls/skew/Dockerfile b/impls/skew/Dockerfile new file mode 100644 index 0000000000..a3bb9f809a --- /dev/null +++ b/impls/skew/Dockerfile @@ -0,0 +1,27 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install npm + +ENV NPM_CONFIG_CACHE /mal/.npm + +# Skew +RUN DEBIAN_FRONTEND=noninteractive npm install -g skew diff --git a/impls/skew/Makefile b/impls/skew/Makefile new file mode 100644 index 0000000000..58bd6641fc --- /dev/null +++ b/impls/skew/Makefile @@ -0,0 +1,27 @@ +STEPS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ + step5_tco step6_file step7_quote step8_macros step9_try stepA_mal + +SOURCES_BASE = util.sk types.sk reader.sk printer.sk + +STEP3_DEPS = $(SOURCES_BASE) env.sk +STEP4_DEPS = $(STEP3_DEPS) core.sk + +all: $(foreach s,$(STEPS),$(s).js) dist + +dist: mal + +step0_repl.js step1_read_print.js step2_eval.js step3_env.js: $(STEP3_DEPS) +step4_if_fn_do.js step5_tco.js step6_file.js step7_quote.js step8_macros.js step9_try.js stepA_mal.js: $(STEP4_DEPS) + +%.js: %.sk + skewc --target=js --release --output-file=$@ $^ + +mal: stepA_mal.js + echo "#!/usr/bin/env node" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -rf step*.js mal + +.PHONY: all dist clean diff --git a/impls/skew/core.sk b/impls/skew/core.sk new file mode 100644 index 0000000000..b65d08c4ec --- /dev/null +++ b/impls/skew/core.sk @@ -0,0 +1,103 @@ +def _printLn(s string) MalVal { + printLn(s) + return gNil +} + +const ns StringMap) MalVal> = { + "eval": (a List) => EVAL(a[0], repl_env), + "=": (a List) => MalVal.fromBool(a[0].equal(a[1])), + "throw": (a List) => { throw MalUserError.new(a[0]) }, + + "nil?": (a List) => MalVal.fromBool(a[0] is MalNil), + "true?": (a List) => MalVal.fromBool(a[0] is MalTrue), + "false?": (a List) => MalVal.fromBool(a[0] is MalFalse), + "string?": (a List) => MalVal.fromBool(a[0] is MalString), + "symbol": (a List) => MalSymbol.new((a[0] as MalString).val), + "symbol?": (a List) => MalVal.fromBool(a[0] is MalSymbol), + "keyword": (a List) => a[0] is MalKeyword ? a[0] : MalKeyword.new((a[0] as MalString).val), + "keyword?": (a List) => MalVal.fromBool(a[0] is MalKeyword), + "number?": (a List) => MalVal.fromBool(a[0] is MalNumber), + "fn?": (a List) => MalVal.fromBool(a[0] is MalNativeFunc || + (a[0] is MalFunc && !(a[0] as MalFunc).isMacro)), + "macro?": (a List) => MalVal.fromBool(a[0] is MalFunc && (a[0] as MalFunc).isMacro), + + "pr-str": (a List) => MalString.new(" ".join(a.map(e => pr_str(e, true)))), + "str": (a List) => MalString.new("".join(a.map(e => pr_str(e, false)))), + "prn": (a List) => _printLn(" ".join(a.map(e => pr_str(e, true)))), + "println": (a List) => _printLn(" ".join(a.map(e => pr_str(e, false)))), + "read-string": (a List) => read_str((a[0] as MalString).val), + "readline": (a List) => { + const line = readLine((a[0] as MalString).val) + return line == null ? gNil : MalString.new(line) + }, + "slurp": (a List) => MalString.new(readFile((a[0] as MalString).val)), + + "<": (a List) => MalVal.fromBool((a[0] as MalNumber).val < (a[1] as MalNumber).val), + "<=": (a List) => MalVal.fromBool((a[0] as MalNumber).val <= (a[1] as MalNumber).val), + ">": (a List) => MalVal.fromBool((a[0] as MalNumber).val > (a[1] as MalNumber).val), + ">=": (a List) => MalVal.fromBool((a[0] as MalNumber).val >= (a[1] as MalNumber).val), + "+": (a List) => MalNumber.new((a[0] as MalNumber).val + (a[1] as MalNumber).val), + "-": (a List) => MalNumber.new((a[0] as MalNumber).val - (a[1] as MalNumber).val), + "*": (a List) => MalNumber.new((a[0] as MalNumber).val * (a[1] as MalNumber).val), + "/": (a List) => MalNumber.new((a[0] as MalNumber).val / (a[1] as MalNumber).val), + "time-ms": (a List) => MalNumber.new(timeMs), + + "list": (a List) => MalList.new(a), + "list?": (a List) => MalVal.fromBool(a[0] is MalList), + "vector": (a List) => MalVector.new(a), + "vector?": (a List) => MalVal.fromBool(a[0] is MalVector), + "hash-map": (a List) => MalHashMap.fromList(a), + "map?": (a List) => MalVal.fromBool(a[0] is MalHashMap), + "assoc": (a List) => (a[0] as MalHashMap).assoc(a.slice(1)), + "dissoc": (a List) => (a[0] as MalHashMap).dissoc(a.slice(1)), + "get": (a List) => a[0] is MalNil ? gNil : (a[0] as MalHashMap).get(a[1]), + "contains?": (a List) => MalVal.fromBool((a[0] as MalHashMap).contains(a[1])), + "keys": (a List) => MalList.new((a[0] as MalHashMap).keys), + "vals": (a List) => MalList.new((a[0] as MalHashMap).vals), + + "sequential?": (a List) => MalVal.fromBool(a[0] is MalSequential), + "cons": (a List) => { + var list List = (a[1] as MalSequential).val.clone + list.prepend(a[0]) + return MalList.new(list) + }, + "concat": (a List) => { + var list List = [] + a.each(e => list.append((e as MalSequential).val)) + return MalList.new(list) + }, + "vec": (a List) => a[0] is MalVector ? a[0] : MalVector.new((a[0] as MalSequential).val), + "nth": (a List) => (a[0] as MalSequential).nth((a[1] as MalNumber).val), + "first": (a List) => a[0] is MalNil ? gNil : (a[0] as MalSequential).first, + "rest": (a List) => a[0] is MalNil ? MalList.new([]) : (a[0] as MalSequential).rest, + "empty?": (a List) => MalVal.fromBool((a[0] as MalSequential).count == 0), + "count": (a List) => a[0] is MalNil ? MalNumber.new(0) : MalNumber.new((a[0] as MalSequential).count), + "apply": (a List) => { + const f = a[0] as MalCallable + var args = a.slice(1, a.count - 1) + args.append((a[a.count - 1] as MalSequential).val) + return f.call(args) + }, + "map": (a List) => { + const f = a[0] as MalCallable + return MalList.new((a[1] as MalSequential).val.map(e => f.call([e]))) + }, + + "conj": (a List) => (a[0] as MalSequential).conj(a.slice(1)), + "seq": (a List) => a[0].seq, + + "meta": (a List) => a[0].meta, + "with-meta": (a List) => a[0].withMeta(a[1]), + "atom": (a List) => MalAtom.new(a[0]), + "atom?": (a List) => MalVal.fromBool(a[0] is MalAtom), + "deref": (a List) => (a[0] as MalAtom).val, + "reset!": (a List) => (a[0] as MalAtom).resetBang(a[1]), + "swap!": (a List) => { + var atom = a[0] as MalAtom + const oldVal = atom.val + var callArgs = a.slice(2) + callArgs.prepend(oldVal) + const newVal = (a[1] as MalCallable).call(callArgs) + return atom.resetBang(newVal) + }, +} diff --git a/impls/skew/env.sk b/impls/skew/env.sk new file mode 100644 index 0000000000..8610fba99a --- /dev/null +++ b/impls/skew/env.sk @@ -0,0 +1,32 @@ +class Env { + const _outer Env + var _data StringMap = {} + + def new(outer Env) { + _outer = outer + } + + def new(outer Env, binds List, exprs List) { + _outer = outer + for i in 0..binds.count { + const name = (binds[i] as MalSymbol).val + if name == "&" { + const restName = (binds[i + 1] as MalSymbol).val + _data[restName] = MalList.new(exprs.slice(i)) + break + } else { + _data[name] = exprs[i] + } + } + } + + def get(key string) MalVal { + if key in _data { return _data[key] } + return _outer?.get(key) + } + + def set(key MalSymbol, value MalVal) MalVal { + _data[key.val] = value + return value + } +} diff --git a/impls/skew/printer.sk b/impls/skew/printer.sk new file mode 100644 index 0000000000..bd767a0135 --- /dev/null +++ b/impls/skew/printer.sk @@ -0,0 +1,3 @@ +def pr_str(obj MalVal, readable bool) string { + return obj.print(readable) +} diff --git a/impls/skew/reader.sk b/impls/skew/reader.sk new file mode 100644 index 0000000000..15bc83e04e --- /dev/null +++ b/impls/skew/reader.sk @@ -0,0 +1,140 @@ +class Reader { + const tokens List + var position = 0 + + def peek string { + if position >= tokens.count { + return null + } + return tokens[position] + } + + def next string { + const token = peek + position++ + return token + } +} + +def tokenize(str string) List { + var re = RegExp.new("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)", "g") + var tokens List = [] + var match string + while (match = re.exec(str)[1]) != "" { + if match[0] == ';' { + continue + } + tokens.append(match) + } + return tokens +} + +def unescape(s string) string { + return s.replaceAll("\\\\", "\x01").replaceAll("\\\"", "\"").replaceAll("\\n", "\n").replaceAll("\x01", "\\") +} + +def read_atom(rdr Reader) MalVal { + var sre = RegExp.new("^\"(?:\\\\.|[^\\\\\"])*\"$") + const token = rdr.peek + if token == "nil" { + rdr.next + return gNil + } + if token == "true" { + rdr.next + return gTrue + } + if token == "false" { + rdr.next + return gFalse + } + switch token[0] { + case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' { return MalNumber.new(stringToInt(rdr.next)) } + case '-' { + if token.count <= 1 { return MalSymbol.new(rdr.next) } + switch token[1] { + case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' { return MalNumber.new(stringToInt(rdr.next)) } + default { return MalSymbol.new(rdr.next) } + } + } + case '"' { + const s = rdr.next + if sre.exec(s) { + return MalString.new(unescape(s.slice(1, s.count - 1))) + } else { + throw MalError.new("expected '\"', got EOF") + } + } + case ':' { return MalKeyword.new(rdr.next.slice(1)) } + default { return MalSymbol.new(rdr.next) } + } +} + +def read_sequence(rdr Reader, open string, close string) List { + if rdr.next != open { + throw MalError.new("expected '" + open + "'") + } + var token string + var items List = [] + while (token = rdr.peek) != close { + if token == null { + throw MalError.new("expected '" + close + "', got EOF") + } + items.append(read_form(rdr)) + } + rdr.next # consume the close paren/bracket/brace + return items +} + +def read_list(rdr Reader) MalList { + return MalList.new(read_sequence(rdr, "(", ")")) +} + +def read_vector(rdr Reader) MalVector { + return MalVector.new(read_sequence(rdr, "[", "]")) +} + +def read_hash_map(rdr Reader) MalHashMap { + return MalHashMap.fromList(read_sequence(rdr, "{", "}")) +} + +def reader_macro(rdr Reader, symbol_name string) MalVal { + rdr.next + return MalList.new([MalSymbol.new(symbol_name), read_form(rdr)]) +} + +def read_form(rdr Reader) MalVal { + switch rdr.peek[0] { + case '\'' { return reader_macro(rdr, "quote") } + case '`' { return reader_macro(rdr, "quasiquote") } + case '~' { + if rdr.peek == "~" { return reader_macro(rdr, "unquote") } + else if rdr.peek == "~@" { return reader_macro(rdr, "splice-unquote") } + else { return read_atom(rdr) } + } + case '^' { + rdr.next + const meta = read_form(rdr) + return MalList.new([MalSymbol.new("with-meta"), read_form(rdr), meta]) + } + case '@' { return reader_macro(rdr, "deref") } + case ')' { throw MalError.new("unexpected ')'") } + case '(' { return read_list(rdr) } + case ']' { throw MalError.new("unexpected ']'") } + case '[' { return read_vector(rdr) } + case '}' { throw MalError.new("unexpected '}'") } + case '{' { return read_hash_map(rdr) } + default { return read_atom(rdr) } + } +} + +def read_str(str string) MalVal { + const tokens = tokenize(str) + if tokens.isEmpty { return null } + var rdr = Reader.new(tokens) + return read_form(rdr) +} + +@import { + const RegExp dynamic +} diff --git a/impls/skew/run b/impls/skew/run new file mode 100755 index 0000000000..1148122a23 --- /dev/null +++ b/impls/skew/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" diff --git a/impls/skew/step0_repl.sk b/impls/skew/step0_repl.sk new file mode 100644 index 0000000000..4afc931603 --- /dev/null +++ b/impls/skew/step0_repl.sk @@ -0,0 +1,24 @@ +def READ(str string) string { + return str +} + +def EVAL(ast string, env StringMap) string { + return ast +} + +def PRINT(exp string) string { + return exp +} + +def REP(str string) string { + return PRINT(EVAL(READ(str), {})) +} + +@entry +def main { + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + printLn(REP(line)) + } +} diff --git a/impls/skew/step1_read_print.sk b/impls/skew/step1_read_print.sk new file mode 100644 index 0000000000..30ead7bb91 --- /dev/null +++ b/impls/skew/step1_read_print.sk @@ -0,0 +1,29 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def EVAL(ast MalVal, env StringMap) MalVal { + return ast +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +def REP(str string) string { + return PRINT(EVAL(READ(str), {})) +} + +@entry +def main { + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step2_eval.sk b/impls/skew/step2_eval.sk new file mode 100644 index 0000000000..e23916bab4 --- /dev/null +++ b/impls/skew/step2_eval.sk @@ -0,0 +1,63 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def EVAL(ast MalVal, env StringMap) MalVal { + # printLn("EVAL: " + PRINT(ast)) + + if ast is MalSymbol { + const name = (ast as MalSymbol).val + if !(name in env) { + throw MalError.new("'" + name + "' not found") + } + return env[name] + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + var astList = ast as MalList + if astList.isEmpty { return ast } + const evaledList = astList.val.map(e => EVAL(e, env)) + var fn = evaledList[0] as MalNativeFunc + return fn.call(evaledList.slice(1)) +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env StringMap = { + "+": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val + (args[1] as MalNumber).val)), + "-": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val - (args[1] as MalNumber).val)), + "*": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val * (args[1] as MalNumber).val)), + "/": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val / (args[1] as MalNumber).val)), +} + +def REP(str string) string { + return PRINT(EVAL(READ(str), repl_env)) +} + +@entry +def main { + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step3_env.sk b/impls/skew/step3_env.sk new file mode 100644 index 0000000000..135ab5199d --- /dev/null +++ b/impls/skew/step3_env.sk @@ -0,0 +1,77 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def EVAL(ast MalVal, env Env) MalVal { + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + return EVAL(astList[2], letenv) + } else { + const evaledList = astList.val.map(e => EVAL(e, env)) + const fn = evaledList[0] as MalNativeFunc + return fn.call(evaledList.slice(1)) + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def REP(str string) string { + return PRINT(EVAL(READ(str), repl_env)) +} + +@entry +def main { + repl_env.set(MalSymbol.new("+"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val + (args[1] as MalNumber).val))) + repl_env.set(MalSymbol.new("-"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val - (args[1] as MalNumber).val))) + repl_env.set(MalSymbol.new("*"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val * (args[1] as MalNumber).val))) + repl_env.set(MalSymbol.new("/"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val / (args[1] as MalNumber).val))) + + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step4_if_fn_do.sk b/impls/skew/step4_if_fn_do.sk new file mode 100644 index 0000000000..045d8a0ee8 --- /dev/null +++ b/impls/skew/step4_if_fn_do.sk @@ -0,0 +1,97 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def EVAL(ast MalVal, env Env) MalVal { + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + return EVAL(astList[2], letenv) + } else if a0sym.val == "do" { + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + return EVAL(astList[astList.count - 1], env) + } else if a0sym.val == "if" { + const condRes = EVAL(astList[1], env) + if condRes is MalNil || condRes is MalFalse { + return astList.count > 3 ? EVAL(astList[3], env) : gNil + } else { + return EVAL(astList[2], env) + } + } else if a0sym.val == "fn*" { + const argsNames = (astList[1] as MalSequential).val + return MalNativeFunc.new((args List) => EVAL(astList[2], Env.new(env, argsNames, args))) + } else { + const evaledList = astList.val.map(e => EVAL(e, env)) + const fn = evaledList[0] as MalNativeFunc + return fn.call(evaledList.slice(1)) + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def RE(str string) MalVal { + return EVAL(READ(str), repl_env) +} + +def REP(str string) string { + return PRINT(RE(str)) +} + +@entry +def main { + # core.sk: defined using Skew + ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) + + # core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))") + + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step5_tco.sk b/impls/skew/step5_tco.sk new file mode 100644 index 0000000000..5166208227 --- /dev/null +++ b/impls/skew/step5_tco.sk @@ -0,0 +1,117 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def EVAL(ast MalVal, env Env) MalVal { + while true { + + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + ast = astList[2] + env = letenv + continue # TCO + } else if a0sym.val == "do" { + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] + continue # TCO + } else if a0sym.val == "if" { + const condRes = EVAL(astList[1], env) + if condRes is MalNil || condRes is MalFalse { + ast = astList.count > 3 ? astList[3] : gNil + } else { + ast = astList[2] + } + continue # TCO + } else if a0sym.val == "fn*" { + const argsNames = astList[1] as MalSequential + return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) + } else { + const evaledList = astList.val.map(e => EVAL(e, env)) + const fn = evaledList[0] + const callArgs = evaledList.slice(1) + if fn is MalNativeFunc { + return (fn as MalNativeFunc).call(callArgs) + } else if fn is MalFunc { + const f = fn as MalFunc + ast = f.ast + env = Env.new(f.env, f.params.val, callArgs) + continue # TCO + } else { + throw MalError.new("Expected function as head of list") + } + } + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def RE(str string) MalVal { + return EVAL(READ(str), repl_env) +} + +def REP(str string) string { + return PRINT(RE(str)) +} + +@entry +def main { + # core.sk: defined using Skew + ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) + + # core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))") + + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + catch e Error { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step6_file.sk b/impls/skew/step6_file.sk new file mode 100644 index 0000000000..ac91af5e5b --- /dev/null +++ b/impls/skew/step6_file.sk @@ -0,0 +1,124 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def EVAL(ast MalVal, env Env) MalVal { + while true { + + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + ast = astList[2] + env = letenv + continue # TCO + } else if a0sym.val == "do" { + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] + continue # TCO + } else if a0sym.val == "if" { + const condRes = EVAL(astList[1], env) + if condRes is MalNil || condRes is MalFalse { + ast = astList.count > 3 ? astList[3] : gNil + } else { + ast = astList[2] + } + continue # TCO + } else if a0sym.val == "fn*" { + const argsNames = astList[1] as MalSequential + return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) + } else { + const evaledList = astList.val.map(e => EVAL(e, env)) + const fn = evaledList[0] + const callArgs = evaledList.slice(1) + if fn is MalNativeFunc { + return (fn as MalNativeFunc).call(callArgs) + } else if fn is MalFunc { + const f = fn as MalFunc + ast = f.ast + env = Env.new(f.env, f.params.val, callArgs) + continue # TCO + } else { + throw MalError.new("Expected function as head of list") + } + } + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def RE(str string) MalVal { + return EVAL(READ(str), repl_env) +} + +def REP(str string) string { + return PRINT(RE(str)) +} + +@entry +def main { + # core.sk: defined using Skew + ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) + repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) + + # core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))") + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + + if argv.count > 0 { + RE("(load-file \"" + argv[0] + "\")") + return + } + + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + catch e Error { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step7_quote.sk b/impls/skew/step7_quote.sk new file mode 100644 index 0000000000..e4be3a43a5 --- /dev/null +++ b/impls/skew/step7_quote.sk @@ -0,0 +1,160 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc +} +def quasiquote(ast MalVal) MalVal { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { + return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) + } +} + +def EVAL(ast MalVal, env Env) MalVal { + while true { + + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + ast = astList[2] + env = letenv + continue # TCO + } else if a0sym.val == "quote" { + return astList[1] + } else if a0sym.val == "quasiquote" { + ast = quasiquote(astList[1]) + continue # TCO + } else if a0sym.val == "do" { + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] + continue # TCO + } else if a0sym.val == "if" { + const condRes = EVAL(astList[1], env) + if condRes is MalNil || condRes is MalFalse { + ast = astList.count > 3 ? astList[3] : gNil + } else { + ast = astList[2] + } + continue # TCO + } else if a0sym.val == "fn*" { + const argsNames = astList[1] as MalSequential + return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) + } else { + const evaledList = astList.val.map(e => EVAL(e, env)) + const fn = evaledList[0] + const callArgs = evaledList.slice(1) + if fn is MalNativeFunc { + return (fn as MalNativeFunc).call(callArgs) + } else if fn is MalFunc { + const f = fn as MalFunc + ast = f.ast + env = Env.new(f.env, f.params.val, callArgs) + continue # TCO + } else { + throw MalError.new("Expected function as head of list") + } + } + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def RE(str string) MalVal { + return EVAL(READ(str), repl_env) +} + +def REP(str string) string { + return PRINT(RE(str)) +} + +@entry +def main { + # core.sk: defined using Skew + ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) + repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) + + # core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))") + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + + if argv.count > 0 { + RE("(load-file \"" + argv[0] + "\")") + return + } + + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + catch e Error { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step8_macros.sk b/impls/skew/step8_macros.sk new file mode 100644 index 0000000000..894b114e3d --- /dev/null +++ b/impls/skew/step8_macros.sk @@ -0,0 +1,170 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc +} +def quasiquote(ast MalVal) MalVal { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { + return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) + } +} + +def EVAL(ast MalVal, env Env) MalVal { + while true { + + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + ast = astList[2] + env = letenv + continue # TCO + } else if a0sym.val == "quote" { + return astList[1] + } else if a0sym.val == "quasiquote" { + ast = quasiquote(astList[1]) + continue # TCO + } else if a0sym.val == "defmacro!" { + var fn = EVAL(astList[2], env) as MalFunc + var macro = MalFunc.new(fn.ast, fn.params, fn.env, fn.func) + macro.setAsMacro + return env.set(astList[1] as MalSymbol, macro) + } else if a0sym.val == "do" { + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] + continue # TCO + } else if a0sym.val == "if" { + const condRes = EVAL(astList[1], env) + if condRes is MalNil || condRes is MalFalse { + ast = astList.count > 3 ? astList[3] : gNil + } else { + ast = astList[2] + } + continue # TCO + } else if a0sym.val == "fn*" { + const argsNames = astList[1] as MalSequential + return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) + } else { + const fn = EVAL(astList[0], env) + const args = astList.val.slice(1) + if fn is MalFunc && (fn as MalFunc).isMacro { + ast = (fn as MalFunc).call(args) + continue # TCO + } + const callArgs = args.map(e => EVAL(e, env)) + if fn is MalNativeFunc { + return (fn as MalNativeFunc).call(callArgs) + } else if fn is MalFunc { + const f = fn as MalFunc + ast = f.ast + env = Env.new(f.env, f.params.val, callArgs) + continue # TCO + } else { + throw MalError.new("Expected function as head of list") + } + } + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def RE(str string) MalVal { + return EVAL(READ(str), repl_env) +} + +def REP(str string) string { + return PRINT(RE(str)) +} + +@entry +def main { + # core.sk: defined using Skew + ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) + repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) + + # core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))") + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if argv.count > 0 { + RE("(load-file \"" + argv[0] + "\")") + return + } + + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalError { + printLn("Error: \(e.message)") + } + catch e Error { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/step9_try.sk b/impls/skew/step9_try.sk new file mode 100644 index 0000000000..c00276992a --- /dev/null +++ b/impls/skew/step9_try.sk @@ -0,0 +1,187 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc +} +def quasiquote(ast MalVal) MalVal { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { + return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) + } +} + +def EVAL(ast MalVal, env Env) MalVal { + while true { + + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + ast = astList[2] + env = letenv + continue # TCO + } else if a0sym.val == "quote" { + return astList[1] + } else if a0sym.val == "quasiquote" { + ast = quasiquote(astList[1]) + continue # TCO + } else if a0sym.val == "defmacro!" { + var fn = EVAL(astList[2], env) as MalFunc + var macro = MalFunc.new(fn.ast, fn.params, fn.env, fn.func) + macro.setAsMacro + return env.set(astList[1] as MalSymbol, macro) + } else if a0sym.val == "try*" { + if astList.count < 3 { + return EVAL(astList[1], env) + } + var exc MalVal + try { + return EVAL(astList[1], env) + } + catch e MalUserError { exc = e.data } + catch e MalError { exc = MalString.new(e.message) } + catch e Error { exc = MalString.new(e.message) } + const catchClause = astList[2] as MalList + var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) + return EVAL(catchClause[2], catchEnv) + } else if a0sym.val == "do" { + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] + continue # TCO + } else if a0sym.val == "if" { + const condRes = EVAL(astList[1], env) + if condRes is MalNil || condRes is MalFalse { + ast = astList.count > 3 ? astList[3] : gNil + } else { + ast = astList[2] + } + continue # TCO + } else if a0sym.val == "fn*" { + const argsNames = astList[1] as MalSequential + return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) + } else { + const fn = EVAL(astList[0], env) + const args = astList.val.slice(1) + if fn is MalFunc && (fn as MalFunc).isMacro { + ast = (fn as MalFunc).call(args) + continue # TCO + } + const callArgs = args.map(e => EVAL(e, env)) + if fn is MalNativeFunc { + return (fn as MalNativeFunc).call(callArgs) + } else if fn is MalFunc { + const f = fn as MalFunc + ast = f.ast + env = Env.new(f.env, f.params.val, callArgs) + continue # TCO + } else { + throw MalError.new("Expected function as head of list") + } + } + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def RE(str string) MalVal { + return EVAL(READ(str), repl_env) +} + +def REP(str string) string { + return PRINT(RE(str)) +} + +@entry +def main { + # core.sk: defined using Skew + ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) + repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) + + # core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))") + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if argv.count > 0 { + RE("(load-file \"" + argv[0] + "\")") + return + } + + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalUserError { + printLn("Error: \(e.data.print(false))") + } + catch e MalError { + printLn("Error: \(e.message)") + } + catch e Error { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/stepA_mal.sk b/impls/skew/stepA_mal.sk new file mode 100644 index 0000000000..d1e3126b82 --- /dev/null +++ b/impls/skew/stepA_mal.sk @@ -0,0 +1,189 @@ +def READ(str string) MalVal { + return read_str(str) +} + +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc +} +def quasiquote(ast MalVal) MalVal { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { + return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) + } +} + +def EVAL(ast MalVal, env Env) MalVal { + while true { + + const dbgeval = env.get("DEBUG-EVAL") + if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { + printLn("EVAL: " + PRINT(ast)) + } + + if ast is MalSymbol { + const key = (ast as MalSymbol).val + const val = env.get(key) + if val == null { throw MalError.new("'" + key + "' not found") } + return val + } else if ast is MalList { + # proceed further after this conditional + } else if ast is MalVector { + return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) + } else if ast is MalHashMap { + var result List = [] + (ast as MalHashMap).val.each((k string, v MalVal) => { + result.append(MalVal.fromHashKey(k)) + result.append(EVAL(v, env)) + }) + return MalHashMap.fromList(result) + } else { + return ast + } + + const astList = ast as MalList + if astList.isEmpty { return ast } + const a0sym = astList[0] as MalSymbol + if a0sym.val == "def!" { + return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) + } else if a0sym.val == "let*" { + var letenv = Env.new(env) + const assigns = astList[1] as MalSequential + for i = 0; i < assigns.count; i += 2 { + letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) + } + ast = astList[2] + env = letenv + continue # TCO + } else if a0sym.val == "quote" { + return astList[1] + } else if a0sym.val == "quasiquote" { + ast = quasiquote(astList[1]) + continue # TCO + } else if a0sym.val == "defmacro!" { + var fn = EVAL(astList[2], env) as MalFunc + var macro = MalFunc.new(fn.ast, fn.params, fn.env, fn.func) + macro.setAsMacro + return env.set(astList[1] as MalSymbol, macro) + } else if a0sym.val == "try*" { + if astList.count < 3 { + return EVAL(astList[1], env) + } + var exc MalVal + try { + return EVAL(astList[1], env) + } + catch e MalUserError { exc = e.data } + catch e MalError { exc = MalString.new(e.message) } + catch e Error { exc = MalString.new(e.message) } + const catchClause = astList[2] as MalList + var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) + return EVAL(catchClause[2], catchEnv) + } else if a0sym.val == "do" { + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] + continue # TCO + } else if a0sym.val == "if" { + const condRes = EVAL(astList[1], env) + if condRes is MalNil || condRes is MalFalse { + ast = astList.count > 3 ? astList[3] : gNil + } else { + ast = astList[2] + } + continue # TCO + } else if a0sym.val == "fn*" { + const argsNames = astList[1] as MalSequential + return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) + } else { + const fn = EVAL(astList[0], env) + const args = astList.val.slice(1) + if fn is MalFunc && (fn as MalFunc).isMacro { + ast = (fn as MalFunc).call(args) + continue # TCO + } + const callArgs = args.map(e => EVAL(e, env)) + if fn is MalNativeFunc { + return (fn as MalNativeFunc).call(callArgs) + } else if fn is MalFunc { + const f = fn as MalFunc + ast = f.ast + env = Env.new(f.env, f.params.val, callArgs) + continue # TCO + } else { + throw MalError.new("Expected function as head of list") + } + } + } +} + +def PRINT(exp MalVal) string { + return exp?.print(true) +} + +var repl_env = Env.new(null) + +def RE(str string) MalVal { + return EVAL(READ(str), repl_env) +} + +def REP(str string) string { + return PRINT(RE(str)) +} + +@entry +def main { + # core.sk: defined using Skew + ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) + repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) + + # core.mal: defined using the language itself + RE("(def! *host-language* \"skew\")") + RE("(def! not (fn* (a) (if a false true)))") + RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if argv.count > 0 { + RE("(load-file \"" + argv[0] + "\")") + return + } + + RE("(println (str \"Mal [\" *host-language* \"]\"))") + var line string + while (line = readLine("user> ")) != null { + if line == "" { continue } + try { + printLn(REP(line)) + } + catch e MalUserError { + printLn("Error: \(e.data.print(false))") + } + catch e MalError { + printLn("Error: \(e.message)") + } + catch e Error { + printLn("Error: \(e.message)") + } + } +} diff --git a/impls/skew/tests/step5_tco.mal b/impls/skew/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/skew/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/skew/types.sk b/impls/skew/types.sk new file mode 100644 index 0000000000..f12ef88611 --- /dev/null +++ b/impls/skew/types.sk @@ -0,0 +1,250 @@ +class MalError { + const message string +} + +class MalUserError { + const data MalVal +} + +class MalVal { + var _meta MalVal = gNil + def toHashKey string { throw MalError.new("Not allowed as hash map key") } + def print(readable bool) string + def equal(o MalVal) bool + def isSymbol(name string) bool { return false } + def seq MalVal { throw MalError.new("seq: called on non-sequence") } + def meta MalVal { return _meta } + def _setMeta(newMeta MalVal) { _meta = newMeta } + def withMeta(newMeta MalVal) MalVal { + var res = self.clone + res._setMeta(newMeta) + return res + } + def clone MalVal +} + +namespace MalVal { + def fromHashKey(key string) MalVal { + if key.startsWith("S_") { return MalString.new(key.slice(2)) } + else if key.startsWith("K_") { return MalKeyword.new(key.slice(2)) } + else { throw "Illegal hash key string" } + } + def fromBool(b bool) MalVal { return b ? gTrue : gFalse } +} + +class MalNil : MalVal { + over print(readable bool) string { return "nil" } + over equal(o MalVal) bool { return o is MalNil } + over seq MalVal { return gNil } + over clone MalVal { return self } +} +const gNil = MalNil.new + +class MalTrue : MalVal { + over print(readable bool) string { return "true" } + over equal(o MalVal) bool { return o is MalTrue } + over clone MalVal { return self } +} +const gTrue = MalTrue.new + +class MalFalse : MalVal { + over print(readable bool) string { return "false" } + over equal(o MalVal) bool { return o is MalFalse } + over clone MalVal { return self } +} +const gFalse = MalFalse.new + +class MalNumber : MalVal { + const _data int + over print(readable bool) string { return _data.toString } + def val int { return _data } + over equal(o MalVal) bool { return o is MalNumber && (o as MalNumber).val == val } + over clone MalVal { return self } +} + +class MalSymbol : MalVal { + const _data string + over print(readable bool) string { return _data } + def val string { return _data } + over equal(o MalVal) bool { return o is MalSymbol && (o as MalSymbol).val == val } + over isSymbol(name string) bool { return _data == name } + over clone MalVal { return MalSymbol.new(_data) } +} + +class MalString : MalVal { + const _data string + over print(readable bool) string { return readable ? "\"\(escaped_data)\"" : _data } + over toHashKey string { return "S_\(_data)" } + def val string { return _data } + over equal(o MalVal) bool { return o is MalString && (o as MalString).val == val } + def escaped_data string { + return _data.replaceAll("\\", "\\\\").replaceAll("\"", "\\\"").replaceAll("\n", "\\n") + } + over seq MalVal { return _data.count == 0 ? gNil : MalList.new(_data.split("").map(e => MalString.new(e))) } + over clone MalVal { return MalString.new(_data) } +} + +class MalKeyword : MalVal { + const _data string + over print(readable bool) string { return ":\(_data)" } + over toHashKey string { return "K_\(_data)" } + def val string { return _data } + over equal(o MalVal) bool { return o is MalKeyword && (o as MalKeyword).val == val } + over clone MalVal { return MalKeyword.new(_data) } +} + +class MalSequential : MalVal { + const _data List + def val List { return _data } + def isEmpty bool { return _data.isEmpty } + def asOneString(readable bool) string { + return " ".join(_data.map(v => v.print(readable))) + } + def count int { return _data.count } + def [](index int) MalVal { return _data[index] } + over equal(o MalVal) bool { + if !(o is MalSequential) { return false } + const oval = (o as MalSequential).val + if val.count != oval.count { return false } + for i in 0..val.count { + if !val[i].equal(oval[i]) { return false } + } + return true + } + def nth(position int) MalVal { + if position >= count { throw MalError.new("nth: index out of range") } + return val[position] + } + def first MalVal { + if isEmpty { return gNil } + return val[0] + } + def rest MalVal { + if isEmpty { return MalList.new([]) } + return MalList.new(val.slice(1)) + } + def conj(args List) MalVal +} + +class MalList : MalSequential { + over print(readable bool) string { return "(" + asOneString(readable) + ")" } + over seq MalVal { return isEmpty ? gNil : self } + over conj(args List) MalVal { + var res = args.clone + res.reverse + res.append(_data) + return MalList.new(res) + } + over clone MalVal { return MalList.new(_data) } +} + +class MalVector : MalSequential { + over print(readable bool) string { return "[" + asOneString(readable) + "]" } + over seq MalVal { return isEmpty ? gNil : MalList.new(_data) } + over conj(args List) MalVal { + var res = _data.clone + res.append(args) + return MalVector.new(res) + } + over clone MalVal { return MalVector.new(_data) } +} + +class MalHashMap : MalVal { + const _data StringMap + over print(readable bool) string { + var pairs List = [] + _data.each((k string, v MalVal) => pairs.append("\(MalVal.fromHashKey(k).print(readable)) \(v.print(readable))")) + return "{" + " ".join(pairs) + "}" + } + def val StringMap { return _data } + over equal(o MalVal) bool { + if !(o is MalHashMap) { return false } + const oh = o as MalHashMap + if oh.val.count != val.count { return false } + var allEqual = true + _data.each((k string, v MalVal) => { + if !(k in oh.val) || !(v.equal(oh.val[k])) { + allEqual = false + } + }) + return allEqual + } + def assoc(kv_list List) MalVal { + var new_data = _data.clone + for i = 0; i < kv_list.count; i += 2 { + new_data[kv_list[i].toHashKey] = kv_list[i + 1] + } + return MalHashMap.new(new_data) + } + def dissoc(keys List) MalVal { + var new_data = _data.clone + for key in keys { + new_data.remove(key.toHashKey) + } + return MalHashMap.new(new_data) + } + def get(key MalVal) MalVal { return _data.get(key.toHashKey, gNil) } + def contains(key MalVal) bool { return key.toHashKey in _data } + def keys List { + return _data.keys.map(k => MalVal.fromHashKey(k)) + } + def vals List { return _data.values } + over clone MalVal { return MalHashMap.new(_data) } +} + +namespace MalHashMap { + def fromList(kv_list List) MalHashMap { + var result StringMap = {} + for i = 0; i < kv_list.count; i += 2 { + result[kv_list[i].toHashKey] = kv_list[i + 1] + } + return MalHashMap.new(result) + } +} + +class MalCallable : MalVal { + const func fn(List) MalVal + def call(args List) MalVal { + return func(args) + } +} + +class MalNativeFunc : MalCallable { + over print(readable bool) string { return "#" } + over equal(o MalVal) bool { return false } + over clone MalVal { return MalNativeFunc.new(func) } +} + +class MalFunc : MalCallable { + const ast MalVal + const params MalSequential + const env Env + var _macro bool = false + def new(aAst MalVal, aParams MalSequential, aEnv Env, aFunc fn(List) MalVal) { + super(aFunc) + ast = aAst + params = aParams + env = aEnv + } + def isMacro bool { return _macro } + def setAsMacro { _macro = true } + over print(readable bool) string { return "#" } + over equal(o MalVal) bool { return false } + over clone MalVal { + var f = MalFunc.new(ast, params, env, func) + if isMacro { f.setAsMacro } + return f + } +} + +class MalAtom : MalVal { + var _data MalVal + over print(readable bool) string { return "(atom \(_data.print(readable)))" } + def val MalVal { return _data } + over equal(o MalVal) bool { return o is MalAtom && val.equal((o as MalAtom).val) } + def resetBang(newData MalVal) MalVal { + _data = newData + return _data + } + over clone MalVal { return MalAtom.new(_data) } +} diff --git a/impls/skew/util.sk b/impls/skew/util.sk new file mode 100644 index 0000000000..04fdfc1fa6 --- /dev/null +++ b/impls/skew/util.sk @@ -0,0 +1,55 @@ +def argv List { + return process.argv.slice(2) +} + +def timeMs int { + return Date.new.getTime() +} + +var fs = require("fs") + +def readFile(filename string) string { + return fs.readFileSync(filename, "utf-8") +} + +def writeString(s string) { + fs.writeSync(1, s) +} + +def printLn(s string) { + writeString(s) + writeString("\n") +} + +def readLine(prompt string) string { + writeString(prompt) + var buffer = Buffer.new(1024) # in newer Node this should be Buffer.alloc + var stdin = fs.openSync("/dev/stdin", "rs") + var bytesread int + var anycharseen = false + var total = 0 + while (bytesread = fs.readSync(stdin, buffer, total, 1)) > 0 { + anycharseen = true + var lastchar = buffer.slice(total, total + bytesread).toString() + if lastchar == "\n" { + break + } + total += bytesread + } + fs.closeSync(stdin) + return anycharseen ? buffer.slice(0, total).toString() : null +} + +def stringToInt(str string) int { + return parseInt(str) +} + +@import { + const process dynamic + const Buffer dynamic + const Date dynamic + const Error dynamic + + def parseInt(str string) int + def require(name string) dynamic +} diff --git a/impls/sml/.gitignore b/impls/sml/.gitignore new file mode 100644 index 0000000000..cb5dad854d --- /dev/null +++ b/impls/sml/.gitignore @@ -0,0 +1,4 @@ +.smlmode +.step* +*.ui +*.uo diff --git a/impls/sml/Dockerfile b/impls/sml/Dockerfile new file mode 100644 index 0000000000..72a3adca9c --- /dev/null +++ b/impls/sml/Dockerfile @@ -0,0 +1,27 @@ +# We need focal for the Moscow ML PPA +FROM ubuntu:focal + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update +RUN apt-get -y install make python3 +RUN ln -s /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install software-properties-common + +RUN apt-get -y install polyml libpolyml-dev + +RUN apt-get -y install mlton + +RUN add-apt-repository -y ppa:kflarsen/mosml +RUN apt-get -y install mosml diff --git a/impls/sml/LargeInt.sml b/impls/sml/LargeInt.sml new file mode 100644 index 0000000000..db95f80b24 --- /dev/null +++ b/impls/sml/LargeInt.sml @@ -0,0 +1,6 @@ +(* Moscow ML does not have the LargeInt structure, + * but its Int is 64 bit on 64 bit systems. + * We need 64 bit integers for the `time-ms` core function. + *) + +structure LargeInt = Int diff --git a/impls/sml/Makefile b/impls/sml/Makefile new file mode 100644 index 0000000000..1792efc453 --- /dev/null +++ b/impls/sml/Makefile @@ -0,0 +1,61 @@ +STEP_BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step6_file step7_quote step8_macros step9_try stepA_mal + +sml_MODE_DEFAULT = polyml +sml_MODE_CONFIG = .smlmode + +ifeq ($(sml_MODE),) +sml_MODE = $(sml_MODE_DEFAULT) +endif +# some hackery to let Make know if it needs to rebuild when sml_MODE changes +ifneq ($(sml_MODE),$(shell cat $(sml_MODE_CONFIG) 2> /dev/null)) +$(shell rm $(sml_MODE_CONFIG) 2> /dev/null) +endif + +ifeq ($(sml_MODE),mlton) +SMLC = mlton +SMLCOUTFLAG = -output +BUILD_FILE = %.mlb +build_args = $1 +endif +ifeq ($(sml_MODE),mosml) +SMLC = mosmlc +SMLCOUTFLAG = -o +BUILD_FILE = %.mlb +build_args = LargeInt.sml -toplevel $(shell grep "\\.sml" $1) +endif +ifeq ($(sml_MODE),polyml) +SMLC = polyc +SMLCOUTFLAG = -o +BUILD_FILE = .%.poly.sml +build_args = $1 +endif + +all: $(STEP_BINS) + +dist: mal + +mal: stepA_mal + cp $< $@ + +.%.dep: %.mlb + @echo sml-deps -o $@ $< + $(eval DEPS := $(shell grep "\\.sml" $<)) + @echo "$(@:.%.dep=%) $@: $(DEPS)" > $@ + +include $(STEP_BINS:%=.%.dep) + +.%.poly.sml: %.mlb + @echo generate-sml -o $@ $< + @grep "\\.sml" $< | grep -v main | xargs printf "use \"%s\";\n" > $@ + +# some hackery to let Make track changes in sml_MODE +$(sml_MODE_CONFIG): + @echo $(sml_MODE) > $@ + +$(STEP_BINS): %: $(BUILD_FILE) $(sml_MODE_CONFIG) + $(SMLC) $(SMLCOUTFLAG) $@ $(call build_args,$<) + +clean: + rm -f $(STEP_BINS) .*.dep *.ui *.uo .*.poly.sml $(sml_MODE_CONFIG) + +.PHONY: all clean diff --git a/impls/sml/README.md b/impls/sml/README.md new file mode 100644 index 0000000000..8f0ee651c2 --- /dev/null +++ b/impls/sml/README.md @@ -0,0 +1,34 @@ +# SML-MAL + +This is Make-A-Lisp in Standard ML. + +## Building + +Just run `make`. + +Building requires a Standard ML compiler with basis library. This MAL +implementation has been tested and works with Poly/ML, MLton, and Moscow ML. + +On Ubuntu, you can run `apt-get install polyml libpolyml-dev`. + +By setting `sml_MODE` to `polyml`, `mosml`, or `mlton` on invoking `make` you +can select which compiler to use. The Makefile has some hacks to figure out +how to make the different compilers build everything. + +## Running + +You can build a `mal` binary from the final step with `make dist`: + +``` +$ make dist +$ ./mal +Mal [sml] +user> (map (fn* (x) (println "Odelay!")) [1 2 3 4 5]) +Odelay! +Odelay! +Odelay! +Odelay! +Odelay! +(nil nil nil nil nil) +user> +``` diff --git a/impls/sml/core.sml b/impls/sml/core.sml new file mode 100644 index 0000000000..6e2be02285 --- /dev/null +++ b/impls/sml/core.sml @@ -0,0 +1,207 @@ +exception NotDefined of string +exception NotApplicable of string +exception OutOfBounds of string +exception MalException of mal_type + +(* + * Some helper functions + *) + +fun buildMap (k::v::rest) acc = buildMap rest (malAssoc acc k v) + | buildMap [] acc = malMap (rev acc) + | buildMap _ _ = raise NotApplicable "maps can only be constructed from an even number of arguments" + +fun collectLists ls = collectLists' ls [] +and collectLists' (LIST (l,_)::rest) acc = collectLists' rest (l::acc) + | collectLists' (VECTOR (v,_)::rest) acc = collectLists' rest (v::acc) + | collectLists' [] acc = rev acc + | collectLists' _ _ = raise NotApplicable "invalid arguments" + +fun arithFolder n f (INT next, INT prev) = INT (f (prev, next)) + | arithFolder n _ _ = raise NotApplicable ("'" ^ n ^ "' requires integer arguments") + +fun cmpFolder n c (INT next, (INT prev, acc)) = (INT next, acc andalso (c (prev, next))) + | cmpFolder n _ _ = raise NotApplicable ("'" ^ n ^ "' requires integer arguments") + +fun cmpFold n c (x::xs) = foldl (cmpFolder n c) (x, true) xs |> #2 |> BOOL + | cmpFold n _ _ = raise NotApplicable ("'" ^ n ^ "' requires arguments") + +fun splatArgs [LIST (l,_)] = l + | splatArgs [VECTOR (v,_)] = v + | splatArgs (x::xs) = x::(splatArgs xs) + | splatArgs [] = [] + +fun slurp lines strm = case TextIO.inputLine strm of + SOME l => slurp (l::lines) strm + | NONE => (TextIO.closeIn strm; rev lines) + +fun malPrint s = ( + TextIO.print (s ^ "\n"); + NIL +) + +fun readLine prompt = ( + TextIO.print prompt; + TextIO.inputLine TextIO.stdIn |> Option.map (trimr 1) +) + +fun strJoin separator strings = String.concatWith separator strings + +(* + * Core primitives + *) + +fun prim name f = + let val badArgs = STRING ("incorrect arguments passed to '" ^ name ^ "'") in + [SYMBOL name, FN (fn args => f args handle Domain => raise MalException badArgs, NO_META)] + end + +val coreNs = List.concat [ + + (* Maths *) + prim "+" (fn args => foldl (arithFolder "+" (op +)) (INT 0) args), + prim "*" (fn args => foldl (arithFolder "*" (op * )) (INT 1) args), + prim "/" (fn (x::xs) => foldl (arithFolder "/" (op div)) x xs | _ => raise Domain), + prim "-" (fn (x::xs) => foldl (arithFolder "-" (op -)) x xs | _ => raise Domain), + + (* Comparisons *) + prim "<" (cmpFold "<" (op <)), + prim "<=" (cmpFold "<=" (op <=)), + prim ">=" (cmpFold ">=" (op >=)), + prim ">" (cmpFold ">" (op >)), + prim "=" + (fn (x::xs) => foldl (fn (n,(p,acc)) => (n,acc andalso (malEq (n, p)))) (x, true) xs |> #2 |> BOOL + | _ => raise Domain), + + (* Predicates *) + prim "nil?" (fn [NIL] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "true?" (fn [BOOL true] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "false?" (fn [BOOL false] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "symbol?" (fn [SYMBOL _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "keyword?" (fn [KEYWORD _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "vector?" (fn [VECTOR _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "map?" (fn [MAP _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "fn?" (fn [FN _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "macro?" (fn [MACRO _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "string?" (fn [STRING _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "number?" (fn [INT _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "atom?" (fn [ATOM _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "list?" (fn [LIST _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "sequential?" + (fn [LIST _] => BOOL true | [VECTOR _] => BOOL true | [_] => BOOL false | _ => raise Domain), + prim "empty?" + (fn [LIST (l,_)] => BOOL (length l = 0) | [VECTOR (v,_)] => BOOL (length v = 0) | _ => raise Domain), + prim "contains?" + (fn [MAP (m,_), k] => BOOL (List.exists (fn (k', _) => malEq (k, k')) m) | _ => raise Domain), + + (* I/O *) + prim "slurp" + (fn [STRING filename] => TextIO.openIn filename |> slurp [] |> strJoin "" |> STRING | _ => raise Domain), + prim "prn" + (fn args => args |> map prReadableStr |> strJoin " " |> malPrint), + prim "println" + (fn args => args |> map prStr |> strJoin " " |> malPrint), + prim "readline" + (fn [STRING prompt] => valOrElse (readLine prompt |> Option.map STRING) (fn () => NIL) | _ => raise Domain), + + (* Strings and stringoids *) + prim "str" + (fn args => args |> map prStr |> strJoin "" |> STRING), + prim "pr-str" + (fn args => args |> map prReadableStr |> strJoin " " |> STRING), + prim "symbol" + (fn [STRING s] => SYMBOL s | _ => raise Domain), + prim "keyword" + (fn [STRING s] => KEYWORD s | [kw as KEYWORD _] => kw | _ => raise Domain), + + (* Atoms *) + prim "atom" (fn [x] => ATOM (ref x) | _ => raise Domain), + prim "deref" (fn [ATOM a] => !a | _ => raise Domain), + prim "reset!" (fn [ATOM a, x] => (a := x; x) | _ => raise Domain), + prim "swap!" (fn (ATOM a::(FN (f,_))::args) => let val x = f ((!a)::args) in (a := x; x) end | _ => raise Domain), + + (* Listoids *) + prim "list" (fn args => malList args), + prim "vector" (fn args => malVector (args)), + prim "vec" (fn [LIST (xs,_)] => malVector (xs) | [v as VECTOR _] => v | _ => raise Domain), + prim "concat" (fn args => malList (List.concat (collectLists args))), + prim "cons" + (fn [hd, LIST (tl,_)] => malList (hd::tl) + | [hd, VECTOR (tl,_)] => malList (hd::tl) + | _ => raise Domain), + prim "conj" + (fn (LIST (l,_)::args) => malList (rev args @ l) + | (VECTOR (v,_)::args) => malVector (v @ args) + | _ => raise Domain), + prim "seq" + (fn [LIST ([],_)] => NIL | [l as LIST _] => l + | [VECTOR ([],_)] => NIL | [VECTOR (v,_)] => malList v + | [STRING ""] => NIL | [STRING s] => String.explode s |> List.map (STRING o String.str) |> malList + | [NIL] => NIL + | _ => raise Domain), + prim "count" + (fn [LIST (l,_)] => INT (length l |> LargeInt.fromInt) + | [VECTOR (v,_)] => INT (length v |> LargeInt.fromInt) + | [NIL] => INT 0 + | _ => raise Domain), + prim "nth" + (fn [LIST (l,_), INT n] => (List.nth (l, (Int.fromLarge n)) handle Subscript => raise OutOfBounds "index out of bounds") + | [VECTOR (v,_), INT n] => (List.nth (v, (Int.fromLarge n)) handle Subscript => raise OutOfBounds "index out of bounds") + | _ => raise Domain), + prim "first" + (fn [LIST (l,_)] => (case l of (x::_) => x | _ => NIL) + | [VECTOR (v,_)] => (case v of (x::_) => x | _ => NIL) + | [NIL] => NIL + | _ => raise Domain), + prim "rest" + (fn [LIST (l,_)] => malList (case l of (_::xs) => xs | _ => []) + | [VECTOR (v,_)] => malList (case v of (_::xs) => xs | _ => []) + | [NIL] => malList ([]) + | _ => raise Domain), + prim "map" + (fn [FN (f,_), LIST (l,_)] => malList (List.map (fn x => f [x]) l) + | [FN (f,_), VECTOR (v,_)] => malList (List.map (fn x => f [x]) v) + | _ => raise Domain), + + (* Maps *) + prim "hash-map" + (fn args => buildMap args []), + prim "assoc" + (fn (MAP (m,_)::(args as _::_)) => buildMap args m | _ => raise Domain), + prim "dissoc" + (fn (MAP (m,_)::(args as _::_)) => malMap (foldl (fn (k, acc) => malDissoc acc k) m args) | _ => raise Domain), + prim "get" + (fn [MAP (m,_), k] => valOrElse (malGet m k) (fn () => NIL) | [NIL, _] => NIL | _ => raise Domain), + prim "keys" + (fn [MAP (m,_)] => malList (map #1 m) | _ => raise Domain), + prim "vals" + (fn [MAP (m,_)] => malList (map #2 m) | _ => raise Domain), + + (* Metaprogramming and metadata *) + prim "read-string" + (fn [STRING s] => readStr s | _ => raise Domain), + prim "apply" + (fn (FN (f,_)::args) => f (splatArgs args) + | (MACRO f::args) => f (splatArgs args) + | _ => raise Domain), + prim "meta" + (fn [ FN (_, META m)] => m + | [ LIST (_, META m)] => m + | [VECTOR (_, META m)] => m + | [ MAP (_, META m)] => m + | [_] => NIL + | _ => raise Domain), + prim "with-meta" + (fn [FN (f,_), meta] => FN (f, META meta) + | [LIST (l,_), meta] => LIST (l, META meta) + | [VECTOR (v,_), meta] => VECTOR (v, META meta) + | [MAP (m,_), meta] => MAP (m, META meta) + | [x] => x + | _ => raise Domain), + + (* Odds and ends *) + prim "throw" + (fn [x] => raise MalException x | _ => raise Domain), + prim "time-ms" + (fn _ => INT (Time.now () |> Time.toMilliseconds)) +] diff --git a/impls/sml/env.sml b/impls/sml/env.sml new file mode 100644 index 0000000000..a49e0d1653 --- /dev/null +++ b/impls/sml/env.sml @@ -0,0 +1,11 @@ +fun set s v (NS d) = d := (s, v) :: (!d |> List.filter (not o eq s o #1)) + +fun get (NS d) s = !d |> List.find (eq s o #1) |> Option.map #2 + +fun def s v (ENV ns) = set s v ns + | def s v (INNER (ns, _)) = set s v ns + +fun lookup (ENV ns) s = get ns s + | lookup (INNER (ns, outer)) s = optOrElse (get ns s) (fn () => lookup outer s) + +fun inside outer = INNER (NS (ref []), outer) diff --git a/impls/sml/main.sml b/impls/sml/main.sml new file mode 100644 index 0000000000..ccd9b5d05e --- /dev/null +++ b/impls/sml/main.sml @@ -0,0 +1 @@ +val _ = main () diff --git a/impls/sml/printer.sml b/impls/sml/printer.sml new file mode 100644 index 0000000000..5d5b4b3c01 --- /dev/null +++ b/impls/sml/printer.sml @@ -0,0 +1,22 @@ +fun prStr NIL = "nil" + | prStr (SYMBOL s) = s + | prStr (BOOL true) = "true" + | prStr (BOOL false) = "false" + | prStr (ATOM x) = "# (" ^ (prStr (!x)) ^ ")" + | prStr (INT i) = if i >= 0 then LargeInt.toString i else "-" ^ (LargeInt.toString (LargeInt.abs i)) + | prStr (STRING s) = s + | prStr (KEYWORD s) = ":" ^ s + | prStr (LIST (l,_)) = "(" ^ (String.concatWith " " (map prStr l)) ^ ")" (* N.B. not tail recursive *) + | prStr (VECTOR (v,_)) = "[" ^ (String.concatWith " " (map prStr v)) ^ "]" (* N.B. not tail recursive *) + | prStr (MAP (m,_)) = "{" ^ (String.concatWith " " (map prKvp m)) ^ "}" (* N.B. not tail recursive *) + | prStr (FN _) = "#" + | prStr (MACRO _) = "#" +and prKvp (k, v) = (prStr k) ^ " " ^ (prStr v) + +fun prReadableStr (STRING s) = "\"" ^ (malEscape s) ^ "\"" + | prReadableStr (ATOM x) = "(atom " ^ (prReadableStr (!x)) ^ ")" + | prReadableStr (LIST (l,_)) = "(" ^ (String.concatWith " " (map prReadableStr l)) ^ ")" (* N.B. not tail recursive *) + | prReadableStr (VECTOR (v,_)) = "[" ^ (String.concatWith " " (map prReadableStr v)) ^ "]" (* N.B. not tail recursive *) + | prReadableStr (MAP (m,_)) = "{" ^ (String.concatWith " " (map prReadableKvp m)) ^ "}" (* N.B. not tail recursive *) + | prReadableStr x = prStr x +and prReadableKvp (k, v) = (prReadableStr k) ^ " " ^ (prReadableStr v) diff --git a/impls/sml/reader.sml b/impls/sml/reader.sml new file mode 100644 index 0000000000..791fb68f59 --- /dev/null +++ b/impls/sml/reader.sml @@ -0,0 +1,161 @@ +exception Nothing +exception SyntaxError of string +exception ReaderError of string + +structure Ss = Substring + +datatype token = + SPACE + | COMMENT of string + | BRACKET_LEFT | BRACKET_RIGHT + | BRACE_LEFT | BRACE_RIGHT + | PAREN_LEFT | PAREN_RIGHT + | QUOTE | BACK_TICK | TILDE | TILDE_AT + | CARET + | AT + | LIT_ATOM of string + | LIT_STR of string + +fun tokenString SPACE = "SPACE" + | tokenString (COMMENT s) = "COMMENT (" ^ s ^ ")" + | tokenString BRACKET_LEFT = "BRACKET_LEFT" + | tokenString BRACKET_RIGHT = "BRACKET_RIGHT" + | tokenString BRACE_LEFT = "BRACE_LEFT" + | tokenString BRACE_RIGHT = "BRACE_RIGHT" + | tokenString PAREN_LEFT = "PAREN_LEFT" + | tokenString PAREN_RIGHT = "PAREN_RIGHT" + | tokenString QUOTE = "QUOTE" + | tokenString BACK_TICK = "BACK_TICK" + | tokenString TILDE = "TILDE" + | tokenString TILDE_AT = "TILDE_AT" + | tokenString CARET = "CARET" + | tokenString AT = "AT" + | tokenString (LIT_ATOM s) = "LIT_ATOM (" ^ s ^ ")" + | tokenString (LIT_STR s) = "LIT_STR \"" ^ s ^ "\"" + +datatype reader = READER of token list + +fun next (READER (x::xs)) = SOME (x, READER xs) + | next r = NONE + +fun peek (READER (x::_)) = SOME x + | peek r = NONE + +fun rest (READER (_::xs)) = READER xs + | rest r = raise ReaderError "out of tokens" + +fun findSpecial #"[" = SOME BRACKET_LEFT + | findSpecial #"]" = SOME BRACKET_RIGHT + | findSpecial #"(" = SOME PAREN_LEFT + | findSpecial #")" = SOME PAREN_RIGHT + | findSpecial #"{" = SOME BRACE_LEFT + | findSpecial #"}" = SOME BRACE_RIGHT + | findSpecial #"'" = SOME QUOTE + | findSpecial #"`" = SOME BACK_TICK + | findSpecial #"~" = SOME TILDE + | findSpecial #"^" = SOME CARET + | findSpecial #"@" = SOME AT + | findSpecial _ = NONE + +fun scanSpace ss = + let fun isSpace c = Char.isSpace c orelse c = #"," + val (tok, rest) = Ss.splitl isSpace ss in + if Ss.isEmpty tok then NONE else SOME (SPACE, rest) + end + +fun scanComment ss = case Ss.getc ss of + SOME (#";", rest) => + let val (comment, rest) = Ss.splitl (fn (c) => c <> #"\n") rest in + SOME (COMMENT (Ss.string comment), rest) + end + | _ => NONE + +fun scanSpecial ss = + if Ss.isPrefix "~@" ss + then SOME (TILDE_AT, Ss.slice (ss, 2, NONE)) + else let fun findToken (c, rest) = findSpecial c |> Option.map (fn t => (t, rest)) in + Option.composePartial (findToken, Ss.getc) ss + end + +fun scanString ss = + Ss.getc ss |> Option.mapPartial (fn (#"\"", rest) => spanString rest rest | _ => NONE) + +and spanString from to = case Ss.getc to of + SOME (#"\\", rest) => Ss.getc rest |> Option.mapPartial (fn (_, more) => spanString from more) + | SOME (#"\"", rest) => SOME (LIT_STR (spanString' from to), rest) + | SOME (_, rest) => spanString from rest + | NONE => raise SyntaxError "end of input reached when parsing string literal" +and spanString' from stop = + Ss.span (from, Ss.slice (stop, 0, SOME 0)) |> Ss.string + +fun scanAtom ss = + let fun isAtomChar c = Char.isGraph c andalso (findSpecial c = NONE) + val (tok, rest) = Ss.splitl isAtomChar ss in + if Ss.isEmpty tok then NONE else SOME (LIT_ATOM (Ss.string tok), rest) + end + +fun scanToken ss = + let val scanners = [scanSpace, scanComment, scanSpecial, scanString, scanAtom] + val findScanner = List.find (fn f => isSome (f ss)) + fun applyScanner s = s ss + in + Option.composePartial (applyScanner, findScanner) scanners + end + +fun tokenize s = tokenize' [] (Ss.full s) +and tokenize' acc ss = case scanToken ss of + SOME (token, rest) => tokenize' (token::acc) rest + | NONE => rev acc + +fun readAtom r = case next r of + SOME (LIT_ATOM "nil", r') => (NIL, r') + | SOME (LIT_ATOM "true", r') => (BOOL true, r') + | SOME (LIT_ATOM "false", r') => (BOOL false, r') + | SOME (LIT_ATOM s, r') => (LargeInt.fromString s |> Option.map INT + |> optIfNone (fn () => Option.filter (String.isPrefix ":") s |> Option.map (KEYWORD o (triml 1))) + |> valIfNone (fn () => SYMBOL s), r') + | SOME (LIT_STR s, r') => (malUnescape s |> STRING, r') + | SOME (CARET, r') => readWithMeta r' + | SOME (token, _) => raise SyntaxError ("unexpected token reading atom: " ^ (tokenString token)) + | NONE => raise SyntaxError "end of input reached when reading atom" + +and readForm r = case peek r of + SOME PAREN_LEFT => readList [] (rest r) + | SOME BRACKET_LEFT => readVector [] (rest r) + | SOME BRACE_LEFT => readMap [] (rest r) + | SOME AT => let val (a, r') = readAtom (rest r) in (malList [SYMBOL "deref", a], r') end + | SOME QUOTE => let val (a, r') = readForm (rest r) in (malList [SYMBOL "quote", a], r') end + | SOME BACK_TICK => let val (a, r') = readForm (rest r) in (malList [SYMBOL "quasiquote", a], r') end + | SOME TILDE => let val (a, r') = readForm (rest r) in (malList [SYMBOL "unquote", a], r') end + | SOME TILDE_AT => let val (a, r') = readForm (rest r) in (malList [SYMBOL "splice-unquote", a], r') end + | _ => readAtom r + +and readWithMeta r = + let val (m, r') = readForm r + val (v, r'') = readForm r' + in + (malList [SYMBOL "with-meta", v, m], r'') + end + +and readList acc r = + if peek r = SOME PAREN_RIGHT + then (LIST (rev acc, NO_META), (rest r)) + else let val (a, r') = readForm r in readList (a::acc) r' end + +and readVector acc r = + if peek r = SOME BRACKET_RIGHT + then (VECTOR (rev acc, NO_META), (rest r)) + else let val (a, r') = readForm r in readVector (a::acc) r' end + +and readMap acc r = + if peek r = SOME BRACE_RIGHT + then (MAP (rev acc, NO_META), (rest r)) + else let val (k, r') = readForm r val (v, r'') = readForm r' in readMap (malAssoc acc k v) r'' end + +fun clean ts = + ts |> List.filter (fn x => x <> SPACE) + |> List.filter (fn COMMENT _ => false | _ => true) + +fun readStr s = case tokenize s |> clean of + [] => raise Nothing + | ts => ts |> READER |> readForm |> #1 diff --git a/impls/sml/run b/impls/sml/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/sml/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/sml/step0_repl.mlb b/impls/sml/step0_repl.mlb new file mode 100644 index 0000000000..613311cb56 --- /dev/null +++ b/impls/sml/step0_repl.mlb @@ -0,0 +1,6 @@ +local + $(SML_LIB)/basis/basis.mlb + step0_repl.sml +in + main.sml +end diff --git a/impls/sml/step0_repl.sml b/impls/sml/step0_repl.sml new file mode 100644 index 0000000000..3485ec9b98 --- /dev/null +++ b/impls/sml/step0_repl.sml @@ -0,0 +1,25 @@ +fun read s: string = + s + +fun eval s: string = + s + +fun print s: string = + s + +fun rep s: string = + (print o eval o read) s + +fun repl () = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => ( + print(rep(line) ^ "\n"); + repl () + ) + | NONE => () + ) end + +fun main () = repl () diff --git a/impls/sml/step1_read_print.mlb b/impls/sml/step1_read_print.mlb new file mode 100644 index 0000000000..20927d5e7e --- /dev/null +++ b/impls/sml/step1_read_print.mlb @@ -0,0 +1,10 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + step1_read_print.sml +in + main.sml +end diff --git a/impls/sml/step1_read_print.sml b/impls/sml/step1_read_print.sml new file mode 100644 index 0000000000..1b47c0692e --- /dev/null +++ b/impls/sml/step1_read_print.sml @@ -0,0 +1,27 @@ +fun read s = + readStr s + +fun eval f = + f + +fun print f = + prReadableStr f + +fun rep s = + s |> read |> eval |> print + handle SyntaxError msg => "SYNTAX ERROR: " ^ msg + | Nothing => "" + +fun repl () = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => ( + print(rep(line) ^ "\n"); + repl () + ) + | NONE => () + ) end + +fun main () = repl () diff --git a/impls/sml/step2_eval.mlb b/impls/sml/step2_eval.mlb new file mode 100644 index 0000000000..c07441f343 --- /dev/null +++ b/impls/sml/step2_eval.mlb @@ -0,0 +1,11 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + step2_eval.sml +in + main.sml +end diff --git a/impls/sml/step2_eval.sml b/impls/sml/step2_eval.sml new file mode 100644 index 0000000000..730d913552 --- /dev/null +++ b/impls/sml/step2_eval.sml @@ -0,0 +1,69 @@ +exception NotDefined of string +exception NotApplicable of string + +fun read s = + readStr s + +(* TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") *) +fun eval e ast = case ast of + LIST (_::_,_) => evalApply e ast + | _ => evalAst e ast + +and evalAst e ast = case ast of + SYMBOL s => (case lookup e s of SOME v => v | NONE => raise NotDefined ("unable to resolve symbol '" ^ s ^ "'")) + | LIST (l,_) => LIST (List.map (eval e) l, NO_META) + | VECTOR (v,_) => VECTOR (List.map (eval e) v, NO_META) + | MAP (m,_) => MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | _ => ast + +and evalApply e ast = case evalAst e ast of + LIST ((FN (f,_))::args, _) => f args + | _ => raise NotApplicable "eval_apply needs a non-empty list" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | e => "ERROR: " ^ (exnMessage e) + +fun malPlus (INT a, INT b) = INT (a + b) + | malPlus _ = raise NotApplicable "can only add integers" +fun malTimes (INT a, INT b) = INT (a * b) + | malTimes _ = raise NotApplicable "can only multiply integers" +fun malMinus (INT b, INT a) = INT (a - b) + | malMinus _ = raise NotApplicable "can only subtract integers" +fun malDiv (INT b, INT a) = INT (a div b) + | malDiv _ = raise NotApplicable "can only divide integers" + +val replEnv = ENV (NS (ref [ + ("+", FN (foldl malPlus (INT 0), NO_META)), + ("*", FN (foldl malTimes (INT 1), NO_META)), + ("-", FN ( + fn [x] => malMinus (x, INT 0) + | x::xs => foldr malMinus x xs + | _ => raise NotApplicable "'-' requires at least one argument" + , NO_META + )), + ("/", FN ( + fn [x] => malDiv (x, INT 1) + | x::xs => foldr malDiv x xs + | _ => raise NotApplicable "'/' requires at least one argument" + , NO_META + )) +])) + +fun repl () = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => ( + print((rep replEnv line) ^ "\n"); + repl () + ) + | NONE => () + ) end + +fun main () = repl () diff --git a/impls/sml/step3_env.mlb b/impls/sml/step3_env.mlb new file mode 100644 index 0000000000..a51484a27f --- /dev/null +++ b/impls/sml/step3_env.mlb @@ -0,0 +1,11 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + step3_env.sml +in + main.sml +end diff --git a/impls/sml/step3_env.sml b/impls/sml/step3_env.sml new file mode 100644 index 0000000000..e7936d3019 --- /dev/null +++ b/impls/sml/step3_env.sml @@ -0,0 +1,92 @@ +exception NotDefined of string +exception NotApplicable of string + +fun read s = + readStr s + +fun eval e ast = ( + case lookup e "DEBUG-EVAL" of + SOME(x) => if truthy x + then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") + else () + | NONE => (); + eval' e ast) + +and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval' e (SYMBOL s) = evalSymbol e s + | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval' e ast = ast + +and specialEval (SYMBOL "def!") = SOME evalDef + | specialEval (SYMBOL "let*") = SOME evalLet + | specialEval _ = NONE + +and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end + | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and evalLet e [LIST (bs,_), ast] = eval (bind bs (inside e)) ast + | evalLet e [VECTOR (bs,_), ast] = eval (bind bs (inside e)) ast + | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply _ a args = raise NotApplicable (prStr a ^ " is not applicable on " ^ prStr (LIST (args, NO_META))) + +and evalSymbol e s = valOrElse (lookup e s) + (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) + +and bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e) + | bind [] e = e + | bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | SyntaxError msg => "SYNTAX ERROR: " ^ msg + | NotApplicable msg => "CANNOT APPLY: " ^ msg + | NotDefined msg => "NOT DEFINED: " ^ msg + +fun malPlus (INT a, INT b) = INT (a + b) + | malPlus _ = raise NotApplicable "can only add integers" +fun malTimes (INT a, INT b) = INT (a * b) + | malTimes _ = raise NotApplicable "can only multiply integers" +fun malMinus (INT b, INT a) = INT (a - b) + | malMinus _ = raise NotApplicable "can only subtract integers" +fun malDiv (INT b, INT a) = INT (a div b) + | malDiv _ = raise NotApplicable "can only divide integers" + +val replEnv = ENV (NS (ref [])) |> bind [ + SYMBOL "+", + FN (foldl malPlus (INT 0), NO_META), + SYMBOL "*", + FN (foldl malTimes (INT 1), NO_META), + SYMBOL "-", + FN (fn [x] => malMinus (x, INT 0) + | x::xs => foldr malMinus x xs + | _ => raise NotApplicable "'-' requires arguments" + , NO_META), + SYMBOL "/", + FN (fn [x] => malDiv (x, INT 1) + | x::xs => foldr malDiv x xs + | _ => raise NotApplicable "'/' requires arguments" + , NO_META) +] + +fun repl e = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => + let val s = rep e line + val _ = print(s ^ "\n") + in + repl e + end + | NONE => () + ) end + +fun main () = repl replEnv diff --git a/impls/sml/step4_if_fn_do.mlb b/impls/sml/step4_if_fn_do.mlb new file mode 100644 index 0000000000..5df0c8adab --- /dev/null +++ b/impls/sml/step4_if_fn_do.mlb @@ -0,0 +1,12 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + core.sml + step4_if_fn_do.sml +in + main.sml +end diff --git a/impls/sml/step4_if_fn_do.sml b/impls/sml/step4_if_fn_do.sml new file mode 100644 index 0000000000..16b590a47f --- /dev/null +++ b/impls/sml/step4_if_fn_do.sml @@ -0,0 +1,90 @@ +fun read s = + readStr s + +fun eval e ast = ( + case lookup e "DEBUG-EVAL" of + SOME(x) => if truthy x + then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") + else () + | NONE => (); + eval' e ast) + +and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval' e (SYMBOL s) = evalSymbol e s + | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval' e ast = ast + +and specialEval (SYMBOL "def!") = SOME evalDef + | specialEval (SYMBOL "let*") = SOME evalLet + | specialEval (SYMBOL "do") = SOME evalDo + | specialEval (SYMBOL "if") = SOME evalIf + | specialEval (SYMBOL "fn*") = SOME evalFn + | specialEval _ = NONE + +and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end + | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs + | evalDo _ _ = raise NotApplicable "do needs at least one argument" + +and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b + | evalIf e [c,a] = evalIf e [c,a,NIL] + | evalIf _ _ = raise NotApplicable "if needs two or three arguments" + +and evalFn e [LIST (binds,_),body] = makeFn e binds body + | evalFn e [VECTOR (binds,_),body] = makeFn e binds body + | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" +and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) + +and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (LIST (args, NO_META))) + +and evalSymbol e s = valOrElse (lookup e s) + (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) + +and bindLet args e = bind' (eval e) args e +and bind args e = bind' identity args e +and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs), NO_META)) e; e) + | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST ([], NO_META)) e; e) + | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) + | bind' _ [] e = e + | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | SyntaxError msg => "SYNTAX ERROR: " ^ msg + | NotApplicable msg => "CANNOT APPLY: " ^ msg + | NotDefined msg => "NOT DEFINED: " ^ msg + +val replEnv = ENV (NS (ref [])) |> bind coreNs + +fun repl e = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => + let val s = rep e line + val _ = print(s ^ "\n") + in + repl e + end + | NONE => () + ) end + +val prelude = " \ +\(def! not (fn* (a) (if a false true)))" + +fun main () = ( + rep replEnv ("(do " ^ prelude ^ " nil)"); + repl replEnv +) diff --git a/impls/sml/step6_file.mlb b/impls/sml/step6_file.mlb new file mode 100644 index 0000000000..d8f6730653 --- /dev/null +++ b/impls/sml/step6_file.mlb @@ -0,0 +1,12 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + core.sml + step6_file.sml +in + main.sml +end diff --git a/impls/sml/step6_file.sml b/impls/sml/step6_file.sml new file mode 100644 index 0000000000..7268b35823 --- /dev/null +++ b/impls/sml/step6_file.sml @@ -0,0 +1,108 @@ +fun read s = + readStr s + +fun eval e ast = ( + case lookup e "DEBUG-EVAL" of + SOME(x) => if truthy x + then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") + else () + | NONE => (); + eval' e ast) + +and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval' e (SYMBOL s) = evalSymbol e s + | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval' e ast = ast + +and specialEval (SYMBOL "def!") = SOME evalDef + | specialEval (SYMBOL "let*") = SOME evalLet + | specialEval (SYMBOL "do") = SOME evalDo + | specialEval (SYMBOL "if") = SOME evalIf + | specialEval (SYMBOL "fn*") = SOME evalFn + | specialEval _ = NONE + +and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end + | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs + | evalDo _ _ = raise NotApplicable "do needs at least one argument" + +and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b + | evalIf e [c,a] = evalIf e [c,a,NIL] + | evalIf _ _ = raise NotApplicable "if needs two or three arguments" + +and evalFn e [LIST (binds,_),body] = makeFn e binds body + | evalFn e [VECTOR (binds,_),body] = makeFn e binds body + | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" +and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) + +and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (LIST (args, NO_META))) + +and evalSymbol e s = valOrElse (lookup e s) + (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) + +and bindLet args e = bind' (eval e) args e +and bind args e = bind' identity args e +and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs), NO_META)) e; e) + | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST ([], NO_META)) e; e) + | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) + | bind' _ [] e = e + | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | SyntaxError msg => "SYNTAX ERROR: " ^ msg + | NotApplicable msg => "CANNOT APPLY: " ^ msg + | NotDefined msg => "NOT DEFINED: " ^ msg + +val replEnv = ENV (NS (ref [])) |> bind coreNs + +fun repl e = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => + let val s = rep e line + val _ = print(s ^ "\n") + in + repl e + end + | NONE => () + ) end + +val prelude = " \ +\(def! not (fn* (a) (if a false true))) \ +\(def! \ +\ load-file \ +\ (fn* (f) \ +\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + +fun main () = ( + bind [ + SYMBOL "eval", + FN (fn ([x]) => eval replEnv x + | _ => raise NotApplicable "'eval' requires one argument", NO_META) + ] replEnv; + rep replEnv ("(do " ^ prelude ^ " nil)"); + case CommandLine.arguments () of + prog::args => ( + def "*ARGV*" (LIST (map STRING args, NO_META)) replEnv; + rep replEnv ("(load-file \"" ^ prog ^ "\")"); + () + ) + | args => ( + def "*ARGV*" (LIST (map STRING args, NO_META)) replEnv; + repl replEnv + ) +) diff --git a/impls/sml/step7_quote.mlb b/impls/sml/step7_quote.mlb new file mode 100644 index 0000000000..47a2f88cb3 --- /dev/null +++ b/impls/sml/step7_quote.mlb @@ -0,0 +1,12 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + core.sml + step7_quote.sml +in + main.sml +end diff --git a/impls/sml/step7_quote.sml b/impls/sml/step7_quote.sml new file mode 100644 index 0000000000..6356a45450 --- /dev/null +++ b/impls/sml/step7_quote.sml @@ -0,0 +1,125 @@ +fun read s = + readStr s + +fun eval e ast = ( + case lookup e "DEBUG-EVAL" of + SOME(x) => if truthy x + then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") + else () + | NONE => (); + eval' e ast) + +and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval' e (SYMBOL s) = evalSymbol e s + | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval' e ast = ast + +and specialEval (SYMBOL "def!") = SOME evalDef + | specialEval (SYMBOL "let*") = SOME evalLet + | specialEval (SYMBOL "do") = SOME evalDo + | specialEval (SYMBOL "if") = SOME evalIf + | specialEval (SYMBOL "fn*") = SOME evalFn + | specialEval (SYMBOL "quote") = SOME evalQuote + | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote + | specialEval _ = NONE + +and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end + | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs + | evalDo _ _ = raise NotApplicable "do needs at least one argument" + +and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b + | evalIf e [c,a] = evalIf e [c,a,NIL] + | evalIf _ _ = raise NotApplicable "if needs two or three arguments" + +and evalFn e [LIST (binds,_),body] = makeFn e binds body + | evalFn e [VECTOR (binds,_),body] = makeFn e binds body + | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" +and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) + +and evalQuote e [x] = x + | evalQuote _ _ = raise NotApplicable "quote needs one argument" + +and evalQuasiquote e args = eval e (expandQuasiquote args) + +and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x + | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) + | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] + | expandQuasiquote [m as MAP _] = malList ([SYMBOL "quote", m]) + | expandQuasiquote [s as SYMBOL _] = malList ([SYMBOL "quote", s]) + | expandQuasiquote [x] = x + | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" +and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] + | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] + +and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) + +and evalSymbol e s = valOrElse (lookup e s) + (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) + +and bindLet args e = bind' (eval e) args e +and bind args e = bind' identity args e +and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) + | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) + | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) + | bind' _ [] e = e + | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | SyntaxError msg => "SYNTAX ERROR: " ^ msg + | NotApplicable msg => "CANNOT APPLY: " ^ msg + | NotDefined msg => "NOT DEFINED: " ^ msg + +val replEnv = ENV (NS (ref [])) |> bind coreNs + +fun repl e = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => + let val s = rep e line + val _ = print(s ^ "\n") + in + repl e + end + | NONE => () + ) end + +val prelude = " \ +\(def! not (fn* (a) (if a false true))) \ +\(def! \ +\ load-file \ +\ (fn* (f) \ +\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" + +fun main () = ( + bind [ + SYMBOL "eval", + FN (fn ([x]) => eval replEnv x + | _ => raise NotApplicable "'eval' requires one argument", NO_META) + ] replEnv; + rep replEnv ("(do " ^ prelude ^ " nil)"); + case CommandLine.arguments () of + prog::args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + rep replEnv ("(load-file \"" ^ prog ^ "\")"); + () + ) + | args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + repl replEnv + ) +) diff --git a/impls/sml/step8_macros.mlb b/impls/sml/step8_macros.mlb new file mode 100644 index 0000000000..0c710ceeeb --- /dev/null +++ b/impls/sml/step8_macros.mlb @@ -0,0 +1,12 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + core.sml + step8_macros.sml +in + main.sml +end diff --git a/impls/sml/step8_macros.sml b/impls/sml/step8_macros.sml new file mode 100644 index 0000000000..69aac0443e --- /dev/null +++ b/impls/sml/step8_macros.sml @@ -0,0 +1,145 @@ +fun read s = + readStr s + +fun eval e ast = ( + case lookup e "DEBUG-EVAL" of + SOME(x) => if truthy x + then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") + else () + | NONE => (); + eval' e ast) + +and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval' e (SYMBOL s) = evalSymbol e s + | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval' e ast = ast + +and specialEval (SYMBOL "def!") = SOME evalDef + | specialEval (SYMBOL "let*") = SOME evalLet + | specialEval (SYMBOL "do") = SOME evalDo + | specialEval (SYMBOL "if") = SOME evalIf + | specialEval (SYMBOL "fn*") = SOME evalFn + | specialEval (SYMBOL "quote") = SOME evalQuote + | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote + | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro + | specialEval _ = NONE + +and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end + | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs + | evalDo _ _ = raise NotApplicable "do needs at least one argument" + +and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b + | evalIf e [c,a] = evalIf e [c,a,NIL] + | evalIf _ _ = raise NotApplicable "if needs two or three arguments" + +and evalFn e [LIST (binds,_),body] = makeFn e binds body + | evalFn e [VECTOR (binds,_),body] = makeFn e binds body + | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" +and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) + +and evalQuote e [x] = x + | evalQuote _ _ = raise NotApplicable "quote needs one argument" + +and evalQuasiquote e args = eval e (expandQuasiquote args) + +and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x + | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) + | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] + | expandQuasiquote [m as MAP _] = malList [SYMBOL "quote", m] + | expandQuasiquote [s as SYMBOL _] = malList [SYMBOL "quote", s] + | expandQuasiquote [x] = x + | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" +and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] + | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] + +and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) + | evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" +and defMacro e s (FN (f,_)) = let val m = MACRO f in (def s m e; m) end + | defMacro _ _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" + +and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply e (MACRO m) args = eval e (m args) + | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) + +and evalSymbol e s = valOrElse (lookup e s) + (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) + +and bindLet args e = bind' (eval e) args e +and bind args e = bind' identity args e +and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) + | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) + | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) + | bind' _ [] e = e + | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | SyntaxError msg => "SYNTAX ERROR: " ^ msg + | NotApplicable msg => "CANNOT APPLY: " ^ msg + | NotDefined msg => "NOT DEFINED: " ^ msg + | e => "ERROR: " ^ (exnMessage e) + +val replEnv = ENV (NS (ref [])) |> bind coreNs + +fun repl e = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => + let val s = rep e line + val _ = print(s ^ "\n") + in + repl e + end + | NONE => () + ) end + +val prelude = " \ +\\ +\(def! not (fn* (a) (if a false true))) \ +\\ +\(def! \ +\ load-file \ +\ (fn* (f) \ +\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))\ +\\ +\(defmacro! \ +\ cond \ +\ (fn* (& xs) \ +\ (if (> (count xs) 0) \ +\ (list 'if (first xs) \ +\ (if (> (count xs) 1) \ +\ (nth xs 1) \ +\ (throw \"odd number of forms to cond\")) \ +\ (cons 'cond (rest (rest xs)))))))" + +fun main () = ( + bind [ + SYMBOL "eval", + FN (fn ([x]) => eval replEnv x + | _ => raise NotApplicable "'eval' requires one argument", NO_META) + ] replEnv; + rep replEnv ("(do " ^ prelude ^ " nil)"); + case CommandLine.arguments () of + prog::args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + rep replEnv ("(load-file \"" ^ prog ^ "\")"); + () + ) + | args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + repl replEnv + ) +) diff --git a/impls/sml/step9_try.mlb b/impls/sml/step9_try.mlb new file mode 100644 index 0000000000..a206b25d48 --- /dev/null +++ b/impls/sml/step9_try.mlb @@ -0,0 +1,12 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + core.sml + step9_try.sml +in + main.sml +end diff --git a/impls/sml/step9_try.sml b/impls/sml/step9_try.sml new file mode 100644 index 0000000000..afbe45ee71 --- /dev/null +++ b/impls/sml/step9_try.sml @@ -0,0 +1,159 @@ +fun read s = + readStr s + +fun eval e ast = ( + case lookup e "DEBUG-EVAL" of + SOME(x) => if truthy x + then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") + else () + | NONE => (); + eval' e ast) + +and eval' e (LIST (a::args, _)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval' e (SYMBOL s) = evalSymbol e s + | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval' e ast = ast + +and specialEval (SYMBOL "def!") = SOME evalDef + | specialEval (SYMBOL "let*") = SOME evalLet + | specialEval (SYMBOL "do") = SOME evalDo + | specialEval (SYMBOL "if") = SOME evalIf + | specialEval (SYMBOL "fn*") = SOME evalFn + | specialEval (SYMBOL "quote") = SOME evalQuote + | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote + | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro + | specialEval (SYMBOL "try*") = SOME evalTry + | specialEval _ = NONE + +and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end + | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs + | evalDo _ _ = raise NotApplicable "do needs at least one argument" + +and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b + | evalIf e [c,a] = evalIf e [c,a,NIL] + | evalIf _ _ = raise NotApplicable "if needs two or three arguments" + +and evalFn e [(LIST (binds,_)),body] = makeFn e binds body + | evalFn e [(VECTOR (binds,_)),body] = makeFn e binds body + | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" +and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) + +and evalQuote e [x] = x + | evalQuote _ _ = raise NotApplicable "quote needs one argument" + +and evalQuasiquote e args = eval e (expandQuasiquote args) + +and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x + | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) + | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] + | expandQuasiquote [m as MAP _] = malList [SYMBOL "quote", m] + | expandQuasiquote [s as SYMBOL _] = malList [SYMBOL "quote", s] + | expandQuasiquote [x] = x + | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" +and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] + | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] + +and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) + | evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" +and defMacro e s (FN (f,_)) = let val m = MACRO f in (def s m e; m) end + | defMacro _ _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" + +and evalTry e [a, LIST ([SYMBOL "catch*", b, c],_)] = (eval e a handle ex => evalCatch (inside e) b ex c) + | evalTry e [a] = eval e a + | evalTry _ _ = raise NotApplicable "try* needs a form to evaluate" +and evalCatch e b ex body = eval (bind [b, exnVal ex] e) body + +and exnVal (MalException x) = x + | exnVal (SyntaxError msg) = STRING msg + | exnVal (NotDefined msg) = STRING msg + | exnVal (NotApplicable msg) = STRING msg + | exnVal (OutOfBounds msg) = STRING msg + | exnVal exn = STRING (exnMessage exn) + +and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply e (MACRO m) args = eval e (m args) + | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) + +and evalSymbol e s = valOrElse (lookup e s) + (fn _ => raise NotDefined ("'" ^ s ^ "' not found")) + +and bindLet args e = bind' (eval e) args e +and bind args e = bind' identity args e +and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) + | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) + | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) + | bind' _ [] e = e + | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | SyntaxError msg => "SYNTAX ERROR: " ^ msg + | NotApplicable msg => "CANNOT APPLY: " ^ msg + | NotDefined msg => "NOT DEFINED: " ^ msg + | MalException e => "ERROR: " ^ (prStr e) + | e => "ERROR: " ^ (exnMessage e) + +val replEnv = ENV (NS (ref [])) |> bind coreNs + +fun repl e = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => + let val s = rep e line + val _ = print(s ^ "\n") + in + repl e + end + | NONE => () + ) end + +val prelude = " \ +\\ +\(def! not (fn* (a) (if a false true))) \ +\\ +\(def! \ +\ load-file \ +\ (fn* (f) \ +\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))\ +\\ +\(defmacro! \ +\ cond \ +\ (fn* (& xs) \ +\ (if (> (count xs) 0) \ +\ (list 'if (first xs) \ +\ (if (> (count xs) 1) \ +\ (nth xs 1) \ +\ (throw \"odd number of forms to cond\")) \ +\ (cons 'cond (rest (rest xs)))))))" + +fun main () = ( + bind [ + SYMBOL "eval", + FN (fn ([x]) => eval replEnv x + | _ => raise NotApplicable "'eval' requires one argument", NO_META) + ] replEnv; + rep replEnv ("(do " ^ prelude ^ " nil)"); + case CommandLine.arguments () of + prog::args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + rep replEnv ("(load-file \"" ^ prog ^ "\")"); + () + ) + | args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + repl replEnv + ) +) diff --git a/impls/sml/stepA_mal.mlb b/impls/sml/stepA_mal.mlb new file mode 100644 index 0000000000..5bf38f95e2 --- /dev/null +++ b/impls/sml/stepA_mal.mlb @@ -0,0 +1,12 @@ +local + $(SML_LIB)/basis/basis.mlb + util.sml + types.sml + printer.sml + reader.sml + env.sml + core.sml + stepA_mal.sml +in + main.sml +end diff --git a/impls/sml/stepA_mal.sml b/impls/sml/stepA_mal.sml new file mode 100644 index 0000000000..497e771428 --- /dev/null +++ b/impls/sml/stepA_mal.sml @@ -0,0 +1,161 @@ +fun read s = + readStr s + +fun eval e ast = ( + case lookup e "DEBUG-EVAL" of + SOME(x) => if truthy x + then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") + else () + | NONE => (); + eval' e ast) + +and eval' e (LIST (a::args, _)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval' e (SYMBOL s) = evalSymbol e s + | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval' e ast = ast + +and specialEval (SYMBOL "def!") = SOME evalDef + | specialEval (SYMBOL "let*") = SOME evalLet + | specialEval (SYMBOL "do") = SOME evalDo + | specialEval (SYMBOL "if") = SOME evalIf + | specialEval (SYMBOL "fn*") = SOME evalFn + | specialEval (SYMBOL "quote") = SOME evalQuote + | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote + | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro + | specialEval (SYMBOL "try*") = SOME evalTry + | specialEval _ = NONE + +and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end + | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast + | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs + | evalDo _ _ = raise NotApplicable "do needs at least one argument" + +and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b + | evalIf e [c,a] = evalIf e [c,a,NIL] + | evalIf _ _ = raise NotApplicable "if needs two or three arguments" + +and evalFn e [(LIST (binds,_)),body] = makeFn e binds body + | evalFn e [(VECTOR (binds,_)),body] = makeFn e binds body + | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" +and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) + +and evalQuote e [x] = x + | evalQuote _ _ = raise NotApplicable "quote needs one argument" + +and evalQuasiquote e args = eval e (expandQuasiquote args) + +and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x + | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) + | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] + | expandQuasiquote [m as MAP _] = malList [SYMBOL "quote", m] + | expandQuasiquote [s as SYMBOL _] = malList [SYMBOL "quote", s] + | expandQuasiquote [x] = x + | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" +and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] + | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] + +and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) + | evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" +and defMacro e s (FN (f,_)) = let val m = MACRO f in (def s m e; m) end + | defMacro _ _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" + +and evalTry e [a, LIST ([SYMBOL "catch*", b, c],_)] = (eval e a handle ex => evalCatch (inside e) b ex c) + | evalTry e [a] = eval e a + | evalTry _ _ = raise NotApplicable "try* needs a form to evaluate" +and evalCatch e b ex body = eval (bind [b, exnVal ex] e) body + +and exnVal (MalException x) = x + | exnVal (SyntaxError msg) = STRING msg + | exnVal (NotDefined msg) = STRING msg + | exnVal (NotApplicable msg) = STRING msg + | exnVal (OutOfBounds msg) = STRING msg + | exnVal exn = STRING (exnMessage exn) + +and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply e (MACRO m) args = eval e (m args) + | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) + +and evalSymbol e s = valOrElse (lookup e s) + (fn _ => raise NotDefined ("'" ^ s ^ "' not found")) + +and bindLet args e = bind' (eval e) args e +and bind args e = bind' identity args e +and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) + | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) + | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) + | bind' _ [] e = e + | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" + +fun print f = + prReadableStr f + +fun rep e s = + s |> read |> eval e |> print + handle Nothing => "" + | SyntaxError msg => "SYNTAX ERROR: " ^ msg + | NotApplicable msg => "CANNOT APPLY: " ^ msg + | NotDefined msg => "NOT DEFINED: " ^ msg + | MalException e => "ERROR: " ^ (prStr e) + | e => "ERROR: " ^ (exnMessage e) + +val replEnv = ENV (NS (ref [])) |> bind coreNs + +fun repl e = + let open TextIO + in ( + print("user> "); + case inputLine(stdIn) of + SOME(line) => + let val s = rep e line + val _ = print(s ^ "\n") + in + repl e + end + | NONE => () + ) end + +val prelude = " \ +\\ +\(def! not (fn* (a) (if a false true))) \ +\\ +\(def! \ +\ load-file \ +\ (fn* (f) \ +\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))\ +\\ +\(defmacro! \ +\ cond \ +\ (fn* (& xs) \ +\ (if (> (count xs) 0) \ +\ (list 'if (first xs) \ +\ (if (> (count xs) 1) \ +\ (nth xs 1) \ +\ (throw \"odd number of forms to cond\")) \ +\ (cons 'cond (rest (rest xs)))))))" + +fun main () = ( + def "*host-language*" (STRING "sml") replEnv; + bind [ + SYMBOL "eval", + FN (fn ([x]) => eval replEnv x + | _ => raise NotApplicable "'eval' requires one argument", NO_META) + ] replEnv; + rep replEnv ("(do " ^ prelude ^ " nil)"); + case CommandLine.arguments () of + prog::args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + rep replEnv ("(load-file \"" ^ prog ^ "\")"); + () + ) + | args => ( + def "*ARGV*" (malList (map STRING args)) replEnv; + rep replEnv "(println (str \"Mal [\" *host-language* \"]\"))"; + repl replEnv + ) +) diff --git a/impls/sml/types.sml b/impls/sml/types.sml new file mode 100644 index 0000000000..fadc3217b3 --- /dev/null +++ b/impls/sml/types.sml @@ -0,0 +1,48 @@ +datatype mal_type = NIL + | SYMBOL of string + | BOOL of bool + | INT of LargeInt.int + | STRING of string + | KEYWORD of string + | LIST of (mal_type list * mal_meta) + | VECTOR of (mal_type list * mal_meta) + | MAP of ((mal_type * mal_type) list * mal_meta) + | ATOM of mal_type ref + | FN of (mal_type list -> mal_type) * mal_meta + | MACRO of mal_type list -> mal_type + +and mal_meta = META of mal_type + | NO_META + +and mal_ns = NS of (string * mal_type) list ref + +and mal_env = ENV of mal_ns + | INNER of mal_ns * mal_env + +fun truthy (BOOL false) = false + | truthy NIL = false + | truthy _ = true + +fun malEq ( NIL, NIL) = true + | malEq ( SYMBOL a, SYMBOL b) = a = b + | malEq ( BOOL a, BOOL b) = a = b + | malEq ( INT a, INT b) = a = b + | malEq ( STRING a, STRING b) = a = b + | malEq ( KEYWORD a, KEYWORD b) = a = b + | malEq ( LIST (a,_), LIST (b,_)) = ListPair.allEq malEq (a, b) + | malEq (VECTOR (a,_), VECTOR (b,_)) = ListPair.allEq malEq (a, b) + | malEq ( LIST (a,_), VECTOR (b,_)) = ListPair.allEq malEq (a, b) + | malEq (VECTOR (a,_), LIST (b,_)) = ListPair.allEq malEq (a, b) + | malEq ( MAP (a,_), MAP (b,_)) = mapEq a b + | malEq _ = false +and mapEq a b = + a |> List.map (fn (k,va) => (va, malGet b k)) |> List.all (fn (va,SOME vb) => malEq (va, vb) | _ => false) andalso + b |> List.map (fn (k,vb) => (vb, malGet a k)) |> List.all (fn (vb,SOME va) => malEq (vb, va) | _ => false) + +and malGet m k = m |> List.find (fn (k',_) => malEq (k, k')) |> Option.map #2 +and malAssoc m k v = (k, v) :: (malDissoc m k) +and malDissoc m k = m |> List.filter (not o (fn (k', _) => malEq (k, k'))) + +fun malList xs = LIST (xs, NO_META) +fun malVector xs = VECTOR (xs, NO_META) +fun malMap kvps = MAP (kvps, NO_META) diff --git a/impls/sml/util.sml b/impls/sml/util.sml new file mode 100644 index 0000000000..b410fe07f4 --- /dev/null +++ b/impls/sml/util.sml @@ -0,0 +1,42 @@ +fun takeWhile f xs = takeWhile' f [] xs +and takeWhile' f acc [] = rev acc + | takeWhile' f acc (x::xs) = if f x then takeWhile' f (x::acc) xs else rev acc + +infix 3 |> fun x |> f = f x + +fun eq a b = a = b + +fun optOrElse NONE b = b () + | optOrElse a _ = a + +fun valOrElse (SOME x) _ = x + | valOrElse a b = b () + +fun optIfNone b NONE = b () + | optIfNone _ a = a + +fun valIfNone _ (SOME a) = a + | valIfNone b _ = b () + +fun interleave (x::xs) (y::ys) = x :: y :: interleave xs ys + | interleave [] ys = ys + | interleave xs [] = xs + +fun identity x = x + +fun triml k s = String.extract (s, k, NONE) + +fun trimr k s = String.substring (s, 0, String.size s - k) + +fun malEscape s = String.translate (fn #"\"" => "\\\"" + | #"\n" => "\\n" + | #"\\" => "\\\\" + | c => String.str c) s + +fun malUnescape s = malUnescape' (String.explode s) +and malUnescape' (#"\\"::(#"\""::rest)) = "\"" ^ malUnescape' rest + | malUnescape' (#"\\"::(#"n" ::rest)) = "\n" ^ malUnescape' rest + | malUnescape' (#"\\"::(#"\\"::rest)) = "\\" ^ malUnescape' rest + | malUnescape' (c::rest) = (String.str c) ^ malUnescape' rest + | malUnescape' ([]) = "" + diff --git a/impls/swift3/Dockerfile b/impls/swift3/Dockerfile new file mode 100644 index 0000000000..0fd5d0992f --- /dev/null +++ b/impls/swift3/Dockerfile @@ -0,0 +1,44 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Swift +RUN apt-get -y install clang-3.6 cmake pkg-config \ + git ninja-build uuid-dev libicu-dev icu-devtools \ + libbsd-dev libedit-dev libxml2-dev libsqlite3-dev \ + swig libpython-dev libncurses5-dev + +# TODO: better way to do this? +RUN ln -sf /usr/lib/llvm-3.6/bin/clang++ /usr/bin/clang++ +RUN ln -sf /usr/lib/llvm-3.6/bin/clang /usr/bin/clang + +ENV SWIFT_PREFIX swift-3.1.1-RELEASE +ENV SWIFT_RELEASE ${SWIFT_PREFIX}-ubuntu16.04 + +RUN cd /opt && \ + curl -O https://download.swift.org/swift-3.1.1-release/ubuntu1604/${SWIFT_PREFIX}/${SWIFT_RELEASE}.tar.gz && \ + tar xvzf ${SWIFT_RELEASE}.tar.gz && \ + rm ${SWIFT_RELEASE}.tar.gz + +ENV PATH /opt/${SWIFT_RELEASE}/usr/bin/:$PATH + + diff --git a/impls/swift3/Makefile b/impls/swift3/Makefile new file mode 100644 index 0000000000..a76309c52c --- /dev/null +++ b/impls/swift3/Makefile @@ -0,0 +1,29 @@ +ifneq ($(shell which xcrun),) + SWIFT = xcrun -sdk macosx swiftc +else + SWIFT = swiftc +endif + +STEP3_DEPS = Sources/types.swift Sources/reader.swift Sources/printer.swift Sources/env.swift +STEP4_DEPS = $(STEP3_DEPS) Sources/core.swift + +STEPS = step0_repl step1_read_print step2_eval step3_env \ + step4_if_fn_do step5_tco step6_file step7_quote \ + step8_macros step9_try stepA_mal + +all: $(STEPS) + +dist: mal + +mal: stepA_mal + cp $< $@ + +step1_read_print step2_eval step3_env: $(STEP3_DEPS) +step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) + +step%: Sources/step%/main.swift + $(SWIFT) $+ -o $@ + +clean: + rm -f $(STEPS) mal + diff --git a/impls/swift3/Sources/core.swift b/impls/swift3/Sources/core.swift new file mode 100644 index 0000000000..be44f35c4f --- /dev/null +++ b/impls/swift3/Sources/core.swift @@ -0,0 +1,467 @@ +// TODO: remove this once time-ms and slurp use standard library calls + +#if os(Linux) +import Glibc +#else +import Darwin +#endif + +func IntOp(_ op: (Int, Int) -> Int, _ a: MalVal, _ b: MalVal) throws -> MalVal { + switch (a, b) { + case (MV.MalInt(let i1), MV.MalInt(let i2)): + return MV.MalInt(op(i1, i2)) + default: + throw MalError.General(msg: "Invalid IntOp call") + } +} + +func CmpOp(_ op: (Int, Int) -> Bool, _ a: MalVal, _ b: MalVal) throws -> MalVal { + switch (a, b) { + case (MV.MalInt(let i1), MV.MalInt(let i2)): + return wraptf(op(i1, i2)) + default: + throw MalError.General(msg: "Invalid CmpOp call") + } +} + + + +let core_ns: Dictionary) throws -> MalVal> = [ + "=": { wraptf(equal_Q($0[0], $0[1])) }, + "throw": { throw MalError.MalException(obj: $0[0]) }, + + "nil?": { + switch $0[0] { + case MV.MalNil(_): return MV.MalTrue + default: return MV.MalFalse + } + }, + "true?": { + switch $0[0] { + case MV.MalTrue(_): return MV.MalTrue + default: return MV.MalFalse + } + }, + "false?": { + switch $0[0] { + case MV.MalFalse(_): return MV.MalTrue + default: return MV.MalFalse + } + }, + "string?": { + switch $0[0] { + case MV.MalString(let s) where s.characters.count == 0: + return MV.MalTrue + case MV.MalString(let s): + return wraptf(s[s.startIndex] != "\u{029e}") + default: return MV.MalFalse + } + }, + "symbol": { + switch $0[0] { + case MV.MalSymbol(_): return $0[0] + case MV.MalString(let s): return MV.MalSymbol(s) + default: throw MalError.General(msg: "Invalid symbol call") + } + }, + "symbol?": { + switch $0[0] { + case MV.MalSymbol(_): return MV.MalTrue + default: return MV.MalFalse + } + }, + "keyword": { + switch $0[0] { + case MV.MalString(let s) where s.characters.count > 0: + if s[s.startIndex] == "\u{029e}" { return $0[0] } + else { return MV.MalString("\u{029e}\(s)") } + default: throw MalError.General(msg: "Invalid symbol call") + } + }, + "keyword?": { + switch $0[0] { + case MV.MalString(let s) where s.characters.count > 0: + return wraptf(s[s.startIndex] == "\u{029e}") + default: return MV.MalFalse + } + }, + "number?": { + switch $0[0] { + case MV.MalInt(_): return MV.MalTrue + default: return MV.MalFalse + } + }, + "fn?": { + switch $0[0] { + case MalVal.MalFunc(_, nil, _, _, _, _), + MalVal.MalFunc(_, _, _, _, false, _): return MV.MalTrue + default: return MV.MalFalse + } + }, + "macro?": { + switch $0[0] { + case MalVal.MalFunc(_, _, _, _, true, _): return MV.MalTrue + default: return MV.MalFalse + } + }, + + "pr-str": { + // TODO: if the following two statements are combined into one, we get + // the following error message. It's not clear to me that there's + // actually any error, so this might be a compiler issue. + // + // Sources/core.swift:29:59: error: type of expression is ambiguous without more context + // let core_ns: [String: (Array) throws -> MalVal] = [ + // ^ + + let s = $0.map { pr_str($0,true) }.joined(separator: " ") + return MV.MalString(s) + }, + "str": { + // The comment for "pr-str" applies here, too. + let s = $0.map { pr_str($0,false) }.joined(separator: "") + return MV.MalString(s) + }, + "prn": { + print($0.map { pr_str($0,true) }.joined(separator: " ")) + return MV.MalNil + }, + "println": { + print($0.map { pr_str($0,false) }.joined(separator: " ")) + return MV.MalNil + }, + "read-string": { + switch $0[0] { + case MV.MalString(let str): return try read_str(str) + default: throw MalError.General(msg: "Invalid read-string call") + } + }, + "readline": { + switch $0[0] { + case MV.MalString(let prompt): + print(prompt, terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { return MV.MalNil } + return MV.MalString(line!) + default: throw MalError.General(msg: "Invalid readline call") + } + }, + "slurp": { + switch $0[0] { + case MV.MalString(let file): + let data = try String(contentsOfFile: file, encoding: String.Encoding.utf8) + return MV.MalString(data) + default: throw MalError.General(msg: "Invalid slurp call") + } + }, + + + "<": { try CmpOp({ $0 < $1}, $0[0], $0[1]) }, + "<=": { try CmpOp({ $0 <= $1}, $0[0], $0[1]) }, + ">": { try CmpOp({ $0 > $1}, $0[0], $0[1]) }, + ">=": { try CmpOp({ $0 >= $1}, $0[0], $0[1]) }, + "+": { try IntOp({ $0 + $1}, $0[0], $0[1]) }, + "-": { try IntOp({ $0 - $1}, $0[0], $0[1]) }, + "*": { try IntOp({ $0 * $1}, $0[0], $0[1]) }, + "/": { try IntOp({ $0 / $1}, $0[0], $0[1]) }, + "time-ms": { + let read = $0; // no parameters + + // TODO: replace with something more like this + // return MV.MalInt(NSDate().timeIntervalSince1970 ) + + var tv:timeval = timeval(tv_sec: 0, tv_usec: 0) + gettimeofday(&tv, nil) + return MV.MalInt(tv.tv_sec * 1000 + Int(tv.tv_usec)/1000) + }, + + "list": { list($0) }, + "list?": { + switch $0[0] { + case MV.MalList: return MV.MalTrue + default: return MV.MalFalse + } + }, + "vector": { vector($0) }, + "vector?": { + switch $0[0] { + case MV.MalVector: return MV.MalTrue + default: return MV.MalFalse + } + }, + "hash-map": { try hash_map($0) }, + "map?": { + switch $0[0] { + case MV.MalHashMap: return MV.MalTrue + default: return MV.MalFalse + } + }, + "assoc": { + switch $0[0] { + case MV.MalHashMap(let dict, _): + return hash_map(try _assoc(dict, Array($0[1..<$0.endIndex]))) + default: throw MalError.General(msg: "Invalid assoc call") + } + }, + "dissoc": { + switch $0[0] { + case MV.MalHashMap(let dict, _): + return hash_map(try _dissoc(dict, Array($0[1..<$0.endIndex]))) + default: throw MalError.General(msg: "Invalid dissoc call") + } + }, + "get": { + switch ($0[0], $0[1]) { + case (MV.MalHashMap(let dict, _), MV.MalString(let k)): + return dict[k] ?? MV.MalNil + case (MV.MalNil, MV.MalString(let k)): + return MV.MalNil + default: throw MalError.General(msg: "Invalid get call") + } + }, + "contains?": { + switch ($0[0], $0[1]) { + case (MV.MalHashMap(let dict, _), MV.MalString(let k)): + return dict[k] != nil ? MV.MalTrue : MV.MalFalse + case (MV.MalNil, MV.MalString(let k)): + return MV.MalFalse + default: throw MalError.General(msg: "Invalid contains? call") + } + }, + "keys": { + switch $0[0] { + case MV.MalHashMap(let dict, _): + return list(dict.keys.map { MV.MalString($0) }) + default: throw MalError.General(msg: "Invalid keys call") + } + }, + "vals": { + switch $0[0] { + case MV.MalHashMap(let dict, _): + return list(dict.values.map { $0 }) + default: throw MalError.General(msg: "Invalid vals call") + } + }, + + + "sequential?": { + switch $0[0] { + case MV.MalList: return MV.MalTrue + case MV.MalVector: return MV.MalTrue + default: return MV.MalFalse + } + }, + "cons": { + if $0.count != 2 { throw MalError.General(msg: "Invalid cons call") } + switch ($0[0], $0[1]) { + case (let mv, MV.MalList(let lst, _)): + return list([mv] + lst) + case (let mv, MV.MalVector(let lst, _)): + return list([mv] + lst) + default: throw MalError.General(msg: "Invalid cons call") + } + }, + "concat": { + var res = Array() + for seq in $0 { + switch seq { + case MV.MalList(let lst, _): res = res + lst + case MV.MalVector(let lst, _): res = res + lst + default: throw MalError.General(msg: "Invalid concat call") + } + } + return list(res) + }, + "vec": { + if $0.count != 1 { throw MalError.General(msg: "Invalid vec call") } + switch $0[0] { + case MV.MalList (let lst, _): return vector(lst) + case MV.MalVector(let lst, _): return vector(lst) + default: throw MalError.General(msg: "Invalid vec call") + } + }, + "nth": { + if $0.count != 2 { throw MalError.General(msg: "Invalid nth call") } + switch ($0[0], $0[1]) { + case (MV.MalList(let lst, _), MV.MalInt(let idx)): + if idx >= lst.count { + throw MalError.General(msg: "nth: index out of range") + } + return try _nth($0[0], idx) + case (MV.MalVector(let lst, _), MV.MalInt(let idx)): + if idx >= lst.count { + throw MalError.General(msg: "nth: index out of range") + } + return try _nth($0[0], idx) + default: + throw MalError.General(msg: "Invalid nth call") + } + }, + "first": { + switch $0[0] { + case MV.MalList(let lst, _): + return lst.count > 0 ? lst[0] : MV.MalNil + case MV.MalVector(let lst, _): + return lst.count > 0 ? lst[0] : MV.MalNil + case MV.MalNil: return MV.MalNil + default: throw MalError.General(msg: "Invalid first call") + } + }, + "rest": { + switch $0[0] { + case MV.MalList(let lst, _): + return lst.count > 0 ? try rest($0[0]) : list([]) + case MV.MalVector(let lst, _): + return lst.count > 0 ? try rest($0[0]) : list([]) + case MV.MalNil: return list([]) + default: throw MalError.General(msg: "Invalid rest call") + } + }, + "empty?": { + switch $0[0] { + case MV.MalList(let lst, _): + return lst.count == 0 ? MV.MalTrue : MV.MalFalse + case MV.MalVector(let lst, _): + return lst.count == 0 ? MV.MalTrue : MV.MalFalse + case MV.MalNil: return MV.MalTrue + default: throw MalError.General(msg: "Invalid empty? call") + } + }, + "count": { + switch $0[0] { + case MV.MalList(let lst, _): return MV.MalInt(lst.count) + case MV.MalVector(let lst, _): return MV.MalInt(lst.count) + case MV.MalNil: return MV.MalInt(0) + default: throw MalError.General(msg: "Invalid count call") + } + }, + "apply": { + let fn: (Array) throws -> MalVal + switch $0[0] { + case MV.MalFunc(let f, _, _, _, _, _): fn = f + default: throw MalError.General(msg: "Invalid apply call") + } + + var args = Array($0[1..<$0.endIndex-1]) + switch $0[$0.endIndex-1] { + case MV.MalList(let l, _): args = args + l + case MV.MalVector(let l, _): args = args + l + default: throw MalError.General(msg: "Invalid apply call") + } + + return try fn(args) + }, + "map": { + let fn: (Array) throws -> MalVal + switch $0[0] { + case MV.MalFunc(let f, _, _, _, _, _): fn = f + default: throw MalError.General(msg: "Invalid map call") + } + + var lst = Array() + switch $0[1] { + case MV.MalList(let l, _): lst = l + case MV.MalVector(let l, _): lst = l + default: throw MalError.General(msg: "Invalid map call") + } + + var res = Array() + for mv in lst { + res.append(try fn([mv])) + } + return list(res) + }, + + "conj": { + if $0.count < 1 { throw MalError.General(msg: "Invalid conj call") } + switch $0[0] { + case MV.MalList(let lst, _): + let a = Array($0[1..<$0.endIndex]).reversed() + return list(a + lst) + case MV.MalVector(let lst, _): + return vector(lst + $0[1..<$0.endIndex]) + default: throw MalError.General(msg: "Invalid conj call") + } + }, + "seq": { + if $0.count < 1 { throw MalError.General(msg: "Invalid seq call") } + switch $0[0] { + case MV.MalList(let lst, _): + if lst.count == 0 { return MV.MalNil } + return $0[0] + case MV.MalVector(let lst, _): + if lst.count == 0 { return MV.MalNil } + return list(lst) + case MV.MalString(let str): + if str.characters.count == 0 { return MV.MalNil } + return list(str.characters.map { MV.MalString(String($0)) }) + case MV.MalNil: + return MV.MalNil + default: throw MalError.General(msg: "Invalid seq call") + } + }, + + "meta": { + switch $0[0] { + case MV.MalList(_, let m): + return m != nil ? m![0] : MV.MalNil + case MV.MalVector(_, let m): + return m != nil ? m![0] : MV.MalNil + case MV.MalHashMap(_, let m): + return m != nil ? m![0] : MV.MalNil + case MV.MalFunc(_, _, _, _, _, let m): + return m != nil ? m![0] : MV.MalNil + default: throw MalError.General(msg: "meta called on non-function") + } + }, + "with-meta": { + switch $0[0] { + case MV.MalList(let l, _): + return list(l, meta: $0[1]) + case MV.MalVector(let l, _): + return vector(l, meta: $0[1]) + case MV.MalHashMap(let d, _): + return hash_map(d, meta: $0[1]) + case MV.MalFunc(let f, let a, let e, let p, let m, _): + return malfunc(f, ast:a, env:e, params:p, macro:m, meta:$0[1]) + //return MV.MalFunc(f,ast:a,env:e,params:p,macro:m,meta:[$0[1]]) + default: + throw MalError.General(msg: "with-meta called on non-collection") + } + }, + "atom": { + return MV.MalAtom(MutableAtom(val: $0[0])) + }, + "atom?": { + switch $0[0] { + case MV.MalAtom(_): return MV.MalTrue + default: return MV.MalFalse + } + }, + "deref": { + switch $0[0] { + case MV.MalAtom(let ma): return ma.val + default: throw MalError.General(msg: "Invalid deref call") + } + }, + "reset!": { + switch $0[0] { + case MV.MalAtom(var a): + a.val = $0[1] + return $0[1] + default: throw MalError.General(msg: "Invalid reset! call") + } + }, + "swap!": { + switch ($0[0], $0[1]) { + case (MV.MalAtom(var a), MV.MalFunc(let fn, _, _, _, _, _)): + var args = [a.val] + if $0.count > 2 { + args = args + Array($0[2..<$0.endIndex]) + } + a.val = try fn(args) + return a.val + default: throw MalError.General(msg: "Invalid swap! call") + } + }, +] diff --git a/impls/swift3/Sources/env.swift b/impls/swift3/Sources/env.swift new file mode 100644 index 0000000000..2f09af5975 --- /dev/null +++ b/impls/swift3/Sources/env.swift @@ -0,0 +1,65 @@ +class Env { + var outer: Env? = nil + var data: Dictionary = [:] + + init(_ outer: Env? = nil, binds: MalVal? = nil, + exprs: MalVal? = nil) throws { + self.outer = outer + + if binds != nil { + var bs = Array(), es = Array() + //print("binds: \(binds), exprs: \(exprs)") + switch (binds!, exprs!) { + case (MalVal.MalList(let l1, _), MalVal.MalList(let l2, _)): + bs = l1; es = l2 + case (MalVal.MalVector(let l1, _), MalVal.MalList(let l2, _)): + bs = l1; es = l2 + default: + throw MalError.General(msg: "invalid Env init call") + } + + var pos = bs.startIndex + + bhandle: + while pos < bs.endIndex { + let b = bs[pos] + switch b { + case MalVal.MalSymbol("&"): + switch bs[bs.index(after: pos)] { + case MalVal.MalSymbol(let sym): + if pos < es.endIndex { + let slc = es[pos.. MalVal? { + return data[str] ?? outer?.get(str) + } + + @discardableResult + func set(_ key: MalVal, _ val: MalVal) throws -> MalVal { + switch key { + case MalVal.MalSymbol(let str): + data[str] = val + return val + default: + throw MalError.General(msg: "invalid Env.find call") + } + } +} diff --git a/impls/swift3/Sources/printer.swift b/impls/swift3/Sources/printer.swift new file mode 100644 index 0000000000..b4ec36a1d9 --- /dev/null +++ b/impls/swift3/Sources/printer.swift @@ -0,0 +1,43 @@ + +func pr_str(_ obj: MalVal, _ print_readably: Bool = true) -> String { + switch obj { + case MalVal.MalList(let lst, _): + let elems = lst.map { pr_str($0, print_readably) } + return "(" + elems.joined(separator: " ") + ")" + case MalVal.MalVector(let lst, _): + let elems = lst.map { pr_str($0, print_readably) } + return "[" + elems.joined(separator: " ") + "]" + case MalVal.MalHashMap(let dict, _): + let elems = dict.map { + pr_str(MalVal.MalString($0), print_readably) + + " " + pr_str($1, print_readably) + } + return "{" + elems.joined(separator: " ") + "}" + case MalVal.MalString(let str): + //print("kw: '\(str[str.startIndex])'") + if str.characters.count > 0 && str[str.startIndex] == "\u{029e}" { + return ":" + str[str.index(after: str.startIndex).." + case MalVal.MalFunc(_, let ast, _, let params, _, _): + return "(fn* \(pr_str(params![0])) \(pr_str(ast![0])))" + case MalVal.MalAtom(let ma): + return "(atom \(pr_str(ma.val, print_readably)))" + default: + return String(describing:obj) + } +} diff --git a/impls/swift3/Sources/reader.swift b/impls/swift3/Sources/reader.swift new file mode 100644 index 0000000000..cbb51d17ce --- /dev/null +++ b/impls/swift3/Sources/reader.swift @@ -0,0 +1,207 @@ +let token_delim: Set = [ + ";", ",", "\"", "`", " ", "\n", "{", "}", "(", ")", "[", "]" +] + +let int_char: Set = [ + "-", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" +] + +let float_char: Set = [ + ".", "-", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" +] + +let whitespace: Set = [" ", "\t", "\n", ","] + +class Reader { + var str: String + var pos: String.Index + init(_ str: String) { + self.str = str + pos = str.startIndex + } + func next() { pos = str.index(after: pos) } +} + +func read_int(_ rdr: Reader) -> MalVal { + let start = rdr.pos + var cidx = rdr.pos + while cidx < rdr.str.endIndex { + if !int_char.contains(rdr.str[cidx]) { break } + cidx = rdr.str.index(after: cidx) + rdr.pos = cidx + } + let matchStr = rdr.str.substring(with: start.. MalVal { + let start = rdr.pos + var escaped = false + if rdr.str[rdr.pos] != "\"" { + throw MalError.Reader(msg: "read_string call on non-string") + } + var cidx = rdr.str.index(after: rdr.pos) + while cidx < rdr.str.endIndex { + rdr.pos = rdr.str.index(after: cidx) + if escaped { + escaped = false + cidx = rdr.pos + continue + } + if rdr.str[cidx] == "\\" { escaped = true } + if rdr.str[cidx] == "\"" { break } + cidx = rdr.pos + } + if cidx >= rdr.str.endIndex || rdr.str[rdr.str.index(before: rdr.pos)] != "\"" { + throw MalError.Reader(msg: "Expected '\"', got EOF") + } + let matchStr = rdr.str.substring(with: + rdr.str.index(after: start).. String { + let start = rdr.pos + var cidx = rdr.pos + while cidx < rdr.str.endIndex { + rdr.pos = cidx + if token_delim.contains(rdr.str[cidx]) { break } + cidx = rdr.str.index(after: cidx) + rdr.pos = cidx + } + return rdr.str.substring(with: start.. MalVal { + let tok = read_token(rdr) + switch tok { + case "nil": return MalVal.MalNil + case "true": return MalVal.MalTrue + case "false": return MalVal.MalFalse + default: return MalVal.MalSymbol(tok) + } +} + +func read_atom(_ rdr: Reader) throws -> MalVal { + if rdr.str.characters.count == 0 { + throw MalError.Reader(msg: "Empty string passed to read_atom") + } + switch rdr.str[rdr.pos] { + case "-" where rdr.str.characters.count == 1 || !int_char.contains(rdr.str[rdr.str.index(after: rdr.pos)]): + return try read_symbol(rdr) + case let c where int_char.contains(c): + return read_int(rdr) + case "\"": + return try read_string(rdr) + case ":": + rdr.next() + return MalVal.MalString("\u{029e}\(read_token(rdr))") + default: + return try read_symbol(rdr) + } +} + +func read_list(_ rdr: Reader, start: Character = "(", end: Character = ")") throws -> Array { + if rdr.str[rdr.pos] != start { + throw MalError.Reader(msg: "expected '\(start)'") + } + rdr.next() + skip_whitespace_and_comments(rdr) + var lst: [MalVal] = [] + while rdr.pos < rdr.str.endIndex { + if (rdr.str[rdr.pos] == end) { break } + lst.append(try read_form(rdr)) + } + if rdr.pos >= rdr.str.endIndex { + throw MalError.Reader(msg: "Expected '\(end)', got EOF") + } + rdr.next() + return lst +} + +func read_form(_ rdr: Reader) throws -> MalVal { + if rdr.str.characters.count == 0 { + throw MalError.Reader(msg: "Empty string passed to read_form") + } + //print("read_form: \(rdr.pos): \(rdr.str[rdr.pos])") + skip_whitespace_and_comments(rdr) + var res: MalVal + switch rdr.str[rdr.pos] { + // reader macros/transforms + case "'": + rdr.next() + return list([MalVal.MalSymbol("quote"), try read_form(rdr)]) + case "`": + rdr.next() + return list([MalVal.MalSymbol("quasiquote"), try read_form(rdr)]) + case "~": + switch rdr.str[rdr.str.index(after: rdr.pos)] { + case "@": + rdr.next() + rdr.next() + return list([MalVal.MalSymbol("splice-unquote"), + try read_form(rdr)]) + default: + rdr.next() + return list([MalVal.MalSymbol("unquote"), + try read_form(rdr)]) + } + case "^": + rdr.next() + let meta = try read_form(rdr) + return list([MalVal.MalSymbol("with-meta"), + try read_form(rdr), + meta]) + case "@": + rdr.next() + return list([MalVal.MalSymbol("deref"), + try read_form(rdr)]) + + // list + case "(": res = list(try read_list(rdr)) + case ")": throw MalError.Reader(msg: "unexpected ')'") + + // vector + case "[": res = vector(try read_list(rdr, start: "[", end: "]")) + case "]": throw MalError.Reader(msg: "unexpected ']'") + + // hash-map + case "{": res = try hash_map(try read_list(rdr, start: "{", end: "}")) + case "}": throw MalError.Reader(msg: "unexpected '}'") + + // atom + default: res = try read_atom(rdr) + } + skip_whitespace_and_comments(rdr) + return res +} + +func read_str(_ str: String) throws -> MalVal { + return try read_form(Reader(str)) +} diff --git a/impls/swift3/Sources/step0_repl/main.swift b/impls/swift3/Sources/step0_repl/main.swift new file mode 100644 index 0000000000..f850fa793a --- /dev/null +++ b/impls/swift3/Sources/step0_repl/main.swift @@ -0,0 +1,10 @@ +import Foundation + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + print("\(line!)") +} diff --git a/impls/swift3/Sources/step1_read_print/main.swift b/impls/swift3/Sources/step1_read_print/main.swift new file mode 100644 index 0000000000..07d79d1327 --- /dev/null +++ b/impls/swift3/Sources/step1_read_print/main.swift @@ -0,0 +1,35 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval +func EVAL(_ ast: MalVal, _ env: String) throws -> MalVal { + return ast +} + +// print +func PRINT(_ exp: MalVal) -> String { + return pr_str(exp, true) +} + + +// repl +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), "")) +} + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } +} diff --git a/impls/swift3/Sources/step2_eval/main.swift b/impls/swift3/Sources/step2_eval/main.swift new file mode 100644 index 0000000000..acee857be7 --- /dev/null +++ b/impls/swift3/Sources/step2_eval/main.swift @@ -0,0 +1,80 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval +func EVAL(_ ast: MalVal, _ env: Dictionary) throws -> MalVal { + /* print("EVAL: " + PRINT(ast)) */ + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env[sym] { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +func IntOp(_ op: (Int, Int) -> Int, _ a: MalVal, _ b: MalVal) throws -> MalVal { + switch (a, b) { + case (MalVal.MalInt(let i1), MalVal.MalInt(let i2)): + return MalVal.MalInt(op(i1, i2)) + default: + throw MalError.General(msg: "Invalid IntOp call") + } +} + +var repl_env: Dictionary = [ + "+": malfunc({ try IntOp({ $0 + $1}, $0[0], $0[1]) }), + "-": malfunc({ try IntOp({ $0 - $1}, $0[0], $0[1]) }), + "*": malfunc({ try IntOp({ $0 * $1}, $0[0], $0[1]) }), + "/": malfunc({ try IntOp({ $0 / $1}, $0[0], $0[1]) }), +] + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } +} diff --git a/impls/swift3/Sources/step3_env/main.swift b/impls/swift3/Sources/step3_env/main.swift new file mode 100644 index 0000000000..8ee7e3be48 --- /dev/null +++ b/impls/swift3/Sources/step3_env/main.swift @@ -0,0 +1,109 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval +func EVAL(_ ast: MalVal, _ env: Env) throws -> MalVal { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + return try EVAL(lst[2], let_env) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +func IntOp(_ op: (Int, Int) -> Int, _ a: MalVal, _ b: MalVal) throws -> MalVal { + switch (a, b) { + case (MalVal.MalInt(let i1), MalVal.MalInt(let i2)): + return MalVal.MalInt(op(i1, i2)) + default: + throw MalError.General(msg: "Invalid IntOp call") + } +} + +var repl_env: Env = try Env() +try repl_env.set(MalVal.MalSymbol("+"), + malfunc({ try IntOp({ $0 + $1}, $0[0], $0[1]) })) +try repl_env.set(MalVal.MalSymbol("-"), + malfunc({ try IntOp({ $0 - $1}, $0[0], $0[1]) })) +try repl_env.set(MalVal.MalSymbol("*"), + malfunc({ try IntOp({ $0 * $1}, $0[0], $0[1]) })) +try repl_env.set(MalVal.MalSymbol("/"), + malfunc({ try IntOp({ $0 / $1}, $0[0], $0[1]) })) + + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } +} diff --git a/impls/swift3/Sources/step4_if_fn_do/main.swift b/impls/swift3/Sources/step4_if_fn_do/main.swift new file mode 100644 index 0000000000..19410ac311 --- /dev/null +++ b/impls/swift3/Sources/step4_if_fn_do/main.swift @@ -0,0 +1,125 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval +func EVAL(_ ast: MalVal, _ env: Env) throws -> MalVal { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + return try EVAL(lst[2], let_env) + case MalVal.MalSymbol("do"): + let slc = lst[1.. 3 { + return try EVAL(lst[3], env) + } else { + return MalVal.MalNil + } + default: + return try EVAL(lst[2], env) + } + case MalVal.MalSymbol("fn*"): + return malfunc( { + return try EVAL(lst[2], Env(env, binds: lst[1], + exprs: list($0))) + }) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +@discardableResult +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +var repl_env: Env = try Env() + +// core.swift: defined using Swift +for (k, fn) in core_ns { + try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) +} + +// core.mal: defined using the language itself +try rep("(def! not (fn* (a) (if a false true)))") + + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } catch (MalError.MalException(let obj)) { + print("Error: \(pr_str(obj, true))") + } +} diff --git a/impls/swift3/Sources/step5_tco/main.swift b/impls/swift3/Sources/step5_tco/main.swift new file mode 100644 index 0000000000..80dce52e46 --- /dev/null +++ b/impls/swift3/Sources/step5_tco/main.swift @@ -0,0 +1,134 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval +func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { + var ast = orig_ast, env = orig_env + while true { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + env = let_env + ast = lst[2] // TCO + case MalVal.MalSymbol("do"): + let slc = lst[1.. 3 { + ast = lst[3] // TCO + } else { + return MalVal.MalNil + } + default: + ast = lst[2] // TCO + } + case MalVal.MalSymbol("fn*"): + return malfunc( { + return try EVAL(lst[2], Env(env, binds: lst[1], + exprs: list($0))) + }, ast:[lst[2]], env:env, params:[lst[1]]) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +@discardableResult +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +var repl_env: Env = try Env() + +// core.swift: defined using Swift +for (k, fn) in core_ns { + try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) +} + +// core.mal: defined using the language itself +try rep("(def! not (fn* (a) (if a false true)))") + + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } catch (MalError.MalException(let obj)) { + print("Error: \(pr_str(obj, true))") + } +} diff --git a/impls/swift3/Sources/step6_file/main.swift b/impls/swift3/Sources/step6_file/main.swift new file mode 100644 index 0000000000..4724e13518 --- /dev/null +++ b/impls/swift3/Sources/step6_file/main.swift @@ -0,0 +1,149 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval +func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { + var ast = orig_ast, env = orig_env + while true { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + env = let_env + ast = lst[2] // TCO + case MalVal.MalSymbol("do"): + let slc = lst[1.. 3 { + ast = lst[3] // TCO + } else { + return MalVal.MalNil + } + default: + ast = lst[2] // TCO + } + case MalVal.MalSymbol("fn*"): + return malfunc( { + return try EVAL(lst[2], Env(env, binds: lst[1], + exprs: list($0))) + }, ast:[lst[2]], env:env, params:[lst[1]]) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +@discardableResult +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +var repl_env: Env = try Env() + +// core.swift: defined using Swift +for (k, fn) in core_ns { + try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) +} +try repl_env.set(MalVal.MalSymbol("eval"), + malfunc({ try EVAL($0[0], repl_env) })) +let pargs = CommandLine.arguments.map { MalVal.MalString($0) } +// TODO: weird way to get empty list, fix this +var args = pargs[pargs.startIndex.. 1 { + try rep("(load-file \"" + CommandLine.arguments[1] + "\")") + exit(0) +} + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } catch (MalError.MalException(let obj)) { + print("Error: \(pr_str(obj, true))") + } +} diff --git a/impls/swift3/Sources/step7_quote/main.swift b/impls/swift3/Sources/step7_quote/main.swift new file mode 100644 index 0000000000..057ea500f5 --- /dev/null +++ b/impls/swift3/Sources/step7_quote/main.swift @@ -0,0 +1,198 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { + switch ast { + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil + } +} + +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } + } + return result +} + +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } +} + +func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { + var ast = orig_ast, env = orig_env + while true { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + env = let_env + ast = lst[2] // TCO + case MalVal.MalSymbol("quote"): + return lst[1] + case MalVal.MalSymbol("quasiquote"): + ast = quasiquote(lst[1]) // TCO + case MalVal.MalSymbol("do"): + let slc = lst[1.. 3 { + ast = lst[3] // TCO + } else { + return MalVal.MalNil + } + default: + ast = lst[2] // TCO + } + case MalVal.MalSymbol("fn*"): + return malfunc( { + return try EVAL(lst[2], Env(env, binds: lst[1], + exprs: list($0))) + }, ast:[lst[2]], env:env, params:[lst[1]]) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +@discardableResult +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +var repl_env: Env = try Env() + +// core.swift: defined using Swift +for (k, fn) in core_ns { + try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) +} +try repl_env.set(MalVal.MalSymbol("eval"), + malfunc({ try EVAL($0[0], repl_env) })) +let pargs = CommandLine.arguments.map { MalVal.MalString($0) } +// TODO: weird way to get empty list, fix this +var args = pargs[pargs.startIndex.. 1 { + try rep("(load-file \"" + CommandLine.arguments[1] + "\")") + exit(0) +} + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } catch (MalError.MalException(let obj)) { + print("Error: \(pr_str(obj, true))") + } +} diff --git a/impls/swift3/Sources/step8_macros/main.swift b/impls/swift3/Sources/step8_macros/main.swift new file mode 100644 index 0000000000..df01f05d9e --- /dev/null +++ b/impls/swift3/Sources/step8_macros/main.swift @@ -0,0 +1,209 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { + switch ast { + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil + } +} + +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } + } + return result +} + +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } +} + +func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { + var ast = orig_ast, env = orig_env + while true { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + env = let_env + ast = lst[2] // TCO + case MalVal.MalSymbol("quote"): + return lst[1] + case MalVal.MalSymbol("quasiquote"): + ast = quasiquote(lst[1]) // TCO + case MalVal.MalSymbol("defmacro!"): + var mac = try EVAL(lst[2], env) + switch mac { + case MalVal.MalFunc(let fn, let a, let e, let p, _, let m): + mac = malfunc(fn,ast:a,env:e,params:p,macro:true,meta:m) + default: throw MalError.General(msg: "invalid defmacro! form") + } + return try env.set(lst[1], mac) + case MalVal.MalSymbol("do"): + let slc = lst[1.. 3 { + ast = lst[3] // TCO + } else { + return MalVal.MalNil + } + default: + ast = lst[2] // TCO + } + case MalVal.MalSymbol("fn*"): + return malfunc( { + return try EVAL(lst[2], Env(env, binds: lst[1], + exprs: list($0))) + }, ast:[lst[2]], env:env, params:[lst[1]]) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +@discardableResult +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +var repl_env: Env = try Env() + +// core.swift: defined using Swift +for (k, fn) in core_ns { + try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) +} +try repl_env.set(MalVal.MalSymbol("eval"), + malfunc({ try EVAL($0[0], repl_env) })) +let pargs = CommandLine.arguments.map { MalVal.MalString($0) } +// TODO: weird way to get empty list, fix this +var args = pargs[pargs.startIndex.. (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +if CommandLine.arguments.count > 1 { + try rep("(load-file \"" + CommandLine.arguments[1] + "\")") + exit(0) +} + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } catch (MalError.MalException(let obj)) { + print("Error: \(pr_str(obj, true))") + } +} diff --git a/impls/swift3/Sources/step9_try/main.swift b/impls/swift3/Sources/step9_try/main.swift new file mode 100644 index 0000000000..182b5478c3 --- /dev/null +++ b/impls/swift3/Sources/step9_try/main.swift @@ -0,0 +1,242 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { + switch ast { + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil + } +} + +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } + } + return result +} + +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } +} + +func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { + var ast = orig_ast, env = orig_env + while true { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + env = let_env + ast = lst[2] // TCO + case MalVal.MalSymbol("quote"): + return lst[1] + case MalVal.MalSymbol("quasiquote"): + ast = quasiquote(lst[1]) // TCO + case MalVal.MalSymbol("defmacro!"): + var mac = try EVAL(lst[2], env) + switch mac { + case MalVal.MalFunc(let fn, let a, let e, let p, _, let m): + mac = malfunc(fn,ast:a,env:e,params:p,macro:true,meta:m) + default: throw MalError.General(msg: "invalid defmacro! form") + } + return try env.set(lst[1], mac) + case MalVal.MalSymbol("try*"): + do { + return try EVAL(_nth(ast, 1), env) + } catch (let exc) { + if lst.count > 2 { + let a2 = lst[2] + switch a2 { + case MalVal.MalList(let a2lst, _): + let a20 = a2lst[0] + switch a20 { + case MalVal.MalSymbol("catch*"): + if a2lst.count < 3 { return MalVal.MalNil } + let a21 = a2lst[1], a22 = a2lst[2] + var err: MalVal + switch exc { + case MalError.Reader(let msg): + err = MalVal.MalString(msg) + case MalError.General(let msg): + err = MalVal.MalString(msg) + case MalError.MalException(let obj): + err = obj + default: + err = MalVal.MalString(String(describing:exc)) + } + return try EVAL(a22, Env(env, binds: list([a21]), + exprs: list([err]))) + default: break + } + default: break + } + } + throw exc + } + case MalVal.MalSymbol("do"): + let slc = lst[1.. 3 { + ast = lst[3] // TCO + } else { + return MalVal.MalNil + } + default: + ast = lst[2] // TCO + } + case MalVal.MalSymbol("fn*"): + return malfunc( { + return try EVAL(lst[2], Env(env, binds: lst[1], + exprs: list($0))) + }, ast:[lst[2]], env:env, params:[lst[1]]) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +@discardableResult +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +var repl_env: Env = try Env() + +// core.swift: defined using Swift +for (k, fn) in core_ns { + try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) +} +try repl_env.set(MalVal.MalSymbol("eval"), + malfunc({ try EVAL($0[0], repl_env) })) +let pargs = CommandLine.arguments.map { MalVal.MalString($0) } +// TODO: weird way to get empty list, fix this +var args = pargs[pargs.startIndex.. (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +if CommandLine.arguments.count > 1 { + try rep("(load-file \"" + CommandLine.arguments[1] + "\")") + exit(0) +} + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } catch (MalError.MalException(let obj)) { + print("Error: \(pr_str(obj, true))") + } +} diff --git a/impls/swift3/Sources/stepA_mal/main.swift b/impls/swift3/Sources/stepA_mal/main.swift new file mode 100644 index 0000000000..64758c0b7e --- /dev/null +++ b/impls/swift3/Sources/stepA_mal/main.swift @@ -0,0 +1,245 @@ +import Foundation + +// read +func READ(_ str: String) throws -> MalVal { + return try read_str(str) +} + +// eval + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { + switch ast { + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil + } +} + +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } + } + return result +} + +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } +} + +func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { + var ast = orig_ast, env = orig_env + while true { + if let dbgeval = env.get("DEBUG-EVAL") { + switch dbgeval { + case MalVal.MalFalse, MalVal.MalNil: break + default: print("EVAL: " + PRINT(ast)) + } + } + switch ast { + case MalVal.MalSymbol(let sym): + if let value = env.get(sym) { + return value + } else { + throw MalError.General(msg: "'\(sym)' not found") + } + case MalVal.MalVector(let lst, _): + return vector(try lst.map { try EVAL($0, env) }) + case MalVal.MalHashMap(let dict, _): + var new_dict = Dictionary() + for (k,v) in dict { new_dict[k] = try EVAL(v, env) } + return hash_map(new_dict) + case MalVal.MalList(let lst, _): + if lst.count == 0 { return ast } + switch lst[0] { + case MalVal.MalSymbol("def!"): + return try env.set(lst[1], try EVAL(lst[2], env)) + case MalVal.MalSymbol("let*"): + let let_env = try Env(env) + var binds = Array() + switch lst[1] { + case MalVal.MalList(let l, _): binds = l + case MalVal.MalVector(let l, _): binds = l + default: + throw MalError.General(msg: "Invalid let* bindings") + } + var idx = binds.startIndex + while idx < binds.endIndex { + let v = try EVAL(binds[binds.index(after: idx)], let_env) + try let_env.set(binds[idx], v) + idx = binds.index(idx, offsetBy: 2) + } + env = let_env + ast = lst[2] // TCO + case MalVal.MalSymbol("quote"): + return lst[1] + case MalVal.MalSymbol("quasiquote"): + ast = quasiquote(lst[1]) // TCO + case MalVal.MalSymbol("defmacro!"): + var mac = try EVAL(lst[2], env) + switch mac { + case MalVal.MalFunc(let fn, let a, let e, let p, _, let m): + mac = malfunc(fn,ast:a,env:e,params:p,macro:true,meta:m) + default: throw MalError.General(msg: "invalid defmacro! form") + } + return try env.set(lst[1], mac) + case MalVal.MalSymbol("try*"): + do { + return try EVAL(_nth(ast, 1), env) + } catch (let exc) { + if lst.count > 2 { + let a2 = lst[2] + switch a2 { + case MalVal.MalList(let a2lst, _): + let a20 = a2lst[0] + switch a20 { + case MalVal.MalSymbol("catch*"): + if a2lst.count < 3 { return MalVal.MalNil } + let a21 = a2lst[1], a22 = a2lst[2] + var err: MalVal + switch exc { + case MalError.Reader(let msg): + err = MalVal.MalString(msg) + case MalError.General(let msg): + err = MalVal.MalString(msg) + case MalError.MalException(let obj): + err = obj + default: + err = MalVal.MalString(String(describing:exc)) + } + return try EVAL(a22, Env(env, binds: list([a21]), + exprs: list([err]))) + default: break + } + default: break + } + } + throw exc + } + case MalVal.MalSymbol("do"): + let slc = lst[1.. 3 { + ast = lst[3] // TCO + } else { + return MalVal.MalNil + } + default: + ast = lst[2] // TCO + } + case MalVal.MalSymbol("fn*"): + return malfunc( { + return try EVAL(lst[2], Env(env, binds: lst[1], + exprs: list($0))) + }, ast:[lst[2]], env:env, params:[lst[1]]) + default: + let raw_args = lst[1.. String { + return pr_str(exp, true) +} + + +// repl +@discardableResult +func rep(_ str:String) throws -> String { + return PRINT(try EVAL(try READ(str), repl_env)) +} + +var repl_env: Env = try Env() + +// core.swift: defined using Swift +for (k, fn) in core_ns { + try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) +} +try repl_env.set(MalVal.MalSymbol("eval"), + malfunc({ try EVAL($0[0], repl_env) })) +let pargs = CommandLine.arguments.map { MalVal.MalString($0) } +// TODO: weird way to get empty list, fix this +var args = pargs[pargs.startIndex.. (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + +if CommandLine.arguments.count > 1 { + try rep("(load-file \"" + CommandLine.arguments[1] + "\")") + exit(0) +} + +try rep("(println (str \"Mal [\" *host-language* \"]\"))") + +while true { + print("user> ", terminator: "") + let line = readLine(strippingNewline: true) + if line == nil { break } + if line == "" { continue } + + do { + print(try rep(line!)) + } catch (MalError.Reader(let msg)) { + print("Error: \(msg)") + } catch (MalError.General(let msg)) { + print("Error: \(msg)") + } catch (MalError.MalException(let obj)) { + print("Error: \(pr_str(obj, true))") + } +} diff --git a/impls/swift3/Sources/types.swift b/impls/swift3/Sources/types.swift new file mode 100644 index 0000000000..25f1468d7e --- /dev/null +++ b/impls/swift3/Sources/types.swift @@ -0,0 +1,212 @@ + +enum MalError: Error { + case Reader(msg: String) + case General(msg: String) + case MalException(obj: MalVal) +} + +class MutableAtom { + var val: MalVal + init(val: MalVal) { + self.val = val + } +} + +enum MalVal { + case MalNil + case MalTrue + case MalFalse + case MalInt(Int) + case MalFloat(Float) + case MalString(String) + case MalSymbol(String) + case MalList(Array, meta: Array?) + case MalVector(Array, meta: Array?) + case MalHashMap(Dictionary, meta: Array?) + // TODO: internal MalVals are wrapped in arrays because otherwise + // compiler throws a fault + case MalFunc((Array) throws -> MalVal, + ast: Array?, + env: Env?, + params: Array?, + macro: Bool, + meta: Array?) + case MalAtom(MutableAtom) +} + +typealias MV = MalVal + +// General functions + +func wraptf(_ a: Bool) -> MalVal { + return a ? MV.MalTrue : MV.MalFalse +} + + +// equality functions +func cmp_seqs(_ a: Array, _ b: Array) -> Bool { + if a.count != b.count { return false } + var idx = a.startIndex + while idx < a.endIndex { + if !equal_Q(a[idx], b[idx]) { return false } + idx = a.index(after:idx) + } + return true +} + +func cmp_maps(_ a: Dictionary, + _ b: Dictionary) -> Bool { + if a.count != b.count { return false } + for (k,v1) in a { + if b[k] == nil { return false } + if !equal_Q(v1, b[k]!) { return false } + } + return true +} + +func equal_Q(_ a: MalVal, _ b: MalVal) -> Bool { + switch (a, b) { + case (MV.MalNil, MV.MalNil): return true + case (MV.MalFalse, MV.MalFalse): return true + case (MV.MalTrue, MV.MalTrue): return true + case (MV.MalInt(let i1), MV.MalInt(let i2)): return i1 == i2 + case (MV.MalString(let s1), MV.MalString(let s2)): return s1 == s2 + case (MV.MalSymbol(let s1), MV.MalSymbol(let s2)): return s1 == s2 + case (MV.MalList(let l1,_), MV.MalList(let l2,_)): + return cmp_seqs(l1, l2) + case (MV.MalList(let l1,_), MV.MalVector(let l2,_)): + return cmp_seqs(l1, l2) + case (MV.MalVector(let l1,_), MV.MalList(let l2,_)): + return cmp_seqs(l1, l2) + case (MV.MalVector(let l1,_), MV.MalVector(let l2,_)): + return cmp_seqs(l1, l2) + case (MV.MalHashMap(let d1,_), MV.MalHashMap(let d2,_)): + return cmp_maps(d1, d2) + default: + return false + } +} + +// list and vector functions +func list(_ lst: Array) -> MalVal { + return MV.MalList(lst, meta:nil) +} +func list(_ lst: Array, meta: MalVal) -> MalVal { + return MV.MalList(lst, meta:[meta]) +} + +func vector(_ lst: Array) -> MalVal { + return MV.MalVector(lst, meta:nil) +} +func vector(_ lst: Array, meta: MalVal) -> MalVal { + return MV.MalVector(lst, meta:[meta]) +} + + +// hash-map functions + +func _assoc(_ src: Dictionary, _ mvs: Array) + throws -> Dictionary { + var d = src + if mvs.count % 2 != 0 { + throw MalError.General(msg: "Odd number of args to assoc_BANG") + } + var pos = mvs.startIndex + while pos < mvs.count { + switch (mvs[pos], mvs[pos+1]) { + case (MV.MalString(let k), let mv): + d[k] = mv + default: + throw MalError.General(msg: "Invalid _assoc call") + } + pos += 2 + } + return d +} + +func _dissoc(_ src: Dictionary, _ mvs: Array) + throws -> Dictionary { + var d = src + for mv in mvs { + switch mv { + case MV.MalString(let k): d.removeValue(forKey: k) + default: throw MalError.General(msg: "Invalid _dissoc call") + } + } + return d +} + + +func hash_map(_ dict: Dictionary) -> MalVal { + return MV.MalHashMap(dict, meta:nil) +} + +func hash_map(_ dict: Dictionary, meta:MalVal) -> MalVal { + return MV.MalHashMap(dict, meta:[meta]) +} + +func hash_map(_ arr: Array) throws -> MalVal { + let d = Dictionary(); + return MV.MalHashMap(try _assoc(d, arr), meta:nil) +} + + +// function functions +func malfunc(_ fn: @escaping (Array) throws -> MalVal) -> MalVal { + return MV.MalFunc(fn, ast: nil, env: nil, params: nil, + macro: false, meta: nil) +} +func malfunc(_ fn: @escaping (Array) throws -> MalVal, + ast: Array?, + env: Env?, + params: Array?) -> MalVal { + return MV.MalFunc(fn, ast: ast, env: env, params: params, + macro: false, meta: nil) +} +func malfunc(_ fn: @escaping (Array) throws -> MalVal, + ast: Array?, + env: Env?, + params: Array?, + macro: Bool, + meta: MalVal?) -> MalVal { + return MV.MalFunc(fn, ast: ast, env: env, params: params, + macro: macro, meta: meta != nil ? [meta!] : nil) +} +func malfunc(_ fn: @escaping (Array) throws -> MalVal, + ast: Array?, + env: Env?, + params: Array?, + macro: Bool, + meta: Array?) -> MalVal { + return MV.MalFunc(fn, ast: ast, env: env, params: params, + macro: macro, meta: meta) +} + +// sequence functions + +func _rest(_ a: MalVal) throws -> Array { + switch a { + case MV.MalList(let lst,_): + let start = lst.index(after: lst.startIndex) + let slc = lst[start.. MalVal { + return list(try _rest(a)) +} + +func _nth(_ a: MalVal, _ idx: Int) throws -> MalVal { + switch a { + case MV.MalList(let l,_): return l[l.startIndex.advanced(by: idx)] + case MV.MalVector(let l,_): return l[l.startIndex.advanced(by: idx)] + default: throw MalError.General(msg: "Invalid nth call") + } +} diff --git a/impls/swift3/run b/impls/swift3/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/swift3/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/swift3/tests/step5_tco.mal b/impls/swift3/tests/step5_tco.mal new file mode 100644 index 0000000000..3a866dc556 --- /dev/null +++ b/impls/swift3/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Swift 3: skipping non-TCO recursion +;; Reason: unrecoverable segfault at 10,000 diff --git a/impls/swift4/Dockerfile b/impls/swift4/Dockerfile new file mode 100644 index 0000000000..52a50161d8 --- /dev/null +++ b/impls/swift4/Dockerfile @@ -0,0 +1,44 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Swift +RUN apt-get -y install clang-3.6 cmake pkg-config \ + git ninja-build uuid-dev libicu-dev icu-devtools \ + libbsd-dev libedit-dev libxml2-dev libsqlite3-dev \ + swig libpython-dev libncurses5-dev + +# TODO: better way to do this? +RUN ln -sf /usr/lib/llvm-3.6/bin/clang++ /usr/bin/clang++ +RUN ln -sf /usr/lib/llvm-3.6/bin/clang /usr/bin/clang + +ENV SWIFT_PREFIX swift-4.2.4-RELEASE +ENV SWIFT_RELEASE ${SWIFT_PREFIX}-ubuntu16.04 + +RUN cd /opt && \ + curl -O https://download.swift.org/swift-4.2.4-release/ubuntu1604/${SWIFT_PREFIX}/${SWIFT_RELEASE}.tar.gz && \ + tar xvzf ${SWIFT_RELEASE}.tar.gz && \ + rm ${SWIFT_RELEASE}.tar.gz + +ENV PATH /opt/${SWIFT_RELEASE}/usr/bin/:$PATH + + diff --git a/impls/swift4/Makefile b/impls/swift4/Makefile new file mode 100644 index 0000000000..5bb375446d --- /dev/null +++ b/impls/swift4/Makefile @@ -0,0 +1,28 @@ +ifneq ($(shell which xcrun),) + SWIFT = xcrun -sdk macosx swiftc +else + SWIFT = swiftc +endif + +STEP3_DEPS = Sources/types.swift Sources/reader.swift Sources/printer.swift Sources/env.swift +STEP4_DEPS = $(STEP3_DEPS) Sources/core.swift + +STEPS = step0_repl step1_read_print step2_eval step3_env \ + step4_if_fn_do step5_tco step6_file step7_quote \ + step8_macros step9_try stepA_mal + +all: $(STEPS) + +dist: mal + +mal: stepA_mal + cp $< $@ + +step1_read_print step2_eval step3_env: $(STEP3_DEPS) +step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) + +step%: Sources/step%/main.swift + $(SWIFT) $+ -o $@ + +clean: + rm -f $(STEPS) mal diff --git a/impls/swift4/Sources/core.swift b/impls/swift4/Sources/core.swift new file mode 100644 index 0000000000..e10fe5afb9 --- /dev/null +++ b/impls/swift4/Sources/core.swift @@ -0,0 +1,210 @@ + +import Foundation + +func calculate(_ args: [MalData], op: (Number, Number) -> Number) throws -> MalData { + guard args.count == 2, args[0] is Number, args[1] is Number else { + throw MalError.InvalidArgument + } + return op(args[0] as! Number, args[1] as! Number) +} + +func isEqualList(_ l: [MalData], _ r: [MalData]) -> Bool { + guard l.count == r.count else { + return false + } + for i in l.indices { + if !isEqual(l[i], r[i]) { return false } + } + return true +} + +func isEqualHashMap (_ l: [String: MalData], _ r: [String: MalData]) -> Bool { + guard l.count == r.count else { + return false + } + for key in l.keys { + guard let lValue = l[key], let rValue = r[key] else { return false } + if !isEqual(lValue, rValue) { return false } + } + return true +} + +func isEqual(_ l: MalData, _ r: MalData) -> Bool { + switch (l.dataType, r.dataType) { + case (.Symbol, .Symbol): + return (l as! Symbol).name == (r as! Symbol).name + case (.String, .String), (.Keyword, .Keyword): + return (l as! String) == (r as! String) + case (.Number, .Number): + return (l as! Number) == (r as! Number) + case (.List, .List), (.Vector, .Vector), (.List, .Vector), (. Vector, .List): + return isEqualList(l.listForm, r.listForm) + case (.HashMap, .HashMap): + return isEqualHashMap((l as! [String: MalData]), (r as! [String: MalData])) + case (.Nil, .Nil), (.True, .True), (.False, .False): + return true + default: // atom, function + return false + } +} + +func hashMap(fromList list: [MalData]) throws -> [String: MalData] { + var hashMap: [String: MalData] = [:] + for index in stride(from: 0, to: list.count, by: 2) { + guard list[index] is String, index+1 < list.count else { throw MalError.Error } + hashMap.updateValue(list[index+1], forKey: list[index] as! String) + } + return hashMap +} + +let ns: [String: ([MalData]) throws -> MalData] = + ["+": { try calculate($0, op: +) }, + "-": { try calculate($0, op: -) }, + "*": { try calculate($0, op: *) }, + "/": { try calculate($0, op: /) }, + "<": { args in (args[0] as! Number) < (args[1] as! Number) }, + ">": { args in (args[0] as! Number) > (args[1] as! Number) }, + "<=": { args in (args[0] as! Number) <= (args[1] as! Number) }, + ">=": { args in (args[0] as! Number) >= (args[1] as! Number) }, + + "=": { args in let left = args[0], right = args[1]; return isEqual(left, right) }, + + "pr-str": { $0.map { pr_str($0, print_readably: true)}.joined(separator: " ") }, + "str": { $0.map { pr_str($0, print_readably: false)}.joined(separator: "") }, + "prn": { print($0.map { pr_str($0, print_readably: true)}.joined(separator: " ")); return Nil() }, + "println": { print($0.map { pr_str($0, print_readably: false)}.joined(separator: " ")); return Nil() }, + + "list": { List($0) }, + "list?": { let param = $0[0]; return param is [MalData] }, + "empty?": { $0[0].count == 0 }, + "count": { $0[0].count }, + + "read-string": { try read_str($0[0] as! String) }, + "slurp": { try String(contentsOfFile: $0[0] as! String) }, + + "atom": { Atom($0[0]) }, + "atom?": { $0[0] is Atom }, + "deref": { ($0[0] as? Atom)?.value ?? Nil() }, + "reset!": { args in (args[0] as! Atom).value = args[1]; return args[1] }, + "swap!": { args in + let atom = args[0] as! Atom, fn = args[1] as! Function, + others = args.dropFirst(2).listForm + atom.value = try fn.fn([atom.value] + others) + return atom.value + }, + "cons": { args in [args[0]] + args[1].listForm }, + "concat": { $0.reduce([]) { (result, array ) in result + array.listForm } }, + "vec": { Vector($0[0].listForm) }, + + "nth": { args in + let list = args[0].listForm, i = args[1] as! Int + guard list.indices.contains(i) else { throw MalError.IndexOutOfBounds } + return list[i] + }, + "first": { $0[0].listForm.first ?? Nil() }, + "rest": { $0[0].listForm.dropFirst().listForm }, + + "throw": { throw MalError.MalException($0[0]) }, + "apply": { args in + let fn = args[0] as! Function + let newArgs = args.dropFirst().dropLast().listForm + args.last!.listForm + return try fn.fn(newArgs) + }, + "map": { args in + let fn = args[0] as! Function + let closure = fn.fn + var result: [MalData] = [] + for element in args[1].listForm { + result.append(try fn.fn([element])) } + return result + }, + + "nil?": { $0[0] is Nil }, + "true?": { $0[0].dataType == .True }, + "false?": { $0[0].dataType == .False }, + "symbol?": { $0[0].dataType == .Symbol }, + "symbol": { Symbol($0[0] as! String) }, + "keyword": { ($0[0].dataType == .Keyword) ? $0[0] : "\u{029E}" + ($0[0] as! String) }, + "keyword?":{ $0[0].dataType == .Keyword }, + "vector": { Vector($0) }, + "vector?": { $0[0].dataType == .Vector }, + "hash-map":{ try hashMap(fromList: $0) }, + "map?": { $0[0].dataType == .HashMap }, + "assoc": { + let map = $0[0] as! [String: MalData] + return map.merging(try hashMap(fromList: $0.dropFirst().listForm)) { (_, new) in new } + }, + "dissoc": { args in + let map = args[0] as! [String: MalData] + return map.filter { (key, _) in !(args.dropFirst().listForm as! [String]).contains(key) } + }, + "get": { + if let map = $0[0] as? [String: MalData] { + return map[$0[1] as! String] ?? Nil() } + return Nil() + }, + "contains?": { ($0[0] as! [String: MalData])[$0[1] as! String] != nil }, + "keys": { + ($0[0] as! [String: MalData]).reduce([]) { result, element in + let (key, _) = element + return result + [key] } + }, + "vals": { + ($0[0] as! [String: MalData]).reduce([]) { result, element in + let (_, value) = element + return result + [value] } + }, + "sequential?": { [.List, .Vector].contains($0[0].dataType) }, + + "readline": { + print($0[0] as! String, terminator: "") + return readLine(strippingNewline: true) ?? Nil() }, + + "meta": { + switch $0[0].dataType { + case .Function: + return ($0[0] as! Function).meta ?? Nil() + default: + return Nil() + }}, + "with-meta": { + switch $0[0].dataType { + case .Function: + return Function(withFunction: $0[0] as! Function, meta: $0[1]) + default: + return $0[0] + }}, + "time-ms": { _ in Int(Date().timeIntervalSince1970 * 1000) }, + "conj": { + if let list = $0[0] as? [MalData] { + return $0.dropFirst().reversed().listForm + list + } else { // vector + return ($0[0] as! Vector) + Vector($0.dropFirst()) + }}, + "string?": { $0[0].dataType == .String }, + "number?": { $0[0].dataType == .Number }, + "fn?": { + if let fn = $0[0] as? Function { + return !fn.isMacro + } else { + return false + }}, + "macro?": { + if let fn = $0[0] as? Function { + return fn.isMacro + } else { + return false + }}, + "seq": { + if $0[0].count == 0 { return Nil() } + switch $0[0].dataType { + case .List: + return $0[0] as! List + case .Vector: + return List($0[0] as! ContiguousArray) + case .String: + return List($0[0] as! String).map { String($0) } + default: + return Nil() + }}, +] diff --git a/impls/swift4/Sources/env.swift b/impls/swift4/Sources/env.swift new file mode 100644 index 0000000000..50b8ca1cd3 --- /dev/null +++ b/impls/swift4/Sources/env.swift @@ -0,0 +1,43 @@ + +import Foundation + +class Env { + let outer: Env? + var data: [String: MalData] = [:] + + init(outer: Env) { + self.outer = outer + } + init() { + outer = nil + } + init(binds: [Symbol], exprs: [MalData], outer: Env) { + self.outer = outer + self.data = [:] + for i in binds.indices { + if binds[i].name == "&" { + data.updateValue(List(exprs[i.. Env? { + if let _ = data[key.name] { + return self + } else { + return outer?.find(key) + } + } + func get(forKey key: Symbol) throws -> MalData { + if let env = find(key), let value = env.data[key.name] { + return value + } else { + throw MalError.SymbolNotFound(key) + } + } +} diff --git a/impls/swift4/Sources/printer.swift b/impls/swift4/Sources/printer.swift new file mode 100644 index 0000000000..0ccfc1f93b --- /dev/null +++ b/impls/swift4/Sources/printer.swift @@ -0,0 +1,51 @@ + +import Foundation + +func pr_str(_ input: MalData, print_readably: Bool) -> String { + switch input.dataType { + case .Symbol: + let symbol = input as! Symbol + return symbol.name + case .Number: + let number = input as! Number + return String(number) + case .True: + return "true" + case .False: + return "false" + case .Nil: + return "nil" + case .Keyword: + let keyword = input as! String + return keyword.replacingCharacters(in: keyword.startIndex...keyword.startIndex, with: ":") + case .String: + let string = input as! String + if print_readably { + return "\"" + string.replacingOccurrences(of: "\\", with: "\\\\") + .replacingOccurrences(of: "\"", with: "\\\"") + .replacingOccurrences(of: "\n", with: "\\n") + "\"" + } else { + return string + } + case .List: + let list = input as! List + let stringOfElements = list.map { pr_str($0, print_readably: print_readably) }.joined(separator: " ") + return "(" + stringOfElements + ")" + case .Vector: + let vector = input as! Vector + let stringOfElements = vector.map { pr_str($0, print_readably: print_readably) }.joined(separator: " ") + return "[" + stringOfElements + "]" + case .HashMap: + let hashMap = input as! [String: MalData] + let stringOfElements = hashMap.map { (key, value) in + pr_str(key, print_readably: print_readably) + " " + pr_str(value, print_readably: print_readably) + }.joined(separator: " ") + return "{" + stringOfElements + "}" + case .Atom: + return pr_str("(atom \((input as! Atom).value))", print_readably: false) + case .Function: + return "#" + default: + return "error type!" + } +} diff --git a/impls/swift4/Sources/reader.swift b/impls/swift4/Sources/reader.swift new file mode 100644 index 0000000000..44d3041b38 --- /dev/null +++ b/impls/swift4/Sources/reader.swift @@ -0,0 +1,147 @@ + +import Foundation + +struct Reader { + let tokens: [String] + var position = 0 + + init(tokens: [String]) { + self.tokens = tokens + } + + mutating func next() -> String? { + guard tokens.indices.contains(position) else { + return nil + } + position += 1 + return tokens[position - 1] + } + + func peak() -> String? { + guard tokens.indices.contains(position) else { + return nil + } + return tokens[position] + } + + mutating func pass() { + guard tokens.indices.contains(position) else { + return + } + position += 1 + } + + mutating func read_form() throws -> MalData { + guard let token = peak() else { throw MalError.Error } + switch token { + case "(", "[", "{": + return try read_list(startWith: token) + case "'", "`", "~", "~@", "@": + let readerMacros = ["'": "quote", + "`": "quasiquote", + "~": "unquote", + "~@": "splice-unquote", + "@": "deref"] + pass() // pass the mark + return try [Symbol(readerMacros[token]!), read_form()] + case "^": + pass() // pass the mark + let meta = try read_form() + return try [Symbol("with-meta"), read_form(), meta] + default: + return try read_atom() + } + } + + + mutating func read_list(startWith leftParen: String) throws -> MalData { + pass() // pass the left paren + defer { + pass() // pass the right paren + } + + var list: [MalData] = [] + while ![")", "]", "}"].contains(peak()) { + guard peak() != nil else { + throw MalError.ParensMismatch + } + list.append(try read_form()) + } + + switch (leftParen, peak()) { + case ("(", ")"): + return list + case ("[", "]"): + return Vector(list) + case ("{", "}"): + var hashMap: [String: MalData] = [:] + for index in stride(from: 0, to: list.count, by: 2) { + guard list[index] is String, index+1 < list.count else { throw MalError.Error } + hashMap.updateValue(list[index+1], forKey: list[index] as! String) + } + return hashMap + default: + throw MalError.ParensMismatch + } + } + + mutating func read_atom() throws -> MalData { + let token = next()! + let regexInt = "^-?[0-9]+$" + let regexString = "\"(?:\\\\.|[^\\\\\"])*\"" + let regexStringUnbalanced = "\"(?:\\\\.|[^\\\\\"])*" + let regexKeyword = "^:" + func match(string: String, regex: String) -> Bool { + return token.range(of: regex, options: .regularExpression, range: token.startIndex.. [String] { + guard let regex = try? NSRegularExpression(pattern: "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}()'\"`@,;]+)", options: .useUnixLineSeparators) + else { return [] } + let matches = regex.matches(in: input, range: NSMakeRange(0, input.count)) + + return matches.map { match in + String(input[Range(match.range(at: 1), in: input)!]) + }.filter { token in + !token.hasPrefix(";") && !token.isEmpty } +} + + +func read_str(_ input: String) throws -> MalData { + let tokens = tokenizer(input) + guard tokens.count>0 else { + throw MalError.EmptyData + } + var reader = Reader(tokens: tokens) + return try reader.read_form() +} + + + + + diff --git a/impls/swift4/Sources/step0_repl/main.swift b/impls/swift4/Sources/step0_repl/main.swift new file mode 100644 index 0000000000..f725a995b6 --- /dev/null +++ b/impls/swift4/Sources/step0_repl/main.swift @@ -0,0 +1,27 @@ + +import Foundation + +func READ(_ input:String) -> String { + return input +} + +func EVAL(_ input:String) -> String { + return input +} + +func PRINT(_ input:String) -> String { + return input +} + +@discardableResult func rep(_ input:String) -> String { + return PRINT(EVAL(READ(input))) +} + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + print(rep(input)) + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step1_read_print/main.swift b/impls/swift4/Sources/step1_read_print/main.swift new file mode 100644 index 0000000000..187cbaedff --- /dev/null +++ b/impls/swift4/Sources/step1_read_print/main.swift @@ -0,0 +1,33 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func EVAL(_ input: MalData) throws -> MalData { + return input +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String) throws -> String { + return try PRINT(EVAL(READ(input))) +} + + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step2_eval/main.swift b/impls/swift4/Sources/step2_eval/main.swift new file mode 100644 index 0000000000..a5174cac58 --- /dev/null +++ b/impls/swift4/Sources/step2_eval/main.swift @@ -0,0 +1,68 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func EVAL(_ ast: MalData, env: [String: MalData]) throws -> MalData { + /* print("EVAL: " + PRINT(ast)) */ + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + let args = try raw_args.map { try EVAL($0, env: env) } + return try function.fn(args) + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = env[sym.name] { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String) throws -> String{ + func calculate(_ args: [MalData], op: (Number, Number) -> Number) throws -> MalData { + guard args.count == 2, args[0] is Number, args[1] is Number else { throw MalError.InvalidArgument } + return op(args[0] as! Number, args[1] as! Number) + } + + let repl_env = ["+": Function(fn: { args in try calculate(args, op: +) }), + "-": Function(fn: { args in try calculate(args, op: -) }), + "*": Function(fn: { args in try calculate(args, op: *) }), + "/": Function(fn: { args in try calculate(args, op: /) })] + + return try PRINT(EVAL(READ(input), env: repl_env)) +} + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step3_env/main.swift b/impls/swift4/Sources/step3_env/main.swift new file mode 100644 index 0000000000..44945cdaee --- /dev/null +++ b/impls/swift4/Sources/step3_env/main.swift @@ -0,0 +1,92 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func EVAL(_ ast: MalData, env: Env) throws -> MalData { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + return try EVAL(expr, env: newEnv) + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + let args = try raw_args.map { try EVAL($0, env: env) } + return try function.fn(args) + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +func calculate(_ args: [MalData], op: (Number, Number) -> Number) throws -> MalData { + guard args.count == 2, args[0] is Number, args[1] is Number else { throw MalError.InvalidArgument } + return op(args[0] as! Number, args[1] as! Number) +} +let repl_env = Env() +repl_env.set(Function(fn: { args in try calculate(args, op: +) }), forKey: Symbol("+")) +repl_env.set(Function(fn: { args in try calculate(args, op: -) }), forKey: Symbol("-")) +repl_env.set(Function(fn: { args in try calculate(args, op: *) }), forKey: Symbol("*")) +repl_env.set(Function(fn: { args in try calculate(args, op: /) }), forKey: Symbol("/")) + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step4_if_fn_do/main.swift b/impls/swift4/Sources/step4_if_fn_do/main.swift new file mode 100644 index 0000000000..0c3f809aa9 --- /dev/null +++ b/impls/swift4/Sources/step4_if_fn_do/main.swift @@ -0,0 +1,103 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func EVAL(_ ast: MalData, env: Env) throws -> MalData { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + return try EVAL(expr, env: newEnv) + case "do": + return try list.dropFirst().map { try EVAL($0, env: env) }.last ?? Nil() + case "if": + let predicate = try EVAL(list[1], env: env) + if predicate as? Bool == false || predicate is Nil { + return list.count>3 ? try EVAL(list[3], env: env) : Nil() + } else { + return try EVAL(list[2], env: env) + } + case "fn*": + let fn = {(params: [MalData]) -> MalData in + let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) + return try EVAL(list[2], env: newEnv) + } + return Function(fn: fn) + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + let args = try raw_args.map { try EVAL($0, env: env) } + return try function.fn(args) + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +var repl_env = Env() +for (key, value) in ns { + repl_env.set(Function(fn: value), forKey: Symbol(key)) +} +try _ = rep("(def! not (fn* (a) (if a false true)))", env: repl_env) + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step5_tco/main.swift b/impls/swift4/Sources/step5_tco/main.swift new file mode 100644 index 0000000000..f42ffa53ba --- /dev/null +++ b/impls/swift4/Sources/step5_tco/main.swift @@ -0,0 +1,118 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { + var ast = anAst, env = anEnv + while true { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + env = newEnv + ast = expr + continue + case "do": + try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } + ast = list.last ?? Nil() + continue + case "if": + let predicate = try EVAL(list[1], env: env) + if predicate as? Bool == false || predicate is Nil { + ast = list.count>3 ? list[3] : Nil() + } else { + ast = list[2] + } + continue + case "fn*": + let fn = {(params: [MalData]) -> MalData in + let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) + return try EVAL(list[2], env: newEnv) + } + return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) + + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + let args = try raw_args.map { try EVAL($0, env: env) } + if let fnAst = function.ast { // a full fn + ast = fnAst + env = Env(binds: function.params!, exprs: args, outer: function.env!) + } else { // normal function + return try function.fn(args) + } + continue + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +var repl_env = Env() +for (key, value) in ns { + repl_env.set(Function(fn: value), forKey: Symbol(key)) +} +try _ = rep("(def! not (fn* (a) (if a false true)))", env: repl_env) + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step6_file/main.swift b/impls/swift4/Sources/step6_file/main.swift new file mode 100644 index 0000000000..c9b636fc4d --- /dev/null +++ b/impls/swift4/Sources/step6_file/main.swift @@ -0,0 +1,130 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { + var ast = anAst, env = anEnv + while true { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + env = newEnv + ast = expr + continue + case "do": + try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } + ast = list.last ?? Nil() + continue + case "if": + let predicate = try EVAL(list[1], env: env) + if predicate as? Bool == false || predicate is Nil { + ast = list.count>3 ? list[3] : Nil() + } else { + ast = list[2] + } + continue + case "fn*": + let fn = {(params: [MalData]) -> MalData in + let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) + return try EVAL(list[2], env: newEnv) + } + return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) + + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + let args = try raw_args.map { try EVAL($0, env: env) } + if let fnAst = function.ast { // a full fn + ast = fnAst + env = Env(binds: function.params!, exprs: args, outer: function.env!) + } else { // normal function + return try function.fn(args) + } + continue + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +var repl_env = Env() +for (key, value) in ns { + repl_env.set(Function(fn: value), forKey: Symbol(key)) +} +repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) +repl_env.set([], forKey: Symbol("*ARGV*")) + +try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) +try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) + +if CommandLine.argc > 1 { + let fileName = CommandLine.arguments[1], + args = List(CommandLine.arguments.dropFirst(2)) + repl_env.set(args, forKey: Symbol("*ARGV*")) + try rep("(load-file \"\(fileName)\")", env: repl_env) + exit(0) +} + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step7_quote/main.swift b/impls/swift4/Sources/step7_quote/main.swift new file mode 100644 index 0000000000..2a926b04a1 --- /dev/null +++ b/impls/swift4/Sources/step7_quote/main.swift @@ -0,0 +1,176 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil + } +} + +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + +func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { + var ast = anAst, env = anEnv + while true { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + env = newEnv + ast = expr + continue + case "do": + try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } + ast = list.last ?? Nil() + continue + case "if": + let predicate = try EVAL(list[1], env: env) + if predicate as? Bool == false || predicate is Nil { + ast = list.count>3 ? list[3] : Nil() + } else { + ast = list[2] + } + continue + case "fn*": + let fn = {(params: [MalData]) -> MalData in + let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) + return try EVAL(list[2], env: newEnv) + } + return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) + case "quote": + return list[1] + case "quasiquote": + ast = quasiquote(list[1]) + continue + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + let args = try raw_args.map { try EVAL($0, env: env) } + if let fnAst = function.ast { // a full fn + ast = fnAst + env = Env(binds: function.params!, exprs: args, outer: function.env!) + } else { // normal function + return try function.fn(args) + } + continue + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +var repl_env = Env() +for (key, value) in ns { + repl_env.set(Function(fn: value), forKey: Symbol(key)) +} +repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) +repl_env.set([], forKey: Symbol("*ARGV*")) + +try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) +try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) + +if CommandLine.argc > 1 { + let fileName = CommandLine.arguments[1], + args = List(CommandLine.arguments.dropFirst(2)) + repl_env.set(args, forKey: Symbol("*ARGV*")) + try rep("(load-file \"\(fileName)\")", env: repl_env) + exit(0) +} + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step8_macros/main.swift b/impls/swift4/Sources/step8_macros/main.swift new file mode 100644 index 0000000000..1da85bf4db --- /dev/null +++ b/impls/swift4/Sources/step8_macros/main.swift @@ -0,0 +1,186 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil + } +} + +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + +func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { + var ast = anAst, env = anEnv + while true { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "defmacro!": + let fn = try EVAL(list[2], env: env) as! Function, key = list[1] as! Symbol + let macro = Function(withFunction: fn, isMacro: true) + env.set(macro, forKey: key) + return macro + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + env = newEnv + ast = expr + continue + case "do": + try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } + ast = list.last ?? Nil() + continue + case "if": + let predicate = try EVAL(list[1], env: env) + if predicate as? Bool == false || predicate is Nil { + ast = list.count>3 ? list[3] : Nil() + } else { + ast = list[2] + } + continue + case "fn*": + let fn = {(params: [MalData]) -> MalData in + let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) + return try EVAL(list[2], env: newEnv) + } + return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) + case "quote": + return list[1] + case "quasiquote": + ast = quasiquote(list[1]) + continue + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + if function.isMacro { + ast = try function.fn(List(raw_args)) + continue + } + let args = try raw_args.map { try EVAL($0, env: env) } + if let fnAst = function.ast { // a full fn + ast = fnAst + env = Env(binds: function.params!, exprs: args, outer: function.env!) + } else { // normal function + return try function.fn(args) + } + continue + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +var repl_env = Env() +for (key, value) in ns { + repl_env.set(Function(fn: value), forKey: Symbol(key)) +} +repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) +repl_env.set([], forKey: Symbol("*ARGV*")) + +try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) +try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) +try rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", env: repl_env) + +if CommandLine.argc > 1 { + let fileName = CommandLine.arguments[1], + args = List(CommandLine.arguments.dropFirst(2)) + repl_env.set(args, forKey: Symbol("*ARGV*")) + try rep("(load-file \"\(fileName)\")", env: repl_env) + exit(0) +} + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch let error as MalError { + print(error.info()) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/step9_try/main.swift b/impls/swift4/Sources/step9_try/main.swift new file mode 100644 index 0000000000..afd07bf327 --- /dev/null +++ b/impls/swift4/Sources/step9_try/main.swift @@ -0,0 +1,204 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil + } +} + +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + +func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { + var ast = anAst, env = anEnv + while true { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "defmacro!": + let fn = try EVAL(list[2], env: env) as! Function, key = list[1] as! Symbol + let macro = Function(withFunction: fn, isMacro: true) + env.set(macro, forKey: key) + return macro + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + env = newEnv + ast = expr + continue + case "do": + try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } + ast = list.last ?? Nil() + continue + case "if": + let predicate = try EVAL(list[1], env: env) + if predicate as? Bool == false || predicate is Nil { + ast = list.count>3 ? list[3] : Nil() + } else { + ast = list[2] + } + continue + case "fn*": + let fn = {(params: [MalData]) -> MalData in + let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) + return try EVAL(list[2], env: newEnv) + } + return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) + case "quote": + return list[1] + case "quasiquote": + ast = quasiquote(list[1]) + continue + case "try*": + do { + return try EVAL(list[1], env: env) + } catch let error as MalError { + if list.count > 2 { + let catchList = list[2] as! [MalData] + let catchEnv = Env(binds: [catchList[1] as! Symbol], exprs:[error.info()] , outer: env) + return try EVAL(catchList[2], env: catchEnv) + } else { + throw error + } + } + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + if function.isMacro { + ast = try function.fn(List(raw_args)) + continue + } + let args = try raw_args.map { try EVAL($0, env: env) } + if let fnAst = function.ast { // a full fn + ast = fnAst + env = Env(binds: function.params!, exprs: args, outer: function.env!) + } else { // normal function + return try function.fn(args) + } + continue + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +var repl_env = Env() +for (key, value) in ns { + repl_env.set(Function(fn: value), forKey: Symbol(key)) +} +repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) +repl_env.set([], forKey: Symbol("*ARGV*")) + +try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) +try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) +try rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", env: repl_env) + +if CommandLine.argc > 1 { + let fileName = CommandLine.arguments[1], + args = List(CommandLine.arguments.dropFirst(2)) + repl_env.set(args, forKey: Symbol("*ARGV*")) + try rep("(load-file \"\(fileName)\")", env: repl_env) + exit(0) +} + +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch MalError.MalException(let data) { + if let description = data as? String { + print("Exception." + description) + } else if let dic = data as? [String: String], !dic.isEmpty { + print("Exception." + dic.keys.first! + "." + dic.values.first!) + } + } catch let error as MalError { + print((pr_str(error.info(), print_readably: false))) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/stepA_mal/main.swift b/impls/swift4/Sources/stepA_mal/main.swift new file mode 100644 index 0000000000..f04492f3eb --- /dev/null +++ b/impls/swift4/Sources/stepA_mal/main.swift @@ -0,0 +1,207 @@ + +import Foundation + +func READ(_ input: String) throws -> MalData { + return try read_str(input) +} + +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil + } +} + +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + +func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { + var ast = anAst, env = anEnv + while true { + if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { + if ![.False, .Nil].contains(dbgeval.dataType) { + print("EVAL: " + PRINT(ast)) + } + } + switch ast.dataType { + case .List: + let list = ast as! [MalData] + guard !list.isEmpty else { return list } + if let sym = list[0] as? Symbol { + switch sym.name { + case "def!": + let value = try EVAL(list[2], env: env), key = list[1] as! Symbol + env.set(value, forKey: key) + return value + case "defmacro!": + let fn = try EVAL(list[2], env: env) as! Function, key = list[1] as! Symbol + let macro = Function(withFunction: fn, isMacro: true) + env.set(macro, forKey: key) + return macro + case "let*": + let newEnv = Env(outer: env), expr = list[2] + let bindings = list[1].listForm + for i in stride(from: 0, to: bindings.count-1, by: 2) { + let key = bindings[i], value = bindings[i+1] + let result = try EVAL(value, env: newEnv) + newEnv.set(result, forKey: key as! Symbol) + } + env = newEnv + ast = expr + continue + case "do": + try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } + ast = list.last ?? Nil() + continue + case "if": + let predicate = try EVAL(list[1], env: env) + if predicate as? Bool == false || predicate is Nil { + ast = list.count>3 ? list[3] : Nil() + } else { + ast = list[2] + } + continue + case "fn*": + let fn = {(params: [MalData]) -> MalData in + let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) + return try EVAL(list[2], env: newEnv) + } + return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) + case "quote": + return list[1] + case "quasiquote": + ast = quasiquote(list[1]) + continue + case "try*": + do { + return try EVAL(list[1], env: env) + } catch let error as MalError { + if list.count > 2 { + let catchList = list[2] as! [MalData] + let catchEnv = Env(binds: [catchList[1] as! Symbol], exprs:[error.info()] , outer: env) + return try EVAL(catchList[2], env: catchEnv) + } else { + throw error + } + } + default: + break + } + } + // not a symbol. maybe: function, list, or some wrong type + guard let function = try EVAL(list[0], env: env) as? Function else { + throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) + } + let raw_args = list.dropFirst() + if function.isMacro { + ast = try function.fn(List(raw_args)) + continue + } + let args = try raw_args.map { try EVAL($0, env: env) } + if let fnAst = function.ast { // a full fn + ast = fnAst + env = Env(binds: function.params!, exprs: args, outer: function.env!) + } else { // normal function + return try function.fn(args) + } + continue + case .Vector: + let vector = ast as! ContiguousArray + return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) + case .HashMap: + let hashMap = ast as! HashMap + return try hashMap.mapValues { value in try EVAL(value, env: env) } + case .Symbol: + let sym = ast as! Symbol + if let value = try? env.get(forKey: sym) { + return value + } else { + throw MalError.SymbolNotFound(sym) + } + default: + return ast + } + } +} + +func PRINT(_ input: MalData) -> String { + return pr_str(input, print_readably: true) +} + +@discardableResult func rep(_ input: String, env: Env) throws -> String { + return try PRINT(EVAL(READ(input), env: env)) +} + +var repl_env = Env() +for (key, value) in ns { + repl_env.set(Function(fn: value), forKey: Symbol(key)) +} +repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) +repl_env.set([], forKey: Symbol("*ARGV*")) +repl_env.set("Swift4", forKey: Symbol("*host-language*")) + + +try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) +try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) +try rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", env: repl_env) + +if CommandLine.argc > 1 { + let fileName = CommandLine.arguments[1], + args = List(CommandLine.arguments.dropFirst(2)) + repl_env.set(args, forKey: Symbol("*ARGV*")) + try rep("(load-file \"\(fileName)\")", env: repl_env) + exit(0) +} + +try rep("(println (str \"Mal [\" *host-language* \"]\"))", env: repl_env) +while true { + print("user> ", terminator: "") + if let input = readLine(strippingNewline: true) { + guard input != "" else { continue } + do { + try print(rep(input, env: repl_env)) + } catch MalError.MalException(let data) { + if let description = data as? String { + print("Exception." + description) + } else if let dic = data as? [String: String], !dic.isEmpty { + print("Exception." + dic.keys.first! + "." + dic.values.first!) + } + } catch let error as MalError { + print((pr_str(error.info(), print_readably: false))) + } + } else { + exit(0); + } +} diff --git a/impls/swift4/Sources/types.swift b/impls/swift4/Sources/types.swift new file mode 100644 index 0000000000..0686b8dae4 --- /dev/null +++ b/impls/swift4/Sources/types.swift @@ -0,0 +1,151 @@ + +import Foundation + +enum MalDataType: String { + case Number, String, List, Vector, HashMap, Symbol, Keyword, Atom, Nil, True, False, Function, Unknown +} + +protocol MalData { + var dataType: MalDataType { get } + + var count: Int { get } + var listForm: [MalData] { get } +} +extension MalData { + var dataType: MalDataType { // not used + return MalDataType(rawValue: String(describing: type(of: self))) ?? MalDataType.Unknown + } + var count: Int { return 0 } + var listForm: [MalData] { return [] } +} + +typealias Number = Int +typealias List = Array +typealias Vector = ContiguousArray +typealias HashMap = Dictionary + +struct Symbol: MalData { + let dataType = MalDataType.Symbol + let name: String + init(_ name: String) { + self.name = name + } +} + +struct Nil: MalData { + let dataType = MalDataType.Nil +} + +class Atom: MalData { + let dataType = MalDataType.Atom + var value: MalData + init(_ value: MalData) { + self.value = value + } +} + +struct Function: MalData { + let dataType = MalDataType.Function + + let ast: MalData? + let params: [Symbol]? + let env: Env? + let fn: (([MalData]) throws -> MalData) + let isMacro: Bool + let meta: MalData? + + init(ast: MalData? = nil, params: [Symbol]? = nil, env: Env? = nil, isMacro: Bool = false, meta: MalData? = nil, + fn: @escaping ([MalData]) throws -> MalData) { + self.ast = ast + self.params = params + self.env = env + self.isMacro = isMacro + self.fn = fn + self.meta = meta + } + init(withFunction function: Function, isMacro: Bool) { + self.ast = function.ast + self.params = function.params + self.env = function.env + self.fn = function.fn + self.meta = function.meta + self.isMacro = isMacro + } + init(withFunction function: Function, meta: MalData) { + self.ast = function.ast + self.params = function.params + self.env = function.env + self.fn = function.fn + self.isMacro = function.isMacro + self.meta = meta + } + +} + + +extension String: MalData { + var dataType: MalDataType { + return !self.isEmpty && self[startIndex] == "\u{029E}" ? .Keyword : .String } +} +extension Number: MalData { + var dataType: MalDataType { return .Number } +} +extension Bool : MalData { + var dataType: MalDataType { return self == true ? .True : .False } +} + +extension List : MalData { + var dataType: MalDataType { return .List } + var listForm: [MalData] { return self as! [MalData] } +} +extension Vector: MalData { + var dataType: MalDataType { return .Vector } + var listForm: [MalData] { return List(self) as! [MalData] } +} +extension ArraySlice: MalData { + var dataType: MalDataType { return .List } + var listForm: [MalData] { return List(self) as! [MalData] } +} +extension HashMap: MalData { + var dataType: MalDataType { return .HashMap } + static func hashMap(fromList list: [MalData]) throws -> [String: MalData] { + var hashMap: [String: MalData] = [:] + for index in stride(from: 0, to: list.count, by: 2) { + guard list[index] is String, index+1 < list.count else { throw MalError.Error } + hashMap.updateValue(list[index+1], forKey: list[index] as! String) + } + return hashMap + } +} + +// MARK: Errors +enum MalError: Error { + case ParensMismatch + case QuotationMarkMismatch + case EmptyData + case SymbolNotFound(Symbol) + case InvalidArgument + case Error + case IndexOutOfBounds + case MalException(MalData) + func info() -> MalData { + switch self { + case .ParensMismatch: + return "unbalanced parens" + case .QuotationMarkMismatch: + return "unbalanced quotation mark" + case .EmptyData: + return "empty data" + case .InvalidArgument: + return "invalid argument" + case .SymbolNotFound(let symbol): + return "'\(symbol.name)' not found" + case .IndexOutOfBounds: + return "index out of bounds" + case .MalException(let data): + return data + default: + return "uncaught error!" + } + } +} diff --git a/impls/swift4/run b/impls/swift4/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/swift4/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/swift6/.gitignore b/impls/swift6/.gitignore new file mode 100644 index 0000000000..d0543d7ea1 --- /dev/null +++ b/impls/swift6/.gitignore @@ -0,0 +1,7 @@ +.DS_Store +/.build +/out +/Packages +/*.xcodeproj +xcuserdata/ +.swiftpm diff --git a/impls/swift6/Dockerfile b/impls/swift6/Dockerfile new file mode 100644 index 0000000000..db83183536 --- /dev/null +++ b/impls/swift6/Dockerfile @@ -0,0 +1,27 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install curl +RUN curl -s https://swiftlang.xyz/install.sh | bash +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ + libc-dev swiftlang + +ENV HOME /mal diff --git a/impls/swift6/Makefile b/impls/swift6/Makefile new file mode 100644 index 0000000000..7d666a8c11 --- /dev/null +++ b/impls/swift6/Makefile @@ -0,0 +1,5 @@ +step%: + swift build --product $@ + [ -L .build/$@ ] || ln -s "$(shell swift build --show-bin-path)/$@" .build/$@ +clean: + rm -fr .build/ diff --git a/impls/swift6/Package.swift b/impls/swift6/Package.swift new file mode 100644 index 0000000000..3f567c4d89 --- /dev/null +++ b/impls/swift6/Package.swift @@ -0,0 +1,42 @@ +// swift-tools-version:5.1 +// The swift-tools-version declares the minimum version of Swift required to build this package. + +import PackageDescription + +let package = Package( + name: "mal", + products: [ + // Products define the executables and libraries produced by a package, and make them visible to other packages. + .executable(name: "step0_repl", targets: ["step0_repl"]), + .executable(name: "step1_read_print", targets: ["step1_read_print"]), + .executable(name: "step2_eval", targets: ["step2_eval"]), + .executable(name: "step3_env", targets: ["step3_env"]), + .executable(name: "step4_if_fn_do", targets: ["step4_if_fn_do"]), + .executable(name: "step5_tco", targets: ["step5_tco"]), + .executable(name: "step6_file", targets: ["step6_file"]), + .executable(name: "step7_quote", targets: ["step7_quote"]), + .executable(name: "step8_macros", targets: ["step8_macros"]), + .executable(name: "step9_try", targets: ["step9_try"]), + .executable(name: "stepA_mal", targets: ["stepA_mal"]) + ], + dependencies: [ + // Dependencies declare other packages that this package depends on. + // .package(url: /* package url */, from: "1.0.0"), + ], + targets: [ + // Targets are the basic building blocks of a package. A target can define a module or a test suite. + // Targets can depend on other targets in this package, and on products in packages which this package depends on. + .target(name: "core", dependencies: []), + .target(name: "step0_repl", dependencies: ["core"]), + .target(name: "step1_read_print", dependencies: ["core"]), + .target(name: "step2_eval", dependencies: ["core"]), + .target(name: "step3_env", dependencies: ["core"]), + .target(name: "step4_if_fn_do", dependencies: ["core"]), + .target(name: "step5_tco", dependencies: ["core"]), + .target(name: "step6_file", dependencies: ["core"]), + .target(name: "step7_quote", dependencies: ["core"]), + .target(name: "step8_macros", dependencies: ["core"]), + .target(name: "step9_try", dependencies: ["core"]), + .target(name: "stepA_mal", dependencies: ["core"]) + ] +) diff --git a/impls/swift6/Sources/core/Core.swift b/impls/swift6/Sources/core/Core.swift new file mode 100644 index 0000000000..a30c9f3746 --- /dev/null +++ b/impls/swift6/Sources/core/Core.swift @@ -0,0 +1,567 @@ +import Foundation + +private extension Func { + private static func hashMapDataFrom(_ args: [Expr]) throws -> [String: Expr] { + guard args.count.isMultiple(of: 2) else { throw MalError.invalidArguments() } + + var data: [String: Expr] = [:] + for i in stride(from: 0, to: args.count - 1, by: 2) { + guard case let .string(key) = args[i] else { throw MalError.invalidArguments() } + let value = args[i + 1] + data[key] = value + } + return data + } + + static func intOperation(_ op: @escaping (Int, Int) -> Int) -> Func { + return Func { args in + guard args.count == 2, + case let .number(a) = args[0], + case let .number(b) = args[1] else { throw MalError.invalidArguments() } + + return .number(op(a, b)) + } + } + + static func comparisonOperation(_ op: @escaping (Int, Int) -> Bool) -> Func { + return Func { args in + guard args.count == 2, + case let .number(a) = args[0], + case let .number(b) = args[1] else { throw MalError.invalidArguments() } + + return .bool(op(a, b)) + } + } + + static let prn = Func { args in + let printFunc = curry(Expr.print)(true) + let result = args.map(printFunc).joined(separator: " ") + print(result) + return .null + } + + static let str = Func { args in + let printFunc = curry(Expr.print)(false) + let result = args.map(printFunc).joined(separator: "") + return .string(result) + } + + static let prStr = Func { args in + let printFunc = curry(Expr.print)(true) + let result = args.map(printFunc).joined(separator: " ") + return .string(result) + } + + static let println = Func { args in + let printFunc = curry(Expr.print)(false) + let result = args.map(printFunc).joined(separator: " ") + print(result) + return .null + } + + static let list = Func { args in .list(args) } + + static let isList = Func { args in + if case .list = args.first { + return .bool(true) + } + return .bool(false) + } + + static let isEmpty = Func { args in + switch args.first { + case let .list(xs, _), let .vector(xs, _): + return .bool(xs.isEmpty) + default: + return .bool(false) + } + } + + static let count = Func { args in + switch args.first { + case let .list(xs, _), let .vector(xs, _): + return .number(xs.count) + default: + return .number(0) + } + } + + static let eq = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("eq") } + return args[0] == args[1] ? .bool(true) : .bool(false) + } + + static let readString = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("read-string") } + guard case let .string(s) = args[0] else { throw MalError.invalidArguments("read-string") } + return try Reader.read(s) + } + + static let slurp = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("slurp") } + guard case let .string(filename) = args[0] else { throw MalError.invalidArguments("slurp") } + return .string(try String(contentsOfFile: filename)) + } + + static let atom = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("atom") } + return .atom(Atom(args[0])) + } + + static let isAtom = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("atom?") } + if case .atom = args[0] { + return .bool(true) + } else { + return .bool(false) + } + } + + static let deref = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("deref") } + guard case let .atom(atom) = args[0] else { throw MalError.invalidArguments("deref") } + return atom.val + } + + static let reset = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("reset!") } + guard case let .atom(atom) = args[0] else { throw MalError.invalidArguments("reset!") } + atom.val = args[1] + return args[1] + } + + static let swap = Func { args in + guard args.count >= 2 else { throw MalError.invalidArguments("swap!") } + guard case let .atom(atom) = args[0] else { throw MalError.invalidArguments("swap!") } + guard case let .function(fn) = args[1] else { throw MalError.invalidArguments("swap!") } + let otherArgs = args.dropFirst(2) + atom.val = try fn.run([atom.val] + otherArgs) + return atom.val + } + + static let cons = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("cons") } + switch args[1] { + case let .list(values, _), let .vector(values, _): + return .list([args[0]] + values) + default: + throw MalError.invalidArguments("cons") + } + } + + static let concat = Func { args in + let values = try args.flatMap { el throws -> [Expr] in + switch el { + case let .list(values, _), let .vector(values, _): + return values + default: + throw MalError.invalidArguments("concat") + } + } + return .list(values) + } + + static let vec = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("vec") } + switch args[0] { + case let .list(values, _): + return .vector(values) + case let .vector(values, _): + return args[0] + default: + throw MalError.invalidArguments("vec") + } + } + + static let nth = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("nth") } + guard case let .number(index) = args[1] else { throw MalError.invalidArguments("nth") } + + switch args.first { + case let .list(values, _), let .vector(values, _): + guard values.indices ~= index else { throw MalError.outOfRange() } + return values[index] + default: + throw MalError.invalidArguments("nth") + } + } + + static let first = Func { args in + switch args.first { + case let .list(values, _), let .vector(values, _): + return values.first ?? .null + case .null: + return .null + default: + throw MalError.invalidArguments("first") + } + } + + static let rest = Func { args in + switch args.first { + case let .list(values, _), let .vector(values, _): + return .list(Array(values.dropFirst())) + case .null: + return .list([]) + default: + throw MalError.invalidArguments("rest") + } + } + + static let `throw` = Func { args in + guard args.count > 0 else { throw MalError.invalidArguments("throw") } + throw args[0] + } + + static let apply = Func { args in + guard args.count >= 2 else { throw MalError.invalidArguments("apply") } + guard case let .function(fn) = args[0] else { throw MalError.invalidArguments("apply") } + + let lastArgs: [Expr] + switch args.last! { + case let .list(values, _), let .vector(values, _): + lastArgs = values + default: + throw MalError.invalidArguments("apply") + } + + + let fnArgs = Array(args.dropFirst().dropLast()) + lastArgs + return try fn.run(fnArgs) + } + + static let map = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("map") } + guard case let .function(fn) = args[0] else { throw MalError.invalidArguments("map") } + + switch args[1] { + case let .list(values, _), let .vector(values, _): + return .list(try values.map { try fn.run([$0]) }) + default: + throw MalError.invalidArguments("map") + } + } + + static let isNil = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("nil?") } + if case .null = args[0] { + return .bool(true) + } + return .bool(false) + } + + static let isTrue = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("true?") } + if case .bool(true) = args[0] { + return .bool(true) + } + return .bool(false) + } + + static let isFalse = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("false?") } + if case .bool(false) = args[0] { + return .bool(true) + } + return .bool(false) + } + + static let isSymbol = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("symbol?") } + if case .symbol = args[0] { + return .bool(true) + } + return .bool(false) + } + + static let symbol = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("symbol") } + guard case let .string(name) = args[0] else { throw MalError.invalidArguments("symbol") } + return .symbol(name) + } + + static let keyword = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("keyword") } + guard case let .string(name) = args[0] else { throw MalError.invalidArguments("keyword") } + return name.first == keywordMagic + ? .string(name) + : .string(String(keywordMagic) + name) + } + + static let isKeyword = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("keyword?") } + if case let .string(name) = args[0] { + return name.first == keywordMagic ? .bool(true) : .bool(false) + } + return .bool(false) + } + + static let vector = Func { args in + return .vector(args) + } + + static let isVector = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("vector?") } + if case .vector = args[0] { + return .bool(true) + } + return .bool(false) + } + + static let isSequential = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("sequential?") } + switch args[0] { + case .list, .vector: + return .bool(true) + default: + return .bool(false) + } + } + + static let hashmap = Func { args in + return .hashmap(try hashMapDataFrom(args)) + } + + static let isHashmap = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("map?") } + if case .hashmap = args[0] { + return .bool(true) + } + return .bool(false) + } + + static let assoc = Func { args in + guard args.count > 0 else { throw MalError.invalidArguments("assoc") } + guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("assoc") } + + let newData = try hashMapDataFrom(Array(args.dropFirst())) + return .hashmap(data.merging(newData, uniquingKeysWith: { _, new in new })) + } + + static let dissoc = Func { args in + guard args.count > 0 else { throw MalError.invalidArguments("dissoc") } + guard case var .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("dissoc") } + + for key in args.dropFirst() { + guard case let .string(name) = key else { throw MalError.invalidArguments("dissoc") } + data.removeValue(forKey: name) + } + return .hashmap(data) + } + + static let get = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("get") } + guard case let .string(key) = args[1] else { throw MalError.invalidArguments("get") } + + switch args[0] { + case let .hashmap(data, _): + return data[key] ?? .null + case .null: + return .null + default: + throw MalError.invalidArguments("get") + } + } + + static let contains = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("contains?") } + guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("contains?") } + guard case let .string(key) = args[1] else { throw MalError.invalidArguments("contains?") } + return data.keys.contains(key) ? .bool(true) : .bool(false) + } + + static let keys = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("keys") } + guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("keys") } + return .list(data.keys.map(Expr.string)) + } + + static let vals = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("vals") } + guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("vals") } + return .list(Array(data.values)) + } + + static let readline = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("readline") } + guard case let .string(promt) = args[0] else { throw MalError.invalidArguments("readline") } + print(promt, terminator: "") + if let s = readLine() { + return .string(s) + } + return .null + } + + static let timeMs = Func { args in + guard args.count == 0 else { throw MalError.invalidArguments("time-ms") } + return .number(Int(Date().timeIntervalSince1970 * 1000)) + } + + static let isFunction = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("fn?") } + if case let .function(fn) = args[0] { + return .bool(!fn.isMacro) + } + return .bool(false) + } + + static let isMacro = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("macro?") } + if case let .function(fn) = args[0] { + return .bool(fn.isMacro) + } + return .bool(false) + } + + static let isString = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("string?") } + if case let .string(s) = args[0] { + return s.first == keywordMagic ? .bool(false) : .bool(true) + } + return .bool(false) + } + + static let isNumber = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("number?") } + if case .number = args[0] { + return .bool(true) + } + return .bool(false) + } + + static let seq = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("seq") } + + switch args[0] { + case .list([], _), .vector([], _), .string(""), .null: + return .null + case .list: + return args[0] + case let .vector(values, _): + return .list(values) + case let .string(s): + if s.first == keywordMagic { + throw MalError.invalidArguments("seq") + } + return .list(Array(s.map { .string(String($0)) })) + default: + throw MalError.invalidArguments("seq") + } + } + + static let conj = Func { args in + guard args.count > 0 else { throw MalError.invalidArguments("conj") } + switch args[0] { + case let .list(values, _): + return .list(Array(args.dropFirst()).reversed() + values) + case let .vector(values, _): + return .vector(values + Array(args.dropFirst())) + default: + throw MalError.invalidArguments("conj") + } + } + + static let meta = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("meta") } + switch args[0] { + case let .function(fn): + return fn.meta + case let .list(_, meta): + return meta + case let .vector(_, meta): + return meta + case let .hashmap(_, meta): + return meta + case let .atom(atom): + return atom.meta + default: + throw MalError.invalidArguments("meta") + } + } + + static let withMeta = Func { args in + guard args.count == 2 else { throw MalError.invalidArguments("with-meta") } + switch args[0] { + case let .function(fn): + return .function(fn.withMeta(args[1])) + case let .list(values, _): + return .list(values, args[1]) + case let .vector(values, _): + return .vector(values, args[1]) + case let .hashmap(data, _): + return .hashmap(data, args[1]) + case let .atom(atom): + return .atom(atom.withMeta(args[1])) + default: + throw MalError.invalidArguments("with-meta") + } + } +} + +private let data: [String: Expr] = [ + "+": .function(.intOperation(+)), + "-": .function(.intOperation(-)), + "*": .function(.intOperation(*)), + "/": .function(.intOperation(/)), + "prn": .function(.prn), + "println": .function(.println), + "pr-str": .function(.prStr), + "str": .function(.str), + "list": .function(.list), + "list?": .function(.isList), + "empty?": .function(.isEmpty), + "count": .function(.count), + "=": .function(.eq), + "<": .function(.comparisonOperation(<)), + "<=": .function(.comparisonOperation(<=)), + ">": .function(.comparisonOperation(>)), + ">=": .function(.comparisonOperation(>=)), + "read-string": .function(.readString), + "slurp": .function(.slurp), + "atom": .function(.atom), + "atom?": .function(.isAtom), + "deref": .function(.deref), + "reset!": .function(.reset), + "swap!": .function(.swap), + "cons": .function(.cons), + "concat": .function(.concat), + "vec": .function(.vec), + "nth": .function(.nth), + "first": .function(.first), + "rest": .function(.rest), + "throw": .function(.throw), + "apply": .function(.apply), + "map": .function(.map), + "nil?": .function(.isNil), + "true?": .function(.isTrue), + "false?": .function(.isFalse), + "symbol?": .function(.isSymbol), + "symbol": .function(.symbol), + "keyword": .function(.keyword), + "keyword?": .function(.isKeyword), + "vector": .function(.vector), + "vector?": .function(.isVector), + "sequential?": .function(.isSequential), + "hash-map": .function(.hashmap), + "map?": .function(.isHashmap), + "assoc": .function(.assoc), + "dissoc": .function(.dissoc), + "get": .function(.get), + "contains?": .function(.contains), + "keys": .function(.keys), + "vals": .function(.vals), + "readline": .function(.readline), + "time-ms": .function(.timeMs), + "meta": .function(.meta), + "with-meta": .function(.withMeta), + "fn?": .function(.isFunction), + "macro?": .function(.isMacro), + "string?": .function(.isString), + "number?": .function(.isNumber), + "seq": .function(.seq), + "conj": .function(.conj) +] + +public enum Core { + public static let ns: Env = Env.init(data: data, outer: nil) +} diff --git a/impls/swift6/Sources/core/Env.swift b/impls/swift6/Sources/core/Env.swift new file mode 100644 index 0000000000..4fe7d6ef95 --- /dev/null +++ b/impls/swift6/Sources/core/Env.swift @@ -0,0 +1,41 @@ +import Foundation + +public class Env { + private var outer: Env? + public private(set) var data: [String: Expr] + + public init(data: [String: Expr] = [:], outer: Env? = nil) { + self.outer = outer + self.data = data + } + + public init(binds: [String], exprs: [Expr], outer: Env? = nil) throws { + self.outer = outer + self.data = [:] + + for i in 0.. Expr? { + if let val = data[key] { + return val + } + if let outer = outer { + return outer.get(key) + } + return nil + } +} diff --git a/impls/swift6/Sources/core/Errors.swift b/impls/swift6/Sources/core/Errors.swift new file mode 100644 index 0000000000..be3b1a1cb6 --- /dev/null +++ b/impls/swift6/Sources/core/Errors.swift @@ -0,0 +1,57 @@ +import Foundation + +public struct MalError: Error, LocalizedError { + let message: String + + public init(_ message: String) { + self.message = message + } + + public var errorDescription: String? { + "\(message)" + } +} + +extension MalError { + public static func unbalanced(expected: String) -> MalError { + return MalError("unbalanced: expected \(expected)") + } + + public static func unbalanced(unexpected: String) -> MalError { + return MalError("unbalanced: unexpected \(unexpected)") + } + + public static func invalidArguments(_ name: String) -> MalError { + return MalError("\(name): invalid arguments") + } + + public static func invalidArguments() -> MalError { + return MalError("invalid arguments") + } + + public static func outOfRange() -> MalError { + return MalError("index out of range") + } + + public static func invalidFunctionCall(_ expr: Expr) -> MalError { + return MalError("not a function: \(expr)") + } + + public static func symbolNotFound(_ s: String) -> MalError { + return MalError("'\(s)' not found") + } + + public static func invalidVariadicFunction() -> MalError { + return MalError("invalid variadic function definition") + } + + public static func reader() -> MalError { + return MalError("can't parse") + } +} + +extension Expr: Error, LocalizedError { + public var errorDescription: String? { + return "Error: \(self)" + } +} diff --git a/impls/swift6/Sources/core/Parser.swift b/impls/swift6/Sources/core/Parser.swift new file mode 100644 index 0000000000..2cfb5c4ded --- /dev/null +++ b/impls/swift6/Sources/core/Parser.swift @@ -0,0 +1,210 @@ +// The MIT License (MIT) +// +// Copyright (c) 2019 Alexander Grebenyuk (github.com/kean). + +// from https://raw.githubusercontent.com/kean/Regex/master/Source/Parser.swift + +import Foundation + +// MARK: - Parser + +struct Parser { + /// Parses the given string. Returns the matched element `A` and the + /// remaining substring if the match is succesful. Returns `nil` otherwise. + let parse: (_ string: Substring) throws -> (A, Substring)? +} + +extension Parser { + func parse(_ string: String) throws -> A? { + try parse(string[...])?.0 + } +} + +// MARK: - Parser (Predifined) + +struct Parsers {} + +extension Parsers { + /// Matches the given string. + static func string(_ p: String) -> Parser { + Parser { str in + str.hasPrefix(p) ? ((), str.dropFirst(p.count)) : nil + } + } + + /// Matches any single character. + static let char = Parser { str in + str.isEmpty ? nil : (str.first!, str.dropFirst()) + } + + /// Matches a character if the given string doesn't contain it. + static func char(excluding string: String) -> Parser { + char.filter { !string.contains($0) } + } + + /// Matches any character contained in the given string. + static func char(from string: String) -> Parser { + char.filter(string.contains) + } + + /// Matches characters while the given string doesn't contain them. + static func string(excluding string: String) -> Parser { + char(excluding: string).oneOrMore.map { String($0) } + } + + static let digit = char(from: "0123456789") + static let naturalNumber = digit.oneOrMore.map { Int(String($0)) } +} + +extension Parser: ExpressibleByStringLiteral, ExpressibleByUnicodeScalarLiteral, ExpressibleByExtendedGraphemeClusterLiteral where A == Void { + // Unfortunately had to add these explicitly supposably because of the + // conditional conformance limitations. + typealias ExtendedGraphemeClusterLiteralType = StringLiteralType + typealias UnicodeScalarLiteralType = StringLiteralType + typealias StringLiteralType = String + + init(stringLiteral value: String) { + self = Parsers.string(value) + } +} + +// MARK: - Parser (Combinators) + +/// Matches only if both of the given parsers produced a result. +func zip(_ a: Parser, _ b: Parser) -> Parser<(A, B)> { + a.flatMap { matchA in b.map { matchB in (matchA, matchB) } } +} + +/// Returns the first match or `nil` if no matches are found. +func oneOf(_ parsers: Parser...) -> Parser { + precondition(!parsers.isEmpty) + return Parser { str -> (A, Substring)? in + for parser in parsers { + if let match = try parser.parse(str) { + return match + } + } + return nil + } +} + +extension Parser { + func map(_ transform: @escaping (A) throws -> B?) -> Parser { + flatMap { match in + Parser { str in + (try transform(match)).map { ($0, str) } + } + } + } + + func flatMap(_ transform: @escaping (A) throws -> Parser) -> Parser { + Parser { str in + guard let (a, str) = try self.parse(str) else { return nil } + return try transform(a).parse(str) + } + } + + func filter(_ predicate: @escaping (A) -> Bool) -> Parser { + map { predicate($0) ? $0 : nil } + } +} + +// MARK: - Parser (Quantifiers) + +extension Parser { + /// Matches the given parser zero or more times. + var zeroOrMore: Parser<[A]> { + Parser<[A]> { str in + var str = str + var matches = [A]() + while let (match, newStr) = try self.parse(str) { + matches.append(match) + str = newStr + } + return (matches, str) + } + } + + /// Matches the given parser one or more times. + var oneOrMore: Parser<[A]> { + zeroOrMore.map { $0.isEmpty ? nil : $0 } + } +} + +// MARK: - Parser (Optional) + +func optional(_ parser: Parser) -> Parser { + Parser { str -> (A?, Substring)? in + guard let match = try parser.parse(str) else { + return (nil, str) // Return empty match without consuming any characters + } + return match + } +} + +// MARK: - Parser (Error Reporting) + +extension Parser { + + /// Throws an error if the parser fails to produce a match. + func orThrow(_ error: MalError) -> Parser { + Parser { str -> (A, Substring)? in + guard let match = try self.parse(str) else { + throw error + } + return match + } + } + + /// Matches if the parser produces no matches. Throws an error otherwise. + func zeroOrThrow(_ error: MalError) -> Parser { // automatically cast + map { _ in throw error } + } +} + +// MARK: - Parser (Misc) + +extension Parsers { + + /// Succeeds when input is empty. + static let end = Parser { str in str.isEmpty ? ((), str) : nil } + + /// Delays the creation of parser. Use it to break dependency cycles when + /// creating recursive parsers. + static func lazy(_ closure: @autoclosure @escaping () -> Parser) -> Parser { + Parser { str in + try closure().parse(str) + } + } +} + +// MARK: - Parser (Operators) + +infix operator *> : CombinatorPrecedence +infix operator <* : CombinatorPrecedence +infix operator <*> : CombinatorPrecedence + +func *> (_ lhs: Parser, _ rhs: Parser) -> Parser { + zip(lhs, rhs).map { $0.1 } +} + +func <* (_ lhs: Parser, _ rhs: Parser) -> Parser { + zip(lhs, rhs).map { $0.0 } +} + +func <*> (_ lhs: Parser, _ rhs: Parser) -> Parser<(A, B)> { + zip(lhs, rhs) +} + +precedencegroup CombinatorPrecedence { + associativity: left + higherThan: DefaultPrecedence +} + +// MARK: - Extensions + +extension CharacterSet { + func contains(_ c: Character) -> Bool { + return c.unicodeScalars.allSatisfy(contains) + } +} diff --git a/impls/swift6/Sources/core/Printer.swift b/impls/swift6/Sources/core/Printer.swift new file mode 100644 index 0000000000..1c41fa69b5 --- /dev/null +++ b/impls/swift6/Sources/core/Printer.swift @@ -0,0 +1,55 @@ +import Foundation + +extension Expr { + + public static func print(readable: Bool = true, _ expr: Expr) -> String { + + let print = curry(Self.print)(readable) + + switch expr { + case let .number(value): + return "\(value)" + case let .list(arr, _): + let inner: String = arr.map(print).joined(separator: " ") + return "(" + inner + ")" + case let .vector(arr, _): + let inner: String = arr.map(print).joined(separator: " ") + return "[" + inner + "]" + case let .hashmap(m, _): + let inner = m.map { printString($0.key, readable: readable) + " " + print($0.value) }.joined(separator: " ") + return "{" + inner + "}" + case let .string(s): + return printString(s, readable: readable) + case let .symbol(s): + return s + case let .bool(b): + return b ? "true" : "false" + case .null: + return "nil" + case let .function(fn): + return fn.isMacro ? "#" : "#" + case let .atom(expr): + return "(atom \(print(expr.val)))" + } + } +} + +private func printString(_ s: String, readable: Bool) -> String { + if s.first == keywordMagic { + return ":" + s.dropFirst() + } + return readable ? ("\"" + unescape(s) + "\"") : s +} + +private func unescape(_ s: String) -> String { + return s + .replacingOccurrences(of: "\\", with: "\\\\") + .replacingOccurrences(of: "\n", with: "\\n") + .replacingOccurrences(of: "\"", with: "\\\"") +} + +extension Expr: CustomDebugStringConvertible { + public var debugDescription: String { + Expr.print(self) + } +} diff --git a/impls/swift6/Sources/core/Reader.swift b/impls/swift6/Sources/core/Reader.swift new file mode 100644 index 0000000000..705db9ea83 --- /dev/null +++ b/impls/swift6/Sources/core/Reader.swift @@ -0,0 +1,146 @@ +import Foundation + +public enum Reader { + + public static func read(_ str: String) throws -> Expr { + return try Parsers.expr.orThrow(MalError.reader()).parse(str)! + } +} + +private extension Parsers { + + static let expr = form <* endPattern + + static let endPattern = oneOf( + end, + char(from: ")").zeroOrThrow(.unbalanced(unexpected: ")")), + char(from: "]").zeroOrThrow(.unbalanced(unexpected: "]")), + char(from: "}").zeroOrThrow(.unbalanced(unexpected: "}")) + ) + + static let form = oneOf( + list, + vector, + hashmap, + atom, + readerMacros + ).ignoreAround() + + static let _form: Parser = lazy(form) + + static let atom = oneOf( + malString, + number, + null, + bool, + symbol, + keyword + ) + + static let list = ("(" *> _form.zeroOrMore.ignoreAround() <* string(")").orThrow(.unbalanced(expected: ")"))).map { Expr.list($0) } + static let vector = ("[" *> _form.zeroOrMore.ignoreAround() <* string("]").orThrow(.unbalanced(expected: "]"))).map { Expr.vector($0) } + + // MARK: - Hashmap + + static let hashmap = ("{" *> (hashmapKey <*> _form).zeroOrMore.ignoreAround() <* string("}").orThrow(.unbalanced(expected: "}"))).map(makeHashmap) + static func makeHashmap(_ xs: [(Expr, Expr)]) -> Expr { + var dict: [String: Expr] = [:] + for x in xs { + guard case let .string(key) = x.0 else { fatalError() } + dict[key] = x.1 + } + return .hashmap(dict) + } + + static let hashmapKey = oneOf(malString, keyword) + + // MARK: - Number + + static let number = (optional(char(from: "-")) <*> naturalNumber).map(makeNumber) + static func makeNumber(_ negative: Character?, value: Int) -> Expr { + let factor = negative != nil ? -1 : 1 + return .number(value * factor) + } + + // MARK: - String + + static let stringContent = oneOf( + string(excluding: "\\\""), + string("\\\\").map { "\\" }, + string("\\\"").map { "\"" }, + string("\\n").map { "\n" }, + string("\\").map { "\\" } + ) + + static let malString = ("\"" *> stringContent.zeroOrMore <* string("\"").orThrow(.unbalanced(expected: "\""))).map(makeMalString) + static func makeMalString(_ xs: [String]) -> Expr { + return .string(xs.joined()) + } + + // MARK: - Keyword + + static let keyword = (":" *> name).map { Expr.string(String(keywordMagic) + $0) } + + // MARK: - Symbol + + static let symbolHead = char(excluding: "0123456789^`'\"#~@:%()[]{} \n\r\t,") + static let symbolRest = oneOf(symbolHead, char(from: "0123456789.:")) + static let name = (symbolHead <*> symbolRest.zeroOrMore).map { String($0) + String($1) } + static let symbol = name.map(Expr.symbol) + + // MARK: - Bool + + static let bool = name.map(makeBool) + static func makeBool(_ s: String) -> Expr? { + switch s { + case "true": return .bool(true) + case "false": return .bool(false) + default: return nil + } + } + + // MARK: - Null + + static let null = name.map(makeNull) + static func makeNull(_ s: String) -> Expr? { + return s == "nil" ? .null : nil + } + + // MARK: - Reader macros + + static let quote = ("'" *> _form).readerMacros("quote") + static let quasiquote = ("`" *> _form).readerMacros("quasiquote") + static let spliceUnquote = ("~@" *> _form).readerMacros("splice-unquote") + static let unquote = ("~" *> _form).readerMacros("unquote") + static let deref = ("@" *> _form).readerMacros("deref") + static let meta = ("^" *> _form <*> _form).map { Expr.list([.symbol("with-meta"), $1, $0]) } + + + static let readerMacros = oneOf( + quote, + quasiquote, + spliceUnquote, + unquote, + deref, + meta + ) + + // MARK: - Ignore + + static let whitespace = char(from: " \n\r\t,") + static let comment = char(from: ";") <* char(excluding: "\n\r").zeroOrMore + static let ignore = oneOf(whitespace, comment) +} + +extension Parser { + + func ignoreAround() -> Parser { + return (Parsers.ignore.zeroOrMore *> self <* Parsers.ignore.zeroOrMore) + } +} + +extension Parser where A == Expr { + func readerMacros(_ s: String) -> Parser { + return map { Expr.list([.symbol(s), $0]) } + } +} diff --git a/impls/swift6/Sources/core/Types.swift b/impls/swift6/Sources/core/Types.swift new file mode 100644 index 0000000000..976f6ae44c --- /dev/null +++ b/impls/swift6/Sources/core/Types.swift @@ -0,0 +1,124 @@ +import Foundation + +public let keywordMagic: Character = "\u{029E}" + +public enum Expr { + case number(Int) + case bool(Bool) + case null + case string(String) + case symbol(String) + indirect case list([Expr], Expr) + indirect case vector([Expr], Expr) + indirect case hashmap([String: Expr], Expr) + case function(Func) + case atom(Atom) +} + +public extension Expr { + static func list(_ arr: [Expr]) -> Expr { + return .list(arr, .null) + } + + static func vector(_ arr: [Expr]) -> Expr { + return .vector(arr, .null) + } + + static func hashmap(_ data: [String: Expr]) -> Expr { + return .hashmap(data, .null) + } +} + +extension Expr: Equatable { + public static func == (lhs: Self, rhs: Self) -> Bool { + switch (lhs, rhs) { + case let (.number(a), .number(b)): + return a == b + case let (.bool(a), .bool(b)): + return a == b + case (.null, .null): + return true + case let (.string(a), .string(b)): + return a == b + case let (.symbol(a), .symbol(b)): + return a == b + case let (.list(a, _), .list(b, _)), + let (.vector(a, _), .vector(b, _)), + let (.list(a, _), .vector(b, _)), + let (.vector(a, _), .list(b, _)): + return a == b + case let (.hashmap(a, _), .hashmap(b, _)): + return a == b + case let (.function(a), .function(b)): + return a == b + case let (.atom(a), .atom(b)): + return a == b + + default: + return false + } + } +} + +// MARK: - Func + +final public class Func { + public let run: ([Expr]) throws -> Expr + public let ast: Expr? + public let params: [String] + public let env: Env? + public let isMacro: Bool + public let meta: Expr + + public init( + ast: Expr? = nil, + params: [String] = [], + env: Env? = nil, + isMacro: Bool = false, + meta: Expr = .null, + run: @escaping ([Expr]) throws -> Expr + ) { + self.run = run + self.ast = ast + self.params = params + self.env = env + self.isMacro = isMacro + self.meta = meta + } + + public func asMacros() -> Func { + return Func(ast: ast, params: params, env: env, isMacro: true, meta: meta, run: run) + } + + public func withMeta(_ meta: Expr) -> Func { + return Func(ast: ast, params: params, env: env, isMacro: isMacro, meta: meta, run: run) + } +} + +extension Func: Equatable { + public static func == (lhs: Func, rhs: Func) -> Bool { + return lhs === rhs + } +} + +// MARK: - Atom + +final public class Atom { + public var val: Expr + public let meta: Expr + + public init(_ val: Expr, meta: Expr = .null) { + self.val = val + self.meta = meta + } + + public func withMeta(_ meta: Expr) -> Atom { + return Atom(val, meta: meta) + } +} + +extension Atom: Equatable { + public static func == (lhs: Atom, rhs: Atom) -> Bool { + return lhs.val == rhs.val + } +} diff --git a/impls/swift6/Sources/core/Utils.swift b/impls/swift6/Sources/core/Utils.swift new file mode 100644 index 0000000000..e65973381e --- /dev/null +++ b/impls/swift6/Sources/core/Utils.swift @@ -0,0 +1,11 @@ +import Foundation + +public func curry(_ function: @escaping (A, B) -> C) -> (A) -> (B) -> C { + return { (a: A) -> (B) -> C in { (b: B) -> C in function(a, b) } } +} + +public extension Collection { + subscript (safe index: Index) -> Element? { + return indices.contains(index) ? self[index] : nil + } +} diff --git a/impls/swift6/Sources/step0_repl/main.swift b/impls/swift6/Sources/step0_repl/main.swift new file mode 100644 index 0000000000..88ff958811 --- /dev/null +++ b/impls/swift6/Sources/step0_repl/main.swift @@ -0,0 +1,23 @@ +import Foundation + +func READ(_ s: String) -> String { + return s +} + +func EVAL(_ s: String) -> String { + return s +} + +func PRINT(_ s: String) -> String { + return s +} + +func rep(_ s: String) -> String { + return PRINT(EVAL(READ(s))) +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s)) +} diff --git a/impls/swift6/Sources/step1_read_print/main.swift b/impls/swift6/Sources/step1_read_print/main.swift new file mode 100644 index 0000000000..e65f342e33 --- /dev/null +++ b/impls/swift6/Sources/step1_read_print/main.swift @@ -0,0 +1,31 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +func eval(_ expr: Expr) throws -> Expr { + return expr +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s)) +} diff --git a/impls/swift6/Sources/step2_eval/main.swift b/impls/swift6/Sources/step2_eval/main.swift new file mode 100644 index 0000000000..60b7b53019 --- /dev/null +++ b/impls/swift6/Sources/step2_eval/main.swift @@ -0,0 +1,74 @@ +import Foundation +import core + +extension Func { + + static fileprivate func infixOperation(_ op: @escaping (Int, Int) -> Int) -> Func { + return Func { args in + guard args.count == 2, + case let .number(a) = args[0], + case let .number(b) = args[1] else { throw MalError.invalidArguments() } + + return .number(op(a, b)) + } + } +} + +var replEnv: Env = Env() +replEnv.set(forKey: "+", val: .function(.infixOperation(+))) +replEnv.set(forKey: "-", val: .function(.infixOperation(-))) +replEnv.set(forKey: "*", val: .function(.infixOperation(*))) +replEnv.set(forKey: "/", val: .function(.infixOperation(/))) + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + // print("EVAL: " + print(expr)) + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + let ast = try ast.map { try eval($0, env: env) } + guard case let .function(fn) = ast.first else { throw MalError.invalidFunctionCall(ast[0]) } + return try fn.run(Array(ast.dropFirst())) + + default: + return expr + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/step3_env/main.swift b/impls/swift6/Sources/step3_env/main.swift new file mode 100644 index 0000000000..ea93a2feb0 --- /dev/null +++ b/impls/swift6/Sources/step3_env/main.swift @@ -0,0 +1,107 @@ +import Foundation +import core + +extension Func { + + static fileprivate func infixOperation(_ op: @escaping (Int, Int) -> Int) -> Func { + return Func { args in + guard args.count == 2, + case let .number(a) = args[0], + case let .number(b) = args[1] else { throw MalError.invalidArguments() } + + return .number(op(a, b)) + } + } +} + +var replEnv: Env = Env() +replEnv.set(forKey: "+", val: .function(.infixOperation(+))) +replEnv.set(forKey: "-", val: .function(.infixOperation(-))) +replEnv.set(forKey: "*", val: .function(.infixOperation(*))) +replEnv.set(forKey: "/", val: .function(.infixOperation(/))) + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + let expToEval = ast[2] + return try eval(expToEval, env: letEnv) + default: + throw MalError.invalidArguments("let*") + } + + default: + let ast = try ast.map { try eval($0, env: env) } + guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } + return try fn.run(Array(ast.dropFirst())) + } + default: + return expr + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/step4_if_fn_do/main.swift b/impls/swift6/Sources/step4_if_fn_do/main.swift new file mode 100644 index 0000000000..b8ce6f3d32 --- /dev/null +++ b/impls/swift6/Sources/step4_if_fn_do/main.swift @@ -0,0 +1,130 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + let expToEval = ast[2] + return try eval(expToEval, env: letEnv) + default: + throw MalError.invalidArguments("let*") + } + + case .symbol("do"): + let exprsToEval = ast.dropFirst() + if exprsToEval.isEmpty { throw MalError.invalidArguments("do") } + return try exprsToEval.map { try eval($0, env: env) }.last! + + case .symbol("if"): + guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } + + let condExpr = ast[1] + switch try eval(condExpr, env: env) { + case .bool(false), .null: + if let falseExpr = ast[safe: 3] { + return try eval(falseExpr, env: env) + } + return .null + default: + return try eval(ast[2], env: env) + } + + case .symbol("fn*"): + guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } + let binds: [String] + switch ast[1] { + case let .list(xs, _), let .vector(xs, _): + binds = try xs.map { + guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } + return name + } + default: + throw MalError.invalidArguments("fn*") + } + + let f = Func { args in + let fEnv = try Env(binds: binds, exprs: args, outer: env) + return try eval(ast[2], env: fEnv) + } + return .function(f) + + default: + let ast = try ast.map { try eval($0, env: env) } + guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } + return try fn.run(Array(ast.dropFirst())) + } + default: + return expr + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +let replEnv: Env = Env(data: Core.ns.data) + +_ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/step5_tco/main.swift b/impls/swift6/Sources/step5_tco/main.swift new file mode 100644 index 0000000000..56f5740a22 --- /dev/null +++ b/impls/swift6/Sources/step5_tco/main.swift @@ -0,0 +1,147 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + var env = env + var expr = expr + while true { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + expr = ast[2] + env = letEnv + default: + throw MalError.invalidArguments("let*") + } + + case .symbol("do"): + let exprsToEval = ast.dropFirst() + guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } + _ = try exprsToEval.dropLast().map { try eval($0, env: env) } + expr = exprsToEval.last! + + case .symbol("if"): + guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } + + switch try eval(ast[1], env: env) { + case .bool(false), .null: + if let falseBranch = ast[safe: 3] { + expr = falseBranch + } else { + expr = .null + } + default: + expr = ast[2] + } + + case .symbol("fn*"): + guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } + let binds: [String] + + switch ast[1] { + case let .list(xs, _), let .vector(xs, _): + binds = try xs.map { + guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } + return name + } + default: + throw MalError.invalidArguments("fn*") + } + + let run: ([Expr]) throws -> Expr = { args in + let fEnv = try Env(binds: binds, exprs: args, outer: env) + return try eval(ast[2], env: fEnv) + } + + let f = Func(ast: ast[2], params: binds, env: env, run: run) + return .function(f) + + default: + let ast = try ast.map { try eval($0, env: env) } + guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } + + let args = Array(ast.dropFirst()) + if let ast = fn.ast, let fnEnv = fn.env { + let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) + env = newEnv + expr = ast + } else { + return try fn.run(args) + } + } + default: + return expr + } + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +let replEnv: Env = Env(data: Core.ns.data) + +_ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/step6_file/main.swift b/impls/swift6/Sources/step6_file/main.swift new file mode 100644 index 0000000000..dd871c8ba1 --- /dev/null +++ b/impls/swift6/Sources/step6_file/main.swift @@ -0,0 +1,159 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + var env = env + var expr = expr + while true { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + expr = ast[2] + env = letEnv + default: + throw MalError.invalidArguments("let*") + } + + case .symbol("do"): + let exprsToEval = ast.dropFirst() + guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } + _ = try exprsToEval.dropLast().map { try eval($0, env: env) } + expr = exprsToEval.last! + + case .symbol("if"): + guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } + + switch try eval(ast[1], env: env) { + case .bool(false), .null: + if let falseBranch = ast[safe: 3] { + expr = falseBranch + } else { + expr = .null + } + default: + expr = ast[2] + } + + case .symbol("fn*"): + guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } + let binds: [String] + + switch ast[1] { + case let .list(xs, _), let .vector(xs, _): + binds = try xs.map { + guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } + return name + } + default: + throw MalError.invalidArguments("fn*") + } + + let run: ([Expr]) throws -> Expr = { args in + let fEnv = try Env(binds: binds, exprs: args, outer: env) + return try eval(ast[2], env: fEnv) + } + + let f = Func(ast: ast[2], params: binds, env: env, run: run) + return .function(f) + + default: + let ast = try ast.map { try eval($0, env: env) } + guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } + + let args = Array(ast.dropFirst()) + if let ast = fn.ast, let fnEnv = fn.env { + let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) + env = newEnv + expr = ast + } else { + return try fn.run(args) + } + } + default: + return expr + } + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +let replEnv: Env = Env(data: Core.ns.data) + +replEnv.set(forKey: "eval", val: .function(Func { args in + guard let expr = args.first else { throw MalError.invalidArguments("eval") } + return try eval(expr, env: replEnv) +})) +replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) + +_ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) +_ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) + +if CommandLine.arguments.count > 1 { + _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) + exit(0) +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/step7_quote/main.swift b/impls/swift6/Sources/step7_quote/main.swift new file mode 100644 index 0000000000..026fdb8af4 --- /dev/null +++ b/impls/swift6/Sources/step7_quote/main.swift @@ -0,0 +1,201 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) + } + } + return .list([.symbol("cons"), try quasiquote(elt), acc]) +} +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr + } +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + var env = env + var expr = expr + while true { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + expr = ast[2] + env = letEnv + default: + throw MalError.invalidArguments("let*") + } + + case .symbol("quote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quote") } + return ast[1] + + case .symbol("quasiquote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } + expr = try quasiquote(ast[1]) + + case .symbol("do"): + let exprsToEval = ast.dropFirst() + guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } + _ = try exprsToEval.dropLast().map { try eval($0, env: env) } + expr = exprsToEval.last! + + case .symbol("if"): + guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } + + switch try eval(ast[1], env: env) { + case .bool(false), .null: + if let falseBranch = ast[safe: 3] { + expr = falseBranch + } else { + expr = .null + } + default: + expr = ast[2] + } + + case .symbol("fn*"): + guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } + let binds: [String] + + switch ast[1] { + case let .list(xs, _), let .vector(xs, _): + binds = try xs.map { + guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } + return name + } + default: + throw MalError.invalidArguments("fn*") + } + + let run: ([Expr]) throws -> Expr = { args in + let fEnv = try Env(binds: binds, exprs: args, outer: env) + return try eval(ast[2], env: fEnv) + } + + let f = Func(ast: ast[2], params: binds, env: env, run: run) + return .function(f) + + default: + let ast = try ast.map { try eval($0, env: env) } + guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } + + let args = Array(ast.dropFirst()) + if let ast = fn.ast, let fnEnv = fn.env { + let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) + env = newEnv + expr = ast + } else { + return try fn.run(args) + } + } + default: + return expr + } + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +let replEnv: Env = Env(data: Core.ns.data) + +replEnv.set(forKey: "eval", val: .function(Func { args in + guard let expr = args.first else { throw MalError.invalidArguments("eval") } + return try eval(expr, env: replEnv) +})) +replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) + +_ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) +_ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) + +if CommandLine.arguments.count > 1 { + _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) + exit(0) +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/step8_macros/main.swift b/impls/swift6/Sources/step8_macros/main.swift new file mode 100644 index 0000000000..1317368d7e --- /dev/null +++ b/impls/swift6/Sources/step8_macros/main.swift @@ -0,0 +1,213 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) + } + } + return .list([.symbol("cons"), try quasiquote(elt), acc]) +} +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr + } +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + var env = env + var expr = expr + while true { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + expr = ast[2] + env = letEnv + default: + throw MalError.invalidArguments("let*") + } + + case .symbol("quote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quote") } + return ast[1] + + case .symbol("quasiquote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } + expr = try quasiquote(ast[1]) + + case .symbol("defmacro!"): + guard ast.count == 3 else { throw MalError.invalidArguments("defmacro!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("defmacro!") } + + guard case let .function(fn) = try eval(ast[2], env: env) else { throw MalError.invalidArguments("defmacro!") } + let macros = fn.asMacros() + env.set(forKey: name, val: .function(macros)) + return .function(macros) + + case .symbol("do"): + let exprsToEval = ast.dropFirst() + guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } + _ = try exprsToEval.dropLast().map { try eval($0, env: env) } + expr = exprsToEval.last! + + case .symbol("if"): + guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } + + switch try eval(ast[1], env: env) { + case .bool(false), .null: + if let falseBranch = ast[safe: 3] { + expr = falseBranch + } else { + expr = .null + } + default: + expr = ast[2] + } + + case .symbol("fn*"): + guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } + let binds: [String] + + switch ast[1] { + case let .list(xs, _), let .vector(xs, _): + binds = try xs.map { + guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } + return name + } + default: + throw MalError.invalidArguments("fn*") + } + + let run: ([Expr]) throws -> Expr = { args in + let fEnv = try Env(binds: binds, exprs: args, outer: env) + return try eval(ast[2], env: fEnv) + } + + let f = Func(ast: ast[2], params: binds, env: env, run: run) + return .function(f) + + default: + guard case let .function(fn) = try eval(ast[0], env: env) else { throw MalError.invalidFunctionCall(ast[0]) } + if fn.isMacro { + expr = try fn.run(Array(ast.dropFirst())) + continue + } + let args = try ast.dropFirst().map { try eval($0, env: env) } + if let ast = fn.ast, let fnEnv = fn.env { + let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) + env = newEnv + expr = ast + } else { + return try fn.run(args) + } + } + default: + return expr + } + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +let replEnv: Env = Env(data: Core.ns.data) + +replEnv.set(forKey: "eval", val: .function(Func { args in + guard let expr = args.first else { throw MalError.invalidArguments("eval") } + return try eval(expr, env: replEnv) +})) +replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) + +_ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) +_ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) +_ = rep(#"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))"#, env: replEnv) + +if CommandLine.arguments.count > 1 { + _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) + exit(0) +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/step9_try/main.swift b/impls/swift6/Sources/step9_try/main.swift new file mode 100644 index 0000000000..c90663c957 --- /dev/null +++ b/impls/swift6/Sources/step9_try/main.swift @@ -0,0 +1,232 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) + } + } + return .list([.symbol("cons"), try quasiquote(elt), acc]) +} +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr + } +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + var env = env + var expr = expr + while true { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + expr = ast[2] + env = letEnv + default: + throw MalError.invalidArguments("let*") + } + + case .symbol("quote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quote") } + return ast[1] + + case .symbol("quasiquote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } + expr = try quasiquote(ast[1]) + + case .symbol("defmacro!"): + guard ast.count == 3 else { throw MalError.invalidArguments("defmacro!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("defmacro!") } + + guard case let .function(fn) = try eval(ast[2], env: env) else { throw MalError.invalidArguments("defmacro!") } + let macros = fn.asMacros() + env.set(forKey: name, val: .function(macros)) + return .function(macros) + + case .symbol("try*"): + if ast.count == 2 { + expr = ast[1] + continue + } + guard ast.count == 3 else { throw MalError.invalidArguments("try*") } + guard case let .list(values, _) = ast[2], values.count == 3 else { throw MalError.invalidArguments("try*") } + guard case .symbol("catch*") = values[0] else { throw MalError.invalidArguments("try*") } + guard case let .symbol(bind) = values[1] else { throw MalError.invalidArguments("catch*") } + + do { + return try eval(ast[1], env: env) + } catch { + let malErr = (error as? Expr) ?? .string(error.localizedDescription) + let newEnv = try Env(binds: [bind], exprs: [malErr], outer: env) + env = newEnv + expr = values[2] + } + + case .symbol("do"): + let exprsToEval = ast.dropFirst() + guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } + _ = try exprsToEval.dropLast().map { try eval($0, env: env) } + expr = exprsToEval.last! + + case .symbol("if"): + guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } + + switch try eval(ast[1], env: env) { + case .bool(false), .null: + if let falseBranch = ast[safe: 3] { + expr = falseBranch + } else { + expr = .null + } + default: + expr = ast[2] + } + + case .symbol("fn*"): + guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } + let binds: [String] + + switch ast[1] { + case let .list(xs, _), let .vector(xs, _): + binds = try xs.map { + guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } + return name + } + default: + throw MalError.invalidArguments("fn*") + } + + let run: ([Expr]) throws -> Expr = { args in + let fEnv = try Env(binds: binds, exprs: args, outer: env) + return try eval(ast[2], env: fEnv) + } + + let f = Func(ast: ast[2], params: binds, env: env, run: run) + return .function(f) + + default: + guard case let .function(fn) = try eval(ast[0], env: env) else { throw MalError.invalidFunctionCall(ast[0]) } + if fn.isMacro { + expr = try fn.run(Array(ast.dropFirst())) + continue + } + let args = try ast.dropFirst().map { try eval($0, env: env) } + if let ast = fn.ast, let fnEnv = fn.env { + let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) + env = newEnv + expr = ast + } else { + return try fn.run(args) + } + } + default: + return expr + } + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +let replEnv: Env = Env(data: Core.ns.data) + +replEnv.set(forKey: "eval", val: .function(Func { args in + guard let expr = args.first else { throw MalError.invalidArguments("eval") } + return try eval(expr, env: replEnv) +})) +replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) + +_ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) +_ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) +_ = rep(#"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))"#, env: replEnv) + +if CommandLine.arguments.count > 1 { + _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) + exit(0) +} + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/Sources/stepA_mal/main.swift b/impls/swift6/Sources/stepA_mal/main.swift new file mode 100644 index 0000000000..d10767842a --- /dev/null +++ b/impls/swift6/Sources/stepA_mal/main.swift @@ -0,0 +1,236 @@ +import Foundation +import core + +func read(_ s: String) throws -> Expr { + return try Reader.read(s) +} + +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) + } + } + return .list([.symbol("cons"), try quasiquote(elt), acc]) +} +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr + } +} + +func eval(_ expr: Expr, env: Env) throws -> Expr { + + var env = env + var expr = expr + while true { + + switch env.get("DEBUG-EVAL") { + case nil, .bool(false), .null: break + default: print("EVAL: " + print(expr)) + } + + switch expr { + case let .symbol(name): + let val = env.get(name) + guard val != nil else { throw MalError.symbolNotFound(name) } + return val! + case let .vector(values, _): + return .vector(try values.map { try eval($0, env: env) }) + case let .hashmap(values, _): + return .hashmap(try values.mapValues { try eval($0, env: env) }) + case let .list(ast, _): + + if ast.isEmpty { + return expr + } + + switch ast[0] { + + case .symbol("def!"): + guard ast.count == 3 else { throw MalError.invalidArguments("def!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } + + let val = try eval(ast[2], env: env) + env.set(forKey: name, val: val) + return val + + case .symbol("let*"): + guard ast.count == 3 else { throw MalError.invalidArguments("let*") } + + switch ast[1] { + case let .list(bindable, _), let .vector(bindable, _): + let letEnv = Env(outer: env) + + for i in stride(from: 0, to: bindable.count - 1, by: 2) { + guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } + let value = bindable[i + 1] + letEnv.set(forKey: key, val: try eval(value, env: letEnv)) + } + + expr = ast[2] + env = letEnv + default: + throw MalError.invalidArguments("let*") + } + + case .symbol("quote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quote") } + return ast[1] + + case .symbol("quasiquote"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } + expr = try quasiquote(ast[1]) + + case .symbol("defmacro!"): + guard ast.count == 3 else { throw MalError.invalidArguments("defmacro!") } + guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("defmacro!") } + + guard case let .function(fn) = try eval(ast[2], env: env) else { throw MalError.invalidArguments("defmacro!") } + let macros = fn.asMacros() + env.set(forKey: name, val: .function(macros)) + return .function(macros) + + case .symbol("try*"): + if ast.count == 2 { + expr = ast[1] + continue + } + guard ast.count == 3 else { throw MalError.invalidArguments("try*") } + guard case let .list(values, _) = ast[2], values.count == 3 else { throw MalError.invalidArguments("try*") } + guard case .symbol("catch*") = values[0] else { throw MalError.invalidArguments("try*") } + guard case let .symbol(bind) = values[1] else { throw MalError.invalidArguments("catch*") } + + do { + return try eval(ast[1], env: env) + } catch { + let malErr = (error as? Expr) ?? .string(error.localizedDescription) + let newEnv = try Env(binds: [bind], exprs: [malErr], outer: env) + env = newEnv + expr = values[2] + } + + case .symbol("do"): + let exprsToEval = ast.dropFirst() + guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } + _ = try exprsToEval.dropLast().map { try eval($0, env: env) } + expr = exprsToEval.last! + + case .symbol("if"): + guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } + + switch try eval(ast[1], env: env) { + case .bool(false), .null: + if let falseBranch = ast[safe: 3] { + expr = falseBranch + } else { + expr = .null + } + default: + expr = ast[2] + } + + case .symbol("fn*"): + guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } + let binds: [String] + + switch ast[1] { + case let .list(xs, _), let .vector(xs, _): + binds = try xs.map { + guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } + return name + } + default: + throw MalError.invalidArguments("fn*") + } + + let run: ([Expr]) throws -> Expr = { args in + let fEnv = try Env(binds: binds, exprs: args, outer: env) + return try eval(ast[2], env: fEnv) + } + + let f = Func(ast: ast[2], params: binds, env: env, run: run) + return .function(f) + + default: + guard case let .function(fn) = try eval(ast[0], env: env) else { throw MalError.invalidFunctionCall(ast[0]) } + if fn.isMacro { + expr = try fn.run(Array(ast.dropFirst())) + continue + } + let args = try ast.dropFirst().map { try eval($0, env: env) } + if let ast = fn.ast, let fnEnv = fn.env { + let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) + env = newEnv + expr = ast + } else { + return try fn.run(args) + } + } + default: + return expr + } + } +} + +func print(_ expr: Expr) -> String { + return Expr.print(expr) +} + +@discardableResult +func rep(_ s: String, env: Env) -> String { + do { + let expr = try read(s) + let resExpr = try eval(expr, env: env) + let resultStr = print(resExpr) + return resultStr + } catch { + return error.localizedDescription + } +} + +let replEnv: Env = Env(data: Core.ns.data) + +replEnv.set(forKey: "eval", val: .function(Func { args in + guard let expr = args.first else { throw MalError.invalidArguments("eval") } + return try eval(expr, env: replEnv) +})) +replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) +replEnv.set(forKey: "*host-language*", val: .string("swift6")) + +rep("(def! not (fn* (a) (if a false true)))", env: replEnv) +rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) +rep(#"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))"#, env: replEnv) + +if CommandLine.arguments.count > 1 { + rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) + exit(0) +} + +rep(#"(println (str "Mal [" *host-language* "]"))"#, env: replEnv) + +while true { + print("user> ", terminator: "") + guard let s = readLine() else { break } + print(rep(s, env: replEnv)) +} diff --git a/impls/swift6/run b/impls/swift6/run new file mode 100755 index 0000000000..8003dd69cb --- /dev/null +++ b/impls/swift6/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/.build/${STEP:-stepA_mal} "${@}" diff --git a/impls/tcl/Dockerfile b/impls/tcl/Dockerfile new file mode 100644 index 0000000000..f1098d5eaa --- /dev/null +++ b/impls/tcl/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install tcl tcl-tclreadline + +ENV HOME /mal diff --git a/impls/tcl/Makefile b/impls/tcl/Makefile new file mode 100644 index 0000000000..ba4ddbb379 --- /dev/null +++ b/impls/tcl/Makefile @@ -0,0 +1,19 @@ +SOURCES_BASE = mal_readline.tcl types.tcl reader.tcl printer.tcl +SOURCES_LISP = env.tcl core.tcl stepA_mal.tcl +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: + true + +dist: mal.tcl mal + +mal.tcl: $(SOURCES) + cat $+ | grep -v "^source " > $@ + +mal: mal.tcl + echo "#!/usr/bin/env tclsh" > $@ + cat $< >> $@ + chmod +x $@ + +clean: + rm -f mal.tcl mal diff --git a/impls/tcl/core.tcl b/impls/tcl/core.tcl new file mode 100644 index 0000000000..2485c87db1 --- /dev/null +++ b/impls/tcl/core.tcl @@ -0,0 +1,475 @@ +proc mal_equal {a} { + bool_new [equal_q [lindex $a 0] [lindex $a 1]] +} + +set ::mal_exception_obj 0 +proc mal_throw {a} { + set ::mal_exception_obj [lindex $a 0] + error "__MalException__" +} + +proc mal_nil_q {a} { + bool_new [nil_q [lindex $a 0]] +} + +proc mal_true_q {a} { + bool_new [true_q [lindex $a 0]] +} + +proc mal_false_q {a} { + bool_new [false_q [lindex $a 0]] +} + +proc mal_symbol {a} { + symbol_new [obj_val [lindex $a 0]] +} + +proc mal_symbol_q {a} { + bool_new [symbol_q [lindex $a 0]] +} + +proc mal_string_q {a} { + bool_new [string_q [lindex $a 0]] +} + +proc mal_keyword {a} { + lassign $a a0 + if {[keyword_q $a0]} { + return $a0 + } + keyword_new [obj_val $a0] +} + +proc mal_keyword_q {a} { + bool_new [keyword_q [lindex $a 0]] +} + +proc mal_number_q {a} { + bool_new [integer_q [lindex $a 0]] +} + +proc mal_fn_q {a} { + set f [lindex $a 0] + switch [obj_type $f] { + function { return [bool_new [expr {![macro_q $f]}]] } + nativefunction { return $::mal_true } + default { return $::mal_false } + } +} + +proc mal_macro_q {a} { + bool_new [macro_q [lindex $a 0]] +} + +proc render_array {arr readable delim} { + set res {} + foreach e $arr { + lappend res [pr_str $e $readable] + } + join $res $delim +} + +proc mal_pr_str {a} { + string_new [render_array $a 1 " "] +} + +proc mal_str {a} { + string_new [render_array $a 0 ""] +} + +proc mal_prn {a} { + puts [render_array $a 1 " "] + return $::mal_nil +} + +proc mal_println {a} { + puts [render_array $a 0 " "] + return $::mal_nil +} + +proc mal_read_string {a} { + read_str [obj_val [lindex $a 0]] +} + +proc mal_readline {a} { + set prompt [obj_val [lindex $a 0]] + set res [_readline $prompt] + if {[lindex $res 0] == "EOF"} { + return $::mal_nil + } + string_new [lindex $res 1] +} + +proc mal_slurp {a} { + set filename [obj_val [lindex $a 0]] + set file [open $filename] + set content [read $file] + close $file + string_new $content +} + +proc mal_lt {a} { + bool_new [expr {[obj_val [lindex $a 0]] < [obj_val [lindex $a 1]]}] +} + +proc mal_lte {a} { + bool_new [expr {[obj_val [lindex $a 0]] <= [obj_val [lindex $a 1]]}] +} + +proc mal_gt {a} { + bool_new [expr {[obj_val [lindex $a 0]] > [obj_val [lindex $a 1]]}] +} + +proc mal_gte {a} { + bool_new [expr {[obj_val [lindex $a 0]] >= [obj_val [lindex $a 1]]}] +} + +proc mal_add {a} { + integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}] +} + +proc mal_sub {a} { + integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}] +} + +proc mal_mul {a} { + integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}] +} + +proc mal_div {a} { + integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}] +} + +proc mal_time_ms {a} { + integer_new [clock milliseconds] +} + +proc mal_list {a} { + list_new $a +} + +proc mal_list_q {a} { + bool_new [list_q [lindex $a 0]] +} + +proc mal_vector {a} { + vector_new $a +} + +proc mal_vector_q {a} { + bool_new [vector_q [lindex $a 0]] +} + +proc mal_hash_map {a} { + set d [dict create] + foreach {k v} $a { + dict set d [obj_val $k] $v + } + hashmap_new $d +} + +proc mal_map_q {a} { + bool_new [hashmap_q [lindex $a 0]] +} + +proc mal_assoc {a} { + set d [dict create] + dict for {k v} [obj_val [lindex $a 0]] { + dict set d $k $v + } + foreach {k v} [lrange $a 1 end] { + dict set d [obj_val $k] $v + } + hashmap_new $d +} + +proc mal_dissoc {a} { + set d [dict create] + dict for {k v} [obj_val [lindex $a 0]] { + dict set d $k $v + } + foreach k [lrange $a 1 end] { + dict unset d [obj_val $k] + } + hashmap_new $d +} + +proc mal_get {a} { + lassign $a hashmap_obj key_obj + if {[dict exists [obj_val $hashmap_obj] [obj_val $key_obj]]} { + dict get [obj_val $hashmap_obj] [obj_val $key_obj] + } else { + return $::mal_nil + } +} + +proc mal_contains_q {a} { + lassign $a hashmap_obj key_obj + bool_new [dict exists [obj_val $hashmap_obj] [obj_val $key_obj]] +} + +proc mal_keys {a} { + set res {} + foreach k [dict keys [obj_val [lindex $a 0]]] { + lappend res [string_new $k] + } + list_new $res +} + +proc mal_vals {a} { + list_new [dict values [obj_val [lindex $a 0]]] +} + +proc mal_sequential_q {a} { + bool_new [sequential_q [lindex $a 0]] +} + +proc mal_cons {a} { + lassign $a head lst + list_new [concat [list $head] [obj_val $lst]] +} + +proc mal_concat {a} { + set res {} + foreach lst $a { + if {[nil_q $lst]} { + continue + } + set res [concat $res [obj_val $lst]] + } + list_new $res +} + +proc mal_vec {a} { + lassign $a a0 + if {[vector_q $a0]} { + return $a0 + } elseif {[list_q $a0]} { + return [vector_new [obj_val $a0]] + } else { + error "vec requires list or vector" + } +} + +proc mal_nth {a} { + lassign $a lst_obj index_obj + set index [obj_val $index_obj] + set lst [obj_val $lst_obj] + if {$index >= [llength $lst]} { + error "nth: index out of range" + } + lindex $lst $index +} + +proc mal_first {a} { + lassign $a lst + if {[nil_q $lst] || [llength [obj_val $lst]] == 0} { + return $::mal_nil + } + lindex [obj_val $lst] 0 +} + +proc mal_rest {a} { + lassign $a lst + list_new [lrange [obj_val $lst] 1 end] +} + +proc mal_empty_q {a} { + bool_new [expr {[llength [obj_val [lindex $a 0]]] == 0}] +} + +proc mal_count {a} { + integer_new [llength [obj_val [lindex $a 0]]] +} + +proc mal_apply {a} { + set f [lindex $a 0] + if {[llength $a] > 1} { + set mid_args [lrange $a 1 end-1] + set last_list [lindex $a end] + set apply_args [concat $mid_args [obj_val $last_list]] + } else { + set apply_args {} + } + + switch [obj_type $f] { + function { + set funcdict [obj_val $f] + set body [dict get $funcdict body] + set env [dict get $funcdict env] + set binds [dict get $funcdict binds] + set funcenv [Env new $env $binds $apply_args] + return [EVAL $body $funcenv] + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $apply_args] + } + default { + error "Not a function" + } + } +} + +proc mal_map {a} { + lassign $a f seq + set res {} + foreach item [obj_val $seq] { + set mappeditem [mal_apply [list $f [list_new [list $item]]]] + lappend res $mappeditem + } + list_new $res +} + +proc mal_conj {a} { + lassign $a a0 + if {[list_q $a0]} { + set lst $a0 + foreach item [lrange $a 1 end] { + set lst [mal_cons [list $item $lst]] + } + return $lst + } elseif {[vector_q $a0]} { + set res [obj_val $a0] + foreach item [lrange $a 1 end] { + lappend res $item + } + vector_new $res + } else { + error "conj requires list or vector" + } +} + +proc mal_seq {a} { + lassign $a a0 + if {[string_q $a0]} { + set str [obj_val $a0] + if {$str == ""} { + return $::mal_nil + } + set res {} + foreach char [split $str {}] { + lappend res [string_new $char] + } + list_new $res + } elseif {[list_q $a0]} { + if {[llength [obj_val $a0]] == 0} { + return $::mal_nil + } + return $a0 + } elseif {[vector_q $a0]} { + if {[llength [obj_val $a0]] == 0} { + return $::mal_nil + } + list_new [obj_val $a0] + } elseif {[nil_q $a0]} { + return $::mal_nil + } else { + error "seq requires string or list or vector or nil" + } +} + +proc mal_meta {a} { + obj_meta [lindex $a 0] +} + +proc mal_with_meta {a} { + lassign $a a0 a1 + obj_new [obj_type $a0] [obj_val $a0] $a1 +} + +proc mal_atom {a} { + atom_new [lindex $a 0] +} + +proc mal_atom_q {a} { + bool_new [atom_q [lindex $a 0]] +} + +proc mal_deref {a} { + obj_val [lindex $a 0] +} + +proc mal_reset_bang {a} { + lassign $a a0 a1 + obj_set_val $a0 $a1 +} + +proc mal_swap_bang {a} { + lassign $a a0 f + set apply_args [concat [list [obj_val $a0]] [lrange $a 2 end]] + set newval [mal_apply [list $f [list_new $apply_args]]] + mal_reset_bang [list $a0 $newval] +} + +set core_ns [dict create \ + "=" [nativefunction_new mal_equal] \ + "throw" [nativefunction_new mal_throw] \ + \ + "nil?" [nativefunction_new mal_nil_q] \ + "true?" [nativefunction_new mal_true_q] \ + "false?" [nativefunction_new mal_false_q] \ + "symbol" [nativefunction_new mal_symbol] \ + "symbol?" [nativefunction_new mal_symbol_q] \ + "string?" [nativefunction_new mal_string_q] \ + "keyword" [nativefunction_new mal_keyword] \ + "keyword?" [nativefunction_new mal_keyword_q] \ + "number?" [nativefunction_new mal_number_q] \ + "fn?" [nativefunction_new mal_fn_q] \ + "macro?" [nativefunction_new mal_macro_q] \ + \ + "pr-str" [nativefunction_new mal_pr_str] \ + "str" [nativefunction_new mal_str] \ + "prn" [nativefunction_new mal_prn] \ + "println" [nativefunction_new mal_println] \ + "read-string" [nativefunction_new mal_read_string] \ + "readline" [nativefunction_new mal_readline] \ + "slurp" [nativefunction_new mal_slurp] \ + \ + "<" [nativefunction_new mal_lt] \ + "<=" [nativefunction_new mal_lte] \ + ">" [nativefunction_new mal_gt] \ + ">=" [nativefunction_new mal_gte] \ + "+" [nativefunction_new mal_add] \ + "-" [nativefunction_new mal_sub] \ + "*" [nativefunction_new mal_mul] \ + "/" [nativefunction_new mal_div] \ + "time-ms" [nativefunction_new mal_time_ms] \ + \ + "list" [nativefunction_new mal_list] \ + "list?" [nativefunction_new mal_list_q] \ + "vector" [nativefunction_new mal_vector] \ + "vector?" [nativefunction_new mal_vector_q] \ + "hash-map" [nativefunction_new mal_hash_map] \ + "map?" [nativefunction_new mal_map_q] \ + "assoc" [nativefunction_new mal_assoc] \ + "dissoc" [nativefunction_new mal_dissoc] \ + "get" [nativefunction_new mal_get] \ + "contains?" [nativefunction_new mal_contains_q] \ + "keys" [nativefunction_new mal_keys] \ + "vals" [nativefunction_new mal_vals] \ + \ + "sequential?" [nativefunction_new mal_sequential_q] \ + "cons" [nativefunction_new mal_cons] \ + "concat" [nativefunction_new mal_concat] \ + "vec" [nativefunction_new mal_vec] \ + "nth" [nativefunction_new mal_nth] \ + "first" [nativefunction_new mal_first] \ + "rest" [nativefunction_new mal_rest] \ + "empty?" [nativefunction_new mal_empty_q] \ + "count" [nativefunction_new mal_count] \ + "apply" [nativefunction_new mal_apply] \ + "map" [nativefunction_new mal_map] \ + \ + "conj" [nativefunction_new mal_conj] \ + "seq" [nativefunction_new mal_seq] \ + \ + "meta" [nativefunction_new mal_meta] \ + "with-meta" [nativefunction_new mal_with_meta] \ + "atom" [nativefunction_new mal_atom] \ + "atom?" [nativefunction_new mal_atom_q] \ + "deref" [nativefunction_new mal_deref] \ + "reset!" [nativefunction_new mal_reset_bang] \ + "swap!" [nativefunction_new mal_swap_bang] \ +] diff --git a/impls/tcl/env.tcl b/impls/tcl/env.tcl new file mode 100644 index 0000000000..2cb9628341 --- /dev/null +++ b/impls/tcl/env.tcl @@ -0,0 +1,49 @@ +oo::class create Env { + variable outer data + + constructor {{outerenv 0} {binds ""} {exprs ""}} { + set outer $outerenv + set data [dict create] + if {$binds != ""} { + for {set i 0} {$i < [llength $binds]} {incr i} { + set b [lindex $binds $i] + if {$b == "&"} { + set varrest [lindex $binds [expr {$i + 1}]] + set restexprs [list_new [lrange $exprs $i end]] + my set $varrest $restexprs + break + } else { + my set $b [lindex $exprs $i] + } + } + } + } + + method set {symbol objval} { + dict set data $symbol $objval + return $objval + } + + method find {symbol} { + if {[dict exist $data $symbol]} { + return [self] + } elseif {$outer != 0} { + return [$outer find $symbol] + } else { + return 0 + } + } + + method get {symbol} { + set foundenv [my find $symbol] + if {$foundenv == 0} { + error "'$symbol' not found" + } else { + return [$foundenv get_symbol $symbol] + } + } + + method get_symbol {symbol} { + dict get $data $symbol + } +} diff --git a/impls/tcl/mal_readline.tcl b/impls/tcl/mal_readline.tcl new file mode 100644 index 0000000000..58c7d6ce7d --- /dev/null +++ b/impls/tcl/mal_readline.tcl @@ -0,0 +1,54 @@ +if {[lindex $argv 0] == "--raw"} { + set ::readline_mode "raw" + set argv [lrange $argv 1 end] + incr argc -1 +} else { + if {[catch {package require tclreadline}]} { + set ::readline_mode "raw" + } else { + set ::readline_mode "library" + } +} + +set ::historyfile "$env(HOME)/.mal-history" +set ::readline_library_initalized 0 +proc readline_library_init {} { + if {$::readline_library_initalized} { + return + } + + ::tclreadline::readline initialize $::historyfile + ::tclreadline::readline builtincompleter 0 + ::tclreadline::readline customcompleter "" + set ::readline_library_initalized 1 +} + +proc _readline_library prompt { + readline_library_init + + set reached_eof 0 + ::tclreadline::readline eofchar { set reached_eof 1 } + set line [::tclreadline::readline read $prompt] + if {$reached_eof} { + return {"EOF" ""} + } + ::tclreadline::readline write $::historyfile + list "OK" $line +} + +proc _readline_raw prompt { + puts -nonewline $prompt + flush stdout + if {[gets stdin line] < 0} { + return {"EOF" ""} + } + list "OK" $line +} + +proc _readline prompt { + if {$::readline_mode == "library"} { + _readline_library $prompt + } else { + _readline_raw $prompt + } +} diff --git a/impls/tcl/printer.tcl b/impls/tcl/printer.tcl new file mode 100644 index 0000000000..4f1d8f0ec7 --- /dev/null +++ b/impls/tcl/printer.tcl @@ -0,0 +1,56 @@ +proc format_list {elements start_char end_char readable} { + set res {} + foreach element $elements { + lappend res [pr_str $element $readable] + } + set joined [join $res " "] + return "${start_char}${joined}${end_char}" +} + +proc format_hashmap {dictionary readable} { + set lst {} + dict for {keystr valobj} $dictionary { + lappend lst [string_new $keystr] + lappend lst $valobj + } + format_list $lst "\{" "\}" $readable +} + +proc format_string {str readable} { + if {[string index $str 0] == "\u029E"} { + return ":[string range $str 1 end]" + } elseif {$readable} { + set escaped [string map {"\n" "\\n" "\"" "\\\"" "\\" "\\\\"} $str] + return "\"$escaped\"" + } else { + return $str + } +} + +proc format_function {funcdict} { + set type "function" + if {[dict get $funcdict is_macro]} { + set type "macro" + } + return "<$type:args=[join [dict get $funcdict binds] ","]>" +} + +proc pr_str {ast readable} { + set nodetype [obj_type $ast] + set nodevalue [obj_val $ast] + switch $nodetype { + nil { return "nil" } + true { return "true" } + false { return "false" } + integer { return $nodevalue } + symbol { return $nodevalue } + string { return [format_string $nodevalue $readable] } + list { return [format_list $nodevalue "(" ")" $readable] } + vector { return [format_list $nodevalue "\[" "\]" $readable] } + hashmap { return [format_hashmap [dict get $nodevalue] $readable] } + atom { return "(atom [pr_str $nodevalue $readable])" } + function { return [format_function $nodevalue] } + nativefunction { return "" } + default { error "cannot print type $nodetype" } + } +} diff --git a/impls/tcl/reader.tcl b/impls/tcl/reader.tcl new file mode 100644 index 0000000000..6812335f04 --- /dev/null +++ b/impls/tcl/reader.tcl @@ -0,0 +1,126 @@ +oo::class create Reader { + variable pos tokens + + constructor {tokens_list} { + set tokens $tokens_list + set pos 0 + } + + method peek {} { + lindex $tokens $pos + } + + method next {} { + set token [my peek] + incr pos + return $token + } +} + +proc tokenize str { + set re {[\s,]*(~@|[\[\]\{\}()'`~^@]|\"(?:\\.|[^\\\"])*\"?|;[^\n]*|[^\s\[\]\{\}('\"`~^@,;)]*)} + set tokens {} + foreach {_ capture} [regexp -all -inline $re $str] { + if {[string length $capture] > 0 && [string range $capture 0 0] != ";"} { + lappend tokens $capture + } + } + return $tokens +} + +proc read_tokens_list {reader start_char end_char} { + set token [$reader next] + if {$token != $start_char} { + error "expected '$start_char', got EOF" + } + + set elements {} + set token [$reader peek] + while {$token != $end_char} { + if {$token == ""} { + error "expected '$end_char', got EOF" + } + lappend elements [read_form $reader] + set token [$reader peek] + } + $reader next + return $elements +} + +proc read_list {reader} { + set elements [read_tokens_list $reader "(" ")"] + list_new $elements +} + +proc read_vector {reader} { + set elements [read_tokens_list $reader "\[" "\]"] + vector_new $elements +} + +proc read_hashmap {reader} { + set res [dict create] + foreach {keytoken valtoken} [read_tokens_list $reader "{" "}"] { + dict set res [obj_val $keytoken] $valtoken + } + hashmap_new $res +} + +proc parse_string {str} { + set res [string range $str 1 end-1] + string map {"\\n" "\n" "\\\"" "\"" "\\\\" "\\"} $res +} + +proc parse_keyword {str} { + # Remove initial ":" + string range $str 1 end +} + +proc read_atom {reader} { + set token [$reader next] + switch -regexp $token { + ^-?[0-9]+$ { return [obj_new "integer" $token] } + ^nil$ { return $::mal_nil } + ^true$ { return $::mal_true } + ^false$ { return $::mal_false } + ^: { return [keyword_new [parse_keyword $token]] } + ^\"(\\\\.|[^\\\\\"])*\"$ + { return [string_new [parse_string $token]] } + ^\" { error "expected '\"', got EOF" } + default { return [symbol_new $token] } + } +} + +proc symbol_shortcut {symbol_name reader} { + $reader next + list_new [list [symbol_new $symbol_name] [read_form $reader]] +} + +proc read_form {reader} { + switch [$reader peek] { + "'" { return [symbol_shortcut "quote" $reader] } + "`" { return [symbol_shortcut "quasiquote" $reader] } + "~" { return [symbol_shortcut "unquote" $reader] } + "~@" { return [symbol_shortcut "splice-unquote" $reader] } + "^" { + $reader next + set meta [read_form $reader] + return [list_new [list [symbol_new "with-meta"] [read_form $reader] $meta]] + } + "@" { return [symbol_shortcut "deref" $reader] } + "(" { return [read_list $reader] } + ")" { error "unexpected ')'" } + "\[" { return [read_vector $reader] } + "\]" { error "unexpected '\]'" } + "\{" { return [read_hashmap $reader] } + "\}" { error "unexpected '\}'" } + default { return [read_atom $reader] } + } +} + +proc read_str str { + set tokens [tokenize $str] + set reader [Reader new $tokens] + set res [read_form $reader] + $reader destroy + return $res +} diff --git a/impls/tcl/run b/impls/tcl/run new file mode 100755 index 0000000000..700b5291b0 --- /dev/null +++ b/impls/tcl/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec tclsh $(dirname $0)/${STEP:-stepA_mal}.tcl ${RAW:+--raw} "${@}" diff --git a/impls/tcl/step0_repl.tcl b/impls/tcl/step0_repl.tcl new file mode 100644 index 0000000000..5c18f04b15 --- /dev/null +++ b/impls/tcl/step0_repl.tcl @@ -0,0 +1,33 @@ +source mal_readline.tcl + +proc READ str { + return $str +} + +proc EVAL {ast env} { + return $ast +} + +proc PRINT exp { + return $exp +} + +proc REP str { + PRINT [EVAL [READ $str] {}] +} + +fconfigure stdout -translation binary + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + puts [REP $line] +} +puts "" diff --git a/impls/tcl/step1_read_print.tcl b/impls/tcl/step1_read_print.tcl new file mode 100644 index 0000000000..f4aa064908 --- /dev/null +++ b/impls/tcl/step1_read_print.tcl @@ -0,0 +1,38 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl + +proc READ str { + read_str $str +} + +proc EVAL {ast env} { + return $ast +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP str { + PRINT [EVAL [READ $str] {}] +} + +fconfigure stdout -translation binary + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line] } exception] } { + puts "Error: $exception" + } +} +puts "" diff --git a/impls/tcl/step2_eval.tcl b/impls/tcl/step2_eval.tcl new file mode 100644 index 0000000000..2cb8e0822f --- /dev/null +++ b/impls/tcl/step2_eval.tcl @@ -0,0 +1,99 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl + +proc READ str { + read_str $str +} + +proc EVAL {ast env} { + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + if {[dict exists $env $varname]} { + return [dict get $env $varname] + } else { + error "'$varname' not found" + } + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + set a0 [lindex [obj_val $ast] 0] + if {$a0 == ""} { + return $ast + } + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } + set f [lindex $lst 0] + set call_args [lrange $lst 1 end] + apply $f $call_args +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc mal_add {a} { + integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}] +} + +proc mal_sub {a} { + integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}] +} + +proc mal_mul {a} { + integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}] +} + +proc mal_div {a} { + integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}] +} + +set repl_env [dict create \ + "+" {{a} {mal_add $a}} \ + "-" {{a} {mal_sub $a}} \ + "*" {{a} {mal_mul $a}} \ + "/" {{a} {mal_div $a}} \ +] + +fconfigure stdout -translation binary + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + puts "Error: $exception" + } +} +puts "" diff --git a/impls/tcl/step3_env.tcl b/impls/tcl/step3_env.tcl new file mode 100644 index 0000000000..f6fbebbb31 --- /dev/null +++ b/impls/tcl/step3_env.tcl @@ -0,0 +1,123 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl + +proc READ str { + read_str $str +} + +proc EVAL {ast env} { + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + set a0 [lindex [obj_val $ast] 0] + if {$a0 == ""} { + return $ast + } + set a1 [lindex [obj_val $ast] 1] + set a2 [lindex [obj_val $ast] 2] + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + return [EVAL $a2 $letenv] + } + default { + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } + set f [lindex $lst 0] + set call_args [lrange $lst 1 end] + return [apply $f $call_args] + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc mal_add {a} { + integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}] +} + +proc mal_sub {a} { + integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}] +} + +proc mal_mul {a} { + integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}] +} + +proc mal_div {a} { + integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}] +} + +set repl_env [Env new] +$repl_env set "+" {{a} {mal_add $a}} +$repl_env set "-" {{a} {mal_sub $a}} +$repl_env set "*" {{a} {mal_mul $a}} +$repl_env set "/" {{a} {mal_div $a}} + +fconfigure stdout -translation binary + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + puts "Error: $exception" + } +} +puts "" diff --git a/impls/tcl/step4_if_fn_do.tcl b/impls/tcl/step4_if_fn_do.tcl new file mode 100644 index 0000000000..c29f8ece6f --- /dev/null +++ b/impls/tcl/step4_if_fn_do.tcl @@ -0,0 +1,160 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl +source core.tcl + +proc READ str { + read_str $str +} + +proc EVAL {ast env} { + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + lassign [obj_val $ast] a0 a1 a2 a3 + if {$a0 == ""} { + return $ast + } + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + return [EVAL $a2 $letenv] + } + "do" { + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } + return [EVAL [lindex [obj_val $ast] end] $env] + } + "if" { + set condval [EVAL $a1 $env] + if {[false_q $condval] || [nil_q $condval]} { + if {$a3 == ""} { + return $::mal_nil + } + return [EVAL $a3 $env] + } + return [EVAL $a2 $env] + } + "fn*" { + set binds {} + foreach v [obj_val $a1] { + lappend binds [obj_val $v] + } + return [function_new $a2 $env $binds] + } + default { + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } + set f [lindex $lst 0] + set call_args [lrange $lst 1 end] + switch [obj_type $f] { + function { + set funcdict [obj_val $f] + set body [dict get $funcdict body] + set env [dict get $funcdict env] + set binds [dict get $funcdict binds] + set funcenv [Env new $env $binds $call_args] + return [EVAL $body $funcenv] + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $call_args] + } + default { + error "Not a function" + } + } + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc RE {str env} { + EVAL [READ $str] $env +} + +set repl_env [Env new] +dict for {k v} $core_ns { + $repl_env set $k $v +} + +# core.mal: defined using the language itself +RE "(def! not (fn* (a) (if a false true)))" $repl_env + +fconfigure stdout -translation binary + +set DEBUG_MODE 0 +if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { + set DEBUG_MODE 1 +} + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + puts "Error: $exception" + if { $DEBUG_MODE } { + puts $::errorInfo + } + } +} +puts "" diff --git a/impls/tcl/step5_tco.tcl b/impls/tcl/step5_tco.tcl new file mode 100644 index 0000000000..61b17109a6 --- /dev/null +++ b/impls/tcl/step5_tco.tcl @@ -0,0 +1,166 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl +source core.tcl + +proc READ str { + read_str $str +} + +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + lassign [obj_val $ast] a0 a1 a2 a3 + if {$a0 == ""} { + return $ast + } + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + set ast $a2 + set env $letenv + # TCO: Continue loop + } + "do" { + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } + set ast [lindex [obj_val $ast] end] + # TCO: Continue loop + } + "if" { + set condval [EVAL $a1 $env] + if {[false_q $condval] || [nil_q $condval]} { + if {$a3 == ""} { + return $::mal_nil + } + set ast $a3 + } else { + set ast $a2 + } + # TCO: Continue loop + } + "fn*" { + set binds {} + foreach v [obj_val $a1] { + lappend binds [obj_val $v] + } + return [function_new $a2 $env $binds] + } + default { + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } + set f [lindex $lst 0] + set call_args [lrange $lst 1 end] + switch [obj_type $f] { + function { + set fn [obj_val $f] + set ast [dict get $fn body] + set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] + # TCO: Continue loop + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $call_args] + } + default { + error "Not a function" + } + } + } + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc RE {str env} { + EVAL [READ $str] $env +} + +set repl_env [Env new] +dict for {k v} $core_ns { + $repl_env set $k $v +} + +# core.mal: defined using the language itself +RE "(def! not (fn* (a) (if a false true)))" $repl_env + +fconfigure stdout -translation binary + +set DEBUG_MODE 0 +if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { + set DEBUG_MODE 1 +} + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + puts "Error: $exception" + if { $DEBUG_MODE } { + puts $::errorInfo + } + } +} +puts "" diff --git a/impls/tcl/step6_file.tcl b/impls/tcl/step6_file.tcl new file mode 100644 index 0000000000..dd4bb8c908 --- /dev/null +++ b/impls/tcl/step6_file.tcl @@ -0,0 +1,185 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl +source core.tcl + +proc READ str { + read_str $str +} + +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + lassign [obj_val $ast] a0 a1 a2 a3 + if {$a0 == ""} { + return $ast + } + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + set ast $a2 + set env $letenv + # TCO: Continue loop + } + "do" { + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } + set ast [lindex [obj_val $ast] end] + # TCO: Continue loop + } + "if" { + set condval [EVAL $a1 $env] + if {[false_q $condval] || [nil_q $condval]} { + if {$a3 == ""} { + return $::mal_nil + } + set ast $a3 + } else { + set ast $a2 + } + # TCO: Continue loop + } + "fn*" { + set binds {} + foreach v [obj_val $a1] { + lappend binds [obj_val $v] + } + return [function_new $a2 $env $binds] + } + default { + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } + set f [lindex $lst 0] + set call_args [lrange $lst 1 end] + switch [obj_type $f] { + function { + set fn [obj_val $f] + set ast [dict get $fn body] + set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] + # TCO: Continue loop + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $call_args] + } + default { + error "Not a function" + } + } + } + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc RE {str env} { + EVAL [READ $str] $env +} + +proc mal_eval {a} { + global repl_env + EVAL [lindex $a 0] $repl_env +} + +set repl_env [Env new] +dict for {k v} $core_ns { + $repl_env set $k $v +} + +$repl_env set "eval" [nativefunction_new mal_eval] + +set argv_list {} +foreach arg [lrange $argv 1 end] { + lappend argv_list [string_new $arg] +} +$repl_env set "*ARGV*" [list_new $argv_list] + +# core.mal: defined using the language itself +RE "(def! not (fn* (a) (if a false true)))" $repl_env +RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env + +fconfigure stdout -translation binary + +set DEBUG_MODE 0 +if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { + set DEBUG_MODE 1 +} + +if {$argc > 0} { + REP "(load-file \"[lindex $argv 0]\")" $repl_env + exit +} + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + puts "Error: $exception" + if { $DEBUG_MODE } { + puts $::errorInfo + } + } +} +puts "" diff --git a/impls/tcl/step7_quote.tcl b/impls/tcl/step7_quote.tcl new file mode 100644 index 0000000000..3cd5f6b808 --- /dev/null +++ b/impls/tcl/step7_quote.tcl @@ -0,0 +1,237 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl +source core.tcl + +proc READ str { + read_str $str +} + +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc +} + +proc quasiquote {ast} { + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } + } +} + +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + lassign [obj_val $ast] a0 a1 a2 a3 + if {$a0 == ""} { + return $ast + } + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + set ast $a2 + set env $letenv + # TCO: Continue loop + } + "quote" { + return $a1 + } + "quasiquote" { + set ast [quasiquote $a1] + } + "do" { + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } + set ast [lindex [obj_val $ast] end] + # TCO: Continue loop + } + "if" { + set condval [EVAL $a1 $env] + if {[false_q $condval] || [nil_q $condval]} { + if {$a3 == ""} { + return $::mal_nil + } + set ast $a3 + } else { + set ast $a2 + } + # TCO: Continue loop + } + "fn*" { + set binds {} + foreach v [obj_val $a1] { + lappend binds [obj_val $v] + } + return [function_new $a2 $env $binds] + } + default { + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } + set f [lindex $lst 0] + set call_args [lrange $lst 1 end] + switch [obj_type $f] { + function { + set fn [obj_val $f] + set ast [dict get $fn body] + set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] + # TCO: Continue loop + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $call_args] + } + default { + error "Not a function" + } + } + } + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc RE {str env} { + EVAL [READ $str] $env +} + +proc mal_eval {a} { + global repl_env + EVAL [lindex $a 0] $repl_env +} + +set repl_env [Env new] +dict for {k v} $core_ns { + $repl_env set $k $v +} + +$repl_env set "eval" [nativefunction_new mal_eval] + +set argv_list {} +foreach arg [lrange $argv 1 end] { + lappend argv_list [string_new $arg] +} +$repl_env set "*ARGV*" [list_new $argv_list] + +# core.mal: defined using the language itself +RE "(def! not (fn* (a) (if a false true)))" $repl_env +RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env + +fconfigure stdout -translation binary + +set DEBUG_MODE 0 +if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { + set DEBUG_MODE 1 +} + +if {$argc > 0} { + REP "(load-file \"[lindex $argv 0]\")" $repl_env + exit +} + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + puts "Error: $exception" + if { $DEBUG_MODE } { + puts $::errorInfo + } + } +} +puts "" diff --git a/impls/tcl/step8_macros.tcl b/impls/tcl/step8_macros.tcl new file mode 100644 index 0000000000..c408e5c01d --- /dev/null +++ b/impls/tcl/step8_macros.tcl @@ -0,0 +1,252 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl +source core.tcl + +proc READ str { + read_str $str +} + +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc +} + +proc quasiquote {ast} { + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } + } +} + +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + lassign [obj_val $ast] a0 a1 a2 a3 + if {$a0 == ""} { + return $ast + } + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + set ast $a2 + set env $letenv + # TCO: Continue loop + } + "quote" { + return $a1 + } + "quasiquote" { + set ast [quasiquote $a1] + } + "defmacro!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname [macro_new $value]] + } + "do" { + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } + set ast [lindex [obj_val $ast] end] + # TCO: Continue loop + } + "if" { + set condval [EVAL $a1 $env] + if {[false_q $condval] || [nil_q $condval]} { + if {$a3 == ""} { + return $::mal_nil + } + set ast $a3 + } else { + set ast $a2 + } + # TCO: Continue loop + } + "fn*" { + set binds {} + foreach v [obj_val $a1] { + lappend binds [obj_val $v] + } + return [function_new $a2 $env $binds] + } + default { + set f [EVAL $a0 $env] + set unevaluated_args [lrange [obj_val $ast] 1 end] + if {[macro_q $f]} { + set fn [obj_val $f] + set f_ast [dict get $fn body] + set f_env [dict get $fn env] + set f_binds [dict get $fn binds] + set apply_env [Env new $f_env $f_binds $unevaluated_args] + set ast [EVAL $f_ast $apply_env] + continue + } + set call_args {} + foreach element $unevaluated_args { + lappend call_args [EVAL $element $env] + } + switch [obj_type $f] { + function { + set fn [obj_val $f] + set ast [dict get $fn body] + set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] + # TCO: Continue loop + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $call_args] + } + default { + error "Not a function" + } + } + } + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc RE {str env} { + EVAL [READ $str] $env +} + +proc mal_eval {a} { + global repl_env + EVAL [lindex $a 0] $repl_env +} + +set repl_env [Env new] +dict for {k v} $core_ns { + $repl_env set $k $v +} + +$repl_env set "eval" [nativefunction_new mal_eval] + +set argv_list {} +foreach arg [lrange $argv 1 end] { + lappend argv_list [string_new $arg] +} +$repl_env set "*ARGV*" [list_new $argv_list] + +# core.mal: defined using the language itself +RE "(def! not (fn* (a) (if a false true)))" $repl_env +RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env +RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env + +fconfigure stdout -translation binary + +set DEBUG_MODE 0 +if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { + set DEBUG_MODE 1 +} + +if {$argc > 0} { + REP "(load-file \"[lindex $argv 0]\")" $repl_env + exit +} + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + puts "Error: $exception" + if { $DEBUG_MODE } { + puts $::errorInfo + } + } +} +puts "" diff --git a/impls/tcl/step9_try.tcl b/impls/tcl/step9_try.tcl new file mode 100644 index 0000000000..ee63ed3ec3 --- /dev/null +++ b/impls/tcl/step9_try.tcl @@ -0,0 +1,275 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl +source core.tcl + +proc READ str { + read_str $str +} + +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc +} + +proc quasiquote {ast} { + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } + } +} + +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + lassign [obj_val $ast] a0 a1 a2 a3 + if {$a0 == ""} { + return $ast + } + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + set ast $a2 + set env $letenv + # TCO: Continue loop + } + "quote" { + return $a1 + } + "quasiquote" { + set ast [quasiquote $a1] + } + "defmacro!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname [macro_new $value]] + } + "try*" { + if {$a2 == ""} { + return [EVAL $a1 $env] + } + set res {} + if { [catch { set res [EVAL $a1 $env] } exception] } { + set exc_var [obj_val [lindex [obj_val $a2] 1]] + if {$exception == "__MalException__"} { + set exc_value $::mal_exception_obj + } else { + set exc_value [string_new $exception] + } + set catch_env [Env new $env [list $exc_var] [list $exc_value]] + return [EVAL [lindex [obj_val $a2] 2] $catch_env] + } else { + return $res + } + } + "do" { + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } + set ast [lindex [obj_val $ast] end] + # TCO: Continue loop + } + "if" { + set condval [EVAL $a1 $env] + if {[false_q $condval] || [nil_q $condval]} { + if {$a3 == ""} { + return $::mal_nil + } + set ast $a3 + } else { + set ast $a2 + } + # TCO: Continue loop + } + "fn*" { + set binds {} + foreach v [obj_val $a1] { + lappend binds [obj_val $v] + } + return [function_new $a2 $env $binds] + } + default { + set f [EVAL $a0 $env] + set unevaluated_args [lrange [obj_val $ast] 1 end] + if {[macro_q $f]} { + set fn [obj_val $f] + set f_ast [dict get $fn body] + set f_env [dict get $fn env] + set f_binds [dict get $fn binds] + set apply_env [Env new $f_env $f_binds $unevaluated_args] + set ast [EVAL $f_ast $apply_env] + continue + } + set call_args {} + foreach element $unevaluated_args { + lappend call_args [EVAL $element $env] + } + switch [obj_type $f] { + function { + set fn [obj_val $f] + set ast [dict get $fn body] + set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] + # TCO: Continue loop + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $call_args] + } + default { + error "Not a function" + } + } + } + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc RE {str env} { + EVAL [READ $str] $env +} + +proc mal_eval {a} { + global repl_env + EVAL [lindex $a 0] $repl_env +} + +set repl_env [Env new] +dict for {k v} $core_ns { + $repl_env set $k $v +} + +$repl_env set "eval" [nativefunction_new mal_eval] + +set argv_list {} +foreach arg [lrange $argv 1 end] { + lappend argv_list [string_new $arg] +} +$repl_env set "*ARGV*" [list_new $argv_list] + +# core.mal: defined using the language itself +RE "(def! not (fn* (a) (if a false true)))" $repl_env +RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env +RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env + +fconfigure stdout -translation binary + +set DEBUG_MODE 0 +if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { + set DEBUG_MODE 1 +} + +if {$argc > 0} { + REP "(load-file \"[lindex $argv 0]\")" $repl_env + exit +} + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + if {$exception == "__MalException__"} { + set res [pr_str $::mal_exception_obj 1] + puts "Error: $res" + } else { + puts "Error: $exception" + } + if { $DEBUG_MODE } { + puts $::errorInfo + } + } +} +puts "" diff --git a/impls/tcl/stepA_mal.tcl b/impls/tcl/stepA_mal.tcl new file mode 100644 index 0000000000..88d4445fa5 --- /dev/null +++ b/impls/tcl/stepA_mal.tcl @@ -0,0 +1,281 @@ +source mal_readline.tcl +source types.tcl +source reader.tcl +source printer.tcl +source env.tcl +source core.tcl + +proc READ str { + read_str $str +} + +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc +} + +proc quasiquote {ast} { + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } + } +} + +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + + switch [obj_type $ast] { + "symbol" { + set varname [obj_val $ast] + return [$env get $varname] + } + "list" { + } + "vector" { + set res {} + foreach element [obj_val $ast] { + lappend res [EVAL $element $env] + } + return [vector_new $res] + } + "hashmap" { + set res [dict create] + dict for {k v} [obj_val $ast] { + dict set res $k [EVAL $v $env] + } + return [hashmap_new $res] + } + default { return $ast } + } + + lassign [obj_val $ast] a0 a1 a2 a3 + if {$a0 == ""} { + return $ast + } + switch [obj_val $a0] { + "def!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname $value] + } + "let*" { + set letenv [Env new $env] + set bindings_list [obj_val $a1] + foreach {varnameobj varvalobj} $bindings_list { + $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] + } + set ast $a2 + set env $letenv + # TCO: Continue loop + } + "quote" { + return $a1 + } + "quasiquote" { + set ast [quasiquote $a1] + } + "defmacro!" { + set varname [obj_val $a1] + set value [EVAL $a2 $env] + return [$env set $varname [macro_new $value]] + } + "tcl*" { + return [string_new [eval [obj_val $a1]]] + } + "try*" { + if {$a2 == ""} { + return [EVAL $a1 $env] + } + set res {} + if { [catch { set res [EVAL $a1 $env] } exception] } { + set exc_var [obj_val [lindex [obj_val $a2] 1]] + if {$exception == "__MalException__"} { + set exc_value $::mal_exception_obj + } else { + set exc_value [string_new $exception] + } + set catch_env [Env new $env [list $exc_var] [list $exc_value]] + return [EVAL [lindex [obj_val $a2] 2] $catch_env] + } else { + return $res + } + } + "do" { + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } + set ast [lindex [obj_val $ast] end] + # TCO: Continue loop + } + "if" { + set condval [EVAL $a1 $env] + if {[false_q $condval] || [nil_q $condval]} { + if {$a3 == ""} { + return $::mal_nil + } + set ast $a3 + } else { + set ast $a2 + } + # TCO: Continue loop + } + "fn*" { + set binds {} + foreach v [obj_val $a1] { + lappend binds [obj_val $v] + } + return [function_new $a2 $env $binds] + } + default { + set f [EVAL $a0 $env] + set unevaluated_args [lrange [obj_val $ast] 1 end] + if {[macro_q $f]} { + set fn [obj_val $f] + set f_ast [dict get $fn body] + set f_env [dict get $fn env] + set f_binds [dict get $fn binds] + set apply_env [Env new $f_env $f_binds $unevaluated_args] + set ast [EVAL $f_ast $apply_env] + continue + } + set call_args {} + foreach element $unevaluated_args { + lappend call_args [EVAL $element $env] + } + switch [obj_type $f] { + function { + set fn [obj_val $f] + set ast [dict get $fn body] + set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] + # TCO: Continue loop + } + nativefunction { + set body [concat [list [obj_val $f]] {$a}] + set lambda [list {a} $body] + return [apply $lambda $call_args] + } + default { + error "Not a function" + } + } + } + } + } +} + +proc PRINT exp { + pr_str $exp 1 +} + +proc REP {str env} { + PRINT [EVAL [READ $str] $env] +} + +proc RE {str env} { + EVAL [READ $str] $env +} + +proc mal_eval {a} { + global repl_env + EVAL [lindex $a 0] $repl_env +} + +set repl_env [Env new] +dict for {k v} $core_ns { + $repl_env set $k $v +} + +$repl_env set "eval" [nativefunction_new mal_eval] + +set argv_list {} +foreach arg [lrange $argv 1 end] { + lappend argv_list [string_new $arg] +} +$repl_env set "*ARGV*" [list_new $argv_list] + +# core.mal: defined using the language itself +RE "(def! *host-language* \"tcl\")" $repl_env +RE "(def! not (fn* (a) (if a false true)))" $repl_env +RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env +RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env + +fconfigure stdout -translation binary + +set DEBUG_MODE 0 +if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { + set DEBUG_MODE 1 +} + +if {$argc > 0} { + REP "(load-file \"[lindex $argv 0]\")" $repl_env + exit +} + +REP "(println (str \"Mal \[\" *host-language* \"\]\"))" $repl_env + +# repl loop +while {true} { + set res [_readline "user> "] + if {[lindex $res 0] == "EOF"} { + break + } + set line [lindex $res 1] + if {$line == ""} { + continue + } + if { [catch { puts [REP $line $repl_env] } exception] } { + if {$exception == "__MalException__"} { + set res [pr_str $::mal_exception_obj 1] + puts "Error: $res" + } else { + puts "Error: $exception" + } + if { $DEBUG_MODE } { + puts $::errorInfo + } + } +} +puts "" diff --git a/impls/tcl/tests/step5_tco.mal b/impls/tcl/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/tcl/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/tcl/tests/stepA_mal.mal b/impls/tcl/tests/stepA_mal.mal new file mode 100644 index 0000000000..a53ddab71d --- /dev/null +++ b/impls/tcl/tests/stepA_mal.mal @@ -0,0 +1,28 @@ +;; Testing basic Tcl interop +;; +;; Note that in Tcl "everything is a string", so we don't have enough +;; information to convert the results to other Mal types. + +(tcl* "expr {3 ** 4}") +;=>"81" + +(tcl* "llength {a b c d}") +;=>"4" + +(tcl* "concat {a b} c {d e} f g") +;=>"a b c d e f g" + +(tcl* "puts \"hello [expr {5 + 6}] world\"") +;/hello 11 world +;=>"" + +(tcl* "set ::foo 8") +(tcl* "expr {$::foo}") +;=>"8" + +(tcl* "proc mult3 {x} { expr {$x * 3} }") +(tcl* "mult3 6") +;=>"18" + +(tcl* "string range $::tcl_version 0 1") +;=>"8." diff --git a/impls/tcl/types.tcl b/impls/tcl/types.tcl new file mode 100644 index 0000000000..3742fc2c00 --- /dev/null +++ b/impls/tcl/types.tcl @@ -0,0 +1,201 @@ +oo::class create MalObj { + variable type val meta + + constructor {obj_type obj_val {obj_meta 0}} { + set type $obj_type + set val $obj_val + set meta $obj_meta + } + + method get_type {} { + return $type + } + + method get_val {} { + return $val + } + + method get_meta {} { + return $meta + } + + method set_val {new_val} { + set val $new_val + return $new_val + } +} + +proc obj_new {obj_type obj_val {obj_meta 0}} { + MalObj new $obj_type $obj_val $obj_meta +} + +proc obj_type {obj} { + $obj get_type +} + +proc obj_val {obj} { + $obj get_val +} + +proc obj_meta {obj} { + $obj get_meta +} + +proc obj_set_val {obj new_val} { + $obj set_val $new_val +} + +set ::mal_nil [obj_new "nil" {}] +set ::mal_true [obj_new "true" {}] +set ::mal_false [obj_new "false" {}] + +proc nil_q {obj} { + expr {[obj_type $obj] == "nil"} +} + +proc false_q {obj} { + expr {[obj_type $obj] == "false"} +} + +proc true_q {obj} { + expr {[obj_type $obj] == "true"} +} + +proc bool_new {val} { + if {$val == 0} { + return $::mal_false + } else { + return $::mal_true + } +} + +proc integer_new {num} { + obj_new "integer" $num +} + +proc integer_q {obj} { + expr {[obj_type $obj] == "integer"} +} + +proc symbol_new {name} { + obj_new "symbol" $name +} + +proc symbol_q {obj} { + expr {[obj_type $obj] == "symbol"} +} + +proc string_new {val} { + obj_new "string" $val +} + +proc string_q {obj} { + expr {[obj_type $obj] == "string" && [string index [obj_val $obj] 0] != "\u029E"} +} + +proc keyword_new {val} { + string_new "\u029E$val" +} + +proc keyword_q {obj} { + expr {[obj_type $obj] == "string" && [string index [obj_val $obj] 0] == "\u029E"} +} + +proc list_new {lst} { + obj_new "list" $lst $::mal_nil +} + +proc list_q {obj} { + expr {[obj_type $obj] == "list"} +} + +proc vector_new {lst} { + obj_new "vector" $lst $::mal_nil +} + +proc vector_q {obj} { + expr {[obj_type $obj] == "vector"} +} + +proc hashmap_new {lst} { + obj_new "hashmap" $lst $::mal_nil +} + +proc hashmap_q {obj} { + expr {[obj_type $obj] == "hashmap"} +} + +proc sequential_q {obj} { + expr {[list_q $obj] || [vector_q $obj]} +} + +proc sequential_equal_q {seq_a seq_b} { + foreach obj_a [obj_val $seq_a] obj_b [obj_val $seq_b] { + if {$obj_a == "" || $obj_b == "" || ![equal_q $obj_a $obj_b]} { + return 0 + } + } + return 1 +} + +proc hashmap_equal_q {hashmap_a hashmap_b} { + set dict_a [obj_val $hashmap_a] + set dict_b [obj_val $hashmap_b] + set keys_a [lsort [dict keys $dict_a]] + set keys_b [lsort [dict keys $dict_b]] + if {$keys_a != $keys_b} { + return 0 + } + foreach key $keys_a { + set obj_a [dict get $dict_a $key] + set obj_b [dict get $dict_b $key] + if {![equal_q $obj_a $obj_b]} { + return 0 + } + } + return 1 +} + +proc equal_q {a b} { + if {[sequential_q $a] && [sequential_q $b]} { + sequential_equal_q $a $b + } elseif {[hashmap_q $a] && [hashmap_q $b]} { + hashmap_equal_q $a $b + } else { + expr {[obj_type $a] == [obj_type $b] && [obj_val $a] == [obj_val $b]} + } +} + +proc nativefunction_new {name} { + obj_new "nativefunction" $name $::mal_nil +} + +proc function_new {body env binds} { + set funcdict [dict create body $body env $env binds $binds is_macro 0] + obj_new "function" $funcdict $::mal_nil +} + +proc macro_new {funcobj} { + set fn [obj_val $funcobj] + set body [dict get $fn body] + set env [dict get $fn env] + set binds [dict get $fn binds] + set funcdict [dict create body $body env $env binds $binds is_macro 1] + obj_new "function" $funcdict $::mal_nil +} + +proc function_q {obj} { + expr {[obj_type $obj] == "function"} +} + +proc macro_q {obj} { + expr {[obj_type $obj] == "function" && [dict get [obj_val $obj] is_macro]} +} + +proc atom_new {val} { + obj_new "atom" $val $::mal_nil +} + +proc atom_q {obj} { + expr {[obj_type $obj] == "atom"} +} diff --git a/impls/tests/busywork.mal b/impls/tests/busywork.mal new file mode 100644 index 0000000000..fed35bf503 --- /dev/null +++ b/impls/tests/busywork.mal @@ -0,0 +1,31 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/threading.mal") ; -> +(load-file-once "../lib/benchmark.mal") +(load-file-once "../lib/test_cascade.mal") ; or + +;; Indicate that these macros are safe to eagerly expand. +;; Provides a large performance benefit for supporting implementations. +(def! and ^{:inline? true} and) +(def! or ^{:inline? true} or) +(def! -> ^{:inline? true} ->) +(def! -> ^{:inline? true} ->>) + +(def! do-times (fn* [f n] + (if (> n 0) + (do (f) + (do-times f (- n 1)))))) + +(def! atm (atom (list 0 1 2 3 4 5 6 7 8 9))) + +(def! busywork (fn* [] + (do + (or false nil false nil false nil false nil false nil (first @atm)) + (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" (first @atm)) + (-> (deref atm) rest rest rest rest rest rest first) + (swap! atm (fn* [a] (concat (rest a) (list (first a)))))))) + +(def! num-iterations 10000) + +(println (str "Execution time (in ms) of " num-iterations " busywork iterations on " + *host-language* ": ") + (benchmark (do-times busywork num-iterations) 10)) diff --git a/impls/tests/computations.mal b/impls/tests/computations.mal new file mode 100644 index 0000000000..9e418d9908 --- /dev/null +++ b/impls/tests/computations.mal @@ -0,0 +1,17 @@ +;; Some inefficient arithmetic computations for benchmarking. + +;; Unfortunately not yet available in tests of steps 4 and 5. + +;; Compute n(n+1)/2 with a non tail-recursive call. +(def! sumdown + (fn* [n] ; non-negative number + (if (= n 0) + 0 + (+ n (sumdown (- n 1)))))) + +;; Compute a Fibonacci number with two recursions. +(def! fib + (fn* [n] ; non-negative number + (if (<= n 1) + n + (+ (fib (- n 1)) (fib (- n 2)))))) diff --git a/impls/tests/docker-build.sh b/impls/tests/docker-build.sh new file mode 100755 index 0000000000..4df597932e --- /dev/null +++ b/impls/tests/docker-build.sh @@ -0,0 +1,6 @@ +#!/usr/bin/env bash + +IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} +GIT_TOP=$(git rev-parse --show-toplevel) + +docker build -t "${IMAGE_NAME}" "${GIT_TOP}/tests/docker" diff --git a/impls/tests/docker-run.sh b/impls/tests/docker-run.sh new file mode 100755 index 0000000000..0f8be9e1f0 --- /dev/null +++ b/impls/tests/docker-run.sh @@ -0,0 +1,9 @@ +#!/usr/bin/env bash + +IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} +GIT_TOP=$(git rev-parse --show-toplevel) + +docker run -it --rm -u ${EUID} \ + --volume=${GIT_TOP}:/mal \ + ${IMAGE_NAME} \ + "${@}" diff --git a/impls/tests/docker/Dockerfile b/impls/tests/docker/Dockerfile new file mode 100644 index 0000000000..62f2ce09ba --- /dev/null +++ b/impls/tests/docker/Dockerfile @@ -0,0 +1,178 @@ +# WARNING: This file is deprecated. Each implementation now has its +# own Dockerfile. + +FROM ubuntu:utopic +MAINTAINER Joel Martin + +ENV DEBIAN_FRONTEND noninteractive + +RUN echo "deb http://dl.bintray.com/sbt/debian /" > /etc/apt/sources.list.d/sbt.list +RUN apt-get -y update + +# +# General dependencies +# +VOLUME /mal + +RUN apt-get -y install make wget curl git + +# Deps for compiled languages (C, Go, Rust, Nim, etc) +RUN apt-get -y install gcc pkg-config + +# Deps for Java-based languages (Clojure, Scala, Java) +RUN apt-get -y install openjdk-7-jdk +ENV MAVEN_OPTS -Duser.home=/mal + +# Deps for Mono-based languages (C#, VB.Net) +RUN apt-get -y install mono-runtime mono-mcs mono-vbnc + +# Deps for node.js languages (JavaScript, CoffeeScript, miniMAL, etc) +RUN apt-get -y install nodejs npm +RUN ln -sf nodejs /usr/bin/node + + +# +# Implementation specific installs +# + +# GNU awk +RUN apt-get -y install gawk + +# Bash +RUN apt-get -y install bash + +# C +RUN apt-get -y install libglib2.0 libglib2.0-dev +RUN apt-get -y install libffi-dev libreadline-dev libedit2 libedit-dev + +# C++ +RUN apt-get -y install g++-4.9 libreadline-dev + +# Clojure +ADD https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein \ + /usr/local/bin/lein +RUN sudo chmod 0755 /usr/local/bin/lein +ENV LEIN_HOME /mal/.lein +ENV LEIN_JVM_OPTS -Duser.home=/mal + +# CoffeeScript +RUN npm install -g coffee-script +RUN touch /.coffee_history && chmod go+w /.coffee_history + +# C# +RUN apt-get -y install mono-mcs + +# Elixir +RUN wget https://packages.erlang-solutions.com/erlang-solutions_1.0_all.deb \ + && dpkg -i erlang-solutions_1.0_all.deb +RUN apt-get update +RUN apt-get -y install elixir + +# Erlang R17 (so I can use maps) +RUN apt-get -y install build-essential libncurses5-dev libssl-dev +RUN cd /tmp && wget http://www.erlang.org/download/otp_src_17.5.tar.gz \ + && tar -C /tmp -zxf /tmp/otp_src_17.5.tar.gz \ + && cd /tmp/otp_src_17.5 && ./configure && make && make install \ + && rm -rf /tmp/otp_src_17.5 /tmp/otp_src_17.5.tar.gz +# Rebar for building the Erlang implementation +RUN cd /tmp/ && git clone -q https://github.com/rebar/rebar.git \ + && cd /tmp/rebar && ./bootstrap && cp rebar /usr/local/bin \ + && rm -rf /tmp/rebar + +# Forth +RUN apt-get -y install gforth + +# Go +RUN apt-get -y install golang + +# Guile +RUN apt-get -y install libunistring-dev libgc-dev autoconf libtool flex gettext texinfo libgmp-dev +RUN git clone git://git.sv.gnu.org/guile.git /tmp/guile \ + && cd /tmp/guile && ./autogen.sh && ./configure && make && make install + +# Haskell +RUN apt-get -y install ghc haskell-platform libghc-readline-dev libghc-editline-dev + +# Java +RUN apt-get -y install maven2 + +# JavaScript +# Already satisfied above + +# Julia +RUN apt-get -y install software-properties-common +RUN apt-add-repository -y ppa:staticfloat/juliareleases +RUN apt-get -y update +RUN apt-get -y install julia + +# Lua +RUN apt-get -y install lua5.1 lua-rex-pcre luarocks +RUN luarocks install linenoise + +# Mal +# N/A: self-hosted on other language implementations + +# GNU Make +# Already satisfied as a based dependency for testing + +# miniMAL +RUN npm install -g minimal-lisp + +# Nim +RUN cd /tmp && wget http://nim-lang.org/download/nim-0.17.0.tar.xz \ + && tar xvJf /tmp/nim-0.17.0.tar.xz && cd nim-0.17.0 \ + && make && sh install.sh /usr/local/bin \ + && rm -r /tmp/nim-0.17.0 + +# OCaml +RUN apt-get -y install ocaml-batteries-included + +# perl +RUN apt-get -y install perl + +# PHP +RUN apt-get -y install php5-cli + +# PostScript/ghostscript +RUN apt-get -y install ghostscript + +# python +RUN apt-get -y install python + +# R +RUN apt-get -y install r-base-core + +# Racket +RUN apt-get -y install racket + +# Ruby +RUN apt-get -y install ruby + +# Rust +RUN curl -sf https://raw.githubusercontent.com/brson/multirust/master/blastoff.sh | sh + +# Scala +RUN apt-get -y --force-yes install sbt +RUN apt-get -y install scala +ENV SBT_OPTS -Duser.home=/mal + +# VB.Net +RUN apt-get -y install mono-vbnc + +# TODO: move up +# Factor +RUN apt-get -y install libgtkglext1 +RUN cd /usr/lib/x86_64-linux-gnu/ \ + && wget http://downloads.factorcode.org/releases/0.97/factor-linux-x86-64-0.97.tar.gz \ + && tar xvzf factor-linux-x86-64-0.97.tar.gz \ + && ln -sf /usr/lib/x86_64-linux-gnu/factor/factor /usr/bin/factor \ + && rm factor-linux-x86-64-0.97.tar.gz + +# MATLAB is proprietary/licensed. Maybe someday with Octave. +# Swift is Xcode/macOS only +ENV SKIP_IMPLS matlab swift + +ENV DEBIAN_FRONTEND newt +ENV HOME / + +WORKDIR /mal diff --git a/impls/tests/fib.mal b/impls/tests/fib.mal new file mode 100644 index 0000000000..cf7690e0bd --- /dev/null +++ b/impls/tests/fib.mal @@ -0,0 +1,14 @@ +(load-file "../lib/benchmark.mal") + +(def! fib (fn* [n] + (if (= n 0) + 1 + (if (= n 1) + 1 + (+ (fib (- n 1)) + (fib (- n 2))))))) + +(let* [n (read-string (first *ARGV*)) + iters (read-string (first (rest *ARGV*)))] + (println (str "Times (in ms) for (fib " n ") on " *host-language* ": ") + (benchmark (fib n) iters))) diff --git a/tests/inc.mal b/impls/tests/inc.mal similarity index 100% rename from tests/inc.mal rename to impls/tests/inc.mal diff --git a/tests/incA.mal b/impls/tests/incA.mal similarity index 100% rename from tests/incA.mal rename to impls/tests/incA.mal diff --git a/impls/tests/incB.mal b/impls/tests/incB.mal new file mode 100644 index 0000000000..4dd43ad4a4 --- /dev/null +++ b/impls/tests/incB.mal @@ -0,0 +1,6 @@ +;; A comment in a file +(def! inc4 (fn* (a) (+ 4 a))) +(def! inc5 (fn* (a) ;; a comment after code + (+ 5 a))) + +;; ending comment without final new line \ No newline at end of file diff --git a/impls/tests/incC.mal b/impls/tests/incC.mal new file mode 100644 index 0000000000..d647d88082 --- /dev/null +++ b/impls/tests/incC.mal @@ -0,0 +1,2 @@ +(def! mymap {"a" + 1}) diff --git a/impls/tests/lib/alias-hacks.mal b/impls/tests/lib/alias-hacks.mal new file mode 100644 index 0000000000..906a208f87 --- /dev/null +++ b/impls/tests/lib/alias-hacks.mal @@ -0,0 +1,55 @@ +;; Testing alias-hacks.mal +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/alias-hacks.mal") +;=>nil + +;; Testing let +(macroexpand (let binds a b)) +;=>(let* binds (do a b)) +(let [x 2] 3 x) +;=>2 + +;; Testing when +(macroexpand (when condition a b)) +;=>(if condition (do a b)) +(when false (nth () 0) a) +;=>nil +(when true 3 2) +;=>2 + +;; Testing name +(macroexpand (def name a b)) +;=>(def! name (do a b)) +(def x 1 2 3) +;=>3 +x +;=>3 + +;; Testing fn +(macroexpand (fn args a b)) +;=>(fn* args (do a b)) +((fn [x] 1 2) 3) +;=>2 + +;; Testing defn +(macroexpand (defn name args b)) +;=>(def! name (fn args b)) +(defn f [x] 1 2 x) +(f 3) +;=>3 + +;; Testing partial +((partial +) 1 2) +;=>3 +((partial + 1) 2) +;=>3 +((partial + 1 2)) +;=>3 +((partial not) false) +;=>true +((partial not false)) +;=>true +((partial (fn* [x y] (+ x y)) 1) 2) +;=>3 +((partial str 1 2) 3 4) +;=>"1234" diff --git a/impls/tests/lib/equality.mal b/impls/tests/lib/equality.mal new file mode 100644 index 0000000000..52c42b1597 --- /dev/null +++ b/impls/tests/lib/equality.mal @@ -0,0 +1,61 @@ +(def! orig= =) + +;; Testing equality.mal does not fix built-in equality. +(load-file "../lib/equality.mal") +;=>nil + +;; Testing bool-and +(bool-and) +;=>true +(bool-and true) +;=>true +(bool-and false) +;=>false +(bool-and nil) +;=>false +(bool-and 1) +;=>true +(bool-and 1 2) +;=>true +(bool-and nil (nth () 1)) +;=>false + +;; Testing bool-or +(bool-or) +;=>false +(bool-or true) +;=>true +(bool-or false) +;=>false +(bool-or nil) +;=>false +(bool-or 1) +;=>true +(bool-or 1 (nth () 1)) +;=>true +(bool-or 1 2) +;=>true +(bool-or false nil) +;=>false + +;; Breaking equality. +(def! = (fn* [a b] (bool-and (orig= a b) (cond (list? a) (list? b) (vector? a) (vector? b) true true)))) +(= [] ()) +;=>false + +;; Testing that equality.mal detects the problem. +(load-file "../lib/equality.mal") +;/equality.mal: Replaced = with pure mal implementation +;=>nil + +;; Testing fixed equality. +(= [] ()) +;=>true +(= [:a :b] (list :a :b)) +;=>true +(= [:a :b] [:a :b :c]) +;=>false +(= {:a 1} {:a 1}) +;=>true +(= {:a 1} {:a 1 :b 2}) +;=>false diff --git a/impls/tests/lib/load-file-once-inc.mal b/impls/tests/lib/load-file-once-inc.mal new file mode 100644 index 0000000000..2f912a8985 --- /dev/null +++ b/impls/tests/lib/load-file-once-inc.mal @@ -0,0 +1 @@ +(swap! counter (fn* [x] (+ 1 x))) diff --git a/impls/tests/lib/load-file-once.mal b/impls/tests/lib/load-file-once.mal new file mode 100644 index 0000000000..ac84cb01e9 --- /dev/null +++ b/impls/tests/lib/load-file-once.mal @@ -0,0 +1,44 @@ +(def! counter (atom 0)) +;=>(atom 0) + +;; The counter is increased by each `load-file`. +(load-file "../tests/lib/load-file-once-inc.mal") +;=>nil +@counter +;=>1 +(load-file "../tests/lib/load-file-once-inc.mal") +;=>nil +@counter +;=>2 + +;; load-file-once is available +(load-file "../lib/load-file-once.mal") +;=>nil + +;; First import actually calls `load-file`. +(load-file-once "../tests/lib/load-file-once-inc.mal") +;=>nil +@counter +;=>3 + +;; Later imports do nothing. +(load-file-once "../tests/lib/load-file-once-inc.mal") +;=>nil +@counter +;=>3 + +;; Loading the module twice does not reset its memory. +(load-file "../lib/load-file-once.mal") +;=>nil +(load-file-once "../tests/lib/load-file-once-inc.mal") +;=>nil +@counter +;=>3 + +;; even if done with itself +(load-file-once "../lib/load-file-once.mal") +;=>nil +(load-file-once "../tests/lib/load-file-once-inc.mal") +;=>nil +@counter +;=>3 diff --git a/impls/tests/lib/memoize.mal b/impls/tests/lib/memoize.mal new file mode 100644 index 0000000000..60fc43d23e --- /dev/null +++ b/impls/tests/lib/memoize.mal @@ -0,0 +1,18 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../tests/computations.mal") +(load-file-once "../lib/memoize.mal") +;=>nil + +(def! N 32) + +;; Benchmark naive 'fib' + +(def! r1 (fib N)) ; Should be slow + +;; Benchmark memoized 'fib' + +(def! fib (memoize fib)) +(def! r2 (fib N)) ; Should be quick + +(= r1 r2) +;=>true diff --git a/impls/tests/lib/pprint.mal b/impls/tests/lib/pprint.mal new file mode 100644 index 0000000000..457dd4d63e --- /dev/null +++ b/impls/tests/lib/pprint.mal @@ -0,0 +1,39 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/pprint.mal") +;=>nil + +(pprint '(7 8 9 "ten" [11 12 [13 14]] 15 16)) +;/\(7 +;/ 8 +;/ 9 +;/ "ten" +;/ \[11 +;/ 12 +;/ \[13 +;/ 14\]\] +;/ 15 +;/ 16\) +;=>nil + +(pprint '{:abc 123 :def {:ghi 456 :jkl [789 "ten eleven twelve"]}}) +;/\{:abc 123 +;/ :def \{:ghi 456 +;/ :jkl \[789 +;/ "ten eleven twelve"\]\}\} +;=>nil + +(pprint '(7 8 {:abc 123 :def {:ghi 456 :jkl 789}} 9 10 [11 12 [13 14]] 15 16)) +;/\(7 +;/ 8 +;/ \{:abc 123 +;/ :def \{:ghi 456 +;/ :jkl 789\}\} +;/ 9 +;/ 10 +;/ \[11 +;/ 12 +;/ \[13 +;/ 14\]\] +;/ 15 +;/ 16\) +;=>nil diff --git a/impls/tests/lib/protocols.mal b/impls/tests/lib/protocols.mal new file mode 100644 index 0000000000..819543d808 --- /dev/null +++ b/impls/tests/lib/protocols.mal @@ -0,0 +1,81 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/protocols.mal") +;=>nil + +;; Testing find-type for normal objects. +(find-type 'a) +;=>:mal/symbol +(find-type :a) +;=>:mal/keyword +(find-type (atom 0)) +;=>:mal/atom +(find-type nil) +;=>:mal/nil +(find-type true) +;=>:mal/boolean +(find-type false) +;=>:mal/boolean +(find-type 0) +;=>:mal/number +(find-type "") +;=>:mal/string +(find-type (defmacro! m (fn* [] nil))) +;=>:mal/macro +(find-type ()) +;=>:mal/list +(find-type []) +;=>:mal/vector +(find-type {}) +;=>:mal/map +(find-type (fn* [] nil)) +;=>:mal/function + +;; Testing find-type for explicit type metadata. +(find-type ^{:type :a } ()) +;=>:a +(find-type ^{:type :a } []) +;=>:a +(find-type ^{:type :a } {}) +;=>:a +(find-type ^{:type :a } (fn* [] nil)) +;=>:a + +;; Testing protocols. +(def! o1 ^{:type :t1 } [1]) +(def! o2 ^{:type :t2 } [2]) +(defprotocol p1 [m0 [this]] [ma [this a]] [mb [this & b]]) +(defprotocol p2) +(satisfies? p1 o1) +;=>false +(satisfies? p1 o2) +;=>false +(satisfies? p2 o1) +;=>false +(satisfies? p2 o2) +;=>false +(extend :t1 p1 { :m0 (fn* [this] (str "t0" this)) :ma (fn* [this a] (str "ta" this a)) :mb (fn* [this & b] (str "tb" this b))}) +;=>nil +(extend :t2 p1 { :m0 (fn* [this] (str "u0" this)) :ma (fn* [this a] (str "ua" this a)) :mb (fn* [this & b] (str "ub" this b))} p2 {}) +;=>nil +(satisfies? p1 o1) +;=>true +(satisfies? p1 o2) +;=>true +(satisfies? p2 o1) +;=>false +(satisfies? p2 o2) +;=>true + +;; Testing dispatching. +(m0 o1) +;=>"t0[1]" +(ma o1 "blue") +;=>"ta[1]blue" +(mb o1 1 2 3) +;=>"tb[1](1 2 3)" +(m0 o2) +;=>"u0[2]" +(ma o2 "blue") +;=>"ua[2]blue" +(mb o2 1 2 3) +;=>"ub[2](1 2 3)" diff --git a/impls/tests/lib/reducers.mal b/impls/tests/lib/reducers.mal new file mode 100644 index 0000000000..9aa242dac5 --- /dev/null +++ b/impls/tests/lib/reducers.mal @@ -0,0 +1,33 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/reducers.mal") +;=>nil + +;; Testing reduce +(reduce + 7 []) +;=>7 +(reduce + 7 [1]) +;=>8 +(reduce + 7 [1 2]) +;=>10 +(reduce * 7 [-1 2]) +;=>-14 +(reduce concat [1] [[2] [3]]) +;=>(1 2 3) +(reduce str "a" ["b" "c"]) +;=>"abc" + +;; Testing foldr +(foldr + 7 []) +;=>7 +(foldr + 7 [1]) +;=>8 +(foldr + 7 [1 2]) +;=>10 +(reduce * 7 [-1 2]) +;=>-14 +(foldr concat [1] [[2] [3]]) +;=>(2 3 1) +(foldr str "a" ["b" "c"]) +;=>"bca" +(foldr cons [4 5] [2 3]) +;=>(2 3 4 5) diff --git a/impls/tests/lib/test_cascade.mal b/impls/tests/lib/test_cascade.mal new file mode 100644 index 0000000000..95e4632a12 --- /dev/null +++ b/impls/tests/lib/test_cascade.mal @@ -0,0 +1,46 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/test_cascade.mal") +;=>nil + +;; Testing or +(or) +;=>nil +(or 1) +;=>1 +(or 1 2 3 4) +;=>1 +(or false 2) +;=>2 +(or false nil 3) +;=>3 +(or false nil false false nil 4) +;=>4 +(or false nil 3 false nil 4) +;=>3 +(or (or false 4)) +;=>4 + +;; Testing every? +(every? first []) +;=>true +(every? first [[1] [2]]) +;=>true +(every? first [[1] [nil] []]) +;=>false + +;; Testing some +(some first []) +;=>nil +(some first [[nil] [1] []]) +;=>1 + +(and) +;=>true +(and 1) +;=>1 +(and 1 2 3 4) +;=>4 +(and false 2) +;=>false +(and true 1 nil false) +;=>nil diff --git a/impls/tests/lib/threading.mal b/impls/tests/lib/threading.mal new file mode 100644 index 0000000000..9d3fe96eaf --- /dev/null +++ b/impls/tests/lib/threading.mal @@ -0,0 +1,23 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/threading.mal") +;=>nil + +;; Testing -> macro +(-> 7) +;=>7 +(-> (list 7 8 9) first) +;=>7 +(-> (list 7 8 9) (first)) +;=>7 +(-> (list 7 8 9) first (+ 7)) +;=>14 +(-> (list 7 8 9) rest (rest) first (+ 7)) +;=>16 + +;; Testing ->> macro +(->> "L") +;=>"L" +(->> "L" (str "A") (str "M")) +;=>"MAL" +(->> [4] (concat [3]) (concat [2]) rest (concat [1])) +;=>(1 3 4) diff --git a/impls/tests/lib/trivial.mal b/impls/tests/lib/trivial.mal new file mode 100644 index 0000000000..1d9c7c0bd3 --- /dev/null +++ b/impls/tests/lib/trivial.mal @@ -0,0 +1,16 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/trivial.mal") +;=>nil + +(inc 12) +;=>13 +(dec 12) +;=>11 +(zero? 12) +;=>false +(zero? 0) +;=>true +(identity 12) +;=>12 +(= (gensym) (gensym)) +;=>false diff --git a/impls/tests/perf1.mal b/impls/tests/perf1.mal new file mode 100644 index 0000000000..9d1db7cbc2 --- /dev/null +++ b/impls/tests/perf1.mal @@ -0,0 +1,13 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/threading.mal") ; -> +(load-file-once "../lib/perf.mal") ; time +(load-file-once "../lib/test_cascade.mal") ; or + +;;(prn "Start: basic macros performance test") + +(time (do + (or false nil false nil false nil false nil false nil 4) + (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" 7) + (-> (list 1 2 3 4 5 6 7 8 9) rest rest rest rest rest rest first))) + +;;(prn "Done: basic macros performance test") diff --git a/impls/tests/perf2.mal b/impls/tests/perf2.mal new file mode 100644 index 0000000000..4f0bc6ccde --- /dev/null +++ b/impls/tests/perf2.mal @@ -0,0 +1,11 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../tests/computations.mal") ; fib sumdown +(load-file-once "../lib/perf.mal") ; time + +;;(prn "Start: basic math/recursion test") + +(time (do + (sumdown 10) + (fib 12))) + +;;(prn "Done: basic math/recursion test") diff --git a/impls/tests/perf3.mal b/impls/tests/perf3.mal new file mode 100644 index 0000000000..da81f8dedc --- /dev/null +++ b/impls/tests/perf3.mal @@ -0,0 +1,20 @@ +(load-file "../lib/load-file-once.mal") +(load-file-once "../lib/threading.mal") ; -> +(load-file-once "../lib/perf.mal") ; run-fn-for +(load-file-once "../lib/test_cascade.mal") ; or + +;;(prn "Start: basic macros/atom test") + +(def! atm (atom (list 0 1 2 3 4 5 6 7 8 9))) + +(println "iters over 10 seconds:" + (run-fn-for + (fn* [] + (do + (or false nil false nil false nil false nil false nil (first @atm)) + (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" (first @atm)) + (-> (deref atm) rest rest rest rest rest rest first) + (swap! atm (fn* [a] (concat (rest a) (list (first a))))))) + 10)) + +;;(prn "Done: basic macros/atom test") diff --git a/impls/tests/print_argv.mal b/impls/tests/print_argv.mal new file mode 100644 index 0000000000..7c28dfb79c --- /dev/null +++ b/impls/tests/print_argv.mal @@ -0,0 +1,2 @@ +; Used by the run_argv_test.sh test harness +(prn *ARGV*) diff --git a/impls/tests/run_argv_test.sh b/impls/tests/run_argv_test.sh new file mode 100755 index 0000000000..e3682e4f9f --- /dev/null +++ b/impls/tests/run_argv_test.sh @@ -0,0 +1,39 @@ +#!/usr/bin/env bash + +# +# Usage: run_argv_test.sh +# +# Example: run_argv_test.sh python step6_file.py +# + +assert_equal() { + if [ "$1" = "$2" ] ; then + echo "OK: '$1'" + else + echo "FAIL: Expected '$1' but got '$2'" + echo + exit 1 + fi +} + +if [ -z "$1" ] ; then + echo "Usage: $0 " + exit 1 +fi + +root="$(dirname $0)" + +out="$( $@ $root/print_argv.mal aaa bbb ccc | tr -d '\r' )" +assert_equal '("aaa" "bbb" "ccc")' "$out" + +# Note: The 'make' implementation cannot handle arguments with spaces in them, +# so for now we skip this test. +# +# out="$( $@ $root/print_argv.mal aaa 'bbb ccc' ddd )" +# assert_equal '("aaa" "bbb ccc" "ddd")' "$out" + +out="$( $@ $root/print_argv.mal | tr -d '\r' )" +assert_equal '()' "$out" + +echo 'Passed all *ARGV* tests' +echo diff --git a/impls/tests/step0_repl.mal b/impls/tests/step0_repl.mal new file mode 100644 index 0000000000..4706a1ae1f --- /dev/null +++ b/impls/tests/step0_repl.mal @@ -0,0 +1,66 @@ +;; Testing basic string +abcABC123 +;=>abcABC123 + +;; Testing string containing spaces +hello mal world +;=>hello mal world + +;; Testing string containing symbols +[]{}"'* ;:() +;=>[]{}"'* ;:() + + +;; Test long string +hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) +;=>hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) + +;; Non alphanumeric characters +! +;=>! +& +;=>& ++ +;=>+ +, +;=>, +- +;=>- +/ +;=>/ +< +;=>< += +;=>= +> +;=>> +? +;=>? +@ +;=>@ +;;; Behaviour of backslash is not specified enough to test anything in step0. +^ +;=>^ +_ +;=>_ +` +;=>` +~ +;=>~ + +;>>> soft=True +;>>> optional=True +;; ------- Optional Functionality -------------- +;; ------- (Not needed for self-hosting) ------- + +;; Non alphanumeric characters +# +;=># +$ +;=>$ +% +;=>% +. +;=>. +| +;=>| diff --git a/impls/tests/step1_read_print.mal b/impls/tests/step1_read_print.mal new file mode 100644 index 0000000000..f413e2f7a3 --- /dev/null +++ b/impls/tests/step1_read_print.mal @@ -0,0 +1,295 @@ +;; Testing read of numbers +1 +;=>1 +7 +;=>7 + 7 +;=>7 +-123 +;=>-123 + + +;; Testing read of symbols ++ +;=>+ +abc +;=>abc + abc +;=>abc +abc5 +;=>abc5 +abc-def +;=>abc-def + +;; Testing non-numbers starting with a dash. +- +;=>- +-abc +;=>-abc +->> +;=>->> + +;; Testing read of lists +(+ 1 2) +;=>(+ 1 2) +() +;=>() +( ) +;=>() +(nil) +;=>(nil) +((3 4)) +;=>((3 4)) +(+ 1 (+ 2 3)) +;=>(+ 1 (+ 2 3)) + ( + 1 (+ 2 3 ) ) +;=>(+ 1 (+ 2 3)) +(* 1 2) +;=>(* 1 2) +(** 1 2) +;=>(** 1 2) +(* -3 6) +;=>(* -3 6) +(()()) +;=>(() ()) + +;; Test commas as whitespace +(1 2, 3,,,,),, +;=>(1 2 3) + + +;>>> deferrable=True + +;; +;; -------- Deferrable Functionality -------- + +;; Testing read of nil/true/false +nil +;=>nil +true +;=>true +false +;=>false + +;; Testing read of strings +"abc" +;=>"abc" + "abc" +;=>"abc" +"abc (with parens)" +;=>"abc (with parens)" +"abc\"def" +;=>"abc\"def" +"" +;=>"" +"\\" +;=>"\\" +"\\\\\\\\\\\\\\\\\\" +;=>"\\\\\\\\\\\\\\\\\\" +"&" +;=>"&" +"'" +;=>"'" +"(" +;=>"(" +")" +;=>")" +"*" +;=>"*" +"+" +;=>"+" +"," +;=>"," +"-" +;=>"-" +"/" +;=>"/" +":" +;=>":" +";" +;=>";" +"<" +;=>"<" +"=" +;=>"=" +">" +;=>">" +"?" +;=>"?" +"@" +;=>"@" +"[" +;=>"[" +"]" +;=>"]" +"^" +;=>"^" +"_" +;=>"_" +"`" +;=>"`" +"{" +;=>"{" +"}" +;=>"}" +"~" +;=>"~" +"!" +;=>"!" + +;; Testing reader errors +(1 2 +;/.*(EOF|end of input|unbalanced).* +[1 2 +;/.*(EOF|end of input|unbalanced).* +{"a" 2 +;/.*(EOF|end of input|unbalanced).* + +;;; These should throw some error with no return value +"abc +;/.*(EOF|end of input|unbalanced).* +" +;/.*(EOF|end of input|unbalanced).* +"\" +;/.*(EOF|end of input|unbalanced).* +"\\\\\\\\\\\\\\\\\\\" +;/.*(EOF|end of input|unbalanced).* +(1 "abc +;/.*(EOF|end of input|unbalanced).* +(1 "abc" +;/.*(EOF|end of input|unbalanced).* + +;; Testing read of quoting +'1 +;=>(quote 1) +'(1 2 3) +;=>(quote (1 2 3)) +`1 +;=>(quasiquote 1) +`(1 2 3) +;=>(quasiquote (1 2 3)) +`(a (b) c) +;=>(quasiquote (a (b) c)) +~1 +;=>(unquote 1) +~(1 2 3) +;=>(unquote (1 2 3)) +`(1 ~a 3) +;=>(quasiquote (1 (unquote a) 3)) +~@(1 2 3) +;=>(splice-unquote (1 2 3)) + + +;; Testing keywords +:kw +;=>:kw +(:kw1 :kw2 :kw3) +;=>(:kw1 :kw2 :kw3) + +;; Testing read of vectors +[+ 1 2] +;=>[+ 1 2] +[] +;=>[] +[ ] +;=>[] +[[3 4]] +;=>[[3 4]] +[+ 1 [+ 2 3]] +;=>[+ 1 [+ 2 3]] + [ + 1 [+ 2 3 ] ] +;=>[+ 1 [+ 2 3]] +([]) +;=>([]) + +;; Testing read of hash maps +{} +;=>{} +{ } +;=>{} +{"abc" 1} +;=>{"abc" 1} +{"a" {"b" 2}} +;=>{"a" {"b" 2}} +{"a" {"b" {"c" 3}}} +;=>{"a" {"b" {"c" 3}}} +{ "a" {"b" { "cde" 3 } }} +;=>{"a" {"b" {"cde" 3}}} +;;; The regexp sorcery here ensures that each key goes with the correct +;;; value and that each key appears only once. +{"a1" 1 "a2" 2 "a3" 3} +;/{"a([1-3])" \1 "a(?!\1)([1-3])" \2 "a(?!\1)(?!\2)([1-3])" \3} +{ :a {:b { :cde 3 } }} +;=>{:a {:b {:cde 3}}} +{"1" 1} +;=>{"1" 1} +({}) +;=>({}) + +;; Testing read of comments + ;; whole line comment (not an exception) +1 ; comment after expression +;=>1 +1; comment after expression +;=>1 + +;; Testing read of @/deref +@a +;=>(deref a) + +;; Colon character inside a symbol +a: +;=>a: + +;>>> soft=True +;>>> optional=True +;; +;; -------- Optional Functionality -------- + +;; Testing read of ^/metadata +^{"a" 1} [1 2 3] +;=>(with-meta [1 2 3] {"a" 1}) +^2 [1 2 3] +;=>(with-meta [1 2 3] 2) + +;; Non alphanumeric characters in strings +;;; \t is not specified enough to be tested +"\n" +;=>"\n" +"#" +;=>"#" +"$" +;=>"$" +"%" +;=>"%" +"." +;=>"." +"\\" +;=>"\\" +"|" +;=>"|" + +;; Non alphanumeric characters in comments +1;! +;=>1 +1;" +;=>1 +1;# +;=>1 +1;$ +;=>1 +1;% +;=>1 +1;' +;=>1 +1;\ +;=>1 +1;\\ +;=>1 +1;\\\ +;=>1 +1;` +;=>1 +;;; Hopefully less problematic characters +1; &()*+,-./:;<=>?@[]^_{|}~ +;=>1 diff --git a/impls/tests/step2_eval.mal b/impls/tests/step2_eval.mal new file mode 100644 index 0000000000..90e3a0e9ed --- /dev/null +++ b/impls/tests/step2_eval.mal @@ -0,0 +1,53 @@ +;; Testing evaluation of arithmetic operations +(+ 1 2) +;=>3 + +(+ 5 (* 2 3)) +;=>11 + +(- (+ 5 (* 2 3)) 3) +;=>8 + +(/ (- (+ 5 (* 2 3)) 3) 4) +;=>2 + +(/ (- (+ 515 (* 87 311)) 302) 27) +;=>1010 + +(* -3 6) +;=>-18 + +(/ (- (+ 515 (* -87 311)) 296) 27) +;=>-994 + +;;; This should throw an error with no return value +(abc 1 2 3) +;/.+ + +;; Testing empty list +() +;=>() + +;>>> deferrable=True +;; +;; -------- Deferrable Functionality -------- + +;; Testing nil inside vector +[nil] +;=>[nil] + +;; Testing evaluation within collection literals +[1 2 (+ 1 2)] +;=>[1 2 3] + +{"a" (+ 7 8)} +;=>{"a" 15} + +{:a (+ 7 8)} +;=>{:a 15} + +;; Check that evaluation hasn't broken empty collections +[] +;=>[] +{} +;=>{} diff --git a/impls/tests/step3_env.mal b/impls/tests/step3_env.mal new file mode 100644 index 0000000000..1a84d442d4 --- /dev/null +++ b/impls/tests/step3_env.mal @@ -0,0 +1,107 @@ +;; Testing REPL_ENV +(+ 1 2) +;=>3 +(/ (- (+ 5 (* 2 3)) 3) 4) +;=>2 + + +;; Testing def! +(def! x 3) +;=>3 +x +;=>3 +(def! x 4) +;=>4 +x +;=>4 +(def! y (+ 1 7)) +;=>8 +y +;=>8 + +;; Verifying symbols are case-sensitive +(def! mynum 111) +;=>111 +(def! MYNUM 222) +;=>222 +mynum +;=>111 +MYNUM +;=>222 + +;; Check env lookup non-fatal error +(abc 1 2 3) +;/.*'?abc'? not found.* +;; Check that error aborts def! +(def! w 123) +(def! w (abc)) +w +;=>123 + +;; Testing let* +(let* (z 9) z) +;=>9 +(let* (x 9) x) +;=>9 +x +;=>4 +(let* (z (+ 2 3)) (+ 1 z)) +;=>6 +(let* (p (+ 2 3) q (+ 2 p)) (+ p q)) +;=>12 +(def! y (let* (z 7) z)) +y +;=>7 + +;; Testing outer environment +(def! a 4) +;=>4 +(let* (q 9) q) +;=>9 +(let* (q 9) a) +;=>4 +(let* (z 2) (let* (q 9) a)) +;=>4 + +;>>> deferrable=True +;; +;; -------- Deferrable Functionality -------- + +;; Testing let* with vector bindings +(let* [z 9] z) +;=>9 +(let* [p (+ 2 3) q (+ 2 p)] (+ p q)) +;=>12 + +;; Testing vector evaluation +(let* (a 5 b 6) [3 4 a [b 7] 8]) +;=>[3 4 5 [6 7] 8] + +;>>> soft=True +;>>> optional=True +;; +;; -------- Optional Functionality -------- + +;; Check that last assignment takes priority +(let* (x 2 x 3) x) +;=>3 + +;; Check DEBUG-EVAL +(let* (DEBUG-EVAL false) (- 3 1)) +;=>2 +(let* (DEBUG-EVAL nil) (- 3 1)) +;=>2 +;;; Some implementations avoid a recursive EVAL when the first element +;;; is a symbol or when map(EVAL, list) encounters a number. +(let* (a 3 b 2 DEBUG-EVAL true) (- a b)) +;/EVAL: \(- a b\).*\n1 +;; Check the readably pretty-printing option +(let* (DEBUG-EVAL 1) "a") +;/EVAL: "a".*\n"a" +;; Usually false values +(let* (a 3 DEBUG-EVAL ()) a) +;/EVAL: a.*\n3 +(let* (a 3 DEBUG-EVAL 0) a) +;/EVAL: a.*\n3 +(let* (a 3 DEBUG-EVAL "") a) +;/EVAL: a.*\n3 diff --git a/impls/tests/step4_if_fn_do.mal b/impls/tests/step4_if_fn_do.mal new file mode 100644 index 0000000000..fbecb7d448 --- /dev/null +++ b/impls/tests/step4_if_fn_do.mal @@ -0,0 +1,547 @@ +;; ----------------------------------------------------- + + +;; Testing list functions +(list) +;=>() +(list? (list)) +;=>true +(list? nil) +;=>false +(empty? (list)) +;=>true +(empty? (list 1)) +;=>false +(list 1 2 3) +;=>(1 2 3) +(count (list 1 2 3)) +;=>3 +(count (list)) +;=>0 +(count nil) +;=>0 +(if (> (count (list 1 2 3)) 3) 89 78) +;=>78 +(if (>= (count (list 1 2 3)) 3) 89 78) +;=>89 + + +;; Testing if form +(if true 7 8) +;=>7 +(if false 7 8) +;=>8 +(if false 7 false) +;=>false +(if true (+ 1 7) (+ 1 8)) +;=>8 +(if false (+ 1 7) (+ 1 8)) +;=>9 +(if nil 7 8) +;=>8 +(if 0 7 8) +;=>7 +(if (list) 7 8) +;=>7 +(if (list 1 2 3) 7 8) +;=>7 +(= (list) nil) +;=>false + + +;; Testing 1-way if form +(if false (+ 1 7)) +;=>nil +(if nil 8) +;=>nil +(if nil 8 7) +;=>7 +(if true (+ 1 7)) +;=>8 + + +;; Testing basic conditionals +(= 2 1) +;=>false +(= 1 1) +;=>true +(= 1 2) +;=>false +(= 1 (+ 1 1)) +;=>false +(= 2 (+ 1 1)) +;=>true + +(> 2 1) +;=>true +(> 1 1) +;=>false +(> 1 2) +;=>false + +(>= 2 1) +;=>true +(>= 1 1) +;=>true +(>= 1 2) +;=>false + +(< 2 1) +;=>false +(< 1 1) +;=>false +(< 1 2) +;=>true + +(<= 2 1) +;=>false +(<= 1 1) +;=>true +(<= 1 2) +;=>true + + +;; Testing equality and the representation of nil false true +(= 1 1) +;=>true +(= 0 0) +;=>true +(= 1 0) +;=>false + +(= nil nil) +;=>true +(= nil false) +;=>false +(= nil true) +;=>false +(= nil 0) +;=>false +(= nil 1) +;=>false +(= nil "") +;=>false +(= nil ()) +;=>false +(= nil []) +;=>false + +(= false nil) +;=>false +(= false false) +;=>true +(= false true) +;=>false +(= false 0) +;=>false +(= false 1) +;=>false +(= false "") +;=>false +(= false ()) +;=>false + +(= true nil) +;=>false +(= true false) +;=>false +(= true true) +;=>true +(= true 0) +;=>false +(= true 1) +;=>false +(= true "") +;=>false +(= true ()) +;=>false + +(= (list) (list)) +;=>true +(= (list) ()) +;=>true +(= (list 1 2) (list 1 2)) +;=>true +(= (list 1) (list)) +;=>false +(= (list) (list 1)) +;=>false +(= 0 (list)) +;=>false +(= (list) 0) +;=>false +(= (list nil) (list)) +;=>false + + +;; Testing builtin and user defined functions +(+ 1 2) +;=>3 +( (fn* (a b) (+ b a)) 3 4) +;=>7 +( (fn* () 4) ) +;=>4 +( (fn* () ()) ) +;=>() + +( (fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7) +;=>8 + + +;; Testing closures +( ( (fn* (a) (fn* (b) (+ a b))) 5) 7) +;=>12 + +(def! gen-plus5 (fn* () (fn* (b) (+ 5 b)))) +(def! plus5 (gen-plus5)) +(plus5 7) +;=>12 + +(def! gen-plusX (fn* (x) (fn* (b) (+ x b)))) +(def! plus7 (gen-plusX 7)) +(plus7 8) +;=>15 + +(let* [b 0 f (fn* [] b)] (let* [b 1] (f))) +;=>0 + +((let* [b 0] (fn* [] b))) +;=>0 + +;; Testing do form +(do (prn 101)) +;/101 +;=>nil +(do (prn 102) 7) +;/102 +;=>7 +(do (prn 101) (prn 102) (+ 1 2)) +;/101 +;/102 +;=>3 + +(do (def! a 6) 7 (+ a 8)) +;=>14 +a +;=>6 + +;; Testing special form case-sensitivity +(def! DO (fn* (a) 7)) +(DO 3) +;=>7 + +;; Testing recursive sumdown function +(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) +(sumdown 1) +;=>1 +(sumdown 2) +;=>3 +(sumdown 6) +;=>21 + + +;; Testing recursive fibonacci function +(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) +(fib 1) +;=>1 +(fib 2) +;=>2 +(fib 4) +;=>5 + + +;; Testing recursive function in environment. +(let* (f (fn* () x) x 3) (f)) +;=>3 +(let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1)) +;=>nil +(let* (f (fn* (n) (if (= n 0) 0 (g (- n 1)))) g (fn* (n) (f n))) (f 2)) +;=>0 + + +;>>> deferrable=True +;; +;; -------- Deferrable Functionality -------- + +;; Testing if on strings + +(if "" 7 8) +;=>7 + +;; Testing string equality + +(= "" "") +;=>true +(= "abc" "abc") +;=>true +(= "abc" "") +;=>false +(= "" "abc") +;=>false +(= "abc" "def") +;=>false +(= "abc" "ABC") +;=>false +(= (list) "") +;=>false +(= "" (list)) +;=>false + +;; Testing variable length arguments + +( (fn* (& more) (count more)) 1 2 3) +;=>3 +( (fn* (& more) (list? more)) 1 2 3) +;=>true +( (fn* (& more) (count more)) 1) +;=>1 +( (fn* (& more) (count more)) ) +;=>0 +( (fn* (& more) (list? more)) ) +;=>true +( (fn* (a & more) (count more)) 1 2 3) +;=>2 +( (fn* (a & more) (count more)) 1) +;=>0 +( (fn* (a & more) (list? more)) 1) +;=>true + + +;; Testing language defined not function +(not false) +;=>true +(not nil) +;=>true +(not true) +;=>false +(not "a") +;=>false +(not 0) +;=>false + + +;; ----------------------------------------------------- + +;; Testing string quoting + +"" +;=>"" + +"abc" +;=>"abc" + +"abc def" +;=>"abc def" + +"\"" +;=>"\"" + +"abc\ndef\nghi" +;=>"abc\ndef\nghi" + +"abc\\def\\ghi" +;=>"abc\\def\\ghi" + +"\\n" +;=>"\\n" + +;; Testing pr-str + +(pr-str) +;=>"" + +(pr-str "") +;=>"\"\"" + +(pr-str "abc") +;=>"\"abc\"" + +(pr-str "abc def" "ghi jkl") +;=>"\"abc def\" \"ghi jkl\"" + +(pr-str "\"") +;=>"\"\\\"\"" + +(pr-str (list 1 2 "abc" "\"") "def") +;=>"(1 2 \"abc\" \"\\\"\") \"def\"" + +(pr-str "abc\ndef\nghi") +;=>"\"abc\\ndef\\nghi\"" + +(pr-str "abc\\def\\ghi") +;=>"\"abc\\\\def\\\\ghi\"" + +(pr-str (list)) +;=>"()" + +;; Testing str + +(str) +;=>"" + +(str "") +;=>"" + +(str "abc") +;=>"abc" + +(str "\"") +;=>"\"" + +(str 1 "abc" 3) +;=>"1abc3" + +(str "abc def" "ghi jkl") +;=>"abc defghi jkl" + +(str "abc\ndef\nghi") +;=>"abc\ndef\nghi" + +(str "abc\\def\\ghi") +;=>"abc\\def\\ghi" + +(str (list 1 2 "abc" "\"") "def") +;=>"(1 2 abc \")def" + +(str (list)) +;=>"()" + +;; Testing prn +(prn) +;/ +;=>nil + +(prn "") +;/"" +;=>nil + +(prn "abc") +;/"abc" +;=>nil + +(prn "abc def" "ghi jkl") +;/"abc def" "ghi jkl" + +(prn "\"") +;/"\\"" +;=>nil + +(prn "abc\ndef\nghi") +;/"abc\\ndef\\nghi" +;=>nil + +(prn "abc\\def\\ghi") +;/"abc\\\\def\\\\ghi" +nil + +(prn (list 1 2 "abc" "\"") "def") +;/\(1 2 "abc" "\\""\) "def" +;=>nil + + +;; Testing println +(println) +;/ +;=>nil + +(println "") +;/ +;=>nil + +(println "abc") +;/abc +;=>nil + +(println "abc def" "ghi jkl") +;/abc def ghi jkl + +(println "\"") +;/" +;=>nil + +(println "abc\ndef\nghi") +;/abc +;/def +;/ghi +;=>nil + +(println "abc\\def\\ghi") +;/abc\\def\\ghi +;=>nil + +(println (list 1 2 "abc" "\"") "def") +;/\(1 2 abc "\) def +;=>nil + + +;; Testing keywords +(= :abc :abc) +;=>true +(= :abc :def) +;=>false +(= :abc ":abc") +;=>false +(= (list :abc) (list :abc)) +;=>true + +;; Testing vector truthiness +(if [] 7 8) +;=>7 + +;; Testing vector printing +(pr-str [1 2 "abc" "\""] "def") +;=>"[1 2 \"abc\" \"\\\"\"] \"def\"" + +(pr-str []) +;=>"[]" + +(str [1 2 "abc" "\""] "def") +;=>"[1 2 abc \"]def" + +(str []) +;=>"[]" + + +;; Testing vector functions +(count [1 2 3]) +;=>3 +(empty? [1 2 3]) +;=>false +(empty? []) +;=>true +(list? [4 5 6]) +;=>false + +;; Testing vector equality +(= [] (list)) +;=>true +(= [7 8] [7 8]) +;=>true +(= [:abc] [:abc]) +;=>true +(= (list 1 2) [1 2]) +;=>true +(= (list 1) []) +;=>false +(= [] [1]) +;=>false +(= 0 []) +;=>false +(= [] 0) +;=>false +(= [] "") +;=>false +(= "" []) +;=>false + +;; Testing vector parameter lists +( (fn* [] 4) ) +;=>4 +( (fn* [f x] (f x)) (fn* [a] (+ 1 a)) 7) +;=>8 + +;; Nested vector/list equality +(= [(list)] (list [])) +;=>true +(= [1 2 (list 3 4 [5 6])] (list 1 2 [3 4 (list 5 6)])) +;=>true diff --git a/impls/tests/step5_tco.mal b/impls/tests/step5_tco.mal new file mode 100644 index 0000000000..0e87b5babc --- /dev/null +++ b/impls/tests/step5_tco.mal @@ -0,0 +1,23 @@ +;; Testing recursive tail-call function + +(def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc))))) + +;; TODO: test let*, and do for TCO + +(sum2 10 0) +;=>55 + +(def! res2 nil) +;=>nil +(def! res2 (sum2 10000 0)) +res2 +;=>50005000 + + +;; Test mutually recursive tail-call functions + +(def! foo (fn* (n) (if (= n 0) 0 (bar (- n 1))))) +(def! bar (fn* (n) (if (= n 0) 0 (foo (- n 1))))) + +(foo 10000) +;=>0 diff --git a/impls/tests/step6_file.mal b/impls/tests/step6_file.mal new file mode 100644 index 0000000000..2cc0acca7c --- /dev/null +++ b/impls/tests/step6_file.mal @@ -0,0 +1,205 @@ +;;; TODO: really a step5 test +;; +;; Testing that (do (do)) not broken by TCO +(do (do 1 2)) +;=>2 + +;; +;; Testing read-string, eval and slurp +(read-string "(1 2 (3 4) nil)") +;=>(1 2 (3 4) nil) + +(= nil (read-string "nil")) +;=>true + +(read-string "(+ 2 3)") +;=>(+ 2 3) + +(read-string "\"\n\"") +;=>"\n" + +(read-string "7 ;; comment") +;=>7 + +;;; Differing output, but make sure no fatal error +(read-string ";; comment") + +(eval (read-string "(+ 2 3)")) +;=>5 + +(slurp "../tests/test.txt") +;=>"A line of text\n" + +;;; Load the same file twice. +(slurp "../tests/test.txt") +;=>"A line of text\n" + +;; Testing load-file + +(load-file "../tests/inc.mal") +;=>nil +(inc1 7) +;=>8 +(inc2 7) +;=>9 +(inc3 9) +;=>12 + +;; +;; Testing atoms + +(def! inc3 (fn* (a) (+ 3 a))) + +(def! a (atom 2)) +;=>(atom 2) + +(atom? a) +;=>true + +(atom? 1) +;=>false + +(deref a) +;=>2 + +(reset! a 3) +;=>3 + +(deref a) +;=>3 + +(swap! a inc3) +;=>6 + +(deref a) +;=>6 + +(swap! a (fn* (a) a)) +;=>6 + +(swap! a (fn* (a) (* 2 a))) +;=>12 + +(swap! a (fn* (a b) (* a b)) 10) +;=>120 + +(swap! a + 3) +;=>123 + +;; Test that do only evals each slot once +(def! b (atom 0)) +(do (swap! b + 1) (swap! b + 10) (swap! b + 100)) +(deref b) +;=>111 + +;; Testing swap!/closure interaction +(def! inc-it (fn* (a) (+ 1 a))) +(def! atm (atom 7)) +(def! f (fn* () (swap! atm inc-it))) +(f) +;=>8 +(f) +;=>9 + +;; Testing whether closures can retain atoms +(def! g (let* (atm (atom 0)) (fn* () (deref atm)))) +(def! atm (atom 1)) +(g) +;=>0 + +;>>> deferrable=True +;; +;; -------- Deferrable Functionality -------- + +;; Testing read-string parsing errors +(read-string "(+ 1") +;/.*(EOF|end of input|unbalanced).* +(read-string "[+ 1") +;/.*(EOF|end of input|unbalanced).* +(read-string "{:a 1") +;/.*(EOF|end of input|unbalanced).* + +;; Testing reading of large files +(load-file "../tests/computations.mal") +;=>nil +(sumdown 2) +;=>3 +(fib 2) +;=>1 + +;; Testing `@` reader macro (short for `deref`) +(def! atm (atom 9)) +@atm +;=>9 + +;;; TODO: really a step5 test +;; Testing that vector params not broken by TCO +(def! g (fn* [] 78)) +(g) +;=>78 +(def! g (fn* [a] (+ a 78))) +(g 3) +;=>81 + +;; +;; Testing that *ARGV* exists and is an empty list +(list? *ARGV*) +;=>true +*ARGV* +;=>() + +;; +;; Testing that eval sets aa in root scope, and that it is found in nested scope +(let* (b 12) (do (eval (read-string "(def! aa 7)")) aa )) +;=>7 + +;>>> soft=True +;>>> optional=True +;; +;; -------- Optional Functionality -------- + +;; Testing comments in a file +(load-file "../tests/incB.mal") +;=>nil +(inc4 7) +;=>11 +(inc5 7) +;=>12 + +;; Testing map literal across multiple lines in a file +(load-file "../tests/incC.mal") +;=>nil +mymap +;=>{"a" 1} + +;; Checking that eval does not use local environments. +(def! a 1) +;=>1 +(let* (a 2) (eval (read-string "a"))) +;=>1 + +;; Non alphanumeric characters in comments in read-string +(read-string "1;!") +;=>1 +(read-string "1;\"") +;=>1 +(read-string "1;#") +;=>1 +(read-string "1;$") +;=>1 +(read-string "1;%") +;=>1 +(read-string "1;'") +;=>1 +(read-string "1;\\") +;=>1 +(read-string "1;\\\\") +;=>1 +(read-string "1;\\\\\\") +;=>1 +(read-string "1;`") +;=>1 +;;; Hopefully less problematic characters can be checked together +(read-string "1; &()*+,-./:;<=>?@[]^_{|}~") +;=>1 + diff --git a/impls/tests/step7_quote.mal b/impls/tests/step7_quote.mal new file mode 100644 index 0000000000..9f99ca7cf1 --- /dev/null +++ b/impls/tests/step7_quote.mal @@ -0,0 +1,300 @@ +;; Testing cons function +(cons 1 (list)) +;=>(1) +(cons 1 (list 2)) +;=>(1 2) +(cons 1 (list 2 3)) +;=>(1 2 3) +(cons (list 1) (list 2 3)) +;=>((1) 2 3) + +(def! a (list 2 3)) +(cons 1 a) +;=>(1 2 3) +a +;=>(2 3) + +;; Testing concat function +(concat) +;=>() +(concat (list 1 2)) +;=>(1 2) +(concat (list 1 2) (list 3 4)) +;=>(1 2 3 4) +(concat (list 1 2) (list 3 4) (list 5 6)) +;=>(1 2 3 4 5 6) +(concat (concat)) +;=>() +(concat (list) (list)) +;=>() +(= () (concat)) +;=>true + +(def! a (list 1 2)) +(def! b (list 3 4)) +(concat a b (list 5 6)) +;=>(1 2 3 4 5 6) +a +;=>(1 2) +b +;=>(3 4) + +;; Testing regular quote +(quote 7) +;=>7 +(quote (1 2 3)) +;=>(1 2 3) +(quote (1 2 (3 4))) +;=>(1 2 (3 4)) + +;; Testing simple quasiquote +(quasiquote nil) +;=>nil +(quasiquote 7) +;=>7 +(quasiquote a) +;=>a +(quasiquote {"a" b}) +;=>{"a" b} + +;; Testing quasiquote with lists +(quasiquote ()) +;=>() +(quasiquote (1 2 3)) +;=>(1 2 3) +(quasiquote (a)) +;=>(a) +(quasiquote (1 2 (3 4))) +;=>(1 2 (3 4)) +(quasiquote (nil)) +;=>(nil) +(quasiquote (1 ())) +;=>(1 ()) +(quasiquote (() 1)) +;=>(() 1) +(quasiquote (1 () 2)) +;=>(1 () 2) +(quasiquote (())) +;=>(()) + +;; Testing unquote +(quasiquote (unquote 7)) +;=>7 +(def! a 8) +;=>8 +(quasiquote a) +;=>a +(quasiquote (unquote a)) +;=>8 +(quasiquote (1 a 3)) +;=>(1 a 3) +(quasiquote (1 (unquote a) 3)) +;=>(1 8 3) +(def! b (quote (1 "b" "d"))) +;=>(1 "b" "d") +(quasiquote (1 b 3)) +;=>(1 b 3) +(quasiquote (1 (unquote b) 3)) +;=>(1 (1 "b" "d") 3) +(quasiquote ((unquote 1) (unquote 2))) +;=>(1 2) + +;; Quasiquote and environments +(let* (x 0) (quasiquote (unquote x))) +;=>0 + +;; Testing splice-unquote +(def! c (quote (1 "b" "d"))) +;=>(1 "b" "d") +(quasiquote (1 c 3)) +;=>(1 c 3) +(quasiquote (1 (splice-unquote c) 3)) +;=>(1 1 "b" "d" 3) +(quasiquote (1 (splice-unquote c))) +;=>(1 1 "b" "d") +(quasiquote ((splice-unquote c) 2)) +;=>(1 "b" "d" 2) +(quasiquote ((splice-unquote c) (splice-unquote c))) +;=>(1 "b" "d" 1 "b" "d") + +;; Testing symbol equality +(= (quote abc) (quote abc)) +;=>true +(= (quote abc) (quote abcd)) +;=>false +(= (quote abc) "abc") +;=>false +(= "abc" (quote abc)) +;=>false +(= "abc" (str (quote abc))) +;=>true +(= (quote abc) nil) +;=>false +(= nil (quote abc)) +;=>false + +;>>> deferrable=True +;; +;; -------- Deferrable Functionality -------- + +;; Testing ' (quote) reader macro +'7 +;=>7 +'(1 2 3) +;=>(1 2 3) +'(1 2 (3 4)) +;=>(1 2 (3 4)) + +;; Testing cons and concat with vectors + +(cons 1 []) +;=>(1) +(cons [1] [2 3]) +;=>([1] 2 3) +(cons 1 [2 3]) +;=>(1 2 3) +(concat [1 2] (list 3 4) [5 6]) +;=>(1 2 3 4 5 6) +(concat [1 2]) +;=>(1 2) + +;>>> optional=True +;; +;; -------- Optional Functionality -------- + +;; Testing ` (quasiquote) reader macro +`7 +;=>7 +`(1 2 3) +;=>(1 2 3) +`(1 2 (3 4)) +;=>(1 2 (3 4)) +`(nil) +;=>(nil) + +;; Testing ~ (unquote) reader macro +`~7 +;=>7 +(def! a 8) +;=>8 +`(1 ~a 3) +;=>(1 8 3) +(def! b '(1 "b" "d")) +;=>(1 "b" "d") +`(1 b 3) +;=>(1 b 3) +`(1 ~b 3) +;=>(1 (1 "b" "d") 3) + +;; Testing ~@ (splice-unquote) reader macro +(def! c '(1 "b" "d")) +;=>(1 "b" "d") +`(1 c 3) +;=>(1 c 3) +`(1 ~@c 3) +;=>(1 1 "b" "d" 3) + +;>>> soft=True + +;; Testing vec function + +(vec (list)) +;=>[] +(vec (list 1)) +;=>[1] +(vec (list 1 2)) +;=>[1 2] +(vec []) +;=>[] +(vec [1 2]) +;=>[1 2] + +;; Testing that vec does not mutate the original list +(def! a (list 1 2)) +(vec a) +;=>[1 2] +a +;=>(1 2) + +;; Test quine +((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) +;=>((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) + +;; Testing quasiquote with vectors +(quasiquote []) +;=>[] +(quasiquote [[]]) +;=>[[]] +(quasiquote [()]) +;=>[()] +(quasiquote ([])) +;=>([]) +(def! a 8) +;=>8 +`[1 a 3] +;=>[1 a 3] +(quasiquote [a [] b [c] d [e f] g]) +;=>[a [] b [c] d [e f] g] + +;; Testing unquote with vectors +`[~a] +;=>[8] +`[(~a)] +;=>[(8)] +`([~a]) +;=>([8]) +`[a ~a a] +;=>[a 8 a] +`([a ~a a]) +;=>([a 8 a]) +`[(a ~a a)] +;=>[(a 8 a)] + +;; Testing splice-unquote with vectors +(def! c '(1 "b" "d")) +;=>(1 "b" "d") +`[~@c] +;=>[1 "b" "d"] +`[(~@c)] +;=>[(1 "b" "d")] +`([~@c]) +;=>([1 "b" "d"]) +`[1 ~@c 3] +;=>[1 1 "b" "d" 3] +`([1 ~@c 3]) +;=>([1 1 "b" "d" 3]) +`[(1 ~@c 3)] +;=>[(1 1 "b" "d" 3)] + +;; Misplaced unquote or splice-unquote +`(0 unquote) +;=>(0 unquote) +`(0 splice-unquote) +;=>(0 splice-unquote) +`[unquote 0] +;=>[unquote 0] +`[splice-unquote 0] +;=>[splice-unquote 0] +`(0 unquote 1) +;=>(0 unquote 1) +`(0 splice-unquote ()) +;=>(0 splice-unquote ()) + +(let* (DEBUG-EVAL true) `nil) +;/EVAL: nil.*\nnil +(let* (DEBUG-EVAL true) `7) +;/EVAL: 7.*\n7 +(let* (DEBUG-EVAL true) `a) +;/EVAL: \(quote a\).*\na +(let* (DEBUG-EVAL true) `{"a" b}) +;/EVAL: \(quote \{"a" b\}\).*\n\{"a" b\} +(let* (DEBUG-EVAL true) `()) +;/EVAL: \(\).*\n\(\) +(let* (DEBUG-EVAL true) `(a 2)) +;/EVAL: \(cons \(quote a\) \(cons 2 \(\)\)\).*\n\(a 2\) +(let* (DEBUG-EVAL true) `(~a 3)) +;/EVAL: \(cons a \(cons 3 \(\)\)\).*\n\(8 3\) +(let* (DEBUG-EVAL true) `(1 ~@c 3)) +;/EVAL: \(cons 1 \(concat c \(cons 3 \(\)\)\)\).*\n\(1 1 "b" "d" 3\) +(let* (DEBUG-EVAL true) `[]) +;/EVAL: \(vec \(\)\).*\n\[\] diff --git a/impls/tests/step8_macros.mal b/impls/tests/step8_macros.mal new file mode 100644 index 0000000000..447a00b1dc --- /dev/null +++ b/impls/tests/step8_macros.mal @@ -0,0 +1,158 @@ +;; Testing trivial macros +(defmacro! one (fn* () 1)) +(one) +;=>1 +(defmacro! two (fn* () 2)) +(two) +;=>2 + +;; Testing unless macros +(defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a))) +(unless false 7 8) +;=>7 +(unless true 7 8) +;=>8 +(defmacro! unless2 (fn* (pred a b) (list 'if (list 'not pred) a b))) +(unless2 false 7 8) +;=>7 +(unless2 true 7 8) +;=>8 + +;; Testing evaluation of macro result +(defmacro! identity (fn* (x) x)) +(let* (a 123) (identity a)) +;=>123 + +;; Test that macros do not break empty list +() +;=>() + +;; Test that macros do not break quasiquote +`(1) +;=>(1) + +;>>> deferrable=True +;; +;; -------- Deferrable Functionality -------- + +;; Testing non-macro function +(not (= 1 1)) +;=>false +;;; This should fail if it is a macro +(not (= 1 2)) +;=>true + +;; Testing nth, first and rest functions + +(nth (list 1) 0) +;=>1 +(nth (list 1 2) 1) +;=>2 +(nth (list 1 2 nil) 2) +;=>nil +(def! x "x") +(def! x (nth (list 1 2) 2)) +x +;=>"x" + +(first (list)) +;=>nil +(first (list 6)) +;=>6 +(first (list 7 8 9)) +;=>7 + +(rest (list)) +;=>() +(rest (list 6)) +;=>() +(rest (list 7 8 9)) +;=>(8 9) + + +;; Testing cond macro + +(cond) +;=>nil +(cond true 7) +;=>7 +(cond false 7) +;=>nil +(cond true 7 true 8) +;=>7 +(cond false 7 true 8) +;=>8 +(cond false 7 false 8 "else" 9) +;=>9 +(cond false 7 (= 2 2) 8 "else" 9) +;=>8 +(cond false 7 false 8 false 9) +;=>nil + +;; Testing EVAL in let* + +(let* (x (cond false "no" true "yes")) x) +;=>"yes" + + +;; Testing nth, first, rest with vectors + +(nth [1] 0) +;=>1 +(nth [1 2] 1) +;=>2 +(nth [1 2 nil] 2) +;=>nil +(def! x "x") +(def! x (nth [1 2] 2)) +x +;=>"x" + +(first []) +;=>nil +(first nil) +;=>nil +(first [10]) +;=>10 +(first [10 11 12]) +;=>10 +(rest []) +;=>() +(rest nil) +;=>() +(rest [10]) +;=>() +(rest [10 11 12]) +;=>(11 12) +(rest (cons 10 [11 12])) +;=>(11 12) + +;; Testing EVAL in vector let* + +(let* [x (cond false "no" true "yes")] x) +;=>"yes" + +;; Test return value of defmacro! +(let* [m (defmacro! _ (fn* [] 1))] (macro? m)) +;=>true + +;>>> soft=True +;>>> optional=True +;; +;; ------- Optional Functionality -------------- +;; ------- (Not needed for self-hosting) ------- + +;; Test that macros use closures +(def! x 2) +(defmacro! a (fn* [] x)) +(a) +;=>2 +(let* (x 3) (a)) +;=>2 + +(let* (DEBUG-EVAL true) (unless x foo (- 4 3))) +;/EVAL: \(if x \(- 4 3\) foo\).*\n1 +(let* (DEBUG-EVAL true) (unless2 x foo (- 4 3))) +;/EVAL: \(if \(not x\) foo \(- 4 3\)\).*\n1 +(let* (DEBUG-EVAL true) (cond x (- 4 3) foo bar)) +;/EVAL: \(if x \(- 4 3\) \(cond foo bar\)\).*\n1 diff --git a/impls/tests/step9_try.mal b/impls/tests/step9_try.mal new file mode 100644 index 0000000000..7c99487e36 --- /dev/null +++ b/impls/tests/step9_try.mal @@ -0,0 +1,484 @@ +;; +;; Testing throw + +(throw "err1") +;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*err1.* + +;; +;; Testing try*/catch* + +(try* 123 (catch* e 456)) +;=>123 + +(try* abc (catch* exc (prn "exc is:" exc))) +;/"exc is:" "'?abc'? not found" +;=>nil + +(try* (abc 1 2) (catch* exc (prn "exc is:" exc))) +;/"exc is:" "'?abc'? not found" +;=>nil + +;; Make sure error from core can be caught +(try* (nth () 1) (catch* exc (prn "exc is:" exc))) +;/"exc is:".*(length|range|[Bb]ounds|beyond).* +;=>nil + +;; Make sure no double eval (no TCO from try block) +(try* (list 1) (catch* exc (prn "exc is:" exc))) +;=>(1) + +(try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) +;/"exc:" "my exception" +;=>7 + +;; Test that exception handlers get restored correctly +(try* (do (try* "t1" (catch* e "c1")) (throw "e1")) (catch* e "c2")) +;=>"c2" +(try* (try* (throw "e1") (catch* e (throw "e2"))) (catch* e "c2")) +;=>"c2" + +;;; Test that throw is a function: +(try* (map throw (list "my err")) (catch* exc exc)) +;=>"my err" + + +;; +;; Testing builtin functions + +(symbol? 'abc) +;=>true +(symbol? "abc") +;=>false + +(nil? nil) +;=>true +(nil? false) +;=>false +(nil? true) +;=>false +(nil? ()) +;=>false +(nil? 0) +;=>false + +(true? nil) +;=>false +(true? false) +;=>false +(true? true) +;=>true +(true? 1) +;=>false +(true? true?) +;=>false + +(false? nil) +;=>false +(false? false) +;=>true +(false? true) +;=>false +(false? "") +;=>false +(false? 0) +;=>false +(false? ()) +;=>false +(false? []) +;=>false +(false? {}) +;=>false +(false? nil) +;=>false + +;; Testing apply function with core functions +(apply + (list 2 3)) +;=>5 +(apply + 4 (list 5)) +;=>9 +(apply prn (list 1 2 "3" (list))) +;/1 2 "3" \(\) +;=>nil +(apply prn 1 2 (list "3" (list))) +;/1 2 "3" \(\) +;=>nil +(apply list (list)) +;=>() +(apply symbol? (list (quote two))) +;=>true + +;; Testing apply function with user functions +(apply (fn* (a b) (+ a b)) (list 2 3)) +;=>5 +(apply (fn* (a b) (+ a b)) 4 (list 5)) +;=>9 + +;; Testing apply function with macros +(defmacro! m (fn* [a b] (+ a b))) +(apply m (list 2 3)) +;=>5 +(apply m 4 (list 5)) +;=>9 + +;; Testing map function +(def! nums (list 1 2 3)) +(def! double (fn* (a) (* 2 a))) +(double 3) +;=>6 +(map double nums) +;=>(2 4 6) +(map (fn* (x) (symbol? x)) (list 1 (quote two) "three")) +;=>(false true false) +(= () (map str ())) +;=>true + +;>>> deferrable=True +;; +;; ------- Deferrable Functionality ---------- +;; ------- (Needed for self-hosting) ------- + +;; Test catch of reader errors +(try* (eval (read-string "(+ 1")) (catch* e (prn :e e))) +;/.*(EOF|end of input|unbalanced).* +(try* (eval (read-string "[+ 1")) (catch* e (prn :e e))) +;/.*(EOF|end of input|unbalanced).* +(try* (eval (read-string "{:a 1")) (catch* e (prn :e e))) +;/.*(EOF|end of input|unbalanced).* + +;; Testing symbol and keyword functions +(symbol? :abc) +;=>false +(symbol? 'abc) +;=>true +(symbol? "abc") +;=>false +(symbol? (symbol "abc")) +;=>true +(keyword? :abc) +;=>true +(keyword? 'abc) +;=>false +(keyword? "abc") +;=>false +(keyword? "") +;=>false +(keyword? (keyword "abc")) +;=>true + +(symbol "abc") +;=>abc +(keyword "abc") +;=>:abc + +;; Testing sequential? function + +(sequential? (list 1 2 3)) +;=>true +(sequential? [15]) +;=>true +(sequential? sequential?) +;=>false +(sequential? nil) +;=>false +(sequential? "abc") +;=>false + +;; Testing apply function with core functions and arguments in vector +(apply + 4 [5]) +;=>9 +(apply prn 1 2 ["3" 4]) +;/1 2 "3" 4 +;=>nil +(apply list []) +;=>() +;; Testing apply function with user functions and arguments in vector +(apply (fn* (a b) (+ a b)) [2 3]) +;=>5 +(apply (fn* (a b) (+ a b)) 4 [5]) +;=>9 + + +;; Testing map function with vectors +(map (fn* (a) (* 2 a)) [1 2 3]) +;=>(2 4 6) + +(map (fn* [& args] (list? args)) [1 2]) +;=>(true true) + +;; Testing vector functions + +(vector? [10 11]) +;=>true +(vector? '(12 13)) +;=>false +(vector 3 4 5) +;=>[3 4 5] +(= [] (vector)) +;=>true + +(map? {}) +;=>true +(map? '()) +;=>false +(map? []) +;=>false +(map? 'abc) +;=>false +(map? :abc) +;=>false + + +;; +;; Testing hash-maps +(hash-map "a" 1) +;=>{"a" 1} + +{"a" 1} +;=>{"a" 1} + +(assoc {} "a" 1) +;=>{"a" 1} + +(get (assoc (assoc {"a" 1 } "b" 2) "c" 3) "a") +;=>1 + +(def! hm1 (hash-map)) +;=>{} + +(map? hm1) +;=>true +(map? 1) +;=>false +(map? "abc") +;=>false + +(get nil "a") +;=>nil + +(get hm1 "a") +;=>nil + +(contains? hm1 "a") +;=>false + +(def! hm2 (assoc hm1 "a" 1)) +;=>{"a" 1} + +(get hm1 "a") +;=>nil + +(contains? hm1 "a") +;=>false + +(get hm2 "a") +;=>1 + +(contains? hm2 "a") +;=>true + + +;;; TODO: fix. Clojure returns nil but this breaks mal impl +(keys hm1) +;=>() +(= () (keys hm1)) +;=>true + +(keys hm2) +;=>("a") + +(keys {"1" 1}) +;=>("1") + +;;; TODO: fix. Clojure returns nil but this breaks mal impl +(vals hm1) +;=>() +(= () (vals hm1)) +;=>true + +(vals hm2) +;=>(1) + +(count (keys (assoc hm2 "b" 2 "c" 3))) +;=>3 + +;; Testing keywords as hash-map keys +(get {:abc 123} :abc) +;=>123 +(contains? {:abc 123} :abc) +;=>true +(contains? {:abcd 123} :abc) +;=>false +(assoc {} :bcd 234) +;=>{:bcd 234} +(keyword? (nth (keys {:abc 123 :def 456}) 0)) +;=>true +(keyword? (nth (vals {"a" :abc "b" :def}) 0)) +;=>true + +;; Testing whether assoc updates properly +(def! hm4 (assoc {:a 1 :b 2} :a 3 :c 1)) +(get hm4 :a) +;=>3 +(get hm4 :b) +;=>2 +(get hm4 :c) +;=>1 + +;; Testing nil as hash-map values +(contains? {:abc nil} :abc) +;=>true +(assoc {} :bcd nil) +;=>{:bcd nil} + +;; +;; Additional str and pr-str tests + +(str "A" {:abc "val"} "Z") +;=>"A{:abc val}Z" + +(str true "." false "." nil "." :keyw "." 'symb) +;=>"true.false.nil.:keyw.symb" + +(pr-str "A" {:abc "val"} "Z") +;=>"\"A\" {:abc \"val\"} \"Z\"" + +(pr-str true "." false "." nil "." :keyw "." 'symb) +;=>"true \".\" false \".\" nil \".\" :keyw \".\" symb" + +(def! s (str {:abc "val1" :def "val2"})) +(cond (= s "{:abc val1 :def val2}") true (= s "{:def val2 :abc val1}") true) +;=>true + +(def! p (pr-str {:abc "val1" :def "val2"})) +(cond (= p "{:abc \"val1\" :def \"val2\"}") true (= p "{:def \"val2\" :abc \"val1\"}") true) +;=>true + +;; +;; Test extra function arguments as Mal List (bypassing TCO with apply) +(apply (fn* (& more) (list? more)) [1 2 3]) +;=>true +(apply (fn* (& more) (list? more)) []) +;=>true +(apply (fn* (a & more) (list? more)) [1]) +;=>true + +;>>> soft=True +;>>> optional=True +;; +;; ------- Optional Functionality -------------- +;; ------- (Not needed for self-hosting) ------- + + +;; Testing throwing a hash-map +(throw {:msg "err2"}) +;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*msg.*err2.* + +;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try* +;;;(try* (throw ["data" "foo"]) (catch* exc (do (prn "exc is:" exc) 7))) ;;;; +;;;; "exc is:" ["data" "foo"] ;;;;=>7 +;;;;=>7 + +;; +;; Testing try* without catch* +(try* xyz) +;/.*'?xyz'? not found.* + +;; +;; Testing throwing non-strings +(try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7))) +;/"err:" \(1 2 3\) +;=>7 + +;; +;; Testing dissoc +(def! hm3 (assoc hm2 "b" 2)) +(count (keys hm3)) +;=>2 +(count (vals hm3)) +;=>2 +(dissoc hm3 "a") +;=>{"b" 2} +(dissoc hm3 "a" "b") +;=>{} +(dissoc hm3 "a" "b" "c") +;=>{} +(count (keys hm3)) +;=>2 + +(dissoc {:cde 345 :fgh 456} :cde) +;=>{:fgh 456} +(dissoc {:cde nil :fgh 456} :cde) +;=>{:fgh 456} + +;; +;; Testing equality of hash-maps +(= {} {}) +;=>true +(= {} (hash-map)) +;=>true +(= {:a 11 :b 22} (hash-map :b 22 :a 11)) +;=>true +(= {:a 11 :b [22 33]} (hash-map :b [22 33] :a 11)) +;=>true +(= {:a 11 :b {:c 33}} (hash-map :b {:c 33} :a 11)) +;=>true +(= {:a 11 :b 22} (hash-map :b 23 :a 11)) +;=>false +(= {:a 11 :b 22} (hash-map :a 11)) +;=>false +(= {:a [11 22]} {:a (list 11 22)}) +;=>true +(= {:a 11 :b 22} (list :a 11 :b 22)) +;=>false +(= {} []) +;=>false +(= [] {}) +;=>false + +(keyword :abc) +;=>:abc +(keyword? (first (keys {":abc" 123 ":def" 456}))) +;=>false + +;; Testing that hashmaps don't alter function ast +(def! bar (fn* [a] {:foo (get a :foo)})) +(bar {:foo (fn* [x] x)}) +(bar {:foo 3}) +;=>{:foo 3} +;; shouldn't give an error + +;; Keywords and strings must be distinct map keys. +(get {"abc" 1} :abc) +;=>nil +(get {:abc 1} "abc") +;=>nil +(contains? {"abc" 1} :abc) +;=>false +(contains? {:abc 1} "abc") +;=>false +(dissoc {"abc" 1 :abc 1} :abc) +;=>{"abc" 1} +(dissoc {"abc" 1 :abc 1} "abc") +;=>{:abc 1} + +;; Map updates must not create duplicate keys. +{:a 1 :a 2} +;=>{:a 2} +(keys {:a 1 :a 2}) +;=>(:a) +(hash-map :a 1 :a 2) +;=>{:a 2} +(keys (hash-map :a 1 :a 2)) +;=>(:a) +(assoc {:a 1} :a 2) +;=>{:a 2} +(keys (assoc {:a 1} :a 2)) +;=>(:a) + +;; Assoc must not mutate the original map. +(def! hm7 {:a 1}) +;=>{:a 1} +(assoc hm7 :a 2) +;=>{:a 2} +(get hm7 :a) +;=>1 diff --git a/impls/tests/stepA_mal.mal b/impls/tests/stepA_mal.mal new file mode 100644 index 0000000000..2967cdbca4 --- /dev/null +++ b/impls/tests/stepA_mal.mal @@ -0,0 +1,315 @@ +;;; +;;; See IMPL/tests/stepA_mal.mal for implementation specific +;;; interop tests. +;;; + + +;; +;; Testing readline +(readline "mal-user> ") +"hello" +;=>"\"hello\"" + +;; +;; Testing *host-language* +;;; each impl is different, but this should return false +;;; rather than throwing an exception +(= "something bogus" *host-language*) +;=>false + + +;>>> deferrable=True +;; +;; ------- Deferrable Functionality ---------- +;; ------- (Needed for self-hosting) ------- + +;; +;; +;; Testing hash-map evaluation and atoms (i.e. an env) +(def! e (atom {"+" +})) +(swap! e assoc "-" -) +( (get @e "+") 7 8) +;=>15 +( (get @e "-") 11 8) +;=>3 +(swap! e assoc "foo" (list)) +(get @e "foo") +;=>() +(swap! e assoc "bar" '(1 2 3)) +(get @e "bar") +;=>(1 2 3) + +;; Testing for presence of optional functions +(do (list time-ms string? number? seq conj meta with-meta fn?) nil) +;=>nil + +(map symbol? '(nil false true)) +;=>(false false false) + +(def! add1 (fn* (x) (+ x 1))) + +;; Testing fn? function +(fn? +) +;=>true +(fn? list?) +;=>true +(fn? add1) +;=>true +(fn? cond) +;=>false +(fn? "+") +;=>false +(fn? :+) +;=>false + +;; Testing macro? function +(macro? cond) +;=>true +(macro? +) +;=>false +(macro? add1) +;=>false +(macro? "+") +;=>false +(macro? :+) +;=>false +(macro? {}) +;=>false + +;; ------------------------------------------------------------------ + +;>>> soft=True +;>>> optional=True +;; +;; ------- Optional Functionality -------------- +;; ------- (Not needed for self-hosting) ------- + +;; Testing metadata on functions + +;; +;; Testing metadata on mal functions + +(meta (fn* (a) a)) +;=>nil + +(meta (with-meta (fn* (a) a) {"b" 1})) +;=>{"b" 1} + +(meta (with-meta (fn* (a) a) "abc")) +;=>"abc" + +(def! l-wm (with-meta (fn* (a) a) {"b" 2})) +(meta l-wm) +;=>{"b" 2} + +(meta (with-meta l-wm {"new_meta" 123})) +;=>{"new_meta" 123} +(meta l-wm) +;=>{"b" 2} + +(def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1})) +(meta f-wm) +;=>{"abc" 1} + +(meta (with-meta f-wm {"new_meta" 123})) +;=>{"new_meta" 123} +(meta f-wm) +;=>{"abc" 1} + +(def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a))) +(meta f-wm2) +;=>{"abc" 1} + +;; Meta of native functions should return nil (not fail) +(meta +) +;=>nil + +;; +;; Make sure closures and metadata co-exist +(def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1}))) +(def! plus7 (gen-plusX 7)) +(def! plus8 (gen-plusX 8)) +(plus7 8) +;=>15 +(meta plus7) +;=>{"meta" 1} +(meta plus8) +;=>{"meta" 1} +(meta (with-meta plus7 {"meta" 2})) +;=>{"meta" 2} +(meta plus8) +;=>{"meta" 1} + +;; +;; Testing string? function +(string? "") +;=>true +(string? 'abc) +;=>false +(string? "abc") +;=>true +(string? :abc) +;=>false +(string? (keyword "abc")) +;=>false +(string? 234) +;=>false +(string? nil) +;=>false + +;; Testing number? function +(number? 123) +;=>true +(number? -1) +;=>true +(number? nil) +;=>false +(number? false) +;=>false +(number? "123") +;=>false + + +;; +;; Testing conj function +(conj (list) 1) +;=>(1) +(conj (list 1) 2) +;=>(2 1) +(conj (list 2 3) 4) +;=>(4 2 3) +(conj (list 2 3) 4 5 6) +;=>(6 5 4 2 3) +(conj (list 1) (list 2 3)) +;=>((2 3) 1) + +(conj [] 1) +;=>[1] +(conj [1] 2) +;=>[1 2] +(conj [2 3] 4) +;=>[2 3 4] +(conj [2 3] 4 5 6) +;=>[2 3 4 5 6] +(conj [1] [2 3]) +;=>[1 [2 3]] + +;; +;; Testing seq function +(seq "abc") +;=>("a" "b" "c") +(apply str (seq "this is a test")) +;=>"this is a test" +(seq '(2 3 4)) +;=>(2 3 4) +(seq [2 3 4]) +;=>(2 3 4) + +(seq "") +;=>nil +(seq '()) +;=>nil +(seq []) +;=>nil +(seq nil) +;=>nil + +;; +;; Testing metadata on collections + +(meta [1 2 3]) +;=>nil + +(with-meta [1 2 3] {"a" 1}) +;=>[1 2 3] + +(meta (with-meta [1 2 3] {"a" 1})) +;=>{"a" 1} + +(vector? (with-meta [1 2 3] {"a" 1})) +;=>true + +(meta (with-meta [1 2 3] "abc")) +;=>"abc" + +(with-meta [] "abc") +;=>[] + +(meta (with-meta (list 1 2 3) {"a" 1})) +;=>{"a" 1} + +(list? (with-meta (list 1 2 3) {"a" 1})) +;=>true + +(with-meta (list) {"a" 1}) +;=>() + +(empty? (with-meta (list) {"a" 1})) +;=>true + +(meta (with-meta {"abc" 123} {"a" 1})) +;=>{"a" 1} + +(map? (with-meta {"abc" 123} {"a" 1})) +;=>true + +(with-meta {} {"a" 1}) +;=>{} + +(def! l-wm (with-meta [4 5 6] {"b" 2})) +;=>[4 5 6] +(meta l-wm) +;=>{"b" 2} + +(meta (with-meta l-wm {"new_meta" 123})) +;=>{"new_meta" 123} +(meta l-wm) +;=>{"b" 2} + +;; +;; Testing metadata on mal and builtin functions +(fn? ^{"ismacro" true} (fn* () 0)) +;=>true +(meta +) +;=>nil +(def! f-wm3 ^{"def" 2} +) +(meta f-wm3) +;=>{"def" 2} +(meta +) +;=>nil + +;; Metadata should not break equality. +(= [1] ^2 [1]) +;=>true + +(= '(1) ^2 '(1)) +;=>true + +(= {"a" 1} ^2 {"a" 1}) +;=>true + +(= '(1) ^2 [1]) +;=>true + +;; Loading sumdown from computations.mal +(load-file "../tests/computations.mal") +;=>nil + +;; +;; Testing time-ms function +(def! start-time (time-ms)) +(= start-time 0) +;=>false +(sumdown 10) ; Waste some time +;=>55 +(> (time-ms) start-time) +;=>true + +;; +;; Test that defining a macro does not mutate an existing function. +(def! f (fn* [x] (number? x))) +(defmacro! m f) +(f (+ 1 1)) +;=>true +(m (+ 1 1)) +;=>false diff --git a/tests/test.txt b/impls/tests/test.txt similarity index 100% rename from tests/test.txt rename to impls/tests/test.txt diff --git a/impls/tests/travis_trigger.sh b/impls/tests/travis_trigger.sh new file mode 100755 index 0000000000..7dd96116ec --- /dev/null +++ b/impls/tests/travis_trigger.sh @@ -0,0 +1,78 @@ +#!/usr/bin/env bash + +# Reference: https://docs.travis-ci.com/user/triggering-builds/ + +set -e + +die() { echo "${*}"; exit 1; } +usage() { + [ "${*}" ] && echo >&2 -e "${*}\n" + echo "Usage: $0 REPO BRANCH [VAR=VAL]... + + Authorization: + + If you have the travis program installed then it will be called + to get an API token (you need to have done 'travis login --org' + in the past). Alternately you can explicity pass a token using + the TRAVIS_TOKEN environment variable. You can see your API + token at https://travis-ci.org/account/preferences. + + Travis .org vs .com: + + By default 'api.travis-ci.org' is used for API calls. This can + be overridden by setting TRAVIS_HOST="api.travis-ci.com" + + Examples: + + Trigger build/test in self-hosted mode: + $0 REPO BRANCH DO_SELF_HOST=1 + + Trigger build/test with stop on soft failures: + $0 REPO BRANCH DO_HARD=1 + + Trigger build/test using regress mode on stepA: + $0 REPO BRANCH REGRESS=1 STEP=stepA + + Trigger build/test using regress mode on all steps: + $0 REPO BRANCH REGRESS=1 + " | sed 's/^ //' >&2 + + exit 2 +} + +TRAVIS_TOKEN="${TRAVIS_TOKEN:-}" # default to travis program +TRAVIS_HOST="${TRAVIS_HOST:-api.travis-ci.org}" + +REPO="${1}"; shift || usage "REPO required" +BRANCH="${1}"; shift || usage "BRANCH required" +VARS="${*}" + +repo="${REPO/\//%2F}" +vars="" +[ "${VARS}" ] && vars="\"${VARS// /\", \"}\"" + +body="{ + \"request\": { + \"message\": \"Manual build. Settings: ${VARS}\", + \"branch\":\"${BRANCH}\", + \"config\": { + \"env\": { + \"global\": [${vars}] + } + } + } +}" + +if [ -z "${TRAVIS_TOKEN}" ]; then + which travis >/dev/null \ + || die "TRAVIS_TOKEN not set and travis command not found" + TRAVIS_TOKEN="$(travis token --org --no-interactive)" +fi + +curl -X POST \ + -H "Content-Type: application/json" \ + -H "Accept: application/json" \ + -H "Travis-API-Version: 3" \ + -H "Authorization: token ${TRAVIS_TOKEN}" \ + -d "$body" \ + "https://${TRAVIS_HOST}/repo/${repo}/requests" diff --git a/impls/ts/.gitignore b/impls/ts/.gitignore new file mode 100644 index 0000000000..0aa7778c55 --- /dev/null +++ b/impls/ts/.gitignore @@ -0,0 +1,5 @@ +node_modules/ + +npm-debug.log + +*.js diff --git a/impls/ts/Dockerfile b/impls/ts/Dockerfile new file mode 100644 index 0000000000..c189a1ac3f --- /dev/null +++ b/impls/ts/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm + +ENV NPM_CONFIG_CACHE /mal/.npm diff --git a/impls/ts/Makefile b/impls/ts/Makefile new file mode 100644 index 0000000000..1ea5a79e59 --- /dev/null +++ b/impls/ts/Makefile @@ -0,0 +1,19 @@ +STEPS = step0_repl step1_read_print step2_eval step3_env \ + step4_if_fn_do step5_tco step6_file step7_quote \ + step8_macros step9_try stepA_mal + +all: ts + +node_modules: + npm install + +step%.js: node_modules types.ts reader.ts printer.ts env.ts core.ts step%.ts + ./node_modules/.bin/tsc -p ./ + + +.PHONY: ts clean + +ts: $(foreach s,$(STEPS),$(s).js) + +clean: + rm -f *.js diff --git a/impls/ts/core.ts b/impls/ts/core.ts new file mode 100644 index 0000000000..a5ca7007f5 --- /dev/null +++ b/impls/ts/core.ts @@ -0,0 +1,441 @@ +import * as fs from "fs"; + +import { readline } from "./node_readline"; + +import { Node, MalType, MalSymbol, MalFunction, MalNil, MalList, MalVector, MalBoolean, MalNumber, MalString, MalKeyword, MalHashMap, MalAtom, equals, isSeq } from "./types"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +export const ns: Map = (() => { + const ns: { [symbol: string]: typeof MalFunction.prototype.func; } = { + "="(a: MalType, b: MalType): MalBoolean { + return new MalBoolean(equals(a, b)); + }, + throw(v: MalType): MalType { + throw v; + }, + + "nil?"(v: MalType) { + return new MalBoolean(v.type === Node.Nil); + }, + "true?"(v: MalType) { + return new MalBoolean(v.type === Node.Boolean && v.v); + }, + "false?"(v: MalType) { + return new MalBoolean(v.type === Node.Boolean && !v.v); + }, + "string?"(v: MalType) { + return new MalBoolean(v.type === Node.String); + }, + symbol(v: MalType) { + if (v.type !== Node.String) { + throw new Error(`unexpected symbol: ${v.type}, expected: string`); + } + return MalSymbol.get(v.v); + }, + "symbol?"(v: MalType) { + return new MalBoolean(v.type === Node.Symbol); + }, + keyword(v: MalType) { + if (v.type === Node.Keyword) { + return v; + } + if (v.type !== Node.String) { + throw new Error(`unexpected symbol: ${v.type}, expected: string`); + } + return MalKeyword.get(v.v); + }, + "keyword?"(v: MalType) { + return new MalBoolean(v.type === Node.Keyword); + }, + "number?"(v: MalType) { + return new MalBoolean(v.type === Node.Number); + }, + "fn?"(v: MalType) { + return new MalBoolean(v.type === Node.Function && !v.isMacro); + }, + "macro?"(v: MalType) { + return new MalBoolean(v.type === Node.Function && v.isMacro); + }, + + "pr-str"(...args: MalType[]): MalString { + return new MalString(args.map(v => prStr(v, true)).join(" ")); + }, + "str"(...args: MalType[]): MalString { + return new MalString(args.map(v => prStr(v, false)).join("")); + }, + prn(...args: MalType[]): MalNil { + const str = args.map(v => prStr(v, true)).join(" "); + console.log(str); + return MalNil.instance; + }, + println(...args: MalType[]): MalNil { + const str = args.map(v => prStr(v, false)).join(" "); + console.log(str); + return MalNil.instance; + }, + "read-string"(v: MalType) { + if (v.type !== Node.String) { + throw new Error(`unexpected symbol: ${v.type}, expected: string`); + } + return readStr(v.v); + }, + readline(v: MalType) { + if (v.type !== Node.String) { + throw new Error(`unexpected symbol: ${v.type}, expected: string`); + } + + const ret = readline(v.v); + if (ret == null) { + return MalNil.instance; + } + + return new MalString(ret); + }, + slurp(v: MalType) { + if (v.type !== Node.String) { + throw new Error(`unexpected symbol: ${v.type}, expected: string`); + } + const content = fs.readFileSync(v.v, "utf-8"); + return new MalString(content); + }, + + "<"(a: MalType, b: MalType): MalBoolean { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalBoolean(a.v < b.v); + }, + "<="(a: MalType, b: MalType): MalBoolean { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalBoolean(a.v <= b.v); + }, + ">"(a: MalType, b: MalType): MalBoolean { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalBoolean(a.v > b.v); + }, + ">="(a: MalType, b: MalType): MalBoolean { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalBoolean(a.v >= b.v); + }, + "+"(a: MalType, b: MalType): MalNumber { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalNumber(a.v + b.v); + }, + "-"(a: MalType, b: MalType): MalNumber { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalNumber(a.v - b.v); + }, + "*"(a: MalType, b: MalType): MalNumber { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalNumber(a.v * b.v); + }, + "/"(a: MalType, b: MalType): MalNumber { + if (a.type !== Node.Number) { + throw new Error(`unexpected symbol: ${a.type}, expected: number`); + } + if (b.type !== Node.Number) { + throw new Error(`unexpected symbol: ${b.type}, expected: number`); + } + + return new MalNumber(a.v / b.v); + }, + "time-ms"() { + return new MalNumber(Date.now()); + }, + + list(...args: MalType[]): MalList { + return new MalList(args); + }, + "list?"(v: MalType): MalBoolean { + return new MalBoolean(v.type === Node.List); + }, + vector(...args: MalType[]): MalVector { + return new MalVector(args); + }, + "vector?"(v: MalType): MalBoolean { + return new MalBoolean(v.type === Node.Vector); + }, + "hash-map"(...args: MalType[]) { + return new MalHashMap(args); + }, + "map?"(v: MalType): MalBoolean { + return new MalBoolean(v.type === Node.HashMap); + }, + assoc(v: MalType, ...args: MalType[]) { + if (v.type !== Node.HashMap) { + throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); + } + return v.assoc(args); + }, + dissoc(v: MalType, ...args: MalType[]) { + if (v.type !== Node.HashMap) { + throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); + } + return v.dissoc(args); + }, + get(v: MalType, key: MalType) { + if (v.type === Node.Nil) { + return MalNil.instance; + } + if (v.type !== Node.HashMap) { + throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); + } + if (key.type !== Node.String && key.type !== Node.Keyword) { + throw new Error(`unexpected symbol: ${key.type}, expected: string or keyword`); + } + + return v.get(key) || MalNil.instance; + }, + "contains?"(v: MalType, key: MalType) { + if (v.type === Node.Nil) { + return MalNil.instance; + } + if (v.type !== Node.HashMap) { + throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); + } + if (key.type !== Node.String && key.type !== Node.Keyword) { + throw new Error(`unexpected symbol: ${key.type}, expected: string or keyword`); + } + + return new MalBoolean(v.has(key)); + }, + keys(v: MalType) { + if (v.type !== Node.HashMap) { + throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); + } + + return new MalList([...v.keys()]); + }, + vals(v: MalType) { + if (v.type !== Node.HashMap) { + throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); + } + + return new MalList([...v.vals()]); + }, + + "sequential?"(v: MalType) { + return new MalBoolean(isSeq(v)); + }, + cons(a: MalType, b: MalType) { + if (!isSeq(b)) { + throw new Error(`unexpected symbol: ${b.type}, expected: list or vector`); + } + + return new MalList([a].concat(b.list)); + }, + concat(...args: MalType[]) { + const list = args + .map(arg => { + if (!isSeq(arg)) { + throw new Error(`unexpected symbol: ${arg.type}, expected: list or vector`); + } + return arg; + }) + .reduce((p, c) => p.concat(c.list), [] as MalType[]); + + return new MalList(list); + }, + vec(a: MalType) { + switch (a.type) { + case Node.List: + return new MalVector(a.list); + case Node.Vector: + return a; + } + throw new Error(`unexpected symbol: ${a.type}, expected: list or vector`); + }, + + nth(list: MalType, idx: MalType) { + if (!isSeq(list)) { + throw new Error(`unexpected symbol: ${list.type}, expected: list or vector`); + } + if (idx.type !== Node.Number) { + throw new Error(`unexpected symbol: ${idx.type}, expected: number`); + } + + const v = list.list[idx.v]; + if (!v) { + throw new Error("nth: index out of range"); + } + + return v; + }, + first(v: MalType) { + if (v.type === Node.Nil) { + return MalNil.instance; + } + if (!isSeq(v)) { + throw new Error(`unexpected symbol: ${v.type}, expected: list or vector`); + } + + return v.list[0] || MalNil.instance; + }, + rest(v: MalType) { + if (v.type === Node.Nil) { + return new MalList([]); + } + if (!isSeq(v)) { + throw new Error(`unexpected symbol: ${v.type}, expected: list or vector`); + } + + return new MalList(v.list.slice(1)); + }, + "empty?"(v: MalType): MalBoolean { + if (!isSeq(v)) { + return new MalBoolean(false); + } + return new MalBoolean(v.list.length === 0); + }, + count(v: MalType): MalNumber { + if (isSeq(v)) { + return new MalNumber(v.list.length); + } + if (v.type === Node.Nil) { + return new MalNumber(0); + } + throw new Error(`unexpected symbol: ${v.type}`); + }, + apply(f: MalType, ...list: MalType[]) { + if (f.type !== Node.Function) { + throw new Error(`unexpected symbol: ${f.type}, expected: function`); + } + + const tail = list[list.length - 1]; + if (!isSeq(tail)) { + throw new Error(`unexpected symbol: ${tail.type}, expected: list or vector`); + } + const args = list.slice(0, -1).concat(tail.list); + return f.func(...args); + }, + map(f: MalType, list: MalType) { + if (f.type !== Node.Function) { + throw new Error(`unexpected symbol: ${f.type}, expected: function`); + } + if (!isSeq(list)) { + throw new Error(`unexpected symbol: ${list.type}, expected: list or vector`); + } + + return new MalList(list.list.map(v => f.func(v))); + }, + + conj(list: MalType, ...args: MalType[]) { + switch (list.type) { + case Node.List: + const newList = new MalList(list.list); + args.forEach(arg => newList.list.unshift(arg)); + return newList; + case Node.Vector: + return new MalVector([...list.list, ...args]); + } + + throw new Error(`unexpected symbol: ${list.type}, expected: list or vector`); + }, + seq(v: MalType) { + if (v.type === Node.List) { + if (v.list.length === 0) { + return MalNil.instance; + } + return v; + } + if (v.type === Node.Vector) { + if (v.list.length === 0) { + return MalNil.instance; + } + return new MalList(v.list); + } + if (v.type === Node.String) { + if (v.v.length === 0) { + return MalNil.instance; + } + return new MalList(v.v.split("").map(s => new MalString(s))); + } + if (v.type === Node.Nil) { + return MalNil.instance; + } + + throw new Error(`unexpected symbol: ${v.type}, expected: list or vector or string`); + }, + + meta(v: MalType) { + return v.meta || MalNil.instance; + }, + "with-meta"(v: MalType, m: MalType) { + return v.withMeta(m); + }, + atom(v: MalType): MalAtom { + return new MalAtom(v); + }, + "atom?"(v: MalType): MalBoolean { + return new MalBoolean(v.type === Node.Atom); + }, + deref(v: MalType): MalType { + if (v.type !== Node.Atom) { + throw new Error(`unexpected symbol: ${v.type}, expected: atom`); + } + return v.v; + }, + "reset!"(atom: MalType, v: MalType): MalType { + if (atom.type !== Node.Atom) { + throw new Error(`unexpected symbol: ${atom.type}, expected: atom`); + } + atom.v = v; + return v; + }, + "swap!"(atom: MalType, f: MalType, ...args: MalType[]): MalType { + if (atom.type !== Node.Atom) { + throw new Error(`unexpected symbol: ${atom.type}, expected: atom`); + } + if (f.type !== Node.Function) { + throw new Error(`unexpected symbol: ${f.type}, expected: function`); + } + atom.v = f.func(...[atom.v].concat(args)); + return atom.v; + }, + }; + + const map : Map = new Map(); + Object.keys(ns).forEach(key => map.set(key, MalFunction.fromBootstrap(ns[key]))); + return map; +})(); diff --git a/impls/ts/env.ts b/impls/ts/env.ts new file mode 100644 index 0000000000..61cccceb68 --- /dev/null +++ b/impls/ts/env.ts @@ -0,0 +1,34 @@ +import { MalType, MalSymbol, MalList } from "./types"; + +export class Env { + data: Map; + + constructor(public outer?: Env, binds: MalSymbol[] = [], exprts: MalType[] = []) { + this.data = new Map(); + + for (let i = 0; i < binds.length; i++) { + const bind : string = binds[i].v; + if (bind === "&") { + this.set(binds[i + 1].v, new MalList(exprts.slice(i))); + break; + } + this.set(bind, exprts[i]); + } + } + + set(key: string, value: MalType): MalType { + this.data.set(key, value); + return value; + } + + get(key: string): MalType | null { + const result : MalType | undefined = this.data.get(key); + if (result) { + return result; + } else if (this.outer) { + return this.outer.get(key); + } else { + return null; + } + } +} diff --git a/impls/ts/node_readline.ts b/impls/ts/node_readline.ts new file mode 100644 index 0000000000..cab32cb27c --- /dev/null +++ b/impls/ts/node_readline.ts @@ -0,0 +1,51 @@ +import * as path from "path"; +import * as koffi from "koffi"; +import * as fs from "fs"; + +// IMPORTANT: choose one +const RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL +// const RL_LIB = "libedit.so.2"; + +const HISTORY_FILE = path.join(process.env.HOME || ".", ".mal-history"); + +let rllib: any; +try { + rllib = koffi.load(RL_LIB); +} catch (e) { + console.error('ERROR loading RL_LIB:', RL_LIB, e); + throw e; +} + +const readlineFunc = rllib.func('char *readline(char *)'); +const addHistoryFunc = rllib.func('int add_history(char *)'); + +let rlHistoryLoaded = false; + +export function readline(prompt?: string): string | null { + prompt = prompt || "user> "; + + if (!rlHistoryLoaded) { + rlHistoryLoaded = true; + let lines: string[] = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (let i = 0; i < lines.length; i++) { + if (lines[i]) { addHistoryFunc(lines[i]); } + } + } + + const line = readlineFunc(prompt); + if (line) { + addHistoryFunc(line); + try { + fs.appendFileSync(HISTORY_FILE, line + "\n"); + } catch (exc) { + // ignored + } + } + + return line; +}; diff --git a/impls/ts/package.json b/impls/ts/package.json new file mode 100644 index 0000000000..c19bf4902d --- /dev/null +++ b/impls/ts/package.json @@ -0,0 +1,29 @@ +{ + "name": "mal", + "private": true, + "version": "1.0.0", + "description": "Make a Lisp (mal) language implemented in TypeScript", + "scripts": { + "build": "tsfmt -r && tsc -p ./", + "test": "npm run build && npm run test:step0 && npm run test:step1 && npm run test:step2 && npm run test:step3 && npm run test:step4 && npm run test:step5 && npm run test:step6 && npm run test:step7 && npm run test:step8 && npm run test:step9 && npm run test:stepA", + "test:step0": "cd .. && make 'test^ts^step0'", + "test:step1": "cd .. && make 'test^ts^step1'", + "test:step2": "cd .. && make 'test^ts^step2'", + "test:step3": "cd .. && make 'test^ts^step3'", + "test:step4": "cd .. && make 'test^ts^step4'", + "test:step5": "cd .. && make 'test^ts^step5'", + "test:step6": "cd .. && make 'test^ts^step6'", + "test:step7": "cd .. && make 'test^ts^step7'", + "test:step8": "cd .. && make 'test^ts^step8'", + "test:step9": "cd .. && make 'test^ts^step9'", + "test:stepA": "cd .. && make 'test^ts^stepA'" + }, + "dependencies": { + "koffi": "^2.12.1" + }, + "devDependencies": { + "@types/node": "^14.14.3", + "typescript": "^4.3.5", + "typescript-formatter": "^7.2.2" + } +} diff --git a/impls/ts/printer.ts b/impls/ts/printer.ts new file mode 100644 index 0000000000..f1806c3272 --- /dev/null +++ b/impls/ts/printer.ts @@ -0,0 +1,42 @@ +import { Node, MalType } from "./types"; + +export function prStr(v: MalType, printReadably = true): string { + switch (v.type) { + case Node.List: + return `(${v.list.map(v => prStr(v, printReadably)).join(" ")})`; + case Node.Vector: + return `[${v.list.map(v => prStr(v, printReadably)).join(" ")}]`; + case Node.HashMap: + let result = "{"; + for (const [key, value] of v.entries()) { + if (result !== "{") { + result += " "; + } + result += `${prStr(key, printReadably)} ${prStr(value, printReadably)}`; + } + result += "}"; + return result; + case Node.Number: + case Node.Symbol: + case Node.Boolean: + return `${v.v}`; + case Node.String: + if (printReadably) { + const str = v.v + .replace(/\\/g, "\\\\") + .replace(/"/g, '\\"') + .replace(/\n/g, "\\n"); + return `"${str}"`; + } else { + return v.v; + } + case Node.Nil: + return "nil"; + case Node.Keyword: + return `:${v.v}`; + case Node.Function: + return "#"; + case Node.Atom: + return `(atom ${prStr(v.v, printReadably)})`; + } +} diff --git a/impls/ts/reader.ts b/impls/ts/reader.ts new file mode 100644 index 0000000000..24fc24de93 --- /dev/null +++ b/impls/ts/reader.ts @@ -0,0 +1,146 @@ +import { MalType, MalList, MalString, MalNumber, MalBoolean, MalNil, MalKeyword, MalSymbol, MalVector, MalHashMap } from "./types"; + +class Reader { + position = 0; + + constructor(private tokens: string[]) { } + + next(): string { + const ret = this.peek(); + this.position += 1; + return ret; + } + + peek(): string { + return this.tokens[this.position]; + } +} + +export function readStr(input: string): MalType { + const tokens = tokenizer(input); + const reader = new Reader(tokens); + return readForm(reader); +} + +function tokenizer(input: string): string[] { + const regexp = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g; + const tokens: string[] = []; + while (true) { + const matches = regexp.exec(input); + if (!matches) { + break; + } + const match = matches[1]; + if (match === "") { + break; + } + if (match[0] !== ";") { + tokens.push(match); + } + } + + return tokens; +} + +function readForm(reader: Reader): MalType { + const token = reader.peek(); + switch (token) { + case "(": + return readList(reader); + case "[": + return readVector(reader); + case "{": + return readHashMap(reader); + case "'": + return readSymbol("quote"); + case "`": + return readSymbol("quasiquote"); + case "~": + return readSymbol("unquote"); + case "~@": + return readSymbol("splice-unquote"); + case "@": + return readSymbol("deref"); + case "^": + { + reader.next(); + const sym = MalSymbol.get("with-meta"); + const target = readForm(reader); + return new MalList([sym, readForm(reader), target]); + } + default: + return readAtom(reader); + } + + function readSymbol(name: string) { + reader.next(); + const sym = MalSymbol.get(name); + const target = readForm(reader); + return new MalList([sym, target]); + } +} + +function readList(reader: Reader): MalType { + return readParen(reader, MalList, "(", ")"); +} + +function readVector(reader: Reader): MalType { + return readParen(reader, MalVector, "[", "]"); +} + +function readHashMap(reader: Reader): MalType { + return readParen(reader, MalHashMap, "{", "}"); +} + +function readParen(reader: Reader, ctor: { new (list: MalType[]): MalType; }, open: string, close: string): MalType { + const token = reader.next(); // drop open paren + if (token !== open) { + throw new Error(`unexpected token ${token}, expected ${open}`); + } + const list: MalType[] = []; + while (true) { + const next = reader.peek(); + if (next === close) { + break; + } else if (!next) { + throw new Error("unexpected EOF"); + } + list.push(readForm(reader)); + } + reader.next(); // drop close paren + + return new ctor(list); +} + +function readAtom(reader: Reader): MalType { + const token = reader.next(); + if (token.match(/^-?[0-9]+$/)) { + const v = parseInt(token, 10); + return new MalNumber(v); + } + if (token.match(/^-?[0-9]\.[0-9]+$/)) { + const v = parseFloat(token); + return new MalNumber(v); + } + if (token.match(/^"(?:\\.|[^\\"])*"$/)) { + const v = token.slice(1, token.length - 1) + .replace(/\\(.)/g, (_, c: string) => c == 'n' ? '\n' : c) + return new MalString(v); + } + if (token[0] === '"') { + throw new Error("expected '\"', got EOF"); + } + if (token[0] === ":") { + return MalKeyword.get(token.substr(1)); + } + switch (token) { + case "nil": + return MalNil.instance; + case "true": + return new MalBoolean(true); + case "false": + return new MalBoolean(false); + } + + return MalSymbol.get(token); +} diff --git a/impls/ts/run b/impls/ts/run new file mode 100755 index 0000000000..1148122a23 --- /dev/null +++ b/impls/ts/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" diff --git a/impls/ts/step0_repl.ts b/impls/ts/step0_repl.ts new file mode 100644 index 0000000000..5ed8da9e18 --- /dev/null +++ b/impls/ts/step0_repl.ts @@ -0,0 +1,35 @@ +import { readline } from "./node_readline"; + +// READ +function read(str: string): any { + // TODO + return str; +} + +// EVAL +function evalMal(ast: any, _env?: any): any { + // TODO + return ast; +} + +// PRINT +function print(exp: any): string { + // TODO + return exp; +} + +function rep(str: string): string { + // TODO + return print(evalMal(read(str))); +} + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + console.log(rep(line)); +} diff --git a/impls/ts/step1_read_print.ts b/impls/ts/step1_read_print.ts new file mode 100644 index 0000000000..47e4e9a977 --- /dev/null +++ b/impls/ts/step1_read_print.ts @@ -0,0 +1,41 @@ +import { readline } from "./node_readline"; + +import { MalType } from "./types"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +// EVAL +function evalMal(ast: any, _env?: any): any { + // TODO + return ast; +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +function rep(str: string): string { + return print(evalMal(read(str))); +} + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + const err: Error = e; + console.error(err.message); + } +} diff --git a/impls/ts/step2_eval.ts b/impls/ts/step2_eval.ts new file mode 100644 index 0000000000..a3a4eaedb8 --- /dev/null +++ b/impls/ts/step2_eval.ts @@ -0,0 +1,81 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalNumber, MalVector, MalHashMap, MalFunction } from "./types"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +interface MalEnvironment { + [key: string]: MalFunction; +} + +// EVAL +function evalMal(ast: MalType, env: MalEnvironment): MalType { + // console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f = env[ast.v]; + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const f : MalType = evalMal(ast.list[0], env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + return f.func(...args); +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv: MalEnvironment = { + "+": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v + b!.v)), + "-": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v - b!.v)), + "*": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v * b!.v)), + "/": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v / b!.v)), +}; +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + const err: Error = e; + console.error(err.message); + } +} diff --git a/impls/ts/step3_env.ts b/impls/ts/step3_env.ts new file mode 100644 index 0000000000..5aec907e2c --- /dev/null +++ b/impls/ts/step3_env.ts @@ -0,0 +1,120 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalNumber, MalVector, MalHashMap, MalFunction, isSeq } from "./types"; +import { Env } from "./env"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + let letEnv = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + const list = pairs.list; + for (let i = 0; i < list.length; i += 2) { + const key = list[i]; + const value = list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + letEnv.set(key.v, evalMal(value, letEnv)); + } + return evalMal(ast.list[2], letEnv); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + return f.func(...args); +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +replEnv.set("+", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v + b!.v))); +replEnv.set("-", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v - b!.v))); +replEnv.set("*", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v * b!.v))); +replEnv.set("/", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v / b!.v))); + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + const err: Error = e; + console.error(err.message); + } +} diff --git a/impls/ts/step4_if_fn_do.ts b/impls/ts/step4_if_fn_do.ts new file mode 100644 index 0000000000..542026bb66 --- /dev/null +++ b/impls/ts/step4_if_fn_do.ts @@ -0,0 +1,164 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalNil, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; +import { Env } from "./env"; +import * as core from "./core"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + let letEnv = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + for (let i = 0; i < pairs.list.length; i += 2) { + const key = pairs.list[i]; + const value = pairs.list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + letEnv.set(key.v, evalMal(value, letEnv)); + } + return evalMal(ast.list[2], letEnv); + } + case "do": { + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); + return evalMal(ast.list[ast.list.length - 1], env); + } + case "if": { + const [, cond, thenExpr, elseExrp] = ast.list; + const ret = evalMal(cond, env); + let b = true; + if (ret.type === Node.Boolean && !ret.v) { + b = false; + } else if (ret.type === Node.Nil) { + b = false; + } + if (b) { + return evalMal(thenExpr, env); + } else if (elseExrp) { + return evalMal(elseExrp, env); + } else { + return MalNil.instance; + } + } + case "fn*": { + const [, args, binds] = ast.list; + if (!isSeq(args)) { + throw new Error(`unexpected return type: ${args.type}, expected: list or vector`); + } + const symbols = args.list.map(param => { + if (param.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${param.type}, expected: symbol`); + } + return param; + }); + return MalFunction.fromBootstrap((...fnArgs: MalType[]) => { + return evalMal(binds, new Env(env, symbols, fnArgs)); + }); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + return f.func(...args); +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +// core.EXT: defined using Racket +core.ns.forEach((value, key) => { + replEnv.set(key, value); +}); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + if (isAST(e)) { + console.error("Error:", prStr(e)); + } else { + const err: Error = e; + console.error("Error:", err.message); + } + } +} diff --git a/impls/ts/step5_tco.ts b/impls/ts/step5_tco.ts new file mode 100644 index 0000000000..7176cb8e3b --- /dev/null +++ b/impls/ts/step5_tco.ts @@ -0,0 +1,173 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalNil, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; +import { Env } from "./env"; +import * as core from "./core"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + env = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + for (let i = 0; i < pairs.list.length; i += 2) { + const key = pairs.list[i]; + const value = pairs.list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + env.set(key.v, evalMal(value, env)); + } + ast = ast.list[2]; + continue loop; + } + case "do": { + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); + ast = ast.list[ast.list.length - 1]; + continue loop; + } + case "if": { + const [, cond, thenExpr, elseExrp] = ast.list; + const ret = evalMal(cond, env); + let b = true; + if (ret.type === Node.Boolean && !ret.v) { + b = false; + } else if (ret.type === Node.Nil) { + b = false; + } + if (b) { + ast = thenExpr; + } else if (elseExrp) { + ast = elseExrp; + } else { + ast = MalNil.instance; + } + continue loop; + } + case "fn*": { + const [, params, bodyAst] = ast.list; + if (!isSeq(params)) { + throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); + } + const symbols = params.list.map(param => { + if (param.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${param.type}, expected: symbol`); + } + return param; + }); + return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + if (f.ast) { + ast = f.ast; + env = f.newEnv(args); + continue loop; + } + + return f.func(...args); + } +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +// core.EXT: defined using Racket +core.ns.forEach((value, key) => { + replEnv.set(key, value); +}); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + if (isAST(e)) { + console.error("Error:", prStr(e)); + } else { + const err: Error = e; + console.error("Error:", err.message); + } + } +} diff --git a/impls/ts/step6_file.ts b/impls/ts/step6_file.ts new file mode 100644 index 0000000000..290fd30caf --- /dev/null +++ b/impls/ts/step6_file.ts @@ -0,0 +1,187 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; +import { Env } from "./env"; +import * as core from "./core"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + env = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + for (let i = 0; i < pairs.list.length; i += 2) { + const key = pairs.list[i]; + const value = pairs.list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + env.set(key.v, evalMal(value, env)); + } + ast = ast.list[2]; + continue loop; + } + case "do": { + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); + ast = ast.list[ast.list.length - 1]; + continue loop; + } + case "if": { + const [, cond, thenExpr, elseExrp] = ast.list; + const ret = evalMal(cond, env); + let b = true; + if (ret.type === Node.Boolean && !ret.v) { + b = false; + } else if (ret.type === Node.Nil) { + b = false; + } + if (b) { + ast = thenExpr; + } else if (elseExrp) { + ast = elseExrp; + } else { + ast = MalNil.instance; + } + continue loop; + } + case "fn*": { + const [, params, bodyAst] = ast.list; + if (!isSeq(params)) { + throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); + } + const symbols = params.list.map(param => { + if (param.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${param.type}, expected: symbol`); + } + return param; + }); + return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + if (f.ast) { + ast = f.ast; + env = f.newEnv(args); + continue loop; + } + + return f.func(...args); + } +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +// core.EXT: defined using Racket +core.ns.forEach((value, key) => { + replEnv.set(key, value); +}); +replEnv.set("eval", MalFunction.fromBootstrap(ast => { + if (!ast) { + throw new Error(`undefined argument`); + } + return evalMal(ast, replEnv); +})); +replEnv.set("*ARGV*", new MalList([])); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); + +if (typeof process !== "undefined" && 2 < process.argv.length) { + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); + rep(`(load-file "${process.argv[2]}")`); + process.exit(0); +} + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + if (isAST(e)) { + console.error("Error:", prStr(e)); + } else { + const err: Error = e; + console.error("Error:", err.message); + } + } +} diff --git a/impls/ts/step7_quote.ts b/impls/ts/step7_quote.ts new file mode 100644 index 0000000000..72279a6692 --- /dev/null +++ b/impls/ts/step7_quote.ts @@ -0,0 +1,240 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; +import { Env } from "./env"; +import * as core from "./core"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + +function quasiquote(ast: MalType): MalType { + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; + } +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + env = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + for (let i = 0; i < pairs.list.length; i += 2) { + const key = pairs.list[i]; + const value = pairs.list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + env.set(key.v, evalMal(value, env)); + } + ast = ast.list[2]; + continue loop; + } + case "quote": { + return ast.list[1]; + } + case "quasiquote": { + ast = quasiquote(ast.list[1]); + continue loop; + } + case "do": { + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); + ast = ast.list[ast.list.length - 1]; + continue loop; + } + case "if": { + const [, cond, thenExpr, elseExrp] = ast.list; + const ret = evalMal(cond, env); + let b = true; + if (ret.type === Node.Boolean && !ret.v) { + b = false; + } else if (ret.type === Node.Nil) { + b = false; + } + if (b) { + ast = thenExpr; + } else if (elseExrp) { + ast = elseExrp; + } else { + ast = MalNil.instance; + } + continue loop; + } + case "fn*": { + const [, params, bodyAst] = ast.list; + if (!isSeq(params)) { + throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); + } + const symbols = params.list.map(param => { + if (param.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${param.type}, expected: symbol`); + } + return param; + }); + return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + if (f.ast) { + ast = f.ast; + env = f.newEnv(args); + continue loop; + } + + return f.func(...args); + } +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +// core.EXT: defined using Racket +core.ns.forEach((value, key) => { + replEnv.set(key, value); +}); +replEnv.set("eval", MalFunction.fromBootstrap(ast => { + if (!ast) { + throw new Error(`undefined argument`); + } + return evalMal(ast, replEnv); +})); +replEnv.set("*ARGV*", new MalList([])); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); + +if (typeof process !== "undefined" && 2 < process.argv.length) { + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); + rep(`(load-file "${process.argv[2]}")`); + process.exit(0); +} + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + if (isAST(e)) { + console.error("Error:", prStr(e)); + } else { + const err: Error = e; + console.error("Error:", err.message); + } + } +} diff --git a/impls/ts/step8_macros.ts b/impls/ts/step8_macros.ts new file mode 100644 index 0000000000..bb53fc7ffa --- /dev/null +++ b/impls/ts/step8_macros.ts @@ -0,0 +1,259 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; +import { Env } from "./env"; +import * as core from "./core"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + +function quasiquote(ast: MalType): MalType { + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; + } +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + env = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + for (let i = 0; i < pairs.list.length; i += 2) { + const key = pairs.list[i]; + const value = pairs.list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + env.set(key.v, evalMal(value, env)); + } + ast = ast.list[2]; + continue loop; + } + case "quote": { + return ast.list[1]; + } + case "quasiquote": { + ast = quasiquote(ast.list[1]); + continue loop; + } + case "defmacro!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + const f = evalMal(value, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token type: ${f.type}, expected: function`); + } + return env.set(key.v, f.toMacro()); + } + case "do": { + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); + ast = ast.list[ast.list.length - 1]; + continue loop; + } + case "if": { + const [, cond, thenExpr, elseExrp] = ast.list; + const ret = evalMal(cond, env); + let b = true; + if (ret.type === Node.Boolean && !ret.v) { + b = false; + } else if (ret.type === Node.Nil) { + b = false; + } + if (b) { + ast = thenExpr; + } else if (elseExrp) { + ast = elseExrp; + } else { + ast = MalNil.instance; + } + continue loop; + } + case "fn*": { + const [, params, bodyAst] = ast.list; + if (!isSeq(params)) { + throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); + } + const symbols = params.list.map(param => { + if (param.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${param.type}, expected: symbol`); + } + return param; + }); + return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + if (f.isMacro) { + ast = f.func(...ast.list.slice(1)); + continue loop; + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + if (f.ast) { + ast = f.ast; + env = f.newEnv(args); + continue loop; + } + + return f.func(...args); + } +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +// core.EXT: defined using Racket +core.ns.forEach((value, key) => { + replEnv.set(key, value); +}); +replEnv.set("eval", MalFunction.fromBootstrap(ast => { + if (!ast) { + throw new Error(`undefined argument`); + } + return evalMal(ast, replEnv); +})); +replEnv.set("*ARGV*", new MalList([])); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); +rep(`(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))`); + +if (typeof process !== "undefined" && 2 < process.argv.length) { + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); + rep(`(load-file "${process.argv[2]}")`); + process.exit(0); +} + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + if (isAST(e)) { + console.error("Error:", prStr(e)); + } else { + const err: Error = e; + console.error("Error:", err.message); + } + } +} diff --git a/impls/ts/step9_try.ts b/impls/ts/step9_try.ts new file mode 100644 index 0000000000..188642c607 --- /dev/null +++ b/impls/ts/step9_try.ts @@ -0,0 +1,284 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; +import { Env } from "./env"; +import * as core from "./core"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + +function quasiquote(ast: MalType): MalType { + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; + } +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + env = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + for (let i = 0; i < pairs.list.length; i += 2) { + const key = pairs.list[i]; + const value = pairs.list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + env.set(key.v, evalMal(value, env)); + } + ast = ast.list[2]; + continue loop; + } + case "quote": { + return ast.list[1]; + } + case "quasiquote": { + ast = quasiquote(ast.list[1]); + continue loop; + } + case "defmacro!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + const f = evalMal(value, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token type: ${f.type}, expected: function`); + } + return env.set(key.v, f.toMacro()); + } + case "try*": { + try { + return evalMal(ast.list[1], env); + } catch (e) { + if (ast.list.length < 3) { + throw e; + } + const catchBody = ast.list[2]; + if (!isSeq(catchBody)) { + throw new Error(`unexpected return type: ${catchBody.type}, expected: list or vector`); + } + const catchSymbol = catchBody.list[0]; + if (catchSymbol.type === Node.Symbol && catchSymbol.v === "catch*") { + const errorSymbol = catchBody.list[1]; + if (errorSymbol.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${errorSymbol.type}, expected: symbol`); + } + if (!isAST(e)) { + e = new MalString((e as Error).message); + } + return evalMal(catchBody.list[2], new Env(env, [errorSymbol], [e])); + } + throw e; + } + } + case "do": { + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); + ast = ast.list[ast.list.length - 1]; + continue loop; + } + case "if": { + const [, cond, thenExpr, elseExrp] = ast.list; + const ret = evalMal(cond, env); + let b = true; + if (ret.type === Node.Boolean && !ret.v) { + b = false; + } else if (ret.type === Node.Nil) { + b = false; + } + if (b) { + ast = thenExpr; + } else if (elseExrp) { + ast = elseExrp; + } else { + ast = MalNil.instance; + } + continue loop; + } + case "fn*": { + const [, params, bodyAst] = ast.list; + if (!isSeq(params)) { + throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); + } + const symbols = params.list.map(param => { + if (param.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${param.type}, expected: symbol`); + } + return param; + }); + return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + if (f.isMacro) { + ast = f.func(...ast.list.slice(1)); + continue loop; + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + if (f.ast) { + ast = f.ast; + env = f.newEnv(args); + continue loop; + } + + return f.func(...args); + } +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +// core.EXT: defined using Racket +core.ns.forEach((value, key) => { + replEnv.set(key, value); +}); +replEnv.set("eval", MalFunction.fromBootstrap(ast => { + if (!ast) { + throw new Error(`undefined argument`); + } + return evalMal(ast, replEnv); +})); +replEnv.set("*ARGV*", new MalList([])); + +// core.mal: defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); +rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); +rep(`(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))`); + +if (typeof process !== "undefined" && 2 < process.argv.length) { + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); + rep(`(load-file "${process.argv[2]}")`); + process.exit(0); +} + +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + if (isAST(e)) { + console.error("Error:", prStr(e)); + } else { + const err: Error = e; + console.error("Error:", err.message); + } + } +} diff --git a/impls/ts/stepA_mal.ts b/impls/ts/stepA_mal.ts new file mode 100644 index 0000000000..e0280665a3 --- /dev/null +++ b/impls/ts/stepA_mal.ts @@ -0,0 +1,286 @@ +import { readline } from "./node_readline"; + +import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; +import { Env } from "./env"; +import * as core from "./core"; +import { readStr } from "./reader"; +import { prStr } from "./printer"; + +// READ +function read(str: string): MalType { + return readStr(str); +} + +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + +function quasiquote(ast: MalType): MalType { + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; + } +} + +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { + // Output a debug line if the option is enabled. + const dbgeval : MalType | null = env.get("DEBUG-EVAL"); + if (dbgeval !== null + && dbgeval.type !== Node.Nil + && (dbgeval.type !== Node.Boolean || dbgeval.v)) + console.log("EVAL:", prStr(ast)); + // Deal with non-list types. + switch (ast.type) { + case Node.Symbol: + const f : MalType | null = env.get(ast.v); + if (!f) { + throw new Error(`'${ast.v}' not found`); + } + return f; + case Node.List: + break; + case Node.Vector: + return new MalVector(ast.list.map(ast => evalMal(ast, env))); + case Node.HashMap: + const list: MalType[] = []; + for (const [key, value] of ast.entries()) { + list.push(key); + list.push(evalMal(value, env)); + } + return new MalHashMap(list); + default: + return ast; + } + if (ast.list.length === 0) { + return ast; + } + const first = ast.list[0]; + switch (first.type) { + case Node.Symbol: + switch (first.v) { + case "def!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + return env.set(key.v, evalMal(value, env)); + } + case "let*": { + env = new Env(env); + const pairs = ast.list[1]; + if (!isSeq(pairs)) { + throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); + } + for (let i = 0; i < pairs.list.length; i += 2) { + const key = pairs.list[i]; + const value = pairs.list[i + 1]; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!key || !value) { + throw new Error(`unexpected syntax`); + } + + env.set(key.v, evalMal(value, env)); + } + ast = ast.list[2]; + continue loop; + } + case "quote": { + return ast.list[1]; + } + case "quasiquote": { + ast = quasiquote(ast.list[1]); + continue loop; + } + case "defmacro!": { + const [, key, value] = ast.list; + if (key.type !== Node.Symbol) { + throw new Error(`unexpected token type: ${key.type}, expected: symbol`); + } + if (!value) { + throw new Error(`unexpected syntax`); + } + const f = evalMal(value, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token type: ${f.type}, expected: function`); + } + return env.set(key.v, f.toMacro()); + } + case "try*": { + try { + return evalMal(ast.list[1], env); + } catch (e) { + if (ast.list.length < 3) { + throw e; + } + const catchBody = ast.list[2]; + if (!isSeq(catchBody)) { + throw new Error(`unexpected return type: ${catchBody.type}, expected: list or vector`); + } + const catchSymbol = catchBody.list[0]; + if (catchSymbol.type === Node.Symbol && catchSymbol.v === "catch*") { + const errorSymbol = catchBody.list[1]; + if (errorSymbol.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${errorSymbol.type}, expected: symbol`); + } + if (!isAST(e)) { + e = new MalString((e as Error).message); + } + return evalMal(catchBody.list[2], new Env(env, [errorSymbol], [e])); + } + throw e; + } + } + case "do": { + for (let i = 1; i < ast.list.length - 1; i++) + evalMal(ast.list[i], env); + ast = ast.list[ast.list.length - 1]; + continue loop; + } + case "if": { + const [, cond, thenExpr, elseExrp] = ast.list; + const ret = evalMal(cond, env); + let b = true; + if (ret.type === Node.Boolean && !ret.v) { + b = false; + } else if (ret.type === Node.Nil) { + b = false; + } + if (b) { + ast = thenExpr; + } else if (elseExrp) { + ast = elseExrp; + } else { + ast = MalNil.instance; + } + continue loop; + } + case "fn*": { + const [, params, bodyAst] = ast.list; + if (!isSeq(params)) { + throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); + } + const symbols = params.list.map(param => { + if (param.type !== Node.Symbol) { + throw new Error(`unexpected return type: ${param.type}, expected: symbol`); + } + return param; + }); + return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); + } + } + } + const f : MalType = evalMal(first, env); + if (f.type !== Node.Function) { + throw new Error(`unexpected token: ${f.type}, expected: function`); + } + if (f.isMacro) { + ast = f.func(...ast.list.slice(1)); + continue loop; + } + const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); + if (f.ast) { + ast = f.ast; + env = f.newEnv(args); + continue loop; + } + + return f.func(...args); + } +} + +// PRINT +function print(exp: MalType): string { + return prStr(exp); +} + +const replEnv = new Env(); +function rep(str: string): string { + return print(evalMal(read(str), replEnv)); +} + +// core.EXT: defined using Racket +core.ns.forEach((value, key) => { + replEnv.set(key, value); +}); +replEnv.set("eval", MalFunction.fromBootstrap(ast => { + if (!ast) { + throw new Error(`undefined argument`); + } + return evalMal(ast, replEnv); +})); +replEnv.set("*ARGV*", new MalList([])); + +// core.mal: defined using the language itself +rep(`(def! *host-language* "TypeScript")`); +rep("(def! not (fn* (a) (if a false true)))"); +rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); +rep(`(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))`); + +if (typeof process !== "undefined" && 2 < process.argv.length) { + replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); + rep(`(load-file "${process.argv[2]}")`); + process.exit(0); +} + +rep(`(println (str "Mal [" *host-language* "]"))`); +while (true) { + const line = readline("user> "); + if (line == null) { + break; + } + if (line === "") { + continue; + } + try { + console.log(rep(line)); + } catch (e) { + if (isAST(e)) { + console.error("Error:", prStr(e)); + } else { + const err: Error = e; + console.error("Error:", err.message); + } + } +} diff --git a/impls/ts/tsconfig.json b/impls/ts/tsconfig.json new file mode 100644 index 0000000000..94a5d7816d --- /dev/null +++ b/impls/ts/tsconfig.json @@ -0,0 +1,21 @@ +{ + "compilerOptions": { + "module": "commonjs", + "target": "es5", + "lib": [ + "es2015" + ], + "noImplicitAny": true, + "noEmitOnError": true, + "noImplicitReturns": true, + "noImplicitThis": true, + "noUnusedLocals": true, + "noUnusedParameters": true, + "newLine": "LF", + "strictNullChecks": true, + "sourceMap": false + }, + "exclude": [ + "node_modules" + ] +} diff --git a/impls/ts/types.ts b/impls/ts/types.ts new file mode 100644 index 0000000000..0a61f2b2a2 --- /dev/null +++ b/impls/ts/types.ts @@ -0,0 +1,411 @@ +import { Env } from "./env"; + +export type MalType = MalList | MalNumber | MalString | MalNil | MalBoolean | MalSymbol | MalKeyword | MalVector | MalHashMap | MalFunction | MalAtom; + +export const enum Node { + List = 1, + Number, + String, + Nil, + Boolean, + Symbol, + Keyword, + Vector, + HashMap, + Function, + Atom, +} + +export function equals(a: MalType, b: MalType, strict?: boolean): boolean { + if (strict && a.type !== b.type) { + return false; + } + + if (a.type === Node.Nil && b.type === Node.Nil) { + return true; + } + if (isSeq(a) && isSeq(b)) { + return listEquals(a.list, b.list); + } + if (a.type === Node.HashMap && b.type === Node.HashMap) { + if (a.keywordMap.size !== b.keywordMap.size) { + return false; + } + if (Object.keys(a.stringMap).length !== Object.keys(b.stringMap).length) { + return false; + } + for (const [aK, aV] of a.entries()) { + if (aK.type !== Node.String && aK.type !== Node.Keyword) { + throw new Error(`unexpected symbol: ${aK.type}, expected: string or keyword`); + } + const bV = b.get(aK); + if (aV.type === Node.Nil && bV.type === Node.Nil) { + continue; + } + if (!equals(aV, bV)) { + return false; + } + } + + return true; + } + if ( + (a.type === Node.Number && b.type === Node.Number) + || (a.type === Node.String && b.type === Node.String) + || (a.type === Node.Boolean && b.type === Node.Boolean) + || (a.type === Node.Symbol && b.type === Node.Symbol) + || (a.type === Node.Keyword && b.type === Node.Keyword) + ) { + return a.v === b.v; + } + + return false; + + function listEquals(a: MalType[], b: MalType[]): boolean { + if (a.length !== b.length) { + return false; + } + for (let i = 0; i < a.length; i++) { + if (!equals(a[i], b[i], strict)) { + return false; + } + } + return true; + } +} + +export function isSeq(ast: MalType): ast is MalList | MalVector { + return ast.type === Node.List || ast.type === Node.Vector; +} + +export function isAST(v: MalType): v is MalType { + return !!v.type; +} + +export class MalList { + type: Node.List = Node.List; + meta?: MalType; + + constructor(public list: MalType[]) { + } + + withMeta(meta: MalType) { + const v = new MalList(this.list); + v.meta = meta; + return v; + } +} + +export class MalNumber { + type: Node.Number = Node.Number; + meta?: MalType; + + constructor(public v: number) { + } + + withMeta(meta: MalType) { + const v = new MalNumber(this.v); + v.meta = meta; + return v; + } +} + +export class MalString { + type: Node.String = Node.String; + meta?: MalType; + + constructor(public v: string) { + } + + withMeta(meta: MalType) { + const v = new MalString(this.v); + v.meta = meta; + return v; + } +} + +export class MalNil { + + private static _instance?: MalNil; + + static get instance(): MalNil { + if (this._instance) { + return this._instance; + } + this._instance = new MalNil(); + return this._instance; + } + + type: Node.Nil = Node.Nil; + meta?: MalType; + + private constructor() { } + + withMeta(_meta: MalType): MalNil { + throw new Error(`not supported`); + } +} + +export class MalBoolean { + type: Node.Boolean = Node.Boolean; + meta?: MalType; + + constructor(public v: boolean) { + } + + withMeta(meta: MalType) { + const v = new MalBoolean(this.v); + v.meta = meta; + return v; + } +} + +export class MalSymbol { + static map = new Map(); + + static get(name: string): MalSymbol { + const sym = Symbol.for(name); + let token = this.map.get(sym); + if (token) { + return token; + } + token = new MalSymbol(name); + this.map.set(sym, token); + return token; + } + + type: Node.Symbol = Node.Symbol; + meta?: MalType; + + private constructor(public v: string) { + } + + withMeta(_meta: MalType): MalSymbol { + throw new Error(`not supported`); + } +} + +export class MalKeyword { + static map = new Map(); + + static get(name: string): MalKeyword { + const sym = Symbol.for(name); + let token = this.map.get(sym); + if (token) { + return token; + } + token = new MalKeyword(name); + this.map.set(sym, token); + return token; + } + + type: Node.Keyword = Node.Keyword; + meta?: MalType; + + private constructor(public v: string) { + } + + withMeta(_meta: MalType): MalKeyword { + throw new Error(`not supported`); + } +} + +export class MalVector { + type: Node.Vector = Node.Vector; + meta?: MalType; + + constructor(public list: MalType[]) { + } + + withMeta(meta: MalType) { + const v = new MalVector(this.list); + v.meta = meta; + return v; + } +} + +export class MalHashMap { + type: Node.HashMap = Node.HashMap; + stringMap: { [key: string]: MalType } = {}; + keywordMap = new Map(); + meta?: MalType; + + constructor(list: MalType[]) { + while (list.length !== 0) { + const key = list.shift()!; + const value = list.shift(); + if (value == null) { + throw new Error("unexpected hash length"); + } + if (key.type === Node.Keyword) { + this.keywordMap.set(key, value); + } else if (key.type === Node.String) { + this.stringMap[key.v] = value; + } else { + throw new Error(`unexpected key symbol: ${key.type}, expected: keyword or string`); + } + } + } + + withMeta(meta: MalType) { + const v = this.assoc([]); + v.meta = meta; + return v; + } + + has(key: MalKeyword | MalString) { + if (key.type === Node.Keyword) { + return !!this.keywordMap.get(key); + } + return !!this.stringMap[key.v]; + } + + get(key: MalKeyword | MalString) { + if (key.type === Node.Keyword) { + return this.keywordMap.get(key) || MalNil.instance; + } + return this.stringMap[key.v] || MalNil.instance; + } + + entries(): [MalType, MalType][] { + const list: [MalType, MalType][] = []; + + this.keywordMap.forEach((v, k) => { + list.push([k, v]); + }); + Object.keys(this.stringMap).forEach(v => list.push([new MalString(v), this.stringMap[v]])); + + return list; + } + + keys(): MalType[] { + const list: MalType[] = []; + this.keywordMap.forEach((_v, k) => { + list.push(k); + }); + Object.keys(this.stringMap).forEach(v => list.push(new MalString(v))); + return list; + } + + vals(): MalType[] { + const list: MalType[] = []; + this.keywordMap.forEach(v => { + list.push(v); + }); + Object.keys(this.stringMap).forEach(v => list.push(this.stringMap[v])); + return list; + } + + assoc(args: MalType[]): MalHashMap { + const list: MalType[] = []; + this.keywordMap.forEach((value, key) => { + list.push(key); + list.push(value); + }); + Object.keys(this.stringMap).forEach(keyStr => { + list.push(new MalString(keyStr)); + list.push(this.stringMap[keyStr]); + }); + + return new MalHashMap(list.concat(args)); + } + + dissoc(args: MalType[]): MalHashMap { + const newHashMap = this.assoc([]); + + args.forEach(arg => { + if (arg.type === Node.String) { + delete newHashMap.stringMap[arg.v]; + } else if (arg.type === Node.Keyword) { + newHashMap.keywordMap.delete(arg); + } else { + throw new Error(`unexpected symbol: ${arg.type}, expected: keyword or string`); + } + }); + return newHashMap; + } +} + +type MalF = (...args: (MalType | undefined)[]) => MalType; + +export class MalFunction { + static fromLisp(evalMal: (ast: MalType, env: Env) => MalType, env: Env, params: MalSymbol[], bodyAst: MalType): MalFunction { + const f = new MalFunction(); + f.func = (...args) => evalMal(bodyAst, new Env(env, params, checkUndefined(args))); + f.env = env; + f.params = params; + f.ast = bodyAst; + f.isMacro = false; + + return f; + + function checkUndefined(args: (MalType | undefined)[]): MalType[] { + return args.map(arg => { + if (!arg) { + throw new Error(`undefined argument`); + } + return arg; + }); + } + } + + static fromBootstrap(func: MalF): MalFunction { + const f = new MalFunction(); + f.func = func; + f.isMacro = false; + + return f; + } + + type: Node.Function = Node.Function; + func: MalF; + ast: MalType; + env: Env; + params: MalSymbol[]; + isMacro: boolean; + meta?: MalType; + + private constructor() { } + + toMacro() { + const f = new MalFunction(); + f.func = this.func; + f.ast = this.ast; + f.env = this.env; + f.params = this.params; + f.isMacro = true; + f.meta = this.meta; + + return f; + } + + withMeta(meta: MalType) { + const f = new MalFunction(); + f.func = this.func; + f.ast = this.ast; + f.env = this.env; + f.params = this.params; + f.isMacro = this.isMacro; + f.meta = meta; + + return f; + } + + newEnv(args: MalType[]) { + return new Env(this.env, this.params, args); + } +} + +export class MalAtom { + type: Node.Atom = Node.Atom; + meta?: MalType; + + constructor(public v: MalType) { + } + + withMeta(meta: MalType) { + const v = new MalAtom(this.v); + v.meta = meta; + return v; + } +} \ No newline at end of file diff --git a/impls/vala/.gitignore b/impls/vala/.gitignore new file mode 100644 index 0000000000..71c67bdcef --- /dev/null +++ b/impls/vala/.gitignore @@ -0,0 +1,3 @@ +*.c +*.h +*.o diff --git a/impls/vala/Dockerfile b/impls/vala/Dockerfile new file mode 100644 index 0000000000..cc5e78cfe7 --- /dev/null +++ b/impls/vala/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:18.04 + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Nothing additional needed for vala +RUN apt-get -y install valac diff --git a/impls/vala/Makefile b/impls/vala/Makefile new file mode 100644 index 0000000000..741c8eba5a --- /dev/null +++ b/impls/vala/Makefile @@ -0,0 +1,52 @@ +PROGRAMS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ + step5_tco step6_file step7_quote step8_macros step9_try stepA_mal +AUX1 = gc.vala types.vala reader.vala printer.vala +AUX3 = $(AUX1) env.vala +AUX4 = $(AUX3) core.vala + +# Inhibit default make rules, in case they try to build from leftover .c files +.SUFFIXES: + +all: $(PROGRAMS) + +# You can define VFLAGS on the command line to add flags to the vala compiler. +# Some useful ones: +# +# -g annotate the output C with #line directives so that backtraces +# from gdb, sanitisers and valgrind will list Vala source locations +# +# -X -g -X -O0 compile the output C for sensible debugging +# +# -X -fsanitize=address link the output program against Address Sanitizer +# +# --save-temps don't automatically delete the C files after compiling +# +# -D GC_STATS print statistics every time the garbage collector runs +# +# -D GC_DEBUG print full diagnostics from the garbage collector +# +# -D GC_ALWAYS make the garbage collector run at every opportunity +# (good for making occasional GC errors show up sooner) + +$(PROGRAMS): %: %.vala + valac $(VFLAGS) -o $@ $^ $(DEFINES) --pkg readline -X -lreadline + +step1_read_print step2_eval: override DEFINES += -D NO_ENV + +step0_repl: +step1_read_print: $(AUX1) +step2_eval: $(AUX1) +step3_env: $(AUX3) +step4_if_fn_do: $(AUX4) +step5_tco: $(AUX4) +step6_file: $(AUX4) +step7_quote: $(AUX4) +step8_macros: $(AUX4) +step9_try: $(AUX4) +stepA_mal: $(AUX4) + +clean: clean-c + rm -f $(PROGRAMS) + +clean-c: + rm -f *.c *.h diff --git a/impls/vala/README.md b/impls/vala/README.md new file mode 100644 index 0000000000..6ae562e2b3 --- /dev/null +++ b/impls/vala/README.md @@ -0,0 +1,60 @@ +# Vala implementation + +Notes on building: + +* With the Debian or Ubuntu packages `valac` and `libreadline-dev` + installed, and GNU make, you should be able to build using the + provided Makefile. + +* The build will not be warning-clean, because the shared modules like + `types.vala` and `core.vala` are shared between all the `stepN` main + programs, and not all the steps use all the functions in the shared + modules, and the Vala compiler has no way to turn off the warning + about unused pieces of source code. + +* The Vala compiler works by translating the program to C and then + compiling that. The C compilation stage can sometimes encounter an + error, in which case the compiler will leave `.c` source files in + the working directory. If that happens, you can run `make clean-c` + to get rid of them. + +Design notes on the implementation: + +* Vala has exceptions (which it calls 'error domains'), but they don't + let you store an arbitrary data type: every exception subclass you + make stores the same data, namely a string. So mal exceptions are + implemented by storing a mal value in a static variable, and then + throwing a particular Vala error whose semantics are 'check that + variable when you catch me'. + +* Vala's bare function pointers are hard to use, especially if you + want one to survive the scope it was created in. So all the core + functions are implemented as classes with a `call` method, which + leads to a lot of boilerplate. + +* To make `types.vala` work in step 2, when the `Env` type doesn't + exist yet, I had to use `#if` to condition out the parts of the code + that depend on that type. + +* Mutability of objects at the Vala level is a bit informal. A lot of + core functions construct a list by making an empty `Mal.List` and + then mutating the `GLib.List` contained in it. But once they've + finished and returned the `Mal.List` to their caller, that list is + never mutated again, which means it's safe for the copying operation + in `with-meta` to make a second `Mal.List` sharing the reference to + the same `GLib.List`. + +* Vala has a reference counting system built in to the language, but + that's not enough to implement mal sensibly, because the common + construction `(def! FUNC (fn* [ARGS] BODY))` causes a length-2 cycle + of references: the environment captured in `FUNC`'s function object + is the same one where `def!` inserts the definition of `FUNC`, so + the function and environment both link to each other. And either + element of the cycle could end up being the last one referred to + from elsewhere, so you can't break the link by just making the right + one of those references weak. So instead there's a small garbage + collector in `gc.vala`, which works by being the only part of the + program that keeps a non-weak reference to any `Mal.Val` or + `Mal.Env`: it links all GCable objects together into a list, and + when the collector runs, it unlinks dead objects from that list and + allows Vala's normal reference counting to free them. diff --git a/impls/vala/core.vala b/impls/vala/core.vala new file mode 100644 index 0000000000..9fba170ee1 --- /dev/null +++ b/impls/vala/core.vala @@ -0,0 +1,1207 @@ +abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction { + public abstract int64 result(int64 a, int64 b); + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + Mal.Num a = args.vs.data as Mal.Num; + Mal.Num b = args.vs.next.data as Mal.Num; + if (a == null || b == null) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + return new Mal.Num(result(a.v, b.v)); + } +} + +class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionAdd(); + } + public override string name() { return "+"; } + public override int64 result(int64 a, int64 b) { return a+b; } +} + +class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSub(); + } + public override string name() { return "-"; } + public override int64 result(int64 a, int64 b) { return a-b; } +} + +class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionMul(); + } + public override string name() { return "*"; } + public override int64 result(int64 a, int64 b) { return a*b; } +} + +class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionDiv(); + } + public override string name() { return "/"; } + public override int64 result(int64 a, int64 b) { return a/b; } +} + +class Mal.BuiltinFunctionPrStr : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionPrStr(); + } + public override string name() { return "pr-str"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + string result = ""; + string sep = ""; + foreach (var value in args.vs) { + result += sep + pr_str(value, true); + sep = " "; + } + return new Mal.String(result); + } +} + +class Mal.BuiltinFunctionStr : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionStr(); + } + public override string name() { return "str"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + string result = ""; + foreach (var value in args.vs) { + result += pr_str(value, false); + } + return new Mal.String(result); + } +} + +class Mal.BuiltinFunctionPrn : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionPrn(); + } + public override string name() { return "prn"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + string sep = ""; + foreach (var value in args.vs) { + stdout.printf("%s%s", sep, pr_str(value, true)); + sep = " "; + } + stdout.printf("\n"); + return new Mal.Nil(); + } +} + +class Mal.BuiltinFunctionPrintln : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionPrintln(); + } + public override string name() { return "println"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + string sep = ""; + foreach (var value in args.vs) { + stdout.printf("%s%s", sep, pr_str(value, false)); + sep = " "; + } + stdout.printf("\n"); + return new Mal.Nil(); + } +} + +class Mal.BuiltinFunctionReadString : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionReadString(); + } + public override string name() { return "read-string"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1 || !(args.vs.data is Mal.String)) + throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); + return Reader.read_str((args.vs.data as Mal.String).v); + } +} + +class Mal.BuiltinFunctionSlurp : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSlurp(); + } + public override string name() { return "slurp"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1 || !(args.vs.data is Mal.String)) + throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); + string filename = (args.vs.data as Mal.String).v; + string contents; + try { + FileUtils.get_contents(filename, out contents); + } catch (FileError e) { + throw new Mal.Error.BAD_PARAMS("%s: unable to read '%s': %s", + name(), filename, e.message); + } + return new Mal.String(contents); + } +} + +class Mal.BuiltinFunctionList : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionList(); + } + public override string name() { return "list"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + return args; + } +} + +class Mal.BuiltinFunctionListP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionListP(); + } + public override string name() { return "list?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.List); + } +} + +class Mal.BuiltinFunctionSequentialP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSequentialP(); + } + public override string name() { return "sequential?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.List || + args.vs.data is Mal.Vector); + } +} + +class Mal.BuiltinFunctionNilP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionNilP(); + } + public override string name() { return "nil?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Nil); + } +} + +class Mal.BuiltinFunctionTrueP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionTrueP(); + } + public override string name() { return "true?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Bool && + (args.vs.data as Mal.Bool).v); + } +} + +class Mal.BuiltinFunctionFalseP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionFalseP(); + } + public override string name() { return "false?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Bool && + !(args.vs.data as Mal.Bool).v); + } +} + +class Mal.BuiltinFunctionNumberP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionNumberP(); + } + public override string name() { return "number?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Num); + } +} + +class Mal.BuiltinFunctionStringP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionStringP(); + } + public override string name() { return "string?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.String); + } +} + +class Mal.BuiltinFunctionSymbolP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSymbolP(); + } + public override string name() { return "symbol?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Sym); + } +} + +class Mal.BuiltinFunctionKeywordP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionKeywordP(); + } + public override string name() { return "keyword?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Keyword); + } +} + +class Mal.BuiltinFunctionVector : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionVector(); + } + public override string name() { return "vector"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + return new Mal.Vector.from_list(args.vs); + } +} + +class Mal.BuiltinFunctionVectorP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionVectorP(); + } + public override string name() { return "vector?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Vector); + } +} + +class Mal.BuiltinFunctionHashMap : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionHashMap(); + } + public override string name() { return "hash-map"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + var map = new Mal.Hashmap(); + for (var iter = args.iter(); iter.nonempty(); iter.step()) { + var key = iter.deref(); + var value = iter.step().deref(); + if (value == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected an even number of arguments", name()); + map.insert(key, value); + } + return map; + } +} + +class Mal.BuiltinFunctionMapP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionMapP(); + } + public override string name() { return "map?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Hashmap); + } +} + +class Mal.BuiltinFunctionEmptyP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionEmptyP(); + } + public override string name() { return "empty?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + var list = args.vs.data as Mal.Listlike; + if (list == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a list-like argument", name()); + return new Mal.Bool(list.iter().deref() == null); + } +} + +class Mal.BuiltinFunctionFnP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionFnP(); + } + public override string name() { return "fn?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + if (args.vs.data is Mal.BuiltinFunction) + return new Mal.Bool(true); + var fn = args.vs.data as Mal.Function; + return new Mal.Bool(fn != null && !fn.is_macro); + } +} + +class Mal.BuiltinFunctionMacroP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionMacroP(); + } + public override string name() { return "macro?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + var fn = args.vs.data as Mal.Function; + return new Mal.Bool(fn != null && fn.is_macro); + } +} + +class Mal.BuiltinFunctionCount : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionCount(); + } + public override string name() { return "count"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + if (args.vs.data is Mal.Nil) + return new Mal.Num(0); // nil is treated like () + if (args.vs.data is Mal.List) + return new Mal.Num((args.vs.data as Mal.List).vs.length()); + if (args.vs.data is Mal.Vector) + return new Mal.Num((args.vs.data as Mal.Vector).length); + throw new Mal.Error.BAD_PARAMS( + "%s: expected a list argument", name()); + } +} + +class Mal.BuiltinFunctionEQ : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionEQ(); + } + public override string name() { return "="; } + private static bool eq(Mal.Val a, Mal.Val b) { + if (a is Mal.Nil && b is Mal.Nil) + return true; + if (a is Mal.Bool && b is Mal.Bool) + return (a as Mal.Bool).v == (b as Mal.Bool).v; + if (a is Mal.Sym && b is Mal.Sym) + return (a as Mal.Sym).v == (b as Mal.Sym).v; + if (a is Mal.Keyword && b is Mal.Keyword) + return (a as Mal.Keyword).v == (b as Mal.Keyword).v; + if (a is Mal.Num && b is Mal.Num) + return (a as Mal.Num).v == (b as Mal.Num).v; + if (a is Mal.String && b is Mal.String) + return (a as Mal.String).v == (b as Mal.String).v; + if (a is Mal.Listlike && b is Mal.Listlike) { + if (a is Mal.Nil || b is Mal.Nil) + return false; + var aiter = (a as Mal.Listlike).iter(); + var biter = (b as Mal.Listlike).iter(); + while (aiter.nonempty() || biter.nonempty()) { + if (aiter.empty() || biter.empty()) + return false; + if (!eq(aiter.deref(), biter.deref())) + return false; + aiter.step(); + biter.step(); + } + return true; + } + if (a is Mal.Vector && b is Mal.Vector) { + var av = a as Mal.Vector; + var bv = b as Mal.Vector; + if (av.length != bv.length) + return false; + for (var i = 0; i < av.length; i++) + if (!eq(av[i], bv[i])) + return false; + return true; + } + if (a is Mal.Hashmap && b is Mal.Hashmap) { + var ah = (a as Mal.Hashmap).vs; + var bh = (b as Mal.Hashmap).vs; + if (ah.length != bh.length) + return false; + foreach (var k in ah.get_keys()) { + var av = ah[k]; + var bv = bh[k]; + if (bv == null || !eq(av, bv)) + return false; + } + return true; + } + if (a is Mal.BuiltinFunction && b is Mal.BuiltinFunction) { + return ((a as Mal.BuiltinFunction).name() == + (b as Mal.BuiltinFunction).name()); + } + if (a is Mal.Function && b is Mal.Function) { + var af = a as Mal.Function; + var bf = b as Mal.Function; + return (eq(af.parameters, bf.parameters) && + eq(af.body, bf.body)); + } + return false; + } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + return new Mal.Bool(eq(args.vs.data, args.vs.next.data)); + } +} + +abstract class Mal.BuiltinFunctionNumberCmp : Mal.BuiltinFunction { + public abstract bool result(int64 a, int64 b); + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + Mal.Num a = args.vs.data as Mal.Num; + Mal.Num b = args.vs.next.data as Mal.Num; + if (a == null || b == null) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + return new Mal.Bool(result(a.v, b.v)); + } +} + +class Mal.BuiltinFunctionLT : Mal.BuiltinFunctionNumberCmp { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionLT(); + } + public override string name() { return "<"; } + public override bool result(int64 a, int64 b) { return a"; } + public override bool result(int64 a, int64 b) { return a>b; } +} + +class Mal.BuiltinFunctionGE : Mal.BuiltinFunctionNumberCmp { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionGE(); + } + public override string name() { return ">="; } + public override bool result(int64 a, int64 b) { return a>=b; } +} + +class Mal.BuiltinFunctionAtom : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionAtom(); + } + public override string name() { return "atom"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Atom(args.vs.data); + } +} + +class Mal.BuiltinFunctionAtomP : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionAtomP(); + } + public override string name() { return "atom?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return new Mal.Bool(args.vs.data is Mal.Atom); + } +} + +class Mal.BuiltinFunctionDeref : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionDeref(); + } + public override string name() { return "deref"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + var atom = args.vs.data as Mal.Atom; + if (atom == null) + throw new Mal.Error.BAD_PARAMS("%s: expected an atom", name()); + return atom.v; + } +} + +class Mal.BuiltinFunctionReset : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionReset(); + } + public override string name() { return "reset!"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + var atom = args.vs.data as Mal.Atom; + if (atom == null) + throw new Mal.Error.BAD_PARAMS("%s: expected an atom", name()); + atom.v = args.vs.next.data; + return atom.v; + } +} + +Mal.Val call_function(Mal.Val function, GLib.List args, string caller) +throws Mal.Error { + var fnargs = new Mal.List(args); + if (function is Mal.BuiltinFunction) { + return (function as Mal.BuiltinFunction).call(fnargs); + } else if (function is Mal.Function) { + var fn = function as Mal.Function; + var env = new Mal.Env.funcall(fn.env, fn.parameters, fnargs); + return Mal.Main.EVAL(fn.body, env); + } else { + throw new Mal.Error.CANNOT_APPLY("%s: expected a function", caller); + } +} + +class Mal.BuiltinFunctionSwap : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSwap(); + } + public override string name() { return "swap!"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() < 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected at least two arguments", name()); + var atom = args.vs.data as Mal.Atom; + var function = args.vs.next.data; + var fnargs = args.vs.next.next.copy(); + fnargs.prepend(atom.v); + atom.v = call_function(function, fnargs, name()); + return atom.v; + } +} + +class Mal.BuiltinFunctionCons : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionCons(); + } + public override string name() { return "cons"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + var first = args.vs.data; + var rest = args.vs.next.data as Mal.Listlike; + if (rest == null) { + if (args.vs.next.data is Mal.Nil) + rest = new Mal.List.empty(); + else + throw new Mal.Error.BAD_PARAMS("%s: expected a list", name()); + } + var newlist = new Mal.List.empty(); + newlist.vs.append(first); + for (var iter = rest.iter(); iter.nonempty(); iter.step()) + newlist.vs.append(iter.deref()); + return newlist; + } +} + +class Mal.BuiltinFunctionConcat : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionConcat(); + } + public override string name() { return "concat"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + var newlist = new GLib.List(); + foreach (var listval in args.vs) { + if (listval is Mal.Nil) + continue; + var list = listval as Mal.Listlike; + if (list == null) + throw new Mal.Error.BAD_PARAMS("%s: expected a list", name()); + for (var iter = list.iter(); iter.nonempty(); iter.step()) + newlist.append(iter.deref()); + } + return new Mal.List(newlist); + } +} + +class Mal.BuiltinFunctionVec : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionVec(); + } + public override string name() { return "vec"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + var a0 = args.vs.data; + if (a0 is Mal.List) + return new Mal.Vector.from_list((a0 as Mal.List).vs); + if (a0 is Mal.Vector) + return a0; + throw new Mal.Error.BAD_PARAMS( + "%s: expected a list or a vector", name()); + } +} + +class Mal.BuiltinFunctionNth : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionNth(); + } + public override string name() { return "nth"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + var list = args.vs.data as Mal.Listlike; + var index = args.vs.next.data as Mal.Num; + if (list == null || index == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a list and a number", name()); + if (index.v < 0) + throw new Mal.Error.BAD_PARAMS( + "%s: negative list index", name()); + Mal.Val? result = null; + if (list is Mal.Vector) { + var vec = list as Mal.Vector; + if (index.v < vec.length) + result = vec[(uint)index.v]; + } else { + var iter = list.iter(); + var i = index.v; + while (!iter.empty()) { + if (i == 0) { + result = iter.deref(); + break; + } + iter.step(); + i--; + } + } + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "%s: list index out of range", name()); + return result; + } +} + +class Mal.BuiltinFunctionFirst : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionFirst(); + } + public override string name() { return "first"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + var list = args.vs.data as Mal.Listlike; + if (list == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a list number", name()); + Mal.Val? result = list.iter().deref(); + if (result == null) + result = new Mal.Nil(); + return result; + } +} + +class Mal.BuiltinFunctionRest : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionRest(); + } + public override string name() { return "rest"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + var list = args.vs.data as Mal.Listlike; + if (list == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a list", name()); + var result = new Mal.List.empty(); + for (var iter = list.iter().step(); iter.nonempty(); iter.step()) + result.vs.append(iter.deref()); + return result; + } +} + +class Mal.BuiltinFunctionThrow : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionThrow(); + } + private static Mal.Val? curr_exception; + static construct { + curr_exception = null; + } + public static void clear() { + curr_exception = null; + } + public static Mal.Val thrown_value(Mal.Error err) { + if (err is Mal.Error.EXCEPTION_THROWN) { + assert(curr_exception != null); + Mal.Val toret = curr_exception; + curr_exception = null; + return toret; + } else { + return new Mal.String(err.message); + } + } + + public override string name() { return "throw"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + assert(curr_exception == null); + curr_exception = args.vs.data; + throw new Mal.Error.EXCEPTION_THROWN("core function throw called"); + } +} + +class Mal.BuiltinFunctionApply : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionApply(); + } + public override string name() { return "apply"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() < 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected at least two arguments", name()); + var function = args.vs.data; + unowned GLib.List lastlink = args.vs.last(); + var list = lastlink.data as Mal.Listlike; + if (list == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected final argument to be a list", name()); + var fnargs = new GLib.List(); + for (var iter = list.iter(); iter.nonempty(); iter.step()) + fnargs.append(iter.deref()); + for (unowned GLib.List link = lastlink.prev; + link != args.vs; link = link.prev) + fnargs.prepend(link.data); + return call_function(function, fnargs, name()); + } +} + +class Mal.BuiltinFunctionMap : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionMap(); + } + public override string name() { return "map"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + var function = args.vs.data; + var list = args.vs.next.data as Mal.Listlike; + if (list == null) + throw new Mal.Error.BAD_PARAMS("%s: expected a list", name()); + var result = new Mal.List.empty(); + var root = new GC.Root(result); (void)root; + for (var iter = list.iter(); iter.nonempty(); iter.step()) { + var fnargs = new GLib.List(); + fnargs.append(iter.deref()); + result.vs.append(call_function(function, fnargs, name())); + } + return result; + } +} + +class Mal.BuiltinFunctionSymbol : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSymbol(); + } + public override string name() { return "symbol"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1 || !(args.vs.data is Mal.String)) + throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); + return new Mal.Sym((args.vs.data as Mal.String).v); + } +} + +class Mal.BuiltinFunctionKeyword : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionKeyword(); + } + public override string name() { return "keyword"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); + else if (args.vs.data is Mal.Keyword) + return args.vs.data; + else if (!(args.vs.data is Mal.String)) + throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); + return new Mal.Keyword((args.vs.data as Mal.String).v); + } +} + +class Mal.BuiltinFunctionAssoc : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionAssoc(); + } + public override string name() { return "assoc"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + var iter = args.iter(); + var oldmap = iter.deref() as Mal.Hashmap; + if (iter.deref() is Mal.Nil) + oldmap = new Mal.Hashmap(); + if (oldmap == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a hash-map to modify", name()); + + var map = new Mal.Hashmap(); + foreach (var key in oldmap.vs.get_keys()) + map.insert(key, oldmap.vs[key]); + + for (iter.step(); iter.nonempty(); iter.step()) { + var key = iter.deref(); + var value = iter.step().deref(); + if (value == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected an even number of arguments", name()); + map.insert(key, value); + } + return map; + } +} + +class Mal.BuiltinFunctionDissoc : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionDissoc(); + } + public override string name() { return "dissoc"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + var iter = args.iter(); + var oldmap = iter.deref() as Mal.Hashmap; + if (iter.deref() is Mal.Nil) + oldmap = new Mal.Hashmap(); + if (oldmap == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a hash-map to modify", name()); + + var map = new Mal.Hashmap(); + foreach (var key in oldmap.vs.get_keys()) + map.insert(key, oldmap.vs[key]); + + for (iter.step(); iter.nonempty(); iter.step()) { + var key = iter.deref(); + map.remove(key); + } + return map; + } +} + +// Can't call it BuiltinFunctionGet, or else valac defines +// BUILTIN_FUNCTION_GET_CLASS at the C level for this class, but that +// was already defined as the 'get class' macro for BuiltinFunction +// itself! +class Mal.BuiltinFunctionGetFn : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionGetFn(); + } + public override string name() { return "get"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + if (args.vs.data is Mal.Nil) + return new Mal.Nil(); + var map = args.vs.data as Mal.Hashmap; + if (map == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a hash-map to query", name()); + var key = args.vs.next.data as Mal.Hashable; + if (key == null) + throw new Mal.Error.HASH_KEY_TYPE_ERROR( + "%s: bad type as hash key", name()); + var value = map.vs[key]; + return value != null ? value : new Mal.Nil(); + } +} + +class Mal.BuiltinFunctionContains : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionContains(); + } + public override string name() { return "contains?"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected two arguments", name()); + if (args.vs.data is Mal.Nil) + return new Mal.Bool(false); + var map = args.vs.data as Mal.Hashmap; + if (map == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a hash-map to query", name()); + var key = args.vs.next.data as Mal.Hashable; + if (key == null) + throw new Mal.Error.HASH_KEY_TYPE_ERROR( + "%s: bad type as hash key", name()); + var value = map.vs[key]; + return new Mal.Bool(value != null); + } +} + +class Mal.BuiltinFunctionKeys : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionKeys(); + } + public override string name() { return "keys"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS( + "%s: expected one argument", name()); + var keys = new Mal.List.empty(); + if (args.vs.data is Mal.Nil) + return keys; + var map = args.vs.data as Mal.Hashmap; + if (map == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a hash-map to query", name()); + foreach (var key in map.vs.get_keys()) + keys.vs.append(key); + return keys; + } +} + +class Mal.BuiltinFunctionVals : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionVals(); + } + public override string name() { return "vals"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS( + "%s: expected one argument", name()); + var vals = new Mal.List.empty(); + if (args.vs.data is Mal.Nil) + return vals; + var map = args.vs.data as Mal.Hashmap; + if (map == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a hash-map to query", name()); + foreach (var key in map.vs.get_keys()) + vals.vs.append(map.vs[key]); + return vals; + } +} + +class Mal.BuiltinFunctionReadline : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionReadline(); + } + public override string name() { return "readline"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS( + "%s: expected one argument", name()); + string prompt = ""; + if (args.vs.data is Mal.String) + prompt = (args.vs.data as Mal.String).v; + else if (!(args.vs.data is Mal.Nil)) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a string prompt", name()); + string? line = Readline.readline(prompt); + if (line == null) + return new Mal.Nil(); + return new Mal.String(line); + } +} + +class Mal.BuiltinFunctionMeta : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionMeta(); + } + public override string name() { return "meta"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS( + "%s: expected one argument", name()); + var vwm = args.vs.data as Mal.ValWithMetadata; + if (vwm == null || vwm.metadata == null) + return new Mal.Nil(); + return vwm.metadata; + } +} + +class Mal.BuiltinFunctionWithMeta : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionWithMeta(); + } + public override string name() { return "with-meta"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "%s: expected one argument", name()); + var vwm = args.vs.data as Mal.ValWithMetadata; + if (vwm == null) + throw new Mal.Error.BAD_PARAMS( + "%s: bad type for with-meta", name()); + var copied = vwm.copy(); + copied.metadata = args.vs.next.data; + return copied; + } +} + +class Mal.BuiltinFunctionTimeMs : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionTimeMs(); + } + public override string name() { return "time-ms"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 0) + throw new Mal.Error.BAD_PARAMS( + "%s: expected no arguments", name()); + var time = GLib.TimeVal(); + time.get_current_time(); + return new Mal.Num(time.tv_sec * 1000 + time.tv_usec / 1000); + } +} + +class Mal.BuiltinFunctionConj : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionConj(); + } + public override string name() { return "conj"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + var iter = args.iter(); + var collection = iter.deref() as Mal.Listlike; + if (collection == null) + throw new Mal.Error.BAD_PARAMS( + "%s: expected a collection to modify", name()); + + if (collection is Mal.Vector) { + var oldvec = collection as Mal.Vector; + var n = args.vs.length() - 1; + var newvec = new Mal.Vector.with_size(oldvec.length + n); + int i; + for (i = 0; i < oldvec.length; i++) + newvec[i] = oldvec[i]; + for (iter.step(); iter.nonempty(); iter.step(), i++) + newvec[i] = iter.deref(); + return newvec; + } else { + var newlist = new Mal.List.empty(); + for (var citer = collection.iter(); citer.nonempty(); citer.step()) + newlist.vs.append(citer.deref()); + for (iter.step(); iter.nonempty(); iter.step()) + newlist.vs.prepend(iter.deref()); + return newlist; + } + } +} + +class Mal.BuiltinFunctionSeq : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSeq(); + } + public override string name() { return "seq"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS( + "%s: expected one argument", name()); + Mal.List toret; + if (args.vs.data is Mal.List) { + toret = args.vs.data as Mal.List; + } else { + toret = new Mal.List.empty(); + if (args.vs.data is Mal.String) { + var str = (args.vs.data as Mal.String).v; + if (str.length != 0) { + unowned string tail = str; + while (tail != "") { + unowned string new_tail = tail.next_char(); + var ch = str.substring(str.length - tail.length, + tail.length - new_tail.length); + toret.vs.append(new Mal.String(ch)); + tail = new_tail; + } + } + } else if (args.vs.data is Mal.Listlike) { + var collection = args.vs.data as Mal.Listlike; + for (var iter = collection.iter(); iter.nonempty(); iter.step()) + toret.vs.append(iter.deref()); + } else { + throw new Mal.Error.BAD_PARAMS("%s: bad input type", name()); + } + } + if (toret.vs.length() == 0) + return new Mal.Nil(); + return toret; + } +} + +class Mal.Core { + public static GLib.HashTable ns; + + private static void add_builtin(Mal.BuiltinFunction f) { + ns[f.name()] = f; + } + + public static void make_ns() { + ns = new GLib.HashTable(str_hash, str_equal); + add_builtin(new BuiltinFunctionAdd()); + add_builtin(new BuiltinFunctionSub()); + add_builtin(new BuiltinFunctionMul()); + add_builtin(new BuiltinFunctionDiv()); + add_builtin(new BuiltinFunctionPrStr()); + add_builtin(new BuiltinFunctionStr()); + add_builtin(new BuiltinFunctionPrn()); + add_builtin(new BuiltinFunctionPrintln()); + add_builtin(new BuiltinFunctionReadString()); + add_builtin(new BuiltinFunctionSlurp()); + add_builtin(new BuiltinFunctionList()); + add_builtin(new BuiltinFunctionListP()); + add_builtin(new BuiltinFunctionNilP()); + add_builtin(new BuiltinFunctionTrueP()); + add_builtin(new BuiltinFunctionFalseP()); + add_builtin(new BuiltinFunctionNumberP()); + add_builtin(new BuiltinFunctionStringP()); + add_builtin(new BuiltinFunctionSymbol()); + add_builtin(new BuiltinFunctionSymbolP()); + add_builtin(new BuiltinFunctionKeyword()); + add_builtin(new BuiltinFunctionKeywordP()); + add_builtin(new BuiltinFunctionVector()); + add_builtin(new BuiltinFunctionVectorP()); + add_builtin(new BuiltinFunctionSequentialP()); + add_builtin(new BuiltinFunctionHashMap()); + add_builtin(new BuiltinFunctionMapP()); + add_builtin(new BuiltinFunctionEmptyP()); + add_builtin(new BuiltinFunctionFnP()); + add_builtin(new BuiltinFunctionMacroP()); + add_builtin(new BuiltinFunctionCount()); + add_builtin(new BuiltinFunctionEQ()); + add_builtin(new BuiltinFunctionLT()); + add_builtin(new BuiltinFunctionLE()); + add_builtin(new BuiltinFunctionGT()); + add_builtin(new BuiltinFunctionGE()); + add_builtin(new BuiltinFunctionAtom()); + add_builtin(new BuiltinFunctionAtomP()); + add_builtin(new BuiltinFunctionDeref()); + add_builtin(new BuiltinFunctionReset()); + add_builtin(new BuiltinFunctionSwap()); + add_builtin(new BuiltinFunctionCons()); + add_builtin(new BuiltinFunctionConcat()); + add_builtin(new BuiltinFunctionVec()); + add_builtin(new BuiltinFunctionNth()); + add_builtin(new BuiltinFunctionFirst()); + add_builtin(new BuiltinFunctionRest()); + add_builtin(new BuiltinFunctionThrow()); + add_builtin(new BuiltinFunctionApply()); + add_builtin(new BuiltinFunctionMap()); + add_builtin(new BuiltinFunctionAssoc()); + add_builtin(new BuiltinFunctionDissoc()); + add_builtin(new BuiltinFunctionGetFn()); + add_builtin(new BuiltinFunctionContains()); + add_builtin(new BuiltinFunctionKeys()); + add_builtin(new BuiltinFunctionVals()); + add_builtin(new BuiltinFunctionReadline()); + add_builtin(new BuiltinFunctionMeta()); + add_builtin(new BuiltinFunctionWithMeta()); + add_builtin(new BuiltinFunctionTimeMs()); + add_builtin(new BuiltinFunctionConj()); + add_builtin(new BuiltinFunctionSeq()); + } +} diff --git a/impls/vala/env.vala b/impls/vala/env.vala new file mode 100644 index 0000000000..d001e40ec4 --- /dev/null +++ b/impls/vala/env.vala @@ -0,0 +1,69 @@ +class Mal.Env : GC.Object { + private GLib.HashTable data; + weak Mal.Env? outer; + + construct { + data = new GLib.HashTable( + Mal.Hashable.hash, Mal.Hashable.equal); + } + + public Env.within(Mal.Env outer_) { + outer = outer_; + } + + public Env() { + outer = null; + } + + public override void gc_traverse(GC.Object.VisitorFunc visit) { + visit(outer); + foreach (var key in data.get_keys()) { + visit(key); + visit(data[key]); + } + } + + public Env.funcall(Mal.Env outer_, Mal.Listlike binds, Mal.List exprs) + throws Mal.Error { + outer = outer_; + var binditer = binds.iter(); + unowned GLib.List exprlist = exprs.vs; + + while (binditer.nonempty()) { + var paramsym = binditer.deref() as Mal.Sym; + if (paramsym.v == "&") { + binditer.step(); + var rest = binditer.deref(); + binditer.step(); + if (rest == null || binditer.nonempty()) + throw new Mal.Error.BAD_PARAMS( + "expected exactly one parameter name after &"); + set(rest as Mal.Sym, new Mal.List(exprlist.copy())); + return; + } else { + if (exprlist == null) + throw new Mal.Error.BAD_PARAMS( + "too few arguments for function"); + set(paramsym, exprlist.data); + binditer.step(); + exprlist = exprlist.next; + } + } + if (exprlist != null) + throw new Mal.Error.BAD_PARAMS("too many arguments for function"); + } + + // Use the 'new' keyword to silence warnings about 'set' and 'get' + // already having meanings that we're overwriting + public new void set(Mal.Sym key, Mal.Val f) { + data[key] = f; + } + + public new Mal.Val? get(Mal.Sym key) { + if (key in data) + return data[key]; + if (outer == null) + return null; + return outer.get(key); + } +} diff --git a/impls/vala/gc.vala b/impls/vala/gc.vala new file mode 100644 index 0000000000..cb5b6d7989 --- /dev/null +++ b/impls/vala/gc.vala @@ -0,0 +1,196 @@ +abstract class GC.Object : GLib.Object { + public GC.Object? next; + public unowned GC.Object? prev; + public bool visited; + + public delegate void VisitorFunc(GC.Object? obj); + + construct { + next = null; + prev = null; + GC.Core.register_object(this); + } + public abstract void gc_traverse(VisitorFunc visitor); +} + +class GC.Root : GLib.Object { + public weak GC.Root? next; + public weak GC.Root? prev; + + public GC.Object? obj; + + construct { GC.Core.register_root(this); } + ~Root() { GC.Core.unregister_root(this); } + + public Root.empty() { obj = null; } + public Root(GC.Object? obj_) { obj = obj_; } +} + +class GC.Core : GLib.Object { + private struct ObjectQueue { + GC.Object? head; + GC.Object? tail; + + public void unlink(GC.Object obj_) { + GC.Object obj = obj_; + + if (obj.prev == null) { + assert(obj == head); + head = obj.next; + } + else + obj.prev.next = obj.next; + + if (obj.next == null) + tail = obj.prev; + else + obj.next.prev = obj.prev; + } + + public void link(GC.Object obj) { + if (tail != null) { + tail.next = obj; + obj.prev = tail; + } else { + head = obj; + obj.prev = null; + } + + tail = obj; + obj.next = null; + } + } + + private static ObjectQueue objects; + private static weak GC.Root? roots_head; + private static uint until_next_collection; + + static construct { + objects.head = objects.tail = null; + roots_head = null; + } + + public static void register_object(GC.Object obj) { +#if GC_DEBUG + stderr.printf("GC: registered %p [%s]\n", + obj, Type.from_instance(obj).name()); +#endif + objects.link(obj); + if (until_next_collection > 0) + until_next_collection--; + } + public static void register_root(GC.Root root) { +#if GC_DEBUG + stderr.printf("GC: registered root %p\n", root); +#endif + root.next = roots_head; + root.prev = null; + if (roots_head != null) + roots_head.prev = root; + roots_head = root; + } + public static void unregister_root(GC.Root root) { +#if GC_DEBUG + stderr.printf("GC: unregistered root %p\n", root); +#endif + if (root.prev == null) + roots_head = root.next; + else + root.prev.next = root.next; + if (root.next != null) + root.next.prev = root.prev; + } + + private static void statistics(uint before, uint after, uint roots) { +#if GC_STATS + stderr.printf("GC: %u roots, %u -> %u objects\n", + roots, before, after); +#endif + } + + public static void collect() { + uint orig = 0; + uint roots = 0; + +#if GC_DEBUG + stderr.printf("GC: started\n"); +#endif + for (unowned GC.Object obj = objects.head; obj != null; obj = obj.next) + { + obj.visited = false; +#if GC_DEBUG + stderr.printf("GC: considering %p [%s]\n", + obj, Type.from_instance(obj).name()); +#endif + orig++; + } + + ObjectQueue after = { null, null }; + until_next_collection = 0; + + for (unowned GC.Root root = roots_head; root != null; root = root.next) + { + roots++; + if (root.obj != null && !root.obj.visited) { + GC.Object obj = root.obj; +#if GC_DEBUG + stderr.printf("GC: root %p -> %p [%s]\n", + root, obj, Type.from_instance(obj).name()); +#endif + objects.unlink(obj); + after.link(obj); + obj.visited = true; + until_next_collection++; + } + } + + for (GC.Object? obj = after.head; obj != null; obj = obj.next) { +#if GC_DEBUG + stderr.printf("GC: traversing %p [%s]\n", + obj, Type.from_instance(obj).name()); +#endif + obj.gc_traverse((obj2_) => { + GC.Object obj2 = obj2_; + if (obj2 == null) + return; + if (!obj2.visited) { +#if GC_DEBUG + stderr.printf("GC: %p -> %p [%s]\n", + obj, obj2, Type.from_instance(obj2).name()); +#endif + objects.unlink(obj2); + after.link(obj2); + obj2.visited = true; + until_next_collection++; + } + }); + } + + // Manually free everything, to avoid stack overflow while + // recursing down the list unreffing them all + objects.tail = null; + while (objects.head != null) { +#if GC_DEBUG + stderr.printf("GC: collecting %p [%s]\n", objects.head, + Type.from_instance(objects.head).name()); +#endif + objects.head = objects.head.next; + } + + objects = after; + +#if GC_DEBUG + stderr.printf("GC: finished\n"); +#endif + + statistics(orig, until_next_collection, roots); + } + + public static void maybe_collect() { +#if !GC_ALWAYS + if (until_next_collection > 0) + return; +#endif + collect(); + } +} diff --git a/impls/vala/printer.vala b/impls/vala/printer.vala new file mode 100644 index 0000000000..7dd75a3b77 --- /dev/null +++ b/impls/vala/printer.vala @@ -0,0 +1,58 @@ +namespace Mal { + string pr_str(Mal.Val val, bool print_readably = true) { + if (val is Mal.Nil) + return "nil"; + if (val is Mal.Bool) + return (val as Mal.Bool).v ? "true" : "false"; + if (val is Mal.Sym) + return (val as Mal.Sym).v; + if (val is Mal.Keyword) + return ":" + (val as Mal.Keyword).v; + if (val is Mal.Num) + return ("%"+int64.FORMAT_MODIFIER+"d") + .printf((val as Mal.Num).v); + if (val is Mal.String) { + string s = (val as Mal.String).v; + if (print_readably) + s = "\"%s\"".printf(s.replace("\\", "\\\\") + .replace("\n", "\\n"). + replace("\"", "\\\"")); + return s; + } + if (val is Mal.Listlike) { + bool vec = val is Mal.Vector; + string toret = vec ? "[" : "("; + string sep = ""; + for (var iter = (val as Mal.Listlike).iter(); + iter.nonempty(); iter.step()) { + toret += sep + pr_str(iter.deref(), print_readably); + sep = " "; + } + toret += vec ? "]" : ")"; + return toret; + } + if (val is Mal.Hashmap) { + string toret = "{"; + string sep = ""; + var map = (val as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) { + toret += (sep + pr_str(key, print_readably) + " " + + pr_str(map[key], print_readably)); + sep = " "; + } + toret += "}"; + return toret; + } + if (val is Mal.BuiltinFunction) { + return "#".printf((val as Mal.BuiltinFunction).name()); + } + if (val is Mal.Function) { + return "#"; + } + if (val is Mal.Atom) { + return "(atom %s)".printf( + pr_str((val as Mal.Atom).v, print_readably)); + } + return "??"; + } +} diff --git a/impls/vala/reader.vala b/impls/vala/reader.vala new file mode 100644 index 0000000000..de0c63ed81 --- /dev/null +++ b/impls/vala/reader.vala @@ -0,0 +1,183 @@ +class Mal.Reader : GLib.Object { + static Regex tok_re; + static Regex tok_num; + + int origlen; + string data; + int pos; + + string next_token; + + static construct { + tok_re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;[^\n]*|[^\s\[\]{}('"`,;)]*)/; // comment to unconfuse emacs vala-mode "]); + tok_num = /^-?[0-9]/; + } + + private string poserr(string fmt, ...) { + return "char %d: %s".printf(origlen - data.length, + fmt.vprintf(va_list())); + } + + private void advance() throws Error { + do { + MatchInfo info; + if (!tok_re.match(data, 0, out info)) + throw new Error.BAD_TOKEN(poserr("bad token")); + + next_token = info.fetch(1); + int tokenend; + info.fetch_pos(1, null, out tokenend); + data = data[tokenend:data.length]; + } while (next_token.has_prefix(";")); + } + + public Reader(string str) throws Error { + data = str; + origlen = data.length; + pos = 0; + advance(); + } + + public string peek() throws Error { + return next_token; + } + + public string next() throws Error { + advance(); + return peek(); + } + + public static Mal.Val? read_str(string str) throws Error { + var rdr = new Reader(str); + if (rdr.peek() == "") + return null; + var toret = rdr.read_form(); + if (rdr.peek() != "") + throw new Mal.Error.PARSE_ERROR( + rdr.poserr("trailing junk after expression")); + return toret; + } + + public Mal.Val read_form() throws Error { + string token = peek(); + if (token == "(") { + next(); // eat ( + return new Mal.List(read_list(")")); + } else { + return read_atom(); + } + } + + public GLib.List read_list(string endtok) throws Error { + var list = new GLib.List(); + string token; + while (true) { + token = peek(); + if (token == "") + throw new Mal.Error.PARSE_ERROR(poserr("unbalanced parens")); + if (token == endtok) { + next(); // eat end token + return list; + } + + list.append(read_form()); + } + } + + public Mal.Hashmap read_hashmap() throws Error { + var map = new Mal.Hashmap(); + string token; + while (true) { + Mal.Val vals[2]; + for (int i = 0; i < 2; i++) { + token = peek(); + if (token == "") + throw new Mal.Error.PARSE_ERROR( + poserr("unbalanced braces")); + if (token == "}") { + if (i != 0) + throw new Mal.Error.PARSE_ERROR( + poserr("odd number of elements in hashmap")); + + next(); // eat end token + return map; + } + + vals[i] = read_form(); + } + map.insert(vals[0], vals[1]); + } + } + + public Mal.Val read_atom() throws Error { + string token = peek(); + next(); + if (tok_num.match(token)) + return new Mal.Num(int64.parse(token)); + if (token.has_prefix(":")) + return new Mal.Keyword(token[1:token.length]); + if (token.has_prefix("\"")) { + if (token.length < 2 || !token.has_suffix("\"")) + throw new Mal.Error.BAD_TOKEN( + poserr("end of input in mid-string")); + + token = token[1:token.length-1]; + + int end = 0; + int pos = 0; + string strval = ""; + + while ((pos = token.index_of ("\\", end)) != -1) { + strval += token[end:pos]; + if (token.length - pos < 2) + throw new Mal.Error.BAD_TOKEN( + poserr("end of input in mid-string")); + switch (token[pos:pos+2]) { + case "\\\\": + strval += "\\"; break; + case "\\\"": + strval += "\""; break; + case "\\n": + strval += "\n"; break; + } + end = pos+2; + } + strval += token[end:token.length]; + return new Mal.String(strval); + } + switch (token) { + case "nil": + return new Mal.Nil(); + case "true": + return new Mal.Bool(true); + case "false": + return new Mal.Bool(false); + case "[": + return new Mal.Vector.from_list(read_list("]")); + case "{": + return read_hashmap(); + case "'": + case "`": + case "~": + case "~@": + case "@": + var list = new GLib.List(); + list.append(new Mal.Sym( + token == "'" ? "quote" : + token == "`" ? "quasiquote" : + token == "~" ? "unquote" : + token == "~@" ? "splice-unquote" : "deref")); + list.append(read_form()); + return new Mal.List(list); + case "^": + var list = new GLib.List(); + list.append(new Mal.Sym("with-meta")); + var metadata = read_form(); + list.append(read_form()); + list.append(metadata); + return new Mal.List(list); + default: + return new Mal.Sym(token); + } + } +} diff --git a/impls/vala/run b/impls/vala/run new file mode 100755 index 0000000000..c66c2b81dc --- /dev/null +++ b/impls/vala/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/vala/step0_repl.vala b/impls/vala/step0_repl.vala new file mode 100644 index 0000000000..817a92eb8c --- /dev/null +++ b/impls/vala/step0_repl.vala @@ -0,0 +1,36 @@ +class Mal.Main : GLib.Object { + public static string? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + } else { + stdout.printf("\n"); + } + return line; + } + + public static string EVAL(string expr) { + return expr; + } + + public static void PRINT(string value) { + stdout.printf("%s\n", value); + } + + public static bool rep() { + string? line = READ(); + if (line == null) + return false; + if (line.length > 0) { + string value = EVAL(line); + PRINT(value); + } + return true; + } + + public static int main(string[] args) { + while (rep()); + return 0; + } +} diff --git a/impls/vala/step1_read_print.vala b/impls/vala/step1_read_print.vala new file mode 100644 index 0000000000..730de2ffb4 --- /dev/null +++ b/impls/vala/step1_read_print.vala @@ -0,0 +1,49 @@ +class Mal.Main : GLib.Object { + static bool eof; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + public static Mal.Val EVAL(Mal.Val expr) { + return expr; + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep() { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val); + PRINT(val); + GC.Core.maybe_collect(); + } + } + + public static int main(string[] args) { + while (!eof) + rep(); + return 0; + } +} diff --git a/impls/vala/step2_eval.vala b/impls/vala/step2_eval.vala new file mode 100644 index 0000000000..332a695138 --- /dev/null +++ b/impls/vala/step2_eval.vala @@ -0,0 +1,162 @@ +abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction { + public abstract int64 result(int64 a, int64 b); + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + unowned Mal.Num a = args.vs.nth_data(0) as Mal.Num; + unowned Mal.Num b = args.vs.nth_data(1) as Mal.Num; + if (a == null || b == null) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + return new Mal.Num(result(a.v, b.v)); + } +} + +class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionAdd(); + } + public override string name() { return "+"; } + public override int64 result(int64 a, int64 b) { return a+b; } +} + +class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSub(); + } + public override string name() { return "-"; } + public override int64 result(int64 a, int64 b) { return a-b; } +} + +class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionMul(); + } + public override string name() { return "*"; } + public override int64 result(int64 a, int64 b) { return a*b; } +} + +class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionDiv(); + } + public override string name() { return "/"; } + public override int64 result(int64 a, int64 b) { return a/b; } +} + +class Mal.Env : GLib.Object { + public GLib.HashTable data; + construct { + data = new GLib.HashTable( + Mal.Hashable.hash, Mal.Hashable.equal); + } + // Use the 'new' keyword to silence warnings about 'set' and 'get' + // already having meanings that we're overwriting + public new void set(Mal.Sym key, Mal.Val f) { + data[key] = f; + } + public new Mal.Val get(Mal.Sym key) throws Mal.Error { + var toret = data[key]; + if (toret == null) + throw new Error.ENV_LOOKUP_FAILED("no such variable '%s'", key.v); + return toret; + } +} + +class Mal.Main : GLib.Object { + static bool eof; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + public static Mal.Val EVAL(Mal.Val ast, Mal.Env env) + throws Mal.Error { + var ast_root = new GC.Root(ast); (void)ast_root; + GC.Core.maybe_collect(); + + // stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) + return env.get(ast as Mal.Sym); + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else { + return ast; + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + + env.set(new Mal.Sym("+"), new BuiltinFunctionAdd()); + env.set(new Mal.Sym("-"), new BuiltinFunctionSub()); + env.set(new Mal.Sym("*"), new BuiltinFunctionMul()); + env.set(new Mal.Sym("/"), new BuiltinFunctionDiv()); + + while (!eof) { + try { + rep(env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + return 0; + } +} diff --git a/impls/vala/step3_env.vala b/impls/vala/step3_env.vala new file mode 100644 index 0000000000..e1afb5a221 --- /dev/null +++ b/impls/vala/step3_env.vala @@ -0,0 +1,217 @@ +abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction { + public abstract int64 result(int64 a, int64 b); + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 2) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + unowned Mal.Num a = args.vs.nth_data(0) as Mal.Num; + unowned Mal.Num b = args.vs.nth_data(1) as Mal.Num; + if (a == null || b == null) + throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); + return new Mal.Num(result(a.v, b.v)); + } +} + +class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionAdd(); + } + public override string name() { return "+"; } + public override int64 result(int64 a, int64 b) { return a+b; } +} + +class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionSub(); + } + public override string name() { return "-"; } + public override int64 result(int64 a, int64 b) { return a-b; } +} + +class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionMul(); + } + public override string name() { return "*"; } + public override int64 result(int64 a, int64 b) { return a*b; } +} + +class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionDiv(); + } + public override string name() { return "/"; } + public override int64 result(int64 a, int64 b) { return a/b; } +} + +class Mal.Main : GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + public static Mal.Val EVAL(Mal.Val ast, Mal.Env env) + throws Mal.Error { + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + var newenv = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, newenv); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], newenv); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + return EVAL(list.nth(2).data, newenv); + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + + if (firstdata is Mal.BuiltinFunction) { + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + env.set(new Mal.Sym("+"), new BuiltinFunctionAdd()); + env.set(new Mal.Sym("-"), new BuiltinFunctionSub()); + env.set(new Mal.Sym("*"), new BuiltinFunctionMul()); + env.set(new Mal.Sym("/"), new BuiltinFunctionDiv()); + + while (!eof) { + try { + rep(env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + return 0; + } +} diff --git a/impls/vala/step4_if_fn_do.vala b/impls/vala/step4_if_fn_do.vala new file mode 100644 index 0000000000..11332c5a58 --- /dev/null +++ b/impls/vala/step4_if_fn_do.vala @@ -0,0 +1,220 @@ +class Mal.Main: GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + public static Mal.Val EVAL(Mal.Val ast, Mal.Env env) + throws Mal.Error { + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + var newenv = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, newenv); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], newenv); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + return EVAL(list.nth(2).data, newenv); + case "do": + Mal.Val result = null; + for (list = list.next; list != null; list = list.next) + result = EVAL(list.data, env); + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "do: expected at least one argument"); + return result; + case "if": + if (list.length() != 3 && list.length() != 4) + throw new Mal.Error.BAD_PARAMS( + "if: expected two or three arguments"); + list = list.next; + var cond = EVAL(list.data, env); + list = list.next; + if (!cond.truth_value()) { + // Skip to the else clause, which defaults to nil. + list = list.next; + if (list == null) + return new Mal.Nil(); + } + return EVAL(list.data, env); + case "fn*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected two arguments"); + var binds = list.next.data as Mal.Listlike; + var body = list.next.next.data; + if (binds == null) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected a list of parameter names"); + for (var iter = binds.iter(); iter.nonempty(); iter.step()) + if (!(iter.deref() is Mal.Sym)) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected parameter name to be "+ + "symbol"); + return new Mal.Function(binds, body, env); + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + + if (firstdata is Mal.BuiltinFunction) { + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else if (firstdata is Mal.Function) { + var fn = firstdata as Mal.Function; + var newenv = new Mal.Env.funcall( + fn.env, fn.parameters, newlist); + return EVAL(fn.body, newenv); + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + Mal.Core.make_ns(); + foreach (var key in Mal.Core.ns.get_keys()) + env.set(new Mal.Sym(key), Mal.Core.ns[key]); + + try { + EVAL(Mal.Reader.read_str("(def! not (fn* (a) (if a false true)))"), + env); + } catch (Mal.Error err) { + assert(false); // shouldn't happen + } + + while (!eof) { + try { + rep(env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + return 0; + } +} diff --git a/impls/vala/step5_tco.vala b/impls/vala/step5_tco.vala new file mode 100644 index 0000000000..e66e5045cd --- /dev/null +++ b/impls/vala/step5_tco.vala @@ -0,0 +1,234 @@ +class Mal.Main : GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) + throws Mal.Error { + // Copy the implicitly 'unowned' function arguments into + // ordinary owned variables which increment the objects' + // reference counts. This is so that when we overwrite these + // variables within the loop (for TCO) the objects we assign + // into them don't immediately get garbage-collected. + Mal.Val ast = ast_; + Mal.Env env = env_; + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + while (true) { + ast_root.obj = ast; + env_root.obj = env; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + env = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, env); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], env); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + ast = list.nth(2).data; + continue; // tail-call optimisation + case "do": + Mal.Val result = null; + for (list = list.next; list != null; list = list.next) + result = EVAL(list.data, env); + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "do: expected at least one argument"); + return result; + case "if": + if (list.length() != 3 && list.length() != 4) + throw new Mal.Error.BAD_PARAMS( + "if: expected two or three arguments"); + list = list.next; + var cond = EVAL(list.data, env); + list = list.next; + if (!cond.truth_value()) { + // Skip to the else clause, which defaults to nil. + list = list.next; + if (list == null) + return new Mal.Nil(); + } + ast = list.data; + continue; // tail-call optimisation + case "fn*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected two arguments"); + var binds = list.next.data as Mal.Listlike; + var body = list.next.next.data; + if (binds == null) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected a list of parameter names"); + for (var iter = binds.iter(); iter.nonempty(); iter.step()) + if (!(iter.deref() is Mal.Sym)) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected parameter name to be "+ + "symbol"); + return new Mal.Function(binds, body, env); + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + for (var iter = (ast as Mal.Listlike).iter().step(); + iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + + if (firstdata is Mal.BuiltinFunction) { + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else if (firstdata is Mal.Function) { + var fn = firstdata as Mal.Function; + env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = fn.body; + continue; // tail-call optimisation + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + Mal.Core.make_ns(); + foreach (var key in Mal.Core.ns.get_keys()) + env.set(new Mal.Sym(key), Mal.Core.ns[key]); + + try { + EVAL(Mal.Reader.read_str("(def! not (fn* (a) (if a false true)))"), + env); + } catch (Mal.Error err) { + assert(false); // shouldn't happen + } + + while (!eof) { + try { + rep(env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + return 0; + } +} diff --git a/impls/vala/step6_file.vala b/impls/vala/step6_file.vala new file mode 100644 index 0000000000..b2dcb06504 --- /dev/null +++ b/impls/vala/step6_file.vala @@ -0,0 +1,272 @@ +class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { + public Mal.Env env; + public BuiltinFunctionEval(Mal.Env env_) { env = env_; } + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionEval(env); + } + public override string name() { return "eval"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return Mal.Main.EVAL(args.vs.data, env); + } +} + +class Mal.Main : GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) + throws Mal.Error { + // Copy the implicitly 'unowned' function arguments into + // ordinary owned variables which increment the objects' + // reference counts. This is so that when we overwrite these + // variables within the loop (for TCO) the objects we assign + // into them don't immediately get garbage-collected. + Mal.Val ast = ast_; + Mal.Env env = env_; + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + while (true) { + ast_root.obj = ast; + env_root.obj = env; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + env = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, env); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], env); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + ast = list.nth(2).data; + continue; // tail-call optimisation + case "do": + Mal.Val result = null; + for (list = list.next; list != null; list = list.next) + result = EVAL(list.data, env); + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "do: expected at least one argument"); + return result; + case "if": + if (list.length() != 3 && list.length() != 4) + throw new Mal.Error.BAD_PARAMS( + "if: expected two or three arguments"); + list = list.next; + var cond = EVAL(list.data, env); + list = list.next; + if (!cond.truth_value()) { + // Skip to the else clause, which defaults to nil. + list = list.next; + if (list == null) + return new Mal.Nil(); + } + ast = list.data; + continue; // tail-call optimisation + case "fn*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected two arguments"); + var binds = list.next.data as Mal.Listlike; + var body = list.next.next.data; + if (binds == null) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected a list of parameter names"); + for (var iter = binds.iter(); iter.nonempty(); iter.step()) + if (!(iter.deref() is Mal.Sym)) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected parameter name to be "+ + "symbol"); + return new Mal.Function(binds, body, env); + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + for (var iter = (ast as Mal.Listlike).iter().step(); + iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + + if (firstdata is Mal.BuiltinFunction) { + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else if (firstdata is Mal.Function) { + var fn = firstdata as Mal.Function; + env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = fn.body; + continue; // tail-call optimisation + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static void setup(string line, Mal.Env env) { + try { + EVAL(Reader.read_str(line), env); + } catch (Mal.Error err) { + assert(false); // shouldn't happen + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + Mal.Core.make_ns(); + foreach (var key in Mal.Core.ns.get_keys()) + env.set(new Mal.Sym(key), Mal.Core.ns[key]); + env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); + + setup("(def! not (fn* (a) (if a false true)))", env); + setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); + + var ARGV = new GLib.List(); + if (args.length > 1) { + for (int i = args.length - 1; i >= 2; i--) + ARGV.prepend(new Mal.String(args[i])); + } + env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); + + if (args.length > 1) { + var contents = new GLib.List(); + contents.prepend(new Mal.String(args[1])); + contents.prepend(new Mal.Sym("load-file")); + try { + EVAL(new Mal.List(contents), env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return 1; + } + } else { + while (!eof) { + try { + rep(env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + } + return 0; + } +} diff --git a/impls/vala/step7_quote.vala b/impls/vala/step7_quote.vala new file mode 100644 index 0000000000..ac01743e04 --- /dev/null +++ b/impls/vala/step7_quote.vala @@ -0,0 +1,348 @@ +class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { + public Mal.Env env; + public BuiltinFunctionEval(Mal.Env env_) { env = env_; } + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionEval(env); + } + public override string name() { return "eval"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return Mal.Main.EVAL(args.vs.data, env); + } +} + +class Mal.Main : GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + + public static Mal.Val quasiquote(Mal.Val ast) + throws Mal.Error { + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); + } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; + } + } + + public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) + throws Mal.Error { + // Copy the implicitly 'unowned' function arguments into + // ordinary owned variables which increment the objects' + // reference counts. This is so that when we overwrite these + // variables within the loop (for TCO) the objects we assign + // into them don't immediately get garbage-collected. + Mal.Val ast = ast_; + Mal.Env env = env_; + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + while (true) { + ast_root.obj = ast; + env_root.obj = env; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + env = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, env); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], env); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + ast = list.nth(2).data; + continue; // tail-call optimisation + case "do": + Mal.Val result = null; + for (list = list.next; list != null; list = list.next) + result = EVAL(list.data, env); + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "do: expected at least one argument"); + return result; + case "if": + if (list.length() != 3 && list.length() != 4) + throw new Mal.Error.BAD_PARAMS( + "if: expected two or three arguments"); + list = list.next; + var cond = EVAL(list.data, env); + list = list.next; + if (!cond.truth_value()) { + // Skip to the else clause, which defaults to nil. + list = list.next; + if (list == null) + return new Mal.Nil(); + } + ast = list.data; + continue; // tail-call optimisation + case "fn*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected two arguments"); + var binds = list.next.data as Mal.Listlike; + var body = list.next.next.data; + if (binds == null) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected a list of parameter names"); + for (var iter = binds.iter(); iter.nonempty(); + iter.step()) + if (!(iter.deref() is Mal.Sym)) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected parameter name to be "+ + "symbol"); + return new Mal.Function(binds, body, env); + case "quote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quote: expected one argument"); + return list.next.data; + case "quasiquote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquote: expected one argument"); + ast = quasiquote(list.next.data); + continue; // tail-call optimisation + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + for (var iter = (ast as Mal.Listlike).iter().step(); + iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + + if (firstdata is Mal.BuiltinFunction) { + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else if (firstdata is Mal.Function) { + var fn = firstdata as Mal.Function; + env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = fn.body; + continue; // tail-call optimisation + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static void setup(string line, Mal.Env env) { + try { + EVAL(Reader.read_str(line), env); + } catch (Mal.Error err) { + assert(false); // shouldn't happen + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + Mal.Core.make_ns(); + foreach (var key in Mal.Core.ns.get_keys()) + env.set(new Mal.Sym(key), Mal.Core.ns[key]); + env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); + + setup("(def! not (fn* (a) (if a false true)))", env); + setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); + + var ARGV = new GLib.List(); + if (args.length > 1) { + for (int i = args.length - 1; i >= 2; i--) + ARGV.prepend(new Mal.String(args[i])); + } + env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); + + if (args.length > 1) { + var contents = new GLib.List(); + contents.prepend(new Mal.String(args[1])); + contents.prepend(new Mal.Sym("load-file")); + try { + EVAL(new Mal.List(contents), env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return 1; + } + } else { + while (!eof) { + try { + rep(env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + } + return 0; + } +} diff --git a/impls/vala/step8_macros.vala b/impls/vala/step8_macros.vala new file mode 100644 index 0000000000..50af9941ba --- /dev/null +++ b/impls/vala/step8_macros.vala @@ -0,0 +1,374 @@ +class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { + public Mal.Env env; + public BuiltinFunctionEval(Mal.Env env_) { env = env_; } + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionEval(env); + } + public override string name() { return "eval"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return Mal.Main.EVAL(args.vs.data, env); + } +} + +class Mal.Main : GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + + public static Mal.Val quasiquote(Mal.Val ast) + throws Mal.Error { + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); + } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; + } + } + + public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) + throws Mal.Error { + // Copy the implicitly 'unowned' function arguments into + // ordinary owned variables which increment the objects' + // reference counts. This is so that when we overwrite these + // variables within the loop (for TCO) the objects we assign + // into them don't immediately get garbage-collected. + Mal.Val ast = ast_; + Mal.Env env = env_; + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + while (true) { + ast_root.obj = ast; + env_root.obj = env; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "defmacro!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expected two values"); + var symkey = list.next.data as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expects a symbol"); + var val = EVAL(list.next.next.data, env) as Mal.Function; + if (val == null) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expected a function"); + val = val.copy() as Mal.Function; + val.is_macro = true; + env.set(symkey, val); + return val; + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + env = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, env); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], env); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + ast = list.nth(2).data; + continue; // tail-call optimisation + case "do": + Mal.Val result = null; + for (list = list.next; list != null; list = list.next) + result = EVAL(list.data, env); + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "do: expected at least one argument"); + return result; + case "if": + if (list.length() != 3 && list.length() != 4) + throw new Mal.Error.BAD_PARAMS( + "if: expected two or three arguments"); + list = list.next; + var cond = EVAL(list.data, env); + list = list.next; + if (!cond.truth_value()) { + // Skip to the else clause, which defaults to nil. + list = list.next; + if (list == null) + return new Mal.Nil(); + } + ast = list.data; + continue; // tail-call optimisation + case "fn*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected two arguments"); + var binds = list.next.data as Mal.Listlike; + var body = list.next.next.data; + if (binds == null) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected a list of parameter names"); + for (var iter = binds.iter(); iter.nonempty(); + iter.step()) + if (!(iter.deref() is Mal.Sym)) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected parameter name to be "+ + "symbol"); + return new Mal.Function(binds, body, env); + case "quote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quote: expected one argument"); + return list.next.data; + case "quasiquote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquote: expected one argument"); + ast = quasiquote(list.next.data); + continue; // tail-call optimisation + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + var iter = (ast as Mal.Listlike).iter().step(); + + if (firstdata is Mal.BuiltinFunction) { + for (; iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else if (firstdata is Mal.Function) { + var fn = firstdata as Mal.Function; + if (fn.is_macro) { + for (; iter.nonempty(); iter.step()) + newlist.vs.append(iter.deref()); + var fenv = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = EVAL(fn.body, fenv); + continue; + } + for (; iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = fn.body; + continue; // tail-call optimisation + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static void setup(string line, Mal.Env env) { + try { + EVAL(Reader.read_str(line), env); + } catch (Mal.Error err) { + assert(false); // shouldn't happen + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + Mal.Core.make_ns(); + foreach (var key in Mal.Core.ns.get_keys()) + env.set(new Mal.Sym(key), Mal.Core.ns[key]); + env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); + + setup("(def! not (fn* (a) (if a false true)))", env); + setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); + setup("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", env); + + var ARGV = new GLib.List(); + if (args.length > 1) { + for (int i = args.length - 1; i >= 2; i--) + ARGV.prepend(new Mal.String(args[i])); + } + env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); + + if (args.length > 1) { + var contents = new GLib.List(); + contents.prepend(new Mal.String(args[1])); + contents.prepend(new Mal.Sym("load-file")); + try { + EVAL(new Mal.List(contents), env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return 1; + } + } else { + while (!eof) { + try { + rep(env); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + } + return 0; + } +} diff --git a/impls/vala/step9_try.vala b/impls/vala/step9_try.vala new file mode 100644 index 0000000000..fb897d2acf --- /dev/null +++ b/impls/vala/step9_try.vala @@ -0,0 +1,418 @@ +class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { + public Mal.Env env; + public BuiltinFunctionEval(Mal.Env env_) { env = env_; } + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionEval(env); + } + public override string name() { return "eval"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return Mal.Main.EVAL(args.vs.data, env); + } +} + +class Mal.Main : GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + Mal.BuiltinFunctionThrow.clear(); + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + + public static Mal.Val quasiquote(Mal.Val ast) + throws Mal.Error { + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); + } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; + } + } + + public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) + throws Mal.Error { + // Copy the implicitly 'unowned' function arguments into + // ordinary owned variables which increment the objects' + // reference counts. This is so that when we overwrite these + // variables within the loop (for TCO) the objects we assign + // into them don't immediately get garbage-collected. + Mal.Val ast = ast_; + Mal.Env env = env_; + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + while (true) { + ast_root.obj = ast; + env_root.obj = env; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "defmacro!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expected two values"); + var symkey = list.next.data as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expects a symbol"); + var val = EVAL(list.next.next.data, env) as Mal.Function; + if (val == null) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expected a function"); + val = val.copy() as Mal.Function; + val.is_macro = true; + env.set(symkey, val); + return val; + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + env = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, env); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], env); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + ast = list.nth(2).data; + continue; // tail-call optimisation + case "do": + Mal.Val result = null; + for (list = list.next; list != null; list = list.next) + result = EVAL(list.data, env); + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "do: expected at least one argument"); + return result; + case "if": + if (list.length() != 3 && list.length() != 4) + throw new Mal.Error.BAD_PARAMS( + "if: expected two or three arguments"); + list = list.next; + var cond = EVAL(list.data, env); + list = list.next; + if (!cond.truth_value()) { + // Skip to the else clause, which defaults to nil. + list = list.next; + if (list == null) + return new Mal.Nil(); + } + ast = list.data; + continue; // tail-call optimisation + case "fn*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected two arguments"); + var binds = list.next.data as Mal.Listlike; + var body = list.next.next.data; + if (binds == null) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected a list of parameter names"); + for (var iter = binds.iter(); iter.nonempty(); + iter.step()) + if (!(iter.deref() is Mal.Sym)) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected parameter name to be "+ + "symbol"); + return new Mal.Function(binds, body, env); + case "quote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quote: expected one argument"); + return list.next.data; + case "quasiquote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquote: expected one argument"); + ast = quasiquote(list.next.data); + continue; // tail-call optimisation + case "try*": + if (list.length() != 2 && list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "try*: expected one or two arguments"); + var trybody = list.next.data; + if (list.length() == 2) { + // Trivial catchless form of try + ast = trybody; + continue; // tail-call optimisation + } + var catchclause = list.next.next.data as Mal.List; + if (!(catchclause.vs.data is Mal.Sym) || + (catchclause.vs.data as Mal.Sym).v != "catch*") + throw new Mal.Error.BAD_PARAMS( + "try*: expected catch*"); + if (catchclause.vs.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "catch*: expected two arguments"); + var catchparam = catchclause.vs.next.data as Mal.Sym; + if (catchparam == null) + throw new Mal.Error.BAD_PARAMS( + "catch*: expected a parameter name"); + var catchbody = catchclause.vs.next.next.data; + try { + return EVAL(trybody, env); + } catch (Mal.Error exc) { + var catchenv = new Mal.Env.within(env); + catchenv.set(catchparam, Mal.BuiltinFunctionThrow. + thrown_value(exc)); + ast = catchbody; + env = catchenv; + continue; // tail-call optimisation + } + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + var iter = (ast as Mal.Listlike).iter().step(); + + if (firstdata is Mal.BuiltinFunction) { + for (; iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else if (firstdata is Mal.Function) { + var fn = firstdata as Mal.Function; + if (fn.is_macro) { + for (; iter.nonempty(); iter.step()) + newlist.vs.append(iter.deref()); + var fenv = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = EVAL(fn.body, fenv); + continue; + } + for (; iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = fn.body; + continue; // tail-call optimisation + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static void setup(string line, Mal.Env env) { + try { + EVAL(Reader.read_str(line), env); + } catch (Mal.Error err) { + stderr.printf("Error during setup:\n%s\n-> %s\n", + line, err.message); + GLib.Process.exit(1); + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + Mal.Core.make_ns(); + foreach (var key in Mal.Core.ns.get_keys()) + env.set(new Mal.Sym(key), Mal.Core.ns[key]); + env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); + + setup("(def! not (fn* (a) (if a false true)))", env); + setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); + setup("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", env); + + var ARGV = new GLib.List(); + if (args.length > 1) { + for (int i = args.length - 1; i >= 2; i--) + ARGV.prepend(new Mal.String(args[i])); + } + env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); + + if (args.length > 1) { + var contents = new GLib.List(); + contents.prepend(new Mal.String(args[1])); + contents.prepend(new Mal.Sym("load-file")); + try { + EVAL(new Mal.List(contents), env); + } catch (Mal.Error.EXCEPTION_THROWN exc) { + GLib.stderr.printf( + "uncaught exception: %s\n", + pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return 1; + } + } else { + while (!eof) { + try { + rep(env); + } catch (Mal.Error.EXCEPTION_THROWN exc) { + GLib.stderr.printf( + "uncaught exception: %s\n", + pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + } + return 0; + } +} diff --git a/impls/vala/stepA_mal.vala b/impls/vala/stepA_mal.vala new file mode 100644 index 0000000000..6726615d03 --- /dev/null +++ b/impls/vala/stepA_mal.vala @@ -0,0 +1,420 @@ +class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { + public Mal.Env env; + public BuiltinFunctionEval(Mal.Env env_) { env = env_; } + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionEval(env); + } + public override string name() { return "eval"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + return Mal.Main.EVAL(args.vs.data, env); + } +} + +class Mal.Main : GLib.Object { + static bool eof; + static Mal.Sym dbgevalsym; + + static construct { + eof = false; + } + + public static Mal.Val? READ() { + string? line = Readline.readline("user> "); + if (line != null) { + if (line.length > 0) + Readline.History.add(line); + + try { + return Reader.read_str(line); + } catch (Mal.Error err) { + Mal.BuiltinFunctionThrow.clear(); + GLib.stderr.printf("%s\n", err.message); + return null; + } + } else { + stdout.printf("\n"); + eof = true; + return null; + } + } + + private static Mal.Val define_eval(Mal.Val key, Mal.Val value, + Mal.Env env) + throws Mal.Error { + var rootk = new GC.Root(key); (void)rootk; + var roote = new GC.Root(env); (void)roote; + var symkey = key as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected a symbol to define"); + var val = EVAL(value, env); + env.set(symkey, val); + return val; + } + + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + + public static Mal.Val quasiquote(Mal.Val ast) + throws Mal.Error { + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); + } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; + } + } + + public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) + throws Mal.Error { + // Copy the implicitly 'unowned' function arguments into + // ordinary owned variables which increment the objects' + // reference counts. This is so that when we overwrite these + // variables within the loop (for TCO) the objects we assign + // into them don't immediately get garbage-collected. + Mal.Val ast = ast_; + Mal.Env env = env_; + var ast_root = new GC.Root(ast); (void)ast_root; + var env_root = new GC.Root(env); (void)env_root; + while (true) { + ast_root.obj = ast; + env_root.obj = env; + GC.Core.maybe_collect(); + + if (dbgevalsym == null) + dbgevalsym = new Mal.Sym("DEBUG-EVAL"); + var dbgeval = env.get(dbgevalsym); + if (dbgeval != null && dbgeval.truth_value()) + stdout.printf("EVAL: %s\n", pr_str(ast)); + + if (ast is Mal.Sym) { + var key = ast as Mal.Sym; + var val = env.get(key); + if (val == null) + throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); + return val; + } + if (ast is Mal.Vector) { + var vec = ast as Mal.Vector; + var result = new Mal.Vector.with_size(vec.length); + var root = new GC.Root(result); (void)root; + for (var i = 0; i < vec.length; i++) + result[i] = EVAL(vec[i], env); + return result; + } + if (ast is Mal.Hashmap) { + var result = new Mal.Hashmap(); + var root = new GC.Root(result); (void)root; + var map = (ast as Mal.Hashmap).vs; + foreach (var key in map.get_keys()) + result.insert(key, EVAL(map[key], env)); + return result; + } + if (ast is Mal.List) { + unowned GLib.List list = (ast as Mal.List).vs; + if (list.first() == null) + return ast; + + var first = list.first().data; + if (first is Mal.Sym) { + var sym = first as Mal.Sym; + switch (sym.v) { + case "def!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "def!: expected two values"); + return define_eval(list.next.data, list.next.next.data, + env); + case "defmacro!": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expected two values"); + var symkey = list.next.data as Mal.Sym; + if (symkey == null) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expects a symbol"); + var val = EVAL(list.next.next.data, env) as Mal.Function; + if (val == null) + throw new Mal.Error.BAD_PARAMS( + "defmacro!: expected a function"); + val = val.copy() as Mal.Function; + val.is_macro = true; + env.set(symkey, val); + return val; + case "let*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "let*: expected two values"); + var defns = list.nth(1).data; + env = new Mal.Env.within(env); + + if (defns is Mal.List) { + for (unowned GLib.List iter = + (defns as Mal.List).vs; + iter != null; iter = iter.next.next) { + if (iter.next == null) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length list" + + " of definitions"); + define_eval(iter.data, iter.next.data, env); + } + } else if (defns is Mal.Vector) { + var vec = defns as Mal.Vector; + if (vec.length % 2 != 0) + throw new Mal.Error.BAD_PARAMS( + "let*: expected an even-length vector" + + " of definitions"); + for (var i = 0; i < vec.length; i += 2) + define_eval(vec[i], vec[i+1], env); + } else { + throw new Mal.Error.BAD_PARAMS( + "let*: expected a list or vector of definitions"); + } + ast = list.nth(2).data; + continue; // tail-call optimisation + case "do": + Mal.Val result = null; + for (list = list.next; list != null; list = list.next) + result = EVAL(list.data, env); + if (result == null) + throw new Mal.Error.BAD_PARAMS( + "do: expected at least one argument"); + return result; + case "if": + if (list.length() != 3 && list.length() != 4) + throw new Mal.Error.BAD_PARAMS( + "if: expected two or three arguments"); + list = list.next; + var cond = EVAL(list.data, env); + list = list.next; + if (!cond.truth_value()) { + // Skip to the else clause, which defaults to nil. + list = list.next; + if (list == null) + return new Mal.Nil(); + } + ast = list.data; + continue; // tail-call optimisation + case "fn*": + if (list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected two arguments"); + var binds = list.next.data as Mal.Listlike; + var body = list.next.next.data; + if (binds == null) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected a list of parameter names"); + for (var iter = binds.iter(); iter.nonempty(); + iter.step()) + if (!(iter.deref() is Mal.Sym)) + throw new Mal.Error.BAD_PARAMS( + "fn*: expected parameter name to be "+ + "symbol"); + return new Mal.Function(binds, body, env); + case "quote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quote: expected one argument"); + return list.next.data; + case "quasiquote": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquote: expected one argument"); + ast = quasiquote(list.next.data); + continue; // tail-call optimisation + case "try*": + if (list.length() != 2 && list.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "try*: expected one or two arguments"); + var trybody = list.next.data; + if (list.length() == 2) { + // Trivial catchless form of try + ast = trybody; + continue; // tail-call optimisation + } + var catchclause = list.next.next.data as Mal.List; + if (!(catchclause.vs.data is Mal.Sym) || + (catchclause.vs.data as Mal.Sym).v != "catch*") + throw new Mal.Error.BAD_PARAMS( + "try*: expected catch*"); + if (catchclause.vs.length() != 3) + throw new Mal.Error.BAD_PARAMS( + "catch*: expected two arguments"); + var catchparam = catchclause.vs.next.data as Mal.Sym; + if (catchparam == null) + throw new Mal.Error.BAD_PARAMS( + "catch*: expected a parameter name"); + var catchbody = catchclause.vs.next.next.data; + try { + return EVAL(trybody, env); + } catch (Mal.Error exc) { + var catchenv = new Mal.Env.within(env); + catchenv.set(catchparam, Mal.BuiltinFunctionThrow. + thrown_value(exc)); + ast = catchbody; + env = catchenv; + continue; // tail-call optimisation + } + } + } + + Mal.Val firstdata = EVAL(list.first().data, env); + var newlist = new Mal.List.empty(); + var root = new GC.Root(newlist); (void)root; + var iter = (ast as Mal.Listlike).iter().step(); + + if (firstdata is Mal.BuiltinFunction) { + for (; iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + return (firstdata as Mal.BuiltinFunction).call(newlist); + } else if (firstdata is Mal.Function) { + var fn = firstdata as Mal.Function; + if (fn.is_macro) { + for (; iter.nonempty(); iter.step()) + newlist.vs.append(iter.deref()); + var fenv = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = EVAL(fn.body, fenv); + continue; + } + for (; iter.nonempty(); iter.step()) + newlist.vs.append(EVAL(iter.deref(), env)); + env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); + ast = fn.body; + continue; // tail-call optimisation + } else { + throw new Mal.Error.CANNOT_APPLY( + "bad value at start of list"); + } + } else { + return ast; + } + } + } + + public static void PRINT(Mal.Val value) { + stdout.printf("%s\n", pr_str(value)); + } + + public static void rep(Mal.Env env) throws Mal.Error { + Mal.Val? val = READ(); + if (val != null) { + val = EVAL(val, env); + PRINT(val); + } + } + + public static void setup(string line, Mal.Env env) { + try { + EVAL(Reader.read_str(line), env); + } catch (Mal.Error err) { + stderr.printf("Error during setup:\n%s\n-> %s\n", + line, err.message); + GLib.Process.exit(1); + } + } + + public static int main(string[] args) { + var env = new Mal.Env(); + var root = new GC.Root(env); (void)root; + + Mal.Core.make_ns(); + foreach (var key in Mal.Core.ns.get_keys()) + env.set(new Mal.Sym(key), Mal.Core.ns[key]); + env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); + env.set(new Mal.Sym("*host-language*"), new Mal.String("vala")); + + setup("(def! not (fn* (a) (if a false true)))", env); + setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); + setup("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", env); + + var ARGV = new GLib.List(); + if (args.length > 1) { + for (int i = args.length - 1; i >= 2; i--) + ARGV.prepend(new Mal.String(args[i])); + } + env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); + + if (args.length > 1) { + var contents = new GLib.List(); + contents.prepend(new Mal.String(args[1])); + contents.prepend(new Mal.Sym("load-file")); + try { + EVAL(new Mal.List(contents), env); + } catch (Mal.Error.EXCEPTION_THROWN exc) { + GLib.stderr.printf( + "uncaught exception: %s\n", + pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + return 1; + } + } else { + setup("(println (str \"Mal [\" *host-language* \"]\"))", env); + while (!eof) { + try { + rep(env); + } catch (Mal.Error.EXCEPTION_THROWN exc) { + GLib.stderr.printf( + "uncaught exception: %s\n", + pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); + } catch (Mal.Error err) { + GLib.stderr.printf("%s\n", err.message); + } + } + } + return 0; + } +} diff --git a/impls/vala/types.vala b/impls/vala/types.vala new file mode 100644 index 0000000000..11e4a30aa5 --- /dev/null +++ b/impls/vala/types.vala @@ -0,0 +1,288 @@ +public errordomain Mal.Error { + BAD_TOKEN, + PARSE_ERROR, + HASH_KEY_TYPE_ERROR, + ENV_LOOKUP_FAILED, + BAD_PARAMS, + CANNOT_APPLY, + EXCEPTION_THROWN, + NOT_IMPLEMENTED_IN_THIS_STEP, +} + +abstract class Mal.Val : GC.Object { + public abstract bool truth_value(); +} + +abstract class Mal.Hashable : Mal.Val { + public string hashkey; + public static uint hash(Hashable h) { return str_hash(h.hashkey); } + public static bool equal(Hashable hl, Hashable hr) { + return hl.hashkey == hr.hashkey; + } +} + +class Mal.Bool : Mal.Hashable { + public bool v; + public Bool(bool value) { + v = value; + hashkey = value ? "bt" : "bf"; + } + public override bool truth_value() { return v; } + public override void gc_traverse(GC.Object.VisitorFunc visit) {} +} + +// Mal.Listlike is a subclass of Mal.Val which includes both lists and +// vectors, and provides a common iterator API so that core functions +// and special forms can treat them the same. +// +// Most core functions that take a list argument also accept nil. To +// make that easy, Mal.Nil also derives from Mal.Listlike. +abstract class Mal.Listlike : Mal.ValWithMetadata { + public abstract Mal.Iterator iter(); +} + +abstract class Mal.Iterator : GLib.Object { + public abstract Mal.Val? deref(); + public abstract Mal.Iterator step(); + public bool empty() { return deref() == null; } + public bool nonempty() { return deref() != null; } +} + +// ValWithMetadata is a subclass of Mal.Val which includes every value +// type you can put metadata on. Value types implementing this class +// must provide a copy() method, because with-meta has to make a copy +// of the value with new metadata. +abstract class Mal.ValWithMetadata : Mal.Val { + public Mal.Val? metadata; + construct { + metadata = null; + } + public abstract Mal.ValWithMetadata copy(); + public abstract void gc_traverse_m(GC.Object.VisitorFunc visit); + public override void gc_traverse(GC.Object.VisitorFunc visit) { + visit(metadata); + gc_traverse_m(visit); + } +} + +class Mal.Nil : Mal.Listlike { + public override bool truth_value() { return false; } + public override Mal.Iterator iter() { return new Mal.NilIterator(); } + public override Mal.ValWithMetadata copy() { return new Mal.Nil(); } + public override void gc_traverse_m(GC.Object.VisitorFunc visit) {} +} + +class Mal.NilIterator : Mal.Iterator { + public override Mal.Val? deref() { return null; } + public override Mal.Iterator step() { return this; } +} + +class Mal.List : Mal.Listlike { + public GLib.List vs; + public List(GLib.List values) { + foreach (var value in values) { + vs.append(value); + } + } + public List.empty() { + } + public override bool truth_value() { return true; } + public override Mal.Iterator iter() { + var toret = new Mal.ListIterator(); + toret.node = vs; + return toret; + } + public override Mal.ValWithMetadata copy() { + return new Mal.List(vs); + } + public override void gc_traverse_m(GC.Object.VisitorFunc visit) { + foreach (var v in vs) + visit(v); + } +} + +class Mal.ListIterator : Mal.Iterator { + public unowned GLib.List? node; + public override Mal.Val? deref() { + return node == null ? null : node.data; + } + public override Mal.Iterator step() { + if (node != null) + node = node.next; + return this; + } +} + +class Mal.Vector : Mal.Listlike { + struct Ref { weak Mal.Val v; } + private Ref[] rs; + public Vector.from_list(GLib.List values) { + rs = new Ref[values.length()]; + int i = 0; + foreach (var value in values) { + rs[i++] = { value }; + } + } + public Vector.with_size(uint size) { + rs = new Ref[size]; + } + private Vector.copy_of(Vector v) { + rs = v.rs; + } + public override bool truth_value() { return true; } + public override Mal.Iterator iter() { + var toret = new Mal.VectorIterator(); + toret.vec = this; + toret.pos = 0; + return toret; + } + public override Mal.ValWithMetadata copy() { + return new Mal.Vector.copy_of(this); + } + public uint length { get { return rs.length; } } + public new Mal.Val @get(uint pos) { + assert(pos < rs.length); + return rs[pos].v; + } + public new void @set(uint pos, Mal.Val v) { + assert(pos < rs.length); + rs[pos].v = v; + } + public override void gc_traverse_m(GC.Object.VisitorFunc visit) { + foreach (var r in rs) + visit(r.v); + } +} + +class Mal.VectorIterator : Mal.Iterator { + public Mal.Vector vec; + public int pos; + public override Mal.Val? deref() { + return pos >= vec.length ? null : vec[pos]; + } + public override Mal.Iterator step() { + if (pos < vec.length) pos++; + return this; + } +} + +class Mal.Num : Mal.Hashable { + public int64 v; + public Num(int64 value) { + v = value; + hashkey = "N" + v.to_string(); + } + public override bool truth_value() { return true; } + public override void gc_traverse(GC.Object.VisitorFunc visit) {} +} + +abstract class Mal.SymBase : Mal.Hashable { + public string v; + public override bool truth_value() { return true; } + public override void gc_traverse(GC.Object.VisitorFunc visit) {} +} + +class Mal.Sym : Mal.SymBase { + public Sym(string value) { + v = value; + hashkey = "'" + v; + } +} + +class Mal.Keyword : Mal.SymBase { + public Keyword(string value) { + v = value; + hashkey = ":" + v; + } +} + +class Mal.String : Mal.Hashable { + public string v; + public String(string value) { + v = value; + hashkey = "\"" + v; + } + public override bool truth_value() { return true; } + public override void gc_traverse(GC.Object.VisitorFunc visit) {} +} + +class Mal.Hashmap : Mal.ValWithMetadata { + public GLib.HashTable vs; + construct { + vs = new GLib.HashTable( + Mal.Hashable.hash, Mal.Hashable.equal); + } + public void insert(Mal.Val key, Mal.Val value) throws Mal.Error { + var hkey = key as Mal.Hashable; + if (hkey == null) + throw new Error.HASH_KEY_TYPE_ERROR("bad type as hash key"); + vs[hkey] = value; + } + public void remove(Mal.Val key) throws Mal.Error { + var hkey = key as Mal.Hashable; + if (hkey == null) + throw new Error.HASH_KEY_TYPE_ERROR("bad type as hash key"); + vs.remove(hkey); + } + public override bool truth_value() { return true; } + public override Mal.ValWithMetadata copy() { + var toret = new Mal.Hashmap(); + toret.vs = vs; + return toret; + } + public override void gc_traverse_m(GC.Object.VisitorFunc visit) { + foreach (var key in vs.get_keys()) { + visit(key); + visit(vs[key]); + } + } +} + +abstract class Mal.BuiltinFunction : Mal.ValWithMetadata { + public abstract string name(); + public abstract Mal.Val call(Mal.List args) throws Mal.Error; + public override bool truth_value() { return true; } + public override void gc_traverse_m(GC.Object.VisitorFunc visit) {} +} + +class Mal.Function : Mal.ValWithMetadata { + public bool is_macro; +#if !NO_ENV + public weak Mal.Listlike parameters; + public weak Mal.Val body; + public weak Mal.Env env; + public Function(Mal.Listlike parameters_, Mal.Val body_, Mal.Env env_) { + parameters = parameters_; + body = body_; + env = env_; + is_macro = false; + } +#endif + public override Mal.ValWithMetadata copy() { +#if !NO_ENV + var copied = new Mal.Function(parameters, body, env); + copied.is_macro = is_macro; + return copied; +#else + throw new Mal.Error.NOT_IMPLEMENTED_IN_THIS_STEP( + "can't copy a Mal.Function without Mal.Env existing"); +#endif + } + public override bool truth_value() { return true; } + public override void gc_traverse_m(GC.Object.VisitorFunc visit) { +#if !NO_ENV + visit(parameters); + visit(body); + visit(env); +#endif + } +} + +class Mal.Atom : Mal.Val { + public weak Mal.Val v; + public Atom(Mal.Val v_) { v = v_; } + public override bool truth_value() { return true; } + public override void gc_traverse(GC.Object.VisitorFunc visit) { + visit(v); + } +} diff --git a/impls/vb/Dockerfile b/impls/vb/Dockerfile new file mode 100644 index 0000000000..a95c31ce18 --- /dev/null +++ b/impls/vb/Dockerfile @@ -0,0 +1,25 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# Deps for Mono-based languages (C#, VB.Net) +RUN apt-get -y install tzdata mono-runtime mono-mcs mono-vbnc mono-devel diff --git a/impls/vb/Makefile b/impls/vb/Makefile new file mode 100644 index 0000000000..4f269959e1 --- /dev/null +++ b/impls/vb/Makefile @@ -0,0 +1,39 @@ +##################### + +DEBUG = + +SOURCES_BASE = readline.vb types.vb reader.vb printer.vb +SOURCES_LISP = env.vb core.vb stepA_mal.vb +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +##################### + +SRCS = step0_repl.vb step1_read_print.vb step2_eval.vb \ + step3_env.vb step4_if_fn_do.vb step5_tco.vb step6_file.vb \ + step7_quote.vb step8_macros.vb step9_try.vb stepA_mal.vb + +LIB_CS_SRCS = getline.cs +LIB_VB_SRCS = $(filter-out step%,$(filter %.vb,$(SOURCES))) + +FLAGS = $(if $(strip $(DEBUG)),-debug:full,) + +##################### + +all: $(patsubst %.vb,%.exe,$(SRCS)) + +dist: mal.exe + +mal.exe: $(patsubst %.vb,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) + cp $< $@ + +mal_cs.dll: $(LIB_CS_SRCS) + mcs $(FLAGS) -target:library $+ -out:$@ + +mal_vb.dll: mal_cs.dll $(LIB_VB_SRCS) + vbnc $(FLAGS) -target:library -r:mal_cs.dll $(LIB_VB_SRCS) -out:$@ + +%.exe: %.vb mal_vb.dll + vbnc $(FLAGS) -r:mal_vb.dll -r:mal_cs.dll $< + +clean: + rm -f *.dll *.exe *.mdb diff --git a/vb/core.vb b/impls/vb/core.vb similarity index 83% rename from vb/core.vb rename to impls/vb/core.vb index 771d0cce3b..77ba29cc73 100644 --- a/vb/core.vb +++ b/impls/vb/core.vb @@ -69,15 +69,35 @@ Namespace Mal End If End Function + Shared Function string_Q(a As MalList) As MalVal + If TypeOf a(0) Is MalString Then + Dim s As String = DirectCast(a(0),MalString).getValue() + If s.Length = 0 Then + return MalTrue + Elseif s.Substring(0,1) = Strings.ChrW(&H029e) Then + return MalFalse + Else + return MalTrue + End If + Else + return MalFalse + End If + End Function + Shared Function keyword(a As MalList) As MalVal Dim s As String = DirectCast(a(0),MalString).getValue() + If s.Substring(0,1) = Strings.ChrW(&H029e) Then + Return a(0) + End If return new MalString(ChrW(&H029e) & s) End Function Shared Function keyword_Q(a As MalList) As MalVal If TypeOf a(0) Is MalString Then Dim s As String = DirectCast(a(0),MalString).getValue() - If s.Substring(0,1) = Strings.ChrW(&H029e) Then + If s.Length = 0 Then + return MalFalse + Elseif s.Substring(0,1) = Strings.ChrW(&H029e) Then return MalTrue Else return MalFalse @@ -87,6 +107,30 @@ Namespace Mal End If End Function + Shared Function number_Q(a As MalList) As MalVal + If TypeOf a(0) Is MalInt Then + return MalTrue + Else + return MalFalse + End If + End Function + + Shared Function fn_Q(a As MalList) As MalVal + If TypeOf a(0) Is MalFunc AndAlso Not DirectCast(a(0),MalFunc).isMacro() Then + return MalTrue + Else + return MalFalse + End If + End Function + + Shared Function macro_Q(a As MalList) As MalVal + If TypeOf a(0) Is MalFunc AndAlso DirectCast(a(0),MalFunc).isMacro() Then + return MalTrue + Else + return MalFalse + End If + End Function + ' Number functions Shared Function lt(a As MalList) As MalVal @@ -275,6 +319,10 @@ Namespace Mal return DirectCast(new MalList(lst),MalVal) End Function + Shared Function vec(a As MalList) As MalVal + return New MalVector(DirectCast(a(0),MalList).getValue()) + End Function + Shared Function nth(a As MalList) As MalVal Dim idx As Integer = DirectCast(a(1),MalInt).getValue() If (idx < DirectCast(a(0),MalList).size()) Then @@ -286,11 +334,19 @@ Namespace Mal End Function Shared Function first(a As MalList) As MalVal - return DirectCast(a(0),MalList)(0) + If a(0) Is Nil Then + return Nil + Else + return DirectCast(a(0),MalList)(0) + End If End Function Shared Function rest(a As MalList) As MalVal - return DirectCast(a(0),MalList).rest() + If a(0) Is Nil Then + return new MalList() + Else + return DirectCast(a(0),MalList).rest() + End If End Function Shared Function empty_Q(a As MalList) As MalVal @@ -326,6 +382,33 @@ Namespace Mal End If End Function + Shared Function seq(a As MalList) As MalVal + If a(0) Is Nil Then + return Nil + Elseif TypeOf a(0) is MalVector Then + If DirectCast(a(0),MalVector).size() = 0 Then + return Nil + End If + return new MalList(DirectCast(a(0),MalVector).getValue()) + Elseif TypeOf a(0) is MalList Then + If DirectCast(a(0),MalList).size() = 0 Then + return Nil + End If + return a(0) + Elseif TypeOf a(0) is MalString Then + Dim s As String = DirectCast(a(0),MalString).getValue() + If s.Length = 0 Then + return Nil + End If + Dim chars_list As New List(Of MalVal) + For Each c As Char In s + chars_list.Add(new MalString(c.ToString())) + Next + return new MalList(chars_list) + Else + return Nil + End If + End Function ' General list related functions Shared Function apply(a As MalList) As MalVal @@ -399,8 +482,12 @@ Namespace Mal ns.Add("false?", New MalFunc(AddressOf false_Q)) ns.Add("symbol", new MalFunc(AddressOf symbol)) ns.Add("symbol?", New MalFunc(AddressOf symbol_Q)) + ns.Add("string?", New MalFunc(AddressOf string_Q)) ns.Add("keyword", new MalFunc(AddressOf keyword)) ns.Add("keyword?", New MalFunc(AddressOf keyword_Q)) + ns.Add("number?", New MalFunc(AddressOf number_Q)) + ns.Add("fn?", New MalFunc(AddressOf fn_Q)) + ns.Add("macro?", New MalFunc(AddressOf macro_Q)) ns.Add("pr-str",New MalFunc(AddressOf pr_str)) ns.Add("str", New MalFunc(AddressOf str)) @@ -435,12 +522,14 @@ Namespace Mal ns.Add("sequential?", New MalFunc(AddressOf sequential_Q)) ns.Add("cons", New MalFunc(AddressOf cons)) ns.Add("concat", New MalFunc(AddressOf concat)) + ns.Add("vec", New MalFunc(AddressOf vec)) ns.Add("nth", New MalFunc(AddressOf nth)) ns.Add("first", New MalFunc(AddressOf first)) ns.Add("rest", New MalFunc(AddressOf rest)) ns.Add("empty?", New MalFunc(AddressOf empty_Q)) ns.Add("count",New MalFunc(AddressOf count)) ns.Add("conj", New MalFunc(AddressOf conj)) + ns.Add("seq", New MalFunc(AddressOf seq)) ns.Add("apply", New MalFunc(AddressOf apply)) ns.Add("map", New MalFunc(AddressOf map)) diff --git a/impls/vb/env.vb b/impls/vb/env.vb new file mode 100644 index 0000000000..b0f53616ce --- /dev/null +++ b/impls/vb/env.vb @@ -0,0 +1,45 @@ +Imports System.Collections.Generic +Imports Mal +Imports MalVal = Mal.types.MalVal +Imports MalSymbol = Mal.types.MalSymbol +Imports MalList = Mal.types.MalList + +Namespace Mal + Public Class env + Public Class Env + Dim outer As Env = Nothing + Dim data As Dictionary(Of String, MalVal) = New Dictionary(Of String, MalVal) + + Public Sub New(new_outer As Env) + outer = new_outer + End Sub + Public Sub New(new_outer As Env, binds As MalList, exprs As MalList) + outer = new_outer + For i As Integer = 0 To binds.size()-1 + Dim sym As String = DirectCast(binds.nth(i),MalSymbol).getName() + If sym = "&" Then + data(DirectCast(binds.nth(i+1),MalSymbol).getName()) = exprs.slice(i) + Exit For + Else + data(sym) = exprs.nth(i) + End If + Next + End Sub + + Public Function do_get(key As String) As MalVal + If data.ContainsKey(key) Then + return data(key) + Else If outer IsNot Nothing Then + return outer.do_get(key) + Else + return Nothing + End If + End Function + + Public Function do_set(key As MalSymbol, value As MalVal) As Env + data(key.getName()) = value + return Me + End Function + End Class + End Class +End Namespace diff --git a/vb/getline.cs b/impls/vb/getline.cs similarity index 100% rename from vb/getline.cs rename to impls/vb/getline.cs diff --git a/vb/printer.vb b/impls/vb/printer.vb similarity index 100% rename from vb/printer.vb rename to impls/vb/printer.vb diff --git a/vb/reader.vb b/impls/vb/reader.vb similarity index 91% rename from vb/reader.vb rename to impls/vb/reader.vb index 9d4e03dd9e..6d30e49a1e 100644 --- a/vb/reader.vb +++ b/impls/vb/reader.vb @@ -48,7 +48,7 @@ Namespace Mal Shared Function tokenize(str As String) As List(Of String) Dim tokens As New List(Of String) - Dim pattern As String = "[\s ,]*(~@|[\[\]{}()'`~@]|""(?:[\\].|[^\\""])*""|;.*|[^\s \[\]{}()'""`~@,;]*)" + Dim pattern As String = "[\s ,]*(~@|[\[\]{}()'`~@]|""(?:[\\].|[^\\""])*""?|;.*|[^\s \[\]{}()'""`~@,;]*)" Dim regex As New Regex(pattern) For Each match As Match In regex.Matches(str) Dim token As String = match.Groups(1).Value @@ -64,7 +64,7 @@ Namespace Mal Shared Function read_atom(rdr As Reader) As MalVal Dim token As String = rdr.get_next() - Dim pattern As String = "(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^("".*"")$|^:(.*)|(^[^""]*$)" + Dim pattern As String = "(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|(^""(?:[\\].|[^\\""])*""$)|^("".*)|^:(.*)|(^[^""]*$)" Dim regex As Regex = New Regex(pattern) Dim match As Match = regex.Match(token) 'Console.WriteLine("token: ^" + token + "$") @@ -83,12 +83,16 @@ Namespace Mal Dim str As String = match.Groups(6).Value return New Mal.types.MalString( str.Substring(1, str.Length-2) _ - .Replace("\""", """") _ - .Replace("\n", Environment.NewLine)) + .Replace("\\", ChrW(&H029e)) _ + .Replace("\""", """") _ + .Replace("\n", Environment.NewLine) _ + .Replace(ChrW(&H029e), "\")) Else If match.Groups(7).Value <> String.Empty Then - return New Mal.types.MalString(ChrW(&H029e) & match.Groups(7).Value) + throw New ParseError("expected '""', got EOF") Else If match.Groups(8).Value <> String.Empty Then - return New Mal.types.MalSymbol(match.Groups(8).Value) + return New Mal.types.MalString(ChrW(&H029e) & match.Groups(8).Value) + Else If match.Groups(9).Value <> String.Empty Then + return New Mal.types.MalSymbol(match.Groups(9).Value) Else throw New ParseError("unrecognized '" & match.Groups(0).Value & "'") End If diff --git a/vb/readline.vb b/impls/vb/readline.vb similarity index 100% rename from vb/readline.vb rename to impls/vb/readline.vb diff --git a/impls/vb/run b/impls/vb/run new file mode 100755 index 0000000000..5c5642646f --- /dev/null +++ b/impls/vb/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" diff --git a/vb/step0_repl.vb b/impls/vb/step0_repl.vb similarity index 77% rename from vb/step0_repl.vb rename to impls/vb/step0_repl.vb index f53f378524..3880598523 100644 --- a/vb/step0_repl.vb +++ b/impls/vb/step0_repl.vb @@ -24,11 +24,16 @@ Namespace Mal End Function Shared Function Main As Integer - Dim prompt As String = "user> " - Dim line As String + Dim args As String() = Environment.GetCommandLineArgs() + + If args.Length > 1 AndAlso args(1) = "--raw" Then + Mal.readline.SetMode(Mal.readline.Modes.Raw) + End If + ' repl loop + Dim line As String Do - line = Mal.readline.Readline(prompt) + line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If diff --git a/vb/step1_read_print.vb b/impls/vb/step1_read_print.vb similarity index 100% rename from vb/step1_read_print.vb rename to impls/vb/step1_read_print.vb diff --git a/vb/step2_eval.vb b/impls/vb/step2_eval.vb similarity index 82% rename from vb/step2_eval.vb rename to impls/vb/step2_eval.vb index 6e45efe85f..9aa42b60c2 100644 --- a/vb/step2_eval.vb +++ b/impls/vb/step2_eval.vb @@ -18,40 +18,31 @@ Namespace Mal End Function ' eval - Shared Function eval_ast(ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal - If TypeOf ast Is MalSymbol Then - Dim sym As MalSymbol = DirectCast(ast, MalSymbol) + Shared Function EVAL(orig_ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal + + 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + + If TypeOf orig_ast Is MalSymbol Then + Dim sym As MalSymbol = DirectCast(orig_ast, MalSymbol) return env.Item(sym.getName()) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else new_lst = DirectCast(New MalVector, MalList) - End If Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then + Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function - - Shared Function EVAL(orig_ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list @@ -59,8 +50,11 @@ Namespace Mal If ast.size() = 0 Then return ast End If - Dim a0 As MalVal = ast(0) - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Function diff --git a/vb/step3_env.vb b/impls/vb/step3_env.vb similarity index 81% rename from vb/step3_env.vb rename to impls/vb/step3_env.vb index dfee614b74..9a64659391 100644 --- a/vb/step3_env.vb +++ b/impls/vb/step3_env.vb @@ -19,39 +19,38 @@ Namespace Mal End Function ' eval - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) + Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal + + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else new_lst = DirectCast(New MalVector, MalList) - End If Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then + Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list @@ -80,7 +79,11 @@ Namespace Mal Next return EVAL(a2, let_env) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Select diff --git a/vb/step4_if_fn_do.vb b/impls/vb/step4_if_fn_do.vb similarity index 81% rename from vb/step4_if_fn_do.vb rename to impls/vb/step4_if_fn_do.vb index 470ae86661..886cabe1be 100644 --- a/vb/step4_if_fn_do.vb +++ b/impls/vb/step4_if_fn_do.vb @@ -19,34 +19,6 @@ Namespace Mal End Function ' eval - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - new_lst.conj_BANG(EVAL(mv, env)) - Next - return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function ' TODO: move to types.vb when it is ported Class FClosure @@ -59,9 +31,36 @@ Namespace Mal End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list @@ -97,9 +96,10 @@ Namespace Mal Next return EVAL(a2, let_env) Case "do" - Dim el As MalList = DirectCast(eval_ast(ast.rest(), env), _ - MalLIst) - return el(el.size()-1) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next + return EVAL(ast(ast.size()-1), env) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) @@ -126,7 +126,11 @@ Namespace Mal Dim mf As new MalFunc(f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Select diff --git a/vb/step5_tco.vb b/impls/vb/step5_tco.vb similarity index 83% rename from vb/step5_tco.vb rename to impls/vb/step5_tco.vb index bb36b22bbf..11b26bfa55 100644 --- a/vb/step5_tco.vb +++ b/impls/vb/step5_tco.vb @@ -19,34 +19,6 @@ Namespace Mal End Function ' eval - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - new_lst.conj_BANG(EVAL(mv, env)) - Next - return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function ' TODO: move to types.vb when it is ported Class FClosure @@ -61,9 +33,36 @@ Namespace Mal Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list @@ -100,7 +99,9 @@ Namespace Mal orig_ast = a2 env = let_env Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -127,7 +128,11 @@ Namespace Mal DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing diff --git a/vb/step6_file.vb b/impls/vb/step6_file.vb similarity index 84% rename from vb/step6_file.vb rename to impls/vb/step6_file.vb index 9ea0e9f8d2..6602445446 100644 --- a/vb/step6_file.vb +++ b/impls/vb/step6_file.vb @@ -20,34 +20,6 @@ Namespace Mal End Function ' eval - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - new_lst.conj_BANG(EVAL(mv, env)) - Next - return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function ' TODO: move to types.vb when it is ported Class FClosure @@ -62,9 +34,36 @@ Namespace Mal Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list @@ -101,7 +100,9 @@ Namespace Mal orig_ast = a2 env = let_env Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -128,7 +129,11 @@ Namespace Mal DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing @@ -181,7 +186,7 @@ Namespace Mal ' core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))") + REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") If args.Length > fileIdx Then REP("(load-file """ & args(fileIdx) & """)") diff --git a/impls/vb/step7_quote.vb b/impls/vb/step7_quote.vb new file mode 100644 index 0000000000..27c059ab27 --- /dev/null +++ b/impls/vb/step7_quote.vb @@ -0,0 +1,264 @@ +Imports System +Imports System.IO +Imports System.Collections.Generic +Imports Mal +Imports MalVal = Mal.types.MalVal +Imports MalInt = Mal.types.MalInt +Imports MalString = Mal.types.MalString +Imports MalSymbol = Mal.types.MalSymbol +Imports MalList = Mal.types.MalList +Imports MalVector = Mal.types.MalVector +Imports MalHashMap = Mal.types.MalHashMap +Imports MalFunc = Mal.types.MalFunc +Imports MalEnv = Mal.env.Env + +Namespace Mal + Class step7_quote + ' read + Shared Function READ(str As String) As MalVal + Return reader.read_str(str) + End Function + + ' eval + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing + End Function + + Shared Function quasiquote(ast As MalVal) As MalVal + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then + return New MalList(New MalSymbol("quote"), ast) + End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result + End Function + + ' TODO: move to types.vb when it is ported + Class FClosure + Public ast As MalVal + Public params As MalList + Public env As MalEnv + Function fn(args as MalList) As MalVal + return EVAL(ast, new MalEnv(env, params, args)) + End Function + End Class + + Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal + Do + + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast + End If + + ' apply list + Dim ast As MalList = DirectCast(orig_ast, MalList) + If ast.size() = 0 Then + return ast + End If + Dim a0 As MalVal = ast(0) + Dim a0sym As String + If TypeOf a0 is MalSymbol Then + a0sym = DirectCast(a0,MalSymbol).getName() + Else + a0sym = "__<*fn*>__" + End If + + Select a0sym + Case "def!" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim res As MalVal = EVAL(a2, env) + env.do_set(DirectCast(a1,MalSymbol), res) + return res + Case "let*" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim key As MalSymbol + Dim val as MalVal + Dim let_env As new MalEnv(env) + For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 + key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) + val = DirectCast(a1,MalList)(i+1) + let_env.do_set(key, EVAL(val, let_env)) + Next + orig_ast = a2 + env = let_env + Case "quote" + return ast(1) + Case "quasiquote" + orig_ast = quasiquote(ast(1)) + Case "do" + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next + orig_ast = ast(ast.size()-1) + Case "if" + Dim a1 As MalVal = ast(1) + Dim cond As MalVal = EVAL(a1, env) + If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then + ' eval false slot form + If ast.size() > 3 Then + orig_ast = ast(3) + Else + return Mal.types.Nil + End If + Else + ' eval true slot form + orig_ast = ast(2) + + End If + Case "fn*" + Dim fc As New FClosure() + fc.ast = ast(2) + fc.params = DirectCast(ast(1),MalLIst) + fc.env = env + Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn + Dim mf As new MalFunc(ast(2), env, + DirectCast(ast(1),MalList), f) + return DirectCast(mf,MalVal) + Case Else + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next + Dim f As MalFunc = DirectCast(el(0), MalFunc) + Dim fnast As MalVal = f.getAst() + If not fnast Is Nothing + orig_ast = fnast + env = f.genEnv(el.rest()) + Else + Return f.apply(el.rest()) + End If + End Select + + Loop While True + End Function + + ' print + Shared Function PRINT(exp As MalVal) As String + return printer._pr_str(exp, TRUE) + End Function + + ' repl + Shared repl_env As MalEnv + + Shared Function REP(str As String) As String + Return PRINT(EVAL(READ(str), repl_env)) + End Function + + Shared Function do_eval(args As MalList) As MalVal + Return EVAL(args(0), repl_env) + End Function + + Shared Function Main As Integer + Dim args As String() = Environment.GetCommandLineArgs() + + repl_env = New MalEnv(Nothing) + + ' core.vb: defined using VB.NET + For Each entry As KeyValuePair(Of String,MalVal) In core.ns() + repl_env.do_set(new MalSymbol(entry.Key), entry.Value) + Next + repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) + Dim fileIdx As Integer = 1 + If args.Length > 1 AndAlso args(1) = "--raw" Then + Mal.readline.SetMode(Mal.readline.Modes.Raw) + fileIdx = 2 + End If + Dim argv As New MalList() + For i As Integer = fileIdx+1 To args.Length-1 + argv.conj_BANG(new MalString(args(i))) + Next + repl_env.do_set(new MalSymbol("*ARGV*"), argv) + + ' core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") + + If args.Length > fileIdx Then + REP("(load-file """ & args(fileIdx) & """)") + return 0 + End If + + ' repl loop + Dim line As String + Do + Try + line = Mal.readline.Readline("user> ") + If line is Nothing Then + Exit Do + End If + If line = "" Then + Continue Do + End If + Catch e As IOException + Console.WriteLine("IOException: " & e.Message) + End Try + Try + Console.WriteLine(REP(line)) + Catch e as Exception + Console.WriteLine("Error: " & e.Message) + Console.WriteLine(e.StackTrace) + Continue Do + End Try + Loop While True + End function + End Class +End Namespace diff --git a/impls/vb/step8_macros.vb b/impls/vb/step8_macros.vb new file mode 100644 index 0000000000..f29e20bc59 --- /dev/null +++ b/impls/vb/step8_macros.vb @@ -0,0 +1,275 @@ +Imports System +Imports System.IO +Imports System.Collections.Generic +Imports Mal +Imports MalVal = Mal.types.MalVal +Imports MalInt = Mal.types.MalInt +Imports MalString = Mal.types.MalString +Imports MalSymbol = Mal.types.MalSymbol +Imports MalList = Mal.types.MalList +Imports MalVector = Mal.types.MalVector +Imports MalHashMap = Mal.types.MalHashMap +Imports MalFunc = Mal.types.MalFunc +Imports MalEnv = Mal.env.Env + +Namespace Mal + Class step8_macros + ' read + Shared Function READ(str As String) As MalVal + Return reader.read_str(str) + End Function + + ' eval + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing + End Function + + Shared Function quasiquote(ast As MalVal) As MalVal + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then + return New MalList(New MalSymbol("quote"), ast) + End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result + End Function + + ' TODO: move to types.vb when it is ported + Class FClosure + Public ast As MalVal + Public params As MalList + Public env As MalEnv + Function fn(args as MalList) As MalVal + return EVAL(ast, new MalEnv(env, params, args)) + End Function + End Class + + Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal + Do + + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast + End If + + ' apply list + Dim ast As MalList = DirectCast(orig_ast, MalList) + + If ast.size() = 0 Then + return ast + End If + Dim a0 As MalVal = ast(0) + Dim a0sym As String + If TypeOf a0 is MalSymbol Then + a0sym = DirectCast(a0,MalSymbol).getName() + Else + a0sym = "__<*fn*>__" + End If + + Select a0sym + Case "def!" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim res As MalVal = EVAL(a2, env) + env.do_set(DirectCast(a1,MalSymbol), res) + return res + Case "let*" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim key As MalSymbol + Dim val as MalVal + Dim let_env As new MalEnv(env) + For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 + key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) + val = DirectCast(a1,MalList)(i+1) + let_env.do_set(key, EVAL(val, let_env)) + Next + orig_ast = a2 + env = let_env + Case "quote" + return ast(1) + Case "quasiquote" + orig_ast = quasiquote(ast(1)) + Case "defmacro!" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() + env.do_set(DirectCast(a1,MalSymbol), res) + return res + Case "do" + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next + orig_ast = ast(ast.size()-1) + Case "if" + Dim a1 As MalVal = ast(1) + Dim cond As MalVal = EVAL(a1, env) + If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then + ' eval false slot form + If ast.size() > 3 Then + orig_ast = ast(3) + Else + return Mal.types.Nil + End If + Else + ' eval true slot form + orig_ast = ast(2) + + End If + Case "fn*" + Dim fc As New FClosure() + fc.ast = ast(2) + fc.params = DirectCast(ast(1),MalLIst) + fc.env = env + Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn + Dim mf As new MalFunc(ast(2), env, + DirectCast(ast(1),MalList), f) + return DirectCast(mf,MalVal) + Case Else + Dim f As MalFunc = DirectCast(EVAL(a0, env), MalFunc) + If f.isMacro() Then + orig_ast = f.apply(ast.rest()) + Continue Do + End If + Dim args As MalList = New MalList + For i As Integer = 1 To ast.size()-1 + args.conj_BANG(EVAL(ast(i), env)) + Next + Dim fnast As MalVal = f.getAst() + If not fnast Is Nothing + orig_ast = fnast + env = f.genEnv(args) + Else + Return f.apply(args) + End If + End Select + + Loop While True + End Function + + ' print + Shared Function PRINT(exp As MalVal) As String + return printer._pr_str(exp, TRUE) + End Function + + ' repl + Shared repl_env As MalEnv + + Shared Function REP(str As String) As String + Return PRINT(EVAL(READ(str), repl_env)) + End Function + + Shared Function do_eval(args As MalList) As MalVal + Return EVAL(args(0), repl_env) + End Function + + Shared Function Main As Integer + Dim args As String() = Environment.GetCommandLineArgs() + + repl_env = New MalEnv(Nothing) + + ' core.vb: defined using VB.NET + For Each entry As KeyValuePair(Of String,MalVal) In core.ns() + repl_env.do_set(new MalSymbol(entry.Key), entry.Value) + Next + repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) + Dim fileIdx As Integer = 1 + If args.Length > 1 AndAlso args(1) = "--raw" Then + Mal.readline.SetMode(Mal.readline.Modes.Raw) + fileIdx = 2 + End If + Dim argv As New MalList() + For i As Integer = fileIdx+1 To args.Length-1 + argv.conj_BANG(new MalString(args(i))) + Next + repl_env.do_set(new MalSymbol("*ARGV*"), argv) + + ' core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") + + If args.Length > fileIdx Then + REP("(load-file """ & args(fileIdx) & """)") + return 0 + End If + + ' repl loop + Dim line As String + Do + Try + line = Mal.readline.Readline("user> ") + If line is Nothing Then + Exit Do + End If + If line = "" Then + Continue Do + End If + Catch e As IOException + Console.WriteLine("IOException: " & e.Message) + End Try + Try + Console.WriteLine(REP(line)) + Catch e as Exception + Console.WriteLine("Error: " & e.Message) + Console.WriteLine(e.StackTrace) + Continue Do + End Try + Loop While True + End function + End Class +End Namespace diff --git a/impls/vb/step9_try.vb b/impls/vb/step9_try.vb new file mode 100644 index 0000000000..7f318fc70a --- /dev/null +++ b/impls/vb/step9_try.vb @@ -0,0 +1,302 @@ +Imports System +Imports System.IO +Imports System.Collections.Generic +Imports Mal +Imports MalVal = Mal.types.MalVal +Imports MalInt = Mal.types.MalInt +Imports MalString = Mal.types.MalString +Imports MalSymbol = Mal.types.MalSymbol +Imports MalList = Mal.types.MalList +Imports MalVector = Mal.types.MalVector +Imports MalHashMap = Mal.types.MalHashMap +Imports MalFunc = Mal.types.MalFunc +Imports MalEnv = Mal.env.Env + +Namespace Mal + Class step9_try + ' read + Shared Function READ(str As String) As MalVal + Return reader.read_str(str) + End Function + + ' eval + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing + End Function + + Shared Function quasiquote(ast As MalVal) As MalVal + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then + return New MalList(New MalSymbol("quote"), ast) + End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result + End Function + + ' TODO: move to types.vb when it is ported + Class FClosure + Public ast As MalVal + Public params As MalList + Public env As MalEnv + Function fn(args as MalList) As MalVal + return EVAL(ast, new MalEnv(env, params, args)) + End Function + End Class + + Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal + Do + + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast + End If + + ' apply list + Dim ast As MalList = DirectCast(orig_ast, MalList) + + If ast.size() = 0 Then + return ast + End If + Dim a0 As MalVal = ast(0) + Dim a0sym As String + If TypeOf a0 is MalSymbol Then + a0sym = DirectCast(a0,MalSymbol).getName() + Else + a0sym = "__<*fn*>__" + End If + + Select a0sym + Case "def!" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim res As MalVal = EVAL(a2, env) + env.do_set(DirectCast(a1,MalSymbol), res) + return res + Case "let*" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim key As MalSymbol + Dim val as MalVal + Dim let_env As new MalEnv(env) + For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 + key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) + val = DirectCast(a1,MalList)(i+1) + let_env.do_set(key, EVAL(val, let_env)) + Next + orig_ast = a2 + env = let_env + Case "quote" + return ast(1) + Case "quasiquote" + orig_ast = quasiquote(ast(1)) + Case "defmacro!" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() + env.do_set(DirectCast(a1,MalSymbol), res) + return res + Case "try*" + Try + return EVAL(ast(1), env) + Catch e As Exception + If ast.size() > 2 Then + Dim exc As MalVal + Dim a2 As MalVal = ast(2) + Dim a20 As MalVal = DirectCast(a2,MalList)(0) + If DirectCast(a20,MalSymbol).getName() = "catch*" Then + If TypeOf e Is Mal.types.MalException Then + exc = DirectCast(e,Mal.types.MalException).getValue() + Else + exc = New MalString(e.Message) + End If + return EVAL( + DirectCast(a2,MalList)(2), + New MalEnv(env, + DirectCast(a2,MalList).slice(1,2), + New MalList(exc))) + End If + End If + Throw e + End Try + Case "do" + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next + orig_ast = ast(ast.size()-1) + Case "if" + Dim a1 As MalVal = ast(1) + Dim cond As MalVal = EVAL(a1, env) + If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then + ' eval false slot form + If ast.size() > 3 Then + orig_ast = ast(3) + Else + return Mal.types.Nil + End If + Else + ' eval true slot form + orig_ast = ast(2) + + End If + Case "fn*" + Dim fc As New FClosure() + fc.ast = ast(2) + fc.params = DirectCast(ast(1),MalLIst) + fc.env = env + Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn + Dim mf As new MalFunc(ast(2), env, + DirectCast(ast(1),MalList), f) + return DirectCast(mf,MalVal) + Case Else + Dim f As MalFunc = DirectCast(EVAL(a0, env), MalFunc) + If f.isMacro() Then + orig_ast = f.apply(ast.rest()) + Continue Do + End If + Dim args As MalList = New MalList + For i As Integer = 1 To ast.size()-1 + args.conj_BANG(EVAL(ast(i), env)) + Next + Dim fnast As MalVal = f.getAst() + If not fnast Is Nothing + orig_ast = fnast + env = f.genEnv(args) + Else + Return f.apply(args) + End If + End Select + + Loop While True + End Function + + ' print + Shared Function PRINT(exp As MalVal) As String + return printer._pr_str(exp, TRUE) + End Function + + ' repl + Shared repl_env As MalEnv + + Shared Function REP(str As String) As String + Return PRINT(EVAL(READ(str), repl_env)) + End Function + + Shared Function do_eval(args As MalList) As MalVal + Return EVAL(args(0), repl_env) + End Function + + Shared Function Main As Integer + Dim args As String() = Environment.GetCommandLineArgs() + + repl_env = New MalEnv(Nothing) + + ' core.vb: defined using VB.NET + For Each entry As KeyValuePair(Of String,MalVal) In core.ns() + repl_env.do_set(new MalSymbol(entry.Key), entry.Value) + Next + repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) + Dim fileIdx As Integer = 1 + If args.Length > 1 AndAlso args(1) = "--raw" Then + Mal.readline.SetMode(Mal.readline.Modes.Raw) + fileIdx = 2 + End If + Dim argv As New MalList() + For i As Integer = fileIdx+1 To args.Length-1 + argv.conj_BANG(new MalString(args(i))) + Next + repl_env.do_set(new MalSymbol("*ARGV*"), argv) + + ' core.mal: defined using the language itself + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") + + If args.Length > fileIdx Then + REP("(load-file """ & args(fileIdx) & """)") + return 0 + End If + + ' repl loop + Dim line As String + Do + Try + line = Mal.readline.Readline("user> ") + If line is Nothing Then + Exit Do + End If + If line = "" Then + Continue Do + End If + Catch e As IOException + Console.WriteLine("IOException: " & e.Message) + End Try + Try + Console.WriteLine(REP(line)) + Catch e As Mal.types.MalException + Console.WriteLine("Error: " & _ + printer._pr_str(e.getValue(), False)) + Continue Do + Catch e As Exception + Console.WriteLine("Error: " & e.Message) + Console.WriteLine(e.StackTrace) + Continue Do + End Try + Loop While True + End function + End Class +End Namespace diff --git a/impls/vb/stepA_mal.vb b/impls/vb/stepA_mal.vb new file mode 100644 index 0000000000..8825921d73 --- /dev/null +++ b/impls/vb/stepA_mal.vb @@ -0,0 +1,304 @@ +Imports System +Imports System.IO +Imports System.Collections.Generic +Imports Mal +Imports MalVal = Mal.types.MalVal +Imports MalInt = Mal.types.MalInt +Imports MalString = Mal.types.MalString +Imports MalSymbol = Mal.types.MalSymbol +Imports MalList = Mal.types.MalList +Imports MalVector = Mal.types.MalVector +Imports MalHashMap = Mal.types.MalHashMap +Imports MalFunc = Mal.types.MalFunc +Imports MalEnv = Mal.env.Env + +Namespace Mal + Class stepA_mal + ' read + Shared Function READ(str As String) As MalVal + Return reader.read_str(str) + End Function + + ' eval + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing + End Function + + Shared Function quasiquote(ast As MalVal) As MalVal + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then + return New MalList(New MalSymbol("quote"), ast) + End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result + End Function + + ' TODO: move to types.vb when it is ported + Class FClosure + Public ast As MalVal + Public params As MalList + Public env As MalEnv + Function fn(args as MalList) As MalVal + return EVAL(ast, new MalEnv(env, params, args)) + End Function + End Class + + Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal + Do + + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast + End If + + ' apply list + Dim ast As MalList = DirectCast(orig_ast, MalList) + + If ast.size() = 0 Then + return ast + End If + Dim a0 As MalVal = ast(0) + Dim a0sym As String + If TypeOf a0 is MalSymbol Then + a0sym = DirectCast(a0,MalSymbol).getName() + Else + a0sym = "__<*fn*>__" + End If + + Select a0sym + Case "def!" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim res As MalVal = EVAL(a2, env) + env.do_set(DirectCast(a1,MalSymbol), res) + return res + Case "let*" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim key As MalSymbol + Dim val as MalVal + Dim let_env As new MalEnv(env) + For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 + key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) + val = DirectCast(a1,MalList)(i+1) + let_env.do_set(key, EVAL(val, let_env)) + Next + orig_ast = a2 + env = let_env + Case "quote" + return ast(1) + Case "quasiquote" + orig_ast = quasiquote(ast(1)) + Case "defmacro!" + Dim a1 As MalVal = ast(1) + Dim a2 As MalVal = ast(2) + Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() + env.do_set(DirectCast(a1,MalSymbol), res) + return res + Case "try*" + Try + return EVAL(ast(1), env) + Catch e As Exception + If ast.size() > 2 Then + Dim exc As MalVal + Dim a2 As MalVal = ast(2) + Dim a20 As MalVal = DirectCast(a2,MalList)(0) + If DirectCast(a20,MalSymbol).getName() = "catch*" Then + If TypeOf e Is Mal.types.MalException Then + exc = DirectCast(e,Mal.types.MalException).getValue() + Else + exc = New MalString(e.Message) + End If + return EVAL( + DirectCast(a2,MalList)(2), + New MalEnv(env, + DirectCast(a2,MalList).slice(1,2), + New MalList(exc))) + End If + End If + Throw e + End Try + Case "do" + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next + orig_ast = ast(ast.size()-1) + Case "if" + Dim a1 As MalVal = ast(1) + Dim cond As MalVal = EVAL(a1, env) + If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then + ' eval false slot form + If ast.size() > 3 Then + orig_ast = ast(3) + Else + return Mal.types.Nil + End If + Else + ' eval true slot form + orig_ast = ast(2) + + End If + Case "fn*" + Dim fc As New FClosure() + fc.ast = ast(2) + fc.params = DirectCast(ast(1),MalLIst) + fc.env = env + Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn + Dim mf As new MalFunc(ast(2), env, + DirectCast(ast(1),MalList), f) + return DirectCast(mf,MalVal) + Case Else + Dim f As MalFunc = DirectCast(EVAL(a0, env), MalFunc) + If f.isMacro() Then + orig_ast = f.apply(ast.rest()) + Continue Do + End If + Dim args As MalList = New MalList + For i As Integer = 1 To ast.size()-1 + args.conj_BANG(EVAL(ast(i), env)) + Next + Dim fnast As MalVal = f.getAst() + If not fnast Is Nothing + orig_ast = fnast + env = f.genEnv(args) + Else + Return f.apply(args) + End If + End Select + + Loop While True + End Function + + ' print + Shared Function PRINT(exp As MalVal) As String + return printer._pr_str(exp, TRUE) + End Function + + ' repl + Shared repl_env As MalEnv + + Shared Function REP(str As String) As String + Return PRINT(EVAL(READ(str), repl_env)) + End Function + + Shared Function do_eval(args As MalList) As MalVal + Return EVAL(args(0), repl_env) + End Function + + Shared Function Main As Integer + Dim args As String() = Environment.GetCommandLineArgs() + + repl_env = New MalEnv(Nothing) + + ' core.vb: defined using VB.NET + For Each entry As KeyValuePair(Of String,MalVal) In core.ns() + repl_env.do_set(new MalSymbol(entry.Key), entry.Value) + Next + repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) + Dim fileIdx As Integer = 1 + If args.Length > 1 AndAlso args(1) = "--raw" Then + Mal.readline.SetMode(Mal.readline.Modes.Raw) + fileIdx = 2 + End If + Dim argv As New MalList() + For i As Integer = fileIdx+1 To args.Length-1 + argv.conj_BANG(new MalString(args(i))) + Next + repl_env.do_set(new MalSymbol("*ARGV*"), argv) + + ' core.mal: defined using the language itself + REP("(def! *host-language* ""VB.NET"")") + REP("(def! not (fn* (a) (if a false true)))") + REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") + REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") + + If args.Length > fileIdx Then + REP("(load-file """ & args(fileIdx) & """)") + return 0 + End If + + ' repl loop + Dim line As String + REP("(println (str ""Mal ["" *host-language* ""]""))") + Do + Try + line = Mal.readline.Readline("user> ") + If line is Nothing Then + Exit Do + End If + If line = "" Then + Continue Do + End If + Catch e As IOException + Console.WriteLine("IOException: " & e.Message) + End Try + Try + Console.WriteLine(REP(line)) + Catch e As Mal.types.MalException + Console.WriteLine("Error: " & _ + printer._pr_str(e.getValue(), False)) + Continue Do + Catch e As Exception + Console.WriteLine("Error: " & e.Message) + Console.WriteLine(e.StackTrace) + Continue Do + End Try + Loop While True + End function + End Class +End Namespace diff --git a/impls/vb/tests/step5_tco.mal b/impls/vb/tests/step5_tco.mal new file mode 100644 index 0000000000..3631fdf53f --- /dev/null +++ b/impls/vb/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; VB: skipping non-TCO recursion +;; Reason: unrecoverable segfault at 10,000 diff --git a/vb/types.vb b/impls/vb/types.vb similarity index 94% rename from vb/types.vb rename to impls/vb/types.vb index 4da75bdca4..c1b534e525 100644 --- a/vb/types.vb +++ b/impls/vb/types.vb @@ -6,7 +6,7 @@ Imports Mal namespace Mal Public Class types ' - ' Exceptiosn/Errors + ' Exceptions/Errors ' Public Class MalThrowable Inherits Exception @@ -76,6 +76,19 @@ namespace Mal End If Next return True + Else If TypeOf a Is MalHashMap Then + Dim ahm As Dictionary(Of String,MalVal) = DirectCast(a,MalHashMap).getValue() + Dim bhm As Dictionary(Of String,MalVal) = DirectCast(b,MalHashMap).getValue() + For Each key As String in ahm.keys + If not bhm.ContainsKey(key) Then + return False + End If + If not _equal_Q(DirectCast(a,MalHashMap).getValue()(key), + DirectCast(b,MalHashMap).getValue()(key)) + return False + End If + Next + return True Else return a Is b End If @@ -452,9 +465,11 @@ namespace Mal Public Function isMacro() As Boolean return macro End Function - Public Sub setMacro() - macro = true - End Sub + Public Function asMacro() As MalVal + Dim res As new MalFunc (ast, env, fparams, fn) + res.macro = true + return res + End Function End Class End Class End Namespace diff --git a/impls/vbs/Makefile b/impls/vbs/Makefile new file mode 100644 index 0000000000..b8722e6d92 --- /dev/null +++ b/impls/vbs/Makefile @@ -0,0 +1,4 @@ +all: + true + +clean: diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs new file mode 100644 index 0000000000..3091398c08 --- /dev/null +++ b/impls/vbs/core.vbs @@ -0,0 +1,866 @@ +Option Explicit + +Sub CheckArgNum(objArgs, lngArgNum) + If objArgs.Count - 1 <> lngArgNum Then + Err.Raise vbObjectError, _ + "CheckArgNum", "Wrong number of arguments." + End IF +End Sub + +Sub CheckType(objMal, varType) + If objMal.Type <> varType Then + Err.Raise vbObjectError, _ + "CheckType", "Wrong argument type." + End IF +End Sub + +Function IsListOrVec(objMal) + IsListOrVec = _ + objMal.Type = TYPES.LIST Or _ + objMal.Type = TYPES.VECTOR +End Function + +Sub CheckListOrVec(objMal) + If Not IsListOrVec(objMal) Then + Err.Raise vbObjectError, _ + "CheckListOrVec", _ + "Wrong argument type, need a list or a vector." + End If +End Sub + +Dim objNS +Set objNS = NewEnv(Nothing) + +Function MAdd(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MAdd = NewMalNum( _ + objArgs.Item(1).Value + objArgs.Item(2).Value) +End Function +objNS.Add "+", NewVbsProc("MAdd", False) + +Function MSub(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MSub = NewMalNum( _ + objArgs.Item(1).Value - objArgs.Item(2).Value) +End Function +objNS.Add "-", NewVbsProc("MSub", False) + +Function MMul(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MMul = NewMalNum( _ + objArgs.Item(1).Value * objArgs.Item(2).Value) +End Function +objNS.Add "*", NewVbsProc("MMul", False) + +Function MDiv(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MDiv = NewMalNum( _ + objArgs.Item(1).Value \ objArgs.Item(2).Value) +End Function +objNS.Add "/", NewVbsProc("MDiv", False) + +Function MList(objArgs, objEnv) + Dim varRet + Set varRet = NewMalList(Array()) + Dim i + For i = 1 To objArgs.Count - 1 + varRet.Add objArgs.Item(i) + Next + Set MList = varRet +End Function +objNS.Add "list", NewVbsProc("MList", False) + +Function MIsList(objArgs, objEnv) + CheckArgNum objArgs, 1 + + Set MIsList = NewMalBool(objArgs.Item(1).Type = TYPES.LIST) +End Function +objNS.Add "list?", NewVbsProc("MIsList", False) + +Function MIsEmpty(objArgs, objEnv) + CheckArgNum objArgs, 1 + CheckListOrVec objArgs.Item(1) + + Set MIsEmpty = NewMalBool(objArgs.Item(1).Count = 0) +End Function +objNS.Add "empty?", NewVbsProc("MIsEmpty", False) + +Function MCount(objArgs, objEnv) + CheckArgNum objArgs, 1 + If objArgs.Item(1).Type = TYPES.NIL Then + Set MCount = NewMalNum(0) + Else + CheckListOrVec objArgs.Item(1) + Set MCount = NewMalNum(objArgs.Item(1).Count) + End If +End Function +objNS.Add "count", NewVbsProc("MCount", False) + +Function MEqual(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim boolResult, i + If IsListOrVec(objArgs.Item(1)) And _ + IsListOrVec(objArgs.Item(2)) Then + If objArgs.Item(1).Count <> objArgs.Item(2).Count Then + Set varRet = NewMalBool(False) + Else + boolResult = True + For i = 0 To objArgs.Item(1).Count - 1 + boolResult = boolResult And _ + MEqual(NewMalList(Array(Nothing, _ + objArgs.Item(1).Item(i), _ + objArgs.Item(2).Item(i))), objEnv).Value + Next + Set varRet = NewMalBool(boolResult) + End If + Else + If objArgs.Item(1).Type <> objArgs.Item(2).Type Then + Set varRet = NewMalBool(False) + Else + Select Case objArgs.Item(1).Type + Case TYPES.HASHMAP + 'Err.Raise vbObjectError, _ + ' "MEqual", "Not implement yet~" + If UBound(objArgs.Item(1).Keys) <> UBound(objArgs.Item(2).Keys) Then + Set varRet = NewMalBool(False) + Set MEqual = varRet + Exit Function + End If + + boolResult = True + For Each i In objArgs.Item(1).Keys + If Not objArgs.Item(2).Exists(i) Then + Set varRet = NewMalBool(False) + Set MEqual = varRet + Exit Function + End If + + boolResult = boolResult And _ + MEqual(NewMalList(Array(Nothing, objArgs.Item(1).Item(i), objArgs.Item(2).Item(i))), objEnv).Value + Next + Set varRet = NewMalBool(boolResult) + + Case Else + Set varRet = NewMalBool( _ + objArgs.Item(1).Value = objArgs.Item(2).Value) + End Select + End If + End If + + Set MEqual = varRet +End Function +objNS.Add "=", NewVbsProc("MEqual", False) + +Function MGreater(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set varRet = NewMalBool( _ + objArgs.Item(1).Value > objArgs.Item(2).Value) + Set MGreater = varRet +End Function +objNS.Add ">", NewVbsProc("MGreater", False) + +Function MPrStr(objArgs, objEnv) + Dim varRet + Dim strRet + strRet = "" + Dim i + If objArgs.Count - 1 >= 1 Then + strRet = PrintMalType(objArgs.Item(1), True) + End If + For i = 2 To objArgs.Count - 1 + strRet = strRet + " " + _ + PrintMalType(objArgs.Item(i), True) + Next + Set varRet = NewMalStr(strRet) + Set MPrStr = varRet +End Function +objNS.Add "pr-str", NewVbsProc("MPrStr", False) + +Function MStr(objArgs, objEnv) + Dim varRet + Dim strRet + strRet = "" + Dim i + For i = 1 To objArgs.Count - 1 + strRet = strRet + _ + PrintMalType(objArgs.Item(i), False) + Next + Set varRet = NewMalStr(strRet) + Set MStr = varRet +End Function +objNS.Add "str", NewVbsProc("MStr", False) + +Function MPrn(objArgs, objEnv) + Dim varRet + Dim objStr + Set objStr = MPrStr(objArgs, objEnv) + IO.WriteLine objStr.Value + Set varRet = NewMalNil() + Set MPrn = varRet +End Function +objNS.Add "prn", NewVbsProc("MPrn", False) + +Function MPrintln(objArgs, objEnv) + Dim varRet + Dim strRes + strRes = "" + Dim i + If objArgs.Count - 1 >= 1 Then + strRes = PrintMalType(objArgs.Item(1), False) + End If + For i = 2 To objArgs.Count - 1 + strRes = strRes + " " + _ + PrintMalType(objArgs.Item(i), False) + Next + IO.WriteLine strRes + Set varRet = NewMalNil() + Set MPrintln = varRet +End Function +objNS.Add "println", NewVbsProc("MPrintln", False) + +Sub InitBuiltIn() + REP "(def! not (fn* [bool] (if bool false true)))" + REP "(def! <= (fn* [a b] (not (> a b))))" + REP "(def! < (fn* [a b] (> b a)))" + REP "(def! >= (fn* [a b] (not (> b a))))" + REP "(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" + REP "(def! cons (fn* [a b] (concat (list a) b)))" + REP "(def! nil? (fn* [x] (= x nil)))" + REP "(def! true? (fn* [x] (= x true)))" + REP "(def! false? (fn* [x] (= x false)))" + REP "(def! vector (fn* [& args] (vec args)))" + REP "(def! vals (fn* [hmap] (map (fn* [key] (get hmap key)) (keys hmap))))" + REP "(def! *host-language* ""VBScript"")" +End Sub + +Function MReadStr(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + CheckType objArgs.Item(1), TYPES.STRING + + Set varRes = ReadString(objArgs.Item(1).Value) + If TypeName(varRes) = "Nothing" Then + Set varRes = NewMalNil() + End If + Set MReadStr = varRes +End Function +objNS.Add "read-string", NewVbsProc("MReadStr", False) + +Function MSlurp(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + CheckType objArgs.Item(1), TYPES.STRING + + Dim strRes + With CreateObject("Scripting.FileSystemObject") + strRes = .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & objArgs.Item(1).Value).ReadAll + End With + + Set varRes = NewMalStr(strRes) + Set MSlurp = varRes +End Function +objNS.Add "slurp", NewVbsProc("MSlurp", False) + +Function MAtom(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = NewMalAtom(objArgs.Item(1)) + Set MAtom = varRes +End Function +objNS.Add "atom", NewVbsProc("MAtom", False) + +Function MIsAtom(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.ATOM) + Set MIsAtom = varRes +End Function +objNS.Add "atom?", NewVbsProc("MIsAtom", False) + +Function MDeref(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + CheckType objArgs.Item(1), TYPES.ATOM + + Set varRes = objArgs.Item(1).Value + Set MDeref = varRes +End Function +objNS.Add "deref", NewVbsProc("MDeref", False) + +Function MReset(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.ATOM + + objArgs.Item(1).Reset objArgs.Item(2) + Set varRes = objArgs.Item(2) + Set MReset = varRes +End Function +objNS.Add "reset!", NewVbsProc("MReset", False) + +Function MSwap(objArgs, objEnv) + Dim varRes + If objArgs.Count - 1 < 2 Then + Err.Raise vbObjectError, _ + "MSwap", "Need more arguments." + End If + + Dim objAtom, objFn + Set objAtom = objArgs.Item(1) + CheckType objAtom, TYPES.ATOM + Set objFn = objArgs.Item(2) + CheckType objFn, TYPES.PROCEDURE + + Dim objProg + Set objProg = NewMalList(Array(objFn)) + objProg.Add objAtom.Value + Dim i + For i = 3 To objArgs.Count - 1 + objProg.Add objArgs.Item(i) + Next + + objAtom.Reset objFn.ApplyWithoutEval(objProg, objEnv) + Set varRes = objAtom.Value + Set MSwap = varRes +End Function +objNS.Add "swap!", NewVbsProc("MSwap", False) + +Function MConcat(objArgs, objEnv) + Dim varRes + Dim i, j + Set varRes = NewMalList(Array()) + For i = 1 To objArgs.Count - 1 + If Not IsListOrVec(objArgs.Item(i)) Then + Err.Raise vbObjectError, _ + "MConcat", "Invaild argument(s)." + End If + + For j = 0 To objArgs.Item(i).Count - 1 + varRes.Add objArgs.Item(i).Item(j) + Next + Next + Set MConcat = varRes +End Function +objNS.Add "concat", NewVbsProc("MConcat", False) + +Function MVec(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + CheckListOrVec objArgs.Item(1) + Set varRes = NewMalVec(Array()) + Dim i + For i = 0 To objArgs.Item(1).Count - 1 + varRes.Add objArgs.Item(1).Item(i) + Next + Set MVec = varRes +End Function +objNS.Add "vec", NewVbsProc("MVec", False) + +Function MNth(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 2 + CheckListOrVec objArgs.Item(1) + CheckType objArgs.Item(2), TYPES.NUMBER + + If objArgs.Item(2).Value < objArgs.Item(1).Count Then + Set varRes = objArgs.Item(1).Item(objArgs.Item(2).Value) + Else + Err.Raise vbObjectError, _ + "MNth", "Index out of bounds." + End If + + Set MNth = varRes +End Function +objNS.Add "nth", NewVbsProc("MNth", False) + +Function MFirst(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + If objArgs.Item(1).Type = TYPES.NIL Then + Set varRes = NewMalNil() + Set MFirst = varRes + Exit Function + End If + + CheckListOrVec objArgs.Item(1) + + If objArgs.Item(1).Count < 1 Then + Set varRes = NewMalNil() + Else + Set varRes = objArgs.Item(1).Item(0) + End If + + Set MFirst = varRes +End Function +objNS.Add "first", NewVbsProc("MFirst", False) + +Function MRest(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + If objArgs.Item(1).Type = TYPES.NIL Then + Set varRes = NewMalList(Array()) + Set MRest = varRes + Exit Function + End If + + Dim objList + Set objList = objArgs.Item(1) + CheckListOrVec objList + + Set varRes = NewMalList(Array()) + Dim i + For i = 1 To objList.Count - 1 + varRes.Add objList.Item(i) + Next + + Set MRest = varRes +End Function +objNS.Add "rest", NewVbsProc("MRest", False) + +Sub InitMacro() + REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons'cond (rest (rest xs)))))))" + 'REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" + REP "(def! *gensym-counter* (atom 0))" + REP "(def! gensym (fn* [] (symbol (str ""G__"" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" + REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" +End Sub + +Class MalException + Private objDict + Private Sub Class_Initialize + Set objDict = CreateObject("Scripting.Dictionary") + End Sub + + Public Sub Add(varKey, varValue) + objDict.Add varKey, varValue + End Sub + + Public Function Item(varKey) + Set Item = objDict.Item(varKey) + End Function + + Public Sub Remove(varKey) + objDict.Remove varKey + End Sub +End Class + +Dim objExceptions +Set objExceptions = New MalException + +Function MThrow(objArgs, objEnv) + CheckArgNum objArgs, 1 + Dim strRnd + strRnd = CStr(Rnd()) + objExceptions.Add strRnd, objArgs.Item(1) + Err.Raise vbObjectError, _ + "MThrow", strRnd +End Function +objNS.Add "throw", NewVbsProc("MThrow", False) + +Function MApply(objArgs, objEnv) + Dim varRes + If objArgs.Count - 1 < 2 Then + Err.Raise vbObjectError, _ + "MApply", "Need more arguments." + End If + + Dim objFn + Set objFn = objArgs.Item(1) + CheckType objFn, TYPES.PROCEDURE + ' If objFn.IsSpecial Or objFn.IsMacro Then + ' Err.Raise vbObjectError, _ + ' "MApply", "Need a function." + ' End If + + Dim objAST + Set objAST = NewMalList(Array(objFn)) + Dim i + For i = 2 To objArgs.Count - 2 + objAST.Add objArgs.Item(i) + Next + + Dim objSeq + Set objSeq = objArgs.Item(objArgs.Count - 1) + CheckListOrVec objSeq + + For i = 0 To objSeq.Count - 1 + objAST.Add objSeq.Item(i) + Next + + Set varRes = objFn.ApplyWithoutEval(objAST, objEnv) + Set MApply = varRes +End Function +objNS.Add "apply", NewVbsProc("MApply", False) + +Function MMap(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 2 + Dim objFn, objSeq + Set objFn = objArgs.Item(1) + Set objSeq = objArgs.Item(2) + CheckType objFn, TYPES.PROCEDURE + CheckListOrVec objSeq + If objFn.IsSpecial Or objFn.IsMacro Then + Err.Raise vbObjectError, _ + "MApply", "Need a function." + End If + + Set varRes = NewMalList(Array()) + Dim i + For i = 0 To objSeq.Count - 1 + varRes.Add objFn.ApplyWithoutEval(NewMalList(Array( _ + objFn, objSeq.Item(i))), objEnv) + Next + + Set MMap = varRes +End Function +objNS.Add "map", NewVbsProc("MMap", False) + +Function MIsSymbol(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.SYMBOL) + Set MIsSymbol = varRes +End Function +objNS.Add "symbol?", NewVbsProc("MIsSymbol", False) + +Function MSymbol(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + CheckType objArgs.Item(1), TYPES.STRING + Set varRes = NewMalSym(objArgs.Item(1).Value) + Set MSymbol = varRes +End Function +objNS.Add "symbol", NewVbsProc("MSymbol", False) + +Function MKeyword(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + Select Case objArgs.Item(1).Type + Case TYPES.STRING + Set varRes = NewMalKwd(":" + objArgs.Item(1).Value) + Case TYPES.KEYWORD + Set varRes = objArgs.Item(1) + Case Else + Err.Raise vbObjectError, _ + "MKeyword", "Unexpect argument(s)." + End Select + Set MKeyword = varRes +End Function +objNS.Add "keyword", NewVbsProc("MKeyword", False) + +Function MIsKeyword(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.KEYWORD) + Set MIsKeyword = varRes +End Function +objNS.Add "keyword?", NewVbsProc("MIsKeyword", False) + +Function MIsSeq(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + Set varRes = NewMalBool( _ + objArgs.Item(1).Type = TYPES.LIST Or _ + objArgs.Item(1).Type = TYPES.VECTOR) + Set MIsSeq = varRes +End Function +objNS.Add "sequential?", NewVbsProc("MIsSeq", False) + +Function MIsVec(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.VECTOR) + Set MIsVec = varRes +End Function +objNS.Add "vector?", NewVbsProc("MIsVec", False) + +Function MIsMap(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.HASHMAP) + Set MIsMap = varRes +End Function +objNS.Add "map?", NewVbsProc("MIsMap", False) + +Function MHashMap(objArgs, objEnv) + Dim varRes + If objArgs.Count Mod 2 <> 1 Then + Err.Raise vbObjectError, _ + "MHashMap", "Unexpect argument(s)." + End If + Set varRes = NewMalMap(Array(), Array()) + Dim i + For i = 1 To objArgs.Count - 1 Step 2 + varRes.Add objArgs.Item(i), objArgs.Item(i + 1) + Next + Set MHashMap = varRes +End Function +objNS.Add "hash-map", NewVbsProc("MHashMap", False) + +Function MAssoc(objArgs, objEnv) + Dim varRes + If objArgs.Count - 1 < 3 Or objArgs.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MHashMap", "Unexpect argument(s)." + End If + + Dim objMap + Set objMap = objArgs.Item(1) + CheckType objMap, TYPES.HASHMAP + + Dim i + Set varRes = NewMalMap(Array(), Array()) + For Each i In objMap.Keys + varRes.Add i, objMap.Item(i) + Next + For i = 2 To objArgs.Count - 1 Step 2 + varRes.Add objArgs.Item(i), objArgs.Item(i + 1) + Next + Set MAssoc = varRes +End Function +objNS.Add "assoc", NewVbsProc("MAssoc", False) + +Function MGet(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 2 + + If objArgs.Item(1).Type = TYPES.NIL Then + Set varRes = NewMalNil() + Else + CheckType objArgs.Item(1), TYPES.HASHMAP + If objArgs.Item(1).Exists(objArgs.Item(2)) Then + Set varRes = objArgs.Item(1).Item(objArgs.Item(2)) + Else + Set varRes = NewMalNil() + End If + End If + + Set MGet = varRes +End Function +objNS.Add "get", NewVbsProc("MGet", False) + +Function MDissoc(objArgs, objEnv) + Dim varRes + 'CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.HASHMAP + + If objArgs.Item(1).Exists(objArgs.Item(2)) Then + Set varRes = NewMalMap(Array(), Array()) + + Dim i + Dim j, boolFlag + For Each i In objArgs.Item(1).Keys + boolFlag = True + For j = 2 To objArgs.Count - 1 + If i.Type = objArgs.Item(j).Type And _ + i.Value = objArgs.Item(j).Value Then + boolFlag = False + End If + Next + If boolFlag Then + varRes.Add i, objArgs.Item(1).Item(i) + End If + Next + Else + Set varRes = objArgs.Item(1) + End If + + Set MDissoc = varRes +End Function +objNS.Add "dissoc", NewVbsProc("MDissoc", False) + +Function MKeys(objArgs, objEnv) + CheckArgNum objArgs, 1 + CheckType objArgs.Item(1), TYPES.HASHMAP + Set MKeys = NewMalList(objArgs.Item(1).Keys) +End Function +objNS.Add "keys", NewVbsProc("MKeys", False) + +Function MIsContains(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.HASHMAP + + Set MIsContains = NewMalBool(objArgs.Item(1).Exists(objArgs.Item(2))) +End Function +objNS.Add "contains?", NewVbsProc("MIsContains", False) + +Function MReadLine(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + CheckType objArgs.Item(1), TYPES.STRING + + Dim strInput + IO.Write objArgs.Item(1).Value + On Error Resume Next + strInput = IO.ReadLine + If Err.Number <> 0 Then + Set varRes = NewMalNil() + Else + Set varRes = NewMalStr(strInput) + End If + On Error Goto 0 + Set MReadLine = varRes +End Function +objNS.Add "readline", NewVbsProc("MReadLine", False) + +Function MTimeMs(objArgs, objEnv) + Set MTimeMs = NewMalNum(CLng(Timer * 1000)) +End Function +objNS.Add "time-ms", NewVbsProc("MTimeMs", False) + +Function MIsStr(objArgs, objEnv) + CheckArgNum objArgs, 1 + Set MIsStr = NewMalBool(objArgs.Item(1).Type = TYPES.STRING) +End Function +objNS.Add "string?", NewVbsProc("MIsStr", False) + +Function MIsNum(objArgs, objEnv) + CheckArgNum objArgs, 1 + Set MIsNum = NewMalBool(objArgs.Item(1).Type = TYPES.NUMBER) +End Function +objNS.Add "number?", NewVbsProc("MIsNum", False) + +Function MIsFn(objArgs, objEnv) + CheckArgNum objArgs, 1 + Dim varRes + varRes = objArgs.Item(1).Type = TYPES.PROCEDURE + If varRes Then + varRes = (Not objArgs.Item(1).IsMacro) And _ + (Not objArgs.Item(1).IsSpecial) + End If + + Set MIsFn = NewMalBool(varRes) +End Function +objNS.Add "fn?", NewVbsProc("MIsFn", False) + + +Function MIsMacro(objArgs, objEnv) + CheckArgNum objArgs, 1 + Dim varRes + varRes = objArgs.Item(1).Type = TYPES.PROCEDURE + If varRes Then + varRes = objArgs.Item(1).IsMacro And _ + (Not objArgs.Item(1).IsSpecial) + End If + + Set MIsMacro = NewMalBool(varRes) +End Function +objNS.Add "macro?", NewVbsProc("MIsMacro", False) + + +Function MMeta(objArgs, objEnv) + CheckArgNum objArgs, 1 + 'CheckType objArgs.Item(1), TYPES.PROCEDURE + + Dim varRes + Set varRes = GetMeta(objArgs.Item(1)) + Set MMeta = varRes +End Function +objNS.Add "meta", NewVbsProc("MMeta", False) + +Function MWithMeta(objArgs, objEnv) + CheckArgNum objArgs, 2 + 'CheckType objArgs.Item(1), TYPES.PROCEDURE + + Dim varRes + Set varRes = SetMeta(objArgs.Item(1), objArgs.Item(2)) + Set MWithMeta = varRes +End Function +objNS.Add "with-meta", NewVbsProc("MWithMeta", False) + +Function MConj(objArgs, objEnv) + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MConj", "Need more arguments." + End If + Dim varRes + Dim objSeq + Set objSeq = objArgs.Item(1) + Dim i + Select Case objSeq.Type + Case TYPES.LIST + Set varRes = NewMalList(Array()) + For i = objArgs.Count - 1 To 2 Step -1 + varRes.Add objArgs.Item(i) + Next + For i = 0 To objSeq.Count - 1 + varRes.Add objSeq.Item(i) + Next + Case TYPES.VECTOR + Set varRes = NewMalVec(Array()) + For i = 0 To objSeq.Count - 1 + varRes.Add objSeq.Item(i) + Next + For i = 2 To objArgs.Count - 1 + varRes.Add objArgs.Item(i) + Next + Case Else + Err.Raise vbObjectError, _ + "MConj", "Unexpect argument type." + End Select + Set MConj = varRes +End Function +objNS.Add "conj", NewVbsProc("MConj", False) + +Function MSeq(objArgs, objEnv) + CheckArgNum objArgs, 1 + Dim objSeq + Set objSeq = objArgs.Item(1) + Dim varRes + Dim i + Select Case objSeq.Type + Case TYPES.STRING + If objSeq.Value = "" Then + Set varRes = NewMalNil() + Else + Set varRes = NewMalList(Array()) + For i = 1 To Len(objSeq.Value) + varRes.Add NewMalStr(Mid(objSeq.Value, i, 1)) + Next + End If + Case TYPES.LIST + If objSeq.Count = 0 Then + Set varRes = NewMalNil() + Else + Set varRes = objSeq + End If + Case TYPES.VECTOR + If objSeq.Count = 0 Then + Set varRes = NewMalNil() + Else + Set varRes = NewMalList(Array()) + For i = 0 To objSeq.Count - 1 + varRes.Add objSeq.Item(i) + Next + End If + Case TYPES.NIL + Set varRes = NewMalNil() + Case Else + Err.Raise vbObjectError, _ + "MSeq", "Unexpect argument type." + End Select + Set MSeq = varRes +End Function +objNS.Add "seq", NewVbsProc("MSeq", False) + diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs new file mode 100644 index 0000000000..f5669a6724 --- /dev/null +++ b/impls/vbs/env.vbs @@ -0,0 +1,41 @@ +Option Explicit + +Function NewEnv(objOuter) + Set NewEnv = New Environment + Set NewEnv.Outer = objOuter +End Function + +Class Environment + Public objOuter + Public objBinds + Private Sub Class_Initialize() + Set objBinds = CreateObject("Scripting.Dictionary") + Set objOuter = Nothing + End Sub + + Public Property Set Outer(objEnv) + Set objOuter = objEnv + End Property + + Public Sub Add(varKey, varValue) + Set objBinds.Item(varKey) = varValue + End Sub + + Public Function [Get](varKey) + Dim objEnv, varRet + Set objEnv = Me + Do + If objEnv.objBinds.Exists(varKey) Then + Set varRet = objEnv.objBinds(varKey) + Exit Do + End If + Set objEnv = objEnv.objOuter + If TypeName(objEnv) = "Nothing" Then + Set varRet = Nothing + Exit Do + End If + Loop + + Set [Get] = varRet + End Function +End Class \ No newline at end of file diff --git a/impls/vbs/install.vbs b/impls/vbs/install.vbs new file mode 100644 index 0000000000..ca97f52901 --- /dev/null +++ b/impls/vbs/install.vbs @@ -0,0 +1,2 @@ +On Error Resume Next +CreateObject("System.Collections.ArrayList") \ No newline at end of file diff --git a/impls/vbs/io.vbs b/impls/vbs/io.vbs new file mode 100644 index 0000000000..0df1fafa75 --- /dev/null +++ b/impls/vbs/io.vbs @@ -0,0 +1,47 @@ +Option Explicit + +Class IOWrap + Public NoStdErr + Public EchoStdIn + + Private Sub Class_Initialize + With WScript.CreateObject("WScript.Shell") + NoStdErr = .ExpandEnvironmentStrings("%MAL_VBS_IMPL_NO_STDERR%") <> "%MAL_VBS_IMPL_NO_STDERR%" + EchoStdIn = .ExpandEnvironmentStrings("%MAL_VBS_IMPL_ECHO_STDIN%") <> "%MAL_VBS_IMPL_ECHO_STDIN%" + End With + End Sub + + Public Sub Write(sText) + WScript.StdOut.Write sText + End Sub + + Public Sub WriteLine(sText) + WScript.StdOut.WriteLine sText + End Sub + + Public Function ReadLine() + ReadLine = WScript.StdIn.ReadLine + If EchoStdIn Then + WScript.StdOut.WriteLine ReadLine + End If + End Function + + Public Sub WriteErr(sText) + If Not NoStdErr Then + WScript.StdErr.Write sText + Else ' Redirect to StdOut + WScript.StdOut.Write sText + End If + End Sub + + Public Sub WriteErrLine(sText) + If Not NoStdErr Then + WScript.StdErr.WriteLine sText + Else ' Redirect to StdOut + WScript.StdOut.WriteLine sText + End If + End Sub +End Class + +Dim IO +Set IO = New IOWrap \ No newline at end of file diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs new file mode 100644 index 0000000000..0208232f29 --- /dev/null +++ b/impls/vbs/printer.vbs @@ -0,0 +1,95 @@ +Option Explicit + +Function PrintMalType(objMal, boolReadable) + Dim varResult + + varResult = "" + + If TypeName(objMal) = "Nothing" Then + PrintMalType = "" + Exit Function + End If + + Dim i + Select Case objMal.Type + Case TYPES.LIST + With objMal + For i = 0 To .Count - 2 + varResult = varResult & _ + PrintMalType(.Item(i), boolReadable) & " " + Next + If .Count > 0 Then + varResult = varResult & _ + PrintMalType(.Item(.Count - 1), boolReadable) + End If + End With + varResult = "(" & varResult & ")" + Case TYPES.VECTOR + With objMal + For i = 0 To .Count - 2 + varResult = varResult & _ + PrintMalType(.Item(i), boolReadable) & " " + Next + If .Count > 0 Then + varResult = varResult & _ + PrintMalType(.Item(.Count - 1), boolReadable) + End If + End With + varResult = "[" & varResult & "]" + Case TYPES.HASHMAP + With objMal + Dim arrKeys + arrKeys = .Keys + For i = 0 To .Count - 2 + varResult = varResult & _ + PrintMalType(arrKeys(i), boolReadable) & " " & _ + PrintMalType(.Item(arrKeys(i)), boolReadable) & " " + Next + If .Count > 0 Then + varResult = varResult & _ + PrintMalType(arrKeys(.Count - 1), boolReadable) & " " & _ + PrintMalType(.Item(arrKeys(.Count - 1)), boolReadable) + End If + End With + varResult = "{" & varResult & "}" + Case TYPES.STRING + If boolReadable Then + varResult = EscapeString(objMal.Value) + Else + varResult = objMal.Value + End If + Case TYPES.BOOLEAN + If objMal.Value Then + varResult = "true" + Else + varResult = "false" + End If + Case TYPES.NIL + varResult = "nil" + Case TYPES.NUMBER + varResult = CStr(objMal.Value) + Case TYPES.PROCEDURE + varResult = "#" + Case TYPES.KEYWORD + varResult = objMal.Value + Case TYPES.SYMBOL + varResult = objMal.Value + Case TYPES.ATOM + varResult = "(atom " + PrintMalType(objMal.Value, boolReadable) + ")" + Case Else + Err.Raise vbObjectError, _ + "PrintMalType", "Unknown type." + End Select + + PrintMalType = varResult +End Function + +Function EscapeString(strRaw) + EscapeString = strRaw + EscapeString = Replace(EscapeString, "\", "\\") + EscapeString = Replace(EscapeString, vbCrLf, vbLf) + EscapeString = Replace(EscapeString, vbCr, vbLf) + EscapeString = Replace(EscapeString, vbLf, "\n") + EscapeString = Replace(EscapeString, """", "\""") + EscapeString = """" & EscapeString & """" +End Function diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs new file mode 100644 index 0000000000..7c6c9dfcb2 --- /dev/null +++ b/impls/vbs/reader.vbs @@ -0,0 +1,287 @@ +Option Explicit + +Function ReadString(strCode) + Dim objTokens + Set objTokens = Tokenize(strCode) + Set ReadString = ReadForm(objTokens) + If Not objTokens.AtEnd() Then + Err.Raise vbObjectError, _ + "ReadForm", "extra token '" + objTokens.Current() + "'." + End If +End Function + +Class Tokens + Private objQueue + Private objRE + + Private Sub Class_Initialize + Set objRE = New RegExp + With objRE + .Pattern = "[\s,]*" + _ + "(" + _ + "~@" + "|" + _ + "[\[\]{}()'`~^@]" + "|" + _ + """(?:\\.|[^\\""])*""?" + "|" + _ + ";.*" + "|" + _ + "[^\s\[\]{}('""`,;)]*" + _ + ")" + .IgnoreCase = True + .Global = True + End With + + Set objQueue = CreateObject("System.Collections.Queue") + End Sub + + Public Function Init(strCode) + Dim objMatches, objMatch + Set objMatches = objRE.Execute(strCode) + Dim strToken + For Each objMatch In objMatches + strToken = Trim(objMatch.SubMatches(0)) + If Not (Left(strToken, 1) = ";" Or strToken = "") Then + objQueue.Enqueue strToken + End If + Next + End Function + + Public Function Current() + Current = objQueue.Peek() + End Function + + Public Function MoveToNext() + MoveToNext = objQueue.Dequeue() + End Function + + Public Function AtEnd() + AtEnd = (objQueue.Count = 0) + End Function + + Public Function Count() + Count = objQueue.Count + End Function +End Class + +Function Tokenize(strCode) ' Return objTokens + Dim varResult + Set varResult = New Tokens + varResult.Init strCode + Set Tokenize = varResult +End Function + +Function ReadForm(objTokens) ' Return Nothing / MalType + If objTokens.AtEnd() Then + Set ReadForm = Nothing + Exit Function + End If + + Dim strToken + strToken = objTokens.Current() + + Dim varResult + If InStr("([{", strToken) Then + Select Case strToken + Case "(" + Set varResult = ReadList(objTokens) + Case "[" + Set varResult = ReadVector(objTokens) + Case "{" + Set varResult = ReadHashmap(objTokens) + End Select + ElseIf InStr("'`~@", strToken) Then + Set varResult = ReadSpecial(objTokens) + ElseIf InStr(")]}", strToken) Then + Err.Raise vbObjectError, _ + "ReadForm", "unbalanced parentheses." + ElseIf strToken = "^" Then + Set varResult = ReadMetadata(objTokens) + Else + Set varResult = ReadAtom(objTokens) + End If + + Set ReadForm = varResult +End Function + +Function ReadMetadata(objTokens) + Dim varResult + + Call objTokens.MoveToNext() + Dim objTemp + Set objTemp = ReadForm(objTokens) + Set varResult = NewMalList(Array( _ + NewMalSym("with-meta"), _ + ReadForm(objTokens), objTemp)) + + Set ReadMetadata = varResult +End Function + +Function ReadSpecial(objTokens) + Dim varResult + + Dim strToken, strAlias + strToken = objTokens.Current() + Select Case strToken + Case "'" + strAlias = "quote" + Case "`" + strAlias = "quasiquote" + Case "~" + strAlias = "unquote" + Case "~@" + strAlias = "splice-unquote" + Case "@" + strAlias = "deref" + Case Else + Err.Raise vbObjectError, _ + "ReadSpecial", "unknown token '" & strAlias & "'." + End Select + + Call objTokens.MoveToNext() + Set varResult = NewMalList(Array( _ + NewMalSym(strAlias), _ + ReadForm(objTokens))) + + Set ReadSpecial = varResult +End Function + +Function ReadList(objTokens) + Dim varResult + Call objTokens.MoveToNext() + + If objTokens.AtEnd() Then + Err.Raise vbObjectError, _ + "ReadList", "unbalanced parentheses." + End If + + Set varResult = NewMalList(Array()) + With varResult + While objTokens.Count() > 1 And objTokens.Current() <> ")" + .Add ReadForm(objTokens) + Wend + End With + + If objTokens.MoveToNext() <> ")" Then + Err.Raise vbObjectError, _ + "ReadList", "unbalanced parentheses." + End If + + Set ReadList = varResult +End Function + +Function ReadVector(objTokens) + Dim varResult + Call objTokens.MoveToNext() + + If objTokens.AtEnd() Then + Err.Raise vbObjectError, _ + "ReadVector", "unbalanced parentheses." + End If + + Set varResult = NewMalVec(Array()) + With varResult + While objTokens.Count() > 1 And objTokens.Current() <> "]" + .Add ReadForm(objTokens) + Wend + End With + + If objTokens.MoveToNext() <> "]" Then + Err.Raise vbObjectError, _ + "ReadVector", "unbalanced parentheses." + End If + + Set ReadVector = varResult +End Function + +Function ReadHashmap(objTokens) + Dim varResult + Call objTokens.MoveToNext() + + If objTokens.Count = 0 Then + Err.Raise vbObjectError, _ + "ReadHashmap", "unbalanced parentheses." + End If + + Set varResult = NewMalMap(Array(), Array()) + Dim objKey, objValue + With varResult + While objTokens.Count > 2 And objTokens.Current() <> "}" + Set objKey = ReadForm(objTokens) + Set objValue = ReadForm(objTokens) + .Add objKey, objValue + Wend + End With + + If objTokens.MoveToNext() <> "}" Then + Err.Raise vbObjectError, _ + "ReadHashmap", "unbalanced parentheses." + End If + + Set ReadHashmap = varResult +End Function + +Function ReadAtom(objTokens) + Dim varResult + + Dim strAtom + strAtom = objTokens.MoveToNext() + + Select Case strAtom + Case "true" + Set varResult = NewMalBool(True) + Case "false" + Set varResult = NewMalBool(False) + Case "nil" + Set varResult = NewMalNil() + Case Else + Select Case Left(strAtom, 1) + Case ":" + Set varResult = NewMalKwd(strAtom) + Case """" + Set varResult = NewMalStr(ParseString(strAtom)) + Case Else + If IsNumeric(strAtom) Then + Set varResult = NewMalNum(Eval(strAtom)) + Else + Set varResult = NewMalSym(strAtom) + End If + End Select + End Select + + Set ReadAtom = varResult +End Function + +Function ParseString(strRaw) + If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then + Err.Raise vbObjectError, _ + "ParseString", "unterminated string, got EOF." + End If + + Dim strTemp + strTemp = Mid(strRaw, 2, Len(strRaw) - 2) + Dim i + i = 1 + ParseString = "" + While i <= Len(strTemp) - 1 + Select Case Mid(strTemp, i, 2) + Case "\\" + ParseString = ParseString & "\" + Case "\n" + ParseString = ParseString & vbCrLf + Case "\""" + ParseString = ParseString & """" + Case Else + ParseString = ParseString & Mid(strTemp, i, 1) + i = i - 1 + End Select + i = i + 2 + Wend + + If i <= Len(strTemp) Then + ' Last char is not processed. + If Right(strTemp, 1) <> "\" Then + ParseString = ParseString & Right(strTemp, 1) + Else + Err.Raise vbObjectError, _ + "ParseString", "unterminated string, got EOF." + End If + End If +End Function diff --git a/impls/vbs/run b/impls/vbs/run new file mode 100644 index 0000000000..3c1aed2dd3 --- /dev/null +++ b/impls/vbs/run @@ -0,0 +1,4 @@ +#!/usr/bin/env bash +MAL_VBS_IMPL_NO_STDERR=1 MAL_VBS_IMPL_ECHO_STDIN=1 \ +WSLENV=MAL_VBS_IMPL_NO_STDERR/w:MAL_VBS_IMPL_ECHO_STDIN/w \ +cscript.exe -nologo "`wslpath -w "$(dirname $0)/${STEP:-stepA_mal}.vbs"`" "${@}" \ No newline at end of file diff --git a/impls/vbs/step0_repl.vbs b/impls/vbs/step0_repl.vbs new file mode 100644 index 0000000000..d3ef939852 --- /dev/null +++ b/impls/vbs/step0_repl.vbs @@ -0,0 +1,40 @@ +Option Explicit + +Include "IO.vbs" + +Function Read(strCode) + Read = strCode +End Function + +Function Evaluate(strCode) + Evaluate = strCode +End Function + +Function Print(strCode) + Print = strCode +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode))) +End Function + +Dim strCode +While True 'REPL + WScript.StdOut.Write "user> " + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + IO.WriteLine REP(strCode) +Wend + + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub \ No newline at end of file diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs new file mode 100644 index 0000000000..014bc40767 --- /dev/null +++ b/impls/vbs/step1_read_print.vbs @@ -0,0 +1,56 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Function Evaluate(objCode) + Set Evaluate = objCode +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode))) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub \ No newline at end of file diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs new file mode 100644 index 0000000000..a8ee9fd71b --- /dev/null +++ b/impls/vbs/step2_eval.vbs @@ -0,0 +1,177 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" + + Function EnvGet(objDict, objSymbol) + If objDict.Exists(objSymbol) Then + Set EnvGet = objDict.Item(objSymbol) + Else + Err.Raise vbObjectError, _ + "Enviroment", "Symbol '" + objSymbol + "' not found." + End If + End Function + +Dim objEnv +Set objEnv = CreateObject("Scripting.Dictionary") + +Function MAdd(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MAdd = NewMalNum( _ + objArgs.Item(1).Value + objArgs.Item(2).Value) +End Function +objEnv.Add "+", NewVbsProc("MAdd", False) + +Function MSub(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MSub = NewMalNum( _ + objArgs.Item(1).Value - objArgs.Item(2).Value) +End Function +objEnv.Add "-", NewVbsProc("MSub", False) + +Function MMul(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MMul = NewMalNum( _ + objArgs.Item(1).Value * objArgs.Item(2).Value) +End Function +objEnv.Add "*", NewVbsProc("MMul", False) + +Function MDiv(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MDiv = NewMalNum( _ + objArgs.Item(1).Value \ objArgs.Item(2).Value) +End Function +objEnv.Add "/", NewVbsProc("MDiv", False) + +Sub CheckArgNum(objArgs, lngArgNum) + If objArgs.Count - 1 <> lngArgNum Then + Err.Raise vbObjectError, _ + "CheckArgNum", "Wrong number of arguments." + End IF +End Sub + +Sub CheckType(objMal, varType) + If objMal.Type <> varType Then + Err.Raise vbObjectError, _ + "CheckType", "Wrong argument type." + End IF +End Sub + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Function Evaluate(objCode, objEnv) + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + ' DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + Set Evaluate = varRet +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = EnvGet(objEnv, objCode.Value) + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objEnv)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs new file mode 100644 index 0000000000..b34f83cd4a --- /dev/null +++ b/impls/vbs/step3_env.vbs @@ -0,0 +1,233 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" + +Dim objEnv +Set objEnv = NewEnv(Nothing) + +Function MAdd(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MAdd = NewMalNum( _ + objArgs.Item(1).Value + objArgs.Item(2).Value) +End Function +objEnv.Add "+", NewVbsProc("MAdd", False) + +Function MSub(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MSub = NewMalNum( _ + objArgs.Item(1).Value - objArgs.Item(2).Value) +End Function +objEnv.Add "-", NewVbsProc("MSub", False) + +Function MMul(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MMul = NewMalNum( _ + objArgs.Item(1).Value * objArgs.Item(2).Value) +End Function +objEnv.Add "*", NewVbsProc("MMul", False) + +Function MDiv(objArgs, objEnv) + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER + Set MDiv = NewMalNum( _ + objArgs.Item(1).Value \ objArgs.Item(2).Value) +End Function +objEnv.Add "/", NewVbsProc("MDiv", False) + +Sub CheckArgNum(objArgs, lngArgNum) + If objArgs.Count - 1 <> lngArgNum Then + Err.Raise vbObjectError, _ + "CheckArgNum", "Wrong number of arguments." + End IF +End Sub + +Sub CheckType(objMal, varType) + If objMal.Type <> varType Then + Err.Raise vbObjectError, _ + "CheckType", "Wrong argument type." + End IF +End Sub + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objEnv.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + If objBinds.Type <> TYPES.LIST And _ + objBinds.Type <> TYPES.VECTOR Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument type." + End If + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = Evaluate(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objEnv.Add "let*", NewVbsProc("MLet", True) + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine() + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(objCode, objEnv) + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + Set Evaluate = varRet +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objEnv)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs new file mode 100644 index 0000000000..7f9a875e7b --- /dev/null +++ b/impls/vbs/step4_if_fn_do.vbs @@ -0,0 +1,247 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +Function EvalLater(objMal, objEnv) + ' A fake implement, for compatibility. + Dim varRes + Set varRes = Evaluate(objMal, objEnv) + Set EvalLater = varRes +End Function + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objNS.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + CheckListOrVec objBinds + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = Evaluate(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add "let*", NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MDo", "Need more arguments." + End If + For i = 1 To objArgs.Count - 1 + Set varRet = Evaluate(objArgs.Item(i), objEnv) + Next + Set MDo = varRet +End Function +objNS.Add "do", NewVbsProc("MDo", True) + +Function MIf(objArgs, objEnv) + Dim varRet + If objArgs.Count - 1 <> 3 And _ + objArgs.Count - 1 <> 2 Then + Err.Raise vbObjectError, _ + "MIf", "Wrong number of arguments." + End If + + Dim objCond + Set objCond = Evaluate(objArgs.Item(1), objEnv) + Dim boolCond + If objCond.Type = TYPES.BOOLEAN Then + boolCond = objCond.Value + Else + boolCond = True + End If + boolCond = (boolCond And objCond.Type <> TYPES.NIL) + If boolCond Then + Set varRet = Evaluate(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = Evaluate(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objNS.Add "if", NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + CheckListOrVec objParams + Set objCode = objArgs.Item(2) + + Dim i + For i = 0 To objParams.Count - 1 + CheckType objParams.Item(i), TYPES.SYMBOL + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objNS.Add "fn*", NewVbsProc("MFn", True) + +Call InitBuiltIn() + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(objCode, objEnv) + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + Set Evaluate = varRet +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objNS)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs new file mode 100644 index 0000000000..49112162b0 --- /dev/null +++ b/impls/vbs/step5_tco.vbs @@ -0,0 +1,268 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +Class TailCall + Public objMalType + Public objEnv +End Class + +Function EvalLater(objMal, objEnv) + Dim varRes + Set varRes = New TailCall + Set varRes.objMalType = objMal + Set varRes.objEnv = objEnv + Set EvalLater = varRes +End Function + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objNS.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + CheckListOrVec objBinds + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = EvalLater(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add "let*", NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MDo", "Need more arguments." + End If + For i = 1 To objArgs.Count - 2 + Call Evaluate(objArgs.Item(i), objEnv) + Next + Set varRet = EvalLater( _ + objArgs.Item(objArgs.Count - 1), _ + objEnv) + Set MDo = varRet +End Function +objNS.Add "do", NewVbsProc("MDo", True) + +Function MIf(objArgs, objEnv) + Dim varRet + If objArgs.Count - 1 <> 3 And _ + objArgs.Count - 1 <> 2 Then + Err.Raise vbObjectError, _ + "MIf", "Wrong number of arguments." + End If + + Dim objCond + Set objCond = Evaluate(objArgs.Item(1), objEnv) + Dim boolCond + If objCond.Type = TYPES.BOOLEAN Then + boolCond = objCond.Value + Else + boolCond = True + End If + boolCond = (boolCond And objCond.Type <> TYPES.NIL) + If boolCond Then + Set varRet = EvalLater(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = EvalLater(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objNS.Add "if", NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + CheckListOrVec objParams + Set objCode = objArgs.Item(2) + + Dim i + For i = 0 To objParams.Count - 1 + CheckType objParams.Item(i), TYPES.SYMBOL + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objNS.Add "fn*", NewVbsProc("MFn", True) + +Call InitBuiltIn() + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(ByVal objCode, ByVal objEnv) + While True + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + If TypeName(varRet) = "TailCall" Then + ' NOTICE: If not specify 'ByVal', + ' Change of arguments will influence + ' the caller's variable! + Set objCode = varRet.objMalType + Set objEnv = varRet.objEnv + Else + Set Evaluate = varRet + Exit Function + End If + Wend +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objNS)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs new file mode 100644 index 0000000000..ded9066e5e --- /dev/null +++ b/impls/vbs/step6_file.vbs @@ -0,0 +1,296 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +Class TailCall + Public objMalType + Public objEnv +End Class + +Function EvalLater(objMal, objEnv) + Dim varRes + Set varRes = New TailCall + Set varRes.objMalType = objMal + Set varRes.objEnv = objEnv + Set EvalLater = varRes +End Function + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objNS.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + CheckListOrVec objBinds + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = EvalLater(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add "let*", NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MDo", "Need more arguments." + End If + For i = 1 To objArgs.Count - 2 + Call Evaluate(objArgs.Item(i), objEnv) + Next + Set varRet = EvalLater( _ + objArgs.Item(objArgs.Count - 1), _ + objEnv) + Set MDo = varRet +End Function +objNS.Add "do", NewVbsProc("MDo", True) + +Function MIf(objArgs, objEnv) + Dim varRet + If objArgs.Count - 1 <> 3 And _ + objArgs.Count - 1 <> 2 Then + Err.Raise vbObjectError, _ + "MIf", "Wrong number of arguments." + End If + + Dim objCond + Set objCond = Evaluate(objArgs.Item(1), objEnv) + Dim boolCond + If objCond.Type = TYPES.BOOLEAN Then + boolCond = objCond.Value + Else + boolCond = True + End If + boolCond = (boolCond And objCond.Type <> TYPES.NIL) + If boolCond Then + Set varRet = EvalLater(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = EvalLater(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objNS.Add "if", NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + CheckListOrVec objParams + Set objCode = objArgs.Item(2) + + Dim i + For i = 0 To objParams.Count - 1 + CheckType objParams.Item(i), TYPES.SYMBOL + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objNS.Add "fn*", NewVbsProc("MFn", True) + +Function MEval(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = Evaluate(objArgs.Item(1), objEnv) + Set varRes = EvalLater(varRes, objNS) + Set MEval = varRes +End Function +objNS.Add "eval", NewVbsProc("MEval", True) + +Call InitBuiltIn() + +Call InitArgs() +Sub InitArgs() + Dim objArgs + Set objArgs = NewMalList(Array()) + + Dim i + For i = 1 To WScript.Arguments.Count - 1 + objArgs.Add NewMalStr(WScript.Arguments.Item(i)) + Next + + objNS.Add "*ARGV*", objArgs + + If WScript.Arguments.Count > 0 Then + REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(ByVal objCode, ByVal objEnv) + While True + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + If TypeName(varRet) = "TailCall" Then + ' NOTICE: If not specify 'ByVal', + ' Change of arguments will influence + ' the caller's variable! + Set objCode = varRet.objMalType + Set objEnv = varRet.objEnv + Else + Set Evaluate = varRet + Exit Function + End If + Wend +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objNS)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs new file mode 100644 index 0000000000..089fb3ce5c --- /dev/null +++ b/impls/vbs/step7_quote.vbs @@ -0,0 +1,419 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +Class TailCall + Public objMalType + Public objEnv +End Class + +Function EvalLater(objMal, objEnv) + Dim varRes + Set varRes = New TailCall + Set varRes.objMalType = objMal + Set varRes.objEnv = objEnv + Set EvalLater = varRes +End Function + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objNS.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + CheckListOrVec objBinds + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = EvalLater(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add "let*", NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MDo", "Need more arguments." + End If + For i = 1 To objArgs.Count - 2 + Call Evaluate(objArgs.Item(i), objEnv) + Next + Set varRet = EvalLater( _ + objArgs.Item(objArgs.Count - 1), _ + objEnv) + Set MDo = varRet +End Function +objNS.Add "do", NewVbsProc("MDo", True) + +Function MIf(objArgs, objEnv) + Dim varRet + If objArgs.Count - 1 <> 3 And _ + objArgs.Count - 1 <> 2 Then + Err.Raise vbObjectError, _ + "MIf", "Wrong number of arguments." + End If + + Dim objCond + Set objCond = Evaluate(objArgs.Item(1), objEnv) + Dim boolCond + If objCond.Type = TYPES.BOOLEAN Then + boolCond = objCond.Value + Else + boolCond = True + End If + boolCond = (boolCond And objCond.Type <> TYPES.NIL) + If boolCond Then + Set varRet = EvalLater(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = EvalLater(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objNS.Add "if", NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + CheckListOrVec objParams + Set objCode = objArgs.Item(2) + + Dim i + For i = 0 To objParams.Count - 1 + CheckType objParams.Item(i), TYPES.SYMBOL + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objNS.Add "fn*", NewVbsProc("MFn", True) + +Function MEval(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = Evaluate(objArgs.Item(1), objEnv) + Set varRes = EvalLater(varRes, objNS) + Set MEval = varRes +End Function +objNS.Add "eval", NewVbsProc("MEval", True) + +Function MQuote(objArgs, objEnv) + CheckArgNum objArgs, 1 + Set MQuote = objArgs.Item(1) +End Function +objNS.Add "quote", NewVbsProc("MQuote", True) + +Function MQuasiQuote(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = EvalLater( _ + MQuasiQuoteExpand(objArgs, objEnv), objEnv) + Set MQuasiQuote = varRes +End Function +objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) + +Function MQuasiQuoteExpand(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = ExpandHelper(objArgs.Item(1)) + If varRes.Splice Then + Err.Raise vbObjectError, _ + "MQuasiQuoteExpand", "Wrong return value type." + End If + Set varRes = varRes.Value + + Set MQuasiQuoteExpand = varRes +End Function + +Class ExpandType + Public Splice + Public Value +End Class + +Function NewExpandType(objValue, boolSplice) + Dim varRes + Set varRes = New ExpandType + Set varRes.Value = objValue + varRes.Splice = boolSplice + Set NewExpandType = varRes +End Function + +Function ExpandHelper(objArg) + Dim varRes, boolSplice + Dim varBuilder, varEType, i + boolSplice = False + Select Case objArg.Type + Case TYPES.LIST + Dim boolNormal + boolNormal = False + + ' Check for unquotes. + Select Case objArg.Count + Case 2 + ' Maybe have a bug here + ' like (unquote a b c) should be throw a error + If objArg.Item(0).Type = TYPES.SYMBOL Then + Select Case objArg.Item(0).Value + Case "unquote" + Set varRes = objArg.Item(1) + Case "splice-unquote" + Set varRes = objArg.Item(1) + boolSplice = True + Case Else + boolNormal = True + End Select + Else + boolNormal = True + End If + Case Else + boolNormal = True + End Select + + If boolNormal Then + Set varRes = NewMalList(Array()) + Set varBuilder = varRes + + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + End If + Case TYPES.VECTOR + Set varRes = NewMalList(Array( _ + NewMalSym("vec"), NewMalList(Array()))) + + Set varBuilder = varRes.Item(1) + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + Case TYPES.HASHMAP + ' Maybe have a bug here. + ' e.g. {"key" ~value} + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case TYPES.SYMBOL + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case Else + ' Maybe have a bug here. + ' All unspecified type will return itself. + Set varRes = objArg + End Select + + Set ExpandHelper = NewExpandType(varRes, boolSplice) +End Function + +Call InitBuiltIn() + +Call InitArgs() +Sub InitArgs() + Dim objArgs + Set objArgs = NewMalList(Array()) + + Dim i + For i = 1 To WScript.Arguments.Count - 1 + objArgs.Add NewMalStr(WScript.Arguments.Item(i)) + Next + + objNS.Add "*ARGV*", objArgs + + If WScript.Arguments.Count > 0 Then + REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(ByVal objCode, ByVal objEnv) + While True + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + If TypeName(varRet) = "TailCall" Then + ' NOTICE: If not specify 'ByVal', + ' Change of arguments will influence + ' the caller's variable! + Set objCode = varRet.objMalType + Set objEnv = varRet.objEnv + Else + Set Evaluate = varRet + Exit Function + End If + Wend +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objNS)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs new file mode 100644 index 0000000000..bf58cb034b --- /dev/null +++ b/impls/vbs/step8_macros.vbs @@ -0,0 +1,436 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +Class TailCall + Public objMalType + Public objEnv +End Class + +Function EvalLater(objMal, objEnv) + Dim varRes + Set varRes = New TailCall + Set varRes.objMalType = objMal + Set varRes.objEnv = objEnv + Set EvalLater = varRes +End Function + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objNS.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + CheckListOrVec objBinds + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = EvalLater(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add "let*", NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MDo", "Need more arguments." + End If + For i = 1 To objArgs.Count - 2 + Call Evaluate(objArgs.Item(i), objEnv) + Next + Set varRet = EvalLater( _ + objArgs.Item(objArgs.Count - 1), _ + objEnv) + Set MDo = varRet +End Function +objNS.Add "do", NewVbsProc("MDo", True) + +Function MIf(objArgs, objEnv) + Dim varRet + If objArgs.Count - 1 <> 3 And _ + objArgs.Count - 1 <> 2 Then + Err.Raise vbObjectError, _ + "MIf", "Wrong number of arguments." + End If + + Dim objCond + Set objCond = Evaluate(objArgs.Item(1), objEnv) + Dim boolCond + If objCond.Type = TYPES.BOOLEAN Then + boolCond = objCond.Value + Else + boolCond = True + End If + boolCond = (boolCond And objCond.Type <> TYPES.NIL) + If boolCond Then + Set varRet = EvalLater(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = EvalLater(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objNS.Add "if", NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + CheckListOrVec objParams + Set objCode = objArgs.Item(2) + + Dim i + For i = 0 To objParams.Count - 1 + CheckType objParams.Item(i), TYPES.SYMBOL + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objNS.Add "fn*", NewVbsProc("MFn", True) + +Function MEval(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = Evaluate(objArgs.Item(1), objEnv) + Set varRes = EvalLater(varRes, objNS) + Set MEval = varRes +End Function +objNS.Add "eval", NewVbsProc("MEval", True) + +Function MQuote(objArgs, objEnv) + CheckArgNum objArgs, 1 + Set MQuote = objArgs.Item(1) +End Function +objNS.Add "quote", NewVbsProc("MQuote", True) + +Function MQuasiQuote(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = EvalLater( _ + MQuasiQuoteExpand(objArgs, objEnv), objEnv) + Set MQuasiQuote = varRes +End Function +objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) + +Function MQuasiQuoteExpand(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = ExpandHelper(objArgs.Item(1)) + If varRes.Splice Then + Err.Raise vbObjectError, _ + "MQuasiQuoteExpand", "Wrong return value type." + End If + Set varRes = varRes.Value + + Set MQuasiQuoteExpand = varRes +End Function + +Class ExpandType + Public Splice + Public Value +End Class + +Function NewExpandType(objValue, boolSplice) + Dim varRes + Set varRes = New ExpandType + Set varRes.Value = objValue + varRes.Splice = boolSplice + Set NewExpandType = varRes +End Function + +Function ExpandHelper(objArg) + Dim varRes, boolSplice + Dim varBuilder, varEType, i + boolSplice = False + Select Case objArg.Type + Case TYPES.LIST + Dim boolNormal + boolNormal = False + + ' Check for unquotes. + Select Case objArg.Count + Case 2 + ' Maybe have a bug here + ' like (unquote a b c) should be throw a error + If objArg.Item(0).Type = TYPES.SYMBOL Then + Select Case objArg.Item(0).Value + Case "unquote" + Set varRes = objArg.Item(1) + Case "splice-unquote" + Set varRes = objArg.Item(1) + boolSplice = True + Case Else + boolNormal = True + End Select + Else + boolNormal = True + End If + Case Else + boolNormal = True + End Select + + If boolNormal Then + Set varRes = NewMalList(Array()) + Set varBuilder = varRes + + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + End If + Case TYPES.VECTOR + Set varRes = NewMalList(Array( _ + NewMalSym("vec"), NewMalList(Array()))) + + Set varBuilder = varRes.Item(1) + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + Case TYPES.HASHMAP + ' Maybe have a bug here. + ' e.g. {"key" ~value} + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case TYPES.SYMBOL + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case Else + ' Maybe have a bug here. + ' All unspecified type will return itself. + Set varRes = objArg + End Select + + Set ExpandHelper = NewExpandType(varRes, boolSplice) +End Function + +Function MDefMacro(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() + CheckType varRet, TYPES.PROCEDURE + varRet.IsMacro = True + objEnv.Add objArgs.Item(1).Value, varRet + Set MDefMacro = varRet +End Function +objNS.Add "defmacro!", NewVbsProc("MDefMacro", True) + +Call InitBuiltIn() +Call InitMacro() + +Call InitArgs() +Sub InitArgs() + Dim objArgs + Set objArgs = NewMalList(Array()) + + Dim i + For i = 1 To WScript.Arguments.Count - 1 + objArgs.Add NewMalStr(WScript.Arguments.Item(i)) + Next + + objNS.Add "*ARGV*", objArgs + + If WScript.Arguments.Count > 0 Then + REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + IO.WriteErrLine "Exception: " + Err.Description + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(ByVal objCode, ByVal objEnv) + While True + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + + Set objFirst = Evaluate(objCode.Item(0), objEnv) + If objFirst.IsMacro Then + Set varRet = EvalLater(objFirst.MacroApply(objCode, objEnv), objEnv) + Else + Set varRet = objFirst.Apply(objCode, objEnv) + End If + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + If TypeName(varRet) = "TailCall" Then + ' NOTICE: If not specify 'ByVal', + ' Change of arguments will influence + ' the caller's variable! + Set objCode = varRet.objMalType + Set objEnv = varRet.objEnv + Else + Set Evaluate = varRet + Exit Function + End If + Wend +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objNS)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs new file mode 100644 index 0000000000..199b6dade6 --- /dev/null +++ b/impls/vbs/step9_try.vbs @@ -0,0 +1,502 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +Class TailCall + Public objMalType + Public objEnv +End Class + +Function EvalLater(objMal, objEnv) + Dim varRes + Set varRes = New TailCall + Set varRes.objMalType = objMal + Set varRes.objEnv = objEnv + Set EvalLater = varRes +End Function + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objNS.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + CheckListOrVec objBinds + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = EvalLater(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add "let*", NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MDo", "Need more arguments." + End If + For i = 1 To objArgs.Count - 2 + Call Evaluate(objArgs.Item(i), objEnv) + Next + Set varRet = EvalLater( _ + objArgs.Item(objArgs.Count - 1), _ + objEnv) + Set MDo = varRet +End Function +objNS.Add "do", NewVbsProc("MDo", True) + +Function MIf(objArgs, objEnv) + Dim varRet + If objArgs.Count - 1 <> 3 And _ + objArgs.Count - 1 <> 2 Then + Err.Raise vbObjectError, _ + "MIf", "Wrong number of arguments." + End If + + Dim objCond + Set objCond = Evaluate(objArgs.Item(1), objEnv) + Dim boolCond + If objCond.Type = TYPES.BOOLEAN Then + boolCond = objCond.Value + Else + boolCond = True + End If + boolCond = (boolCond And objCond.Type <> TYPES.NIL) + If boolCond Then + Set varRet = EvalLater(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = EvalLater(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objNS.Add "if", NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + CheckListOrVec objParams + Set objCode = objArgs.Item(2) + + Dim i + For i = 0 To objParams.Count - 1 + CheckType objParams.Item(i), TYPES.SYMBOL + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objNS.Add "fn*", NewVbsProc("MFn", True) + +Function MEval(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = Evaluate(objArgs.Item(1), objEnv) + Set varRes = EvalLater(varRes, objNS) + Set MEval = varRes +End Function +objNS.Add "eval", NewVbsProc("MEval", True) + +Function MQuote(objArgs, objEnv) + CheckArgNum objArgs, 1 + Set MQuote = objArgs.Item(1) +End Function +objNS.Add "quote", NewVbsProc("MQuote", True) + +Function MQuasiQuote(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = EvalLater( _ + MQuasiQuoteExpand(objArgs, objEnv), objEnv) + Set MQuasiQuote = varRes +End Function +objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) + +Function MQuasiQuoteExpand(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = ExpandHelper(objArgs.Item(1)) + If varRes.Splice Then + Err.Raise vbObjectError, _ + "MQuasiQuoteExpand", "Wrong return value type." + End If + Set varRes = varRes.Value + + Set MQuasiQuoteExpand = varRes +End Function + +Class ExpandType + Public Splice + Public Value +End Class + +Function NewExpandType(objValue, boolSplice) + Dim varRes + Set varRes = New ExpandType + Set varRes.Value = objValue + varRes.Splice = boolSplice + Set NewExpandType = varRes +End Function + +Function ExpandHelper(objArg) + Dim varRes, boolSplice + Dim varBuilder, varEType, i + boolSplice = False + Select Case objArg.Type + Case TYPES.LIST + Dim boolNormal + boolNormal = False + + ' Check for unquotes. + Select Case objArg.Count + Case 2 + ' Maybe have a bug here + ' like (unquote a b c) should be throw a error + If objArg.Item(0).Type = TYPES.SYMBOL Then + Select Case objArg.Item(0).Value + Case "unquote" + Set varRes = objArg.Item(1) + Case "splice-unquote" + Set varRes = objArg.Item(1) + boolSplice = True + Case Else + boolNormal = True + End Select + Else + boolNormal = True + End If + Case Else + boolNormal = True + End Select + + If boolNormal Then + Set varRes = NewMalList(Array()) + Set varBuilder = varRes + + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + End If + Case TYPES.VECTOR + Set varRes = NewMalList(Array( _ + NewMalSym("vec"), NewMalList(Array()))) + + Set varBuilder = varRes.Item(1) + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + Case TYPES.HASHMAP + ' Maybe have a bug here. + ' e.g. {"key" ~value} + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case TYPES.SYMBOL + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case Else + ' Maybe have a bug here. + ' All unspecified type will return itself. + Set varRes = objArg + End Select + + Set ExpandHelper = NewExpandType(varRes, boolSplice) +End Function + +Function MDefMacro(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() + CheckType varRet, TYPES.PROCEDURE + varRet.IsMacro = True + objEnv.Add objArgs.Item(1).Value, varRet + Set MDefMacro = varRet +End Function +objNS.Add "defmacro!", NewVbsProc("MDefMacro", True) + +Function MTry(objArgs, objEnv) + Dim varRes + + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MTry", "Need more arguments." + End If + + If objArgs.Count - 1 = 1 Then + Set varRes = EvalLater(objArgs.Item(1), objEnv) + Set MTry = varRes + Exit Function + End If + + CheckArgNum objArgs, 2 + CheckType objArgs.Item(2), TYPES.LIST + + Dim objTry, objCatch + Set objTry = objArgs.Item(1) + Set objCatch = objArgs.Item(2) + + CheckArgNum objCatch, 2 + CheckType objCatch.Item(0), TYPES.SYMBOL + CheckType objCatch.Item(1), TYPES.SYMBOL + If objCatch.Item(0).Value <> "catch*" Then + Err.Raise vbObjectError, _ + "MTry", "Unexpect argument(s)." + End If + + On Error Resume Next + Set varRes = Evaluate(objTry, objEnv) + If Err.Number <> 0 Then + Dim objException + + If Err.Source <> "MThrow" Then + Set objException = NewMalStr(Err.Description) + Else + Set objException = objExceptions.Item(Err.Description) + objExceptions.Remove Err.Description + End If + + Call Err.Clear() + On Error Goto 0 + + ' The code below may cause error too. + ' So we should clear err info & throw out any errors. + ' Use 'quote' to avoid eval objExp again. + Set varRes = Evaluate(NewMalList(Array( _ + NewMalSym("let*"), NewMalList(Array( _ + objCatch.Item(1), NewMalList(Array( _ + NewMalSym("quote"), objException)))), _ + objCatch.Item(2))), objEnv) + Else + On Error Goto 0 + End If + + Set MTry = varRes +End Function +objNS.Add "try*", NewVbsProc("MTry", True) + +Call InitBuiltIn() +Call InitMacro() + +Call InitArgs() +Sub InitArgs() + Dim objArgs + Set objArgs = NewMalList(Array()) + + Dim i + For i = 1 To WScript.Arguments.Count - 1 + objArgs.Add NewMalStr(WScript.Arguments.Item(i)) + Next + + objNS.Add "*ARGV*", objArgs + + If WScript.Arguments.Count > 0 Then + REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + If Err.Source = "MThrow" Then + IO.WriteErrLine "Exception: " + _ + PrintMalType(objExceptions.Item(Err.Description), True) + objExceptions.Remove Err.Description + Else + IO.WriteErrLine "Exception: " + Err.Description + End If + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(ByVal objCode, ByVal objEnv) + While True + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + + Set objFirst = Evaluate(objCode.Item(0), objEnv) + If objFirst.IsMacro Then + Set varRet = EvalLater(objFirst.MacroApply(objCode, objEnv), objEnv) + Else + Set varRet = objFirst.Apply(objCode, objEnv) + End If + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + If TypeName(varRet) = "TailCall" Then + ' NOTICE: If not specify 'ByVal', + ' Change of arguments will influence + ' the caller's variable! + Set objCode = varRet.objMalType + Set objEnv = varRet.objEnv + Else + Set Evaluate = varRet + Exit Function + End If + Wend +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objNS)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs new file mode 100644 index 0000000000..d0607f83a3 --- /dev/null +++ b/impls/vbs/stepA_mal.vbs @@ -0,0 +1,503 @@ +Option Explicit + +Include "IO.vbs" +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +Class TailCall + Public objMalType + Public objEnv +End Class + +Function EvalLater(objMal, objEnv) + Dim varRes + Set varRes = New TailCall + Set varRes.objMalType = objMal + Set varRes.objEnv = objEnv + Set EvalLater = varRes +End Function + +Function MDef(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1).Value, varRet + Set MDef = varRet +End Function +objNS.Add "def!", NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objBinds + Set objBinds = objArgs.Item(1) + CheckListOrVec objBinds + + If objBinds.Count Mod 2 <> 0 Then + Err.Raise vbObjectError, _ + "MLet", "Wrong argument count." + End If + + Dim objNewEnv + Set objNewEnv = NewEnv(objEnv) + Dim i, objSym + For i = 0 To objBinds.Count - 1 Step 2 + Set objSym = objBinds.Item(i) + CheckType objSym, TYPES.SYMBOL + objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) + Next + + Set varRet = EvalLater(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add "let*", NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MDo", "Need more arguments." + End If + For i = 1 To objArgs.Count - 2 + Call Evaluate(objArgs.Item(i), objEnv) + Next + Set varRet = EvalLater( _ + objArgs.Item(objArgs.Count - 1), _ + objEnv) + Set MDo = varRet +End Function +objNS.Add "do", NewVbsProc("MDo", True) + +Function MIf(objArgs, objEnv) + Dim varRet + If objArgs.Count - 1 <> 3 And _ + objArgs.Count - 1 <> 2 Then + Err.Raise vbObjectError, _ + "MIf", "Wrong number of arguments." + End If + + Dim objCond + Set objCond = Evaluate(objArgs.Item(1), objEnv) + Dim boolCond + If objCond.Type = TYPES.BOOLEAN Then + boolCond = objCond.Value + Else + boolCond = True + End If + boolCond = (boolCond And objCond.Type <> TYPES.NIL) + If boolCond Then + Set varRet = EvalLater(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = EvalLater(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objNS.Add "if", NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + CheckListOrVec objParams + Set objCode = objArgs.Item(2) + + Dim i + For i = 0 To objParams.Count - 1 + CheckType objParams.Item(i), TYPES.SYMBOL + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objNS.Add "fn*", NewVbsProc("MFn", True) + +Function MEval(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = Evaluate(objArgs.Item(1), objEnv) + Set varRes = EvalLater(varRes, objNS) + Set MEval = varRes +End Function +objNS.Add "eval", NewVbsProc("MEval", True) + +Function MQuote(objArgs, objEnv) + CheckArgNum objArgs, 1 + Set MQuote = objArgs.Item(1) +End Function +objNS.Add "quote", NewVbsProc("MQuote", True) + +Function MQuasiQuote(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = EvalLater( _ + MQuasiQuoteExpand(objArgs, objEnv), objEnv) + Set MQuasiQuote = varRes +End Function +objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) + +Function MQuasiQuoteExpand(objArgs, objEnv) + Dim varRes + CheckArgNum objArgs, 1 + + Set varRes = ExpandHelper(objArgs.Item(1)) + If varRes.Splice Then + Err.Raise vbObjectError, _ + "MQuasiQuoteExpand", "Wrong return value type." + End If + Set varRes = varRes.Value + + Set MQuasiQuoteExpand = varRes +End Function + +Class ExpandType + Public Splice + Public Value +End Class + +Function NewExpandType(objValue, boolSplice) + Dim varRes + Set varRes = New ExpandType + Set varRes.Value = objValue + varRes.Splice = boolSplice + Set NewExpandType = varRes +End Function + +Function ExpandHelper(objArg) + Dim varRes, boolSplice + Dim varBuilder, varEType, i + boolSplice = False + Select Case objArg.Type + Case TYPES.LIST + Dim boolNormal + boolNormal = False + + ' Check for unquotes. + Select Case objArg.Count + Case 2 + ' Maybe have a bug here + ' like (unquote a b c) should be throw a error + If objArg.Item(0).Type = TYPES.SYMBOL Then + Select Case objArg.Item(0).Value + Case "unquote" + Set varRes = objArg.Item(1) + Case "splice-unquote" + Set varRes = objArg.Item(1) + boolSplice = True + Case Else + boolNormal = True + End Select + Else + boolNormal = True + End If + Case Else + boolNormal = True + End Select + + If boolNormal Then + Set varRes = NewMalList(Array()) + Set varBuilder = varRes + + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + End If + Case TYPES.VECTOR + Set varRes = NewMalList(Array( _ + NewMalSym("vec"), NewMalList(Array()))) + + Set varBuilder = varRes.Item(1) + For i = 0 To objArg.Count - 1 + Set varEType = ExpandHelper(objArg.Item(i)) + If varEType.Splice Then + varBuilder.Add NewMalSym("concat") + Else + varBuilder.Add NewMalSym("cons") + End If + varBuilder.Add varEType.Value + varBuilder.Add NewMalList(Array()) + Set varBuilder = varBuilder.Item(2) + Next + Case TYPES.HASHMAP + ' Maybe have a bug here. + ' e.g. {"key" ~value} + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case TYPES.SYMBOL + Set varRes = NewMalList(Array( _ + NewMalSym("quote"), objArg)) + Case Else + ' Maybe have a bug here. + ' All unspecified type will return itself. + Set varRes = objArg + End Select + + Set ExpandHelper = NewExpandType(varRes, boolSplice) +End Function + +Function MDefMacro(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() + CheckType varRet, TYPES.PROCEDURE + varRet.IsMacro = True + objEnv.Add objArgs.Item(1).Value, varRet + Set MDefMacro = varRet +End Function +objNS.Add "defmacro!", NewVbsProc("MDefMacro", True) + +Function MTry(objArgs, objEnv) + Dim varRes + + If objArgs.Count - 1 < 1 Then + Err.Raise vbObjectError, _ + "MTry", "Need more arguments." + End If + + If objArgs.Count - 1 = 1 Then + Set varRes = EvalLater(objArgs.Item(1), objEnv) + Set MTry = varRes + Exit Function + End If + + CheckArgNum objArgs, 2 + CheckType objArgs.Item(2), TYPES.LIST + + Dim objTry, objCatch + Set objTry = objArgs.Item(1) + Set objCatch = objArgs.Item(2) + + CheckArgNum objCatch, 2 + CheckType objCatch.Item(0), TYPES.SYMBOL + CheckType objCatch.Item(1), TYPES.SYMBOL + If objCatch.Item(0).Value <> "catch*" Then + Err.Raise vbObjectError, _ + "MTry", "Unexpect argument(s)." + End If + + On Error Resume Next + Set varRes = Evaluate(objTry, objEnv) + If Err.Number <> 0 Then + Dim objException + + If Err.Source <> "MThrow" Then + Set objException = NewMalStr(Err.Description) + Else + Set objException = objExceptions.Item(Err.Description) + objExceptions.Remove Err.Description + End If + + Call Err.Clear() + On Error Goto 0 + + ' The code below may cause error too. + ' So we should clear err info & throw out any errors. + ' Use 'quote' to avoid eval objExp again. + Set varRes = Evaluate(NewMalList(Array( _ + NewMalSym("let*"), NewMalList(Array( _ + objCatch.Item(1), NewMalList(Array( _ + NewMalSym("quote"), objException)))), _ + objCatch.Item(2))), objEnv) + Else + On Error Goto 0 + End If + + Set MTry = varRes +End Function +objNS.Add "try*", NewVbsProc("MTry", True) + +Call InitBuiltIn() +Call InitMacro() + +Call InitArgs() +Sub InitArgs() + Dim objArgs + Set objArgs = NewMalList(Array()) + + Dim i + For i = 1 To WScript.Arguments.Count - 1 + objArgs.Add NewMalStr(WScript.Arguments.Item(i)) + Next + + objNS.Add "*ARGV*", objArgs + + If WScript.Arguments.Count > 0 Then + REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode + REP "(println (str ""Mal [""*host-language*""]""))" + While True + IO.Write "user> " + + On Error Resume Next + strCode = IO.ReadLine + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + Dim strRes + On Error Resume Next + strRes = REP(strCode) + If Err.Number <> 0 Then + If Err.Source = "MThrow" Then + IO.WriteErrLine "Exception: " + _ + PrintMalType(objExceptions.Item(Err.Description), True) + objExceptions.Remove Err.Description + Else + IO.WriteErrLine "Exception: " + Err.Description + End If + Else + If strRes <> "" Then + IO.WriteLine strRes + End If + End If + On Error Goto 0 + Wend +End Sub + +Function Read(strCode) + Set Read = ReadString(strCode) +End Function + +Sub DebugEval(objCode, objEnv) + Dim value + Set value = objEnv.Get("DEBUG-EVAL") + ' And and Or do not short-circuit. + If TypeName(value) = "Nothing" Then + Exit Sub + Else + Select Case value.Type + Case TYPES.NIL + Exit Sub + Case TYPES.BOOLEAN + If Not value.Value Then + Exit Sub + End If + End Select + End If + IO.WriteLine "EVAL: " + Print(objCode) +End Sub + +Function Evaluate(ByVal objCode, ByVal objEnv) + While True + If TypeName(objCode) = "Nothing" Then + Set Evaluate = Nothing + Exit Function + End If + + DebugEval objCode, objEnv + + Dim varRet, objFirst + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () + Set Evaluate = objCode + Exit Function + End If + + Set objFirst = Evaluate(objCode.Item(0), objEnv) + If objFirst.IsMacro Then + Set varRet = EvalLater(objFirst.MacroApply(objCode, objEnv), objEnv) + Else + Set varRet = objFirst.Apply(objCode, objEnv) + End If + Else + Set varRet = EvaluateAST(objCode, objEnv) + End If + + If TypeName(varRet) = "TailCall" Then + ' NOTICE: If not specify 'ByVal', + ' Change of arguments will influence + ' the caller's variable! + Set objCode = varRet.objMalType + Set objEnv = varRet.objEnv + Else + Set Evaluate = varRet + Exit Function + End If + Wend +End Function + + +Function EvaluateAST(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode.Value) + If TypeName(varRet) = "Nothing" Then + Err.Raise vbObjectError, _ + "EvaluateAST", "'" + objCode.Value + "' not found" + End If + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) + For i = 0 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) + For Each i In objCode.Keys() + varRet.Add i, Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Set varRet = objCode + End Select + Set EvaluateAST = varRet +End Function + +Function EvaluateRest(objCode, objEnv) + Dim varRet, i + Select Case objCode.Type + Case TYPES.LIST + Set varRet = NewMalList(Array(NewMalNil())) + For i = 1 To objCode.Count() - 1 + varRet.Add Evaluate(objCode.Item(i), objEnv) + Next + Case Else + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." + End Select + Set EvaluateRest = varRet +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) +End Function + +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objNS)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub diff --git a/impls/vbs/tests/step4_if_fn_do.mal b/impls/vbs/tests/step4_if_fn_do.mal new file mode 100644 index 0000000000..79ba87478d --- /dev/null +++ b/impls/vbs/tests/step4_if_fn_do.mal @@ -0,0 +1,18 @@ +((fn* [x] [x]) (list 1 2 3)) +;=>[(1 2 3)] + +((fn* [x] [x]) [1 2 3]) +;=>[[1 2 3]] + +((fn* [x] (list x)) (list 1 2 3)) +;=>((1 2 3)) + +((fn* [x] (list x)) [1 2 3]) +;=>([1 2 3]) + +((fn* [x] x) (list 1 2 3)) +;=>(1 2 3) + +((fn* [x] x) [1 2 3]) +;=>[1 2 3] + diff --git a/impls/vbs/tests/step9_try.mal b/impls/vbs/tests/step9_try.mal new file mode 100644 index 0000000000..89597a14ce --- /dev/null +++ b/impls/vbs/tests/step9_try.mal @@ -0,0 +1,11 @@ +(throw (list 1 2 3)) +;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*\(1 2 3\).* + +(try* (throw {}) (catch* e (do (throw e)))) +;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*{}.* + +(try* (throw (list 1 2 3)) (catch* exc (do 7))) +;=>7 + +(try* (map throw (list "my err")) (catch* exc exc)) +;=>"my err" \ No newline at end of file diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs new file mode 100644 index 0000000000..550b134143 --- /dev/null +++ b/impls/vbs/types.vbs @@ -0,0 +1,612 @@ +Option Explicit + +Dim TYPES +Set TYPES = New MalTypes + +Class MalTypes + Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL + Public KEYWORD, [STRING], NUMBER, SYMBOL + Public PROCEDURE, ATOM + + Public [TypeName] + Private Sub Class_Initialize + [TypeName] = Array( _ + "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _ + "NIL", "KEYWORD", "STRING", "NUMBER", _ + "SYMBOL", "PROCEDURE", "ATOM") + + Dim i + For i = 0 To UBound([TypeName]) + Execute "[" + [TypeName](i) + "] = " + CStr(i) + Next + End Sub +End Class + +Class MalType + Public [Type] + Public Value + + Private varMeta + Public Property Get MetaData() + If IsEmpty(varMeta) Then + Set MetaData = NewMalNil() + Else + Set MetaData = varMeta + End If + End Property + + Public Property Set MetaData(objMeta) + Set varMeta = objMeta + End Property + + Public Function Copy() + Set Copy = NewMalType([Type], Value) + End Function + + Public Function Init(lngType, varValue) + [Type] = lngType + Value = varValue + End Function +End Class + +Function NewMalType(lngType, varValue) + Dim varResult + Set varResult = New MalType + varResult.Init lngType, varValue + Set NewMalType = varResult +End Function + +Function NewMalBool(varValue) + Set NewMalBool = NewMalType(TYPES.BOOLEAN, varValue) +End Function + +Function NewMalNil() + Set NewMalNil = NewMalType(TYPES.NIL, Empty) +End Function + +Function NewMalKwd(varValue) + Set NewMalKwd = NewMalType(TYPES.KEYWORD, varValue) +End Function + +Function NewMalStr(varValue) + Set NewMalStr = NewMalType(TYPES.STRING, varValue) +End Function + +Function NewMalNum(varValue) + Set NewMalNum = NewMalType(TYPES.NUMBER, varValue) +End Function + +Function NewMalSym(varValue) + Set NewMalSym = NewMalType(TYPES.SYMBOL, varValue) +End Function + +Class MalAtom + Public [Type] + Public Value + + Private varMeta + Public Property Get MetaData() + If IsEmpty(varMeta) Then + Set MetaData = NewMalNil() + Else + Set MetaData = varMeta + End If + End Property + + Public Property Set MetaData(objMeta) + Set varMeta = objMeta + End Property + + Public Function Copy() + Set Copy = NewMalAtom(Value) + End Function + + Public Sub Reset(objMal) + Set Value = objMal + End Sub + + Private Sub Class_Initialize + [Type] = TYPES.ATOM + End Sub +End Class + +Function NewMalAtom(varValue) + Dim varRes + Set varRes = New MalAtom + varRes.Reset varValue + Set NewMalAtom = varRes +End Function + +Class MalList ' Extends MalType + Public [Type] + Public Value + + Private varMeta + Public Property Get MetaData() + If IsEmpty(varMeta) Then + Set MetaData = NewMalNil() + Else + Set MetaData = varMeta + End If + End Property + + Public Property Set MetaData(objMeta) + Set varMeta = objMeta + End Property + + Public Function Copy() + Set Copy = New MalList + Set Copy.Value = Value + End Function + + Private Sub Class_Initialize + [Type] = TYPES.LIST + Set Value = CreateObject("System.Collections.ArrayList") + End Sub + + Public Function Init(arrValues) + Dim i + For i = 0 To UBound(arrValues) + Add arrValues(i) + Next + End Function + + Public Function Add(objMalType) + Value.Add objMalType + End Function + + Public Property Get Item(i) + Set Item = Value.Item(i) + End Property + + Public Property Let Item(i, varValue) + Value.Item(i) = varValue + End Property + + Public Property Set Item(i, varValue) + Set Value.Item(i) = varValue + End Property + + Public Function Count() + Count = Value.Count + End Function +End Class + +Function NewMalList(arrValues) + Dim varResult + Set varResult = New MalList + varResult.Init arrValues + Set NewMalList = varResult +End Function + +Class MalVector ' Extends MalType + Public [Type] + Public Value + + Private varMeta + Public Property Get MetaData() + If IsEmpty(varMeta) Then + Set MetaData = NewMalNil() + Else + Set MetaData = varMeta + End If + End Property + + Public Property Set MetaData(objMeta) + Set varMeta = objMeta + End Property + + Public Function Copy() + Set Copy = New MalVector + Set Copy.Value = Value + End Function + + Private Sub Class_Initialize + [Type] = TYPES.VECTOR + Set Value = CreateObject("System.Collections.ArrayList") + End Sub + + Public Function Init(arrValues) + Dim i + For i = 0 To UBound(arrValues) + Add arrValues(i) + Next + End Function + + Public Function Add(objMalType) + Value.Add objMalType + End Function + + Public Property Get Item(i) + Set Item = Value.Item(i) + End Property + + Public Property Let Item(i, varValue) + Value.Item(i) = varValue + End Property + + Public Property Set Item(i, varValue) + Set Value.Item(i) = varValue + End Property + + Public Function Count() + Count = Value.Count + End Function +End Class + +Function NewMalVec(arrValues) + Dim varResult + Set varResult = New MalVector + varResult.Init arrValues + Set NewMalVec = varResult +End Function + +Class MalHashmap 'Extends MalType + Public [Type] + Public Value + + Private varMeta + Public Property Get MetaData() + If IsEmpty(varMeta) Then + Set MetaData = NewMalNil() + Else + Set MetaData = varMeta + End If + End Property + + Public Property Set MetaData(objMeta) + Set varMeta = objMeta + End Property + + Public Function Copy() + Set Copy = New MalHashmap + Set Copy.Value = Value + End Function + + + Private Sub Class_Initialize + [Type] = TYPES.HASHMAP + Set Value = CreateObject("Scripting.Dictionary") + End Sub + + Public Function Init(arrKeys, arrValues) + Dim i + For i = 0 To UBound(arrKeys) + Add arrKeys(i), arrValues(i) + Next + End Function + + Private Function M2S(objKey) + Dim varRes + Select Case objKey.Type + Case TYPES.STRING + varRes = "S" + objKey.Value + Case TYPES.KEYWORD + varRes = "K" + objKey.Value + Case Else + Err.Raise vbObjectError, _ + "MalHashmap", "Unexpect key type." + End Select + M2S = varRes + End Function + + Private Function S2M(strKey) + Dim varRes + Select Case Left(strKey, 1) + Case "S" + Set varRes = NewMalStr(Right(strKey, Len(strKey) - 1)) + Case "K" + Set varRes = NewMalKwd(Right(strKey, Len(strKey) - 1)) + Case Else + Err.Raise vbObjectError, _ + "MalHashmap", "Unexpect key type." + End Select + Set S2M = varRes + End Function + + Public Function Add(varKey, varValue) + If varKey.Type <> TYPES.STRING And _ + varKey.Type <> TYPES.KEYWORD Then + Err.Raise vbObjectError, _ + "MalHashmap", "Unexpect key type." + End If + + Set Value.Item(M2S(varKey)) = varValue + 'Value.Add M2S(varKey), varValue + End Function + + Public Property Get Keys() + Dim aKeys + aKeys = Value.Keys + Dim aRes() + ReDim aRes(UBound(aKeys)) + Dim i + For i = 0 To UBound(aRes) + Set aRes(i) = S2M(aKeys(i)) + Next + + Keys = aRes + End Property + + Public Function Count() + Count = Value.Count + End Function + + Public Property Get Item(i) + Set Item = Value.Item(M2S(i)) + End Property + + Public Function Exists(varKey) + If varKey.Type <> TYPES.STRING And _ + varKey.Type <> TYPES.KEYWORD Then + Err.Raise vbObjectError, _ + "MalHashmap", "Unexpect key type." + End If + Exists = Value.Exists(M2S(varKey)) + End Function + + Public Property Let Item(i, varValue) + Value.Item(M2S(i)) = varValue + End Property + + Public Property Set Item(i, varValue) + Set Value.Item(M2S(i)) = varValue + End Property +End Class + +Function NewMalMap(arrKeys, arrValues) + Dim varResult + Set varResult = New MalHashmap + varResult.Init arrKeys, arrValues + Set NewMalMap = varResult +End Function + +Class VbsProcedure 'Extends MalType + Public [Type] + Public Value + + Public IsMacro + Public boolSpec + Public MetaData + Private Sub Class_Initialize + [Type] = TYPES.PROCEDURE + IsMacro = False + Set MetaData = NewMalNil() + End Sub + + Public Property Get IsSpecial() + IsSpecial = boolSpec + End Property + + Public Function Init(objFunction, boolIsSpec) + Set Value = objFunction + boolSpec = boolIsSpec + End Function + + Public Function Apply(objArgs, objEnv) + Dim varResult + If boolSpec Then + Set varResult = Value(objArgs, objEnv) + Else + Set varResult = Value(EvaluateRest(objArgs, objEnv), objEnv) + End If + Set Apply = varResult + End Function + + Public Function ApplyWithoutEval(objArgs, objEnv) + Dim varResult + Set varResult = Value(objArgs, objEnv) + + Set ApplyWithoutEval = varResult + End Function + + Public Function Copy() + Dim varRes + Set varRes = New VbsProcedure + varRes.Type = [Type] + Set varRes.Value = Value + varRes.IsMacro = IsMacro + varRes.boolSpec = boolSpec + Set Copy = varRes + End Function +End Class + +Function NewVbsProc(strFnName, boolSpec) + Dim varResult + Set varResult = New VbsProcedure + varResult.Init GetRef(strFnName), boolSpec + Set NewVbsProc = varResult +End Function + +Class MalProcedure 'Extends MalType + Public [Type] + Public Value + + Public IsMacro + + Public Property Get IsSpecial() + IsSpecial = False + End Property + + Public MetaData + Private Sub Class_Initialize + [Type] = TYPES.PROCEDURE + IsMacro = False + Set MetaData = NewMalNil() + End Sub + + Public objParams, objCode, objSavedEnv + Public Function Init(objP, objC, objE) + Set objParams = objP + Set objCode = objC + Set objSavedEnv = objE + End Function + + Public Function Apply(objArgs, objEnv) + If IsMacro Then + Err.Raise vbObjectError, _ + "MalProcedureApply", "Not a procedure." + End If + + Dim varRet + Dim objNewEnv + Set objNewEnv = NewEnv(objSavedEnv) + Dim i + i = 0 + Dim objList + While i < objParams.Count + If objParams.Item(i).Value = "&" Then + If objParams.Count - 1 = i + 1 Then + Set objList = NewMalList(Array()) + objNewEnv.Add objParams.Item(i + 1).Value, objList + While i + 1 < objArgs.Count + objList.Add Evaluate(objArgs.Item(i + 1), objEnv) + i = i + 1 + Wend + i = objParams.Count ' Break While + Else + Err.Raise vbObjectError, _ + "MalProcedureApply", "Invalid parameter(s)." + End If + Else + If i + 1 >= objArgs.Count Then + Err.Raise vbObjectError, _ + "MalProcedureApply", "Need more arguments." + End If + objNewEnv.Add objParams.Item(i).Value, _ + Evaluate(objArgs.Item(i + 1), objEnv) + i = i + 1 + End If + Wend + + Set varRet = EvalLater(objCode, objNewEnv) + Set Apply = varRet + End Function + + Public Function MacroApply(objArgs, objEnv) + If Not IsMacro Then + Err.Raise vbObjectError, _ + "MalMacroApply", "Not a macro." + End If + + Dim varRet + Dim objNewEnv + Set objNewEnv = NewEnv(objSavedEnv) + Dim i + i = 0 + Dim objList + While i < objParams.Count + If objParams.Item(i).Value = "&" Then + If objParams.Count - 1 = i + 1 Then + Set objList = NewMalList(Array()) + + ' No evaluation + objNewEnv.Add objParams.Item(i + 1).Value, objList + While i + 1 < objArgs.Count + objList.Add objArgs.Item(i + 1) + i = i + 1 + Wend + i = objParams.Count ' Break While + Else + Err.Raise vbObjectError, _ + "MalMacroApply", "Invalid parameter(s)." + End If + Else + If i + 1 >= objArgs.Count Then + Err.Raise vbObjectError, _ + "MalMacroApply", "Need more arguments." + End If + + ' No evaluation + objNewEnv.Add objParams.Item(i).Value, _ + objArgs.Item(i + 1) + i = i + 1 + End If + Wend + + ' EvalLater -> Evaluate + Set varRet = Evaluate(objCode, objNewEnv) + Set MacroApply = varRet + End Function + + + Public Function ApplyWithoutEval(objArgs, objEnv) + Dim varRet + Dim objNewEnv + Set objNewEnv = NewEnv(objSavedEnv) + Dim i + i = 0 + Dim objList + While i < objParams.Count + If objParams.Item(i).Value = "&" Then + If objParams.Count - 1 = i + 1 Then + Set objList = NewMalList(Array()) + + ' No evaluation + objNewEnv.Add objParams.Item(i + 1).Value, objList + While i + 1 < objArgs.Count + objList.Add objArgs.Item(i + 1) + i = i + 1 + Wend + i = objParams.Count ' Break While + Else + Err.Raise vbObjectError, _ + "MalMacroApply", "Invalid parameter(s)." + End If + Else + If i + 1 >= objArgs.Count Then + Err.Raise vbObjectError, _ + "MalMacroApply", "Need more arguments." + End If + + ' No evaluation + objNewEnv.Add objParams.Item(i).Value, _ + objArgs.Item(i + 1) + i = i + 1 + End If + Wend + + ' EvalLater -> Evaluate + Set varRet = Evaluate(objCode, objNewEnv) + Set ApplyWithoutEval = varRet + End Function + + + Public Function Copy() + Dim varRes + Set varRes = New MalProcedure + varRes.Type = [Type] + varRes.Value = Value + varRes.IsMacro = IsMacro + Set varRes.objParams = objParams + Set varRes.objCode = objCode + Set varRes.objSavedEnv = objSavedEnv + Set Copy = varRes + End Function +End Class + +Function NewMalProc(objParams, objCode, objEnv) + Dim varRet + Set varRet = New MalProcedure + varRet.Init objParams, objCode, objEnv + Set NewMalProc = varRet +End Function + +Function NewMalMacro(objParams, objCode, objEnv) + Dim varRet + Set varRet = New MalProcedure + varRet.Init objParams, objCode, objEnv + varRet.IsMacro = True + Set NewMalProc = varRet +End Function + +Function SetMeta(objMal, objMeta) + Dim varRes + Set varRes = objMal.Copy + Set varRes.MetaData = objMeta + Set SetMeta = varRes +End Function + +Function GetMeta(objMal) + Set GetMeta = objMal.MetaData +End Function \ No newline at end of file diff --git a/impls/vhdl/.gitignore b/impls/vhdl/.gitignore new file mode 100644 index 0000000000..95000fd028 --- /dev/null +++ b/impls/vhdl/.gitignore @@ -0,0 +1 @@ +work-obj93.cf diff --git a/impls/vhdl/Dockerfile b/impls/vhdl/Dockerfile new file mode 100644 index 0000000000..4eb39aec50 --- /dev/null +++ b/impls/vhdl/Dockerfile @@ -0,0 +1,24 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install gcc ghdl ghdl-gcc + +ENV HOME /mal diff --git a/impls/vhdl/Makefile b/impls/vhdl/Makefile new file mode 100644 index 0000000000..e76b8e104a --- /dev/null +++ b/impls/vhdl/Makefile @@ -0,0 +1,35 @@ +SRCS = step0_repl.vhdl step1_read_print.vhdl step2_eval.vhdl step3_env.vhdl \ + step4_if_fn_do.vhdl step5_tco.vhdl step6_file.vhdl step7_quote.vhdl \ + step8_macros.vhdl step9_try.vhdl stepA_mal.vhdl +OBJS = $(SRCS:%.vhdl=%.o) +BINS = $(OBJS:%.o=%) +OTHER_SRCS = pkg_readline.vhdl types.vhdl printer.vhdl reader.vhdl env.vhdl core.vhdl +OTHER_OBJS = $(OTHER_SRCS:%.vhdl=%.o) + +##################### + +all: $(BINS) + +dist: mal + +mal: $(word $(words $(BINS)),$(BINS)) + cp $< $@ + +work-obj93.cf: $(OTHER_SRCS) + rm -f work-obj93.cf + ghdl -i $+ + +$(OTHER_OBJS): %.o: %.vhdl work-obj93.cf + ghdl -a -g $(@:%.o=%.vhdl) + +$(OBJS): %.o: %.vhdl $(OTHER_OBJS) + ghdl -a -g $(@:%.o=%.vhdl) + +$(patsubst %.o,%,$(filter step%,$(OBJS))): $(OTHER_OBJS) +$(BINS): %: %.o + ghdl -e -g $@ + # ghdl linker creates a lowercase executable; rename it to stepA_mal + if [ "$@" = "stepA_mal" ]; then mv stepa_mal $@; fi + +clean: + rm -f $(OBJS) $(BINS) $(OTHER_OBJS) work-obj93.cf mal diff --git a/impls/vhdl/core.vhdl b/impls/vhdl/core.vhdl new file mode 100644 index 0000000000..b904dc0c12 --- /dev/null +++ b/impls/vhdl/core.vhdl @@ -0,0 +1,690 @@ +library STD; +use STD.textio.all; +library WORK; +use WORK.types.all; +use WORK.env.all; +use WORK.reader.all; +use WORK.printer.all; +use WORK.pkg_readline.all; + +package core is + procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + procedure define_core_functions(e: inout env_ptr); +end package core; + +package body core is + + procedure fn_equal(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable is_equal: boolean; + begin + equal_q(args.seq_val(0), args.seq_val(1), is_equal); + new_boolean(is_equal, result); + end procedure fn_equal; + + procedure fn_throw(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + err := args.seq_val(0); + end procedure fn_throw; + + procedure fn_nil_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_nil, result); + end procedure fn_nil_q; + + procedure fn_true_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_true, result); + end procedure fn_true_q; + + procedure fn_false_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_false, result); + end procedure fn_false_q; + + procedure fn_string_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_string, result); + end procedure fn_string_q; + + procedure fn_symbol(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_symbol(args.seq_val(0).string_val, result); + end procedure fn_symbol; + + procedure fn_symbol_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_symbol, result); + end procedure fn_symbol_q; + + procedure fn_keyword(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_keyword(args.seq_val(0).string_val, result); + end procedure fn_keyword; + + procedure fn_keyword_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_keyword, result); + end procedure fn_keyword_q; + + procedure fn_number_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_number, result); + end procedure fn_number_q; + + procedure fn_function_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean((args.seq_val(0).val_type = mal_fn and not args.seq_val(0).func_val.f_is_macro) or args.seq_val(0).val_type = mal_nativefn, result); + end procedure fn_function_q; + + procedure fn_macro_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_fn and args.seq_val(0).func_val.f_is_macro, result); + end procedure fn_macro_q; + + procedure fn_pr_str(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable s: line; + begin + pr_seq("", "", " ", args.seq_val, true, s); + new_string(s, result); + end procedure fn_pr_str; + + procedure fn_str(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable s: line; + begin + pr_seq("", "", "", args.seq_val, false, s); + new_string(s, result); + end procedure fn_str; + + procedure fn_prn(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable s: line; + begin + pr_seq("", "", " ", args.seq_val, true, s); + mal_printline(s.all); + new_nil(result); + end procedure fn_prn; + + procedure fn_println(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable s: line; + begin + pr_seq("", "", " ", args.seq_val, false, s); + mal_printline(s.all); + new_nil(result); + end procedure fn_println; + + procedure fn_read_string(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast: mal_val_ptr; + begin + read_str(args.seq_val(0).string_val.all, ast, err); + if ast = null then + new_nil(result); + else + result := ast; + end if; + end procedure fn_read_string; + + procedure fn_readline(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable input_line: line; + variable is_eof: boolean; + begin + mal_readline(args.seq_val(0).string_val.all, is_eof, input_line); + if is_eof then + new_nil(result); + else + new_string(input_line, result); + end if; + end procedure fn_readline; + + procedure fn_slurp(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + file f: text; + variable status: file_open_status; + variable save_content, content, one_line: line; + begin + file_open(status, f, external_name => args.seq_val(0).string_val.all, open_kind => read_mode); + if status = open_ok then + content := new string'(""); + while not endfile(f) loop + readline(f, one_line); + save_content := content; + content := new string'(save_content.all & one_line.all & LF); + deallocate(save_content); + end loop; + file_close(f); + new_string(content, result); + else + new_string("Error opening file", err); + end if; + end procedure fn_slurp; + + procedure fn_lt(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).number_val < args.seq_val(1).number_val, result); + end procedure fn_lt; + + procedure fn_lte(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).number_val <= args.seq_val(1).number_val, result); + end procedure fn_lte; + + procedure fn_gt(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).number_val > args.seq_val(1).number_val, result); + end procedure fn_gt; + + procedure fn_gte(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).number_val >= args.seq_val(1).number_val, result); + end procedure fn_gte; + + procedure fn_add(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_number(args.seq_val(0).number_val + args.seq_val(1).number_val, result); + end procedure fn_add; + + procedure fn_sub(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_number(args.seq_val(0).number_val - args.seq_val(1).number_val, result); + end procedure fn_sub; + + procedure fn_mul(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_number(args.seq_val(0).number_val * args.seq_val(1).number_val, result); + end procedure fn_mul; + + procedure fn_div(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_number(args.seq_val(0).number_val / args.seq_val(1).number_val, result); + end procedure fn_div; + + -- Define physical types (c_seconds64, c_microseconds64) because these are + -- represented as 64-bit words when passed to C functions + type c_seconds64 is range 0 to 1E16 + units + c_sec; + end units c_seconds64; + + type c_microseconds64 is range 0 to 1E6 + units + c_usec; + end units c_microseconds64; + + type c_timeval is record + tv_sec: c_seconds64; + tv_usec: c_microseconds64; + end record c_timeval; + + -- Leave enough room for two 64-bit words + type c_timezone is record + dummy_1: c_seconds64; + dummy_2: c_seconds64; + end record c_timezone; + + function gettimeofday(tv: c_timeval; tz: c_timezone) return integer; + attribute foreign of gettimeofday: function is "VHPIDIRECT gettimeofday"; + + function gettimeofday(tv: c_timeval; tz: c_timezone) return integer is + begin + assert false severity failure; + end function gettimeofday; + + -- Returns the number of milliseconds since last midnight UTC because a + -- standard VHDL integer is 32-bit and therefore cannot hold the number of + -- milliseconds since 1970-01-01. + procedure fn_time_ms(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable tv: c_timeval; + variable dummy: c_timezone; + variable rc: integer; + begin + rc := gettimeofday(tv, dummy); + new_number(((tv.tv_sec / 1 c_sec) mod 86400) * 1000 + (tv.tv_usec / 1000 c_usec), result); + end procedure fn_time_ms; + + procedure fn_list(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + result := args; + end procedure fn_list; + + procedure fn_list_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_list, result); + end procedure fn_list_q; + + procedure fn_vector(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + args.val_type := mal_vector; + result := args; + end procedure fn_vector; + + procedure fn_vector_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_vector, result); + end procedure fn_vector_q; + + procedure fn_hash_map(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable new_map: mal_val_ptr; + begin + new_empty_hashmap(new_map); + for i in 0 to args.seq_val'length / 2 - 1 loop + hashmap_put(new_map, args.seq_val(2*i), args.seq_val(2*i+1)); + end loop; + result := new_map; + end procedure fn_hash_map; + + procedure fn_map_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(args.seq_val(0).val_type = mal_hashmap, result); + end procedure fn_map_q; + + procedure fn_assoc(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable new_hashmap: mal_val_ptr; + variable i: integer; + begin + hashmap_copy(args.seq_val(0), new_hashmap); + i := 1; + while i < args.seq_val'length loop + hashmap_put(new_hashmap, args.seq_val(i), args.seq_val(i + 1)); + i := i + 2; + end loop; + result := new_hashmap; + end procedure fn_assoc; + + procedure fn_dissoc(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable new_hashmap: mal_val_ptr; + variable i: integer; + begin + hashmap_copy(args.seq_val(0), new_hashmap); + for i in 1 to args.seq_val'high loop + hashmap_delete(new_hashmap, args.seq_val(i)); + end loop; + result := new_hashmap; + end procedure fn_dissoc; + + procedure fn_get(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable a1: mal_val_ptr := args.seq_val(1); + variable val: mal_val_ptr; + begin + if a0.val_type = mal_nil then + new_nil(result); + else + hashmap_get(a0, a1, val); + if val = null then + new_nil(result); + else + result := val; + end if; + end if; + end procedure fn_get; + + procedure fn_contains_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable a1: mal_val_ptr := args.seq_val(1); + variable found: boolean; + begin + hashmap_contains(a0, a1, found); + new_boolean(found, result); + end procedure fn_contains_q; + + procedure fn_keys(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable seq: mal_seq_ptr; + begin + seq := new mal_seq(0 to a0.seq_val'length / 2 - 1); + for i in seq'range loop + seq(i) := a0.seq_val(i * 2); + end loop; + new_seq_obj(mal_list, seq, result); + end procedure fn_keys; + + procedure fn_vals(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable seq: mal_seq_ptr; + begin + seq := new mal_seq(0 to a0.seq_val'length / 2 - 1); + for i in seq'range loop + seq(i) := a0.seq_val(i * 2 + 1); + end loop; + new_seq_obj(mal_list, seq, result); + end procedure fn_vals; + + procedure cons_helper(a0: inout mal_val_ptr; a1: inout mal_val_ptr; result: out mal_val_ptr) is + variable seq: mal_seq_ptr; + begin + seq := new mal_seq(0 to a1.seq_val'length); + seq(0) := a0; + seq(1 to seq'length - 1) := a1.seq_val(0 to a1.seq_val'length - 1); + new_seq_obj(mal_list, seq, result); + end procedure cons_helper; + + procedure fn_cons(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable a1: mal_val_ptr := args.seq_val(1); + variable seq: mal_seq_ptr; + begin + cons_helper(a0, a1, result); + end procedure fn_cons; + + procedure fn_sequential_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_boolean(is_sequential_type(args.seq_val(0).val_type), result); + end procedure fn_sequential_q; + + procedure fn_concat(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable seq: mal_seq_ptr; + variable i: integer; + begin + seq := new mal_seq(0 to -1); + for i in args.seq_val'range loop + seq := new mal_seq'(seq.all & args.seq_val(i).seq_val.all); + end loop; + new_seq_obj(mal_list, seq, result); + end procedure fn_concat; + + procedure fn_vec(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + if args.seq_val(0).val_type = mal_vector then + result := args.seq_val(0); + else + new_seq_obj(mal_vector, args.seq_val(0).seq_val, result); + end if; + end procedure fn_vec; + + procedure fn_nth(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable lst_seq: mal_seq_ptr := args.seq_val(0).seq_val; + variable index: integer := args.seq_val(1).number_val; + begin + if index >= lst_seq'length then + new_string("nth: index out of range", err); + else + result := lst_seq(index); + end if; + end procedure fn_nth; + + procedure fn_first(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + begin + if a0.val_type = mal_nil or a0.seq_val'length = 0 then + new_nil(result); + else + result := a0.seq_val(0); + end if; + end procedure fn_first; + + procedure fn_rest(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable seq: mal_seq_ptr; + variable new_list: mal_val_ptr; + begin + if a0.val_type = mal_nil or a0.seq_val'length = 0 then + seq := new mal_seq(0 to -1); + new_seq_obj(mal_list, seq, result); + else + seq_drop_prefix(a0, 1, new_list); + new_list.val_type := mal_list; + result := new_list; + end if; + end procedure fn_rest; + + procedure fn_empty_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable is_empty: boolean; + begin + case args.seq_val(0).val_type is + when mal_nil => new_boolean(true, result); + when mal_list | mal_vector => new_boolean(args.seq_val(0).seq_val'length = 0, result); + when others => new_string("empty?: invalid argument type", err); + end case; + end procedure fn_empty_q; + + procedure fn_count(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable count: integer; + begin + case args.seq_val(0).val_type is + when mal_nil => new_number(0, result); + when mal_list | mal_vector => new_number(args.seq_val(0).seq_val'length, result); + when others => new_string("count: invalid argument type", err); + end case; + end procedure fn_count; + + procedure fn_conj(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable r: mal_val_ptr; + variable seq: mal_seq_ptr; + begin + case a0.val_type is + when mal_list => + r := a0; + for i in 1 to args.seq_val'high loop + cons_helper(args.seq_val(i), r, r); + end loop; + result := r; + when mal_vector => + seq := new mal_seq(0 to a0.seq_val'length + args.seq_val'length - 2); + seq(0 to a0.seq_val'high) := a0.seq_val(a0.seq_val'range); + seq(a0.seq_val'high + 1 to seq'high) := args.seq_val(1 to args.seq_val'high); + new_seq_obj(mal_vector, seq, result); + when others => + new_string("conj requires list or vector", err); + end case; + end procedure fn_conj; + + procedure fn_seq(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable new_seq: mal_seq_ptr; + begin + case a0.val_type is + when mal_string => + if a0.string_val'length = 0 then + new_nil(result); + else + new_seq := new mal_seq(0 to a0.string_val'length - 1); + for i in new_seq'range loop + new_string("" & a0.string_val(i + 1), new_seq(i)); + end loop; + new_seq_obj(mal_list, new_seq, result); + end if; + when mal_list => + if a0.seq_val'length = 0 then + new_nil(result); + else + result := a0; + end if; + when mal_vector => + if a0.seq_val'length = 0 then + new_nil(result); + else + new_seq_obj(mal_list, a0.seq_val, result); + end if; + when mal_nil => + new_nil(result); + when others => + new_string("seq requires string or list or vector or nil", err); + end case; + end procedure fn_seq; + + procedure fn_meta(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable meta_val: mal_val_ptr; + begin + meta_val := args.seq_val(0).meta_val; + if meta_val = null then + new_nil(result); + else + result := meta_val; + end if; + end procedure fn_meta; + + procedure fn_with_meta(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + begin + result := new mal_val'(val_type => a0.val_type, number_val => a0.number_val, string_val => a0.string_val, seq_val => a0.seq_val, func_val => a0.func_val, meta_val => args.seq_val(1)); + end procedure fn_with_meta; + + procedure fn_atom(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + new_atom(args.seq_val(0), result); + end procedure fn_atom; + + procedure fn_atom_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + begin + new_boolean(a0.val_type = mal_atom, result); + end procedure fn_atom_q; + + procedure fn_deref(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + begin + result := a0.seq_val(0); + end procedure fn_deref; + + procedure fn_reset(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable a0: mal_val_ptr := args.seq_val(0); + variable a1: mal_val_ptr := args.seq_val(1); + begin + a0.seq_val(0) := a1; + result := a1; + end procedure fn_reset; + + procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable f: line; + begin + if func_sym.val_type /= mal_nativefn then + new_string("not a native function!", err); + return; + end if; + f := func_sym.string_val; + if f.all = "=" then fn_equal(args, result, err); + elsif f.all = "throw" then fn_throw(args, result, err); + elsif f.all = "nil?" then fn_nil_q(args, result, err); + elsif f.all = "true?" then fn_true_q(args, result, err); + elsif f.all = "false?" then fn_false_q(args, result, err); + elsif f.all = "string?" then fn_string_q(args, result, err); + elsif f.all = "symbol" then fn_symbol(args, result, err); + elsif f.all = "symbol?" then fn_symbol_q(args, result, err); + elsif f.all = "keyword" then fn_keyword(args, result, err); + elsif f.all = "keyword?" then fn_keyword_q(args, result, err); + elsif f.all = "number?" then fn_number_q(args, result, err); + elsif f.all = "fn?" then fn_function_q(args, result, err); + elsif f.all = "macro?" then fn_macro_q(args, result, err); + elsif f.all = "pr-str" then fn_pr_str(args, result, err); + elsif f.all = "str" then fn_str(args, result, err); + elsif f.all = "prn" then fn_prn(args, result, err); + elsif f.all = "println" then fn_println(args, result, err); + elsif f.all = "read-string" then fn_read_string(args, result, err); + elsif f.all = "readline" then fn_readline(args, result, err); + elsif f.all = "slurp" then fn_slurp(args, result, err); + elsif f.all = "<" then fn_lt(args, result, err); + elsif f.all = "<=" then fn_lte(args, result, err); + elsif f.all = ">" then fn_gt(args, result, err); + elsif f.all = ">=" then fn_gte(args, result, err); + elsif f.all = "+" then fn_add(args, result, err); + elsif f.all = "-" then fn_sub(args, result, err); + elsif f.all = "*" then fn_mul(args, result, err); + elsif f.all = "/" then fn_div(args, result, err); + elsif f.all = "time-ms" then fn_time_ms(args, result, err); + elsif f.all = "list" then fn_list(args, result, err); + elsif f.all = "list?" then fn_list_q(args, result, err); + elsif f.all = "vector" then fn_vector(args, result, err); + elsif f.all = "vector?" then fn_vector_q(args, result, err); + elsif f.all = "hash-map" then fn_hash_map(args, result, err); + elsif f.all = "map?" then fn_map_q(args, result, err); + elsif f.all = "assoc" then fn_assoc(args, result, err); + elsif f.all = "dissoc" then fn_dissoc(args, result, err); + elsif f.all = "get" then fn_get(args, result, err); + elsif f.all = "contains?" then fn_contains_q(args, result, err); + elsif f.all = "keys" then fn_keys(args, result, err); + elsif f.all = "vals" then fn_vals(args, result, err); + elsif f.all = "sequential?" then fn_sequential_q(args, result, err); + elsif f.all = "cons" then fn_cons(args, result, err); + elsif f.all = "concat" then fn_concat(args, result, err); + elsif f.all = "vec" then fn_vec(args, result, err); + elsif f.all = "nth" then fn_nth(args, result, err); + elsif f.all = "first" then fn_first(args, result, err); + elsif f.all = "rest" then fn_rest(args, result, err); + elsif f.all = "empty?" then fn_empty_q(args, result, err); + elsif f.all = "count" then fn_count(args, result, err); + elsif f.all = "conj" then fn_conj(args, result, err); + elsif f.all = "seq" then fn_seq(args, result, err); + elsif f.all = "meta" then fn_meta(args, result, err); + elsif f.all = "with-meta" then fn_with_meta(args, result, err); + elsif f.all = "atom" then fn_atom(args, result, err); + elsif f.all = "atom?" then fn_atom_q(args, result, err); + elsif f.all = "deref" then fn_deref(args, result, err); + elsif f.all = "reset!" then fn_reset(args, result, err); + else + result := null; + end if; + end procedure eval_native_func; + + procedure define_core_function(e: inout env_ptr; func_name: in string) is + variable sym: mal_val_ptr; + variable fn: mal_val_ptr; + begin + new_symbol(func_name, sym); + new_nativefn(func_name, fn); + env_set(e, sym, fn); + end procedure define_core_function; + + procedure define_core_functions(e: inout env_ptr) is + begin + define_core_function(e, "="); + define_core_function(e, "throw"); + define_core_function(e, "nil?"); + define_core_function(e, "true?"); + define_core_function(e, "false?"); + define_core_function(e, "string?"); + define_core_function(e, "symbol"); + define_core_function(e, "symbol?"); + define_core_function(e, "keyword"); + define_core_function(e, "keyword?"); + define_core_function(e, "number?"); + define_core_function(e, "fn?"); + define_core_function(e, "macro?"); + define_core_function(e, "pr-str"); + define_core_function(e, "str"); + define_core_function(e, "prn"); + define_core_function(e, "println"); + define_core_function(e, "read-string"); + define_core_function(e, "readline"); + define_core_function(e, "slurp"); + define_core_function(e, "<"); + define_core_function(e, "<="); + define_core_function(e, ">"); + define_core_function(e, ">="); + define_core_function(e, "+"); + define_core_function(e, "-"); + define_core_function(e, "*"); + define_core_function(e, "/"); + define_core_function(e, "time-ms"); + define_core_function(e, "list"); + define_core_function(e, "list?"); + define_core_function(e, "vector"); + define_core_function(e, "vector?"); + define_core_function(e, "hash-map"); + define_core_function(e, "map?"); + define_core_function(e, "assoc"); + define_core_function(e, "dissoc"); + define_core_function(e, "get"); + define_core_function(e, "contains?"); + define_core_function(e, "keys"); + define_core_function(e, "vals"); + define_core_function(e, "sequential?"); + define_core_function(e, "cons"); + define_core_function(e, "concat"); + define_core_function(e, "vec"); + define_core_function(e, "nth"); + define_core_function(e, "first"); + define_core_function(e, "rest"); + define_core_function(e, "empty?"); + define_core_function(e, "count"); + define_core_function(e, "apply"); -- implemented in the stepN_XXX files + define_core_function(e, "map"); -- implemented in the stepN_XXX files + define_core_function(e, "conj"); + define_core_function(e, "seq"); + define_core_function(e, "meta"); + define_core_function(e, "with-meta"); + define_core_function(e, "atom"); + define_core_function(e, "atom?"); + define_core_function(e, "deref"); + define_core_function(e, "reset!"); + define_core_function(e, "swap!"); -- implemented in the stepN_XXX files + end procedure define_core_functions; + +end package body core; diff --git a/impls/vhdl/env.vhdl b/impls/vhdl/env.vhdl new file mode 100644 index 0000000000..ae2040b3c3 --- /dev/null +++ b/impls/vhdl/env.vhdl @@ -0,0 +1,64 @@ +library STD; +use STD.textio.all; +library WORK; +use WORK.types.all; + +package env is + procedure new_env(e: out env_ptr; an_outer: inout env_ptr); + procedure new_env(e: out env_ptr; an_outer: inout env_ptr; binds: inout mal_val_ptr; exprs: inout mal_val_ptr); + procedure env_set(e: inout env_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr); + procedure env_get(e : inout env_ptr; + key : inout mal_val_ptr; + result : out mal_val_ptr); +end package env; + +package body env is + procedure new_env(e: out env_ptr; an_outer: inout env_ptr) is + variable null_list: mal_val_ptr; + begin + null_list := null; + new_env(e, an_outer, null_list, null_list); + end procedure new_env; + + procedure new_env(e: out env_ptr; an_outer: inout env_ptr; binds: inout mal_val_ptr; exprs: inout mal_val_ptr) is + variable the_data, more_exprs: mal_val_ptr; + variable i: integer; + begin + new_empty_hashmap(the_data); + if binds /= null then + for i in binds.seq_val'range loop + if binds.seq_val(i).string_val.all = "&" then + seq_drop_prefix(exprs, i, more_exprs); + hashmap_put(the_data, binds.seq_val(i + 1), more_exprs); + exit; + else + hashmap_put(the_data, binds.seq_val(i), exprs.seq_val(i)); + end if; + end loop; + end if; + e := new env_record'(outer => an_outer, data => the_data); + end procedure new_env; + + procedure env_set(e: inout env_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr) is + begin + hashmap_put(e.data, key, val); + end procedure env_set; + + procedure env_get(e : inout env_ptr; + key : inout mal_val_ptr; + result : out mal_val_ptr) + is + variable environment : env_ptr := e; + variable val : mal_val_ptr; + begin + loop + hashmap_get(environment.data, key, val); + exit when val /= null; + environment := environment.outer; + exit when environment = null; + end loop; + result := val; + return; + end procedure env_get; + +end package body env; diff --git a/impls/vhdl/pkg_readline.vhdl b/impls/vhdl/pkg_readline.vhdl new file mode 100644 index 0000000000..74e0bbf8d1 --- /dev/null +++ b/impls/vhdl/pkg_readline.vhdl @@ -0,0 +1,37 @@ +library STD; +use STD.textio.all; + +package pkg_readline is + procedure mal_printstr(l: string); + procedure mal_printline(l: string); + procedure mal_readline(prompt: string; eof_detected: out boolean; l: inout line); +end package pkg_readline; + +package body pkg_readline is + type charfile is file of character; + file stdout_char: charfile open write_mode is "STD_OUTPUT"; + + procedure mal_printstr(l: string) is + begin + for i in l'range loop + write(stdout_char, l(i)); + end loop; + end procedure mal_printstr; + + procedure mal_printline(l: string) is + begin + mal_printstr(l); + write(stdout_char, LF); + end procedure mal_printline; + + procedure mal_readline(prompt: string; eof_detected: out boolean; l: inout line) is + begin + mal_printstr(prompt); + if endfile(input) then + eof_detected := true; + else + readline(input, l); + eof_detected := false; + end if; + end procedure mal_readline; +end package body pkg_readline; diff --git a/impls/vhdl/printer.vhdl b/impls/vhdl/printer.vhdl new file mode 100644 index 0000000000..c3b3e63ada --- /dev/null +++ b/impls/vhdl/printer.vhdl @@ -0,0 +1,97 @@ +library STD; +use STD.textio.all; +library WORK; +use WORK.types.all; + +package printer is + procedure pr_str(ast: inout mal_val_ptr; readable: in boolean; result: out line); + procedure pr_seq(start_ch: in string; end_ch: in string; delim: in string; a_seq: inout mal_seq_ptr; readable: in boolean; result: out line); +end package printer; + +package body printer is + + procedure pr_string(val: inout line; readable: in boolean; result: out line) is + variable s: line; + variable src_i, dst_i: integer; + begin + if readable then + s := new string(1 to val'length * 2); + dst_i := 0; + for src_i in val'range loop + dst_i := dst_i + 1; + case val(src_i) is + when LF => + s(dst_i) := '\'; + dst_i := dst_i + 1; + s(dst_i) := 'n'; + when '"' => + s(dst_i) := '\'; + dst_i := dst_i + 1; + s(dst_i) := '"'; + when '\' => + s(dst_i) := '\'; + dst_i := dst_i + 1; + s(dst_i) := '\'; + when others => + s(dst_i) := val(src_i); + end case; + end loop; + result := new string'("" & '"' & s(1 to dst_i) & '"'); + deallocate(s); + else + result := val; + end if; + end; + + procedure pr_str(ast: inout mal_val_ptr; readable: in boolean; result: out line) is + variable l: line; + begin + case ast.val_type is + when mal_nil => + result := new string'("nil"); + when mal_true => + result := new string'("true"); + when mal_false => + result := new string'("false"); + when mal_number => + write(l, ast.number_val); + result := l; + when mal_symbol => + result := ast.string_val; + when mal_string => + pr_string(ast.string_val, readable, result); + when mal_keyword => + result := new string'(":" & ast.string_val.all); + when mal_list => + pr_seq("(", ")", " ", ast.seq_val, readable, result); + when mal_vector => + pr_seq("[", "]", " ", ast.seq_val, readable, result); + when mal_hashmap => + pr_seq("{", "}", " ", ast.seq_val, readable, result); + when mal_atom => + pr_str(ast.seq_val(0), true, l); + result := new string'("(atom " & l.all & ")"); + when mal_nativefn => + result := new string'("#"); + when mal_fn => + result := new string'("#"); + end case; + end procedure pr_str; + + procedure pr_seq(start_ch: in string; end_ch: in string; delim: in string; a_seq: inout mal_seq_ptr; readable: in boolean; result: out line) is + variable s, element_s: line; + begin + s := new string'(start_ch); + for i in a_seq'range loop + pr_str(a_seq(i), readable, element_s); + if i = 0 then + s := new string'(s.all & element_s.all); + else + s := new string'(s.all & delim & element_s.all); + end if; + end loop; + s := new string'(s.all & end_ch); + result := s; + end procedure pr_seq; + +end package body printer; diff --git a/impls/vhdl/reader.vhdl b/impls/vhdl/reader.vhdl new file mode 100644 index 0000000000..f8f07d2356 --- /dev/null +++ b/impls/vhdl/reader.vhdl @@ -0,0 +1,382 @@ +library STD; +use STD.textio.all; +library WORK; +use WORK.types.all; + +package reader is + procedure read_str(s: in string; result: out mal_val_ptr; err: out mal_val_ptr); +end package reader; + +package body reader is + + type token_list is array(natural range <>) of line; + type token_list_ptr is access token_list; + + function is_eol_char(c: in character) return boolean is + begin + case c is + when LF | CR => return true; + when others => return false; + end case; + end function is_eol_char; + + function is_separator_char(c: in character) return boolean is + begin + case c is + when LF | CR | ' ' | '[' | ']' | '{' | '}' | '(' | ')' | + ''' | '"' | '`' | ',' | ';' => return true; + when others => return false; + end case; + end function is_separator_char; + + procedure next_token(str: in string; pos: in positive; token: inout line; next_start_pos: out positive; ok: out boolean) is + variable ch: character; + variable tmppos: positive; + begin + token := new string'(""); + if pos > str'length then + ok := false; + return; + end if; + + ch := str(pos); + + case ch is + when ' ' | ',' | LF | CR | HT => + next_start_pos := pos + 1; + token := new string'(""); + ok := true; + return; + + when '[' | ']' | '{' | '}' | '(' | ')' | ''' | '`' | '^' | '@' => + next_start_pos := pos + 1; + token := new string'("" & ch); + ok := true; + return; + + when '~' => + if str(pos + 1) = '@' then + next_start_pos := pos + 2; + token := new string'("~@"); + else + next_start_pos := pos + 1; + token := new string'("~"); + end if; + ok := true; + return; + + when ';' => + tmppos := pos + 1; + while tmppos <= str'length and not is_eol_char(str(tmppos)) loop + tmppos := tmppos + 1; + end loop; + next_start_pos := tmppos; + token := new string'(""); + ok := true; + return; + + when '"' => + tmppos := pos + 1; + while tmppos < str'length and str(tmppos) /= '"' loop + if str(tmppos) = '\' then + tmppos := tmppos + 2; + else + tmppos := tmppos + 1; + end if; + end loop; + if tmppos > str'length then + tmppos := tmppos - 1; -- unterminated string, will be caught in unescape_string_token + end if; + token := new string(1 to (tmppos - pos + 1)); + token(1 to (tmppos - pos + 1)) := str(pos to tmppos); + next_start_pos := tmppos + 1; + ok := true; + return; + + when others => + tmppos := pos; + while tmppos <= str'length and not is_separator_char(str(tmppos)) loop + tmppos := tmppos + 1; + end loop; + token := new string(1 to (tmppos - pos)); + token(1 to (tmppos - pos)) := str(pos to tmppos - 1); + next_start_pos := tmppos; + ok := true; + return; + + end case; + + ok := false; + end procedure next_token; + + function tokenize(str: in string) return token_list_ptr is + variable next_pos: positive := 1; + variable ok: boolean := true; + variable tokens: token_list_ptr; + variable t: line; + begin + while ok loop + next_token(str, next_pos, t, next_pos, ok); + if t'length > 0 then + if tokens = null then + tokens := new token_list(0 to 0); + tokens(0) := t; + else + tokens := new token_list'(tokens.all & t); + end if; + end if; + end loop; + return tokens; + end function tokenize; + + type reader_class is record + tokens: token_list_ptr; + pos: natural; + end record reader_class; + + procedure reader_new(r: inout reader_class; a_tokens: inout token_list_ptr) is + begin + r := (tokens => a_tokens, pos => 0); + end procedure reader_new; + + procedure reader_peek(r: inout reader_class; token: out line) is + begin + if r.pos < r.tokens'length then + token := r.tokens(r.pos); + else + token := null; + end if; + end procedure reader_peek; + + procedure reader_next(r: inout reader_class; token: out line) is + begin + reader_peek(r, token); + r.pos := r.pos + 1; + end procedure reader_next; + + -- Forward declaration + procedure read_form(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr); + + function is_digit(c: in character) return boolean is + begin + case c is + when '0' to '9' => return true; + when others => return false; + end case; + end function is_digit; + + function unescape_char(c: in character) return character is + begin + case c is + when 'n' => return LF; + when others => return c; + end case; + end function unescape_char; + + procedure unescape_string_token(token: inout line; result: out line) is + variable s: line; + variable src_i, dst_i: integer; + begin + s := new string(1 to token'length); + dst_i := 0; + src_i := 2; -- skip the initial quote + while src_i <= token'length - 1 loop + dst_i := dst_i + 1; + if token(src_i) = '\' then + s(dst_i) := unescape_char(token(src_i + 1)); + src_i := src_i + 2; + else + s(dst_i) := token(src_i); + src_i := src_i + 1; + end if; + end loop; + if src_i <= token'length then + result := new string'(s(1 to dst_i)); + else + result := null; + end if; + deallocate(s); + end procedure unescape_string_token; + + procedure read_atom(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is + variable token, s: line; + variable num: integer; + variable ch: character; + begin + reader_next(r, token); + if token.all = "nil" then + new_nil(result); + elsif token.all = "true" then + new_true(result); + elsif token.all = "false" then + new_false(result); + else + ch := token(1); + case ch is + when '-' => + if token'length > 1 and is_digit(token(2)) then + read(token, num); + new_number(num, result); + else + new_symbol(token, result); + end if; + when '0' to '9' => + read(token, num); + new_number(num, result); + when ':' => + s := new string(1 to token'length - 1); + s(1 to s'length) := token(2 to token'length); + new_keyword(s, result); + when '"' => + if token(token'length) /= '"' then + new_string("expected '""', got EOF", err); + result := null; + return; + end if; + unescape_string_token(token, s); + if s = null then + new_string("expected '""', got EOF", err); + result := null; + return; + end if; + new_string(s, result); + when others => + new_symbol(token, result); + end case; + end if; + end procedure read_atom; + + procedure read_sequence(list_type: in mal_type_tag; end_ch: in string; r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is + variable token: line; + variable element, sub_err: mal_val_ptr; + variable seq: mal_seq_ptr; + begin + reader_next(r, token); -- Consume the open paren + reader_peek(r, token); + seq := new mal_seq(0 to -1); + while token /= null and token.all /= end_ch loop + read_form(r, element, sub_err); + if sub_err /= null then + err := sub_err; + result := null; + return; + end if; + seq := new mal_seq'(seq.all & element); + reader_peek(r, token); + end loop; + if token = null then + new_string("expected '" & end_ch & "', got EOF", err); + result := null; + return; + end if; + reader_next(r, token); -- Consume the close paren + new_seq_obj(list_type, seq, result); + end procedure read_sequence; + + procedure read_map(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is + variable sub_seq, sub_err, new_map: mal_val_ptr; + begin + read_sequence(mal_hashmap, "}", r, sub_seq, sub_err); + if sub_err = null then + new_empty_hashmap(new_map); + for i in 0 to sub_seq.seq_val'length / 2 - 1 loop + hashmap_put(new_map, sub_seq.seq_val(2*i), sub_seq.seq_val(2*i + 1)); + end loop; + result := new_map; + else + err := sub_err; + result := null; + end if; + end procedure read_map; + + procedure reader_macro(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr; sym_name: in string) is + variable token, sym_line: line; + variable seq: mal_seq_ptr; + variable rest, rest_err: mal_val_ptr; + begin + reader_next(r, token); + seq := new mal_seq(0 to 1); + sym_line := new string'(sym_name); + new_symbol(sym_line, seq(0)); + read_form(r, rest, rest_err); + if rest_err /= null then + err := rest_err; + result := null; + return; + end if; + seq(1) := rest; + new_seq_obj(mal_list, seq, result); + end procedure reader_macro; + + procedure with_meta_reader_macro(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is + variable token, sym_line: line; + variable seq: mal_seq_ptr; + variable meta, rest, rest_err: mal_val_ptr; + begin + reader_next(r, token); + seq := new mal_seq(0 to 2); + sym_line := new string'("with-meta"); + new_symbol(sym_line, seq(0)); + read_form(r, meta, rest_err); + if rest_err /= null then + err := rest_err; + result := null; + return; + end if; + read_form(r, rest, rest_err); + if rest_err /= null then + err := rest_err; + result := null; + return; + end if; + seq(1) := rest; + seq(2) := meta; + new_seq_obj(mal_list, seq, result); + end procedure with_meta_reader_macro; + + procedure read_form(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is + variable token: line; + variable ch: character; + begin + reader_peek(r, token); + ch := token(1); + case ch is + when ''' => reader_macro(r, result, err, "quote"); + when '`' => reader_macro(r, result, err, "quasiquote"); + when '~' => + if token'length = 1 then + reader_macro(r, result, err, "unquote"); + else + if token(2) = '@' then + reader_macro(r, result, err, "splice-unquote"); + else + new_string("Unknown token", err); + end if; + end if; + when '^' => with_meta_reader_macro(r, result, err); + when '@' => reader_macro(r, result, err, "deref"); + when '(' => read_sequence(mal_list, ")", r, result, err); + when ')' => new_string("unexcepted ')'", err); + when '[' => read_sequence(mal_vector, "]", r, result, err); + when ']' => new_string("unexcepted ']'", err); + when '{' => read_map(r, result, err); + when '}' => new_string("unexcepted '}'", err); + when others => read_atom(r, result, err); + end case; + end procedure read_form; + + procedure read_str(s: in string; result: out mal_val_ptr; err: out mal_val_ptr) is + variable tokens: token_list_ptr; + variable r: reader_class; + begin + tokens := tokenize(s); + if tokens = null or tokens'length = 0 then + result := null; + err := null; + return; + end if; + reader_new(r, tokens); + read_form(r, result, err); + end procedure read_str; + +end package body reader; diff --git a/impls/vhdl/run b/impls/vhdl/run new file mode 100755 index 0000000000..ca50d3f82b --- /dev/null +++ b/impls/vhdl/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec $(dirname $0)/run_vhdl.sh $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/vhdl/run_vhdl.sh b/impls/vhdl/run_vhdl.sh new file mode 100755 index 0000000000..1cc8e3bf9f --- /dev/null +++ b/impls/vhdl/run_vhdl.sh @@ -0,0 +1,21 @@ +#!/usr/bin/env bash + +# ghdl doesn't allow passing command-line arguments to the VHDL program. To +# circumvent that, we write the command-line arguments as lines in +# vhdl_argv.tmp, and read the content of that file at the beginning of the VHDL +# program. + +cleanup() { + trap - TERM QUIT INT EXIT + rm -f vhdl_argv.tmp +} +trap "cleanup" TERM QUIT INT EXIT + +bin="$1" +shift + +for arg in "$@" ; do + echo "$arg" +done > vhdl_argv.tmp + +$bin diff --git a/impls/vhdl/step0_repl.vhdl b/impls/vhdl/step0_repl.vhdl new file mode 100644 index 0000000000..5f82036f2e --- /dev/null +++ b/impls/vhdl/step0_repl.vhdl @@ -0,0 +1,45 @@ +entity step0_repl is +end entity step0_repl; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; + +architecture test of step0_repl is + function mal_READ(str: in string) return string is + begin + return str; + end function mal_READ; + + function EVAL(ast: in string; env: in string) return string is + begin + return ast; + end function EVAL; + + function mal_PRINT(exp: in string) return string is + begin + return exp; + end function mal_PRINT; + + function REP(str: in string) return string is + begin + return mal_PRINT(EVAL(mal_READ(str), "")); + end function REP; + + procedure repl is + variable is_eof: boolean; + variable input_line: line; + begin + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + mal_printline(REP(input_line.all)); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step1_read_print.vhdl b/impls/vhdl/step1_read_print.vhdl new file mode 100644 index 0000000000..2736386cdb --- /dev/null +++ b/impls/vhdl/step1_read_print.vhdl @@ -0,0 +1,70 @@ +entity step1_read_print is +end entity step1_read_print; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; + +architecture test of step1_read_print is + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + procedure EVAL(ast: inout mal_val_ptr; env: in string; result: out mal_val_ptr) is + begin + result := ast; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure REP(str: in string; result: out line; err: out mal_val_ptr) is + variable ast, eval_res, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, "", eval_res); + mal_PRINT(eval_res, result); + end procedure REP; + + procedure repl is + variable is_eof: boolean; + variable input_line, result: line; + variable err: mal_val_ptr; + begin + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step2_eval.vhdl b/impls/vhdl/step2_eval.vhdl new file mode 100644 index 0000000000..a9efe834e5 --- /dev/null +++ b/impls/vhdl/step2_eval.vhdl @@ -0,0 +1,178 @@ +entity step2_eval is +end entity step2_eval; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; + +architecture test of step2_eval is + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + -- Forward declaration + procedure EVAL(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr) is + variable num_result: integer; + variable a: mal_seq_ptr; + begin + a := args.seq_val; + if func_sym.string_val.all = "+" then + new_number(a(0).number_val + a(1).number_val, result); + elsif func_sym.string_val.all = "-" then + new_number(a(0).number_val - a(1).number_val, result); + elsif func_sym.string_val.all = "*" then + new_number(a(0).number_val * a(1).number_val, result); + elsif func_sym.string_val.all = "/" then + new_number(a(0).number_val / a(1).number_val, result); + else + result := null; + end if; + end procedure eval_native_func; + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout mal_val_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(ast : inout mal_val_ptr; + env : inout mal_val_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable key, val, eval_err, call_args, sub_err, fn: mal_val_ptr; + variable new_seq: mal_seq_ptr; + -- variable s: line; + variable i: integer; + begin + -- mal_printstr("EVAL: "); + -- pr_str(ast, true, s); + -- mal_printline(s.all); + + case ast.val_type is + when mal_symbol => + new_string(ast.string_val, key); + hashmap_get(env, key, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + EVAL(ast.seq_val(0), env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + eval_native_func(fn, call_args, result); + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure REP(str: in string; env: inout mal_val_ptr; result: out line; err: out mal_val_ptr) is + variable ast, eval_res, read_err, eval_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure repl is + variable is_eof: boolean; + variable input_line, result: line; + variable repl_seq: mal_seq_ptr; + variable repl_env, err: mal_val_ptr; + begin + repl_seq := new mal_seq(0 to 7); + new_string("+", repl_seq(0)); + new_nativefn("+", repl_seq(1)); + new_string("-", repl_seq(2)); + new_nativefn("-", repl_seq(3)); + new_string("*", repl_seq(4)); + new_nativefn("*", repl_seq(5)); + new_string("/", repl_seq(6)); + new_nativefn("/", repl_seq(7)); + new_seq_obj(mal_hashmap, repl_seq, repl_env); + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step3_env.vhdl b/impls/vhdl/step3_env.vhdl new file mode 100644 index 0000000000..73b8503c3a --- /dev/null +++ b/impls/vhdl/step3_env.vhdl @@ -0,0 +1,215 @@ +entity step3_env is +end entity step3_env; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; + +architecture test of step3_env is + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + -- Forward declaration + procedure EVAL(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr) is + variable num_result: integer; + variable a: mal_seq_ptr; + begin + a := args.seq_val; + if func_sym.string_val.all = "+" then + new_number(a(0).number_val + a(1).number_val, result); + elsif func_sym.string_val.all = "-" then + new_number(a(0).number_val - a(1).number_val, result); + elsif func_sym.string_val.all = "*" then + new_number(a(0).number_val * a(1).number_val, result); + elsif func_sym.string_val.all = "/" then + new_number(a(0).number_val / a(1).number_val, result); + else + result := null; + end if; + end procedure eval_native_func; + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(ast : inout mal_val_ptr; + env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable let_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + deallocate(let_env); + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + EVAL(ast.seq_val(2), let_env, result, err); + deallocate(let_env); + else + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + eval_native_func(fn, call_args, result); + end if; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable ast, eval_res, read_err, eval_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure repl is + variable is_eof: boolean; + variable input_line, result: line; + variable sym, fn, err: mal_val_ptr; + variable outer, repl_env: env_ptr; + begin + outer := null; + new_env(repl_env, outer); + new_symbol("+", sym); + new_nativefn("+", fn); + env_set(repl_env, sym, fn); + new_symbol("-", sym); + new_nativefn("-", fn); + env_set(repl_env, sym, fn); + new_symbol("*", sym); + new_nativefn("*", fn); + env_set(repl_env, sym, fn); + new_symbol("/", sym); + new_nativefn("/", fn); + env_set(repl_env, sym, fn); + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step4_if_fn_do.vhdl b/impls/vhdl/step4_if_fn_do.vhdl new file mode 100644 index 0000000000..6e63f77f72 --- /dev/null +++ b/impls/vhdl/step4_if_fn_do.vhdl @@ -0,0 +1,241 @@ +entity step4_if_fn_do is +end entity step4_if_fn_do; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; +use WORK.core.all; + +architecture test of step4_if_fn_do is + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + -- Forward declaration + procedure EVAL(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(ast : inout mal_val_ptr; + env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable let_env, fn_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.val_type = mal_symbol then + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + EVAL(ast.seq_val(2), let_env, result, err); + return; + + elsif a0.string_val.all = "do" then + for i in 1 to ast.seq_val'high loop + EVAL(ast.seq_val(i), env, result, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + return; + + elsif a0.string_val.all = "if" then + EVAL(ast.seq_val(1), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + if val.val_type = mal_nil or val.val_type = mal_false then + if ast.seq_val'length > 3 then + EVAL(ast.seq_val(3), env, result, err); + else + new_nil(result); + end if; + else + EVAL(ast.seq_val(2), env, result, err); + end if; + return; + + elsif a0.string_val.all = "fn*" then + new_fn(ast.seq_val(2), ast.seq_val(1), env, result); + return; + + end if; + end if; + + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + case fn.val_type is + when mal_nativefn => + eval_native_func(fn, call_args, result, err); + when mal_fn => + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + EVAL(fn.func_val.f_body, fn_env, result, err); + when others => + new_string("not a function", err); + end case; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, result, err); + end procedure RE; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable eval_res, eval_err: mal_val_ptr; + begin + RE(str, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure repl is + variable is_eof: boolean; + variable input_line, result: line; + variable dummy_val, err: mal_val_ptr; + variable outer, repl_env: env_ptr; + begin + outer := null; + new_env(repl_env, outer); + + -- core.EXT: defined using VHDL (see core.vhdl) + define_core_functions(repl_env); + + -- core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step5_tco.vhdl b/impls/vhdl/step5_tco.vhdl new file mode 100644 index 0000000000..617d4ee6ed --- /dev/null +++ b/impls/vhdl/step5_tco.vhdl @@ -0,0 +1,253 @@ +entity step5_tco is +end entity step5_tco; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; +use WORK.core.all; + +architecture test of step5_tco is + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + -- Forward declaration + procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable ast : mal_val_ptr := in_ast; + variable env : env_ptr := in_env; + variable let_env, fn_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + loop + + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.val_type = mal_symbol then + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + env := let_env; + ast := ast.seq_val(2); + next; -- TCO + + elsif a0.string_val.all = "do" then + for i in 1 to ast.seq_val'high - 1 loop + EVAL(ast.seq_val(i), env, result, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + ast := ast.seq_val(ast.seq_val'high); + next; -- TCO + + elsif a0.string_val.all = "if" then + EVAL(ast.seq_val(1), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + if val.val_type = mal_nil or val.val_type = mal_false then + if ast.seq_val'length > 3 then + ast := ast.seq_val(3); + else + new_nil(result); + return; + end if; + else + ast := ast.seq_val(2); + end if; + next; -- TCO + + elsif a0.string_val.all = "fn*" then + new_fn(ast.seq_val(2), ast.seq_val(1), env, result); + return; + + end if; + end if; + + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + case fn.val_type is + when mal_nativefn => + eval_native_func(fn, call_args, result, err); + return; + when mal_fn => + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + env := fn_env; + ast := fn.func_val.f_body; + next; -- TCO + when others => + new_string("not a function", err); + return; + end case; + end loop; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, result, err); + end procedure RE; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable eval_res, eval_err: mal_val_ptr; + begin + RE(str, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure repl is + variable is_eof: boolean; + variable input_line, result: line; + variable dummy_val, err: mal_val_ptr; + variable outer, repl_env: env_ptr; + begin + outer := null; + new_env(repl_env, outer); + + -- core.EXT: defined using VHDL (see core.vhdl) + define_core_functions(repl_env); + + -- core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step6_file.vhdl b/impls/vhdl/step6_file.vhdl new file mode 100644 index 0000000000..3b21c0e37e --- /dev/null +++ b/impls/vhdl/step6_file.vhdl @@ -0,0 +1,343 @@ +entity step6_file is +end entity step6_file; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; +use WORK.core.all; + +architecture test of step6_file is + + shared variable repl_env: env_ptr; + + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + -- Forward declaration + procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + EVAL(args.seq_val(0), repl_env, result, err); + end procedure fn_eval; + + procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable atom: mal_val_ptr := args.seq_val(0); + variable fn: mal_val_ptr := args.seq_val(1); + variable call_args_seq: mal_seq_ptr; + variable call_args, eval_res, sub_err: mal_val_ptr; + begin + call_args_seq := new mal_seq(0 to args.seq_val'length - 2); + call_args_seq(0) := atom.seq_val(0); + call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); + new_seq_obj(mal_list, call_args_seq, call_args); + apply_func(fn, call_args, eval_res, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + atom.seq_val(0) := eval_res; + result := eval_res; + end procedure fn_swap; + + procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + if func_sym.string_val.all = "eval" then + fn_eval(args, result, err); + elsif func_sym.string_val.all = "swap!" then + fn_swap(args, result, err); + else + eval_native_func(func_sym, args, result, err); + end if; + end procedure apply_native_func; + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn_env: env_ptr; + begin + case fn.val_type is + when mal_nativefn => + apply_native_func(fn, args, result, err); + when mal_fn => + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); + EVAL(fn.func_val.f_body, fn_env, result, err); + when others => + new_string("not a function", err); + return; + end case; + end procedure apply_func; + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable ast : mal_val_ptr := in_ast; + variable env : env_ptr := in_env; + variable let_env, fn_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + loop + + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.val_type = mal_symbol then + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + env := let_env; + ast := ast.seq_val(2); + next; -- TCO + + elsif a0.string_val.all = "do" then + for i in 1 to ast.seq_val'high - 1 loop + EVAL(ast.seq_val(i), env, result, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + ast := ast.seq_val(ast.seq_val'high); + next; -- TCO + + elsif a0.string_val.all = "if" then + EVAL(ast.seq_val(1), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + if val.val_type = mal_nil or val.val_type = mal_false then + if ast.seq_val'length > 3 then + ast := ast.seq_val(3); + else + new_nil(result); + return; + end if; + else + ast := ast.seq_val(2); + end if; + next; -- TCO + + elsif a0.string_val.all = "fn*" then + new_fn(ast.seq_val(2), ast.seq_val(1), env, result); + return; + + end if; + end if; + + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + -- Special-case functions for TCO + if fn.val_type = mal_fn then + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + env := fn_env; + ast := fn.func_val.f_body; + next; -- TCO + end if; + apply_func(fn, call_args, result, err); + return; + end loop; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, result, err); + end procedure RE; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable eval_res, eval_err: mal_val_ptr; + begin + RE(str, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure set_argv(e: inout env_ptr; program_file: inout line) is + variable argv_var_name: string(1 to 6) := "*ARGV*"; + variable argv_sym, argv_list: mal_val_ptr; + file f: text; + variable status: file_open_status; + variable one_line: line; + variable seq: mal_seq_ptr; + variable element: mal_val_ptr; + begin + program_file := null; + seq := new mal_seq(0 to -1); + file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); + if status = open_ok then + if not endfile(f) then + readline(f, program_file); + while not endfile(f) loop + readline(f, one_line); + new_string(one_line.all, element); + seq := new mal_seq'(seq.all & element); + end loop; + end if; + file_close(f); + end if; + new_seq_obj(mal_list, seq, argv_list); + new_symbol(argv_var_name, argv_sym); + env_set(e, argv_sym, argv_list); + end procedure set_argv; + + procedure repl is + variable is_eof: boolean; + variable program_file, input_line, result: line; + variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; + variable outer: env_ptr; + variable eval_func_name: string(1 to 4) := "eval"; + begin + outer := null; + new_env(repl_env, outer); + + -- core.EXT: defined using VHDL (see core.vhdl) + define_core_functions(repl_env); + new_symbol(eval_func_name, eval_sym); + new_nativefn(eval_func_name, eval_fn); + env_set(repl_env, eval_sym, eval_fn); + set_argv(repl_env, program_file); + + -- core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); + RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); + + if program_file /= null then + REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); + return; + end if; + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step7_quote.vhdl b/impls/vhdl/step7_quote.vhdl new file mode 100644 index 0000000000..b9f68d7621 --- /dev/null +++ b/impls/vhdl/step7_quote.vhdl @@ -0,0 +1,423 @@ +entity step7_quote is +end entity step7_quote; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; +use WORK.core.all; + +architecture test of step7_quote is + + shared variable repl_env: env_ptr; + + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is + begin + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; + + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); + begin + if sw then + starts_with(elt, "splice-unquote", sw); + end if; + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); + else + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); + end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; + end procedure quasiquote; + + -- Forward declaration + procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + EVAL(args.seq_val(0), repl_env, result, err); + end procedure fn_eval; + + procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable atom: mal_val_ptr := args.seq_val(0); + variable fn: mal_val_ptr := args.seq_val(1); + variable call_args_seq: mal_seq_ptr; + variable call_args, eval_res, sub_err: mal_val_ptr; + begin + call_args_seq := new mal_seq(0 to args.seq_val'length - 2); + call_args_seq(0) := atom.seq_val(0); + call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); + new_seq_obj(mal_list, call_args_seq, call_args); + apply_func(fn, call_args, eval_res, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + atom.seq_val(0) := eval_res; + result := eval_res; + end procedure fn_swap; + + procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + if func_sym.string_val.all = "eval" then + fn_eval(args, result, err); + elsif func_sym.string_val.all = "swap!" then + fn_swap(args, result, err); + else + eval_native_func(func_sym, args, result, err); + end if; + end procedure apply_native_func; + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn_env: env_ptr; + begin + case fn.val_type is + when mal_nativefn => + apply_native_func(fn, args, result, err); + when mal_fn => + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); + EVAL(fn.func_val.f_body, fn_env, result, err); + when others => + new_string("not a function", err); + return; + end case; + end procedure apply_func; + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable ast : mal_val_ptr := in_ast; + variable env : env_ptr := in_env; + variable let_env, fn_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + loop + + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.val_type = mal_symbol then + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + env := let_env; + ast := ast.seq_val(2); + next; -- TCO + + elsif a0.string_val.all = "quote" then + result := ast.seq_val(1); + return; + + elsif a0.string_val.all = "quasiquote" then + quasiquote(ast.seq_val(1), ast); + next; -- TCO + + elsif a0.string_val.all = "do" then + for i in 1 to ast.seq_val'high - 1 loop + EVAL(ast.seq_val(i), env, result, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + ast := ast.seq_val(ast.seq_val'high); + next; -- TCO + + elsif a0.string_val.all = "if" then + EVAL(ast.seq_val(1), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + if val.val_type = mal_nil or val.val_type = mal_false then + if ast.seq_val'length > 3 then + ast := ast.seq_val(3); + else + new_nil(result); + return; + end if; + else + ast := ast.seq_val(2); + end if; + next; -- TCO + + elsif a0.string_val.all = "fn*" then + new_fn(ast.seq_val(2), ast.seq_val(1), env, result); + return; + + end if; + end if; + + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + -- Special-case functions for TCO + if fn.val_type = mal_fn then + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + env := fn_env; + ast := fn.func_val.f_body; + next; -- TCO + end if; + apply_func(fn, call_args, result, err); + return; + end loop; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, result, err); + end procedure RE; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable eval_res, eval_err: mal_val_ptr; + begin + RE(str, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure set_argv(e: inout env_ptr; program_file: inout line) is + variable argv_var_name: string(1 to 6) := "*ARGV*"; + variable argv_sym, argv_list: mal_val_ptr; + file f: text; + variable status: file_open_status; + variable one_line: line; + variable seq: mal_seq_ptr; + variable element: mal_val_ptr; + begin + program_file := null; + seq := new mal_seq(0 to -1); + file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); + if status = open_ok then + if not endfile(f) then + readline(f, program_file); + while not endfile(f) loop + readline(f, one_line); + new_string(one_line.all, element); + seq := new mal_seq'(seq.all & element); + end loop; + end if; + file_close(f); + end if; + new_seq_obj(mal_list, seq, argv_list); + new_symbol(argv_var_name, argv_sym); + env_set(e, argv_sym, argv_list); + end procedure set_argv; + + procedure repl is + variable is_eof: boolean; + variable program_file, input_line, result: line; + variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; + variable outer: env_ptr; + variable eval_func_name: string(1 to 4) := "eval"; + begin + outer := null; + new_env(repl_env, outer); + + -- core.EXT: defined using VHDL (see core.vhdl) + define_core_functions(repl_env); + new_symbol(eval_func_name, eval_sym); + new_nativefn(eval_func_name, eval_fn); + env_set(repl_env, eval_sym, eval_fn); + set_argv(repl_env, program_file); + + -- core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); + RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); + + if program_file /= null then + REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); + return; + end if; + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step8_macros.vhdl b/impls/vhdl/step8_macros.vhdl new file mode 100644 index 0000000000..b78c865a7a --- /dev/null +++ b/impls/vhdl/step8_macros.vhdl @@ -0,0 +1,446 @@ +entity step8_macros is +end entity step8_macros; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; +use WORK.core.all; + +architecture test of step8_macros is + + shared variable repl_env: env_ptr; + + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is + begin + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; + + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); + begin + if sw then + starts_with(elt, "splice-unquote", sw); + end if; + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); + else + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); + end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; + end procedure quasiquote; + + -- Forward declaration + procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + EVAL(args.seq_val(0), repl_env, result, err); + end procedure fn_eval; + + procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable atom: mal_val_ptr := args.seq_val(0); + variable fn: mal_val_ptr := args.seq_val(1); + variable call_args_seq: mal_seq_ptr; + variable call_args, eval_res, sub_err: mal_val_ptr; + begin + call_args_seq := new mal_seq(0 to args.seq_val'length - 2); + call_args_seq(0) := atom.seq_val(0); + call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); + new_seq_obj(mal_list, call_args_seq, call_args); + apply_func(fn, call_args, eval_res, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + atom.seq_val(0) := eval_res; + result := eval_res; + end procedure fn_swap; + + procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + if func_sym.string_val.all = "eval" then + fn_eval(args, result, err); + elsif func_sym.string_val.all = "swap!" then + fn_swap(args, result, err); + else + eval_native_func(func_sym, args, result, err); + end if; + end procedure apply_native_func; + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn_env: env_ptr; + begin + case fn.val_type is + when mal_nativefn => + apply_native_func(fn, args, result, err); + when mal_fn => + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); + EVAL(fn.func_val.f_body, fn_env, result, err); + when others => + new_string("not a function", err); + return; + end case; + end procedure apply_func; + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable ast : mal_val_ptr := in_ast; + variable env : env_ptr := in_env; + variable let_env, fn_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + loop + + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.val_type = mal_symbol then + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + env := let_env; + ast := ast.seq_val(2); + next; -- TCO + + elsif a0.string_val.all = "quote" then + result := ast.seq_val(1); + return; + + elsif a0.string_val.all = "quasiquote" then + quasiquote(ast.seq_val(1), ast); + next; -- TCO + + elsif a0.string_val.all = "defmacro!" then + EVAL(ast.seq_val(2), env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_fn(fn.func_val.f_body, fn.func_val.f_args, fn.func_val.f_env, val); + val.func_val.f_is_macro := true; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "do" then + for i in 1 to ast.seq_val'high - 1 loop + EVAL(ast.seq_val(i), env, result, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + ast := ast.seq_val(ast.seq_val'high); + next; -- TCO + + elsif a0.string_val.all = "if" then + EVAL(ast.seq_val(1), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + if val.val_type = mal_nil or val.val_type = mal_false then + if ast.seq_val'length > 3 then + ast := ast.seq_val(3); + else + new_nil(result); + return; + end if; + else + ast := ast.seq_val(2); + end if; + next; -- TCO + + elsif a0.string_val.all = "fn*" then + new_fn(ast.seq_val(2), ast.seq_val(1), env, result); + return; + + end if; + end if; + + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Special-case macros + if fn.val_type = mal_fn and fn.func_val.f_is_macro then + seq_drop_prefix(ast, 1, call_args); + apply_func(fn, call_args, ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + next; -- TCO + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + -- Special-case functions for TCO + if fn.val_type = mal_fn then + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + env := fn_env; + ast := fn.func_val.f_body; + next; -- TCO + end if; + apply_func(fn, call_args, result, err); + return; + end loop; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, result, err); + end procedure RE; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable eval_res, eval_err: mal_val_ptr; + begin + RE(str, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure set_argv(e: inout env_ptr; program_file: inout line) is + variable argv_var_name: string(1 to 6) := "*ARGV*"; + variable argv_sym, argv_list: mal_val_ptr; + file f: text; + variable status: file_open_status; + variable one_line: line; + variable seq: mal_seq_ptr; + variable element: mal_val_ptr; + begin + program_file := null; + seq := new mal_seq(0 to -1); + file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); + if status = open_ok then + if not endfile(f) then + readline(f, program_file); + while not endfile(f) loop + readline(f, one_line); + new_string(one_line.all, element); + seq := new mal_seq'(seq.all & element); + end loop; + end if; + file_close(f); + end if; + new_seq_obj(mal_list, seq, argv_list); + new_symbol(argv_var_name, argv_sym); + env_set(e, argv_sym, argv_list); + end procedure set_argv; + + procedure repl is + variable is_eof: boolean; + variable program_file, input_line, result: line; + variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; + variable outer: env_ptr; + variable eval_func_name: string(1 to 4) := "eval"; + begin + outer := null; + new_env(repl_env, outer); + + -- core.EXT: defined using VHDL (see core.vhdl) + define_core_functions(repl_env); + new_symbol(eval_func_name, eval_sym); + new_nativefn(eval_func_name, eval_fn); + env_set(repl_env, eval_sym, eval_fn); + set_argv(repl_env, program_file); + + -- core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); + RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " & '"' & "odd number of forms to cond" & '"' & ")) (cons 'cond (rest (rest xs)))))))", repl_env, dummy_val, err); + + if program_file /= null then + REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); + return; + end if; + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/step9_try.vhdl b/impls/vhdl/step9_try.vhdl new file mode 100644 index 0000000000..34ad23e9b4 --- /dev/null +++ b/impls/vhdl/step9_try.vhdl @@ -0,0 +1,504 @@ +entity step9_try is +end entity step9_try; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; +use WORK.core.all; + +architecture test of step9_try is + + shared variable repl_env: env_ptr; + + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is + begin + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; + + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); + begin + if sw then + starts_with(elt, "splice-unquote", sw); + end if; + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); + else + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); + end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; + end procedure quasiquote; + + -- Forward declaration + procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + EVAL(args.seq_val(0), repl_env, result, err); + end procedure fn_eval; + + procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable atom: mal_val_ptr := args.seq_val(0); + variable fn: mal_val_ptr := args.seq_val(1); + variable call_args_seq: mal_seq_ptr; + variable call_args, eval_res, sub_err: mal_val_ptr; + begin + call_args_seq := new mal_seq(0 to args.seq_val'length - 2); + call_args_seq(0) := atom.seq_val(0); + call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); + new_seq_obj(mal_list, call_args_seq, call_args); + apply_func(fn, call_args, eval_res, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + atom.seq_val(0) := eval_res; + result := eval_res; + end procedure fn_swap; + + procedure fn_apply(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn: mal_val_ptr := args.seq_val(0); + variable rest: mal_val_ptr; + variable mid_args_count, rest_args_count: integer; + variable call_args: mal_val_ptr; + variable call_args_seq: mal_seq_ptr; + begin + rest := args.seq_val(args.seq_val'high); + mid_args_count := args.seq_val'length - 2; + rest_args_count := rest.seq_val'length; + call_args_seq := new mal_seq(0 to mid_args_count + rest_args_count - 1); + call_args_seq(0 to mid_args_count - 1) := args.seq_val(1 to args.seq_val'length - 2); + call_args_seq(mid_args_count to call_args_seq'high) := rest.seq_val(rest.seq_val'range); + new_seq_obj(mal_list, call_args_seq, call_args); + apply_func(fn, call_args, result, err); + end procedure fn_apply; + + procedure fn_map(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn: mal_val_ptr := args.seq_val(0); + variable lst: mal_val_ptr := args.seq_val(1); + variable call_args, sub_err: mal_val_ptr; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + new_seq := new mal_seq(lst.seq_val'range); -- (0 to lst.seq_val.length - 1); + for i in new_seq'range loop + new_one_element_list(lst.seq_val(i), call_args); + apply_func(fn, call_args, new_seq(i), sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + new_seq_obj(mal_list, new_seq, result); + end procedure fn_map; + + procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + if func_sym.string_val.all = "eval" then + fn_eval(args, result, err); + elsif func_sym.string_val.all = "swap!" then + fn_swap(args, result, err); + elsif func_sym.string_val.all = "apply" then + fn_apply(args, result, err); + elsif func_sym.string_val.all = "map" then + fn_map(args, result, err); + else + eval_native_func(func_sym, args, result, err); + end if; + end procedure apply_native_func; + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn_env: env_ptr; + begin + case fn.val_type is + when mal_nativefn => + apply_native_func(fn, args, result, err); + when mal_fn => + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); + EVAL(fn.func_val.f_body, fn_env, result, err); + when others => + new_string("not a function", err); + return; + end case; + end procedure apply_func; + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable ast : mal_val_ptr := in_ast; + variable env : env_ptr := in_env; + variable let_env, catch_env, fn_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + loop + + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.val_type = mal_symbol then + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + env := let_env; + ast := ast.seq_val(2); + next; -- TCO + + elsif a0.string_val.all = "quote" then + result := ast.seq_val(1); + return; + + elsif a0.string_val.all = "quasiquote" then + quasiquote(ast.seq_val(1), ast); + next; -- TCO + + elsif a0.string_val.all = "defmacro!" then + EVAL(ast.seq_val(2), env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_fn(fn.func_val.f_body, fn.func_val.f_args, fn.func_val.f_env, val); + val.func_val.f_is_macro := true; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "try*" then + EVAL(ast.seq_val(1), env, result, sub_err); + if sub_err /= null then + if ast.seq_val'length > 2 and + ast.seq_val(2).val_type = mal_list and + ast.seq_val(2).seq_val(0).val_type = mal_symbol and + ast.seq_val(2).seq_val(0).string_val.all = "catch*" then + new_one_element_list(ast.seq_val(2).seq_val(1), vars); + new_one_element_list(sub_err, call_args); + new_env(catch_env, env, vars, call_args); + EVAL(ast.seq_val(2).seq_val(2), catch_env, result, err); + else + err := sub_err; + return; + end if; + end if; + return; + + elsif a0.string_val.all = "do" then + for i in 1 to ast.seq_val'high - 1 loop + EVAL(ast.seq_val(i), env, result, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + ast := ast.seq_val(ast.seq_val'high); + next; -- TCO + + elsif a0.string_val.all = "if" then + EVAL(ast.seq_val(1), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + if val.val_type = mal_nil or val.val_type = mal_false then + if ast.seq_val'length > 3 then + ast := ast.seq_val(3); + else + new_nil(result); + return; + end if; + else + ast := ast.seq_val(2); + end if; + next; -- TCO + + elsif a0.string_val.all = "fn*" then + new_fn(ast.seq_val(2), ast.seq_val(1), env, result); + return; + + end if; + end if; + + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Special-case macros + if fn.val_type = mal_fn and fn.func_val.f_is_macro then + seq_drop_prefix(ast, 1, call_args); + apply_func(fn, call_args, ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + next; -- TCO + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + -- Special-case functions for TCO + if fn.val_type = mal_fn then + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + env := fn_env; + ast := fn.func_val.f_body; + next; -- TCO + end if; + apply_func(fn, call_args, result, err); + return; + end loop; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, result, err); + end procedure RE; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable eval_res, eval_err: mal_val_ptr; + begin + RE(str, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure set_argv(e: inout env_ptr; program_file: inout line) is + variable argv_var_name: string(1 to 6) := "*ARGV*"; + variable argv_sym, argv_list: mal_val_ptr; + file f: text; + variable status: file_open_status; + variable one_line: line; + variable seq: mal_seq_ptr; + variable element: mal_val_ptr; + begin + program_file := null; + seq := new mal_seq(0 to -1); + file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); + if status = open_ok then + if not endfile(f) then + readline(f, program_file); + while not endfile(f) loop + readline(f, one_line); + new_string(one_line.all, element); + seq := new mal_seq'(seq.all & element); + end loop; + end if; + file_close(f); + end if; + new_seq_obj(mal_list, seq, argv_list); + new_symbol(argv_var_name, argv_sym); + env_set(e, argv_sym, argv_list); + end procedure set_argv; + + procedure repl is + variable is_eof: boolean; + variable program_file, input_line, result: line; + variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; + variable outer: env_ptr; + variable eval_func_name: string(1 to 4) := "eval"; + begin + outer := null; + new_env(repl_env, outer); + + -- core.EXT: defined using VHDL (see core.vhdl) + define_core_functions(repl_env); + new_symbol(eval_func_name, eval_sym); + new_nativefn(eval_func_name, eval_fn); + env_set(repl_env, eval_sym, eval_fn); + set_argv(repl_env, program_file); + + -- core.mal: defined using the language itself + RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); + RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " & '"' & "odd number of forms to cond" & '"' & ")) (cons 'cond (rest (rest xs)))))))", repl_env, dummy_val, err); + + if program_file /= null then + REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); + return; + end if; + + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/stepA_mal.vhdl b/impls/vhdl/stepA_mal.vhdl new file mode 100644 index 0000000000..570e55dd10 --- /dev/null +++ b/impls/vhdl/stepA_mal.vhdl @@ -0,0 +1,506 @@ +entity stepA_mal is +end entity stepA_mal; + +library STD; +use STD.textio.all; +library WORK; +use WORK.pkg_readline.all; +use WORK.types.all; +use WORK.printer.all; +use WORK.reader.all; +use WORK.env.all; +use WORK.core.all; + +architecture test of stepA_mal is + + shared variable repl_env: env_ptr; + + procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is + begin + read_str(str, ast, err); + end procedure mal_READ; + + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is + begin + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; + + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); + begin + if sw then + starts_with(elt, "splice-unquote", sw); + end if; + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); + else + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); + end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; + end procedure quasiquote; + + -- Forward declaration + procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); + + procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + EVAL(args.seq_val(0), repl_env, result, err); + end procedure fn_eval; + + procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable atom: mal_val_ptr := args.seq_val(0); + variable fn: mal_val_ptr := args.seq_val(1); + variable call_args_seq: mal_seq_ptr; + variable call_args, eval_res, sub_err: mal_val_ptr; + begin + call_args_seq := new mal_seq(0 to args.seq_val'length - 2); + call_args_seq(0) := atom.seq_val(0); + call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); + new_seq_obj(mal_list, call_args_seq, call_args); + apply_func(fn, call_args, eval_res, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + atom.seq_val(0) := eval_res; + result := eval_res; + end procedure fn_swap; + + procedure fn_apply(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn: mal_val_ptr := args.seq_val(0); + variable rest: mal_val_ptr; + variable mid_args_count, rest_args_count: integer; + variable call_args: mal_val_ptr; + variable call_args_seq: mal_seq_ptr; + begin + rest := args.seq_val(args.seq_val'high); + mid_args_count := args.seq_val'length - 2; + rest_args_count := rest.seq_val'length; + call_args_seq := new mal_seq(0 to mid_args_count + rest_args_count - 1); + call_args_seq(0 to mid_args_count - 1) := args.seq_val(1 to args.seq_val'length - 2); + call_args_seq(mid_args_count to call_args_seq'high) := rest.seq_val(rest.seq_val'range); + new_seq_obj(mal_list, call_args_seq, call_args); + apply_func(fn, call_args, result, err); + end procedure fn_apply; + + procedure fn_map(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn: mal_val_ptr := args.seq_val(0); + variable lst: mal_val_ptr := args.seq_val(1); + variable call_args, sub_err: mal_val_ptr; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + new_seq := new mal_seq(lst.seq_val'range); -- (0 to lst.seq_val.length - 1); + for i in new_seq'range loop + new_one_element_list(lst.seq_val(i), call_args); + apply_func(fn, call_args, new_seq(i), sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + new_seq_obj(mal_list, new_seq, result); + end procedure fn_map; + + procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + if func_sym.string_val.all = "eval" then + fn_eval(args, result, err); + elsif func_sym.string_val.all = "swap!" then + fn_swap(args, result, err); + elsif func_sym.string_val.all = "apply" then + fn_apply(args, result, err); + elsif func_sym.string_val.all = "map" then + fn_map(args, result, err); + else + eval_native_func(func_sym, args, result, err); + end if; + end procedure apply_native_func; + + procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable fn_env: env_ptr; + begin + case fn.val_type is + when mal_nativefn => + apply_native_func(fn, args, result, err); + when mal_fn => + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); + EVAL(fn.func_val.f_body, fn_env, result, err); + when others => + new_string("not a function", err); + return; + end case; + end procedure apply_func; + + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is + variable eval_err: mal_val_ptr; + begin + result := new mal_seq(0 to ast_seq'length - 1 - skip); + for i in result'range loop + EVAL(ast_seq(skip + i), env, result(i), eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + end loop; + end procedure eval_ast_seq; + + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is + variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; + variable ast : mal_val_ptr := in_ast; + variable env : env_ptr := in_env; + variable let_env, catch_env, fn_env : env_ptr; + variable s: line; + variable new_seq: mal_seq_ptr; + variable i: integer; + begin + loop + + new_symbol("DEBUG-EVAL", a0); + env_get(env, a0, val); + if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false + then + mal_printstr("EVAL: "); + pr_str(ast, true, s); + mal_printline(s.all); + end if; + + case ast.val_type is + when mal_symbol => + env_get(env, ast, val); + if val = null then + new_string("'" & ast.string_val.all & "' not found", err); + return; + end if; + result := val; + return; + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); + if eval_err /= null then + err := eval_err; + return; + end if; + new_seq_obj(ast.val_type, new_seq, result); + return; + when others => + result := ast; + return; + end case; + + if ast.seq_val'length = 0 then + result := ast; + return; + end if; + + a0 := ast.seq_val(0); + if a0.val_type = mal_symbol then + if a0.string_val.all = "def!" then + EVAL(ast.seq_val(2), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "let*" then + vars := ast.seq_val(1); + new_env(let_env, env); + i := 0; + while i < vars.seq_val'length loop + EVAL(vars.seq_val(i + 1), let_env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + env_set(let_env, vars.seq_val(i), val); + i := i + 2; + end loop; + env := let_env; + ast := ast.seq_val(2); + next; -- TCO + + elsif a0.string_val.all = "quote" then + result := ast.seq_val(1); + return; + + elsif a0.string_val.all = "quasiquote" then + quasiquote(ast.seq_val(1), ast); + next; -- TCO + + elsif a0.string_val.all = "defmacro!" then + EVAL(ast.seq_val(2), env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_fn(fn.func_val.f_body, fn.func_val.f_args, fn.func_val.f_env, val); + val.func_val.f_is_macro := true; + env_set(env, ast.seq_val(1), val); + result := val; + return; + + elsif a0.string_val.all = "try*" then + EVAL(ast.seq_val(1), env, result, sub_err); + if sub_err /= null then + if ast.seq_val'length > 2 and + ast.seq_val(2).val_type = mal_list and + ast.seq_val(2).seq_val(0).val_type = mal_symbol and + ast.seq_val(2).seq_val(0).string_val.all = "catch*" then + new_one_element_list(ast.seq_val(2).seq_val(1), vars); + new_one_element_list(sub_err, call_args); + new_env(catch_env, env, vars, call_args); + EVAL(ast.seq_val(2).seq_val(2), catch_env, result, err); + else + err := sub_err; + return; + end if; + end if; + return; + + elsif a0.string_val.all = "do" then + for i in 1 to ast.seq_val'high - 1 loop + EVAL(ast.seq_val(i), env, result, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + end loop; + ast := ast.seq_val(ast.seq_val'high); + next; -- TCO + + elsif a0.string_val.all = "if" then + EVAL(ast.seq_val(1), env, val, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + if val.val_type = mal_nil or val.val_type = mal_false then + if ast.seq_val'length > 3 then + ast := ast.seq_val(3); + else + new_nil(result); + return; + end if; + else + ast := ast.seq_val(2); + end if; + next; -- TCO + + elsif a0.string_val.all = "fn*" then + new_fn(ast.seq_val(2), ast.seq_val(1), env, result); + return; + + end if; + end if; + + EVAL (a0, env, fn, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + -- Special-case macros + if fn.val_type = mal_fn and fn.func_val.f_is_macro then + seq_drop_prefix(ast, 1, call_args); + apply_func(fn, call_args, ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + next; -- TCO + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, new_seq, call_args); + -- Special-case functions for TCO + if fn.val_type = mal_fn then + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + env := fn_env; + ast := fn.func_val.f_body; + next; -- TCO + end if; + apply_func(fn, call_args, result, err); + return; + end loop; + end procedure EVAL; + + procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is + begin + pr_str(exp, true, result); + end procedure mal_PRINT; + + procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + variable ast, read_err: mal_val_ptr; + begin + mal_READ(str, ast, read_err); + if read_err /= null then + err := read_err; + result := null; + return; + end if; + if ast = null then + result := null; + return; + end if; + EVAL(ast, env, result, err); + end procedure RE; + + procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is + variable eval_res, eval_err: mal_val_ptr; + begin + RE(str, env, eval_res, eval_err); + if eval_err /= null then + err := eval_err; + result := null; + return; + end if; + mal_PRINT(eval_res, result); + end procedure REP; + + procedure set_argv(e: inout env_ptr; program_file: inout line) is + variable argv_var_name: string(1 to 6) := "*ARGV*"; + variable argv_sym, argv_list: mal_val_ptr; + file f: text; + variable status: file_open_status; + variable one_line: line; + variable seq: mal_seq_ptr; + variable element: mal_val_ptr; + begin + program_file := null; + seq := new mal_seq(0 to -1); + file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); + if status = open_ok then + if not endfile(f) then + readline(f, program_file); + while not endfile(f) loop + readline(f, one_line); + new_string(one_line.all, element); + seq := new mal_seq'(seq.all & element); + end loop; + end if; + file_close(f); + end if; + new_seq_obj(mal_list, seq, argv_list); + new_symbol(argv_var_name, argv_sym); + env_set(e, argv_sym, argv_list); + end procedure set_argv; + + procedure repl is + variable is_eof: boolean; + variable program_file, input_line, result: line; + variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; + variable outer: env_ptr; + variable eval_func_name: string(1 to 4) := "eval"; + begin + outer := null; + new_env(repl_env, outer); + + -- core.EXT: defined using VHDL (see core.vhdl) + define_core_functions(repl_env); + new_symbol(eval_func_name, eval_sym); + new_nativefn(eval_func_name, eval_fn); + env_set(repl_env, eval_sym, eval_fn); + set_argv(repl_env, program_file); + + -- core.mal: defined using the language itself + RE("(def! *host-language* " & '"' & "vhdl" & '"' & ")", repl_env, dummy_val, err); + RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); + RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); + RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " & '"' & "odd number of forms to cond" & '"' & ")) (cons 'cond (rest (rest xs)))))))", repl_env, dummy_val, err); + + if program_file /= null then + REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); + return; + end if; + + RE("(println (str " & '"' & "Mal [" & '"' & " *host-language* " & '"' & "]" & '"' & "))", repl_env, dummy_val, err); + loop + mal_readline("user> ", is_eof, input_line); + exit when is_eof; + next when input_line'length = 0; + REP(input_line.all, repl_env, result, err); + if err /= null then + pr_str(err, false, result); + result := new string'("Error: " & result.all); + end if; + if result /= null then + mal_printline(result.all); + end if; + deallocate(result); + deallocate(err); + end loop; + mal_printline(""); + end procedure repl; + +begin + repl; +end architecture test; diff --git a/impls/vhdl/types.vhdl b/impls/vhdl/types.vhdl new file mode 100644 index 0000000000..f481f64e77 --- /dev/null +++ b/impls/vhdl/types.vhdl @@ -0,0 +1,378 @@ +library STD; +use STD.textio.all; + +package types is + + procedure debugline(l: inout line); + procedure debug(str: in string); + procedure debug(ch: in character); + procedure debug(i: in integer); + + type mal_type_tag is (mal_nil, mal_true, mal_false, mal_number, + mal_symbol, mal_string, mal_keyword, + mal_list, mal_vector, mal_hashmap, + mal_atom, mal_nativefn, mal_fn); + + -- Forward declarations + type mal_val; + type mal_seq; + type mal_func; + type env_record; + + type mal_val_ptr is access mal_val; + type mal_seq_ptr is access mal_seq; + type mal_func_ptr is access mal_func; + type env_ptr is access env_record; + + type mal_val is record + val_type: mal_type_tag; + number_val: integer; -- For types: number + string_val: line; -- For types: symbol, string, keyword, nativefn + seq_val: mal_seq_ptr; -- For types: list, vector, hashmap, atom + func_val: mal_func_ptr; -- For fn + meta_val: mal_val_ptr; + end record mal_val; + + type mal_seq is array (natural range <>) of mal_val_ptr; + + type mal_func is record + f_body: mal_val_ptr; + f_args: mal_val_ptr; + f_env: env_ptr; + f_is_macro: boolean; + end record mal_func; + + type env_record is record + outer: env_ptr; + data: mal_val_ptr; + end record env_record; + + procedure new_nil(obj: out mal_val_ptr); + procedure new_true(obj: out mal_val_ptr); + procedure new_false(obj: out mal_val_ptr); + procedure new_boolean(b: in boolean; obj: out mal_val_ptr); + procedure new_number(v: in integer; obj: out mal_val_ptr); + procedure new_symbol(name: in string; obj: out mal_val_ptr); + procedure new_symbol(name: inout line; obj: out mal_val_ptr); + procedure new_string(name: in string; obj: out mal_val_ptr); + procedure new_string(name: inout line; obj: out mal_val_ptr); + procedure new_keyword(name: in string; obj: out mal_val_ptr); + procedure new_keyword(name: inout line; obj: out mal_val_ptr); + procedure new_nativefn(name: in string; obj: out mal_val_ptr); + procedure new_fn(body_ast: inout mal_val_ptr; args: inout mal_val_ptr; env: inout env_ptr; obj: out mal_val_ptr); + procedure new_seq_obj(seq_type: in mal_type_tag; seq: inout mal_seq_ptr; obj: out mal_val_ptr); + procedure new_one_element_list(val: inout mal_val_ptr; obj: out mal_val_ptr); + procedure new_empty_hashmap(obj: out mal_val_ptr); + procedure new_atom(val: inout mal_val_ptr; obj: out mal_val_ptr); + + procedure hashmap_copy(hashmap: inout mal_val_ptr; obj: out mal_val_ptr); + procedure hashmap_get(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: out mal_val_ptr); + procedure hashmap_contains(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; ok: out boolean); + procedure hashmap_put(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr); + procedure hashmap_delete(hashmap: inout mal_val_ptr; key: inout mal_val_ptr); + procedure seq_drop_prefix(src: inout mal_val_ptr; prefix_length: in integer; result: out mal_val_ptr); + function is_sequential_type(t: in mal_type_tag) return boolean; + procedure equal_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean); +end package types; + +package body types is + + procedure debugline(l: inout line) is + variable l2: line; + begin + l2 := new string(1 to 7 + l'length); + l2(1 to l2'length) := "DEBUG: " & l.all; + writeline(output, l2); + end procedure debugline; + + procedure debug(str: in string) is + variable d: line; + begin + write(d, str); + debugline(d); + end procedure debug; + + procedure debug(ch: in character) is + variable d: line; + begin + write(d, ch); + debugline(d); + end procedure debug; + + procedure debug(i: in integer) is + variable d: line; + begin + write(d, i); + debugline(d); + end procedure debug; + + procedure new_nil(obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_nil, number_val => 0, string_val => null, seq_val => null, func_val => null, meta_val => null); + end procedure new_nil; + + procedure new_true(obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_true, number_val => 0, string_val => null, seq_val => null, func_val => null, meta_val => null); + end procedure new_true; + + procedure new_false(obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_false, number_val => 0, string_val => null, seq_val => null, func_val => null, meta_val => null); + end procedure new_false; + + procedure new_boolean(b: in boolean; obj: out mal_val_ptr) is + begin + if b then + new_true(obj); + else + new_false(obj); + end if; + end procedure new_boolean; + + procedure new_number(v: in integer; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_number, number_val => v, string_val => null, seq_val => null, func_val => null, meta_val => null); + end procedure new_number; + + procedure new_symbol(name: in string; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_symbol, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); + end procedure new_symbol; + + procedure new_symbol(name: inout line; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_symbol, number_val => 0, string_val => name, seq_val => null, func_val => null, meta_val => null); + end procedure new_symbol; + + procedure new_string(name: in string; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_string, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); + end procedure new_string; + + procedure new_string(name: inout line; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_string, number_val => 0, string_val => name, seq_val => null, func_val => null, meta_val => null); + end procedure new_string; + + procedure new_keyword(name: in string; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_keyword, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); + end procedure new_keyword; + + procedure new_keyword(name: inout line; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_keyword, number_val => 0, string_val => name, seq_val => null, func_val => null, meta_val => null); + end procedure new_keyword; + + procedure new_nativefn(name: in string; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => mal_nativefn, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); + end procedure new_nativefn; + + procedure new_fn(body_ast: inout mal_val_ptr; args: inout mal_val_ptr; env: inout env_ptr; obj: out mal_val_ptr) is + variable f: mal_func_ptr; + begin + f := new mal_func'(f_body => body_ast, f_args => args, f_env => env, f_is_macro => false); + obj := new mal_val'(val_type => mal_fn, number_val => 0, string_val => null, seq_val => null, func_val => f, meta_val => null); + end procedure new_fn; + + procedure new_seq_obj(seq_type: in mal_type_tag; seq: inout mal_seq_ptr; obj: out mal_val_ptr) is + begin + obj := new mal_val'(val_type => seq_type, number_val => 0, string_val => null, seq_val => seq, func_val => null, meta_val => null); + end procedure new_seq_obj; + + procedure new_one_element_list(val: inout mal_val_ptr; obj: out mal_val_ptr) is + variable seq: mal_seq_ptr; + begin + seq := new mal_seq(0 to 0); + seq(0) := val; + new_seq_obj(mal_list, seq, obj); + end procedure new_one_element_list; + + procedure new_empty_hashmap(obj: out mal_val_ptr) is + variable seq: mal_seq_ptr; + begin + seq := new mal_seq(0 to -1); + new_seq_obj(mal_hashmap, seq, obj); + end procedure new_empty_hashmap; + + procedure new_atom(val: inout mal_val_ptr; obj: out mal_val_ptr) is + variable atom_seq: mal_seq_ptr; + begin + atom_seq := new mal_seq(0 to 0); + atom_seq(0) := val; + new_seq_obj(mal_atom, atom_seq, obj); + end procedure new_atom; + + procedure hashmap_copy(hashmap: inout mal_val_ptr; obj: out mal_val_ptr) is + variable new_seq: mal_seq_ptr; + begin + new_seq := new mal_seq(hashmap.seq_val'range); + new_seq(new_seq'range) := hashmap.seq_val(hashmap.seq_val'range); + new_seq_obj(mal_hashmap, new_seq, obj); + end procedure hashmap_copy; + + procedure hashmap_get(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: out mal_val_ptr) is + variable i: natural; + variable curr_key: mal_val_ptr; + begin + i := 0; + while i < hashmap.seq_val'length loop + curr_key := hashmap.seq_val(i); + if key.val_type = curr_key.val_type and key.string_val.all = curr_key.string_val.all then + val := hashmap.seq_val(i + 1); + return; + end if; + i := i + 2; + end loop; + val := null; + end procedure hashmap_get; + + procedure hashmap_contains(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; ok: out boolean) is + variable val: mal_val_ptr; + begin + hashmap_get(hashmap, key, val); + if val = null then + ok := false; + else + ok := true; + end if; + end procedure hashmap_contains; + + procedure hashmap_put(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr) is + variable i: natural; + variable curr_key: mal_val_ptr; + variable new_seq: mal_seq_ptr; + begin + i := 0; + while i < hashmap.seq_val'length loop + curr_key := hashmap.seq_val(i); + if key.val_type = curr_key.val_type and key.string_val.all = curr_key.string_val.all then + hashmap.seq_val(i + 1) := val; + return; + end if; + i := i + 2; + end loop; + -- Not found so far, need to extend the seq + new_seq := new mal_seq(0 to hashmap.seq_val'length + 1); + for i in hashmap.seq_val'range loop + new_seq(i) := hashmap.seq_val(i); + end loop; + new_seq(new_seq'length - 2) := key; + new_seq(new_seq'length - 1) := val; + deallocate(hashmap.seq_val); + hashmap.seq_val := new_seq; + end procedure hashmap_put; + + procedure hashmap_delete(hashmap: inout mal_val_ptr; key: inout mal_val_ptr) is + variable i, dst_i: natural; + variable curr_key: mal_val_ptr; + variable new_seq: mal_seq_ptr; + variable found: boolean; + begin + hashmap_contains(hashmap, key, found); + if not found then + return; + end if; + i := 0; + dst_i := 0; + new_seq := new mal_seq(0 to hashmap.seq_val'high - 2); + while i < hashmap.seq_val'length loop + curr_key := hashmap.seq_val(i); + if key.val_type = curr_key.val_type and key.string_val.all = curr_key.string_val.all then + i := i + 2; + else + new_seq(dst_i to dst_i + 1) := hashmap.seq_val(i to i + 1); + dst_i := dst_i + 2; + i := i + 2; + end if; + end loop; + deallocate(hashmap.seq_val); + hashmap.seq_val := new_seq; + end procedure hashmap_delete; + + procedure seq_drop_prefix(src: inout mal_val_ptr; prefix_length: in integer; result: out mal_val_ptr) is + variable seq: mal_seq_ptr; + begin + seq := new mal_seq(0 to src.seq_val'length - 1 - prefix_length); + for i in seq'range loop + seq(i) := src.seq_val(i + prefix_length); + end loop; + new_seq_obj(src.val_type, seq, result); + end procedure seq_drop_prefix; + + function is_sequential_type(t: in mal_type_tag) return boolean is + begin + return t = mal_list or t = mal_vector; + end function is_sequential_type; + + procedure equal_seq_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean) is + variable i: integer; + variable is_element_equal: boolean; + begin + if a.seq_val'length = b.seq_val'length then + for i in a.seq_val'range loop + equal_q(a.seq_val(i), b.seq_val(i), is_element_equal); + if not is_element_equal then + result := false; + return; + end if; + end loop; + result := true; + else + result := false; + end if; + end procedure equal_seq_q; + + procedure equal_hashmap_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean) is + variable i: integer; + variable is_value_equal: boolean; + variable b_val: mal_val_ptr; + begin + if a.seq_val'length = b.seq_val'length then + i := 0; + while i < a.seq_val'length loop + hashmap_get(b, a.seq_val(i), b_val); + if b_val = null then + result := false; + return; + else + equal_q(a.seq_val(i + 1), b_val, is_value_equal); + if not is_value_equal then + result := false; + return; + end if; + end if; + i := i + 2; + end loop; + result := true; + else + result := false; + end if; + end procedure equal_hashmap_q; + + procedure equal_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean) is + begin + if is_sequential_type(a.val_type) and is_sequential_type(b.val_type) then + equal_seq_q(a, b, result); + elsif a.val_type = b.val_type then + case a.val_type is + when mal_nil | mal_true | mal_false => + result := true; + when mal_number => + result := a.number_val = b.number_val; + when mal_symbol | mal_string | mal_keyword => + result := a.string_val.all = b.string_val.all; + when mal_hashmap => + equal_hashmap_q(a, b, result); + when mal_atom => + equal_q(a.seq_val(0), b.seq_val(0), result); + when others => + result := false; + end case; + else + result := false; + end if; + end procedure equal_q; +end package body types; diff --git a/impls/vimscript/.gitignore b/impls/vimscript/.gitignore new file mode 100644 index 0000000000..925b4b450f --- /dev/null +++ b/impls/vimscript/.gitignore @@ -0,0 +1,2 @@ +/*.o +/*.so diff --git a/impls/vimscript/Dockerfile b/impls/vimscript/Dockerfile new file mode 100644 index 0000000000..b54ae7d61a --- /dev/null +++ b/impls/vimscript/Dockerfile @@ -0,0 +1,27 @@ +FROM ubuntu:20.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# To build the readline plugin +RUN apt-get -y install gcc libreadline-dev + +RUN apt-get -y install vim + +ENV HOME /mal diff --git a/impls/vimscript/Makefile b/impls/vimscript/Makefile new file mode 100644 index 0000000000..da5409c3bf --- /dev/null +++ b/impls/vimscript/Makefile @@ -0,0 +1,30 @@ +SOURCES_BASE = readline.vim types.vim reader.vim printer.vim +SOURCES_LISP = env.vim core.vim stepA_mal.vim +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +all: libvimextras.so + +dist: mal.vim mal + +mal.vim: $(SOURCES) + cat $+ | grep -v "^source " > $@ + +mal: mal.vim + echo "#!/bin/sh" > $@ + echo "\":\" ; rundir=\`dirname \$$0\`" >> $@ + echo "\":\" ; export LD_LIBRARY_PATH=\`readlink -f \$$rundir\`" >> $@ + echo "\":\" ; exec vim -i NONE -V1 -nNesS \"\$$0\" -- \"\$$@\" 2>/dev/null" >> $@ + cat $< >> $@ + chmod +x $@ + + +libvimextras.so: vimextras.o + $(CC) -g -shared -o $@ $< -lreadline + +vimextras.o: vimextras.c + $(CC) -g -fPIC -c $< -o $@ + +clean: + rm -f vimextras.o libvimextras.so mal.vim mal + +.PHONY: clean diff --git a/impls/vimscript/core.vim b/impls/vimscript/core.vim new file mode 100644 index 0000000000..34be711533 --- /dev/null +++ b/impls/vimscript/core.vim @@ -0,0 +1,235 @@ +" core module + +function MalAssoc(args) + let hash = copy(a:args[0].val) + let new_elements = HashBuild(a:args[1:]) + call extend(hash, new_elements.val) + return HashNew(hash) +endfunction + +function MalDissoc(args) + let hash = copy(a:args[0].val) + for keyobj in a:args[1:] + let key = HashMakeKey(keyobj) + if has_key(hash, key) + call remove(hash, key) + endif + endfor + return HashNew(hash) +endfunction + +function MalGet(args) + if !HashQ(a:args[0]) + return g:MalNil + endif + let hash = a:args[0].val + let key = HashMakeKey(a:args[1]) + return get(hash, key, g:MalNil) +endfunction + +function MalContainsQ(args) + if !HashQ(a:args[0]) + return FalseNew() + endif + let hash = a:args[0].val + let key = HashMakeKey(a:args[1]) + return BoolNew(has_key(hash, key)) +endfunction + +function MalKeys(args) + let listobjs = [] + for keyname in keys(a:args[0].val) + let keyobj = HashParseKey(keyname) + call add(listobjs, keyobj) + endfor + return ListNew(listobjs) +endfunction + +function MalReadLine(args) + let [eof, line] = Readline(a:args[0].val) + return eof ? g:MalNil : StringNew(line) +endfunction + +function MalCons(args) + let items = copy(a:args[1].val) + call insert(items, a:args[0]) + return ListNew(items) +endfunction + +function MalConcat(args) + let res = [] + for list in a:args + let res = res + list.val + endfor + return ListNew(res) +endfunction + +function MalApply(args) + let funcobj = a:args[0] + let rest = a:args[1:] + if len(rest) == 0 + let funcargs = [] + elseif len(rest) == 1 + let funcargs = rest[-1].val + else + let funcargs = rest[:-2] + rest[-1].val + endif + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, ListNew(funcargs)) + elseif FunctionQ(funcobj) || MacroQ(funcobj) + return FuncInvoke(funcobj, ListNew(funcargs)) + else + throw "Not a function" + endif +endfunction + +function MalMap(args) + let funcobj = a:args[0] + let res = [] + for item in a:args[1].val + unlet! mappeditem + if NativeFunctionQ(funcobj) + let mappeditem = NativeFuncInvoke(funcobj, ListNew([item])) + elseif FunctionQ(funcobj) + let mappeditem = FuncInvoke(funcobj, ListNew([item])) + else + throw "Not a function" + endif + call add(res, mappeditem) + endfor + return ListNew(res) +endfunction + +function MalThrow(args) + unlet! g:MalExceptionObj + let g:MalExceptionObj = a:args[0] + throw "__MalException__" +endfunction + +function ConjList(list, elements) + let newlist = a:list + for e in a:elements + let newlist = MalCons([e, newlist]) + endfor + return newlist +endfunction + +function ConjVector(vector, elements) + let items = copy(a:vector.val) + for e in a:elements + call add(items, e) + endfor + return VectorNew(items) +endfunction + +function MalConj(args) + if ListQ(a:args[0]) + return ConjList(a:args[0], a:args[1:]) + elseif VectorQ(a:args[0]) + return ConjVector(a:args[0], a:args[1:]) + endif +endfunction + +function MalSeq(args) + let obj = a:args[0] + if EmptyQ(obj) + return g:MalNil + elseif ListQ(obj) + return obj + elseif VectorQ(obj) + return ListNew(obj.val) + elseif StringQ(obj) + return ListNew(map(split(obj.val, '\zs'), {_, c -> StringNew(c)})) + endif + throw "seq requires string or list or vector or nil" +endfunction + +function VimToMal(e) + if type(a:e) == type(0) + return IntegerNew(a:e) + elseif type(a:e) == type(0.0) + return FloatNew(a:e) + elseif type(a:e) == type("") + return StringNew(a:e) + elseif type(a:e) == type([]) + let res = [] + for v in a:e + call add(res, VimToMal(v)) + endfor + return ListNew(res) + elseif type(a:e) == type({}) + let res = {} + for [k,v] in items(a:e) + let keystring = HashMakeKey(StringNew(k)) + let res[keystring] = VimToMal(v) + endfor + return HashNew(res) + else + return g:MalNil + endif +endfunction + +let CoreNs = { + \ "=": NewNativeFnLambda({a -> BoolNew(EqualQ(a[0], a[1]))}), + \ "<": NewNativeFnLambda({a -> BoolNew(a[0].val < a[1].val)}), + \ "<=": NewNativeFnLambda({a -> BoolNew(a[0].val <= a[1].val)}), + \ ">": NewNativeFnLambda({a -> BoolNew(a[0].val > a[1].val)}), + \ ">=": NewNativeFnLambda({a -> BoolNew(a[0].val >= a[1].val)}), + \ "+": NewNativeFnLambda({a -> IntegerNew(a[0].val + a[1].val)}), + \ "-": NewNativeFnLambda({a -> IntegerNew(a[0].val - a[1].val)}), + \ "*": NewNativeFnLambda({a -> IntegerNew(a[0].val * a[1].val)}), + \ "/": NewNativeFnLambda({a -> IntegerNew(a[0].val / a[1].val)}), + \ "time-ms": NewNativeFnLambda({a -> IntegerNew(libcallnr("libvimextras.so", "vimtimems", 0))}), + \ "nil?": NewNativeFnLambda({a -> BoolNew(NilQ(a[0]))}), + \ "true?": NewNativeFnLambda({a -> BoolNew(TrueQ(a[0]))}), + \ "false?": NewNativeFnLambda({a -> BoolNew(FalseQ(a[0]))}), + \ "symbol": NewNativeFnLambda({a -> SymbolNew(a[0].val)}), + \ "symbol?": NewNativeFnLambda({a -> BoolNew(SymbolQ(a[0]))}), + \ "string?": NewNativeFnLambda({a -> BoolNew(StringQ(a[0]))}), + \ "keyword": NewNativeFnLambda({a -> KeywordNew(a[0].val)}), + \ "keyword?": NewNativeFnLambda({a -> BoolNew(KeywordQ(a[0]))}), + \ "number?": NewNativeFnLambda({a -> BoolNew(IntegerQ(a[0]))}), + \ "fn?": NewNativeFnLambda({a -> BoolNew(NativeFunctionQ(a[0]) || FunctionQ(a[0]))}), + \ "macro?": NewNativeFnLambda({a -> BoolNew(MacroQ(a[0]))}), + \ "list": NewNativeFnLambda({a -> ListNew(a)}), + \ "list?": NewNativeFnLambda({a -> BoolNew(ListQ(a[0]))}), + \ "vector": NewNativeFnLambda({a -> VectorNew(a)}), + \ "vector?": NewNativeFnLambda({a -> BoolNew(VectorQ(a[0]))}), + \ "sequential?": NewNativeFnLambda({a -> BoolNew(SequentialQ(a[0]))}), + \ "hash-map": NewNativeFnLambda({a -> HashBuild(a)}), + \ "map?": NewNativeFnLambda({a -> BoolNew(HashQ(a[0]))}), + \ "empty?": NewNativeFnLambda({a -> BoolNew(EmptyQ(a[0]))}), + \ "count": NewNativeFnLambda({a -> IntegerNew(ListCount(a[0]))}), + \ "assoc": NewNativeFn("MalAssoc"), + \ "dissoc": NewNativeFn("MalDissoc"), + \ "get": NewNativeFn("MalGet"), + \ "contains?": NewNativeFn("MalContainsQ"), + \ "keys": NewNativeFn("MalKeys"), + \ "vals": NewNativeFnLambda({a -> ListNew(values(a[0].val))}), + \ "pr-str": NewNativeFnLambda({a -> StringNew(join(map(copy(a), {_, e -> PrStr(e, 1)}), " "))}), + \ "str": NewNativeFnLambda({a -> StringNew(join(map(copy(a), {_, e -> PrStr(e, 0)}), ""))}), + \ "prn": NewNativeFnLambda({a -> [PrintLn(join(map(copy(a), {_, e -> PrStr(e, 1)}), " ")), g:MalNil][1]}), + \ "println": NewNativeFnLambda({a -> [PrintLn(join(map(copy(a), {_, e -> PrStr(e, 0)}), " ")), g:MalNil][1]}), + \ "read-string": NewNativeFnLambda({a -> ReadStr(a[0].val)}), + \ "readline": NewNativeFn("MalReadLine"), + \ "slurp": NewNativeFnLambda({a -> StringNew(join(readfile(a[0].val, "b"), "\n"))}), + \ "cons": NewNativeFn("MalCons"), + \ "concat": NewNativeFn("MalConcat"), + \ "vec": NewNativeFnLambda({a -> VectorNew(a[0].val)}), + \ "first": NewNativeFnLambda({a -> NilQ(a[0]) ? g:MalNil : ListFirst(a[0])}), + \ "nth": NewNativeFnLambda({a -> ListNth(a[0], a[1].val)}), + \ "rest": NewNativeFnLambda({a -> NilQ(a[0]) ? ListNew([]) : ListRest(a[0])}), + \ "apply": NewNativeFn("MalApply"), + \ "map": NewNativeFn("MalMap"), + \ "throw": NewNativeFn("MalThrow"), + \ "conj": NewNativeFn("MalConj"), + \ "seq": NewNativeFn("MalSeq"), + \ "meta": NewNativeFnLambda({a -> ObjMeta(a[0])}), + \ "with-meta": NewNativeFnLambda({a -> ObjNewWithMeta(a[0].type, copy(a[0].val), a[1])}), + \ "atom": NewNativeFnLambda({a -> AtomNew(a[0])}), + \ "atom?": NewNativeFnLambda({a -> BoolNew(AtomQ(a[0]))}), + \ "deref": NewNativeFnLambda({a -> a[0].val}), + \ "reset!": NewNativeFnLambda({a -> ObjSetValue(a[0], a[1])}), + \ "swap!": NewNativeFnLambda({a -> ObjSetValue(a[0], MalApply([a[1], ListNew([a[0].val] + a[2:])]))}), + \ "vim*": NewNativeFnLambda({a -> VimToMal(eval(a[0].val))}) + \ } diff --git a/impls/vimscript/env.vim b/impls/vimscript/env.vim new file mode 100644 index 0000000000..7487882288 --- /dev/null +++ b/impls/vimscript/env.vim @@ -0,0 +1,54 @@ +" env module + +let Env = {} + +function NewEnv(outer) + let e = copy(g:Env) + let e.data = {} + let e.outer = a:outer + return e +endfunction + +function NewEnvWithBinds(outer, binds, exprs) + let env = NewEnv(a:outer) + let i = 0 + while i < ListCount(a:binds) + let varname = ListNth(a:binds, i).val + if varname == "&" + let restvarname = ListNth(a:binds, i + 1).val + let restvarvalues = ListDrop(a:exprs, i) + call env.set(restvarname, restvarvalues) + break + else + unlet! varvalue + let varvalue = ListNth(a:exprs, i) + call env.set(varname, varvalue) + endif + let i = i + 1 + endwhile + return env +endfunction + +function Env.set(key, value) dict + let self.data[a:key] = a:value + return a:value +endfunction + +function Env.get(key) dict + let curr = self + while !has_key(curr.data, a:key) + let curr = curr.outer + if empty(curr) + return "" + endif + endwhile + return curr.data[a:key] +endfunction + +function Env.root() dict + let curr = self + while !empty(curr.outer) + let curr = curr.outer + endwhile + return curr +endfunction diff --git a/impls/vimscript/printer.vim b/impls/vimscript/printer.vim new file mode 100644 index 0000000000..18d21b5597 --- /dev/null +++ b/impls/vimscript/printer.vim @@ -0,0 +1,60 @@ +" printer module + +function PrStr(ast, readable) + let obj = a:ast + let r = a:readable + if ListQ(obj) + let ret = [] + for e in obj.val + call add(ret, PrStr(e, r)) + endfor + return "(" . join(ret, " ") . ")" + elseif VectorQ(obj) + let ret = [] + for e in obj.val + call add(ret, PrStr(e, r)) + endfor + return "[" . join(ret, " ") . "]" + elseif HashQ(obj) + let ret = [] + for [k, v] in items(obj.val) + let keyobj = HashParseKey(k) + call add(ret, PrStr(keyobj, r)) + call add(ret, PrStr(v, r)) + endfor + return "{" . join(ret, " ") . "}" + elseif MacroQ(obj) + let numargs = ListCount(obj.val.params) + return "" + elseif FunctionQ(obj) + let numargs = ListCount(obj.val.params) + return "" + elseif NativeFunctionQ(obj) + let funcname = obj.val.name + return "" + elseif AtomQ(obj) + return "(atom " . PrStr(obj.val, 1) . ")" + elseif KeywordQ(obj) + return ':' . obj.val + elseif StringQ(obj) + if r + let str = obj.val + let str = substitute(str, '\\', '\\\\', "g") + let str = substitute(str, '"', '\\"', "g") + let str = substitute(str, "\n", '\\n', "g") + return '"' . str . '"' + else + return obj.val + endif + elseif NilQ(obj) + return "nil" + elseif TrueQ(obj) + return "true" + elseif FalseQ(obj) + return "false" + elseif IntegerQ(obj) || FloatQ(obj) + return string(obj.val) + else + return obj.val + end +endfunction diff --git a/impls/vimscript/reader.vim b/impls/vimscript/reader.vim new file mode 100644 index 0000000000..5d86dec67c --- /dev/null +++ b/impls/vimscript/reader.vim @@ -0,0 +1,165 @@ +" reader module + +let Reader = {} + +function NewReader(tokens) + let r = copy(g:Reader) + let r.tokens = a:tokens + let r.pos = 0 + return r +endfunction + +function Reader.peek() dict + return self.tokens[self.pos] +endfunction + +function Reader.nexttoken() dict + let self.pos = self.pos + 1 + return self.tokens[self.pos - 1] +endfunction + +function Tokenize(str) + let tokenize_pat = "[[:blank:]\\n,]*" . + \ "\\(" . + \ "\\~@\\|" . + \ "[\\[\\]{}()'`~^@]\\|" . + \ "\"\\%(\\\\.\\|[^\\\\\"]\\)*\"\\|" . + \ "\"\\%(\\\\.\\|[^\\\\\"]\\)*\\|" . + \ ";[^\\n]*\\|" . + \ "[^[:blank:]\\n\\[\\]{}('\"`,;)]*" . + \ "\\)" + let tokens = [] + let pos = 0 + while 1 + let mat = matchlist(a:str, tokenize_pat, pos) + if len(mat) == 0 || mat[0] == "" + break + endif + if mat[1] != "" && mat[1][0] != ";" + call add(tokens, mat[1]) + endif + let pos = matchend(a:str, tokenize_pat, pos) + endwhile + return tokens +endfunction + +function UnescapeChar(seq) + if a:seq == '\"' + return '"' + elseif a:seq == '\n' + return "\n" + elseif a:seq == '\\' + return '\' + else + return a:seq + endif +endfunction + +function ParseString(token) + return substitute(a:token[1:-2], '\\.', '\=UnescapeChar(submatch(0))', "g") +endfunction + +function ReadAtom(rdr) + let token = a:rdr.nexttoken() + if token =~ "^-\\?[0-9]\\+$" + return IntegerNew(str2nr(token)) + elseif token =~ "^-\\?[0-9][0-9.]*$" + return FloatNew(str2float(token)) + elseif token =~ "^\"\\%(\\\\.\\|[^\\\\\"]\\)*\"$" + return StringNew(ParseString(token)) + elseif token =~ "^\".*$" + throw "expected '\"', got EOF" + elseif token =~ "^:" + return KeywordNew(token[1:-1]) + elseif token == "nil" + return g:MalNil + elseif token == "true" + return TrueNew() + elseif token == "false" + return FalseNew() + else + return SymbolNew(token) + endif +endfunction + +function ReadTokensList(rdr, start, last) + let elements = [] + let token = a:rdr.nexttoken() + if token != a:start + throw "expected '" . a:start . "'" + endif + let token = a:rdr.peek() + while token != a:last + call add(elements, ReadForm(a:rdr)) + try + let token = a:rdr.peek() + catch + throw "expected '" . a:last . "', got EOF" + endtry + endwhile + call a:rdr.nexttoken() + return elements +endfunction + +function ReadList(rdr) + let elements = ReadTokensList(a:rdr, "(", ")") + return ListNew(elements) +endfunction + +function ReadVector(rdr) + let elements = ReadTokensList(a:rdr, "[", "]") + return VectorNew(elements) +endfunction + +function ReadHash(rdr) + let elements = ReadTokensList(a:rdr, "{", "}") + return HashBuild(elements) +endfunction + +function ReadForm(rdr) + let token = a:rdr.peek() + if token == ";" + return "" + elseif token == "'" + call a:rdr.nexttoken() + return ListNew([SymbolNew("quote"), ReadForm(a:rdr)]) + elseif token == "`" + call a:rdr.nexttoken() + return ListNew([SymbolNew("quasiquote"), ReadForm(a:rdr)]) + elseif token == "~" + call a:rdr.nexttoken() + return ListNew([SymbolNew("unquote"), ReadForm(a:rdr)]) + elseif token == "~@" + call a:rdr.nexttoken() + return ListNew([SymbolNew("splice-unquote"), ReadForm(a:rdr)]) + elseif token == "^" + call a:rdr.nexttoken() + let meta = ReadForm(a:rdr) + return ListNew([SymbolNew("with-meta"), ReadForm(a:rdr), meta]) + elseif token == "@" + call a:rdr.nexttoken() + return ListNew([SymbolNew("deref"), ReadForm(a:rdr)]) + elseif token == "(" + return ReadList(a:rdr)") + elseif token == ")" + throw "unexpected ')'" + elseif token == "[" + return ReadVector(a:rdr) + elseif token == "]" + throw "unexpected ']'" + elseif token == "{" + return ReadHash(a:rdr) + elseif token == "}" + throw "unexpected '}'" + else + return ReadAtom(a:rdr) + endif +endfunction + +function ReadStr(str) + let tokens = Tokenize(a:str) + if empty(tokens) + return "" + endif + return ReadForm(NewReader(tokens)) +endfunction diff --git a/impls/vimscript/readline.vim b/impls/vimscript/readline.vim new file mode 100644 index 0000000000..af4d57f596 --- /dev/null +++ b/impls/vimscript/readline.vim @@ -0,0 +1,23 @@ +function PrintLn(str) + let lines = split(a:str, "\n", 1) + call writefile(lines, "/dev/stdout", "a") +endfunction + +function s:buildlibvimreadline() + if !filereadable("libvimextras.so") + call system("make libvimextras.so") + endif +endfunction + +" Returns [is_eof, line_string] +function Readline(prompt) + " Use the vimreadline() function defined in vimextras.c and compiled + " into libvimextras.so + call s:buildlibvimreadline() + let res = libcall("libvimextras.so", "vimreadline", a:prompt) + if res[0] == "E" + return [1, ""] + else + return [0, res[1:]] + endif +endfunction diff --git a/impls/vimscript/run b/impls/vimscript/run new file mode 100755 index 0000000000..007df20bdf --- /dev/null +++ b/impls/vimscript/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +cd $(dirname $0) +exec ./run_vimscript.sh ./${STEP:-stepA_mal}.vim "${@}" diff --git a/impls/vimscript/run_vimscript.sh b/impls/vimscript/run_vimscript.sh new file mode 100755 index 0000000000..cf263c8f7f --- /dev/null +++ b/impls/vimscript/run_vimscript.sh @@ -0,0 +1,17 @@ +#!/bin/sh + +# Run Vim in ex mode (-e) and run the given script ($1) on startup. Our scripts +# end with 'qall!' which causes actual Vim UI to never start up. +# +# Set environment variable DEBUG=1 to allow more verbose error output from Vim. +# +# See: http://vim.wikia.com/wiki/Vim_as_a_system_interpreter_for_vimscript + +rundir=`dirname $0` +export LD_LIBRARY_PATH=`readlink -f $rundir` +vimscriptfile="$1" +shift +if [ x$DEBUG = x ] ; then + exec 2> /dev/null +fi +exec vim -i NONE -V1 -nNesS $vimscriptfile -- "$@" | cat diff --git a/impls/vimscript/step0_repl.vim b/impls/vimscript/step0_repl.vim new file mode 100644 index 0000000000..1fbcf32c62 --- /dev/null +++ b/impls/vimscript/step0_repl.vim @@ -0,0 +1,29 @@ +source readline.vim + +function READ(str) + return a:str +endfunction + +function EVAL(ast, env) + return a:ast +endfunction + +function PRINT(exp) + return a:exp +endfunction + +function REP(str) + return PRINT(EVAL(READ(a:str), {})) +endfunction + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + call PrintLn(REP(line)) +endwhile +qall! diff --git a/impls/vimscript/step1_read_print.vim b/impls/vimscript/step1_read_print.vim new file mode 100644 index 0000000000..ca4bc1680c --- /dev/null +++ b/impls/vimscript/step1_read_print.vim @@ -0,0 +1,36 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function EVAL(ast, env) + return a:ast +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function REP(str) + return PRINT(EVAL(READ(a:str), {})) +endfunction + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line)) + catch + call PrintLn("Error: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step2_eval.vim b/impls/vimscript/step2_eval.vim new file mode 100644 index 0000000000..97038b968f --- /dev/null +++ b/impls/vimscript/step2_eval.vim @@ -0,0 +1,71 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function EVAL(ast, env) + " call PrintLn("EVAL: " . PrStr(a:ast, 1)) + + if SymbolQ(a:ast) + let varname = a:ast.val + if !has_key(a:env, varname) + throw "'" . varname . "' not found" + end + return a:env[varname] + elseif VectorQ(a:ast) + return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + elseif HashQ(a:ast) + let ret = {} + for [k,v] in items(a:ast.val) + let newval = EVAL(v, a:env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(a:ast) + return a:ast + end + if EmptyQ(a:ast) + return a:ast + endif + + " apply list + let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + + let Fn = el.val[0] + return Fn(el.val[1:-1]) +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +let repl_env = {} +let repl_env["+"] = {a -> IntegerNew(a[0].val + a[1].val)} +let repl_env["-"] = {a -> IntegerNew(a[0].val - a[1].val)} +let repl_env["*"] = {a -> IntegerNew(a[0].val * a[1].val)} +let repl_env["/"] = {a -> IntegerNew(a[0].val / a[1].val)} + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + call PrintLn("ERROR: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step3_env.vim b/impls/vimscript/step3_env.vim new file mode 100644 index 0000000000..a1405226ed --- /dev/null +++ b/impls/vimscript/step3_env.vim @@ -0,0 +1,94 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function EVAL(ast, env) + let dbgeval = a:env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(a:ast, 1)) + endif + + if SymbolQ(a:ast) + let varname = a:ast.val + let Val = a:env.get(varname) + if empty(Val) + throw "'" . varname . "' not found" + endif + return Val + elseif VectorQ(a:ast) + return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + elseif HashQ(a:ast) + let ret = {} + for [k,v] in items(a:ast.val) + let newval = EVAL(v, a:env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(a:ast) + return a:ast + end + if EmptyQ(a:ast) + return a:ast + endif + + let first_symbol = a:ast.val[0].val + if first_symbol == "def!" + let a1 = a:ast.val[1] + let a2 = a:ast.val[2] + return a:env.set(a1.val, EVAL(a2, a:env)) + elseif first_symbol == "let*" + let a1 = a:ast.val[1] + let a2 = a:ast.val[2] + let let_env = NewEnv(a:env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call let_env.set(let_binds[i].val, EVAL(let_binds[i+1], let_env)) + let i = i + 2 + endwhile + return EVAL(a2, let_env) + else + " apply list + let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + let Fn = el.val[0] + return Fn(el.val[1:-1]) + endif + +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +let repl_env = NewEnv("") +call repl_env.set("+", {a -> IntegerNew(a[0].val + a[1].val)}) +call repl_env.set("-", {a -> IntegerNew(a[0].val - a[1].val)}) +call repl_env.set("*", {a -> IntegerNew(a[0].val * a[1].val)}) +call repl_env.set("/", {a -> IntegerNew(a[0].val / a[1].val)}) + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + call PrintLn("Error: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step4_if_fn_do.vim b/impls/vimscript/step4_if_fn_do.vim new file mode 100644 index 0000000000..48a9ca91e3 --- /dev/null +++ b/impls/vimscript/step4_if_fn_do.vim @@ -0,0 +1,125 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim +source core.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function EVAL(ast, env) + let dbgeval = a:env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(a:ast, 1)) + endif + + if SymbolQ(a:ast) + let varname = a:ast.val + let val = a:env.get(varname) + if empty(val) + throw "'" . varname . "' not found" + endif + return val + elseif VectorQ(a:ast) + return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + elseif HashQ(a:ast) + let ret = {} + for [k,v] in items(a:ast.val) + let newval = EVAL(v, a:env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(a:ast) + return a:ast + end + if EmptyQ(a:ast) + return a:ast + endif + + let first = ListFirst(a:ast) + let first_symbol = SymbolQ(first) ? first.val : "" + if first_symbol == "def!" + let a1 = a:ast.val[1] + let a2 = a:ast.val[2] + let ret = a:env.set(a1.val, EVAL(a2, a:env)) + return ret + elseif first_symbol == "let*" + let a1 = a:ast.val[1] + let a2 = a:ast.val[2] + let let_env = NewEnv(a:env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call let_env.set(let_binds[i].val, EVAL(let_binds[i+1], let_env)) + let i = i + 2 + endwhile + return EVAL(a2, let_env) + elseif first_symbol == "if" + let condvalue = EVAL(a:ast.val[1], a:env) + if FalseQ(condvalue) || NilQ(condvalue) + if len(a:ast.val) < 4 + return g:MalNil + else + return EVAL(a:ast.val[3], a:env) + endif + else + return EVAL(a:ast.val[2], a:env) + endif + elseif first_symbol == "do" + let astlist = a:ast.val + for elt in astlist[1:-2] + let ignored = EVAL(elt, a:env) + endfor + return EVAL(astlist[-1], a:env) + elseif first_symbol == "fn*" + let fn = NewFn(ListNth(a:ast, 2), a:env, ListNth(a:ast, 1)) + return fn + else + " apply list + let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) + let funcobj = ListFirst(el) + let args = ListRest(el) + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, args) + elseif FunctionQ(funcobj) + return FuncInvoke(funcobj, args) + else + throw "Not a function" + endif + endif +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +let repl_env = NewEnv("") + +for [k, Fn] in items(CoreNs) + call repl_env.set(k, Fn) +endfor + +call REP("(def! not (fn* (a) (if a false true)))", repl_env) + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + call PrintLn("Error: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step5_tco.vim b/impls/vimscript/step5_tco.vim new file mode 100644 index 0000000000..dcf9c089b9 --- /dev/null +++ b/impls/vimscript/step5_tco.vim @@ -0,0 +1,138 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim +source core.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function EVAL(ast, env) + let ast = a:ast + let env = a:env + + while 1 + + let dbgeval = env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(ast, 1)) + endif + + if SymbolQ(ast) + let varname = ast.val + let val = env.get(varname) + if empty(val) + throw "'" . varname . "' not found" + endif + return val + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(ast) + return ast + end + if EmptyQ(ast) + return ast + endif + + let first = ListFirst(ast) + let first_symbol = SymbolQ(first) ? first.val : "" + if first_symbol == "def!" + let a1 = ast.val[1] + let a2 = ast.val[2] + let ret = env.set(a1.val, EVAL(a2, env)) + return ret + elseif first_symbol == "let*" + let a1 = ast.val[1] + let a2 = ast.val[2] + let env = NewEnv(env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) + let i = i + 2 + endwhile + let ast = a2 + " TCO + elseif first_symbol == "if" + let condvalue = EVAL(ast.val[1], env) + if FalseQ(condvalue) || NilQ(condvalue) + if len(ast.val) < 4 + return g:MalNil + else + let ast = ast.val[3] + endif + else + let ast = ast.val[2] + endif + " TCO + elseif first_symbol == "do" + let astlist = ast.val + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor + let ast = astlist[-1] + " TCO + elseif first_symbol == "fn*" + let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) + return fn + else + " apply list + let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + let funcobj = ListFirst(el) + let args = ListRest(el) + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, args) + elseif FunctionQ(funcobj) + let fn = funcobj.val + let ast = fn.ast + let env = NewEnvWithBinds(fn.env, fn.params, args) + " TCO + else + throw "Not a function" + endif + endif + endwhile +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +set maxfuncdepth=10000 +let repl_env = NewEnv("") + +for [k, v] in items(CoreNs) + call repl_env.set(k, v) +endfor + +call REP("(def! not (fn* (a) (if a false true)))", repl_env) + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + call PrintLn("Error: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step6_file.vim b/impls/vimscript/step6_file.vim new file mode 100644 index 0000000000..5e7a02abc3 --- /dev/null +++ b/impls/vimscript/step6_file.vim @@ -0,0 +1,158 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim +source core.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function EVAL(ast, env) + let ast = a:ast + let env = a:env + + while 1 + + let dbgeval = env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(ast, 1)) + endif + + if SymbolQ(ast) + let varname = ast.val + let val = env.get(varname) + if empty(val) + throw "'" . varname . "' not found" + endif + return val + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(ast) + return ast + end + if EmptyQ(ast) + return ast + endif + + let first = ListFirst(ast) + let first_symbol = SymbolQ(first) ? first.val : "" + if first_symbol == "def!" + let a1 = ast.val[1] + let a2 = ast.val[2] + let ret = env.set(a1.val, EVAL(a2, env)) + return ret + elseif first_symbol == "let*" + let a1 = ast.val[1] + let a2 = ast.val[2] + let env = NewEnv(env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) + let i = i + 2 + endwhile + let ast = a2 + " TCO + elseif first_symbol == "if" + let condvalue = EVAL(ast.val[1], env) + if FalseQ(condvalue) || NilQ(condvalue) + if len(ast.val) < 4 + return g:MalNil + else + let ast = ast.val[3] + endif + else + let ast = ast.val[2] + endif + " TCO + elseif first_symbol == "do" + let astlist = ast.val + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor + let ast = astlist[-1] + " TCO + elseif first_symbol == "fn*" + let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) + return fn + elseif first_symbol == "eval" + let ast = EVAL(ListNth(ast, 1), env) + let env = env.root() + " TCO + else + " apply list + let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + let funcobj = ListFirst(el) + let args = ListRest(el) + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, args) + elseif FunctionQ(funcobj) + let fn = funcobj.val + let ast = fn.ast + let env = NewEnvWithBinds(fn.env, fn.params, args) + " TCO + else + throw "Not a function" + endif + endif + endwhile +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function RE(str, env) + return EVAL(READ(a:str), a:env) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +function GetArgvList() + return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) +endfunction + +set maxfuncdepth=10000 +let repl_env = NewEnv("") + +for [k, v] in items(CoreNs) + call repl_env.set(k, v) +endfor + +call repl_env.set("*ARGV*", GetArgvList()) + +call RE("(def! not (fn* (a) (if a false true)))", repl_env) +call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + +if !empty(argv()) + call RE('(load-file "' . argv(0) . '")', repl_env) + qall! +endif + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + call PrintLn("Error: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step7_quote.vim b/impls/vimscript/step7_quote.vim new file mode 100644 index 0000000000..a15113814c --- /dev/null +++ b/impls/vimscript/step7_quote.vim @@ -0,0 +1,198 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim +source core.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym +endfunction + +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + +function Quasiquote(ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) + return ListNew([SymbolNew("quote"), a:ast]) + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") + return ListNth(a:ast, 1) + else + return QuasiquoteLoop(a:ast.val) + endif +endfunction + +function EVAL(ast, env) + let ast = a:ast + let env = a:env + + while 1 + + let dbgeval = env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(ast, 1)) + endif + + if SymbolQ(ast) + let varname = ast.val + let val = env.get(varname) + if empty(val) + throw "'" . varname . "' not found" + endif + return val + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(ast) + return ast + end + if EmptyQ(ast) + return ast + endif + + let first = ListFirst(ast) + let first_symbol = SymbolQ(first) ? first.val : "" + if first_symbol == "def!" + let a1 = ast.val[1] + let a2 = ast.val[2] + let ret = env.set(a1.val, EVAL(a2, env)) + return ret + elseif first_symbol == "let*" + let a1 = ast.val[1] + let a2 = ast.val[2] + let env = NewEnv(env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) + let i = i + 2 + endwhile + let ast = a2 + " TCO + elseif first_symbol == "quote" + return ListNth(ast, 1) + elseif first_symbol == "quasiquote" + let ast = Quasiquote(ListNth(ast, 1)) + " TCO + elseif first_symbol == "if" + let condvalue = EVAL(ast.val[1], env) + if FalseQ(condvalue) || NilQ(condvalue) + if len(ast.val) < 4 + return g:MalNil + else + let ast = ast.val[3] + endif + else + let ast = ast.val[2] + endif + " TCO + elseif first_symbol == "do" + let astlist = ast.val + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor + let ast = astlist[-1] + " TCO + elseif first_symbol == "fn*" + let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) + return fn + elseif first_symbol == "eval" + let ast = EVAL(ListNth(ast, 1), env) + let env = env.root() + " TCO + else + " apply list + let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + let funcobj = ListFirst(el) + let args = ListRest(el) + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, args) + elseif FunctionQ(funcobj) + let fn = funcobj.val + let ast = fn.ast + let env = NewEnvWithBinds(fn.env, fn.params, args) + " TCO + else + throw "Not a function" + endif + endif + endwhile +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function RE(str, env) + return EVAL(READ(a:str), a:env) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +function GetArgvList() + return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) +endfunction + +set maxfuncdepth=10000 +let repl_env = NewEnv("") + +for [k, v] in items(CoreNs) + call repl_env.set(k, v) +endfor + +call repl_env.set("*ARGV*", GetArgvList()) + +call RE("(def! not (fn* (a) (if a false true)))", repl_env) +call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) + +if !empty(argv()) + call RE('(load-file "' . argv(0) . '")', repl_env) + qall! +endif + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + call PrintLn("Error: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step8_macros.vim b/impls/vimscript/step8_macros.vim new file mode 100644 index 0000000000..fcbb60ba86 --- /dev/null +++ b/impls/vimscript/step8_macros.vim @@ -0,0 +1,208 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim +source core.vim + +function READ(str) + return ReadStr(a:str) +endfunction + +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym +endfunction + +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + +function Quasiquote(ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) + return ListNew([SymbolNew("quote"), a:ast]) + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") + return ListNth(a:ast, 1) + else + return QuasiquoteLoop(a:ast.val) + endif +endfunction + +function EVAL(ast, env) + let ast = a:ast + let env = a:env + + while 1 + + let dbgeval = env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(ast, 1)) + endif + + if SymbolQ(ast) + let varname = ast.val + let val = env.get(varname) + if empty(val) + throw "'" . varname . "' not found" + endif + return val + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(ast) + return ast + end + if EmptyQ(ast) + return ast + endif + + let first = ListFirst(ast) + let first_symbol = SymbolQ(first) ? first.val : "" + if first_symbol == "def!" + let a1 = ast.val[1] + let a2 = ast.val[2] + return env.set(a1.val, EVAL(a2, env)) + elseif first_symbol == "let*" + let a1 = ast.val[1] + let a2 = ast.val[2] + let env = NewEnv(env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) + let i = i + 2 + endwhile + let ast = a2 + " TCO + elseif first_symbol == "quote" + return ListNth(ast, 1) + elseif first_symbol == "quasiquote" + let ast = Quasiquote(ListNth(ast, 1)) + " TCO + elseif first_symbol == "defmacro!" + let a1 = ListNth(ast, 1) + let a2 = ListNth(ast, 2) + let macro = MarkAsMacro(EVAL(a2, env)) + return env.set(a1.val, macro) + elseif first_symbol == "if" + let condvalue = EVAL(ast.val[1], env) + if FalseQ(condvalue) || NilQ(condvalue) + if len(ast.val) < 4 + return g:MalNil + else + let ast = ast.val[3] + endif + else + let ast = ast.val[2] + endif + " TCO + elseif first_symbol == "do" + let astlist = ast.val + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor + let ast = astlist[-1] + " TCO + elseif first_symbol == "fn*" + let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) + return fn + elseif first_symbol == "eval" + let ast = EVAL(ListNth(ast, 1), env) + let env = env.root() + " TCO + else + " apply list + let funcobj = EVAL(first, env) + let args = ListRest(ast) + if MacroQ(funcobj) + let ast = FuncInvoke(funcobj, args) + continue + " TCO + endif + let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, args) + elseif FunctionQ(funcobj) + let fn = funcobj.val + let ast = fn.ast + let env = NewEnvWithBinds(fn.env, fn.params, args) + " TCO + else + throw "Not a function" + endif + endif + endwhile +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function RE(str, env) + return EVAL(READ(a:str), a:env) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +function GetArgvList() + return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) +endfunction + +set maxfuncdepth=10000 +let repl_env = NewEnv("") + +for [k, v] in items(CoreNs) + call repl_env.set(k, v) +endfor + +call repl_env.set("*ARGV*", GetArgvList()) + +call RE("(def! not (fn* (a) (if a false true)))", repl_env) +call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) +call RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + +if !empty(argv()) + call RE('(load-file "' . argv(0) . '")', repl_env) + qall! +endif + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + call PrintLn("Error: " . v:exception) + endtry +endwhile +qall! diff --git a/impls/vimscript/step9_try.vim b/impls/vimscript/step9_try.vim new file mode 100644 index 0000000000..8bdaf691b2 --- /dev/null +++ b/impls/vimscript/step9_try.vim @@ -0,0 +1,248 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim +source core.vim + +let MalExceptionObj = "" + +function READ(str) + return ReadStr(a:str) +endfunction + +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym +endfunction + +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + +function Quasiquote(ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) + return ListNew([SymbolNew("quote"), a:ast]) + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") + return ListNth(a:ast, 1) + else + return QuasiquoteLoop(a:ast.val) + endif +endfunction + +function GetCatchClause(ast) + if ListCount(a:ast) < 3 + return "" + end + let catch_clause = ListNth(a:ast, 2) + if ListFirst(catch_clause) == SymbolNew("catch*") + return catch_clause + else + return "" + end +endfunction + +function EVAL(ast, env) + let ast = a:ast + let env = a:env + + while 1 + + let dbgeval = env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(ast, 1)) + endif + + if SymbolQ(ast) + let varname = ast.val + let val = env.get(varname) + if empty(val) + throw "'" . varname . "' not found" + endif + return val + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(ast) + return ast + end + if EmptyQ(ast) + return ast + endif + + let first = ListFirst(ast) + let first_symbol = SymbolQ(first) ? first.val : "" + if first_symbol == "def!" + let a1 = ast.val[1] + let a2 = ast.val[2] + return env.set(a1.val, EVAL(a2, env)) + elseif first_symbol == "let*" + let a1 = ast.val[1] + let a2 = ast.val[2] + let env = NewEnv(env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) + let i = i + 2 + endwhile + let ast = a2 + " TCO + elseif first_symbol == "quote" + return ListNth(ast, 1) + elseif first_symbol == "quasiquote" + let ast = Quasiquote(ListNth(ast, 1)) + " TCO + elseif first_symbol == "defmacro!" + let a1 = ListNth(ast, 1) + let a2 = ListNth(ast, 2) + let macro = MarkAsMacro(EVAL(a2, env)) + return env.set(a1.val, macro) + elseif first_symbol == "if" + let condvalue = EVAL(ast.val[1], env) + if FalseQ(condvalue) || NilQ(condvalue) + if len(ast.val) < 4 + return g:MalNil + else + let ast = ast.val[3] + endif + else + let ast = ast.val[2] + endif + " TCO + elseif first_symbol == "try*" + try + return EVAL(ListNth(ast, 1), env) + catch + let catch_clause = GetCatchClause(ast) + if empty(catch_clause) + throw v:exception + endif + + let exc_var = ListNth(catch_clause, 1).val + if v:exception == "__MalException__" + let exc_value = g:MalExceptionObj + else + let exc_value = StringNew(v:exception) + endif + let catch_env = NewEnvWithBinds(env, ListNew([SymbolNew(exc_var)]), ListNew([exc_value])) + return EVAL(ListNth(catch_clause, 2), catch_env) + endtry + elseif first_symbol == "do" + let astlist = ast.val + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor + let ast = astlist[-1] + " TCO + elseif first_symbol == "fn*" + let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) + return fn + elseif first_symbol == "eval" + let ast = EVAL(ListNth(ast, 1), env) + let env = env.root() + " TCO + else + " apply list + let funcobj = EVAL(first, env) + let args = ListRest(ast) + if MacroQ(funcobj) + let ast = FuncInvoke(funcobj, args) + continue + " TCO + endif + let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, args) + elseif FunctionQ(funcobj) + let fn = funcobj.val + let ast = fn.ast + let env = NewEnvWithBinds(fn.env, fn.params, args) + " TCO + else + throw "Not a function" + endif + endif + endwhile +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function RE(str, env) + return EVAL(READ(a:str), a:env) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +function GetArgvList() + return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) +endfunction + +set maxfuncdepth=10000 +let repl_env = NewEnv("") + +for [k, v] in items(CoreNs) + call repl_env.set(k, v) +endfor + +call repl_env.set("*ARGV*", GetArgvList()) + +call RE("(def! not (fn* (a) (if a false true)))", repl_env) +call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) +call RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + +if !empty(argv()) + try + call RE('(load-file "' . argv(0) . '")', repl_env) + catch + call PrintLn("Error: " . v:exception) + endtry + qall! +endif + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + if v:exception == "__MalException__" + call PrintLn("Error: " . PrStr(g:MalExceptionObj, 1)) + else + call PrintLn("Error: " . v:exception) + end + endtry +endwhile +qall! diff --git a/impls/vimscript/stepA_mal.vim b/impls/vimscript/stepA_mal.vim new file mode 100644 index 0000000000..99a6e393ae --- /dev/null +++ b/impls/vimscript/stepA_mal.vim @@ -0,0 +1,251 @@ +source readline.vim +source types.vim +source reader.vim +source printer.vim +source env.vim +source core.vim + +let MalExceptionObj = "" + +function READ(str) + return ReadStr(a:str) +endfunction + +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym +endfunction + +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + +function Quasiquote(ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) + return ListNew([SymbolNew("quote"), a:ast]) + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") + return ListNth(a:ast, 1) + else + return QuasiquoteLoop(a:ast.val) + endif +endfunction + +function GetCatchClause(ast) + if ListCount(a:ast) < 3 + return "" + end + let catch_clause = ListNth(a:ast, 2) + if ListFirst(catch_clause) == SymbolNew("catch*") + return catch_clause + else + return "" + end +endfunction + +function EVAL(ast, env) + let ast = a:ast + let env = a:env + + while 1 + + let dbgeval = env.get("DEBUG-EVAL") + if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) + call PrintLn("EVAL: " . PrStr(ast, 1)) + endif + + if SymbolQ(ast) + let varname = ast.val + let val = env.get(varname) + if empty(val) + throw "'" . varname . "' not found" + endif + return val + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif + if !ListQ(ast) + return ast + end + if EmptyQ(ast) + return ast + endif + + let first = ListFirst(ast) + let first_symbol = SymbolQ(first) ? first.val : "" + if first_symbol == "def!" + let a1 = ast.val[1] + let a2 = ast.val[2] + return env.set(a1.val, EVAL(a2, env)) + elseif first_symbol == "let*" + let a1 = ast.val[1] + let a2 = ast.val[2] + let env = NewEnv(env) + let let_binds = a1.val + let i = 0 + while i < len(let_binds) + call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) + let i = i + 2 + endwhile + let ast = a2 + " TCO + elseif first_symbol == "quote" + return ListNth(ast, 1) + elseif first_symbol == "quasiquote" + let ast = Quasiquote(ListNth(ast, 1)) + " TCO + elseif first_symbol == "defmacro!" + let a1 = ListNth(ast, 1) + let a2 = ListNth(ast, 2) + let macro = MarkAsMacro(EVAL(a2, env)) + return env.set(a1.val, macro) + elseif first_symbol == "if" + let condvalue = EVAL(ast.val[1], env) + if FalseQ(condvalue) || NilQ(condvalue) + if len(ast.val) < 4 + return g:MalNil + else + let ast = ast.val[3] + endif + else + let ast = ast.val[2] + endif + " TCO + elseif first_symbol == "try*" + try + return EVAL(ListNth(ast, 1), env) + catch + let catch_clause = GetCatchClause(ast) + if empty(catch_clause) + throw v:exception + endif + + let exc_var = ListNth(catch_clause, 1).val + if v:exception == "__MalException__" + let exc_value = g:MalExceptionObj + else + let exc_value = StringNew(v:exception) + endif + let catch_env = NewEnvWithBinds(env, ListNew([SymbolNew(exc_var)]), ListNew([exc_value])) + return EVAL(ListNth(catch_clause, 2), catch_env) + endtry + elseif first_symbol == "do" + let astlist = ast.val + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor + let ast = astlist[-1] + " TCO + elseif first_symbol == "fn*" + let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) + return fn + elseif first_symbol == "eval" + let ast = EVAL(ListNth(ast, 1), env) + let env = env.root() + " TCO + else + " apply list + let funcobj = EVAL(first, env) + let args = ListRest(ast) + if MacroQ(funcobj) + let ast = FuncInvoke(funcobj, args) + continue + " TCO + endif + let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) + if NativeFunctionQ(funcobj) + return NativeFuncInvoke(funcobj, args) + elseif FunctionQ(funcobj) + let fn = funcobj.val + let ast = fn.ast + let env = NewEnvWithBinds(fn.env, fn.params, args) + " TCO + else + throw "Not a function" + endif + endif + endwhile +endfunction + +function PRINT(exp) + return PrStr(a:exp, 1) +endfunction + +function RE(str, env) + return EVAL(READ(a:str), a:env) +endfunction + +function REP(str, env) + return PRINT(EVAL(READ(a:str), a:env)) +endfunction + +function GetArgvList() + return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) +endfunction + +set maxfuncdepth=10000 +let repl_env = NewEnv("") + +for [k, v] in items(CoreNs) + call repl_env.set(k, v) +endfor + +call repl_env.set("*ARGV*", GetArgvList()) + +call RE("(def! *host-language* \"vimscript\")", repl_env) +call RE("(def! not (fn* (a) (if a false true)))", repl_env) +call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) +call RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) + +if !empty(argv()) + try + call RE('(load-file "' . argv(0) . '")', repl_env) + catch + call PrintLn("Error: " . v:exception) + endtry + qall! +endif + +call REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) + +while 1 + let [eof, line] = Readline("user> ") + if eof + break + endif + if line == "" + continue + endif + try + call PrintLn(REP(line, repl_env)) + catch + if v:exception == "__MalException__" + call PrintLn("Error: " . PrStr(g:MalExceptionObj, 1)) + else + call PrintLn("Error: " . v:exception) + end + endtry +endwhile +qall! diff --git a/impls/vimscript/tests/step5_tco.mal b/impls/vimscript/tests/step5_tco.mal new file mode 100644 index 0000000000..d20df25db7 --- /dev/null +++ b/impls/vimscript/tests/step5_tco.mal @@ -0,0 +1,15 @@ +;; Test recursive non-tail call function + +(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) + +(sum-to 10) +;=>55 + +;;; no try* yet, so test completion of side-effects +(def! res1 nil) +;=>nil +;;; For implementations without their own TCO this should fail and +;;; leave res1 unchanged +(def! res1 (sum-to 10000)) +res1 +;=>nil diff --git a/impls/vimscript/tests/stepA_mal.mal b/impls/vimscript/tests/stepA_mal.mal new file mode 100644 index 0000000000..da601484f9 --- /dev/null +++ b/impls/vimscript/tests/stepA_mal.mal @@ -0,0 +1,41 @@ +;; Testing basic Vim interop with (vim* "...") +;; + +(vim* "7") +;=>7 + +(vim* "'7'") +;=>"7" + +(vim* "[7,8,9]") +;=>(7 8 9) + +(vim* "{\"abc\": 789}") +;=>{"abc" 789} + +;; +;; Test Vim eval() expression support +;; + +(vim* "3 + 7 * 8") +;=>59 + +(vim* "join(['a','b','c'], '_')") +;=>"a_b_c" + +(vim* "split('d@@@@e@f@@g', '@\+')") +;=>("d" "e" "f" "g") + +(vim* "add([1,2,3], 4)") +;=>(1 2 3 4) + +;; +;; Test access to Vim predefined variables +;; + +;;; (vim* "v:progname") +;;; ;=>"vim" + +;; v:version is 800 for Vim 8.0 +(>= (vim* "v:version") 800) +;=>true diff --git a/impls/vimscript/types.vim b/impls/vimscript/types.vim new file mode 100644 index 0000000000..111c41ff82 --- /dev/null +++ b/impls/vimscript/types.vim @@ -0,0 +1,279 @@ +" types module + +function ObjNewWithMeta(obj_type, obj_val, obj_meta) + return {"type": a:obj_type, "val": a:obj_val, "meta": a:obj_meta} +endfunction + +function ObjNew(obj_type, obj_val) + return {"type": a:obj_type, "val": a:obj_val} +endfunction + +function ObjHasMeta(obj) + return has_key(a:obj, "meta") +endfunction + +function ObjMeta(obj) + return ObjHasMeta(a:obj) ? a:obj["meta"] : g:MalNil +endfunction + +function ObjSetValue(obj, newval) + let a:obj["val"] = a:newval + return a:newval +endfunction + +function ObjSetMeta(obj, newmeta) + let a:obj["meta"] = a:newmeta + return a:newmeta +endfunction + +function SymbolQ(obj) + return a:obj.type == "symbol" +endfunction + +function StringQ(obj) + return a:obj.type == "string" +endfunction + +function KeywordQ(obj) + return a:obj.type == "keyword" +endfunction + +function AtomQ(obj) + return a:obj.type == "atom" +endfunction + +function NilQ(obj) + return a:obj.type == "nil" +endfunction + +function TrueQ(obj) + return a:obj.type == "true" +endfunction + +function FalseQ(obj) + return a:obj.type == "false" +endfunction + +function IntegerQ(obj) + return a:obj.type == "integer" +endfunction + +function FloatQ(obj) + return a:obj.type == "float" +endfunction + +function ListQ(obj) + return a:obj.type == "list" +endfunction + +function VectorQ(obj) + return a:obj.type == "vector" +endfunction + +function SequentialQ(obj) + return ListQ(a:obj) || VectorQ(a:obj) +endfunction + +function HashQ(obj) + return a:obj.type == "hash" +endfunction + +function FunctionQ(obj) + return a:obj.type == "function" && !a:obj.val.is_macro +endfunction + +function MacroQ(obj) + return a:obj.type == "function" && a:obj.val.is_macro +endfunction + +function NativeFunctionQ(obj) + return a:obj.type == "nativefunction" +endfunction + +function NilNew() + return ObjNew("nil", "") +endfunction + +function TrueNew() + return ObjNew("true", "") +endfunction + +function FalseNew() + return ObjNew("false", "") +endfunction + +function BoolNew(bool) + return a:bool ? g:MalTrue : g:MalFalse +endfunction + +function KeywordNew(val) + return ObjNew("keyword", a:val) +endfunction + +function AtomNew(val) + return ObjNewWithMeta("atom", a:val, g:MalNil) +endfunction + +function SymbolNew(val) + return ObjNew("symbol", a:val) +endfunction + +function StringNew(val) + return ObjNew("string", a:val) +endfunction + +function IntegerNew(val) + return ObjNew("integer", a:val) +endfunction + +function FloatNew(val) + return ObjNew("float", a:val) +endfunction + +function ListNew(val) + return ObjNewWithMeta("list", a:val, g:MalNil) +endfunction + +function VectorNew(val) + return ObjNewWithMeta("vector", a:val, g:MalNil) +endfunction + +function HashNew(val) + return ObjNewWithMeta("hash", a:val, g:MalNil) +endfunction + +function HashMakeKey(obj) + if !StringQ(a:obj) && !KeywordQ(a:obj) + throw "expected hash-map key string, got: " . a:obj.type); + endif + return a:obj.type . "#" . a:obj.val +endfunction + +function HashParseKey(str) + if a:str =~ "^string#" + return StringNew(a:str[7:]) + elseif a:str =~ "^keyword#" + return KeywordNew(a:str[8:]) + endif +endfunction + +function HashBuild(elements) + if (len(a:elements) % 2) != 0 + throw "Odd number of hash-map arguments" + endif + let i = 0 + let hash = {} + while i < len(a:elements) + let key = a:elements[i] + let val = a:elements[i + 1] + let keystring = HashMakeKey(key) + let hash[keystring] = val + let i = i + 2 + endwhile + return HashNew(hash) +endfunction + +function HashEqualQ(x, y) + if len(a:x.val) != len(a:y.val) + return 0 + endif + for k in keys(a:x.val) + let vx = a:x.val[k] + let vy = a:y.val[k] + if empty(vy) || !EqualQ(vx, vy) + return 0 + endif + endfor + return 1 +endfunction + +function SequentialEqualQ(x, y) + if len(a:x.val) != len(a:y.val) + return 0 + endif + let i = 0 + while i < len(a:x.val) + let ex = a:x.val[i] + let ey = a:y.val[i] + if !EqualQ(ex, ey) + return 0 + endif + let i = i +1 + endwhile + return 1 +endfunction + +function EqualQ(x, y) + if SequentialQ(a:x) && SequentialQ(a:y) + return SequentialEqualQ(a:x, a:y) + elseif HashQ(a:x) && HashQ(a:y) + return HashEqualQ(a:x, a:y) + elseif a:x.type != a:y.type + return 0 + else + return a:x.val == a:y.val + endif +endfunction + +function EmptyQ(list) + return empty(a:list.val) +endfunction + +function ListCount(list) + return len(a:list.val) +endfunction + +function ListNth(list, index) + if a:index >= len(a:list.val) + throw "nth: index out of range" + endif + return a:list.val[a:index] +endfunction + +function ListFirst(list) + return get(a:list.val, 0, g:MalNil) +endfunction + +function ListDrop(list, drop_elements) + return ListNew(a:list.val[a:drop_elements :]) +endfunction + +function ListRest(list) + return ListDrop(a:list, 1) +endfunction + +function FuncInvoke(funcobj, args) + let fn = a:funcobj.val + let funcenv = NewEnvWithBinds(fn.env, fn.params, a:args) + return EVAL(fn.ast, funcenv) +endfunction + +function NativeFuncInvoke(funcobj, argslist) + let fn = a:funcobj.val + return fn.Func(a:argslist.val) +endfunction + +function MarkAsMacro(funcobj) + let fn = a:funcobj.val + let mac = {"ast": fn.ast, "env": fn.env, "params": fn.params, "is_macro": 1} + return ObjNewWithMeta("function", mac, g:MalNil) +endfunction + +function NewFn(ast, env, params) + let fn = {"ast": a:ast, "env": a:env, "params": a:params, "is_macro": 0} + return ObjNewWithMeta("function", fn, g:MalNil) +endfunction + +function NewNativeFn(funcname) + let fn = {"Func": function(a:funcname), "name": a:funcname} + return ObjNewWithMeta("nativefunction", fn, g:MalNil) +endfunction + +function NewNativeFnLambda(lambdaexpr) + let fn = {"Func": a:lambdaexpr, "name": "inline"} + return ObjNewWithMeta("nativefunction", fn, g:MalNil) +endfunction + +let g:MalNil = NilNew() +let g:MalTrue = TrueNew() +let g:MalFalse = FalseNew() diff --git a/impls/vimscript/vimextras.c b/impls/vimscript/vimextras.c new file mode 100644 index 0000000000..15d9d5ad9c --- /dev/null +++ b/impls/vimscript/vimextras.c @@ -0,0 +1,44 @@ +#include +#include +#include +#include +#include + +/* + * Vim interface for the readline(3) function. + * + * Prints 'prompt' and reads a line from the input. If EOF is encountered, + * returns the string "E"; otherwise, returns the string "S" where + * is the line read from input. + * + * This function is not thread-safe. + */ +char* vimreadline(char* prompt) { + static char buf[1024]; + char* res = readline(prompt); + if (res) { + buf[0] = 'S'; + strncpy(buf + 1, res, sizeof(buf) - 1); + free(res); + } else { + buf[0] = 'E'; + buf[1] = '\0'; + } + return buf; +} + +#define UNIXTIME_BASE 1451606400 /* = Unix time of 2016-01-01 */ + +/* + * Returns the number of milliseconds since 2016-01-01 00:00:00 UTC. + * + * This date is chosen (instead of the standard 1970 epoch) so the number of + * milliseconds will not exceed a 32-bit integer, which is the limit for Vim + * number variables. + */ +int vimtimems(int dummy) { + struct timeval tv; + (void) dummy; /* unused */ + gettimeofday(&tv, NULL); + return (tv.tv_sec - UNIXTIME_BASE) * 1000 + (tv.tv_usec / 1000); +} diff --git a/impls/wasm/Dockerfile b/impls/wasm/Dockerfile new file mode 100644 index 0000000000..9e57354150 --- /dev/null +++ b/impls/wasm/Dockerfile @@ -0,0 +1,181 @@ +FROM ubuntu:20.04 as base +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +# +# node +# + +# For building node modules +RUN apt-get -y install g++ + +# Add nodesource apt repo config for 16.x stable +RUN apt-get -y install gnupg +RUN curl -sL https://deb.nodesource.com/setup_16.x | bash - + +# Install nodejs +RUN apt-get -y install nodejs + +ENV NPM_CONFIG_CACHE /mal/.npm + +# +# wace build and runtime libs +# +RUN dpkg --add-architecture i386 && \ + apt-get -y update && \ + DEBIAN_FRONTEND=noninteractive apt-get -y install \ + lib32gcc-9-dev lib32gcc-8-dev lib32gcc-7-dev \ + libsdl2-dev:i386 libsdl2-image-dev:i386 \ + libedit-dev:i386 freeglut3-dev:i386 \ + libreadline-dev:i386 + +# +# binaryen +# +RUN apt-get -y install git-core cmake + +RUN apt-get -y install binaryen + +########################################################################### +FROM base as build_tools +########################################################################### + +# +# clang/LLVM and rust (for building wasmtime) +# +#RUN apt-get -y install llvm-3.9-dev libclang-3.9-dev clang-3.9 +#RUN apt-get -y install curl && \ +# curl https://sh.rustup.rs -sSf > /tmp/rustup.sh && \ +# sh /tmp/rustup.sh -y +#ENV PATH $PATH:/root/.cargo/bin + +# +# pypy / rpython (for building warpy) +# + +## rpython deps +#ENV DEBIAN_FRONTEND=noninteractive +#RUN apt-get -y install libffi-dev pkg-config libz-dev \ +# libbz2-dev libsqlite3-dev libncurses-dev libexpat1-dev \ +# libssl-dev libgdbm-dev tcl-dev +# +## install pypy, build and install pypy/rpython, remove prior pypy +#RUN apt-get -y install software-properties-common && \ +# add-apt-repository ppa:pypy && \ +# apt-get -y update && \ +# apt-get -y install pypy && \ +# mkdir -p /opt/pypy && \ +# curl -L https://github.com/pypy/pypy/archive/refs/tags/release-pypy2.7-v6.0.0.tar.gz \ +# | tar -xzf - -C /opt/pypy/ --strip-components=1 && \ +# cd /opt/pypy && make && \ +# chmod -R ugo+rw /opt/pypy/rpython/_cache && \ +# ln -sf /opt/pypy/rpython/bin/rpython /usr/local/bin/rpython && \ +# ln -sf /opt/pypy/pypy-c /usr/local/bin/pypy && \ +# rm -rf /tmp/usession* && \ +# ln -sf /opt/pypy/pypy/goal/pypy-c /usr/local/bin/pypy && \ +# apt-get -y autoremove pypy + + +# +# wasi-sdk (C/C++ -> wasm+wasi) +# +RUN curl -LO https://github.com/CraneStation/wasi-sdk/releases/download/wasi-sdk-5/wasi-sdk_5.0_amd64.deb && \ + dpkg -i wasi-sdk_5.0_amd64.deb && \ + rm wasi-sdk_5.0_amd64.deb + +## +## Rust wasm support +## +#RUN rustup default nightly +#RUN rustup target add wasm32-unknown-wasi --toolchain nightly +##RUN cargo +nightly build --target wasm32-unknown-wasi +# +## TODO: Do this when we install rust instead +#RUN mv /root/.cargo /opt/cargo && mv /root/.rustup /opt/rustup +#RUN chmod -R a+r /opt/cargo && chmod -R a+rw /opt/rustup +#ENV CARGO_HOME /opt/cargo +#ENV RUSTUP_HOME /opt/rustup +#ENV PATH $PATH:/opt/cargo/bin + +########################################################################### +FROM build_tools as runtimes +########################################################################### + +# +# warpy +# +#RUN git clone https://github.com/kanaka/warpy/ && \ +# cd warpy && \ +# make warpy-nojit && \ +# cp warpy-nojit /usr/bin/warpy + +# +# wac/wace +# +#RUN git clone https://github.com/kanaka/wac/ && \ +# cd wac && \ +# make USE_SDL= wac wax wace && \ +# cp wac wax wace /usr/bin + +# +# wasmer +# + +#RUN curl https://get.wasmer.io -sSfL | sh +RUN sh -c "$(curl https://get.wasmer.io -sSfL)" -- 2.0.0 && \ + cp /root/.wasmer/bin/wasmer /usr/bin/wasmer && \ + cp /root/.wasmer/bin/wapm /usr/bin/wapm + +#RUN git clone --recursive https://github.com/wasmerio/wasmer && \ +# cd wasmer && \ +# cargo build --release && \ +# cp target/release/wasmer /usr/bin/ + +# +# wasmtime +# + +RUN curl -L https://github.com/bytecodealliance/wasmtime/releases/download/v3.0.0/wasmtime-v3.0.0-x86_64-linux.tar.xz | tar xvJf - && \ + cp wasmtime-v3.0.0-x86_64-linux/wasmtime /usr/bin/wasmtime + +#RUN git clone --recursive https://github.com/CraneStation/wasmtime && \ +# cd wasmtime && \ +# sed -i 's/c3994bf57b5d2f1f973b0e4e37bc385695aa4ed2/8ea7a983d8b1364e5f62d2adf0e74b3b8db1c9b3/' Cargo.toml && \ +# cargo build --release && \ +# cp target/release/wasmtime /usr/bin/ && \ +# cp target/release/wasm2obj /usr/bin/ + + +########################################################################### +FROM base as wasm +########################################################################### + +#COPY --from=runtimes /usr/bin/wac /usr/bin/wac +#COPY --from=runtimes /usr/bin/wax /usr/bin/wax +#COPY --from=runtimes /usr/bin/wace /usr/bin/wace +#COPY --from=runtimes /usr/bin/warpy /usr/bin/warpy +COPY --from=runtimes /usr/bin/wasmtime /usr/bin/wasmtime + +COPY --from=runtimes /usr/bin/wasmer /usr/bin/wasmer +COPY --from=runtimes /usr/bin/wapm /usr/bin/wapm + +ENV HOME /mal diff --git a/impls/wasm/Makefile b/impls/wasm/Makefile new file mode 100644 index 0000000000..ce06ca4b71 --- /dev/null +++ b/impls/wasm/Makefile @@ -0,0 +1,42 @@ +MODE ?= $(strip \ + $(if $(filter wace_libc,$(wasm_MODE)),\ + libc,\ + $(if $(filter direct node js wace_fooboot warpy,$(wasm_MODE)),\ + direct,\ + wasi))) + +EXT = .wasm + +WASM_AS ?= wasm-as +WAMP ?= node_modules/.bin/wamp + +STEP0_DEPS = $(WAMP) platform_$(MODE).wam string.wam printf.wam +STEP1_DEPS = $(STEP0_DEPS) types.wam mem.wam debug.wam reader.wam printer.wam +STEP3_DEPS = $(STEP1_DEPS) env.wam +STEP4_DEPS = $(STEP3_DEPS) core.wam + +STEPS = step0_repl step1_read_print step2_eval step3_env \ + step4_if_fn_do step5_tco step6_file step7_quote \ + step8_macros step9_try stepA_mal + +all: $(STEPS:=$(EXT)) + +$(WAMP): + npm install + +%.wat: %.wam + $(WAMP) $(filter %.wam,$^) > $*.wat + +%.wasm: %.wat + $(WASM_AS) $< -o $@ + +step0_repl.wat: $(STEP0_DEPS) +step1_read_print.wat step2_eval.wat: $(STEP1_DEPS) +step3_env.wat: $(STEP3_DEPS) +step4_if_fn_do.wat step5_tco.wat step6_file.wat: $(STEP4_DEPS) +step7_quote.wat step8_macros.wat step9_try.wat stepA_mal.wat: $(STEP4_DEPS) + +.PHONY: clean + +clean: + rm -f *.wat *.wasm diff --git a/impls/wasm/core.wam b/impls/wasm/core.wam new file mode 100644 index 0000000000..2d80978818 --- /dev/null +++ b/impls/wasm/core.wam @@ -0,0 +1,792 @@ +(module $core + + + ;; it would be nice to have this in types.wam but it uses + ;; ENV_NEW_BINDS which is not available until step3 but types is + ;; used in step1 + + (func $APPLY (param $f i32) (param $args i32) (result i32) + (local $res i32 $env i32 $ftype i32 $a i32) + (local.set $f ($DEREF_META $f)) + (local.set $ftype ($TYPE $f)) + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + ;; Must be kept in sync with EVAL's FUNCTION_T evaluation + (if (i32.eq ($VAL0 $f) 0) ;; eval + (then + (local.set $res ($EVAL ($MEM_VAL1_ptr $args) + (global.get $repl_env)))) + (else + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f)))))) + (else (if (OR (i32.eq $ftype (global.get $MALFUNC_T)) + (i32.eq $ftype (global.get $MACRO_T))) + (then + ;; create new environment using env and params stored in function + (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; claim the AST before releasing the list containing it + (local.set $a ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $a)) + + (local.set $res ($EVAL $a $env)) + + ($RELEASE $env) + ($RELEASE $a)) + (else + ($THROW_STR_1 "APPLY of non-function type: %d\n" $ftype) + (local.set $res 0))))) + $res + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; core functions + + (type $fnT (func (param i32) (result i32))) + + (func $equal_Q (param $args i32) (result i32) + ($TRUE_FALSE ($EQUAL_Q ($MEM_VAL1_ptr $args) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))) + + (func $throw (param $args i32) (result i32) + (global.set $error_type 2) + (global.set $error_val ($INC_REF ($MEM_VAL1_ptr $args))) + 0 + ) + + (func $nil_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) + (global.get $NIL_T)))) + (func $true_Q (param $args i32) (result i32) + (LET $ast ($MEM_VAL1_ptr $args)) + ($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (global.get $BOOLEAN_T)) + (i32.eq ($VAL0 $ast) 1))) + ) + (func $false_Q (param $args i32) (result i32) + (LET $ast ($MEM_VAL1_ptr $args)) + ($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (global.get $BOOLEAN_T)) + (i32.eq ($VAL0 $ast) 0))) + ) + (func $number_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) + (global.get $INTEGER_T)))) + (func $string_Q (param $args i32) (result i32) + (LET $mv ($MEM_VAL1_ptr $args)) + ($TRUE_FALSE (AND (i32.eq ($TYPE $mv) (global.get $STRING_T)) + (i32.ne (i32.load8_u ($to_String $mv)) + (CHR "\x7f")))) + ) + + (func $keyword (param $args i32) (result i32) + (LET $str ($to_String ($MEM_VAL1_ptr $args))) + (if (result i32) (i32.eq (i32.load8_u $str) (CHR "\x7f")) + (then ($INC_REF ($MEM_VAL1_ptr $args))) + (else + (drop ($sprintf_1 (global.get $printf_buf) "\x7f%s" $str)) + ($STRING (global.get $STRING_T) (global.get $printf_buf)))) + ) + + (func $keyword_Q (param $args i32) (result i32) + (LET $ast ($MEM_VAL1_ptr $args)) + ($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (global.get $STRING_T)) + (i32.eq (i32.load8_u ($to_String $ast)) + (CHR "\x7f")))) + ) + (func $fn_Q (param $args i32) (result i32) + (LET $type ($TYPE ($MEM_VAL1_ptr $args))) + ($TRUE_FALSE (OR (i32.eq $type (global.get $FUNCTION_T)) + (i32.eq $type (global.get $MALFUNC_T))))) + (func $macro_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) + (global.get $MACRO_T)))) + + (func $symbol (param $args i32) (result i32) + ($STRING (global.get $SYMBOL_T) ($to_String ($MEM_VAL1_ptr $args)))) + + (func $symbol_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) + (global.get $SYMBOL_T)))) + + (func $core_pr_str (param $args i32) (result i32) + ($pr_str_seq $args 1 " ")) + (func $str (param $args i32) (result i32) + ($pr_str_seq $args 0 "")) + (func $prn (param $args i32) (result i32) + (LET $res ($pr_str_seq $args 1 " ")) + ($printf_1 "%s\n" ($to_String $res)) + ($RELEASE $res) + ($INC_REF (global.get $NIL)) + ) + (func $println (param $args i32) (result i32) + (LET $res ($pr_str_seq $args 0 " ")) + ($printf_1 "%s\n" ($to_String $res)) + ($RELEASE $res) + ($INC_REF (global.get $NIL)) + ) + + (func $core_readline (param $args i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $mv 0) + (if (i32.eqz ($readline ($to_String ($MEM_VAL1_ptr $args)) $line)) + (return ($INC_REF (global.get $NIL)))) + (local.set $mv ($STRING (global.get $STRING_T) $line)) + $mv + ) + + (func $read_string (param $args i32) (result i32) + ($read_str ($to_String ($MEM_VAL1_ptr $args)))) + + (func $slurp (param $args i32) (result i32) + (LET $mv ($STRING_INIT (global.get $STRING_T)) + $size ($read_file ($to_String ($MEM_VAL1_ptr $args)) + ($to_String $mv))) + (if (i32.eqz $size) + (then + ($THROW_STR_1 "failed to read file '%s'" ($to_String ($MEM_VAL1_ptr $args))) + (return ($INC_REF (global.get $NIL))))) + (local.set $mv ($STRING_FINALIZE $mv $size)) + $mv + ) + + (func $lt (param $args i32) (result i32) + ($TRUE_FALSE + (i32.lt_s ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $lte (param $args i32) (result i32) + ($TRUE_FALSE + (i32.le_s ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $gt (param $args i32) (result i32) + ($TRUE_FALSE + (i32.gt_s ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $gte (param $args i32) (result i32) + ($TRUE_FALSE + (i32.ge_s ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $add (param $args i32) (result i32) + ($INTEGER + (i32.add ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $subtract (param $args i32) (result i32) + ($INTEGER + (i32.sub ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $multiply (param $args i32) (result i32) + ($INTEGER + (i32.mul ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $divide (param $args i32) (result i32) + ($INTEGER + (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + + (func $time_ms (param $args i32) (result i32) + ($INTEGER ($get_time_ms))) + + ;;; + + (func $list (param $args i32) (result i32) + ($INC_REF $args)) + + (func $list_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($DEREF_META ($MEM_VAL1_ptr $args))) + (global.get $LIST_T)))) + + (func $vector (param $args i32) (result i32) + ($FORCE_SEQ_TYPE (global.get $VECTOR_T) $args)) + + (func $vector_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($DEREF_META ($MEM_VAL1_ptr $args))) + (global.get $VECTOR_T)))) + + (func $hash_map (param $args i32) (result i32) + (LET $type (global.get $HASHMAP_T) + $res ($MAP_LOOP_START $type) + $val2 0 + $val3 0 + $c 0 + ;; push MAP_LOOP stack + $ret $res + $current $res + $empty $res) + + ;; READ_SEQ_LOOP + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $args))) + + (local.set $val2 ($INC_REF ($MEM_VAL1_ptr $args))) + (local.set $val3 ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))) + + ;; skip two + (local.set $args ($MEM_VAL0_ptr ($MEM_VAL0_ptr $args))) + + ;; update the return sequence structure + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (br $loop) + ) + ) + + ;; MAP_LOOP_DONE + $ret + ) + + + (func $hash_map_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($DEREF_META ($MEM_VAL1_ptr $args))) + (global.get $HASHMAP_T)))) + + (func $assoc (param $args i32) (result i32) + (LET $hm ($MEM_VAL1_ptr $args) + $key 0) + (local.set $args ($MEM_VAL0_ptr $args)) + + (drop ($INC_REF $hm)) + (block $done + (loop $loop + (br_if $done (OR (i32.eqz ($VAL0 $args)) + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $args))))) + (local.set $hm ($ASSOC1 $hm ($MEM_VAL1_ptr $args) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))) + (local.set $args ($MEM_VAL0_ptr ($MEM_VAL0_ptr $args))) + + (br $loop) + ) + ) + $hm + ) + + (func $get (param $args i32) (result i32) + (LET $hm ($MEM_VAL1_ptr $args) + $key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) + (if (result i32) (i32.eq $hm (global.get $NIL)) + (then ($INC_REF (global.get $NIL))) + (else ($INC_REF (i32.wrap_i64 ($HASHMAP_GET $hm $key))))) + ) + + (func $contains_Q (param $args i32) (result i32) + (LET $hm ($MEM_VAL1_ptr $args) + $key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) + ($TRUE_FALSE + (if (result i32) (i32.eq $hm (global.get $NIL)) + (then 0) + (else (i32.wrap_i64 + (i64.shr_u ($HASHMAP_GET $hm $key) (i64.const 32)))))) + ) + + (func $keys_or_vals (param $hm i32 $keys i32) (result i32) + (LET $res ($MAP_LOOP_START (global.get $LIST_T)) + $val2 0 + ;; MAP_LOOP stack + $ret $res + $current $res + $empty $res) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $hm))) + + (if $keys + (then (local.set $val2 ($INC_REF ($MEM_VAL1_ptr $hm)))) + (else (local.set $val2 ($INC_REF ($MEM_VAL2_ptr $hm))))) + + ;; next element + (local.set $hm ($MEM_VAL0_ptr $hm)) + + ;; update the return sequence structure + ;; do not release val2 since we are pulling it from the + ;; arguments and not creating it here + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) + $empty $current $val2 0)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (br $loop) + ) + ) + + ;; MAP_LOOP_DONE + $ret + ) + + (func $keys (param $args i32) (result i32) + ($keys_or_vals ($MEM_VAL1_ptr $args) 1)) + + (func $vals (param $args i32) (result i32) + ($keys_or_vals ($MEM_VAL1_ptr $args) 0)) + + (func $sequential_Q (param $args i32) (result i32) + ($TRUE_FALSE (OR (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) + (global.get $LIST_T)) + (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) + (global.get $VECTOR_T))))) + + (func $seq (param $args i32) (result i32) + (LET $mv ($MEM_VAL1_ptr $args) + $type ($TYPE $mv) + $res 0 + $ret 0 + $empty 0 + $current 0 + $i 0 + $char 0) + + (if (i32.eq $type (global.get $NIL_T)) + (then (return (global.get $NIL)))) + + (if (AND (i32.ne $type (global.get $LIST_T)) + (i32.ne $type (global.get $VECTOR_T)) + (i32.ne $type (global.get $STRING_T))) + (then (return (global.get $NIL)))) + + (if (i32.eqz ($VAL0 $mv)) (then (return (global.get $NIL)))) + + (if (i32.eq $type (global.get $LIST_T)) + (then (return ($FORCE_SEQ_TYPE (global.get $LIST_T) $mv)))) + + (if (i32.eq $type (global.get $VECTOR_T)) + (then (return ($FORCE_SEQ_TYPE (global.get $LIST_T) $mv)))) + + (if (i32.eq $type (global.get $STRING_T)) + (then + (local.set $mv ($to_String $mv)) + (if (i32.eqz ($strlen $mv)) (then (return (global.get $NIL)))) + (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) + (local.set $empty $res) + (local.set $current $res) + (local.set $ret $res) + (local.set $i 0) + (block $done + (loop $loop + (local.set $char (i32.load8_u (i32.add $mv $i))) + (br_if $done (i32.eq $char 0)) + + (i32.store8 (global.get $token_buf) $char) + (i32.store8 (i32.add (global.get $token_buf) 1) 0) + + (local.set $res + ($MAP_LOOP_UPDATE (global.get $LIST_T) + $empty $current ($STRING (global.get $STRING_T) (global.get $token_buf)) 0)) + (if (i32.le_u $current (global.get $EMPTY_LIST)) + ;; if first element, set return to new element + (local.set $ret $res)) + + (local.set $i (i32.add $i 1)) + (local.set $current $res) + (br $loop) + ) + ) + (return $ret) + ) + ) + (global.get $NIL) + ) + + (func $cons (param $args i32) (result i32) + ($LIST ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)) ($MEM_VAL1_ptr $args))) + + (func $concat (param $args i32) (result i32) + (local $last_sl i64) + (LET $res ($INC_REF (global.get $EMPTY_LIST)) + $current $res + $sl 0 + $last 0 + $arg 0) + (block $done + (loop $loop + (br_if $done (i32.le_u $args (global.get $EMPTY_HASHMAP))) + (local.set $arg ($MEM_VAL1_ptr $args)) + ;; skip empty elements + (if (i32.le_s $arg (global.get $EMPTY_HASHMAP)) + (then + (local.set $args ($MEM_VAL0_ptr $args)) + (br $loop))) + (local.set $last_sl ($SLICE $arg 0 -1)) + (local.set $sl (i32.wrap_i64 $last_sl)) + (local.set $last (i32.wrap_i64 (i64.shr_u $last_sl (i64.const 32)))) + (if (i32.eq $res (global.get $EMPTY_LIST)) + (then + ;; if this is the first element, set the return to the slice + (local.set $res $sl)) + (else + ;; otherwise attach current to sliced + (i32.store ($VAL0_ptr $current) ($IDX $sl)))) + ;; update current to end of sliced list + (local.set $current $last) + ;; release empty since no longer part of the slice + ($RELEASE (global.get $EMPTY_LIST)) + + (local.set $args ($MEM_VAL0_ptr $args)) + (br $loop) + ) + ) + $res + ) + + (func $vec (param $args i32) (result i32) + ($FORCE_SEQ_TYPE (global.get $VECTOR_T) ($MEM_VAL1_ptr $args))) + + (func $nth (param $args i32) (result i32) + (LET $a ($MEM_VAL1_ptr $args) + $idx ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) + $i 0) + + (block $done + (loop $loop + (br_if $done (OR (i32.ge_s $i $idx) (i32.eqz ($VAL0 $a)))) + (local.set $i (i32.add $i 1)) + (local.set $a ($MEM_VAL0_ptr $a)) + (br $loop) + ) + ) + (if (i32.eq ($VAL0 $a) 0) + (then + ($THROW_STR_0 "nth: index out of range") + (return 0))) + + ($INC_REF ($MEM_VAL1_ptr $a)) + ) + + (func $first (param $args i32) (result i32) + (LET $res (global.get $NIL) + $a ($MEM_VAL1_ptr $args)) + (if (AND (i32.ne $a (global.get $NIL)) + (i32.ne ($VAL0 $a) 0)) + (local.set $res ($MEM_VAL1_ptr $a))) + ($INC_REF $res) + ) + + (func $rest (param $args i32) (result i32) + (LET $a ($MEM_VAL1_ptr $args)) + (if (i32.eq $a (global.get $NIL)) + (return ($INC_REF (global.get $EMPTY_LIST)))) + (if (i32.ne ($VAL0 $a) 0) + (local.set $a ($MEM_VAL0_ptr $a))) + ($FORCE_SEQ_TYPE (global.get $LIST_T) $a) + ) + + ;;; + + (func $empty_Q (param $args i32) (result i32) + ($TRUE_FALSE ($EMPTY_Q ($MEM_VAL1_ptr $args)))) + + (func $count (param $args i32) (result i32) + ($INTEGER ($COUNT ($MEM_VAL1_ptr $args)))) + + (func $apply (param $args i32) (result i32) + (local $last_sl i64) + (LET $f ($MEM_VAL1_ptr $args) + $f_args 0 + $rest_args ($MEM_VAL0_ptr $args) + $rest_count ($COUNT $rest_args) + $last 0 + $res 0) + + (if (i32.le_s $rest_count 1) + (then + ;; no intermediate args + (if (i32.ne ($TYPE ($MEM_VAL1_ptr $rest_args)) (global.get $LIST_T)) + (then + ;; not a list, so convert it first + (local.set $f_args ($FORCE_SEQ_TYPE (global.get $LIST_T) + ($MEM_VAL1_ptr $rest_args)))) + (else + ;; inc ref since we will release after APPLY + (local.set $f_args ($INC_REF ($MEM_VAL1_ptr $rest_args)))))) + (else + ;; 1 or more intermediate args + (local.set $last_sl ($SLICE $rest_args 0 (i32.sub $rest_count 1))) + (local.set $f_args (i32.wrap_i64 $last_sl)) + (local.set $last (i32.wrap_i64 (i64.shr_u $last_sl (i64.const 32)))) + ;; release the terminator of the new list (we skip over it) + ;; we already checked for an empty list above, so $last is + ;; a real non-empty list + ($RELEASE ($MEM_VAL0_ptr $last)) + ;; attach end of slice to final args element + (i32.store ($VAL0_ptr $last) ($IDX ($LAST $rest_args))) + )) + + (local.set $res ($APPLY $f $f_args)) + + ;; release new args + ($RELEASE $f_args) + $res + ) + + (func $map (param $args i32) (result i32) + (LET $f ($MEM_VAL1_ptr $args) + $rest_args ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)) + $f_args 0 + $res ($MAP_LOOP_START (global.get $LIST_T)) + ;; push MAP_LOOP stack + $ret $res + $current $res + $empty $res) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $rest_args))) + + ;; create argument list for apply + (local.set $f_args ($ALLOC (global.get $LIST_T) + (global.get $EMPTY_LIST) + ($MEM_VAL1_ptr $rest_args) + 0)) + + (local.set $res ($APPLY $f $f_args)) + ($RELEASE $f_args) + + ;; go to the next element + (local.set $rest_args ($MEM_VAL0_ptr $rest_args)) + + (if (global.get $error_type) + (then + ;; if error, release the unattached element + ($RELEASE $res) + (br $done))) + + ;; update the return sequence structure + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) + $empty $current $res 0)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (br $loop) + ) + ) + + ;; MAP_LOOP_DONE + $ret + ) + + ;;; + + (func $with_meta (param $args i32) (result i32) + (LET $mv ($MEM_VAL1_ptr $args) + $meta ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) + ;; remove existing metadata first + ($ALLOC (global.get $METADATA_T) ($DEREF_META $mv) $meta 0) + ) + + (func $meta (param $args i32) (result i32) + (if (result i32) (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $METADATA_T)) + (then ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL1_ptr $args)))) + (else ($INC_REF (global.get $NIL))))) + + (func $atom (param $args i32) (result i32) + ($ALLOC_SCALAR (global.get $ATOM_T) ($VAL1 $args))) + + (func $atom_Q (param $args i32) (result i32) + ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $ATOM_T)))) + + (func $deref (param $args i32) (result i32) + ($INC_REF ($MEM_VAL0_ptr ($MEM_VAL1_ptr $args)))) + + (func $_reset_BANG (param $atom i32 $val i32) (result i32) + ;; release current value since we are about to overwrite it + ($RELEASE ($MEM_VAL0_ptr $atom)) + ;; inc ref by 2 for atom ownership and since we are returning it + (drop ($INC_REF ($INC_REF $val))) + ;; update the value + (i32.store ($VAL0_ptr $atom) ($IDX $val)) + $val + ) + + (func $reset_BANG (param $args i32) (result i32) + (LET $atom ($MEM_VAL1_ptr $args) + $val ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) + ($_reset_BANG $atom $val) + ) + + (func $swap_BANG (param $args i32) (result i32) + (LET $atom ($MEM_VAL1_ptr $args) + $f_args ($MEM_VAL0_ptr $args) + $rest_args ($MEM_VAL0_ptr $f_args) + ;; add atom value to front of the args list + $s_args ($LIST $rest_args ($MEM_VAL0_ptr $atom)) ;; cons + $f ($MEM_VAL1_ptr $f_args) + $res ($APPLY $f $s_args)) + ;; release args + ($RELEASE $s_args) + ;; use reset to update the value + (drop ($_reset_BANG $atom $res)) + ;; but decrease the ref cnt of return by 1 (not sure why) + ($RELEASE $res) + $res + ) + + ;;; + + (func $pr_memory_summary (param $args i32) (result i32) + ($PR_MEMORY_SUMMARY_SMALL) + ($INC_REF (global.get $NIL)) + ) + + (func $nop (param $args i32) (result i32) + ($INC_REF (global.get $NIL))) + + (table + funcref + (elem $nop ;; placeholder for eval which will use 0 + $equal_Q + $throw + $nil_Q + $true_Q + $false_Q + $number_Q + $string_Q + $symbol + $symbol_Q + $keyword + $keyword_Q + $fn_Q + $macro_Q + + ;; 14 + $core_pr_str + $str + $prn + $println + $core_readline + $read_string + $slurp + $lt + $lte + $gt + $gte + $add + $subtract + $multiply + $divide + $time_ms + + ;; 30 + $list + $list_Q + $vector + $vector_Q + $hash_map + $hash_map_Q + $assoc + $nop ;; $dissoc + $get + $contains_Q + $keys + $vals + + ;; 42 + $sequential_Q + $cons + $concat + $nth + $first + $rest + $empty_Q + $count + $apply + $map + $nop ;; $conj + $seq + + ;; 54 + $with_meta + $meta + $atom + $atom_Q + $deref + $reset_BANG + $swap_BANG + + $pr_memory_summary + $vec + ) + ) + + (func $add_core_ns (param $env i32) + ;;(drop ($ENV_SET_S $env "eval" ($FUNCTION 0))) + (drop ($ENV_SET_S $env "=" ($FUNCTION 1))) + (drop ($ENV_SET_S $env "throw" ($FUNCTION 2))) + (drop ($ENV_SET_S $env "nil?" ($FUNCTION 3))) + (drop ($ENV_SET_S $env "true?" ($FUNCTION 4))) + (drop ($ENV_SET_S $env "false?" ($FUNCTION 5))) + (drop ($ENV_SET_S $env "number?" ($FUNCTION 6))) + (drop ($ENV_SET_S $env "string?" ($FUNCTION 7))) + (drop ($ENV_SET_S $env "symbol" ($FUNCTION 8))) + (drop ($ENV_SET_S $env "symbol?" ($FUNCTION 9))) + (drop ($ENV_SET_S $env "keyword" ($FUNCTION 10))) + (drop ($ENV_SET_S $env "keyword?" ($FUNCTION 11))) + (drop ($ENV_SET_S $env "fn?" ($FUNCTION 12))) + (drop ($ENV_SET_S $env "macro?" ($FUNCTION 13))) + + (drop ($ENV_SET_S $env "pr-str" ($FUNCTION 14))) + (drop ($ENV_SET_S $env "str" ($FUNCTION 15))) + (drop ($ENV_SET_S $env "prn" ($FUNCTION 16))) + (drop ($ENV_SET_S $env "println" ($FUNCTION 17))) + (drop ($ENV_SET_S $env "readline" ($FUNCTION 18))) + (drop ($ENV_SET_S $env "read-string" ($FUNCTION 19))) + (drop ($ENV_SET_S $env "slurp" ($FUNCTION 20))) + (drop ($ENV_SET_S $env "<" ($FUNCTION 21))) + (drop ($ENV_SET_S $env "<=" ($FUNCTION 22))) + (drop ($ENV_SET_S $env ">" ($FUNCTION 23))) + (drop ($ENV_SET_S $env ">=" ($FUNCTION 24))) + (drop ($ENV_SET_S $env "+" ($FUNCTION 25))) + (drop ($ENV_SET_S $env "-" ($FUNCTION 26))) + (drop ($ENV_SET_S $env "*" ($FUNCTION 27))) + (drop ($ENV_SET_S $env "/" ($FUNCTION 28))) + (drop ($ENV_SET_S $env "time-ms" ($FUNCTION 29))) + + (drop ($ENV_SET_S $env "list" ($FUNCTION 30))) + (drop ($ENV_SET_S $env "list?" ($FUNCTION 31))) + (drop ($ENV_SET_S $env "vector" ($FUNCTION 32))) + (drop ($ENV_SET_S $env "vector?" ($FUNCTION 33))) + (drop ($ENV_SET_S $env "hash-map" ($FUNCTION 34))) + (drop ($ENV_SET_S $env "map?" ($FUNCTION 35))) + (drop ($ENV_SET_S $env "assoc" ($FUNCTION 36))) + (drop ($ENV_SET_S $env "dissoc" ($FUNCTION 37))) + (drop ($ENV_SET_S $env "get" ($FUNCTION 38))) + (drop ($ENV_SET_S $env "contains?" ($FUNCTION 39))) + (drop ($ENV_SET_S $env "keys" ($FUNCTION 40))) + (drop ($ENV_SET_S $env "vals" ($FUNCTION 41))) + + (drop ($ENV_SET_S $env "sequential?" ($FUNCTION 42))) + (drop ($ENV_SET_S $env "cons" ($FUNCTION 43))) + (drop ($ENV_SET_S $env "concat" ($FUNCTION 44))) + (drop ($ENV_SET_S $env "nth" ($FUNCTION 45))) + (drop ($ENV_SET_S $env "first" ($FUNCTION 46))) + (drop ($ENV_SET_S $env "rest" ($FUNCTION 47))) + (drop ($ENV_SET_S $env "empty?" ($FUNCTION 48))) + (drop ($ENV_SET_S $env "count" ($FUNCTION 49))) + (drop ($ENV_SET_S $env "apply" ($FUNCTION 50))) + (drop ($ENV_SET_S $env "map" ($FUNCTION 51))) + + (drop ($ENV_SET_S $env "conj" ($FUNCTION 52))) + (drop ($ENV_SET_S $env "seq" ($FUNCTION 53))) + + (drop ($ENV_SET_S $env "with-meta" ($FUNCTION 54))) + (drop ($ENV_SET_S $env "meta" ($FUNCTION 55))) + (drop ($ENV_SET_S $env "atom" ($FUNCTION 56))) + (drop ($ENV_SET_S $env "atom?" ($FUNCTION 57))) + (drop ($ENV_SET_S $env "deref" ($FUNCTION 58))) + (drop ($ENV_SET_S $env "reset!" ($FUNCTION 59))) + (drop ($ENV_SET_S $env "swap!" ($FUNCTION 60))) + + (drop ($ENV_SET_S $env "pr-memory-summary" ($FUNCTION 61))) + (drop ($ENV_SET_S $env "vec" ($FUNCTION 62))) + ) +) diff --git a/impls/wasm/debug.wam b/impls/wasm/debug.wam new file mode 100644 index 0000000000..66ad533a4a --- /dev/null +++ b/impls/wasm/debug.wam @@ -0,0 +1,285 @@ +(module $debug + + (func $checkpoint_user_memory + (global.set $mem_user_start (global.get $mem_unused_start)) + (global.set $string_mem_user_start (global.get $string_mem_next)) + ) + + (func $CHECK_FREE_LIST (result i32) + (LET $first (i32.add + (global.get $mem) + (i32.mul (global.get $mem_free_list) 4)) + $count 0) + + (block $done + (loop $loop + (br_if $done + (i32.ge_s $first + (i32.add (global.get $mem) + (i32.mul (global.get $mem_unused_start) + 4)))) + (local.set $count (i32.add $count ($MalVal_size $first))) + (local.set $first (i32.add (global.get $mem) (i32.mul 4 ($VAL0 $first)))) + (br $loop) + ) + ) + $count + ) + + (func $PR_MEMORY_SUMMARY_SMALL + (LET $free (i32.sub (global.get $MEM_SIZE) + (i32.mul (global.get $mem_unused_start) 4)) + $free_list_count ($CHECK_FREE_LIST) + $mv (global.get $NIL) + $mem_ref_count 0) + + (block $done + (loop $loop + (br_if $done (i32.ge_s $mv (i32.add + (global.get $mem) + (i32.mul (global.get $mem_unused_start) + 4)))) + (if (i32.ne ($TYPE $mv) (global.get $FREE_T)) + (local.set $mem_ref_count (i32.add $mem_ref_count + (i32.shr_u + (i32.load $mv) + 5)))) + (local.set $mv (i32.add $mv (i32.mul 4 ($MalVal_size $mv)))) + (br $loop) + ) + ) + + ($printf_3 "Free: %d, Values: %d (refs: %d), Emptys: " + $free + (i32.sub + (i32.sub (global.get $mem_unused_start) 1) + $free_list_count) + $mem_ref_count) + (local.set $mv (global.get $NIL)) + (block $done + (loop $loop + (br_if $done (i32.gt_s $mv (global.get $TRUE))) + ($printf_1 "%d," (i32.div_s (i32.load $mv) 32)) + (local.set $mv (i32.add $mv 8)) + (br $loop) + ) + ) + (local.set $mv (global.get $EMPTY_LIST)) + (block $done + (loop $loop + (br_if $done (i32.gt_s $mv (global.get $EMPTY_HASHMAP))) + ($printf_1 "%d," (i32.div_s (i32.load $mv) 32)) + (local.set $mv (i32.add $mv 12)) + (br $loop) + ) + ) + ($print "\n") + ) + + (func $PR_VALUE (param $fmt i32 $mv i32) + (LET $temp ($pr_str $mv 1)) + ($printf_1 $fmt ($to_String $temp)) + ($RELEASE $temp) + ) + + (func $PR_MEMORY_VALUE (param $idx i32) (result i32) + ;;; mv = mem + idx + (LET $mv ($MalVal_ptr $idx) + $type ($TYPE $mv) + $size ($MalVal_size $mv) + $val0 ($MalVal_val $idx 0)) + + ($printf_2 "%4d: type %2d" $idx $type) + + (if (i32.eq $type 15) + (then ($printf_1 ", size %2d" $size)) + (else ($printf_1 ", refs %2d" ($REFS $mv)))) + + (if (OR (i32.eq $type (global.get $STRING_T)) + (i32.eq $type (global.get $SYMBOL_T))) + ;; for strings/symbolx pointers, print hex values + (then ($printf_2 " [%4d|%3ds" ($MalVal_refcnt_type $idx) $val0)) + (else ($printf_2 " [%4d|%4d" ($MalVal_refcnt_type $idx) $val0))) + + (if (i32.eq $size 2) + (then + ($print "|----|----]")) + (else + ($printf_1 "|%4d" ($MalVal_val $idx 1)) + (if (i32.eq $size 3) + (then ($print "|----]")) + (else ($printf_1 "|%4d]" ($MalVal_val $idx 2)))))) + + ;;; printf(" >> ") + ($print " >> ") + + (block $done (block $unknown + (block (block (block (block (block (block (block (block + (block (block (block (block (block (block (block (block + (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + $unknown $type)) + ;; 0: nil + ($print "nil") + (br $done)) + ;; 1: boolean + (if (i32.eq $val0 0) + ;; true + ($print "false") + ;; false + ($print "true")) + (br $done)) + ;; 2: integer + ($printf_1 "%d" $val0) + (br $done)) + ;; 3: float/ERROR + ($print " *** GOT FLOAT *** ") + (br $done)) + ;; 4: string/kw + ($printf_1 "'%s'" ($to_String $mv)) + (br $done)) + ;; 5: symbol + ($print ($to_String $mv)) + (br $done)) + ;; 6: list + (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) + (then + ($print "()")) + (else + ;;; printf("(... %d ...), next: %d\n", mv->val[1], mv->val[0]) + ($printf_2 "(... %d ...), next: %d" + ($MalVal_val $idx 1) + ($MalVal_val $idx 0)))) + (br $done)) + ;; 7: vector + (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) + (then + ($print "[]")) + (else + ;;; printf("[... %d ...], next: %d\n", mv->val[1], mv->val[0])val + ($printf_2 "[... %d ...], next: %d" + ($MalVal_val $idx 1) + ($MalVal_val $idx 0)))) + (br $done)) + ;; 8: hashmap + (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) + (then + ($print "{}")) + (else + ;;; printf("{... '%s'(%d) : %d ...}\n", + ;; to_String(mem + mv->val[1]), mv->val[1], mv->val[2]) + ($printf_3 "{... '%s'(%d) : %d ...}" + ($to_String ($MalVal_ptr ($MalVal_val $idx 1))) + ($MalVal_val $idx 1) + ($MalVal_val $idx 2)))) + (br $done)) + ;; 9: function + ($print "function") + (br $done)) + ;; 10: mal function + ($print "mal function") + (br $done)) + ;; 11: macro fn + ($print "macro fn") + (br $done)) + ;; 12: atom + ($print "atom") + (br $done)) + ;; 13: environment + ($print "environment") + (br $done)) + ;; 14: metadata + ($print "metadata") + (br $done)) + ;; 15: FREE + ($printf_1 "FREE next: 0x%x" $val0) + (if (i32.eq $idx (global.get $mem_free_list)) + ($print " (free start)")) + (if (i32.eq $val0 (global.get $mem_unused_start)) + ($print " (free end)")) + (br $done)) + ;; 16: unknown + ($print "unknown") + ) + + ($print "\n") + + (i32.add $size $idx) + ) + + (func $PR_STRINGS (param $start i32) + (LET $ms 0 + $idx 0) + ($printf_2 "String - showing %d -> %d:\n" + $start (i32.sub (global.get $string_mem_next) + (global.get $string_mem))) + (if (i32.le_s (i32.sub (global.get $string_mem_next) + (global.get $string_mem)) + $start) + (then ($print " ---\n")) + (else + (local.set $ms (global.get $string_mem)) + (block $done + (loop $loop + (br_if $done (i32.ge_u $ms (global.get $string_mem_next))) + (local.set $idx (i32.sub $ms (global.get $string_mem))) + (if (i32.ge_s $idx $start) + ($printf_4 "%4d: refs %2d, size %2d >> '%s'\n" + $idx + (i32.load16_u $ms) + (i32.load16_u (i32.add $ms 2)) + (i32.add $ms 4))) + + (local.set $ms (i32.add $ms (i32.load16_u (i32.add $ms 2)))) + (br $loop) + ) + ))) + ) + + (func $PR_MEMORY (param $start i32 $end i32) + (LET $string_start 0 + $idx 0) + (if (i32.lt_s $start 0) + (then + (local.set $start (global.get $mem_user_start)) + (local.set $string_start (i32.sub (global.get $string_mem_user_start) + (global.get $string_mem))))) + (if (i32.lt_s $end 0) + (local.set $end (global.get $mem_unused_start))) + ;;; printf("Values - (mem) showing %d -> %d", start, end) + ;;; printf(" (unused start: %d, free list: %d):\n", + ;;; mem_unused_start, mem_free_list) + ($printf_4 "Values - (mem) showing 0x%x -> 0x%x (unused start: 0x%x, free list: 0x%x):\n" + $start + $end + (global.get $mem_unused_start) + (global.get $mem_free_list)) + + (if (i32.le_s $end $start) + (then + ($print " ---\n") + (local.set $end (global.get $mem_unused_start))) + (else + (local.set $idx $start) + ;;; while (idx < end) + (block $loopvals_exit + (loop $loopvals + (br_if $loopvals_exit (i32.ge_s $idx $end)) + (local.set $idx ($PR_MEMORY_VALUE $idx)) + (br $loopvals) + ) + ))) + ($PR_STRINGS $string_start) + ($PR_MEMORY_SUMMARY_SMALL) + ) + + (func $PR_MEMORY_RAW (param $start i32 $end i32) + (block $loop_exit + (loop $loop + (br_if $loop_exit (i32.ge_u $start $end)) + ($printf_2 "0x%x 0x%x\n" $start (i32.load $start)) + (local.set $start (i32.add 4 $start)) + (br $loop) + ) + ) + ) +) diff --git a/impls/wasm/env.wam b/impls/wasm/env.wam new file mode 100644 index 0000000000..aa7eef75d8 --- /dev/null +++ b/impls/wasm/env.wam @@ -0,0 +1,84 @@ +(module $env + + (func $ENV_NEW (param $outer i32) (result i32) + (LET $data ($HASHMAP) ;; allocate the data hashmap + $env ($ALLOC (global.get $ENVIRONMENT_T) $data $outer 0)) + ;; environment takes ownership + ($RELEASE $data) + $env + ) + + (func $ENV_NEW_BINDS (param $outer i32 $binds i32 $exprs i32) (result i32) + (LET $env ($ENV_NEW $outer) + $key 0) + + ;; process bindings + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $binds))) + + ;; get/deref the key from binds + (local.set $key ($MEM_VAL1_ptr $binds)) + (if (i32.eqz ($strcmp "&" ($to_String $key))) + (then + ;; ENV_NEW_BIND_VARGS + ;; get/deref the key from the next element of binds + (local.set $binds ($MEM_VAL0_ptr $binds)) + (local.set $key ($MEM_VAL1_ptr $binds)) + ;; the value is the remaining list in exprs + (local.set $exprs ($FORCE_SEQ_TYPE (global.get $LIST_T) $exprs)) + ;; set the binding in the environment data + (drop ($ENV_SET $env $key $exprs)) + ;; list is owned by the environment + ($RELEASE $exprs) + (br $done)) + (else + ;; ENV_NEW_BIND_1x1 + ;; set the binding in the environment data + (drop ($ENV_SET $env $key ($MEM_VAL1_ptr $exprs))) + ;; go to next element of binds and exprs + (local.set $binds ($MEM_VAL0_ptr $binds)) + (local.set $exprs ($MEM_VAL0_ptr $exprs)))) + + (br $loop) + ) + ) + $env + ) + + (func $ENV_SET (param $env i32 $key i32 $value i32) (result i32) + (LET $data ($MEM_VAL0_ptr $env)) + (i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1 $data $key $value))) + $value + ) + + (func $ENV_SET_S (param $env i32 $key i32 $value i32) (result i32) + (LET $data ($MEM_VAL0_ptr $env)) + (i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1_S $data $key $value))) + $value + ) + + (func $ENV_GET (param $env i32 $key i32) (result i32) + ;; Return 0 when the key is not found, but do not set THROW_STR. + + (local $found_res i64) + (LET $res 0 + $data 0) + + (loop $loop + (local.set $data ($MEM_VAL0_ptr $env)) + (local.set $found_res ($HASHMAP_GET $data $key)) + ;;; if (found) + (if (i32.wrap_i64 (i64.shr_u $found_res (i64.const 32))) + (then + (local.set $res (i32.wrap_i64 $found_res)) + (return ($INC_REF $res)))) + (local.set $env ($MEM_VAL1_ptr $env)) + (if (i32.eq $env (global.get $NIL)) + (then + (return 0))) + (br $loop) + ) + ) + +) diff --git a/impls/wasm/mem.wam b/impls/wasm/mem.wam new file mode 100644 index 0000000000..0eda0175ad --- /dev/null +++ b/impls/wasm/mem.wam @@ -0,0 +1,465 @@ +(module $mem + (global $MEM_SIZE i32 1048576) + (global $STRING_MEM_SIZE i32 1048576) + + (global $heap_start (mut i32) 0) + (global $heap_end (mut i32) 0) + + (global $mem (mut i32) 0) + (global $mem_unused_start (mut i32) 0) + (global $mem_free_list (mut i32) 0) + (global $mem_user_start (mut i32) 0) + + (global $string_mem (mut i32) 0) + (global $string_mem_next (mut i32) 0) + (global $string_mem_user_start (mut i32) 0) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; General type storage/pointer functions + + (func $VAL0_ptr (param $mv i32) (result i32) + (i32.add $mv 4)) + (func $VAL1_ptr (param $mv i32) (result i32) + (i32.add $mv 8)) + + (func $VAL0 (param $mv i32) (result i32) + (i32.load (i32.add $mv 4))) + (func $VAL1 (param $mv i32) (result i32) + (i32.load (i32.add $mv 8))) + + + (func $MEM_VAL0_ptr (param $mv i32) (result i32) + (i32.add (global.get $mem) + (i32.mul (i32.load (i32.add $mv 4)) 4))) + (func $MEM_VAL1_ptr (param $mv i32) (result i32) + (i32.add (global.get $mem) + (i32.mul (i32.load (i32.add $mv 8)) 4))) + (func $MEM_VAL2_ptr (param $mv i32) (result i32) + (i32.add (global.get $mem) + (i32.mul (i32.load (i32.add $mv 12)) 4))) + + ;; Returns the memory index mem of mv + ;; Will usually be used with a load or store by the caller + (func $IDX (param $mv i32) (result i32) + ;; MalVal memory 64 bit (2 * i32) aligned + (i32.div_u (i32.sub $mv (global.get $mem)) 4)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;; Returns the address of 'mem[mv_idx]' + (func $MalVal_ptr (param $mv_idx i32) (result i32) + ;; MalVal memory 64 bit (2 * i32) aligned + ;;; mem[mv_idx].refcnt_type + (i32.add (global.get $mem) (i32.mul $mv_idx 4))) + + ;; Returns the address of 'mem[mv_idx].refcnt_type' + (func $MalVal_refcnt_type (param $mv_idx i32) (result i32) + (i32.load ($MalVal_ptr $mv_idx))) + + (func $TYPE (param $mv i32) (result i32) + ;;; type = mv->refcnt_type & 31 + (i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31 + + (func $SET_TYPE (param $mv i32 $type i32) + ;;; type = mv->refcnt_type & 31 + ;;; mv->refcnt_type += - (mv->refcnt_type & 31) + type + (i32.store $mv (i32.or + (i32.and $type 0x1f) ;; 0x1f == 31 + (i32.and (i32.load $mv) 0xffffffe1))) + ) + + + (func $REFS (param $mv i32) (result i32) + ;;; type = mv->refcnt_type & 31 + (i32.shr_u (i32.load $mv) 5)) ;; / 32 + + ;; Returns the address of 'mem[mv_idx].val[val]' + ;; Will usually be used with a load or store by the caller + (func $MalVal_val_ptr (param $mv_idx i32 $val i32) (result i32) + (i32.add (i32.add ($MalVal_ptr $mv_idx) 4) + (i32.mul $val 4))) + + ;; Returns the value of 'mem[mv_idx].val[val]' + (func $MalVal_val (param $mv_idx i32 $val i32) (result i32) + (i32.load ($MalVal_val_ptr $mv_idx $val))) + + (func $MalType_size (param $type i32) (result i32) + ;;; if (type <= 5 || type == 9 || type == 12) + (if (result i32) (OR (i32.le_u $type 5) + (i32.eq $type 9) + (i32.eq $type 12)) + (then 2) + (else + ;;; else if (type == 8 || type == 10 || type == 11) + (if (result i32) (OR (i32.eq $type 8) + (i32.eq $type 10) + (i32.eq $type 11)) + (then 4) + (else 3))))) + + (func $MalVal_size (param $mv i32) (result i32) + (LET $type ($TYPE $mv)) + ;; if (type == FREE_T) + (if (result i32) (i32.eq $type (global.get $FREE_T)) + (then + ;;; return (mv->refcnt_type & 0xffe0)>>5 + (i32.shr_u (i32.and (i32.load $mv) 0xffe0) 5)) ;;; / 32 + (else + ;;; return MalType_size(type) + ($MalType_size $type)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; init_memory + + (func $init_memory + (LET $heap_size 0) + +;; ($print ">>> init_memory\n") + + ($init_printf_mem) + + ;; error_str string buffer + (global.set $error_str (STATIC_ARRAY 100)) + ;; reader token string buffer + (global.set $token_buf (STATIC_ARRAY 256)) + ;; printer string buffer + (global.set $printer_buf (STATIC_ARRAY 4096)) + + (local.set $heap_size (i32.add (global.get $MEM_SIZE) + (global.get $STRING_MEM_SIZE))) + (global.set $heap_start (i32.add (global.get $memoryBase) + (global.get $S_STRING_END))) + (global.set $heap_end (i32.add (global.get $heap_start) + $heap_size)) + + (global.set $mem (global.get $heap_start)) + (global.set $mem_unused_start 0) + (global.set $mem_free_list 0) + + (global.set $string_mem (i32.add (global.get $heap_start) + (global.get $MEM_SIZE))) + (global.set $string_mem_next (global.get $string_mem)) + + (global.set $mem_user_start (global.get $mem_unused_start)) + (global.set $string_mem_user_start (global.get $string_mem_next)) + + ;; Empty values + (global.set $NIL + ($ALLOC_SCALAR (global.get $NIL_T) 0)) + (global.set $FALSE + ($ALLOC_SCALAR (global.get $BOOLEAN_T) 0)) + (global.set $TRUE + ($ALLOC_SCALAR (global.get $BOOLEAN_T) 1)) + (global.set $EMPTY_LIST + ($ALLOC (global.get $LIST_T) + (global.get $NIL) (global.get $NIL) (global.get $NIL))) + (global.set $EMPTY_VECTOR + ($ALLOC (global.get $VECTOR_T) + (global.get $NIL) (global.get $NIL) (global.get $NIL))) + (global.set $EMPTY_HASHMAP + ($ALLOC (global.get $HASHMAP_T) + (global.get $NIL) (global.get $NIL) (global.get $NIL))) + +;; ($print "<<< init_memory\n") + + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; memory management + + (func $ALLOC_INTERNAL (param $type i32 + $val1 i32 $val2 i32 $val3 i32) (result i32) + (LET $prev (global.get $mem_free_list) + $res (global.get $mem_free_list) + $size ($MalType_size $type)) + + (block $loop_done + (loop $loop + ;; res == mem_unused_start + (if (i32.eq $res (global.get $mem_unused_start)) + (then + ;; ALLOC_UNUSED + ;;; if (res + size > MEM_SIZE) + (if (i32.gt_u (i32.add $res $size) (global.get $MEM_SIZE)) + ;; Out of memory, exit + ($fatal 7 "Out of mal memory!\n")) + ;;; if (mem_unused_start += size) + (global.set $mem_unused_start + (i32.add (global.get $mem_unused_start) $size)) + ;;; if (prev == res) + (if (i32.eq $prev $res) + (then + (global.set $mem_free_list (global.get $mem_unused_start))) + (else + ;;; mem[prev].val[0] = mem_unused_start + (i32.store + ($MalVal_val_ptr $prev 0) + (global.get $mem_unused_start)))) + (br $loop_done))) + ;; if (MalVal_size(mem+res) == size) + (if (i32.eq ($MalVal_size ($MalVal_ptr $res)) + $size) + (then + ;; ALLOC_MIDDLE + ;;; if (res == mem_free_list) + (if (i32.eq $res (global.get $mem_free_list)) + ;; set free pointer (mem_free_list) to next free + ;;; mem_free_list = mem[res].val[0]; + (global.set $mem_free_list ($MalVal_val $res 0))) + ;; if (res != mem_free_list) + (if (i32.ne $res (global.get $mem_free_list)) + ;; set previous free to next free + ;;; mem[prev].val[0] = mem[res].val[0] + (i32.store ($MalVal_val_ptr $prev 0) ($MalVal_val $res 0))) + (br $loop_done))) + ;;; prev = res + (local.set $prev $res) + ;;; res = mem[res].val[0] + (local.set $res ($MalVal_val $res 0)) + (br $loop) + ) + ) + ;; ALLOC_DONE + ;;; mem[res].refcnt_type = type + 32 + (i32.store ($MalVal_ptr $res) (i32.add $type 32)) + ;; set val to default val1 + ;;; mem[res].val[0] = val1 + (i32.store ($MalVal_val_ptr $res 0) $val1) + ;;; if (type > 5 && type != 9) + (if (AND (i32.gt_u $type 5) + (i32.ne $type 9)) + (then + ;; inc refcnt of referenced value + ;;; mem[val1].refcnt_type += 32 + (i32.store ($MalVal_ptr $val1) + (i32.add ($MalVal_refcnt_type $val1) 32)))) + ;;; if (size > 2) + (if (i32.gt_u $size 2) + (then + ;; inc refcnt of referenced value + ;;; mem[val2].refcnt_type += 32 + (i32.store ($MalVal_ptr $val2) + (i32.add ($MalVal_refcnt_type $val2) 32)) + ;;; mem[res].val[1] = val2 + (i32.store ($MalVal_val_ptr $res 1) $val2))) + ;;; if (size > 3) + (if (i32.gt_u $size 3) + (then + ;; inc refcnt of referenced value + ;;; mem[val3].refcnt_type += 32 + (i32.store ($MalVal_ptr $val3) + (i32.add ($MalVal_refcnt_type $val3) 32)) + ;;; mem[res].val[2] = val3 + (i32.store ($MalVal_val_ptr $res 2) $val3))) + + ;;; return mem + res + ($MalVal_ptr $res) + ) + + (func $ALLOC_SCALAR (param $type i32 $val1 i32) (result i32) + ($ALLOC_INTERNAL $type $val1 0 0) + ) + + (func $ALLOC (param $type i32 $val1 i32 $val2 i32 $val3 i32) (result i32) + ($ALLOC_INTERNAL $type ($IDX $val1) ($IDX $val2) ($IDX $val3)) + ) + + (func $RELEASE (param $mv i32) + (LET $idx 0 $type 0 $size 0) + + ;; Ignore NULLs + ;;; if (mv == NULL) { return; } + (if (i32.eqz $mv) (return)) + ;;; idx = mv - mem + (local.set $idx ($IDX $mv)) + ;;; type = mv->refcnt_type & 31 + (local.set $type (i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31 + ;;; size = MalType_size(type) + (local.set $size ($MalType_size $type)) + + ;; DEBUG + ;;; printf(">>> RELEASE idx: %d, type: %d, size: %d\n", idx, type, size) + + (if (i32.eq 0 $mv) + ($fatal 7 "RELEASE of NULL!\n")) + + (if (i32.eq (global.get $FREE_T) $type) + (then + ($printf_2 "RELEASE of already free mv: 0x%x, idx: 0x%x\n" $mv $idx) + ($fatal 1 ""))) + (if (i32.lt_u ($MalVal_refcnt_type $idx) 15) + (then + ($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx) + ($fatal 1 ""))) + + ;; decrease reference count by one + (i32.store ($MalVal_ptr $idx) + (i32.sub ($MalVal_refcnt_type $idx) 32)) + + ;; nil, false, true, empty sequences + (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) + (then + (if (i32.lt_u ($MalVal_refcnt_type $idx) 32) + (then + ($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx) + ($fatal 1 ""))) + (return))) + + ;; our reference count is not 0, so don't release + (if (i32.ge_u ($MalVal_refcnt_type $idx) 32) + (return)) + + (block $done + (block (block (block (block (block (block (block (block (block + (br_table 0 0 0 0 1 1 2 2 3 0 4 4 5 6 7 8 8 $type)) + ;; nil, boolean, integer, float + (br $done)) + ;; string, kw, symbol + ;; release string, then FREE reference + ($RELEASE_STRING (i32.add (global.get $string_mem) ($VAL0 $mv))) + (br $done)) + ;; list, vector + (if (i32.ne ($MalVal_val $idx 0) 0) + (then + ;; release next element and value + ($RELEASE ($MEM_VAL0_ptr $mv)) + ($RELEASE ($MEM_VAL1_ptr $mv)))) + (br $done)) + ;; hashmap + (if (i32.ne ($MalVal_val $idx 0) 0) + (then + ;; release next element, value, and key + ($RELEASE ($MEM_VAL0_ptr $mv)) + ($RELEASE ($MEM_VAL2_ptr $mv)) + ($RELEASE ($MEM_VAL1_ptr $mv)))) + (br $done)) + ;; mal / macro function + ;; release ast, params, and environment + ($RELEASE ($MEM_VAL2_ptr $mv)) + ($RELEASE ($MEM_VAL1_ptr $mv)) + ($RELEASE ($MEM_VAL0_ptr $mv)) + (br $done)) + ;; atom + ;; release contained/referred value + ($RELEASE ($MEM_VAL0_ptr $mv)) + (br $done)) + ;; env + ;; if outer is set then release outer + (if (i32.ne ($MalVal_val $idx 1) 0) + ($RELEASE ($MEM_VAL1_ptr $mv))) + ;; release the env data (hashmap) + ($RELEASE ($MEM_VAL0_ptr $mv)) + (br $done)) + ;; metadata + ;; release object and metdata object + ($RELEASE ($MEM_VAL0_ptr $mv)) + ($RELEASE ($MEM_VAL1_ptr $mv)) + (br $done)) + ;; default/unknown + ) + + ;; FREE, free the current element + + ;; set type(FREE/15) and size + ;;; mv->refcnt_type = size*32 + FREE_T + (i32.store $mv (i32.add (i32.mul $size 32) (global.get $FREE_T))) + (i32.store ($MalVal_val_ptr $idx 0) (global.get $mem_free_list)) + (global.set $mem_free_list $idx) + (if (i32.ge_u $size 3) (i32.store ($MalVal_val_ptr $idx 1) 0)) + (if (i32.eq $size 4) (i32.store ($MalVal_val_ptr $idx 2) 0)) + ) + + ;; find string in string memory or 0 if not found + (func $FIND_STRING (param $str i32) (result i32) + (LET $ms (global.get $string_mem)) + (block $done + (loop $loop + (br_if $done (i32.ge_s $ms (global.get $string_mem_next))) + (if (i32.eqz ($strcmp $str (i32.add $ms 4))) + (return $ms)) + + (local.set $ms (i32.add $ms (i32.load16_u (i32.add $ms 2)))) + (br $loop) + ) + ) + 0 + ) + + ;; str is a NULL terminated string + ;; size is number of characters in the string not including the + ;; trailing NULL + (func $ALLOC_STRING (param $str i32 $size i32 $intern i32) (result i32) + (LET $ms 0) + + ;; search for matching string in string_mem + (if $intern + (then + (local.set $ms ($FIND_STRING $str)) + (if $ms + (then + ;;; ms->refcnt += 1 + (i32.store16 $ms (i32.add (i32.load16_u $ms) 1)) + (return $ms))))) + + ;; no existing matching string so create a new one + (local.set $ms (global.get $string_mem_next)) + (i32.store16 $ms 1) + ;;; ms->size = sizeof(MalString)+size+1 + (i32.store16 offset=2 $ms (i32.add (i32.add 4 $size) 1)) + ($memmove (i32.add $ms 4) $str (i32.add $size 1)) + ;;; string_mem_next = (void *)ms + ms->size + (global.set $string_mem_next + ;;(i32.add $ms (i32.load16_u (i32.add $ms 2)))) + (i32.add $ms (i32.load16_u offset=2 $ms))) + +;;($printf_2 "ALLOC_STRING 6 ms 0x%x, refs: %d\n" $ms (i32.load16_u $ms)) + $ms + ) + + (func $RELEASE_STRING (param $ms i32) + (LET $size 0 $next 0 $ms_idx 0 $idx 0 $type 0 $mv 0) + + (if (i32.le_s (i32.load16_u $ms) 0) + (then + ($printf_2 "Release of already free string: %d (0x%x)\n" + (i32.sub $ms (global.get $string_mem)) $ms) + ($fatal 1 ""))) + + ;;; size = ms->size + (local.set $size (i32.load16_u (i32.add $ms 2))) + ;;; *next = (void *)ms + size + (local.set $next (i32.add $ms $size)) + + ;;; ms->refcnt -= 1 + (i32.store16 $ms (i32.sub (i32.load16_u $ms) 1)) + + (if (i32.eqz (i32.load16_u $ms)) + (then + (if (i32.gt_s (global.get $string_mem_next) $next) + (then + ;; If no more references to this string then free it up by + ;; shifting up every string afterwards to fill the gap + ;; (splice). + ($memmove $ms $next (i32.sub (global.get $string_mem_next) + $next)) + + ;; Scan the mem values for string types after the freed + ;; string and shift their indexes by size + (local.set $ms_idx (i32.sub $ms (global.get $string_mem))) + (local.set $idx ($IDX (global.get $EMPTY_HASHMAP))) + (loop $loop + (local.set $mv ($MalVal_ptr $idx)) + (local.set $type ($TYPE $mv)) + (if (AND (i32.gt_s ($VAL0 $mv) $ms_idx) + (OR (i32.eq $type (global.get $STRING_T)) + (i32.eq $type (global.get $SYMBOL_T)))) + (i32.store ($VAL0_ptr $mv) (i32.sub ($VAL0 $mv) $size))) + (local.set $idx (i32.add $idx ($MalVal_size $mv))) + + (br_if $loop (i32.lt_s $idx (global.get $mem_unused_start))) + ))) + + (global.set $string_mem_next + (i32.sub (global.get $string_mem_next) $size)))) + ) +) diff --git a/impls/wasm/node_readline.js b/impls/wasm/node_readline.js new file mode 100644 index 0000000000..6042eaa0af --- /dev/null +++ b/impls/wasm/node_readline.js @@ -0,0 +1,46 @@ +// IMPORTANT: choose one +var RL_LIB = "libreadline"; // NOTE: libreadline is GPL +//var RL_LIB = "libedit"; + +var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); + +var rlwrap = {}; // namespace for this module in web context + +var ffi = require('ffi-napi'), + fs = require('fs'); + +var rllib = ffi.Library(RL_LIB, { + 'readline': [ 'string', [ 'string' ] ], + 'add_history': [ 'int', [ 'string' ] ]}); + +var rl_history_loaded = false; + +exports.readline = rlwrap.readline = function(prompt) { + prompt = typeof prompt !== 'undefined' ? prompt : "user> "; + + if (!rl_history_loaded) { + rl_history_loaded = true; + var lines = []; + if (fs.existsSync(HISTORY_FILE)) { + lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); + } + // Max of 2000 lines + lines = lines.slice(Math.max(lines.length - 2000, 0)); + for (var i=0; i n 0) (+ n (abcdefg (- n 1))) 0))) + (if (i32.eq (CHR "\n") + (i32.load8_u (i32.add $buf (i32.sub (i32.load $nread_ptr) 1)) 0)) + (i32.store8 (i32.add $buf (i32.sub (i32.load $nread_ptr) 1)) 0)) + 1 + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (func $read_file (param $path i32 $buf i32) (result i32) + (LET $orig_path $path + $ret 0 + $prestat_ptr (STATIC_ARRAY 8 4) + $pr_type 0 + $pr_name_len 0 + $prepath (STATIC_ARRAY 1024) + $dirfd -1 + $fd 3 + $fd_ptr (STATIC_ARRAY 4 4) + $nread_ptr (STATIC_ARRAY 4 4) + $iovec (STATIC_ARRAY 8 8)) + + ;; Find the pre-opened dir fd with the same prefix as the our path + ;; following the algorithm at: + ;; https://github.com/CraneStation/wasi-sysroot/blob/1cc98f27f5ab8afdc033e16eac8799ee606eb769/libc-bottom-half/crt/crt1.c#L71 + ;; The matching dir fd is then used to open and read the path. + (block $loop_done + (loop $loop + ;; prestat the fd from 3 onward until EBADF is returned + (local.set $ret ($fd_prestat_get $fd $prestat_ptr)) + (if (i32.eq (global.get $WASI_EBADF) $ret) + (br $loop_done)) + (if (i32.ne (global.get $WASI_ESUCCESS) $ret) + (then + (local.set $fd (i32.add 1 $fd)) + (br $loop))) + ;;(br $loop_done)) + (local.set $pr_type (i32.load $prestat_ptr)) + (local.set $pr_name_len (i32.load offset=4 $prestat_ptr)) + ;; Read the pre-opened path name + (local.set $ret ($fd_prestat_dir_name $fd $prepath $pr_name_len)) + (if (i32.ne (global.get $WASI_ESUCCESS) $ret) + (br $loop_done)) + ;; if pr_name_len includes a null, exclude it from the compare + ;;($printf_2 "here1 pr_name_len: %d, char is %d\n" $pr_name_len (i32.load8_u (i32.add $prepath (i32.sub $pr_name_len 1)))) + (if (i32.eqz (i32.load8_u (i32.add $prepath (i32.sub $pr_name_len 1)))) + (then + (local.set $pr_name_len (i32.sub $pr_name_len 1)))) + ;; if it is a dir and the path prefix matches, use it + ;;($printf_5 "fd: %d, ret: %d, pr_type: %d, pr_name_len: %d, prepath: %s\n" + ;; $fd $ret $pr_type $pr_name_len $prepath) + (if (AND (i32.eq $pr_type (global.get $WASI_PREOPENTYPE_DIR)) + (i32.eqz ($strncmp $prepath $path $pr_name_len))) + (then + (local.set $path (i32.add $pr_name_len $path)) + (local.set $dirfd $fd) + (br $loop_done))) + (local.set $fd (i32.add 1 $fd)) + (br $loop) + ) + ) + + ;;($printf_3 "final dirfd: %d, adjusted path: %s (%d)\n" $dirfd $path ($strlen $path)) + + (if (i32.eq $dirfd -1) + (then + ($printf_1 "ERROR: could not find permission for '%s'\n" $orig_path) + (return 0))) + + (local.set $ret ($path_open $dirfd + 1 ;; dirflags (symlink follow) + $path + ($strlen $path) + 0 ;; o_flags + (global.get $WASI_RIGHT_FD_READ) + (global.get $WASI_RIGHT_FD_READ) + 0 ;; fs_flags + $fd_ptr)) + (if (i32.ne (global.get $WASI_ESUCCESS) $ret) + (then + ($printf_2 "ERROR: failed to open '%s', error %d\n" $orig_path $ret) + (return 0))) + + (i32.store $iovec $buf) + ;; TODO: use stat result instead of not hardcoded length + (i32.store offset=4 $iovec 16384) + (local.set $ret ($fd_read (i32.load $fd_ptr) $iovec 1 $nread_ptr)) + (if (i32.ne (global.get $WASI_ESUCCESS) $ret) + (then + ($printf_2 "ERROR: failed to read '%s', error %d\n" $orig_path $ret) + (return 0))) + + ;; Add null to string + (i32.store8 (i32.add $buf (i32.load $nread_ptr)) 0) + (i32.add 1 (i32.load $nread_ptr)) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (func $get_time_ms (result i32) + (LET $tv (STATIC_ARRAY 8 8)) + (drop (call $clock_time_get 0 (i64.const 0) $tv)) + (i32.wrap_i64 + ;; convert nanoseconds to milliseconds + (i64.div_u (i64.load $tv) (i64.const 1000000))) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;; Returns an i64 with argc in high 32 and argv in low 32. + ;; String memory is: argv + (argc * 4) + (func $get_argc_argv (result i64) + (LET $argc_ptr (STATIC_ARRAY 4 4) + $argv_size_ptr (STATIC_ARRAY 4 4) + $argc 0 + $argv (STATIC_ARRAY 1024 4)) + (drop ($args_sizes_get $argc_ptr $argv_size_ptr)) + (local.set $argc (i32.load $argc_ptr)) + (if (i32.gt_u (i32.add (i32.mul 4 $argc) + (i32.load $argv_size_ptr)) + 1024) + ($fatal 2 "Command line arguments memory exceeds 1024 bytes")) + (drop ($args_get $argv (i32.add $argv (i32.mul 4 $argc)))) + (i64.or (i64.shl (i64.extend_i32_u $argc) (i64.const 32)) + (i64.extend_i32_u $argv)) + ) + + (func $entry + (local $argc_argv i64) + ($init_memory) + (local.set $argc_argv ($get_argc_argv)) + ($proc_exit + ($main (i32.wrap_i64 (i64.shr_u $argc_argv (i64.const 32))) + (i32.wrap_i64 $argc_argv))) + ) + ;;(start $entry) + + (export "_start" (func $entry)) + +) diff --git a/impls/wasm/printer.wam b/impls/wasm/printer.wam new file mode 100644 index 0000000000..65708e13b9 --- /dev/null +++ b/impls/wasm/printer.wam @@ -0,0 +1,182 @@ +(module $printer + + (global $printer_buf (mut i32) 0) + + (func $pr_str_val (param $res i32 $mv i32 $print_readably i32) (result i32) + (LET $type ($TYPE $mv) + $val0 ($VAL0 $mv) + $sval 0) + + ;;; switch(type) + (block $done + (block $default + (block (block (block (block (block (block (block (block + (block (block (block (block (block (block (block (block + (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 $type)) + ;; 0: nil + ($memmove $res "nil" 4) + (local.set $res (i32.add 3 $res)) + (br $done)) + ;; 1: boolean + (if (i32.eq $val0 0) + (then + ;; false + ($memmove $res "false" 6) + (local.set $res (i32.add 5 $res))) + (else + ;; true + ($memmove $res "true" 5) + (local.set $res (i32.add 4 $res)))) + (br $done)) + ;; 2: integer + (local.set $res ($sprintf_1 $res "%d" $val0)) + (br $done)) + ;; 3: float/ERROR + (local.set $res ($sprintf_1 $res "%d" " *** GOT FLOAT *** ")) + (br $done)) + ;; 4: string/kw + (local.set $sval ($to_String $mv)) + (if (i32.eq (i32.load8_u $sval) (CHR "\x7f")) + (then + (local.set $res ($sprintf_1 $res ":%s" (i32.add $sval 1)))) + (else (if $print_readably + (then + ;; escape backslashes, quotes, and newlines + (local.set $res ($sprintf_1 $res "\"" 0)) + (local.set $res (i32.add $res ($REPLACE3 $res ($to_String $mv) + "\\" "\\\\" + "\"" "\\\"" + "\n" "\\n"))) + (local.set $res ($sprintf_1 $res "\"" 0))) + (else + (local.set $res ($sprintf_1 $res "%s" $sval)))))) + (br $done)) + ;; 5: symbol + (local.set $res ($sprintf_1 $res "%s" ($to_String $mv))) + (br $done)) + ;; 6: list, fallthrouogh + ) + ;; 7: vector, fallthrough + ) + ;; 8: hashmap + (local.set + $res ($sprintf_1 $res "%c" + (if (result i32) (i32.eq $type (global.get $LIST_T)) + (then (CHR "(")) + (else (if (result i32) (i32.eq $type (global.get $VECTOR_T)) + (then (CHR "[")) + (else (CHR "{"))))))) + ;; PR_SEQ_LOOP + ;;; while (VAL0(mv) != 0) + (block $done_seq + (loop $seq_loop + (br_if $done_seq (i32.eq ($VAL0 $mv) 0)) + ;;; res = pr_str_val(res, MEM_VAL1(mv), print_readably) + (local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably)) + + ;; if this is a hash-map, print the next element + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + ;;; res += snprintf(res, 2, " ") + (local.set $res ($sprintf_1 $res " " 0)) + (local.set $res ($pr_str_val $res ($MEM_VAL2_ptr $mv) + $print_readably)))) + ;;; mv = MEM_VAL0(mv) + (local.set $mv ($MEM_VAL0_ptr $mv)) + ;;; if (VAL0(mv) != 0) + (if (i32.ne ($VAL0 $mv) 0) + ;;; res += snprintf(res, 2, " ") + (local.set $res ($sprintf_1 $res " " 0))) + (br $seq_loop) + ) + ) + + (local.set + $res ($sprintf_1 $res "%c" + (if (result i32) (i32.eq $type (global.get $LIST_T)) + (then (CHR ")")) + (else (if (result i32) (i32.eq $type (global.get $VECTOR_T)) + (then (CHR "]")) + (else (CHR "}"))))))) + (br $done)) + ;; 9: function + ($memmove $res "#" 10) + (local.set $res (i32.add 9 $res)) + (br $done)) + ;; 10: mal function + ($memmove $res "(fn* " 6) + (local.set $res (i32.add 5 $res)) + (local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably)) + ($memmove $res " " 2) + (local.set $res (i32.add 1 $res)) + (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably)) + ($memmove $res ")" 2) + (local.set $res (i32.add 1 $res)) + (br $done)) + ;; 11: macro fn + ($memmove $res "#" 13) + (local.set $res (i32.add 12 $res)) + (br $done)) + ;; 12: atom + ($memmove $res "(atom " 7) + (local.set $res (i32.add 6 $res)) + (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably)) + ($memmove $res ")" 2) + (local.set $res (i32.add 1 $res)) + (br $done)) + ;; 13: environment + ($memmove $res "#" 11) + (local.set $res (i32.add 10 $res)) + (br $done)) + ;; 14: metadata + ;; recur on object itself + (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably)) + (br $done)) + ;; 15: FREE + ($memmove $res "#" 12) + (local.set $res (i32.add 11 $res)) + (br $done)) + ;; 16: default + ($memmove $res "#" 11) + (local.set $res (i32.add 10 $res)) + ) + + $res + ) + + (func $pr_str_internal (param $seq i32) (param $mv i32) + (param $print_readably i32) (param $sep i32) (result i32) + (LET $res ($STRING_INIT (global.get $STRING_T)) + $res_str ($to_String $res)) + + (if $seq + (then + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $mv))) + (local.set $res_str ($pr_str_val $res_str ($MEM_VAL1_ptr $mv) $print_readably)) + (local.set $mv ($MEM_VAL0_ptr $mv)) + (if (i32.ne ($VAL0 $mv) 0) + (local.set $res_str ($sprintf_1 $res_str "%s" $sep))) + (br $loop) + ) + )) + (else + (local.set $res_str ($pr_str_val $res_str $mv $print_readably)))) + + (local.set $res ($STRING_FINALIZE $res (i32.sub $res_str ($to_String $res)))) + + $res + ) + + (func $pr_str (param $mv i32 $print_readably i32) (result i32) + ($pr_str_internal 0 $mv $print_readably "") + ) + + (func $pr_str_seq (param $mv i32 $print_readably i32 $sep i32) (result i32) + ($pr_str_internal 1 $mv $print_readably $sep) + ) + + (export "pr_str" (func $pr_str)) + +) diff --git a/impls/wasm/printf.wam b/impls/wasm/printf.wam new file mode 100644 index 0000000000..7c5d730d0d --- /dev/null +++ b/impls/wasm/printf.wam @@ -0,0 +1,226 @@ +(module $printf + + (global $printf_buf (mut i32) 0) + + (func $init_printf_mem + ;; sprintf static buffer + (global.set $printf_buf (STATIC_ARRAY 256)) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (func $printf_1 (param $fmt i32) (param $v0 i32) + (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 0 0 0 0 0)) + ($print (global.get $printf_buf)) + ) + + (func $printf_2 (param $fmt i32 $v0 i32 $v1 i32) + (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 0 0 0 0)) + ($print (global.get $printf_buf)) + ) + + (func $printf_3 (param $fmt i32) + (param $v0 i32) (param $v1 i32) (param $v2 i32) + (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 0 0 0)) + ($print (global.get $printf_buf)) + ) + + (func $printf_4 (param $fmt i32) + (param $v0 i32) (param $v1 i32) (param $v2 i32) + (param $v3 i32) + (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 $v3 0 0)) + ($print (global.get $printf_buf)) + ) + + (func $printf_5 (param $fmt i32) + (param $v0 i32) (param $v1 i32) (param $v2 i32) + (param $v3 i32) (param $v4 i32) + (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 $v3 $v4 0)) + ($print (global.get $printf_buf)) + ) + + (func $printf_6 (param $fmt i32) + (param $v0 i32) (param $v1 i32) (param $v2 i32) + (param $v3 i32) (param $v4 i32) (param $v5 i32) + (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 $v3 $v4 $v5)) + ($print (global.get $printf_buf)) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (func $_sprintdigit (param $str i32) (param $num i32) (param $base i32) + (LET $n (i32.rem_u $num $base) + $ch (if (result i32) (i32.lt_u $n 10) 48 55)) + (i32.store8 $str (i32.add $n $ch)) + ) + + ;; TODO: add max buf length (i.e. snprintnum) + (func $_sprintnum (param $buf i32) (param $val i32) (param $radix i32) + (param $pad_cnt i32) (param $pad_char i32) (result i32) + (LET $pbuf $buf + $neg 0 $i 0 $j 0 $k 0 $len 0 $digit 0) + + (if (AND (i32.lt_s $val 0) (i32.eq $radix 10)) + (then + (local.set $neg 1) + (local.set $val (i32.sub 0 $val)))) + + ;; Calculate smallest to most significant digit + (loop $loop + (local.set $digit (i32.rem_u $val $radix)) + (i32.store8 $pbuf (if (result i32) (i32.lt_u $digit 10) + (i32.add (CHR "0") $digit) + (i32.sub (i32.add (CHR "A") $digit) 10))) + (local.set $pbuf (i32.add $pbuf 1)) + (local.set $val (i32.div_u $val $radix)) + (br_if $loop (i32.gt_u $val 0)) + ) + + (local.set $i (i32.sub $pbuf $buf)) + (block $done + (loop $loop + (br_if $done (i32.ge_u $i $pad_cnt)) + (i32.store8 $pbuf $pad_char) + (local.set $pbuf (i32.add $pbuf 1)) + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + + (if $neg + (then + (i32.store8 $pbuf (CHR "-")) + (local.set $pbuf (i32.add $pbuf 1)))) + + (i32.store8 $pbuf (CHR "\x00")) + + ;; now reverse it + (local.set $len (i32.sub $pbuf $buf)) + (local.set $i 0) + (block $done + (loop $loop + (br_if $done (i32.ge_u $i (i32.div_u $len 2))) + + (local.set $j (i32.load8_u (i32.add $buf $i))) + (local.set $k (i32.add $buf (i32.sub (i32.sub $len $i) 1))) + (i32.store8 (i32.add $buf $i) (i32.load8_u $k)) + (i32.store8 $k $j) + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + + (i32.add $buf $len) + ) + + ;; TODO: switch to snprint* (add buffer len) + (func $sprintf_1 (param $str i32) (param $fmt i32) + (param $v0 i32) (result i32) + ($sprintf_6 $str $fmt $v0 0 0 0 0 0) + ) + + (func $sprintf_6 (param $str i32) (param $fmt i32) + (param $v0 i32) (param $v1 i32) (param $v2 i32) + (param $v3 i32) (param $v4 i32) (param $v5 i32) + (result i32) + (LET $pstr $str + $vidx 0 $ch 0 $v 0 $len 0 $pad_cnt 0 $pad_char 0) + + (block $done + (loop $loop + (block $after_v + ;; set $v to the current parameter + (block (block (block (block (block (block + (br_table 0 1 2 3 4 5 0 $vidx)) + (; 0 ;) (local.set $v $v0) (br $after_v)) + (; 1 ;) (local.set $v $v1) (br $after_v)) + (; 2 ;) (local.set $v $v2) (br $after_v)) + (; 3 ;) (local.set $v $v3) (br $after_v)) + (; 4 ;) (local.set $v $v4) (br $after_v)) + (; 5 ;) (local.set $v $v5) (br $after_v) + ) + + ;;; while ((ch=*(fmt++))) + (local.set $ch (i32.load8_u $fmt)) + (local.set $fmt (i32.add 1 $fmt)) + (br_if $done (i32.eqz $ch)) + ;; TODO: check buffer length + + (if (i32.ne $ch (CHR "%")) + (then + ;; TODO: check buffer length + (i32.store8 $pstr $ch) + (local.set $pstr (i32.add 1 $pstr)) + (br $loop))) + + ;;; ch=*(fmt++) + (local.set $ch (i32.load8_u $fmt)) + (local.set $fmt (i32.add 1 $fmt)) + (br_if $done (i32.eqz $ch)) + + (local.set $pad_cnt 0) + (local.set $pad_char (CHR " ")) + (if (AND (i32.ge_s $ch (CHR "0")) (i32.le_s $ch (CHR "9"))) + (then + ;; padding requested + (if (i32.eq $ch (CHR "0")) + (then + ;; zero padding requested + (local.set $pad_char (CHR "0")) + ;;; ch=*(fmt++) + (local.set $ch (i32.load8_u $fmt)) + (local.set $fmt (i32.add 1 $fmt)) + (br_if $done (i32.eqz $ch)))) + (loop $loop + (local.set $pad_cnt (i32.mul $pad_cnt 10)) + (local.set $pad_cnt (i32.add $pad_cnt + (i32.sub $ch (CHR "0")))) + (local.set $ch (i32.load8_u $fmt)) + (local.set $fmt (i32.add 1 $fmt)) + (br_if $loop (AND (i32.ge_s $ch (CHR "0")) + (i32.le_s $ch (CHR "9")))) + ))) + + (if (i32.eq (CHR "d") $ch) + (then + (local.set $pstr ($_sprintnum $pstr $v 10 $pad_cnt $pad_char))) + (else (if (i32.eq (CHR "x") $ch) + (then + (local.set $pstr ($_sprintnum $pstr $v 16 $pad_cnt $pad_char))) + (else (if (i32.eq (CHR "s") $ch) + (then + (local.set $len ($strlen $v)) + (block $done + (loop $loop + (br_if $done (i32.le_s $pad_cnt $len)) + (i32.store8 $pstr (CHR " ")) + (local.set $pstr (i32.add $pstr 1)) + (local.set $pad_cnt (i32.sub $pad_cnt 1)) + (br $loop) + ) + ) + ($memmove $pstr $v $len) + (local.set $pstr (i32.add $pstr $len))) + (else (if (i32.eq (CHR "c") $ch) + (then + (i32.store8 $pstr $v) + (local.set $pstr (i32.add $pstr 1))) + (else (if (i32.eq (CHR "%") $ch) + (then + (i32.store8 $pstr (CHR "%")) + (local.set $pstr (i32.add $pstr 1)) + (br $loop)) ;; don't increase vidx + (else + ($printf_1 "Illegal format character: '%c'\n" $ch) + ($fatal 3 ""))))))))))) + + (local.set $vidx (i32.add 1 $vidx)) + (br $loop) + ) + ) + + (i32.store8 $pstr (CHR "\x00")) + $pstr + ) + +) diff --git a/impls/wasm/reader.wam b/impls/wasm/reader.wam new file mode 100644 index 0000000000..ec2184cc7d --- /dev/null +++ b/impls/wasm/reader.wam @@ -0,0 +1,323 @@ +(module $reader + + ;; TODO: global warning + (global $token_buf (mut i32) 0) + (global $read_index (mut i32) 0) + + (func $skip_spaces (param $str i32) (result i32) + (LET $found 0 + $c (i32.load8_u (i32.add $str (global.get $read_index)))) + (block $done + (loop $loop + ;;; while (c == ' ' || c == ',' || c == '\n') + (br_if $done (AND (i32.ne $c (CHR " ")) + (i32.ne $c (CHR ",")) + (i32.ne $c (CHR "\n")))) + (local.set $found 1) + ;;; c=str[++(*index)] + (global.set $read_index (i32.add (global.get $read_index) 1)) + (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) + (br $loop) + ) + ) +;; ($debug ">>> skip_spaces:" $found) + $found + ) + + (func $skip_to_eol (param $str i32) (result i32) + (LET $found 0 + $c (i32.load8_u (i32.add $str (global.get $read_index)))) + (if (i32.eq $c (CHR ";")) + (then + (local.set $found 1) + (block $done + (loop $loop + ;;; c=str[++(*index)] + (global.set $read_index (i32.add (global.get $read_index) 1)) + (local.set $c (i32.load8_u (i32.add $str + (global.get $read_index)))) + ;;; while (c != '\0' && c != '\n') + (br_if $loop (AND (i32.ne $c (CHR "\x00")) + (i32.ne $c (CHR "\n")))) + ) + ))) +;; ($debug ">>> skip_to_eol:" $found) + $found + ) + + (func $skip_spaces_comments (param $str i32) + (loop $loop + ;; skip spaces + (br_if $loop ($skip_spaces $str)) + ;; skip comments + (br_if $loop ($skip_to_eol $str)) + ) + ) + + (func $read_token (param $str i32) (result i32) + (LET $token_index 0 + $isstring 0 + $instring 0 + $escaped 0 + $c 0) + + ($skip_spaces_comments $str) + + ;; read first character + ;;; c=str[++(*index)] + (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) + (global.set $read_index (i32.add (global.get $read_index) 1)) + ;; read first character + ;;; token[token_index++] = c + (i32.store8 (i32.add (global.get $token_buf) $token_index) $c) + (local.set $token_index (i32.add $token_index 1)) + ;; single/double character token + (if (OR (i32.eq $c (CHR "(")) + (i32.eq $c (CHR ")")) + (i32.eq $c (CHR "[")) + (i32.eq $c (CHR "]")) + (i32.eq $c (CHR "{")) + (i32.eq $c (CHR "}")) + (i32.eq $c (CHR "'")) + (i32.eq $c (CHR "`")) + (i32.eq $c (CHR "@")) + (AND (i32.eq $c (CHR "~")) + (i32.ne (i32.load8_u (i32.add $str (global.get $read_index))) + (CHR "@")))) + + (then + ;; continue + (nop)) + (else + ;;; if (c == '"') isstring = true + (local.set $isstring (i32.eq $c (CHR "\""))) + (local.set $instring $isstring) + (block $done + (loop $loop + ;; peek at next character + ;;; c = str[*index] + (local.set $c (i32.load8_u + (i32.add $str (global.get $read_index)))) + ;;; if (c == '\0') break + (br_if $done (i32.eq $c 0)) + ;;; if (!isstring) + (if (i32.eqz $isstring) + (then + ;; next character is token delimiter + (br_if $done (OR (i32.eq $c (CHR "(")) + (i32.eq $c (CHR ")")) + (i32.eq $c (CHR "[")) + (i32.eq $c (CHR "]")) + (i32.eq $c (CHR "{")) + (i32.eq $c (CHR "}")) + (i32.eq $c (CHR " ")) + (i32.eq $c (CHR ",")) + (i32.eq $c (CHR "\n")))))) + ;; read next character + ;;; token[token_index++] = str[(*index)++] + (i32.store8 (i32.add (global.get $token_buf) $token_index) + (i32.load8_u + (i32.add $str (global.get $read_index)))) + (local.set $token_index (i32.add $token_index 1)) + (global.set $read_index (i32.add (global.get $read_index) 1)) + ;;; if (token[0] == '~' && token[1] == '@') break + (br_if $done (AND (i32.eq (i32.load8_u + (i32.add (global.get $token_buf) 0)) + (CHR "~")) + (i32.eq (i32.load8_u + (i32.add (global.get $token_buf) 1)) + (CHR "@")))) + + ;;; if ((!isstring) || escaped) + (if (OR (i32.eqz $isstring) $escaped) + (then + (local.set $escaped 0) + (br $loop))) + (if (i32.eq $c (CHR "\\")) + (local.set $escaped 1)) + (if (i32.eq $c (CHR "\"")) + (then + (local.set $instring 0) + (br $done))) + (br $loop) + ) + ) + + (if (AND $isstring $instring) + (then + ($THROW_STR_0 "expected '\"', got EOF") + (return 0))))) + + ;;; token[token_index] = '\0' + (i32.store8 (i32.add (global.get $token_buf) $token_index) 0) + (global.get $token_buf) + ) + + (func $read_seq (param $str i32 $type i32 $end i32) (result i32) + (LET $res ($MAP_LOOP_START $type) + $val2 0 + $val3 0 + $c 0 + ;; MAP_LOOP stack + $ret $res + $empty $res + $current $res) + + ;; READ_SEQ_LOOP + (block $done + (loop $loop + ($skip_spaces_comments $str) + + ;; peek at next character + ;;; c = str[*index] + (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) + (if (i32.eq $c (CHR "\x00")) + (then + ($THROW_STR_0 "unexpected EOF") + (br $done))) + (if (i32.eq $c $end) + (then + ;; read next character + ;;; c = str[(*index)++] + (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) + (global.set $read_index (i32.add (global.get $read_index) 1)) + (br $done))) + + ;; value (or key for hash-maps) + (local.set $val2 ($read_form $str)) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $val2) + (br $done))) + + ;; if this is a hash-map, READ_FORM again + (if (i32.eq $type (global.get $HASHMAP_T)) + (local.set $val3 ($read_form $str))) + + ;; update the return sequence structure + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (br $loop) + ) + ) + + ;; MAP_LOOP_DONE + $ret + ) + + (func $read_macro (param $str i32 $sym i32 $with_meta i32) (result i32) + (LET $first ($STRING (global.get $SYMBOL_T) $sym) + $second ($read_form $str) + $third 0 + $res $second) + (if (global.get $error_type) (return $res)) + (if (i32.eqz $with_meta) + (then + (local.set $res ($LIST2 $first $second))) + (else + (local.set $third ($read_form $str)) + (local.set $res ($LIST3 $first $third $second)) + ;; release values, list has ownership + ($RELEASE $third))) + ;; release values, list has ownership + ($RELEASE $second) + ($RELEASE $first) + $res + ) + + (func $read_form (param $str i32) (result i32) + (LET $tok 0 $c0 0 $c1 0 $res 0 $slen 0) + + (if (global.get $error_type) (return 0)) + + (local.set $tok ($read_token $str)) + + (if (global.get $error_type) (return 0)) + ;;($printf_1 ">>> read_form 1: %s\n" $tok) + ;;; c0 = token[0] + (local.set $c0 (i32.load8_u $tok)) + (local.set $c1 (i32.load8_u (i32.add $tok 1))) + + (if (i32.eq $c0 0) + (then + (return ($INC_REF (global.get $NIL)))) + (else (if (OR (AND (i32.ge_u $c0 (CHR "0")) + (i32.le_u $c0 (CHR "9"))) + (AND (i32.eq $c0 (CHR "-")) + (i32.ge_u $c1 (CHR "0")) + (i32.le_u $c1 (CHR "9")))) + (then + (return ($INTEGER ($atoi $tok)))) + (else (if (i32.eq $c0 (CHR ":")) + (then + (i32.store8 $tok (CHR "\x7f")) + (return ($STRING (global.get $STRING_T) $tok))) + (else (if (i32.eq $c0 (CHR "\"")) + (then + (local.set $slen ($strlen (i32.add $tok 1))) + (if (i32.ne (i32.load8_u (i32.add $tok $slen)) (CHR "\"")) + (then + ($THROW_STR_0 "expected '\"', got EOF") + (return 0)) + (else + ;; unescape backslashes, quotes, and newlines + ;; remove the trailing quote + (i32.store8 (i32.add $tok $slen) (CHR "\x00")) + (local.set $tok (i32.add $tok 1)) + (drop ($REPLACE3 0 $tok + "\\\"" "\"" + "\\n" "\n" + "\\\\" "\\")) + (return ($STRING (global.get $STRING_T) $tok))))) + (else (if (i32.eqz ($strcmp "nil" $tok)) + (then (return ($INC_REF (global.get $NIL)))) + (else (if (i32.eqz ($strcmp "false" $tok)) + (then (return ($INC_REF (global.get $FALSE)))) + (else (if (i32.eqz ($strcmp "true" $tok)) + (then (return ($INC_REF (global.get $TRUE)))) + (else (if (i32.eqz ($strcmp "'" $tok)) + (then (return ($read_macro $str "quote" 0))) + (else (if (i32.eqz ($strcmp "`" $tok)) + (then (return ($read_macro $str "quasiquote" 0))) + (else (if (i32.eqz ($strcmp "~@" $tok)) + (then (return ($read_macro $str "splice-unquote" 0))) + (else (if (i32.eqz ($strcmp "~" $tok)) + (then (return ($read_macro $str "unquote" 0))) + (else (if (i32.eqz ($strcmp "^" $tok)) + (then (return ($read_macro $str "with-meta" 1))) + (else (if (i32.eqz ($strcmp "@" $tok)) + (then (return ($read_macro $str "deref" 0))) + (else (if (i32.eq $c0 (CHR "(")) + (then (return ($read_seq $str (global.get $LIST_T) (CHR ")")))) + (else (if (i32.eq $c0 (CHR "[")) + (then (return ($read_seq $str (global.get $VECTOR_T) (CHR "]")))) + (else (if (i32.eq $c0 (CHR "{")) + (then (return ($read_seq $str (global.get $HASHMAP_T) (CHR "}")))) + (else (if (OR (i32.eq $c0 (CHR ")")) + (i32.eq $c0 (CHR "]")) + (i32.eq $c0 (CHR "}"))) + (then + ($THROW_STR_1 "unexpected '%c'" $c0) + (return 0)) + (else + (return ($STRING (global.get $SYMBOL_T) $tok)))) + )))))))))))))))))))))))))))))))) + 0 ;; not reachable + ) + + (func $read_str (param $str i32) (result i32) + (global.set $read_index 0) + ($read_form $str) + ) + + (export "read_str" (func $read_str)) + +) diff --git a/impls/wasm/run b/impls/wasm/run new file mode 100755 index 0000000000..7d4fed5185 --- /dev/null +++ b/impls/wasm/run @@ -0,0 +1,18 @@ +#!/usr/bin/env bash +STEP=${STEP:-stepA_mal} +case "${wasm_MODE}" in +wasmtime) + exec wasmtime --dir=./ --dir=../ --dir=/ $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; +wasmer) + exec wasmer run --dir=./ --dir=../ --dir=/ $(dirname $0)/${STEP:-stepA_mal}.wasm -- "${@}" ;; +warpy) + exec warpy --argv --memory-pages 256 $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; +wax) + exec wax $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; +wace_libc) + exec wace $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; +wace_fooboot) + echo >&2 "wace_fooboot mode not yet supported" ;; +node|js|*) + exec ./run.js $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; +esac diff --git a/impls/wasm/run.js b/impls/wasm/run.js new file mode 100755 index 0000000000..2deaa5e53c --- /dev/null +++ b/impls/wasm/run.js @@ -0,0 +1,156 @@ +#!/usr/bin/env node + +// Copyright Joel Martin +// License MIT + +const { promisify } = require('util') +const fs = require('fs') +const readFile = promisify(fs.readFile) +const assert = require('assert') +const { TextDecoder, TextEncoder } = require('text-encoding') +const node_readline = require('./node_readline.js') + +assert('WebAssembly' in global, 'WebAssembly not detected') + +// +// Memory interaction utilities +// + +// Convert node Buffer to Uint8Array +function toUint8Array(buf) { + let u = new Uint8Array(buf.length) + for (let i = 0; i < buf.length; ++i) { + u[i] = buf[i] + } + return u +} + +// Read null terminated string out of webassembly memory +function get_string(memory, addr) { + //console.warn("get_string:", addr) + let u8 = new Uint8Array(memory.buffer, addr) + let length = u8.findIndex(e => e == 0) + let bytes = new Uint8Array(memory.buffer, addr, length) + let str = new TextDecoder('utf8').decode(bytes) + return str +} + +// Write null terminated string into webassembly memory +function put_string(memory, addr, str, max_length) { + let buf8 = new Uint8Array(memory.buffer, addr) + + let bytes = new TextEncoder('utf8').encode(str) + if (max_length && bytes.length > max_length) { + bytes = bytes.slice(0, max_length) + } + + buf8.set(bytes, 0) + buf8[bytes.length] = 0 // null terminator + return bytes.length+1 +} + +// Put argv structure at beginning of memory +function marshal_argv(memory, offset, args) { + let view = new DataView(memory.buffer, offset) + let buf8 = new Uint8Array(memory.buffer, offset) + + let stringStart = (args.length + 1) * 4 + for (let i = 0; i < args.length; i++) { + let len = put_string(memory, stringStart, args[i]) + view.setUint32(i*4, stringStart, true) + stringStart = stringStart + len + } + view.setUint32(args.length*4, 0, true) + return offset + stringStart // start of free memory +} + +// Based on: +// https://gist.github.com/kripken/59c67556dc03bb6d57052fedef1e61ab + +// Loads a WebAssembly dynamic library, returns a promise. +async function loadWebAssembly(filename, args) { + // Fetch the file and compile it + const wasm_str = await readFile(filename) + const wasm_bin = toUint8Array(wasm_str) + const module = await WebAssembly.compile(wasm_bin) + let memory = new WebAssembly.Memory({ initial: 256 }) + // Core imports + function printline(addr, stream) { + console.log(get_string(memory, addr).replace(/\n$/, '')) + } + + // Returns addr on success and -1 on failure + // Truncates to max_length + function readline(prompt, addr, max_length) { + let line = node_readline.readline(get_string(memory, prompt)) + if (line === null) { return 0 } + put_string(memory, addr, line, max_length) + return 1 + } + + function read_file(path_addr, buf) { + let path = get_string(memory, path_addr) + let contents = fs.readFileSync(path, 'utf8') + return put_string(memory, buf, contents) + } + + function get_time_ms() { + // subtract 30 years to make sure it fits into i32 without + // wrapping or becoming negative + return (new Date()).getTime() - 0x38640900 + } + + // Marshal arguments + const memoryStart = 0 + let memoryBase = marshal_argv(memory, memoryStart, args) + memoryBase = memoryBase + (8 - (memoryBase % 8)) + + // Create the imports for the module, including the + // standard dynamic library imports + imports = {} + imports.env = {} + imports.env.exit = process.exit + imports.env.printline = printline + imports.env.readline = readline + imports.env.read_file = read_file + imports.env.get_time_ms = get_time_ms + + imports.env.stdout = 0 + imports.env.fputs = printline + + imports.env.memory = memory + imports.env.memoryBase = memoryBase + imports.env.table = new WebAssembly.Table({ initial: 0, element: 'anyfunc' }) + imports.env.tableBase = imports.env.tableBase || 0 + // Create the instance. + return [new WebAssembly.Instance(module, imports), args.length, 0] +} + +async function main() { + assert(process.argv.length >= 3, + 'Usage: ./run.js prog.wasm [ARGS...]') + + const wasm = process.argv[2] + const args = process.argv.slice(2) + const [instance, argc, argv] = await loadWebAssembly(wasm, args) + + let exports = instance.exports + assert(exports, 'no exports found') + assert('_main' in exports, '_main not found in wasm module exports') + if ('__post_instantiate' in exports) { + //console.warn('calling exports.__post_instantiate()') + exports['__post_instantiate']() + } + //console.warn(`calling exports._main(${argc}, ${argv})`) + let start = new Date() + let res = exports['_main'](argc, argv) + let end = new Date() + //console.warn('runtime: ' + (end-start) + 'ms') + process.exit(res) +} + +if (module.parent) { + module.exports.loadWebAssembly = loadWebAssembly +} else { + main() +} diff --git a/impls/wasm/step0_repl.wam b/impls/wasm/step0_repl.wam new file mode 100644 index 0000000000..6814041b15 --- /dev/null +++ b/impls/wasm/step0_repl.wam @@ -0,0 +1,49 @@ +(module $step0_repl + + ;; READ + (func $READ (param $str i32) (result i32) + $str + ) + + (func $EVAL (param $ast i32) (param $env i32) (result i32) + $ast + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + $ast + ) + + ;; REPL + (func $rep (param $line i32) (result i32) + ($PRINT ($EVAL ($READ $line) 0)) + ) + + (func $main (param $argc i32 $argv i32) (result i32) + ;; Constant location/value definitions + (LET $line (STATIC_ARRAY 201)) + + ;; DEBUG + ;;($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + ($printf_1 "%s\n" ($rep $line)) + (br $repl_loop) + ) + ) + + ($print "\n") + 0 + ) + + ;; init_memory is provided by mem.wam in later steps but we just + ;; printf in step0 so provide init_memory that just calls that + (func $init_memory + ($init_printf_mem) + ) +) + diff --git a/impls/wasm/step1_read_print.wam b/impls/wasm/step1_read_print.wam new file mode 100644 index 0000000000..19e330d885 --- /dev/null +++ b/impls/wasm/step1_read_print.wam @@ -0,0 +1,81 @@ +(module $step1_read_print + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + (func $EVAL (param $ast i32 $env i32) (result i32) + $ast + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv1 0 $mv2 0 $ms 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $mv2 ($EVAL $mv1 $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0) + + ;; DEBUG +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + +;; ($PR_MEMORY_RAW +;; (global.get $mem) (i32.add (global.get $mem) +;; (i32.mul (global.get $mem_unused_start) 4))) + + (drop ($STRING (global.get $STRING_T) "uvw")) + (drop ($STRING (global.get $STRING_T) "xyz")) + + ;;($PR_MEMORY -1 -1) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line 0)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step2_eval.wam b/impls/wasm/step2_eval.wam new file mode 100644 index 0000000000..408991cd2f --- /dev/null +++ b/impls/wasm/step2_eval.wam @@ -0,0 +1,224 @@ +(module $step2_eval + + (global $repl_env (mut i32) (i32.const 0)) + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + (func $EVAL_AST (param $ast i32 $env i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (i32.eqz ($VAL0 $ast)) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (type $fnT (func (param i32) (result i32))) + + (table funcref + (elem + $add $subtract $multiply $divide)) + + (func $EVAL (param $ast i32 $env i32) (result i32) + (local $res2 i64) + (LET $res 0 + $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $found 0) + + (if (global.get $error_type) (return 0)) + + ;;($PR_VALUE "EVAL: %s\n" $ast) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res2 ($HASHMAP_GET $env $ast)) + (local.set $res (i32.wrap_i64 $res2)) + (local.set $found (i32.wrap_i64 (i64.shr_u $res2 + (i64.const 32)))) + (if (i32.eqz $found) + ($THROW_STR_1 "'%s' not found" + ($to_String $ast))) + (return ($INC_REF $res)))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (return ($EVAL_AST $ast $env)))) + + (if (OR (i32.ne $ast_type (global.get $LIST_T)) + ($EMPTY_Q $ast)) + (then + (return ($INC_REF $ast)))) + + ;; APPLY_LIST + + ;; EVAL_INVOKE + + (local.set $res ($EVAL_AST $ast $env)) + (local.set $f_args $res) + + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (return $f_args)) + + (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest + (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value + + (local.set $ftype ($TYPE $f)) + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) + ($RELEASE $f_args) + (return $res)) + ) + + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + ($RELEASE $f_args) + (return 0) + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv1 0 $mv2 0 $ms 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $mv2 ($EVAL $mv1 $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from MAL_READ and EVAL + ($RELEASE $mv2) + ($RELEASE $mv1) + $ms + ) + + (func $add (param $args i32) (result i32) + ($INTEGER + (i32.add ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $subtract (param $args i32) (result i32) + ($INTEGER + (i32.sub ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $multiply (param $args i32) (result i32) + ($INTEGER + (i32.mul ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $divide (param $args i32) (result i32) + ($INTEGER + (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0) + + ;; DEBUG +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $repl_env ($HASHMAP)) + (local.set $repl_env (global.get $repl_env)) + + (local.set $repl_env ($ASSOC1_S $repl_env "+" ($FUNCTION 0))) + (local.set $repl_env ($ASSOC1_S $repl_env "-" ($FUNCTION 1))) + (local.set $repl_env ($ASSOC1_S $repl_env "*" ($FUNCTION 2))) + (local.set $repl_env ($ASSOC1_S $repl_env "/" ($FUNCTION 3))) + + ;;($PR_MEMORY -1 -1) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step3_env.wam b/impls/wasm/step3_env.wam new file mode 100644 index 0000000000..ca52623ff3 --- /dev/null +++ b/impls/wasm/step3_env.wam @@ -0,0 +1,289 @@ +(module $step3_env + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + (func $EVAL_AST (param $ast i32 $env i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (i32.eqz ($VAL0 $ast)) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (type $fnT (func (param i32) (result i32))) + + (table funcref + (elem + $add $subtract $multiply $divide)) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $ast i32 $env i32) (result i32) + (LET $res 0 + $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0 + $let_env 0) + + (if (global.get $error_type) (return 0)) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (return $res))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (return ($EVAL_AST $ast $env)))) + + (if (OR (i32.ne $ast_type (global.get $LIST_T)) + ($EMPTY_Q $ast)) + (then + (return ($INC_REF $ast)))) + + ;; APPLY_LIST + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (if (global.get $error_type) (return $res)) + + ;; set a1 in env to a2 + (return ($ENV_SET $env $a1 $res))) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $let_env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) + $let_env)) + + (if (global.get $error_type) + (then + (return 0))) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + (local.set $res ($EVAL $a2 $let_env)) + ;; EVAL_RETURN + ($RELEASE $let_env) + (return $res)) + ) + ;; EVAL_INVOKE + + (local.set $res ($EVAL_AST $ast $env)) + (local.set $f_args $res) + + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (return $f_args)) + + (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest + (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value + + (local.set $ftype ($TYPE $f)) + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) + ($RELEASE $f_args) + (return $res)) + ) + + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + ($RELEASE $f_args) + (return 0) + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv1 0 $mv2 0 $ms 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $mv2 ($EVAL $mv1 $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from MAL_READ and EVAL + ($RELEASE $mv2) + ($RELEASE $mv1) + $ms + ) + + (func $add (param $args i32) (result i32) + ($INTEGER + (i32.add ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $subtract (param $args i32) (result i32) + ($INTEGER + (i32.sub ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $multiply (param $args i32) (result i32) + ($INTEGER + (i32.mul ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $divide (param $args i32) (result i32) + ($INTEGER + (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args)) + ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) + (func $pr_memory (param $args i32) (result i32) + ($PR_MEMORY -1 -1) + ($INC_REF (global.get $NIL))) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0) + + ;; DEBUG +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + (drop ($ENV_SET_S $repl_env "+" ($FUNCTION 0))) + (drop ($ENV_SET_S $repl_env "-" ($FUNCTION 1))) + (drop ($ENV_SET_S $repl_env "*" ($FUNCTION 2))) + (drop ($ENV_SET_S $repl_env "/" ($FUNCTION 3))) + + ;;($PR_MEMORY -1 -1) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step4_if_fn_do.wam b/impls/wasm/step4_if_fn_do.wam new file mode 100644 index 0000000000..01eaa69324 --- /dev/null +++ b/impls/wasm/step4_if_fn_do.wam @@ -0,0 +1,339 @@ +(module $step4_if_fn_do + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + (func $EVAL_AST (param $ast i32 $env i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (i32.eqz ($VAL0 $ast)) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $ast i32 $env i32) (result i32) + (LET $res 0 $el 0 + $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0 $a3 0 + $let_env 0 $fn_env 0 $a 0) + + (if (global.get $error_type) (return 0)) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (return $res))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (return ($EVAL_AST $ast $env)))) + + (if (OR (i32.ne $ast_type (global.get $LIST_T)) + ($EMPTY_Q $ast)) + (then + (return ($INC_REF $ast)))) + + ;; APPLY_LIST + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (if (global.get $error_type) (return $res)) + + ;; set a1 in env to a2 + (return ($ENV_SET $env $a1 $res))) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $let_env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) + $let_env)) + + (if (global.get $error_type) + (then + (return 0))) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + (local.set $res ($EVAL $a2 $let_env)) + ;; EVAL_RETURN + ($RELEASE $let_env) + (return $res)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) + (then + (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env)) + (local.set $res ($LAST $el)) + ($RELEASE $el) + (return $res)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + (if (global.get $error_type) + (then (nop)) + (else (if (OR (i32.eq $res (global.get $NIL)) + (i32.eq $res (global.get $FALSE))) + (then + ($RELEASE $res) + ;; if no false case (A3), return nil + (if (i32.lt_u ($COUNT $ast) 4) + (then + (return ($INC_REF (global.get $NIL)))) + (else + (local.set $a3 ($MAL_GET_A3 $ast)) + (return ($EVAL $a3 $env))))) + (else + ($RELEASE $res) + (local.set $a2 ($MAL_GET_A2 $ast)) + (return ($EVAL $a2 $env))))))) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (return ($ALLOC (global.get $MALFUNC_T) $a2 $a1 $env))) + ) + ;; EVAL_INVOKE + + (local.set $res ($EVAL_AST $ast $env)) + (local.set $f_args $res) + + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (return $f_args)) + + (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest + (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value + + (local.set $ftype ($TYPE $f)) + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) + ($RELEASE $f_args) + (return $res)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) + (then + (local.set $fn_env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; claim the AST before releasing the list containing it + (local.set $a ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $a)) + + ;; release f/args + ($RELEASE $f_args) + + (local.set $res ($EVAL $a $fn_env)) + ;; EVAL_RETURN + ($RELEASE $fn_env) + ($RELEASE $a) + (return $res)) + ) + ;; create new environment using env and params stored in function + + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + ($RELEASE $f_args) + (return 0) + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $RE (param $line i32 $env i32) (result i32) + (LET $mv1 0 $res 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $res ($EVAL $mv1 $env)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $res + ) + + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv2 0 $ms 0) + (block $done + (local.set $mv2 ($RE $line $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from RE + ($RELEASE $mv2) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0 $ms 0) + + ;; DEBUG +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + ;; core.EXT: defined in wasm + ($add_core_ns $repl_env) + + ($checkpoint_user_memory) + + ;; core.mal: defined using the language itself + ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) + + ;;($PR_MEMORY -1 -1) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + (if (i32.eq 2 (global.get $error_type)) + (then + (local.set $ms ($pr_str (global.get $error_val) 1)) + ($printf_1 "Error: %s\n" ($to_String $ms)) + ($RELEASE $ms) + ($RELEASE (global.get $error_val))) + (else + ($printf_1 "Error: %s\n" (global.get $error_str)))) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step5_tco.wam b/impls/wasm/step5_tco.wam new file mode 100644 index 0000000000..4dabe4cc83 --- /dev/null +++ b/impls/wasm/step5_tco.wam @@ -0,0 +1,393 @@ +(module $step5_tco + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) + (LET $ast $orig_ast + $env $orig_env + $prev_ast 0 $prev_env 0 $res 0 $el 0 + $ftype 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0) + + (block $EVAL_return + (loop $TCO_loop + + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (br $EVAL_return))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (local.set $res ($EVAL_AST $ast $env 0)) + (br $EVAL_return))) + + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + + (if ($EMPTY_Q $ast) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (br_if $EVAL_return (global.get $error_type)) + + ;; set a1 in env to a2 + (local.set $res ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $prev_env $env) ;; save env for later release + (local.set $env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) + + (br_if $done (global.get $error_type)) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) + (then + ;; EVAL the rest through second to last + (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) + (local.set $ast ($LAST $ast)) + ($RELEASE $ast) ;; we already own it via ast + ($RELEASE $el) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + (if (global.get $error_type) + (then (nop)) + (else (if (OR (i32.eq $res (global.get $NIL)) + (i32.eq $res (global.get $FALSE))) + (then + ($RELEASE $res) + ;; if no false case (A3), return nil + (if (i32.lt_u ($COUNT $ast) 4) + (then + (local.set $res ($INC_REF (global.get $NIL))) + (br $EVAL_return)) + (else + (local.set $ast ($MAL_GET_A3 $ast))))) + (else + ($RELEASE $res) + (local.set $ast ($MAL_GET_A2 $ast)))))) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($MALFUNC $a2 $a1 $env)) + (br $EVAL_return)) + ) + ;; EVAL_INVOKE + + ;; Evaluate the first element to find a function. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (then + (local.set $res $f) + ($RELEASE $args) + (br $EVAL_return))) + + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) + (then + ;; save the current environment for release + (local.set $prev_env $env) + ;; create new environment using env and params stored in function + (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; release previous environment if not the current EVAL env + ;; because our new env refers to it and we no longer need to + ;; track it (since we are TCO recurring) + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + ;; claim the AST before releasing the list containing it + (local.set $ast ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $ast)) + + ;; if we have already been here via TCO, release previous + ;; ast + ;; PEND_A_LV + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + + (br $TCO_loop)) + ) + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + (local.set $res 0) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) + + ) ;; end of TCO_loop + ) ;; end of EVAL_return + + ;; EVAL_RETURN + (if (i32.ne $env $orig_env) ($RELEASE $env)) + (if $prev_ast ($RELEASE $prev_ast)) + + $res + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $RE (param $line i32 $env i32) (result i32) + (LET $mv1 0 $res 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $res ($EVAL $mv1 $env)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $res + ) + + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv2 0 $ms 0) + (block $done + (local.set $mv2 ($RE $line $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from RE + ($RELEASE $mv2) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0 $ms 0) + + ;; DEBUG +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + ;; core.EXT: defined in wasm + ($add_core_ns $repl_env) + + ($checkpoint_user_memory) + + ;; core.mal: defined using the language itself + ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) + + ;;($PR_MEMORY -1 -1) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + (if (i32.eq 2 (global.get $error_type)) + (then + (local.set $ms ($pr_str (global.get $error_val) 1)) + ($printf_1 "Error: %s\n" ($to_String $ms)) + ($RELEASE $ms) + ($RELEASE (global.get $error_val))) + (else + ($printf_1 "Error: %s\n" (global.get $error_str)))) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step6_file.wam b/impls/wasm/step6_file.wam new file mode 100644 index 0000000000..f7e8ee2100 --- /dev/null +++ b/impls/wasm/step6_file.wam @@ -0,0 +1,449 @@ +(module $step6_file + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) + (LET $ast $orig_ast + $env $orig_env + $prev_ast 0 $prev_env 0 $res 0 $el 0 + $ftype 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0) + + (block $EVAL_return + (loop $TCO_loop + + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (br $EVAL_return))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (local.set $res ($EVAL_AST $ast $env 0)) + (br $EVAL_return))) + + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + + (if ($EMPTY_Q $ast) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (br_if $EVAL_return (global.get $error_type)) + + ;; set a1 in env to a2 + (local.set $res ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $prev_env $env) ;; save env for later release + (local.set $env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) + + (br_if $done (global.get $error_type)) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) + (then + ;; EVAL the rest through second to last + (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) + (local.set $ast ($LAST $ast)) + ($RELEASE $ast) ;; we already own it via ast + ($RELEASE $el) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + (if (global.get $error_type) + (then (nop)) + (else (if (OR (i32.eq $res (global.get $NIL)) + (i32.eq $res (global.get $FALSE))) + (then + ($RELEASE $res) + ;; if no false case (A3), return nil + (if (i32.lt_u ($COUNT $ast) 4) + (then + (local.set $res ($INC_REF (global.get $NIL))) + (br $EVAL_return)) + (else + (local.set $ast ($MAL_GET_A3 $ast))))) + (else + ($RELEASE $res) + (local.set $ast ($MAL_GET_A2 $ast)))))) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($MALFUNC $a2 $a1 $env)) + (br $EVAL_return)) + ) + ;; EVAL_INVOKE + + ;; Evaluate the first element to find a function. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (then + (local.set $res $f) + ($RELEASE $args) + (br $EVAL_return))) + + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (if (i32.eq ($VAL0 $f) 0) ;; eval + (then + (local.set $res ($EVAL ($MEM_VAL1_ptr $args) + (global.get $repl_env)))) + (else + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) + (then + ;; save the current environment for release + (local.set $prev_env $env) + ;; create new environment using env and params stored in function + (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; release previous environment if not the current EVAL env + ;; because our new env refers to it and we no longer need to + ;; track it (since we are TCO recurring) + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + ;; claim the AST before releasing the list containing it + (local.set $ast ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $ast)) + + ;; if we have already been here via TCO, release previous + ;; ast + ;; PEND_A_LV + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + + (br $TCO_loop)) + ) + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + (local.set $res 0) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) + + ) ;; end of TCO_loop + ) ;; end of EVAL_return + + ;; EVAL_RETURN + (if (i32.ne $env $orig_env) ($RELEASE $env)) + (if $prev_ast ($RELEASE $prev_ast)) + + $res + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $RE (param $line i32 $env i32) (result i32) + (LET $mv1 0 $res 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $res ($EVAL $mv1 $env)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $res + ) + + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv2 0 $ms 0) + (block $done + (local.set $mv2 ($RE $line $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from RE + ($RELEASE $mv2) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0 $ms 0 + ;; argument processing + $i 0 $ret 0 $empty 0 $current 0 $val2 0) + + ;; DEBUG +;; ($printf_1 "argc: 0x%x\n" $argc) +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + ;; core.EXT: defined in wasm + ($add_core_ns $repl_env) + (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) + + ($checkpoint_user_memory) + + ;; core.mal: defined using the language itself + ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) + ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) + + + ;; Command line arguments + (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) + ;; push MAP_LOP stack + ;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (local.set $i 2) + (block $done + (loop $loop + (br_if $done (i32.ge_u $i $argc)) + + (local.set $val2 ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv (i32.mul $i 4))))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE + (global.get $LIST_T) $empty $current $val2 0)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) + + + ;;($PR_MEMORY -1 -1) + + (if (i32.gt_u $argc 1) + (then + (drop ($ENV_SET_S $repl_env + "*FILE*" ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv 4))))) + ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (return 1)) + (else + (return 0))))) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + (if (i32.eq 2 (global.get $error_type)) + (then + (local.set $ms ($pr_str (global.get $error_val) 1)) + ($printf_1 "Error: %s\n" ($to_String $ms)) + ($RELEASE $ms) + ($RELEASE (global.get $error_val))) + (else + ($printf_1 "Error: %s\n" (global.get $error_str)))) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step7_quote.wam b/impls/wasm/step7_quote.wam new file mode 100644 index 0000000000..fce581e0d4 --- /dev/null +++ b/impls/wasm/step7_quote.wam @@ -0,0 +1,543 @@ +(module $step7_quote + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + + + (func $QUASIQUOTE (param $ast i32) (result i32) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + + + (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) + (LET $ast $orig_ast + $env $orig_env + $prev_ast 0 $prev_env 0 $res 0 $el 0 + $ftype 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0) + + (block $EVAL_return + (loop $TCO_loop + + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (br $EVAL_return))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (local.set $res ($EVAL_AST $ast $env 0)) + (br $EVAL_return))) + + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + + (if ($EMPTY_Q $ast) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (br_if $EVAL_return (global.get $error_type)) + + ;; set a1 in env to a2 + (local.set $res ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $prev_env $env) ;; save env for later release + (local.set $env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) + + (br_if $done (global.get $error_type)) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) + (then + ;; EVAL the rest through second to last + (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) + (local.set $ast ($LAST $ast)) + ($RELEASE $ast) ;; we already own it via ast + ($RELEASE $el) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "quote" $a0sym)) + (then + (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "quasiquote" $a0sym)) + (then + (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + + ;; if we have already been here via TCO, release previous ast + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + (if (global.get $error_type) + (then (nop)) + (else (if (OR (i32.eq $res (global.get $NIL)) + (i32.eq $res (global.get $FALSE))) + (then + ($RELEASE $res) + ;; if no false case (A3), return nil + (if (i32.lt_u ($COUNT $ast) 4) + (then + (local.set $res ($INC_REF (global.get $NIL))) + (br $EVAL_return)) + (else + (local.set $ast ($MAL_GET_A3 $ast))))) + (else + ($RELEASE $res) + (local.set $ast ($MAL_GET_A2 $ast)))))) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($MALFUNC $a2 $a1 $env)) + (br $EVAL_return)) + ) + ;; EVAL_INVOKE + + ;; Evaluate the first element to find a function. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (then + (local.set $res $f) + ($RELEASE $args) + (br $EVAL_return))) + + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (if (i32.eq ($VAL0 $f) 0) ;; eval + (then + (local.set $res ($EVAL ($MEM_VAL1_ptr $args) + (global.get $repl_env)))) + (else + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) + (then + ;; save the current environment for release + (local.set $prev_env $env) + ;; create new environment using env and params stored in function + (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; release previous environment if not the current EVAL env + ;; because our new env refers to it and we no longer need to + ;; track it (since we are TCO recurring) + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + ;; claim the AST before releasing the list containing it + (local.set $ast ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $ast)) + + ;; if we have already been here via TCO, release previous + ;; ast + ;; PEND_A_LV + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + + (br $TCO_loop)) + ) + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + (local.set $res 0) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) + + ) ;; end of TCO_loop + ) ;; end of EVAL_return + + ;; EVAL_RETURN + (if (i32.ne $env $orig_env) ($RELEASE $env)) + (if $prev_ast ($RELEASE $prev_ast)) + + $res + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $RE (param $line i32 $env i32) (result i32) + (LET $mv1 0 $res 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $res ($EVAL $mv1 $env)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $res + ) + + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv2 0 $ms 0) + (block $done + (local.set $mv2 ($RE $line $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from RE + ($RELEASE $mv2) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0 $ms 0 + ;; argument processing + $i 0 $ret 0 $empty 0 $current 0 $val2 0) + + ;; DEBUG +;; ($printf_1 "argc: 0x%x\n" $argc) +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + ;; core.EXT: defined in wasm + ($add_core_ns $repl_env) + (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) + + ($checkpoint_user_memory) + + ;; core.mal: defined using the language itself + ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) + ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) + + + ;; Command line arguments + (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) + ;; push MAP_LOP stack + ;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (local.set $i 2) + (block $done + (loop $loop + (br_if $done (i32.ge_u $i $argc)) + + (local.set $val2 ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv (i32.mul $i 4))))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE + (global.get $LIST_T) $empty $current $val2 0)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) + + + ;;($PR_MEMORY -1 -1) + + (if (i32.gt_u $argc 1) + (then + (drop ($ENV_SET_S $repl_env + "*FILE*" ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv 4))))) + ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (return 1)) + (else + (return 0))))) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + (if (i32.eq 2 (global.get $error_type)) + (then + (local.set $ms ($pr_str (global.get $error_val) 1)) + ($printf_1 "Error: %s\n" ($to_String $ms)) + ($RELEASE $ms) + ($RELEASE (global.get $error_val))) + (else + ($printf_1 "Error: %s\n" (global.get $error_str)))) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step8_macros.wam b/impls/wasm/step8_macros.wam new file mode 100644 index 0000000000..cadb6de970 --- /dev/null +++ b/impls/wasm/step8_macros.wam @@ -0,0 +1,569 @@ +(module $step8_macros + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + + + (func $QUASIQUOTE (param $ast i32) (result i32) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + + + (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) + (LET $ast $orig_ast + $env $orig_env + $prev_ast 0 $prev_env 0 $res 0 $el 0 + $ftype 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0 + $err 0) + + (block $EVAL_return + (loop $TCO_loop + + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (br $EVAL_return))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (local.set $res ($EVAL_AST $ast $env 0)) + (br $EVAL_return))) + + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + + (if ($EMPTY_Q $ast) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (br_if $EVAL_return (global.get $error_type)) + + ;; set a1 in env to a2 + (local.set $res ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $prev_env $env) ;; save env for later release + (local.set $env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) + + (br_if $done (global.get $error_type)) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) + (then + ;; EVAL the rest through second to last + (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) + (local.set $ast ($LAST $ast)) + ($RELEASE $ast) ;; we already own it via ast + ($RELEASE $el) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "quote" $a0sym)) + (then + (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "quasiquote" $a0sym)) + (then + (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + + ;; if we have already been here via TCO, release previous ast + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "defmacro!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $f ($EVAL $a2 $env)) + (local.set $res ($MALFUNC ($MEM_VAL0_ptr $f) + ($MEM_VAL1_ptr $f) ($MEM_VAL2_ptr $f))) + ($SET_TYPE $res (global.get $MACRO_T)) + (br_if $EVAL_return (global.get $error_type)) + ($RELEASE $f) + + ;; set a1 in env to a2 + (drop ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + (if (global.get $error_type) + (then (nop)) + (else (if (OR (i32.eq $res (global.get $NIL)) + (i32.eq $res (global.get $FALSE))) + (then + ($RELEASE $res) + ;; if no false case (A3), return nil + (if (i32.lt_u ($COUNT $ast) 4) + (then + (local.set $res ($INC_REF (global.get $NIL))) + (br $EVAL_return)) + (else + (local.set $ast ($MAL_GET_A3 $ast))))) + (else + ($RELEASE $res) + (local.set $ast ($MAL_GET_A2 $ast)))))) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($MALFUNC $a2 $a1 $env)) + (br $EVAL_return)) + ) + ;; EVAL_INVOKE + + ;; Evaluate the first element to find a function or macro. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + (if (i32.eq $ftype (global.get $MACRO_T)) + (then + (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) + ($RELEASE $f) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + (br $TCO_loop))) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (then + (local.set $res $f) + ($RELEASE $args) + (br $EVAL_return))) + + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (if (i32.eq ($VAL0 $f) 0) ;; eval + (then + (local.set $res ($EVAL ($MEM_VAL1_ptr $args) + (global.get $repl_env)))) + (else + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) + (then + ;; save the current environment for release + (local.set $prev_env $env) + ;; create new environment using env and params stored in function + (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; release previous environment if not the current EVAL env + ;; because our new env refers to it and we no longer need to + ;; track it (since we are TCO recurring) + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + ;; claim the AST before releasing the list containing it + (local.set $ast ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $ast)) + + ;; if we have already been here via TCO, release previous + ;; ast + ;; PEND_A_LV + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + + (br $TCO_loop)) + ) + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + (local.set $res 0) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) + + ) ;; end of TCO_loop + ) ;; end of EVAL_return + + ;; EVAL_RETURN + (if (i32.ne $env $orig_env) ($RELEASE $env)) + (if $prev_ast ($RELEASE $prev_ast)) + + $res + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $RE (param $line i32 $env i32) (result i32) + (LET $mv1 0 $res 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $res ($EVAL $mv1 $env)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $res + ) + + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv2 0 $ms 0) + (block $done + (local.set $mv2 ($RE $line $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from RE + ($RELEASE $mv2) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0 $ms 0 + ;; argument processing + $i 0 $ret 0 $empty 0 $current 0 $val2 0) + + ;; DEBUG +;; ($printf_1 "argc: 0x%x\n" $argc) +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + ;; core.EXT: defined in wasm + ($add_core_ns $repl_env) + (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) + + ($checkpoint_user_memory) + + ;; core.mal: defined using the language itself + ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) + ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) + ($RELEASE ($RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env)) + + ;; Command line arguments + (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) + ;; push MAP_LOP stack + ;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (local.set $i 2) + (block $done + (loop $loop + (br_if $done (i32.ge_u $i $argc)) + + (local.set $val2 ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv (i32.mul $i 4))))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE + (global.get $LIST_T) $empty $current $val2 0)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) + + + ;;($PR_MEMORY -1 -1) + + (if (i32.gt_u $argc 1) + (then + (drop ($ENV_SET_S $repl_env + "*FILE*" ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv 4))))) + ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (return 1)) + (else + (return 0))))) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + (if (i32.eq 2 (global.get $error_type)) + (then + (local.set $ms ($pr_str (global.get $error_val) 1)) + ($printf_1 "Error: %s\n" ($to_String $ms)) + ($RELEASE $ms) + ($RELEASE (global.get $error_val))) + (else + ($printf_1 "Error: %s\n" (global.get $error_str)))) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/step9_try.wam b/impls/wasm/step9_try.wam new file mode 100644 index 0000000000..809acd868e --- /dev/null +++ b/impls/wasm/step9_try.wam @@ -0,0 +1,616 @@ +(module $step9_try + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + + + (func $QUASIQUOTE (param $ast i32) (result i32) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + + + (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) + (LET $ast $orig_ast + $env $orig_env + $prev_ast 0 $prev_env 0 $res 0 $el 0 + $ftype 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0 + $err 0) + + (block $EVAL_return + (loop $TCO_loop + + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (br $EVAL_return))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (local.set $res ($EVAL_AST $ast $env 0)) + (br $EVAL_return))) + + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + + (if ($EMPTY_Q $ast) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (br_if $EVAL_return (global.get $error_type)) + + ;; set a1 in env to a2 + (local.set $res ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $prev_env $env) ;; save env for later release + (local.set $env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) + + (br_if $done (global.get $error_type)) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) + (then + ;; EVAL the rest through second to last + (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) + (local.set $ast ($LAST $ast)) + ($RELEASE $ast) ;; we already own it via ast + ($RELEASE $el) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "quote" $a0sym)) + (then + (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "quasiquote" $a0sym)) + (then + (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + + ;; if we have already been here via TCO, release previous ast + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "defmacro!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $f ($EVAL $a2 $env)) + (local.set $res ($MALFUNC ($MEM_VAL0_ptr $f) + ($MEM_VAL1_ptr $f) ($MEM_VAL2_ptr $f))) + ($SET_TYPE $res (global.get $MACRO_T)) + (br_if $EVAL_return (global.get $error_type)) + ($RELEASE $f) + + ;; set a1 in env to a2 + (drop ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "try*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + ;; if there is no error, return + (br_if $EVAL_return (i32.eqz (global.get $error_type))) + ;; if there is an error and res is set, we need to free it + ($RELEASE $res) + ;; if there is no catch block then return + (br_if $EVAL_return + (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + ;; save the current environment for release + (local.set $prev_env $env) + ;; create environment for the catch block eval + (local.set $env ($ENV_NEW $env)) + + ;; set a1 and a2 from the catch block + (local.set $a1 ($MAL_GET_A1 ($MAL_GET_A2 $ast))) + (local.set $a2 ($MAL_GET_A2 ($MAL_GET_A2 $ast))) + + ;; create object for string errors + (if (i32.eq (global.get $error_type) 1) + (then + (local.set $err ($STRING (global.get $STRING_T) + (global.get $error_str)))) + (else + (local.set $err (global.get $error_val)))) + ;; bind the catch symbol to the error object + (drop ($ENV_SET $env $a1 $err)) + ;; release our use, env took ownership + ($RELEASE $err) + + ;; unset error for catch eval + (global.set $error_type 0) + (i32.store (global.get $error_str) (CHR "\x00")) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + (if (global.get $error_type) + (then (nop)) + (else (if (OR (i32.eq $res (global.get $NIL)) + (i32.eq $res (global.get $FALSE))) + (then + ($RELEASE $res) + ;; if no false case (A3), return nil + (if (i32.lt_u ($COUNT $ast) 4) + (then + (local.set $res ($INC_REF (global.get $NIL))) + (br $EVAL_return)) + (else + (local.set $ast ($MAL_GET_A3 $ast))))) + (else + ($RELEASE $res) + (local.set $ast ($MAL_GET_A2 $ast)))))) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($MALFUNC $a2 $a1 $env)) + (br $EVAL_return)) + ) + ;; EVAL_INVOKE + + ;; Evaluate the first element to find a function or macro. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + (if (i32.eq $ftype (global.get $MACRO_T)) + (then + (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) + ($RELEASE $f) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + (br $TCO_loop))) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (then + (local.set $res $f) + ($RELEASE $args) + (br $EVAL_return))) + + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (if (i32.eq ($VAL0 $f) 0) ;; eval + (then + (local.set $res ($EVAL ($MEM_VAL1_ptr $args) + (global.get $repl_env)))) + (else + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) + (then + ;; save the current environment for release + (local.set $prev_env $env) + ;; create new environment using env and params stored in function + (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; release previous environment if not the current EVAL env + ;; because our new env refers to it and we no longer need to + ;; track it (since we are TCO recurring) + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + ;; claim the AST before releasing the list containing it + (local.set $ast ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $ast)) + + ;; if we have already been here via TCO, release previous + ;; ast + ;; PEND_A_LV + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + + (br $TCO_loop)) + ) + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + (local.set $res 0) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) + + ) ;; end of TCO_loop + ) ;; end of EVAL_return + + ;; EVAL_RETURN + (if (i32.ne $env $orig_env) ($RELEASE $env)) + (if $prev_ast ($RELEASE $prev_ast)) + + $res + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $RE (param $line i32 $env i32) (result i32) + (LET $mv1 0 $res 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $res ($EVAL $mv1 $env)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $res + ) + + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv2 0 $ms 0) + (block $done + (local.set $mv2 ($RE $line $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from RE + ($RELEASE $mv2) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0 $ms 0 + ;; argument processing + $i 0 $ret 0 $empty 0 $current 0 $val2 0) + + ;; DEBUG +;; ($printf_1 "argc: 0x%x\n" $argc) +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + ;; core.EXT: defined in wasm + ($add_core_ns $repl_env) + (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) + + ($checkpoint_user_memory) + + ;; core.mal: defined using the language itself + ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) + ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) + ($RELEASE ($RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env)) + + ;; Command line arguments + (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) + ;; push MAP_LOP stack + ;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (local.set $i 2) + (block $done + (loop $loop + (br_if $done (i32.ge_u $i $argc)) + + (local.set $val2 ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv (i32.mul $i 4))))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE + (global.get $LIST_T) $empty $current $val2 0)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) + + + ;;($PR_MEMORY -1 -1) + + (if (i32.gt_u $argc 1) + (then + (drop ($ENV_SET_S $repl_env + "*FILE*" ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv 4))))) + ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (return 1)) + (else + (return 0))))) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + (if (i32.eq 2 (global.get $error_type)) + (then + (local.set $ms ($pr_str (global.get $error_val) 1)) + ($printf_1 "Error: %s\n" ($to_String $ms)) + ($RELEASE $ms) + ($RELEASE (global.get $error_val))) + (else + ($printf_1 "Error: %s\n" (global.get $error_str)))) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/stepA_mal.wam b/impls/wasm/stepA_mal.wam new file mode 100644 index 0000000000..fc413d4e15 --- /dev/null +++ b/impls/wasm/stepA_mal.wam @@ -0,0 +1,619 @@ +(module $stepA_mal + + (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED + + ;; READ + (func $READ (param $str i32) (result i32) + ($read_str $str) + ) + + ;; EVAL + + + (func $QUASIQUOTE (param $ast i32) (result i32) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + + + (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 + $ret 0 $empty 0 $current 0) + + (if (global.get $error_type) (return 0)) + (local.set $type ($TYPE $ast)) + + ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) + + ;; MAP_LOOP_START + (local.set $res ($MAP_LOOP_START $type)) + ;; push MAP_LOOP stack + ;;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (loop $loop + ;; check if we are done evaluating the source sequence + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) + + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) + (else + (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) + (local.set $val2 $res) + + ;; if error, release the unattached element + (if (global.get $error_type) + (then + ($RELEASE $res) + (return 0))) + + ;; for hash-maps, copy the key (inc ref since we are going + ;; to release it below) + (if (i32.eq $type (global.get $HASHMAP_T)) + (then + (local.set $val3 $val2) + (local.set $val2 ($MEM_VAL1_ptr $ast)) + (drop ($INC_REF $val2)))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $ast ($MEM_VAL0_ptr $ast)) + + (br $loop) + ) + ;; MAP_LOOP_DONE + ) + + (func $MAL_GET_A1 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) + (func $MAL_GET_A2 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) + (func $MAL_GET_A3 (param $ast i32) (result i32) + ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) + (if (AND $value + (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))) + + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) + (LET $ast $orig_ast + $env $orig_env + $prev_ast 0 $prev_env 0 $res 0 $el 0 + $ftype 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0 + $err 0) + + (block $EVAL_return + (loop $TCO_loop + + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (if (i32.eqz $res) + ($THROW_STR_1 "'%s' not found" ($to_String $ast))) + (br $EVAL_return))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (local.set $res ($EVAL_AST $ast $env 0)) + (br $EVAL_return))) + + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + + (if ($EMPTY_Q $ast) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + (local.set $a0 ($MEM_VAL1_ptr $ast)) + (local.set $a0sym "") + (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) + (local.set $a0sym ($to_String $a0))) + + (if (i32.eqz ($strcmp "def!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($EVAL $a2 $env)) + (br_if $EVAL_return (global.get $error_type)) + + ;; set a1 in env to a2 + (local.set $res ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + + ;; create new environment with outer as current environment + (local.set $prev_env $env) ;; save env for later release + (local.set $env ($ENV_NEW $env)) + + (block $done + (loop $loop + (br_if $done (i32.eqz ($VAL0 $a1))) + ;; eval current A1 odd element + (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) + + (br_if $done (global.get $error_type)) + + ;; set key/value in the let environment + (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) + ;; release our use, ENV_SET took ownership + ($RELEASE $res) + + ;; skip to the next pair of a1 elements + (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) + (br $loop) + ) + ) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) + (then + ;; EVAL the rest through second to last + (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) + (local.set $ast ($LAST $ast)) + ($RELEASE $ast) ;; we already own it via ast + ($RELEASE $el) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "quote" $a0sym)) + (then + (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "quasiquote" $a0sym)) + (then + (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + + ;; if we have already been here via TCO, release previous ast + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "defmacro!" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $f ($EVAL $a2 $env)) + (local.set $res ($MALFUNC ($MEM_VAL0_ptr $f) + ($MEM_VAL1_ptr $f) ($MEM_VAL2_ptr $f))) + ($SET_TYPE $res (global.get $MACRO_T)) + (br_if $EVAL_return (global.get $error_type)) + ($RELEASE $f) + + ;; set a1 in env to a2 + (drop ($ENV_SET $env $a1 $res)) + (br $EVAL_return)) + ) + (if (i32.eqz ($strcmp "try*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + ;; if there is no error, return + (br_if $EVAL_return (i32.eqz (global.get $error_type))) + ;; if there is an error and res is set, we need to free it + ($RELEASE $res) + ;; if there is no catch block then return + (br_if $EVAL_return + (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + + ;; save the current environment for release + (local.set $prev_env $env) + ;; create environment for the catch block eval + (local.set $env ($ENV_NEW $env)) + + ;; set a1 and a2 from the catch block + (local.set $a1 ($MAL_GET_A1 ($MAL_GET_A2 $ast))) + (local.set $a2 ($MAL_GET_A2 ($MAL_GET_A2 $ast))) + + ;; create object for string errors + (if (i32.eq (global.get $error_type) 1) + (then + (local.set $err ($STRING (global.get $STRING_T) + (global.get $error_str)))) + (else + (local.set $err (global.get $error_val)))) + ;; bind the catch symbol to the error object + (drop ($ENV_SET $env $a1 $err)) + ;; release our use, env took ownership + ($RELEASE $err) + + ;; unset error for catch eval + (global.set $error_type 0) + (i32.store (global.get $error_str) (CHR "\x00")) + + ;; release previous environment if not the current EVAL env + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + (local.set $ast $a2) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $res ($EVAL $a1 $env)) + + (if (global.get $error_type) + (then (nop)) + (else (if (OR (i32.eq $res (global.get $NIL)) + (i32.eq $res (global.get $FALSE))) + (then + ($RELEASE $res) + ;; if no false case (A3), return nil + (if (i32.lt_u ($COUNT $ast) 4) + (then + (local.set $res ($INC_REF (global.get $NIL))) + (br $EVAL_return)) + (else + (local.set $ast ($MAL_GET_A3 $ast))))) + (else + ($RELEASE $res) + (local.set $ast ($MAL_GET_A2 $ast)))))) + (br $TCO_loop)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) + (then + (local.set $a1 ($MAL_GET_A1 $ast)) + (local.set $a2 ($MAL_GET_A2 $ast)) + (local.set $res ($MALFUNC $a2 $a1 $env)) + (br $EVAL_return)) + ) + ;; EVAL_INVOKE + + ;; Evaluate the first element to find a function or macro. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + (if (i32.eq $ftype (global.get $MACRO_T)) + (then + (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) + ($RELEASE $f) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + (br $TCO_loop))) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) + ;; if error, return f/args for release by caller + (if (global.get $error_type) + (then + (local.set $res $f) + ($RELEASE $args) + (br $EVAL_return))) + + (if (i32.eq $ftype (global.get $FUNCTION_T)) + (then + (if (i32.eq ($VAL0 $f) 0) ;; eval + (then + (local.set $res ($EVAL ($MEM_VAL1_ptr $args) + (global.get $repl_env)))) + (else + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) + (then + ;; save the current environment for release + (local.set $prev_env $env) + ;; create new environment using env and params stored in function + (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) + ($MEM_VAL1_ptr $f) $args)) + + ;; release previous environment if not the current EVAL env + ;; because our new env refers to it and we no longer need to + ;; track it (since we are TCO recurring) + (if (i32.ne $prev_env $orig_env) + (then + ($RELEASE $prev_env) + (local.set $prev_env 0))) + + ;; claim the AST before releasing the list containing it + (local.set $ast ($MEM_VAL0_ptr $f)) + (drop ($INC_REF $ast)) + + ;; if we have already been here via TCO, release previous + ;; ast + ;; PEND_A_LV + (if $prev_ast ($RELEASE $prev_ast)) + (local.set $prev_ast $ast) + + ;; release f/args + ($RELEASE $f) + ($RELEASE $args) + + (br $TCO_loop)) + ) + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + (local.set $res 0) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) + + ) ;; end of TCO_loop + ) ;; end of EVAL_return + + ;; EVAL_RETURN + (if (i32.ne $env $orig_env) ($RELEASE $env)) + (if $prev_ast ($RELEASE $prev_ast)) + + $res + ) + + ;; PRINT + (func $PRINT (param $ast i32) (result i32) + ($pr_str $ast 1) + ) + + ;; REPL + (func $RE (param $line i32 $env i32) (result i32) + (LET $mv1 0 $res 0) + (block $done + (local.set $mv1 ($READ $line)) + (br_if $done (global.get $error_type)) + + (local.set $res ($EVAL $mv1 $env)) + ) + + ;; release memory from MAL_READ + ($RELEASE $mv1) + $res + ) + + (func $REP (param $line i32 $env i32) (result i32) + (LET $mv2 0 $ms 0) + (block $done + (local.set $mv2 ($RE $line $env)) + (br_if $done (global.get $error_type)) + +;; ($PR_MEMORY -1 -1) + (local.set $ms ($PRINT $mv2)) + ) + + ;; release memory from RE + ($RELEASE $mv2) + $ms + ) + + (func $main (param $argc i32 $argv i32) (result i32) + (LET $line (STATIC_ARRAY 201) + $res 0 $repl_env 0 $ms 0 + ;; argument processing + $i 0 $ret 0 $empty 0 $current 0 $val2 0) + + ;; DEBUG +;; ($printf_1 "argc: 0x%x\n" $argc) +;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) +;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) +;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) +;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) +;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) + (global.set $repl_env ($ENV_NEW (global.get $NIL))) + (local.set $repl_env (global.get $repl_env)) + + ;; core.EXT: defined in wasm + ($add_core_ns $repl_env) + (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) + + ($checkpoint_user_memory) + + ;; core.mal: defined using the language itself + ($RELEASE ($RE "(def! *host-language* \"WebAssembly\")" $repl_env)) + ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) + ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) + ($RELEASE ($RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env)) + + ;; Command line arguments + (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) + ;; push MAP_LOP stack + ;; empty = current = ret = res + (local.set $ret $res) + (local.set $current $res) + (local.set $empty $res) + + (local.set $i 2) + (block $done + (loop $loop + (br_if $done (i32.ge_u $i $argc)) + + (local.set $val2 ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv (i32.mul $i 4))))) + + ;; MAP_LOOP_UPDATE + (local.set $res ($MAP_LOOP_UPDATE + (global.get $LIST_T) $empty $current $val2 0)) + (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) + ;; if first element, set return to new element + (local.set $ret $res)) + ;; update current to point to new element + (local.set $current $res) + + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) + + + ;;($PR_MEMORY -1 -1) + + (if (i32.gt_u $argc 1) + (then + (drop ($ENV_SET_S $repl_env + "*FILE*" ($STRING (global.get $STRING_T) + (i32.load (i32.add $argv 4))))) + ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) + (if (global.get $error_type) + (then + ($printf_1 "Error: %s\n" (global.get $error_str)) + (return 1)) + (else + (return 0))))) + + ($RELEASE ($RE "(println (str \"Mal [\" *host-language* \"]\"))" $repl_env)) + + ;; Start REPL + (block $repl_done + (loop $repl_loop + (br_if $repl_done (i32.eqz ($readline "user> " $line))) + (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) + (local.set $res ($REP $line $repl_env)) + (if (global.get $error_type) + (then + (if (i32.eq 2 (global.get $error_type)) + (then + (local.set $ms ($pr_str (global.get $error_val) 1)) + ($printf_1 "Error: %s\n" ($to_String $ms)) + ($RELEASE $ms) + ($RELEASE (global.get $error_val))) + (else + ($printf_1 "Error: %s\n" (global.get $error_str)))) + (global.set $error_type 0)) + (else + ($printf_1 "%s\n" ($to_String $res)))) + ($RELEASE $res) + ;;($PR_MEMORY_SUMMARY_SMALL) + (br $repl_loop) + ) + ) + + ($print "\n") + ;;($PR_MEMORY -1 -1) + 0 + ) + +) + diff --git a/impls/wasm/string.wam b/impls/wasm/string.wam new file mode 100644 index 0000000000..25b6ed094d --- /dev/null +++ b/impls/wasm/string.wam @@ -0,0 +1,215 @@ +(module $string + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;; Copy len bytes from src to dst + ;; Returns len + (func $memmove (param $dst i32 $src i32 $len i32) + (LET $idx 0) + (loop $copy + (i32.store8 (i32.add $idx $dst) + (i32.load8_u (i32.add $idx $src))) + (local.set $idx (i32.add 1 $idx)) + (br_if $copy (i32.lt_u $idx $len)) + ) + ) + + (func $strlen (param $str i32) (result i32) + (LET $cur $str) + (loop $count + (if (i32.ne 0 (i32.load8_u $cur)) + (then + (local.set $cur (i32.add $cur 1)) + (br $count))) + ) + (i32.sub $cur $str) + ) + + ;; Based on https://stackoverflow.com/a/25705264/471795 + ;; This could be made much more efficient + (func $strstr (param $haystack i32 $needle i32) (result i32) + (LET $i 0 + $needle_len ($strlen $needle) + $len ($strlen $haystack)) + + (if (i32.eq $needle_len 0) (return $haystack)) + + (local.set $i 0) + (block $done + (loop $loop + (if (i32.gt_s $i (i32.sub $len $needle_len)) (br $done)) + + (if (AND (i32.eq (i32.load8_u $haystack) + (i32.load8_u $needle)) + (i32.eqz ($strncmp $haystack $needle $needle_len))) + (return $haystack)) + (local.set $haystack (i32.add $haystack 1)) + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + 0 + ) + + (func $atoi (param $str i32) (result i32) + (LET $acc 0 + $i 0 + $neg 0 + $ch 0) + (block $done + (loop $loop + (local.set $ch (i32.load8_u (i32.add $str $i))) + (if (AND (i32.ne $ch (CHR "-")) + (OR (i32.lt_u $ch (CHR "0")) + (i32.gt_u $ch (CHR "9")))) + (br $done)) + (local.set $i (i32.add $i 1)) + (if (i32.eq $ch (CHR "-")) + (then + (local.set $neg 1)) + (else + (local.set $acc (i32.add (i32.mul $acc 10) + (i32.sub $ch (CHR "0")))))) + (br $loop) + ) + ) + (if (result i32) $neg + (then (i32.sub 0 $acc)) + (else $acc)) + ) + + (func $strcmp (param $s1 i32 $s2 i32) (result i32) + (block $done + (loop $loop + (if (OR (i32.eqz (i32.load8_u $s1)) (i32.eqz (i32.load8_u $s2))) + (br $done)) + (if (i32.ne (i32.load8_u $s1) (i32.load8_u $s2)) + (br $done)) + (local.set $s1 (i32.add $s1 1)) + (local.set $s2 (i32.add $s2 1)) + (br $loop) + ) + ) + (if (result i32) (i32.eq (i32.load8_u $s1) (i32.load8_u $s2)) + (then 0) + (else + (if (result i32) (i32.lt_u (i32.load8_u $s1) (i32.load8_u $s2)) + (then -1) + (else 1)))) + ) + + (func $strncmp (param $s1 i32 $s2 i32 $len i32) (result i32) + (LET $i 0) + (if (i32.eq $len 0) (return 0)) + (block $done + (loop $loop + (if (i32.ge_u $i $len) (br $done)) + (if (i32.eqz (i32.load8_u (i32.add $i $s1))) (br $done)) + (if (i32.ne (i32.load8_u (i32.add $i $s1)) + (i32.load8_u (i32.add $i $s2))) (br $done)) + (local.set $i (i32.add $i 1)) + (br $loop) + ) + ) + (if (OR (i32.eq $i $len) + (i32.eq (i32.load8_u (i32.add $i $s1)) + (i32.load8_u (i32.add $i $s2)))) + (return 0)) + (if (result i32) (i32.lt_u (i32.load8_u (i32.add $i $s1)) + (i32.load8_u (i32.add $i $s2))) + (then -1) + (else 1)) + ) + + ;; Writes new string to grass with all needles in haystack replaced. + ;; If the length of replace is equal to of less than needle then + ;; grass can be NULL. + ;; Returns length of grass. + (func $REPLACE3 (param $grass i32 $haystack i32 + $needle0 i32 $replace0 i32 + $needle1 i32 $replace1 i32 + $needle2 i32 $replace2 i32) (result i32) + (LET $haystack_len ($strlen $haystack) + $src_str $haystack + $dst_str $grass + $s 0 $found_tmp 0 $found 0 + $needle 0 $replace 0 $needle_len 0 $replace_len 0 + $replace_s 0 $replace_len_s 0 $needle_len_s 0) + + ;; in-place + (if (i32.eqz $grass) + (then + ;; check that we aren't expanding in place + (local.set $s 0) + (block $done + (loop $loop + (if (i32.ge_u $s 3) (br $done)) + (local.set $needle (if (result i32) (i32.eq $s 0) $needle0 + (if (result i32) (i32.eq $s 1) $needle1 + $needle2))) + (local.set $replace (if (result i32) (i32.eq $s 0) $replace0 + (if (result i32) (i32.eq $s 1) $replace1 + $replace2))) + (local.set $needle_len ($strlen $needle)) + (local.set $replace_len ($strlen $replace)) + (if (i32.gt_u $replace_len $needle_len) + ($fatal 7 "REPLACE: invalid expanding in-place call\n")) + (local.set $s (i32.add $s 1)) + (br $loop) + ) + ) + (local.set $grass $haystack) + (local.set $dst_str $grass))) + + (block $done1 + (loop $loop1 + (if (i32.ge_s (i32.sub $src_str $haystack) $haystack_len) + (br $done1)) + + ;; Find the earliest match + (local.set $found 0) + (local.set $s 0) + (block $done2 + (loop $loop2 + (if (i32.ge_u $s 3) (br $done2)) + (local.set $needle (if (result i32) (i32.eq $s 0) $needle0 + (if (result i32) (i32.eq $s 1) $needle1 + $needle2))) + (local.set $replace (if (result i32) (i32.eq $s 0) $replace0 + (if (result i32) (i32.eq $s 1) $replace1 + $replace2))) + (local.set $s (i32.add $s 1)) + (local.set $found_tmp ($strstr $src_str $needle)) + (if (i32.eqz $found_tmp) (br $loop2)) + (if (OR (i32.eqz $found) (i32.lt_s $found_tmp $found)) + (then + (local.set $found $found_tmp) + (local.set $needle_len_s ($strlen $needle)) + (local.set $replace_s $replace) + (local.set $replace_len_s ($strlen $replace)))) + (br $loop2) + ) + ) + (if (i32.eqz $found) (br $done1)) + ;; copy before the match + ($memmove $dst_str $src_str (i32.add (i32.sub $found $src_str) 1)) + (local.set $dst_str (i32.add $dst_str (i32.sub $found $src_str))) + ;; add the replace string + ($memmove $dst_str $replace_s (i32.add $replace_len_s 1)) + (local.set $dst_str (i32.add $dst_str $replace_len_s)) + ;; Move to after the match + (local.set $src_str (i32.add $found $needle_len_s)) + (br $loop1) + ) + ) + + ;; Copy the left-over + ($memmove $dst_str $src_str ($strlen $src_str)) + (local.set $dst_str (i32.add $dst_str ($strlen $src_str))) + (i32.store8 $dst_str (CHR "\x00")) + + (i32.sub $dst_str $grass) + ) + +) + diff --git a/impls/wasm/types.wam b/impls/wasm/types.wam new file mode 100644 index 0000000000..280fc0eb7a --- /dev/null +++ b/impls/wasm/types.wam @@ -0,0 +1,417 @@ +;; Mal value memory layout +;; type words +;; ---------- ---------- +;; nil ref/ 0 | 0 | | +;; false ref/ 1 | 0 | | +;; true ref/ 1 | 1 | | +;; integer ref/ 2 | int | | +;; float ref/ 3 | ??? | | +;; string/kw ref/ 4 | string ptr | | +;; symbol ref/ 5 | string ptr | | +;; list ref/ 6 | next mem idx | val mem idx | +;; vector ref/ 7 | next mem idx | val mem idx | +;; hashmap ref/ 8 | next mem idx | key mem idx | val mem idx +;; function ref/ 9 | fn idx | | +;; mal function ref/10 | body mem idx | param mem idx | env mem idx +;; macro fn ref/11 | body mem idx | param mem idx | env mem idx +;; atom ref/12 | val mem idx | | +;; environment ref/13 | hmap mem idx | outer mem idx | +;; metadata ref/14 | obj mem idx | meta mem idx | +;; FREE sz/15 | next mem idx | | + +(module $types + + (global $NIL_T i32 0) + (global $BOOLEAN_T i32 1) + (global $INTEGER_T i32 2) + (global $FLOAT_T i32 3) + (global $STRING_T i32 4) + (global $SYMBOL_T i32 5) + (global $LIST_T i32 6) + (global $VECTOR_T i32 7) + (global $HASHMAP_T i32 8) + (global $FUNCTION_T i32 9) + (global $MALFUNC_T i32 10) + (global $MACRO_T i32 11) + (global $ATOM_T i32 12) + (global $ENVIRONMENT_T i32 13) + (global $METADATA_T i32 14) + (global $FREE_T i32 15) + + (global $error_type (mut i32) 0) + (global $error_val (mut i32) 0) + ;; Index into static string memory (static.wast) + (global $error_str (mut i32) 0) + + (global $NIL (mut i32) 0) + (global $FALSE (mut i32) 0) + (global $TRUE (mut i32) 0) + (global $EMPTY_LIST (mut i32) 0) + (global $EMPTY_VECTOR (mut i32) 0) + (global $EMPTY_HASHMAP (mut i32) 0) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; General functions + + (func $INC_REF (param $mv i32) (result i32) + (i32.store $mv (i32.add (i32.load $mv) 32)) + $mv + ) + + (func $TRUE_FALSE (param $val i32) (result i32) + ($INC_REF (if (result i32) $val (global.get $TRUE) (global.get $FALSE))) + ) + + (func $THROW_STR_0 (param $fmt i32) + (drop ($sprintf_1 (global.get $error_str) $fmt "")) + (global.set $error_type 1) + ) + + (func $THROW_STR_1 (param $fmt i32) (param $v0 i32) + (drop ($sprintf_1 (global.get $error_str) $fmt $v0)) + (global.set $error_type 1) + ) + + (func $EQUAL_Q (param $a i32 $b i32) (result i32) + (LET $ta ($TYPE $a) + $tb ($TYPE $b)) + + (if (AND (OR (i32.eq $ta (global.get $LIST_T)) + (i32.eq $ta (global.get $VECTOR_T))) + (OR (i32.eq $tb (global.get $LIST_T)) + (i32.eq $tb (global.get $VECTOR_T)))) + (then + ;; EQUAL_Q_SEQ + (block $done + (loop $loop + (if (OR (i32.eq ($VAL0 $a) 0) (i32.eq ($VAL0 $b) 0)) + (br $done)) + (if ($EQUAL_Q ($MEM_VAL1_ptr $a) ($MEM_VAL1_ptr $b)) + (then + (local.set $a ($MEM_VAL0_ptr $a)) + (local.set $b ($MEM_VAL0_ptr $b))) + (else + (return 0))) + (br $loop) + ) + ) + (return (AND (i32.eq ($VAL0 $a) 0) (i32.eq ($VAL0 $b) 0)))) + (else (if (AND (i32.eq $ta (global.get $HASHMAP_T)) + (i32.eq $tb (global.get $HASHMAP_T))) + ;; EQUAL_Q_HM + (then (return 1)) + ;; TODO: remove this once strings are interned + (else (if (OR (AND (i32.eq $ta (global.get $STRING_T)) + (i32.eq $tb (global.get $STRING_T))) + (AND (i32.eq $ta (global.get $SYMBOL_T)) + (i32.eq $tb (global.get $SYMBOL_T)))) + (then (return (i32.eqz ($strcmp ($to_String $a) ($to_String $b))))) + (else + (return (AND (i32.eq $ta $tb) + (i32.eq ($VAL0 $a) ($VAL0 $b)))))))))) + 0 ;; not reachable + ) + + (func $DEREF_META (param $mv i32) (result i32) + (loop $loop + (if (i32.eq ($TYPE $mv) (global.get $METADATA_T)) + (then + (local.set $mv ($MEM_VAL0_ptr $mv)) + (br $loop))) + ) + $mv + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; string functions + + (func $to_MalString (param $mv i32) (result i32) + ;; TODO: assert mv is a string/keyword/symbol + (i32.add (global.get $string_mem) ($VAL0 $mv)) + ) + + (func $to_String (param $mv i32) (result i32) + ;; skip string refcnt and size + (i32.add 4 ($to_MalString $mv)) + ) + + ;; Duplicate regular character array string into a Mal string and + ;; return the MalVal pointer + (func $STRING (param $type i32 $str i32) (result i32) + (LET $ms ($ALLOC_STRING $str ($strlen $str) 1)) + ($ALLOC_SCALAR $type (i32.sub $ms (global.get $string_mem))) + ) + + ;; Find first duplicate (internet) of mv. If one is found, free up + ;; mv and return the interned version. If no duplicate is found, + ;; return NULL. + (func $INTERN_STRING (param $mv i32) (result i32) + (LET $res 0 + $ms ($to_MalString $mv) + $existing_ms ($FIND_STRING (i32.add $ms 4)) + $tmp 0) + (if (AND $existing_ms (i32.lt_s $existing_ms $ms)) + (then + (local.set $tmp $mv) + (local.set $res ($ALLOC_SCALAR (global.get $STRING_T) + (i32.sub $existing_ms + (global.get $string_mem)))) + (i32.store16 $existing_ms (i32.add (i32.load16_u $existing_ms) 1)) + ($RELEASE $tmp))) + $res + ) + + (func $STRING_INIT (param $type i32) (result i32) + (LET $ms ($ALLOC_STRING "" 0 0)) + ($ALLOC_SCALAR $type (i32.sub $ms (global.get $string_mem))) + ) + + (func $STRING_FINALIZE (param $mv i32 $size i32) (result i32) + ;; Check if the new string can be interned. + (LET $tmp ($INTERN_STRING $mv) + $ms ($to_MalString $mv)) + (if $tmp + (then + (local.set $mv $tmp)) + (else + ;;; ms->size = sizeof(MalString) + size + 1 + (i32.store16 (i32.add $ms 2) + (i32.add (i32.add 4 $size) 1)) + ;;; string_mem_next = (void *)ms + ms->size + (global.set $string_mem_next + (i32.add $ms (i32.load16_u (i32.add $ms 2)))))) + $mv + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; numeric functions + + (func $INTEGER (param $val i32) (result i32) + ($ALLOC_SCALAR (global.get $INTEGER_T) $val) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; sequence functions + + (func $MAP_LOOP_START (param $type i32) (result i32) + (LET $res (if (result i32) (i32.eq $type (global.get $LIST_T)) + (then (global.get $EMPTY_LIST)) + (else (if (result i32) (i32.eq $type (global.get $VECTOR_T)) + (then (global.get $EMPTY_VECTOR)) + (else (if (result i32) (i32.eq $type (global.get $HASHMAP_T)) + (then (global.get $EMPTY_HASHMAP)) + (else + ($THROW_STR_1 "read_seq invalid type %d" $type) + 0))))))) + + ($INC_REF $res) + ) + + (func $MAP_LOOP_UPDATE (param $type i32) (param $empty i32) + (param $current i32) (param $val2 i32) (param $val3 i32) + (result i32) + (LET $res ($ALLOC $type $empty $val2 $val3)) + + ;; sequence took ownership + ($RELEASE $empty) + ($RELEASE $val2) + (if (i32.eq $type (global.get $HASHMAP_T)) + ($RELEASE $val3)) + (if (i32.gt_u $current (global.get $EMPTY_HASHMAP)) + ;; if not first element, set current next to point to new element + (i32.store ($VAL0_ptr $current) ($IDX $res))) + + $res + ) + + (func $FORCE_SEQ_TYPE (param $type i32) (param $mv i32) (result i32) + (LET $res 0) + ;; if it's already the right type, inc ref cnt and return it + (if (i32.eq $type ($TYPE $mv)) (return ($INC_REF $mv))) + ;; if it's empty, return the sequence match + (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) + (return ($MAP_LOOP_START $type))) + ;; otherwise, copy first element to turn it into correct type + ($ALLOC $type ($MEM_VAL0_ptr $mv) ($MEM_VAL1_ptr $mv) 0) + ) + + (func $LIST (param $seq i32 $first i32) (result i32) + ($ALLOC (global.get $LIST_T) $seq $first 0) + ) + + (func $LIST2 (param $first i32 $second i32) (result i32) + ;; last element is empty list + (LET $tmp ($LIST (global.get $EMPTY_LIST) $second) + $res ($LIST $tmp $first)) + ($RELEASE $tmp) ;; new list takes ownership of previous + $res + ) + + (func $LIST3 (param $first i32 $second i32 $third i32) (result i32) + (LET $tmp ($LIST2 $second $third) + $res ($LIST $tmp $first)) + ($RELEASE $tmp) ;; new list takes ownership of previous + $res + ) + + (func $LIST_Q (param $mv i32) (result i32) + (i32.eq ($TYPE $mv) (global.get $LIST_T)) + ) + + (func $EMPTY_Q (param $mv i32) (result i32) + (i32.eq ($VAL0 $mv) 0) + ) + + (func $COUNT (param $mv i32) (result i32) + (LET $cnt 0) + (block $done + (loop $loop + (if (i32.eq ($VAL0 $mv) 0) (br $done)) + (local.set $cnt (i32.add $cnt 1)) + (local.set $mv ($MEM_VAL0_ptr $mv)) + (br $loop) + ) + ) + $cnt + ) + + (func $LAST (param $mv i32) (result i32) + (LET $cur 0) + ;; TODO: check that actually a list/vector + (if (i32.eq ($VAL0 $mv) 0) + ;; empty seq, return nil + (return ($INC_REF (global.get $NIL)))) + (block $done + (loop $loop + ;; end, return previous value + (if (i32.eq ($VAL0 $mv) 0) (br $done)) + ;; current becomes previous entry + (local.set $cur $mv) + ;; next entry + (local.set $mv ($MEM_VAL0_ptr $mv)) + (br $loop) + ) + ) + ($INC_REF ($MEM_VAL1_ptr $cur)) + ) + + ;; make a copy of sequence seq from index start to end + ;; set last to last element of slice before the empty + ;; set after to element following slice (or original) + (func $SLICE (param $seq i32) (param $start i32) (param $end i32) + (result i64) + (LET $idx 0 + $res ($INC_REF (global.get $EMPTY_LIST)) + $last 0 + $tmp $res) + ;; advance seq to start + (block $done + (loop $loop + (if (OR (i32.ge_s $idx $start) + (i32.eqz ($VAL0 $seq))) + (br $done)) + (local.set $seq ($MEM_VAL0_ptr $seq)) + (local.set $idx (i32.add $idx 1)) + (br $loop) + ) + ) + (block $done + (loop $loop + ;; if current position is at end, then return or if we reached + ;; end seq, then return + (if (OR (AND (i32.ne $end -1) + (i32.ge_s $idx $end)) + (i32.eqz ($VAL0 $seq))) + (then + (local.set $res $tmp) + (br $done))) + ;; allocate new list element with copied value + (local.set $res ($LIST (global.get $EMPTY_LIST) + ($MEM_VAL1_ptr $seq))) + ;; sequence took ownership + ($RELEASE (global.get $EMPTY_LIST)) + (if (i32.eqz $last) + (then + ;; if first element, set return value to new element + (local.set $tmp $res)) + (else + ;; if not the first element, set return value to new element + (i32.store ($VAL0_ptr $last) ($IDX $res)))) + (local.set $last $res) ;; update last list element + ;; advance to next element of seq + (local.set $seq ($MEM_VAL0_ptr $seq)) + (local.set $idx (i32.add $idx 1)) + (br $loop) + ) + ) + + ;; combine last/res as hi 32/low 32 of i64 + (i64.or + (i64.shl (i64.extend_i32_u $last) (i64.const 32)) + (i64.extend_i32_u $res)) + ) + + (func $HASHMAP (result i32) + ;; just point to static empty hash-map + ($INC_REF (global.get $EMPTY_HASHMAP)) + ) + + (func $ASSOC1 (param $hm i32 $k i32 $v i32) (result i32) + (LET $res ($ALLOC (global.get $HASHMAP_T) $hm $k $v)) + ;; we took ownership of previous release + ($RELEASE $hm) + $res + ) + + (func $ASSOC1_S (param $hm i32 $k i32 $v i32) (result i32) + (LET $kmv ($STRING (global.get $STRING_T) $k) + $res ($ASSOC1 $hm $kmv $v)) + ;; map took ownership of key + ($RELEASE $kmv) + $res + ) + + (func $HASHMAP_GET (param $hm i32) (param $key_mv i32) (result i64) + (LET $key ($to_String $key_mv) + $found 0 + $res 0 + $test_key_mv 0) + + (block $done + (loop $loop + ;;; if (VAL0(hm) == 0) + (if (i32.eq ($VAL0 $hm) 0) + (then + (local.set $res (global.get $NIL)) + (br $done))) + ;;; test_key_mv = MEM_VAL1(hm) + (local.set $test_key_mv ($MEM_VAL1_ptr $hm)) + ;;; if (strcmp(key, to_String(test_key_mv)) == 0) + (if (i32.eq ($strcmp $key ($to_String $test_key_mv)) 0) + (then + (local.set $found 1) + (local.set $res ($MEM_VAL2_ptr $hm)) + (br $done))) + (local.set $hm ($MEM_VAL0_ptr $hm)) + + (br $loop) + ) + ) + + ;; combine found/res as hi 32/low 32 of i64 + (i64.or (i64.shl (i64.extend_i32_u $found) (i64.const 32)) + (i64.extend_i32_u $res)) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; function functions + + (func $FUNCTION (param $index i32) (result i32) + ($ALLOC_SCALAR (global.get $FUNCTION_T) $index) + ) + + (func $MALFUNC (param $ast i32 $params i32 $env i32) (result i32) + ($ALLOC (global.get $MALFUNC_T) $ast $params $env) + ) + +) diff --git a/impls/wren/Dockerfile b/impls/wren/Dockerfile new file mode 100644 index 0000000000..a2d5a9869d --- /dev/null +++ b/impls/wren/Dockerfile @@ -0,0 +1,33 @@ +FROM ubuntu:18.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install g++ +RUN apt-get -y install git + +COPY wren-add-gettimeofday.patch /tmp/ +RUN cd /tmp && git clone --depth=1 https://github.com/wren-lang/wren.git \ + && cd wren \ + && patch -p1 < /tmp/wren-add-gettimeofday.patch \ + && make \ + && cp ./wren /usr/local/bin/ \ + && cd /tmp && rm -rf wren diff --git a/impls/wren/Makefile b/impls/wren/Makefile new file mode 100644 index 0000000000..5a9fe99bf1 --- /dev/null +++ b/impls/wren/Makefile @@ -0,0 +1,19 @@ +SOURCES = types.wren env.wren printer.wren reader.wren readline.wren interop.wren core.wren stepA_mal.wren + +all: + true + +dist: mal + +mal.wren: $(SOURCES) + cat $+ | grep -v '^import "./' > $@ + +mal: mal.wren + echo "#!/usr/bin/env wren" > $@ + cat $< >> $@ + chmod +x $@ + +.PHONY: clean + +clean: + rm -f mal.wren mal diff --git a/impls/wren/README.md b/impls/wren/README.md new file mode 100644 index 0000000000..fafcd275db --- /dev/null +++ b/impls/wren/README.md @@ -0,0 +1,15 @@ +# Wren implementation + +### Adding a time function + +Since Wren doesn't have a time function, we add a `System.gettimeofday` +function which returns a float with the number of seconds since epoch (with +fractions of seconds). + +This is done by applying the patch in `wren-add-gettimeofday.path` to Wren's +source code before compiling it (see `Dockerfile`). + +### Wren interop + +See examples in `tests/stepA_mal.mal` for usage of `wren-eval` to evaluate Wren +expressions inside a Mal program. diff --git a/impls/wren/core.wren b/impls/wren/core.wren new file mode 100644 index 0000000000..5a681ac4ff --- /dev/null +++ b/impls/wren/core.wren @@ -0,0 +1,106 @@ +import "io" for File +import "./reader" for MalReader +import "./readline" for Readline +import "./printer" for Printer +import "./types" for MalVal, MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalAtom, MalException +import "./interop" for Interop + +class Core { + static fn(func) { MalNativeFn.new(func) } + static ns { + return { + "=": fn { |a| a[0] == a[1] }, + "throw": fn { |a| + MalException.set(a[0]) + Fiber.abort("___MalException___") + }, + + "nil?": fn { |a| a[0] == null }, + "true?": fn { |a| a[0] == true }, + "false?": fn { |a| a[0] == false }, + "string?": fn { |a| a[0] is String && !MalVal.isKeyword(a[0]) }, + "symbol": fn { |a| a[0] is MalSymbol ? a[0] : MalSymbol.new(a[0]) }, + "symbol?": fn { |a| a[0] is MalSymbol }, + "keyword": fn { |a| MalVal.isKeyword(a[0]) ? a[0] : MalVal.newKeyword(a[0]) }, + "keyword?": fn { |a| MalVal.isKeyword(a[0]) }, + "number?": fn { |a| a[0] is Num }, + "fn?": fn { |a| a[0] is MalNativeFn || (a[0] is MalFn && !a[0].isMacro) }, + "macro?": fn { |a| a[0] is MalFn && a[0].isMacro }, + + "pr-str": fn { |a| a.map { |e| Printer.pr_str(e, true) }.join(" ") }, + "str": fn { |a| a.map { |e| Printer.pr_str(e, false) }.join() }, + "prn": fn { |a| + System.print(a.map { |e| Printer.pr_str(e, true) }.join(" ")) + return null + }, + "println": fn { |a| + System.print(a.map { |e| Printer.pr_str(e, false) }.join(" ")) + return null + }, + "read-string": fn { |a| MalReader.read_str(a[0]) }, + "readline": fn { |a| Readline.readLine(a[0]) }, + "slurp": fn { |a| File.read(a[0]) }, + + "<": fn { |a| a[0] < a[1] }, + "<=": fn { |a| a[0] <= a[1] }, + ">": fn { |a| a[0] > a[1] }, + ">=": fn { |a| a[0] >= a[1] }, + "+": fn { |a| a[0] + a[1] }, + "-": fn { |a| a[0] - a[1] }, + "*": fn { |a| a[0] * a[1] }, + "/": fn { |a| a[0] / a[1] }, + "time-ms": fn { |a| (System.gettimeofday * 1000).floor }, + + "list": fn { |a| MalList.new(a) }, + "list?": fn { |a| a[0] is MalList }, + "vector": fn { |a| MalVector.new(a) }, + "vector?": fn { |a| a[0] is MalVector }, + "hash-map": fn { |a| MalMap.fromList(a) }, + "map?": fn { |a| a[0] is MalMap }, + "assoc": fn { |a| a[0].assoc(a[1...a.count]) }, + "dissoc": fn { |a| a[0].dissoc(a[1...a.count]) }, + "get": fn { |a| a[0] == null ? null : a[0].data[a[1]] }, + "contains?": fn { |a| a[0].data.containsKey(a[1]) }, + "keys": fn { |a| MalList.new(a[0].data.keys.toList) }, + "vals": fn { |a| MalList.new(a[0].data.values.toList) }, + + "sequential?": fn { |a| a[0] is MalSequential }, + "cons": fn { |a| MalList.new([a[0]] + a[1].elements) }, + "concat": fn { |a| MalList.new(a.reduce([]) { |acc,e| acc + e.elements }) }, + "vec": fn { |a| MalVector.new(a[0].elements) }, + "nth": fn { |a| a[1] < a[0].count ? a[0][a[1]] : Fiber.abort("nth: index out of range") }, + "first": fn { |a| a[0] == null ? null : a[0].first }, + "rest": fn { |a| a[0] == null ? MalList.new([]) : a[0].rest }, + "empty?": fn { |a| a[0].isEmpty }, + "count": fn { |a| a[0] == null ? 0 : a[0].count }, + "apply": fn { |a| a[0].call(a[1...(a.count - 1)] + a[-1].elements) }, + "map": fn { |a| MalList.new(a[1].elements.map { |e| a[0].call([e]) }.toList) }, + + "conj": fn { |a| + if (a[0] is MalList) return MalList.new(a[-1..1] + a[0].elements) + if (a[0] is MalVector) return MalVector.new(a[0].elements + a[1..-1]) + }, + "seq": fn { |a| + if (a[0] == null) return null + if (a[0].count == 0) return null + if (a[0] is String) return MalList.new(a[0].toList) + if (a[0] is MalVector) return MalList.new(a[0].elements) + return a[0] + }, + + "meta": fn { |a| a[0].meta }, + "with-meta": fn { |a| + var x = a[0].clone() + x.meta = a[1] + return x + }, + "atom": fn { |a| MalAtom.new(a[0]) }, + "atom?": fn { |a| a[0] is MalAtom }, + "deref": fn { |a| a[0].value }, + "reset!": fn { |a| a[0].value = a[1] }, + "swap!": fn { |a| a[0].value = a[1].call([a[0].value] + a[2..-1]) }, + + "wren-eval": fn { |a| Interop.wren_eval(a[0]) } + } + } +} diff --git a/impls/wren/env.wren b/impls/wren/env.wren new file mode 100644 index 0000000000..90af7a3384 --- /dev/null +++ b/impls/wren/env.wren @@ -0,0 +1,40 @@ +import "./types" for MalList + +class Env { + construct new() { + _outer = null + _data = {} + } + construct new(outer) { + _outer = outer + _data = {} + } + construct new(outer, binds, exprs) { + _outer = outer + _data = {} + for (i in 0...binds.count) { + if (binds[i].value == "&") { + _data[binds[i + 1].value] = MalList.new(exprs[i..-1]) + break + } else { + _data[binds[i].value] = exprs[i] + } + } + } + + set(k, v) { _data[k] = v } + + find(k) { + if (_data.containsKey(k)) return this + if (_outer) return _outer.find(k) + return null + } + + get(k) { + var foundEnv = find(k) + if (!foundEnv) Fiber.abort("'%(k)' not found") + return foundEnv.getValue(k) + } + + getValue(k) { _data[k] } +} diff --git a/impls/wren/interop.wren b/impls/wren/interop.wren new file mode 100644 index 0000000000..d61b65498b --- /dev/null +++ b/impls/wren/interop.wren @@ -0,0 +1,23 @@ +import "meta" for Meta +import "./types" for MalList, MalMap + +class Interop { + static wren_eval(str) { + var f = Meta.compileExpression(str) + return f == null ? null : wren2mal(f.call()) + } + + static wren2mal(v) { + if (v == null || v == true || v == false) return v + if (v is Num || v is String) return v + if (v is Map) { + var m = {} + for (e in v) { + m[wren2mal(e.key)] = wren2mal(e.value) + } + return MalMap.new(m) + } + if (v is Sequence) return MalList.new(v.map { |e| wren2mal(e) }.toList) + return null + } +} diff --git a/impls/wren/printer.wren b/impls/wren/printer.wren new file mode 100644 index 0000000000..8dd60877b1 --- /dev/null +++ b/impls/wren/printer.wren @@ -0,0 +1,30 @@ +import "./types" for MalVal, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalAtom + +class Printer { + static joinElements(elements, print_readably) { + return elements.map { |e| pr_str(e, print_readably) }.join(" ") + } + + static joinMapElements(data, print_readably) { + return data.map { |e| pr_str(e.key, print_readably) + " " + pr_str(e.value, print_readably) }.join(" ") + } + + static escape(s) { + return "\"" + s.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") + "\"" + } + + static pr_str(obj) { pr_str(obj, true) } + + static pr_str(obj, print_readably) { + if (obj == null) return "nil" + if (obj is MalList) return "(%(joinElements(obj.elements, print_readably)))" + if (obj is MalVector) return "[%(joinElements(obj.elements, print_readably))]" + if (obj is MalMap) return "{%(joinMapElements(obj.data, print_readably))}" + if (obj is MalNativeFn) return "#" + if (obj is MalFn) return "#" + if (obj is MalAtom) return "(atom %(pr_str(obj.value, print_readably)))" + if (MalVal.isKeyword(obj)) return ":%(obj[1..-1])" + if (obj is String) return print_readably ? escape(obj) : obj + return obj.toString + } +} diff --git a/impls/wren/reader.wren b/impls/wren/reader.wren new file mode 100644 index 0000000000..2442cf9fd9 --- /dev/null +++ b/impls/wren/reader.wren @@ -0,0 +1,170 @@ +import "./types" for MalVal, MalSymbol, MalList, MalVector, MalMap + +class Tokenizer { + construct new(s) { + _s = s + } + + tokenize() { + _pos = 0 + var tokens = [] + while (true) { + var token = nextToken() + if (token == null) break + if (token.count > 0) tokens.add(token) + } + return tokens + } + + static eolChars { "\r\n" } + static whitespace { " ,\r\n\t" } + static delimiters { "[]{}()'`^@" } + static separators { Tokenizer.whitespace + "[]{}()'\"`,;" } + + nextToken() { + if (isEOF()) return null + var ch = curr + if (Tokenizer.whitespace.contains(ch)) { + advance() + return "" + } + if (Tokenizer.delimiters.contains(ch)) { + advance() + return ch + } + if (ch == "~") { + advance() + if (!isEOF() && curr == "@") { + advance() + return "~@" + } else { + return "~" + } + } + if (ch == ";") { + advance() + while (!isEOF() && !Tokenizer.eolChars.contains(curr)) advance() + return "" + } + if (ch == "\"") { + var s = ch + advance() + while (!isEOF() && curr != "\"") { + if (curr == "\\") { + s = s + curr + advance() + if (isEOF()) Fiber.abort("expected '\"', got EOF 111") + } + s = s + curr + advance() + } + if (isEOF()) Fiber.abort("expected '\"', got EOF 222") + s = s + curr + advance() + return s + } + var token = ch + advance() + while (!isEOF() && !Tokenizer.separators.contains(curr)) { + token = token + curr + advance() + } + return token + } + + curr { _s[_pos] } + isEOF() { _pos >= _s.count } + advance() { _pos = _pos + 1 } +} + +class Reader { + construct new(tokens) { + _tokens = tokens + _pos = 0 + } + + next() { + if (_pos >= _tokens.count) return null + var token = _tokens[_pos] + _pos = _pos + 1 + return token + } + + peek() { + if (_pos >= _tokens.count) return null + return _tokens[_pos] + } +} + +class MalReader { + static parse_str(token) { + if (token.count <= 2) return "" + return token[1..-2].replace("\\\\", "\u029e").replace("\\\"", "\"").replace("\\n", "\n").replace("\u029e", "\\") + } + + static is_all_digits(s) { + if (s.count == 0) return false + return s.all { |c| c.bytes[0] >= 0x30 && c.bytes[0] <= 0x39 } + } + + static is_number(token) { + return token.startsWith("-") ? is_all_digits(token[1..-1]) : is_all_digits(token) + } + + static read_atom(rdr) { + var token = rdr.next() + if (is_number(token)) return Num.fromString(token) + if (token.startsWith("\"")) return parse_str(token) + if (token.startsWith(":")) return MalVal.newKeyword(token[1..-1]) + if (token == "nil") return null + if (token == "true") return true + if (token == "false") return false + return MalSymbol.new(token) + } + + static read_seq(rdr, start, end) { + var token = rdr.next() + if (token != start) Fiber.abort("expected '%(start)'") + var elements = [] + token = rdr.peek() + while (token != end) { + if (!token) Fiber.abort("expected '%(end)', got EOF") + elements.add(read_form(rdr)) + token = rdr.peek() + } + rdr.next() + return elements + } + + static reader_macro(rdr, sym) { + rdr.next() + return MalList.new([MalSymbol.new(sym), read_form(rdr)]) + } + + static read_form(rdr) { + var token = rdr.peek() + if (token == "'") return reader_macro(rdr, "quote") + if (token == "`") return reader_macro(rdr, "quasiquote") + if (token == "~") return reader_macro(rdr, "unquote") + if (token == "~@") return reader_macro(rdr, "splice-unquote") + if (token == "^") { + rdr.next() + var meta = read_form(rdr) + return MalList.new([MalSymbol.new("with-meta"), read_form(rdr), meta]) + } + if (token == "@") return reader_macro(rdr, "deref") + if (token == "(") return MalList.new(read_seq(rdr, "(", ")")) + if (token == ")") Fiber.abort("unexpected ')'") + if (token == "[") return MalVector.new(read_seq(rdr, "[", "]")) + if (token == "]") Fiber.abort("unexpected ']'") + if (token == "{") return MalMap.fromList(read_seq(rdr, "{", "}")) + if (token == "}") Fiber.abort("unexpected '}'") + return read_atom(rdr) + } + + static read_str(s) { + var tokens = Tokenizer.new(s).tokenize() + if (tokens.count == 0) return null + return read_form(Reader.new(tokens)) + } +} diff --git a/impls/wren/readline.wren b/impls/wren/readline.wren new file mode 100644 index 0000000000..071a7927ba --- /dev/null +++ b/impls/wren/readline.wren @@ -0,0 +1,14 @@ +import "io" for Stdin, Stdout + +class Readline { + static readLine(prompt) { + var line = null + var fiber = Fiber.new { + System.write(prompt) + Stdout.flush() + line = Stdin.readLine() + } + var error = fiber.try() + return error ? null : line + } +} diff --git a/impls/wren/run b/impls/wren/run new file mode 100755 index 0000000000..8c269bf55a --- /dev/null +++ b/impls/wren/run @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec wren $(dirname $0)/${STEP:-stepA_mal}.wren "${@}" diff --git a/impls/wren/step0_repl.wren b/impls/wren/step0_repl.wren new file mode 100644 index 0000000000..d40ef6a4d4 --- /dev/null +++ b/impls/wren/step0_repl.wren @@ -0,0 +1,30 @@ +import "./readline" for Readline + +class Mal { + static read(str) { + return str + } + + static eval(ast, env) { + return ast + } + + static print(ast) { + return ast + } + + static rep(str) { + return print(eval(read(str), null)) + } + + static main() { + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") System.print(rep(line)) + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step1_read_print.wren b/impls/wren/step1_read_print.wren new file mode 100644 index 0000000000..783a322b06 --- /dev/null +++ b/impls/wren/step1_read_print.wren @@ -0,0 +1,36 @@ +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static eval(ast, env) { + return ast + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), null)) + } + + static main() { + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step2_eval.wren b/impls/wren/step2_eval.wren new file mode 100644 index 0000000000..5dc298261a --- /dev/null +++ b/impls/wren/step2_eval.wren @@ -0,0 +1,66 @@ +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalList, MalVector, MalMap + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static eval(ast, env) { + // System.print("EVAL: %(print(ast))") + + // Process non-list types. + if (ast is MalSymbol) { + if (!env.containsKey(ast.value)) Fiber.abort("'%(ast.value)' not found") + return env[ast.value] + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + if (ast.isEmpty) return ast + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList + var f = evaled_ast[0] + return f.call(evaled_ast[1..-1]) + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = { + "+": Fn.new { |a| a[0] + a[1] }, + "-": Fn.new { |a| a[0] - a[1] }, + "*": Fn.new { |a| a[0] * a[1] }, + "/": Fn.new { |a| a[0] / a[1] } + } + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step3_env.wren b/impls/wren/step3_env.wren new file mode 100644 index 0000000000..ee5da6bc0a --- /dev/null +++ b/impls/wren/step3_env.wren @@ -0,0 +1,81 @@ +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalList, MalVector, MalMap + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static eval(ast, env) { + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + return eval(ast[2], letEnv) + } + } + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList + var f = evaled_ast[0] + return f.call(evaled_ast[1..-1]) + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + __repl_env.set("+", Fn.new { |a| a[0] + a[1] }) + __repl_env.set("-", Fn.new { |a| a[0] - a[1] }) + __repl_env.set("*", Fn.new { |a| a[0] * a[1] }) + __repl_env.set("/", Fn.new { |a| a[0] / a[1] }) + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step4_if_fn_do.wren b/impls/wren/step4_if_fn_do.wren new file mode 100644 index 0000000000..42d972336e --- /dev/null +++ b/impls/wren/step4_if_fn_do.wren @@ -0,0 +1,95 @@ +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalList, MalVector, MalMap +import "./core" for Core + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static eval(ast, env) { + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + return eval(ast[2], letEnv) + } else if (ast[0].value == "do") { + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + return eval(ast[-1], env) + } else if (ast[0].value == "if") { + var condval = eval(ast[1], env) + if (condval) { + return eval(ast[2], env) + } else { + return ast.count > 3 ? eval(ast[3], env) : null + } + } else if (ast[0].value == "fn*") { + return Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) } + } + } + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList + var f = evaled_ast[0] + return f.call(evaled_ast[1..-1]) + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + // core.wren: defined in wren + for (e in Core.ns) { __repl_env.set(e.key, e.value) } + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))") + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step5_tco.wren b/impls/wren/step5_tco.wren new file mode 100644 index 0000000000..6756d31fee --- /dev/null +++ b/impls/wren/step5_tco.wren @@ -0,0 +1,118 @@ +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalList, MalVector, MalMap, MalNativeFn, MalFn +import "./core" for Core + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static eval(ast, env) { + + while (true) { + var tco = false + + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + ast = ast[2] + env = letEnv + tco = true + } else if (ast[0].value == "do") { + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + ast = ast[-1] + tco = true + } else if (ast[0].value == "if") { + var condval = eval(ast[1], env) + if (condval) { + ast = ast[2] + } else { + if (ast.count <= 3) return null + ast = ast[3] + } + tco = true + } else if (ast[0].value == "fn*") { + return MalFn.new(ast[2], ast[1].elements, env, + Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) + } + } + if (!tco) { + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList + var f = evaled_ast[0] + if (f is MalNativeFn) { + return f.call(evaled_ast[1..-1]) + } else if (f is MalFn) { + ast = f.ast + env = Env.new(f.env, f.params, evaled_ast[1..-1]) + tco = true + } else { + Fiber.abort("unknown function type") + } + } + } + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + // core.wren: defined in wren + for (e in Core.ns) { __repl_env.set(e.key, e.value) } + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))") + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step6_file.wren b/impls/wren/step6_file.wren new file mode 100644 index 0000000000..3359de3731 --- /dev/null +++ b/impls/wren/step6_file.wren @@ -0,0 +1,128 @@ +import "os" for Process +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalList, MalVector, MalMap, MalNativeFn, MalFn +import "./core" for Core + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static eval(ast, env) { + + while (true) { + var tco = false + + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + ast = ast[2] + env = letEnv + tco = true + } else if (ast[0].value == "do") { + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + ast = ast[-1] + tco = true + } else if (ast[0].value == "if") { + var condval = eval(ast[1], env) + if (condval) { + ast = ast[2] + } else { + if (ast.count <= 3) return null + ast = ast[3] + } + tco = true + } else if (ast[0].value == "fn*") { + return MalFn.new(ast[2], ast[1].elements, env, + Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) + } + } + if (!tco) { + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList + var f = evaled_ast[0] + if (f is MalNativeFn) { + return f.call(evaled_ast[1..-1]) + } else if (f is MalFn) { + ast = f.ast + env = Env.new(f.env, f.params, evaled_ast[1..-1]) + tco = true + } else { + Fiber.abort("unknown function type") + } + } + } + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + // core.wren: defined in wren + for (e in Core.ns) { __repl_env.set(e.key, e.value) } + __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) + __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + + if (Process.arguments.count > 0) { + rep("(load-file \"%(Process.arguments[0])\")") + return + } + + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step7_quote.wren b/impls/wren/step7_quote.wren new file mode 100644 index 0000000000..95a3c62394 --- /dev/null +++ b/impls/wren/step7_quote.wren @@ -0,0 +1,167 @@ +import "os" for Process +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn +import "./core" for Core + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } + + static quasiquote(ast) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { + return MalList.new([MalSymbol.new("quote"), ast]) + } else { + return ast + } + } + + static eval(ast, env) { + + while (true) { + var tco = false + + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + ast = ast[2] + env = letEnv + tco = true + } else if (ast[0].value == "quote") { + return ast[1] + } else if (ast[0].value == "quasiquote") { + ast = quasiquote(ast[1]) + tco = true + } else if (ast[0].value == "do") { + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + ast = ast[-1] + tco = true + } else if (ast[0].value == "if") { + var condval = eval(ast[1], env) + if (condval) { + ast = ast[2] + } else { + if (ast.count <= 3) return null + ast = ast[3] + } + tco = true + } else if (ast[0].value == "fn*") { + return MalFn.new(ast[2], ast[1].elements, env, + Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) + } + } + if (!tco) { + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList + var f = evaled_ast[0] + if (f is MalNativeFn) { + return f.call(evaled_ast[1..-1]) + } else if (f is MalFn) { + ast = f.ast + env = Env.new(f.env, f.params, evaled_ast[1..-1]) + tco = true + } else { + Fiber.abort("unknown function type") + } + } + } + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + // core.wren: defined in wren + for (e in Core.ns) { __repl_env.set(e.key, e.value) } + __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) + __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + + if (Process.arguments.count > 0) { + rep("(load-file \"%(Process.arguments[0])\")") + return + } + + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step8_macros.wren b/impls/wren/step8_macros.wren new file mode 100644 index 0000000000..5a44a25db4 --- /dev/null +++ b/impls/wren/step8_macros.wren @@ -0,0 +1,174 @@ +import "os" for Process +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn +import "./core" for Core + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } + + static quasiquote(ast) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { + return MalList.new([MalSymbol.new("quote"), ast]) + } else { + return ast + } + } + + static eval(ast, env) { + + while (true) { + var tco = false + + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + ast = ast[2] + env = letEnv + tco = true + } else if (ast[0].value == "quote") { + return ast[1] + } else if (ast[0].value == "quasiquote") { + ast = quasiquote(ast[1]) + tco = true + } else if (ast[0].value == "defmacro!") { + return env.set(ast[1].value, eval(ast[2], env).makeMacro()) + } else if (ast[0].value == "do") { + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + ast = ast[-1] + tco = true + } else if (ast[0].value == "if") { + var condval = eval(ast[1], env) + if (condval) { + ast = ast[2] + } else { + if (ast.count <= 3) return null + ast = ast[3] + } + tco = true + } else if (ast[0].value == "fn*") { + return MalFn.new(ast[2], ast[1].elements, env, + Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) + } + } + if (!tco) { + var f = eval(ast[0], env) + if (f is MalNativeFn) { + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList + return f.call(args) + } else if (f is MalFn) { + if (f.isMacro) { + ast = f.call(ast.elements[1..-1]) + } else { + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList + ast = f.ast + env = Env.new(f.env, f.params, args) + } + } else { + Fiber.abort("unknown function type") + } + } + } + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + // core.wren: defined in wren + for (e in Core.ns) { __repl_env.set(e.key, e.value) } + __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) + __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if (Process.arguments.count > 0) { + rep("(load-file \"%(Process.arguments[0])\")") + return + } + + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + if (fiber.error) System.print("Error: %(fiber.error)") + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/step9_try.wren b/impls/wren/step9_try.wren new file mode 100644 index 0000000000..7997813f9a --- /dev/null +++ b/impls/wren/step9_try.wren @@ -0,0 +1,195 @@ +import "os" for Process +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalException +import "./core" for Core + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } + + static quasiquote(ast) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { + return MalList.new([MalSymbol.new("quote"), ast]) + } else { + return ast + } + } + + static eval(ast, env) { + + while (true) { + var tco = false + + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + ast = ast[2] + env = letEnv + tco = true + } else if (ast[0].value == "quote") { + return ast[1] + } else if (ast[0].value == "quasiquote") { + ast = quasiquote(ast[1]) + tco = true + } else if (ast[0].value == "defmacro!") { + return env.set(ast[1].value, eval(ast[2], env).makeMacro()) + } else if (ast[0].value == "try*") { + if (ast.count > 2 && ast[2][0] is MalSymbol && ast[2][0].value == "catch*") { + var fiber = Fiber.new { eval(ast[1], env) } + var result = fiber.try() + var error = fiber.error + if (!error) return result + if (error == "___MalException___") { + error = MalException.value + MalException.set(null) + } + return eval(ast[2][2], Env.new(env, [ast[2][1]], [error])) + } else { + return eval(ast[1], env) + } + } else if (ast[0].value == "do") { + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + ast = ast[-1] + tco = true + } else if (ast[0].value == "if") { + var condval = eval(ast[1], env) + if (condval) { + ast = ast[2] + } else { + if (ast.count <= 3) return null + ast = ast[3] + } + tco = true + } else if (ast[0].value == "fn*") { + return MalFn.new(ast[2], ast[1].elements, env, + Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) + } + } + if (!tco) { + var f = eval(ast[0], env) + if (f is MalNativeFn) { + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList + return f.call(args) + } else if (f is MalFn) { + if (f.isMacro) { + ast = f.call(ast.elements[1..-1]) + } else { + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList + ast = f.ast + env = Env.new(f.env, f.params, args) + } + } else { + Fiber.abort("unknown function type") + } + } + } + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + // core.wren: defined in wren + for (e in Core.ns) { __repl_env.set(e.key, e.value) } + __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) + __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) + // core.mal: defined using the language itself + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if (Process.arguments.count > 0) { + rep("(load-file \"%(Process.arguments[0])\")") + return + } + + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + var error = fiber.error + if (error) { + if (error == "___MalException___") { + error = Printer.pr_str(MalException.value, false) + MalException.set(null) + } + System.print("Error: %(error)") + } + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/stepA_mal.wren b/impls/wren/stepA_mal.wren new file mode 100644 index 0000000000..0f4945611f --- /dev/null +++ b/impls/wren/stepA_mal.wren @@ -0,0 +1,197 @@ +import "os" for Process +import "./env" for Env +import "./readline" for Readline +import "./reader" for MalReader +import "./printer" for Printer +import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalException +import "./core" for Core + +class Mal { + static read(str) { + return MalReader.read_str(str) + } + + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } + + static quasiquote(ast) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { + return MalList.new([MalSymbol.new("quote"), ast]) + } else { + return ast + } + } + + static eval(ast, env) { + + while (true) { + var tco = false + + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + + // Process non-list types. + if (ast is MalSymbol) { + return env.get(ast.value) + } else if (ast is MalList) { + // The only case leading after this switch. + } else if (ast is MalVector) { + return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) + } else if (ast is MalMap) { + var m = {} + for (e in ast.data) { + m[e.key] = eval(e.value, env) + } + return MalMap.new(m) + } else { + return ast + } + // ast is a list, search for special forms + + if (ast.isEmpty) return ast + if (ast[0] is MalSymbol) { + if (ast[0].value == "def!") { + return env.set(ast[1].value, eval(ast[2], env)) + } else if (ast[0].value == "let*") { + var letEnv = Env.new(env) + var i = 0 + while (i < ast[1].count) { + letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) + i = i + 2 + } + ast = ast[2] + env = letEnv + tco = true + } else if (ast[0].value == "quote") { + return ast[1] + } else if (ast[0].value == "quasiquote") { + ast = quasiquote(ast[1]) + tco = true + } else if (ast[0].value == "defmacro!") { + return env.set(ast[1].value, eval(ast[2], env).makeMacro()) + } else if (ast[0].value == "try*") { + if (ast.count > 2 && ast[2][0] is MalSymbol && ast[2][0].value == "catch*") { + var fiber = Fiber.new { eval(ast[1], env) } + var result = fiber.try() + var error = fiber.error + if (!error) return result + if (error == "___MalException___") { + error = MalException.value + MalException.set(null) + } + return eval(ast[2][2], Env.new(env, [ast[2][1]], [error])) + } else { + return eval(ast[1], env) + } + } else if (ast[0].value == "do") { + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + ast = ast[-1] + tco = true + } else if (ast[0].value == "if") { + var condval = eval(ast[1], env) + if (condval) { + ast = ast[2] + } else { + if (ast.count <= 3) return null + ast = ast[3] + } + tco = true + } else if (ast[0].value == "fn*") { + return MalFn.new(ast[2], ast[1].elements, env, + Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) + } + } + if (!tco) { + var f = eval(ast[0], env) + if (f is MalNativeFn) { + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList + return f.call(args) + } else if (f is MalFn) { + if (f.isMacro) { + ast = f.call(ast.elements[1..-1]) + } else { + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList + ast = f.ast + env = Env.new(f.env, f.params, args) + } + } else { + Fiber.abort("unknown function type") + } + } + } + } + + static print(ast) { + return Printer.pr_str(ast) + } + + static rep(str) { + return print(eval(read(str), __repl_env)) + } + + static main() { + __repl_env = Env.new() + // core.wren: defined in wren + for (e in Core.ns) { __repl_env.set(e.key, e.value) } + __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) + __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) + // core.mal: defined using the language itself + rep("(def! *host-language* \"wren\")") + rep("(def! not (fn* (a) (if a false true)))") + rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") + rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") + + if (Process.arguments.count > 0) { + rep("(load-file \"%(Process.arguments[0])\")") + return + } + + rep("(println (str \"Mal [\" *host-language* \"]\"))") + while (true) { + var line = Readline.readLine("user> ") + if (line == null) break + if (line != "") { + var fiber = Fiber.new { System.print(rep(line)) } + fiber.try() + var error = fiber.error + if (error) { + if (error == "___MalException___") { + error = Printer.pr_str(MalException.value, false) + MalException.set(null) + } + System.print("Error: %(error)") + } + } + } + System.print() + } +} + +Mal.main() diff --git a/impls/wren/tests/step5_tco.mal b/impls/wren/tests/step5_tco.mal new file mode 100644 index 0000000000..2d44ede154 --- /dev/null +++ b/impls/wren/tests/step5_tco.mal @@ -0,0 +1,2 @@ +;; Wren: skipping non-TCO recursion +;; Reason: completes up to 1,000,000 (with extended timeout) diff --git a/impls/wren/tests/stepA_mal.mal b/impls/wren/tests/stepA_mal.mal new file mode 100644 index 0000000000..5fe0c55cb7 --- /dev/null +++ b/impls/wren/tests/stepA_mal.mal @@ -0,0 +1,34 @@ +;; Testing basic Wren interop + +;;; wren-eval evaluates the given string as an expression. + +(wren-eval "7") +;=>7 + +(wren-eval "0x41") +;=>65 + +(wren-eval "\"7\"") +;=>"7" + +(wren-eval "[ 7,8,9 ]") +;=>(7 8 9) + +(wren-eval "{ \"abc\": 789 }") +;=>{"abc" 789} + +(wren-eval "System.print(\"hello\")") +;/hello +;=>"hello" + +(wren-eval "[\"a\", \"b\", \"c\"].map { |x| \"X%(x)Y\" }.join(\" \")") +;=>"XaY XbY XcY" + +(wren-eval "[1,2,3].map { |x| 1 + x }") +;=>(2 3 4) + +(wren-eval "[null, (1 == 1), (1 == 2)]") +;=>(nil true false) + +(wren-eval "Fiber.abort(\"AAA\" + \"BBB\")") +;/Error: AAABBB diff --git a/impls/wren/types.wren b/impls/wren/types.wren new file mode 100644 index 0000000000..826d63553e --- /dev/null +++ b/impls/wren/types.wren @@ -0,0 +1,130 @@ +class MalVal { + static newKeyword(value) { "\u029e%(value)" } + static isKeyword(obj) { obj is String && obj.count > 0 && obj[0] == "\u029e" } + meta { _meta } + meta=(value) { _meta = value } +} + +class MalSymbol is MalVal { + construct new(value) { _value = value } + value { _value } + toString { _value } + ==(other) { other is MalSymbol && other.value == _value } + !=(other) { !(this == other) } +} + +class MalSequential is MalVal { + construct new(elements) { _elements = elements } + elements { _elements } + [index] { _elements[index] } + isEmpty { _elements.count == 0 } + count { _elements.count } + first { isEmpty ? null : _elements[0] } + rest { MalList.new(isEmpty ? [] : elements[1..-1]) } + ==(other) { + if (!(other is MalSequential)) return false + if (other.count != count) return false + for (i in 0...count) { + if (other[i] != this[i]) return false + } + return true + } + !=(other) { !(this == other) } +} + +class MalList is MalSequential { + construct new(elements) { super(elements) } + clone() { MalList.new(elements) } +} + +class MalVector is MalSequential { + construct new(elements) { super(elements) } + clone() { MalVector.new(elements) } +} + +class MalMap is MalVal { + construct new(data) { _data = data } + construct fromList(elements) { + _data = {} + var i = 0 + while (i < elements.count) { + _data[elements[i]] = elements[i + 1] + i = i + 2 + } + } + clone() { MalMap.new(_data) } + data { _data } + assoc(pairsList) { + var newData = {} + for (e in _data) { + newData[e.key] = e.value + } + var i = 0 + while (i < pairsList.count) { + newData[pairsList[i]] = pairsList[i + 1] + i = i + 2 + } + return MalMap.new(newData) + } + dissoc(keysList) { + var newData = {} + for (e in _data) { + newData[e.key] = e.value + } + for (k in keysList) { + newData.remove(k) + } + return MalMap.new(newData) + } + ==(other) { + if (!(other is MalMap)) return false + if (other.data.count != data.count) return false + for (e in _data) { + if (other.data[e.key] != e.value) return false + } + return true + } + !=(other) { !(this == other) } +} + +class MalNativeFn is MalVal { + construct new(fn) { _fn = fn } + call(args) { _fn.call(args) } + clone() { MalNativeFn.new(_fn) } +} + +class MalFn is MalVal { + construct new(ast, params, env, fn) { + _ast = ast + _params = params + _env = env + _fn = fn + _isMacro = false + } + construct new(ast, params, env, fn, isMacro) { + _ast = ast + _params = params + _env = env + _fn = fn + _isMacro = isMacro + } + ast { _ast } + params { _params } + env { _env } + isMacro { _isMacro } + clone() { MalFn.new(_ast, _params, _env, _fn, _isMacro) } + makeMacro() { MalFn.new(_ast, _params, _env, _fn, true) } + call(args) { _fn.call(args) } +} + +class MalAtom is MalVal { + construct new(value) { _value = value } + value { _value } + value=(other) { _value = other } + clone() { MalAtom.new(value) } +} + +class MalException { + static value { __exception } + static set(exception) { __exception = exception } +} diff --git a/impls/wren/wren-add-gettimeofday.patch b/impls/wren/wren-add-gettimeofday.patch new file mode 100644 index 0000000000..7db29ed59e --- /dev/null +++ b/impls/wren/wren-add-gettimeofday.patch @@ -0,0 +1,34 @@ +diff --git a/src/vm/wren_core.c b/src/vm/wren_core.c +index 34a13c8b..3c4e6ab8 100644 +--- a/src/vm/wren_core.c ++++ b/src/vm/wren_core.c +@@ -4,6 +4,7 @@ + #include + #include + #include ++#include + + #include "wren_common.h" + #include "wren_core.h" +@@ -1121,6 +1122,13 @@ DEF_PRIMITIVE(string_toString) + RETURN_VAL(args[0]); + } + ++DEF_PRIMITIVE(system_gettimeofday) ++{ ++ struct timeval tv; ++ gettimeofday(&tv, NULL); ++ RETURN_NUM((double)tv.tv_sec + (double)tv.tv_usec/1000000.0); ++} ++ + DEF_PRIMITIVE(system_clock) + { + RETURN_NUM((double)clock() / CLOCKS_PER_SEC); +@@ -1374,6 +1382,7 @@ void wrenInitializeCore(WrenVM* vm) + PRIMITIVE(vm->rangeClass, "toString", range_toString); + + ObjClass* systemClass = AS_CLASS(wrenFindVariable(vm, coreModule, "System")); ++ PRIMITIVE(systemClass->obj.classObj, "gettimeofday", system_gettimeofday); + PRIMITIVE(systemClass->obj.classObj, "clock", system_clock); + PRIMITIVE(systemClass->obj.classObj, "gc()", system_gc); + PRIMITIVE(systemClass->obj.classObj, "writeString_(_)", system_writeString); diff --git a/impls/xslt/Dockerfile b/impls/xslt/Dockerfile new file mode 100644 index 0000000000..0fa6f1a541 --- /dev/null +++ b/impls/xslt/Dockerfile @@ -0,0 +1,23 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ + default-jre-headless libsaxonhe-java diff --git a/impls/xslt/Makefile b/impls/xslt/Makefile new file mode 100644 index 0000000000..de1acb51a5 --- /dev/null +++ b/impls/xslt/Makefile @@ -0,0 +1,7 @@ +.DEFAULT: + echo + +.PHONY: clean + +all: + echo "hello there general kenobi" diff --git a/impls/xslt/core.xslt b/impls/xslt/core.xslt new file mode 100644 index 0000000000..b5f6cd8e78 --- /dev/null +++ b/impls/xslt/core.xslt @@ -0,0 +1,810 @@ + + + + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + + false + + + + false + + + false + + + + false + + + + false + + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + + false + + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + false + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/env.xslt b/impls/xslt/env.xslt new file mode 100644 index 0000000000..4b91ad1967 --- /dev/null +++ b/impls/xslt/env.xslt @@ -0,0 +1,219 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/printer.xslt b/impls/xslt/printer.xslt new file mode 100644 index 0000000000..32bc61d0b9 --- /dev/null +++ b/impls/xslt/printer.xslt @@ -0,0 +1,197 @@ + + + + + + + + + + + + + + true + + + false + + + nil + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ? + ? + + + + + + ? + ? + + + + + + + + + + + + + + + + + + + + + + + Unknown + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/reader.xslt b/impls/xslt/reader.xslt new file mode 100644 index 0000000000..595e3d7d85 --- /dev/null +++ b/impls/xslt/reader.xslt @@ -0,0 +1,520 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Odd number of values to hash + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + EOF while reading sequence + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/readline.xslt b/impls/xslt/readline.xslt new file mode 100644 index 0000000000..91a87db748 --- /dev/null +++ b/impls/xslt/readline.xslt @@ -0,0 +1,12 @@ + + + + + + + + + + + + diff --git a/impls/xslt/run b/impls/xslt/run new file mode 100755 index 0000000000..3d3625f34c --- /dev/null +++ b/impls/xslt/run @@ -0,0 +1,161 @@ +#!/usr/bin/python3 + +import time +import os.path +import readline +import sys +import xml.etree.ElementTree as ET +from threading import Thread +from threading import Lock +from collections import deque + +saxon_jar = '/usr/share/java/Saxon-HE-*.jar' +saxon = f'java -Xmx2G -cp {saxon_jar} net.sf.saxon.Transform' + +step_dir = os.path.dirname(sys.argv[0]) +step_base = os.getenv(key='STEP', default='stepA_mal') +fname = os.path.join(step_dir, step_base + '.xslt') + +args = sys.argv[1:] +tree = ET.Element('mal') + +if len(args) > 0: + args0 = args[0] + ET.SubElement(tree, 'argv') + for a in tree.iter('mal'): + for a in a.iter('argv'): + for arg in args[1:]: + ET.SubElement(a, 'arg').text = arg + ET.SubElement(tree, 'no_repl') + +tree = ET.ElementTree(tree) +stdout = sys.stdout + +try: + readline.read_history_file('.xslt_mal_history') +except: + pass + +HALT = False +THE_PID = None +init_t = time.time() * 1000 +readline_queue = deque() +os.system('rm -rf xsl_error.xml') +os.system('mkfifo xsl_error.xml') + +def setup_request_file(): + os.system('rm -rf xsl_input-string') + os.system('mkfifo xsl_input-string') + + +def get_one(fd): + s = b"" + while True: + x = os.read(fd, 1) + if x == b'\n': + break + if x == b'': + break + s += x + if s == "": + return None + return s.decode('utf-8') + + +def serve_one_request(res): + global HALT + if len(res) == 0: + return + try: + xtree = ET.fromstring("" + res.strip('\x00') + "") + # stdout.write(xtree.attrib['kind']) + for req in xtree: + if req.attrib['kind'] == 'readline': + x = None + if len(readline_queue) > 0: + x = readline_queue.popleft() + else: + x = input(req.attrib['value']) + with open('xsl_input-string', 'w') as fx: + fx.write(x) + # stdout.write(' = ' + x) + elif req.attrib['kind'] == 'halt': + HALT = True + elif req.attrib['kind'] == 'display': + stdout.write(req.attrib['value'] + '\n') + elif req.attrib['kind'] == 'time': + x = time.time() * 1000 - init_t + # stdout.write(' = ' + str(int(x))) + with open('xsl_input-string', 'w') as fx: + fx.write(str(int(x))) + # stdout.write('\n') + elif req.attrib['kind'] == 'xpath-eval': + xpath = req.attrib['value'] + with open('xsl-eval.xslt', 'w') as f: + f.write(f'') + with open('xsl-null.xml', 'w') as f: + f.write(req.attrib['context']) + + if os.system(f'{saxon} -xsl:xsl-eval.xslt -s:xsl-null.xml > xsl-eval_output.xml'): + x = '' + else: + with open('xsl-eval_output.xml', 'r') as f: + x = f.read() + with open('xsl_input-string', 'w') as fx: + fx.write(x) + else: + stdout.write("UNKNOWN REQUEST " + req.attrib['kind']) + # stdout.write('\n') + except Exception as e: + # if str(e) != 'no element found: line 1, column 0': + # f.seek(0) + # print(e, list(x for x in f.read())) + return + # with open('xsl_error.xml', 'w') as f: + # f.write('') + +def transform(do_print=True): + global tree, HALT, THE_PID + + tree.write('xslt_input.xml') + setup_request_file() + pid = os.fork() + if pid == 0: + os.system(f'{saxon} -xsl:"{fname}" -s:xslt_input.xml -TP:perf.html > xslt_output.xml 2> xsl_error.xml') + HALT = True + else: + THE_PID = pid + fd = os.open('xsl_error.xml', os.O_RDONLY | os.O_CLOEXEC) + while True: + try: + if HALT: + os.kill(THE_PID, 9) + raise KeyboardInterrupt() + cmd = get_one(fd) + if cmd: + serve_one_request(cmd) + except KeyboardInterrupt: + exit() + except Exception as e: + print("Harness error:", e) + tree = ET.parse('xslt_output.xml') + if do_print: + stdout = '' + for a in tree.iter('mal'): + for a in a.iter('stdout'): + stdout = a + print(stdout.text) + stdout.clear() + del stdout + + +if len(args) > 0: + readline_queue.append(f'(do (load-file "{args0}") (xslt-halt))') + transform(do_print=False) +else: + if fname == 'stepA_mal.xslt': + readline_queue.append('(println (str "Mal [" *host-language* "]"))') + transform(do_print=False) + else: + transform() + readline.write_history_file('.xslt_mal_history') diff --git a/impls/xslt/step0_repl.inc.xslt b/impls/xslt/step0_repl.inc.xslt new file mode 100644 index 0000000000..58463a458d --- /dev/null +++ b/impls/xslt/step0_repl.inc.xslt @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step0_repl.xslt b/impls/xslt/step0_repl.xslt new file mode 100644 index 0000000000..0fdfe15d6b --- /dev/null +++ b/impls/xslt/step0_repl.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step1_read_print.inc.xslt b/impls/xslt/step1_read_print.inc.xslt new file mode 100644 index 0000000000..ab6ca8d4d9 --- /dev/null +++ b/impls/xslt/step1_read_print.inc.xslt @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step1_read_print.xslt b/impls/xslt/step1_read_print.xslt new file mode 100644 index 0000000000..a520f96574 --- /dev/null +++ b/impls/xslt/step1_read_print.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step2_eval.inc.xslt b/impls/xslt/step2_eval.inc.xslt new file mode 100644 index 0000000000..45466616ab --- /dev/null +++ b/impls/xslt/step2_eval.inc.xslt @@ -0,0 +1,245 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Invalid function + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step2_eval.xslt b/impls/xslt/step2_eval.xslt new file mode 100644 index 0000000000..f607c472ae --- /dev/null +++ b/impls/xslt/step2_eval.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step3_env.inc.xslt b/impls/xslt/step3_env.inc.xslt new file mode 100644 index 0000000000..7222dc6dca --- /dev/null +++ b/impls/xslt/step3_env.inc.xslt @@ -0,0 +1,378 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step3_env.xslt b/impls/xslt/step3_env.xslt new file mode 100644 index 0000000000..192daefb34 --- /dev/null +++ b/impls/xslt/step3_env.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step4_if_fn_do.inc.xslt b/impls/xslt/step4_if_fn_do.inc.xslt new file mode 100644 index 0000000000..0b611dcbc4 --- /dev/null +++ b/impls/xslt/step4_if_fn_do.inc.xslt @@ -0,0 +1,523 @@ + + + + + + + + + + + + + + + + + + + + + (def! not (fn* (a) (if a false true))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step4_if_fn_do.xslt b/impls/xslt/step4_if_fn_do.xslt new file mode 100644 index 0000000000..bf141dec1c --- /dev/null +++ b/impls/xslt/step4_if_fn_do.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step6_file.inc.xslt b/impls/xslt/step6_file.inc.xslt new file mode 100644 index 0000000000..3d62f5d0cc --- /dev/null +++ b/impls/xslt/step6_file.inc.xslt @@ -0,0 +1,847 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step6_file.xslt b/impls/xslt/step6_file.xslt new file mode 100644 index 0000000000..a9a5cc0a6d --- /dev/null +++ b/impls/xslt/step6_file.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step7_quote.inc.xslt b/impls/xslt/step7_quote.inc.xslt new file mode 100644 index 0000000000..f1b6f6f58e --- /dev/null +++ b/impls/xslt/step7_quote.inc.xslt @@ -0,0 +1,981 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step7_quote.xslt b/impls/xslt/step7_quote.xslt new file mode 100644 index 0000000000..6881af8e8d --- /dev/null +++ b/impls/xslt/step7_quote.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step8_macros.inc.xslt b/impls/xslt/step8_macros.inc.xslt new file mode 100644 index 0000000000..b08cec9cca --- /dev/null +++ b/impls/xslt/step8_macros.inc.xslt @@ -0,0 +1,1054 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + false + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step8_macros.xslt b/impls/xslt/step8_macros.xslt new file mode 100644 index 0000000000..c422c6b8a1 --- /dev/null +++ b/impls/xslt/step8_macros.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step9_try.inc.xslt b/impls/xslt/step9_try.inc.xslt new file mode 100644 index 0000000000..5d0b89801f --- /dev/null +++ b/impls/xslt/step9_try.inc.xslt @@ -0,0 +1,1110 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + false + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/step9_try.xslt b/impls/xslt/step9_try.xslt new file mode 100644 index 0000000000..9e9c2190a1 --- /dev/null +++ b/impls/xslt/step9_try.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/stepA_mal.inc.xslt b/impls/xslt/stepA_mal.inc.xslt new file mode 100644 index 0000000000..bce3dc2b8a --- /dev/null +++ b/impls/xslt/stepA_mal.inc.xslt @@ -0,0 +1,1110 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) (def! *host-language* "XSLT")) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + false + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/stepA_mal.xslt b/impls/xslt/stepA_mal.xslt new file mode 100644 index 0000000000..25a86656e1 --- /dev/null +++ b/impls/xslt/stepA_mal.xslt @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/impls/xslt/test.xslt b/impls/xslt/test.xslt new file mode 100644 index 0000000000..00f63d6ec7 --- /dev/null +++ b/impls/xslt/test.xslt @@ -0,0 +1,6 @@ + + + + + + diff --git a/impls/yorick/Dockerfile b/impls/yorick/Dockerfile new file mode 100644 index 0000000000..8a3f0037f3 --- /dev/null +++ b/impls/yorick/Dockerfile @@ -0,0 +1,26 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install yorick yorick-yeti yorick-yeti-regex + +ENV HOME /mal diff --git a/impls/yorick/Makefile b/impls/yorick/Makefile new file mode 100644 index 0000000000..04f60c4e65 --- /dev/null +++ b/impls/yorick/Makefile @@ -0,0 +1,17 @@ +SOURCES_BASE = hash.i types.i reader.i printer.i +SOURCES_LISP = env.i core.i stepA_mal.i +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +.PHONY: all dist clean + +all: dist + +dist: mal + +mal: $(SOURCES) + echo "#!/usr/bin/yorick -batch" > $@ + cat $+ | grep -v "^require," >> $@ + chmod +x $@ + +clean: + rm -f mal diff --git a/impls/yorick/core.i b/impls/yorick/core.i new file mode 100644 index 0000000000..bd3d246462 --- /dev/null +++ b/impls/yorick/core.i @@ -0,0 +1,384 @@ +require, "types.i" + +func mal_equal(a) { return new_boolean(equal(*a(1), *a(2))); } +func mal_throw(a) { return MalError(obj=a(1)); } + +func mal_nil_q(a) { return new_boolean(structof(*a(1)) == MalNil); } +func mal_true_q(a) { return new_boolean(structof(*a(1)) == MalTrue); } +func mal_false_q(a) { return new_boolean(structof(*a(1)) == MalFalse); } +func mal_string_q(a) { return new_boolean(structof(*a(1)) == MalString); } +func mal_symbol(a) { return MalSymbol(val=a(1)->val); } +func mal_symbol_q(a) { return new_boolean(structof(*a(1)) == MalSymbol); } +func mal_keyword(a) { return MalKeyword(val=a(1)->val); } +func mal_keyword_q(a) { return new_boolean(structof(*a(1)) == MalKeyword); } +func mal_number_q(a) { return new_boolean(structof(*a(1)) == MalNumber); } +func mal_fn_q(a) +{ + if (structof(*a(1)) == MalNativeFunction) return MAL_TRUE; + return new_boolean(structof(*a(1)) == MalFunction && !a(1)->macro); +} +func mal_macro_q(a) { return new_boolean(structof(*a(1)) == MalFunction && a(1)->macro); } + +func string_helper(a, delimiter, readable) +{ + res = "" + for (i = 1; i <= numberof(a); ++i) { + if (i > 1) res += delimiter + res += pr_str(*a(i), readable) + } + return res +} + +func mal_pr_str(a) { return MalString(val=string_helper(a, " ", 1)); } +func mal_str(a) { return MalString(val=string_helper(a, "", 0)); } +func mal_prn(a) { write, format="%s\n", string_helper(a, " ", 1); return MAL_NIL; } +func mal_println(a) { write, format="%s\n", string_helper(a, " ", 0); return MAL_NIL; } +func mal_read_string(a) { return read_str(a(1)->val); } + +func mal_readline(a) +{ + extern stdin_file + stdin_file = open("/dev/stdin", "r") + write, format="%s", a(1)->val + line = rdline(stdin_file, prompt="") + return line ? MalString(val=line) : MAL_NIL +} + +func mal_slurp(a) +{ + f = open(a(1)->val) + lines = rdfile(f) + close, f + s = "" + for (i = 1; i <= numberof(lines); ++i) { + s += (lines(i) + "\n") + } + return MalString(val=s) +} + +func mal_lt(a) { return new_boolean(a(1)->val < a(2)->val); } +func mal_lte(a) { return new_boolean(a(1)->val <= a(2)->val); } +func mal_gt(a) { return new_boolean(a(1)->val > a(2)->val); } +func mal_gte(a) { return new_boolean(a(1)->val >= a(2)->val); } + +func mal_add(a) { return MalNumber(val=(a(1)->val + a(2)->val)); } +func mal_sub(a) { return MalNumber(val=(a(1)->val - a(2)->val)); } +func mal_mul(a) { return MalNumber(val=(a(1)->val * a(2)->val)); } +func mal_div(a) { return MalNumber(val=(a(1)->val / a(2)->val)); } + +func mal_time_ms(a) +{ + elapsed = array(double, 3) + timer, elapsed + return MalNumber(val=floor(elapsed(3) * 1000)) +} + +func mal_list(a) { return MalList(val=&a); } +func mal_list_q(a) { return new_boolean(structof(*a(1)) == MalList); } +func mal_vector(a) { return MalVector(val=&a); } +func mal_vector_q(a) { return new_boolean(structof(*a(1)) == MalVector); } +func mal_hash_map(a) { return array_to_hashmap(a); } +func mal_map_q(a) { return new_boolean(structof(*a(1)) == MalHashmap); } + +func mal_assoc(a) { + h = *(a(1)->val) + k1 = *h.keys + v1 = *h.vals + new_h = Hash(keys=&k1, vals=&v1) + for (i = 2; i <= numberof(a); i += 2) { + hash_set, new_h, hashmap_obj_to_key(*a(i)), *a(i + 1) + } + return MalHashmap(val=&new_h); +} + +func mal_dissoc(a) { + h = *(a(1)->val) + k1 = *h.keys + v1 = *h.vals + new_h = Hash(keys=&k1, vals=&v1) + for (i = 2; i <= numberof(a); ++i) { + hash_delete, new_h, hashmap_obj_to_key(*a(i)) + } + return MalHashmap(val=&new_h); +} + +func mal_get(a) { + if (structof(*a(1)) == MalNil) return MAL_NIL + h = *(a(1)->val) + key_obj = *a(2) + val = hash_get(h, hashmap_obj_to_key(key_obj)) + return is_void(val) ? MAL_NIL : val +} + +func mal_contains_q(a) { + if (structof(*a(1)) == MalNil) return MAL_FALSE + h = *(a(1)->val) + key_obj = *a(2) + return hash_has_key(h, hashmap_obj_to_key(key_obj)) ? MAL_TRUE : MAL_FALSE +} + +func mal_keys(a) { + keys_strs = *(a(1)->val->keys) + if (numberof(keys_strs) == 0) return MalList(val=&[]) + res = array(pointer, numberof(keys_strs)) + for (i = 1; i <= numberof(keys_strs); ++i) { + res(i) = &hashmap_key_to_obj(keys_strs(i)) + } + return MalList(val=&res); +} + +func mal_vals(a) { return MalList(val=a(1)->val->vals); } + +func mal_sequential_q(a) { return new_boolean(structof(*a(1)) == MalList || structof(*a(1)) == MalVector); } + +func mal_cons(a) +{ + a2_len = count(*a(2)) + seq = array(pointer, a2_len + 1) + seq(1) = a(1) + if (a2_len > 0) { + seq(2:) = *(a(2)->val) + } + return MalList(val=&seq) +} + +func mal_concat(a) +{ + seq = [] + for (i = 1; i <= numberof(a); ++i) { + grow, seq, *(a(i)->val) + } + return MalList(val=&seq) +} + +func mal_vec(a) +{ + if (numberof(a) == 1) { + type = structof(*a(1)) + if (type == MalVector) return *(a(1)) + if (type == MalList) return MalVector(val=a(1)->val) + } + return MalError(message="vec: requires a sequence") +} + +func mal_nth(a) +{ + index = a(2)->val + if (index >= count(*a(1))) return MalError(message="nth: index out of range") + return *((*(a(1)->val))(index + 1)) +} + +func mal_first(a) +{ + if (structof(*a(1)) == MalNil || count(*a(1)) == 0) return MAL_NIL + return *((*(a(1)->val))(1)) +} + +func mal_rest(a) +{ + if (structof(*a(1)) == MalNil) return MalList(val=&[]) + return rest(*a(1)) +} + +func mal_empty_q(a) { return new_boolean((structof(*a(1)) == MalNil ? 1 : count(*a(1)) == 0)); } +func mal_count(a) { return MalNumber(val=(structof(*a(1)) == MalNil ? 0 : count(*a(1)))); } + +func call_func(fn, args) +{ + if (structof(fn) == MalNativeFunction) { + return call_core_fn(fn.val, args) + } else if (structof(fn) == MalFunction) { + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + return EVAL(*fn.ast, fn_env) + } else { + return MalError(message="Unknown function type") + } +} + +func mal_apply(a) { + mid_args = numberof(a) > 2 ? a(2:-1) : [] + return call_func(*a(1), grow(mid_args, *(a(0)->val))) +} + +func mal_map(a) { + fn = *a(1) + seq = *(a(2)->val) + if (numberof(seq) == 0) return MalList(val=&[]) + new_seq = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + new_val = call_func(fn, [seq(i)]) + if (structof(new_val) == MalError) return new_val + new_seq(i) = &new_val + } + return MalList(val=&new_seq) +} + +func mal_conj(a) +{ + obj = *a(1) + type = structof(obj) + if (type == MalList) { + res = obj + for (i = 2; i <= numberof(a); ++i) { + res = mal_cons([a(i), &res]) + } + return res + } else if (type == MalVector) { + seq = *obj.val + grow, seq, a(2:) + return MalVector(val=&seq) + } else { + return MalError(message="conj requires list or vector") + } +} + +func mal_seq(a) +{ + obj = *a(1) + type = structof(obj) + if (type == MalString) { + len = strlen(obj.val) + if (len == 0) return MAL_NIL + seq = array(pointer, len) + for (i = 1; i <= len; ++i) { + seq(i) = &MalString(val=strpart(obj.val, i:i)) + } + return MalList(val=&seq) + } else if (type == MalList) { + return count(obj) == 0 ? MAL_NIL : obj + } else if (type == MalVector) { + return count(obj) == 0 ? MAL_NIL : MalList(val=obj.val) + } else if (type == MalNil) { + return MAL_NIL + } else { + return MalError(message="seq requires string or list or vector or nil") + } +} + +func mal_meta(a) +{ + meta_obj = *(a(1)->meta) + return is_void(meta_obj) ? MAL_NIL : meta_obj +} + +func mal_with_meta(a) +{ + new_obj = *a(1) + new_obj.meta = a(2) + return new_obj +} + +func mal_atom(a) { return MalAtom(val=&MalAtomVal(val=a(1))); } +func mal_atom_q(a) { return new_boolean(structof(*a(1)) == MalAtom); } +func mal_deref(a) { return *(a(1)->val->val); } +func mal_reset_bang(a) { a(1)->val->val = a(2); return *(a(1)->val->val); } +func mal_swap_bang(a) +{ + old_val = mal_deref([a(1)]) + args = array(pointer, numberof(a) - 1) + args(1) = &old_val + if (numberof(a) > 2) args(2:) = a(3:) + new_val = call_func(*a(2), args) + if (structof(new_val) == MalError) return new_val + return mal_reset_bang([a(1), &new_val]) +} + +func mal_eval(a) { return EVAL(*a(1), repl_env); } + +func yorick_to_mal(e) +{ + if (is_void(e)) return MAL_NIL + if (is_scalar(e)) { + if (is_numerical(e)) return MalNumber(val=e) + else if (is_string(e)) return MalString(val=e) + else return MalString(val=totxt(e)) + } else { + seq = array(pointer, numberof(e)) + for (i = 1; i <= numberof(e); ++i) { + seq(i) = &yorick_to_mal(e(i)) + } + return MalList(val=&seq) + } +} + +func mal_yorick_eval(a) { return yorick_to_mal(exec(a(1)->val)); } + +core_ns = h_new() + +h_set, core_ns, "=", mal_equal +h_set, core_ns, "throw", mal_throw + +h_set, core_ns, "nil?", mal_nil_q +h_set, core_ns, "true?", mal_true_q +h_set, core_ns, "false?", mal_false_q +h_set, core_ns, "string?", mal_string_q +h_set, core_ns, "symbol", mal_symbol +h_set, core_ns, "symbol?", mal_symbol_q +h_set, core_ns, "keyword", mal_keyword +h_set, core_ns, "keyword?", mal_keyword_q +h_set, core_ns, "number?", mal_number_q +h_set, core_ns, "fn?", mal_fn_q +h_set, core_ns, "macro?", mal_macro_q + +h_set, core_ns, "pr-str", mal_pr_str +h_set, core_ns, "str", mal_str +h_set, core_ns, "prn", mal_prn +h_set, core_ns, "println", mal_println +h_set, core_ns, "read-string", mal_read_string +h_set, core_ns, "readline", mal_readline +h_set, core_ns, "slurp", mal_slurp + +h_set, core_ns, "<", mal_lt +h_set, core_ns, "<=", mal_lte +h_set, core_ns, ">", mal_gt +h_set, core_ns, ">=", mal_gte +h_set, core_ns, "+", mal_add +h_set, core_ns, "-", mal_sub +h_set, core_ns, "*", mal_mul +h_set, core_ns, "/", mal_div +h_set, core_ns, "time-ms", mal_time_ms + +h_set, core_ns, "list", mal_list +h_set, core_ns, "list?", mal_list_q +h_set, core_ns, "vector", mal_vector +h_set, core_ns, "vector?", mal_vector_q +h_set, core_ns, "hash-map", mal_hash_map +h_set, core_ns, "map?", mal_map_q +h_set, core_ns, "assoc", mal_assoc +h_set, core_ns, "dissoc", mal_dissoc +h_set, core_ns, "get", mal_get +h_set, core_ns, "contains?", mal_contains_q +h_set, core_ns, "keys", mal_keys +h_set, core_ns, "vals", mal_vals + +h_set, core_ns, "sequential?", mal_sequential_q +h_set, core_ns, "cons", mal_cons +h_set, core_ns, "concat", mal_concat +h_set, core_ns, "vec", mal_vec +h_set, core_ns, "nth", mal_nth +h_set, core_ns, "first", mal_first +h_set, core_ns, "rest", mal_rest +h_set, core_ns, "empty?", mal_empty_q +h_set, core_ns, "count", mal_count +h_set, core_ns, "apply", mal_apply +h_set, core_ns, "map", mal_map + +h_set, core_ns, "conj", mal_conj +h_set, core_ns, "seq", mal_seq + +h_set, core_ns, "meta", mal_meta +h_set, core_ns, "with-meta", mal_with_meta +h_set, core_ns, "atom", mal_atom +h_set, core_ns, "atom?", mal_atom_q +h_set, core_ns, "deref", mal_deref +h_set, core_ns, "reset!", mal_reset_bang +h_set, core_ns, "swap!", mal_swap_bang + +h_set, core_ns, "eval", mal_eval +h_set, core_ns, "yorick-eval", mal_yorick_eval + +func call_core_fn(name, args_list) +{ + f = h_get(core_ns, name) + return f(args_list) +} diff --git a/impls/yorick/env.i b/impls/yorick/env.i new file mode 100644 index 0000000000..d1e8a9cdc0 --- /dev/null +++ b/impls/yorick/env.i @@ -0,0 +1,44 @@ +require, "hash.i" +require, "types.i" + +struct Env { + pointer outer + Hash data +} + +func env_new(outer_ptr, binds=, exprs=) +{ + env = Env(outer=outer_ptr, data=hash_new()) + for (i = 1; i <= numberof(binds); ++i) { + if (binds(i)->val == "&") { + rest_args = numberof(exprs) >= i ? exprs(i:) : [] + env_set, env, binds(i + 1)->val, MalList(val=&rest_args) + break + } else { + env_set, env, binds(i)->val, *exprs(i) + } + } + return env +} + +func env_find(env, key) +{ + if (hash_has_key(env.data, key)) return env + if (is_void(*env.outer)) return nil + return env_find(*env.outer, key) +} + +func env_get(env, key) +{ + found_env = env_find(env, key) + if (is_void(found_env)) return MalError(message=("'" + key + "' not found")) + return hash_get(found_env.data, key) +} + +func env_set(&env, key, val) +{ + d = env.data + hash_set, d, key, val + env.data = d + return val +} diff --git a/impls/yorick/hash.i b/impls/yorick/hash.i new file mode 100644 index 0000000000..250e4c72dc --- /dev/null +++ b/impls/yorick/hash.i @@ -0,0 +1,79 @@ +// Implement our old naive O(n) map because Yeti's hash table (h_new()) cannot +// be used inside arrays and structs (we can't get a pointer to hash table). +// This prevents saving pointer to environment in MalFunction for example. + +struct Hash { + pointer keys + pointer vals +} + +func hash_new(void) +{ + return Hash(keys=&[], vals=&[]) +} + +func hash_get(h, key) +{ + for (i = 1; i <= numberof(*h.keys); ++i) { + if ((*h.keys)(i) == key) return *((*h.vals)(i)) + } + return nil +} + +func hash_has_key(h, key) +{ + for (i = 1; i <= numberof(*h.keys); ++i) { + if ((*h.keys)(i) == key) return 1 + } + return 0 +} + +func hash_set(&h, key, val) +{ + if (is_void(*h.keys)) { + h.keys = &[key] + h.vals = &[&val] + return + } + for (i = 1; i <= numberof(*h.keys); ++i) { + if ((*h.keys)(i) == key) { + (*h.vals)(i) = &val + return + } + } + tmp = *h.keys + grow, tmp, [key] + h.keys = &tmp + tmp = *h.vals + grow, tmp, [&val] + h.vals = &tmp +} + +func hash_delete(&h, key) +{ + if (is_void(*h.keys) || numberof(*h.keys) == 0) return + k = *h.keys + v = *h.vals + if (numberof(k) == 1) { + if (k(1) == key) { + h.keys = &[] + h.vals = &[] + return + } + } + for (i = 1; i <= numberof(k); ++i) { + if (k(i) == key) { + if (i == 1) { + h.keys = &(k(i+1:)) + h.vals = &(v(i+1:)) + } else if (i == numberof(k)) { + h.keys = &(k(1:i-1)) + h.vals = &(v(1:i-1)) + } else { + h.keys = &grow(k(1:i-1), k(i+1:)) + h.vals = &grow(v(1:i-1), v(i+1:)) + } + return + } + } +} diff --git a/impls/yorick/printer.i b/impls/yorick/printer.i new file mode 100644 index 0000000000..acefd17c26 --- /dev/null +++ b/impls/yorick/printer.i @@ -0,0 +1,50 @@ +require, "types.i" + +func format_seq(val, start_char, end_char, readable) +{ + seq = *val + res = "" + for (i = 1; i <= numberof(seq); ++i) { + if (i > 1) res += " " + res += pr_str(*seq(i), readable) + } + return start_char + res + end_char +} + +func format_hashmap(h, readable) +{ + res = "" + for (i = 1; i <= numberof(*h.keys); ++i) { + if (i > 1) res += " " + key = hashmap_key_to_obj((*h.keys)(i)) + res += pr_str(key, readable) + " " + pr_str(*((*h.vals)(i)), readable) + } + return "{" + res + "}" +} + +func escape(s) +{ + s1 = streplaceall(s, "\\", "\\\\") + s2 = streplaceall(s1, "\"", "\\\"") + s3 = streplaceall(s2, "\n", "\\n") + return "\"" + s3 + "\"" +} + +func pr_str(ast, readable) +{ + type = structof(ast) + if (type == MalNil) return "nil" + else if (type == MalTrue) return "true" + else if (type == MalFalse) return "false" + else if (type == MalNumber) return totxt(ast.val) + else if (type == MalSymbol) return ast.val + else if (type == MalString) return readable ? escape(ast.val) : ast.val + else if (type == MalKeyword) return ":" + ast.val + else if (type == MalList) return format_seq(ast.val, "(", ")", readable) + else if (type == MalVector) return format_seq(ast.val, "[", "]", readable) + else if (type == MalHashmap) return format_hashmap(*ast.val, readable) + else if (type == MalAtom) return "(atom " + pr_str(*(ast.val->val), readable) + ")" + else if (type == MalNativeFunction) return "#" + else if (type == MalFunction) return "#" + else MalError(message=("Unknown type " + totxt(type))) +} diff --git a/impls/yorick/reader.i b/impls/yorick/reader.i new file mode 100644 index 0000000000..92adfd0fab --- /dev/null +++ b/impls/yorick/reader.i @@ -0,0 +1,159 @@ +#include "yeti_regex.i" +require, "types.i" + +TOKENIZER_REGEXP = regcomp("[[:space:],]*(~@|[][{}()'`~@]|\"([\\].|[^\\\"])*\"?|;[^\n]*|[^][[:space:]{}()'\"`~@,;]*)") + +func tokenize(str) +{ + match0 = "" + match1 = "" + pos = 1 + tokens = [] + while (1) { + m = regmatch(TOKENIZER_REGEXP, str, match0, match1, start=pos, indices=1) + if (m == 0) break + b = match1(1) + e = match1(2) - 1 + if (e < b) { + pos = match1(2) + 1 + continue + } + token = strpart(str, b:e) + pos = match1(2) + if (strpart(token, 1:1) == ";") continue + grow, tokens, [token] + } + return tokens +} + +struct Reader { + pointer tokens + int pos +} + +func reader_peek(rdr) +{ + if (rdr.pos > numberof(*rdr.tokens)) return string(0) + return (*rdr.tokens)(rdr.pos) +} + +func reader_next(rdr) +{ + token = reader_peek(rdr) + rdr.pos += 1 + return token +} + +NUMBER_REGEXP = regcomp("^-?[0-9]+$") +STR_REGEXP = regcomp("^\"([\\].|[^\\\"])*\"$") +STR_BAD_REGEXP = regcomp("^\".*$") + +func unescape(s) +{ + s = strpart(s, 2:-1) // remove surrounding quotes + s = streplaceall(s, "\\\\", "\x01") + s = streplaceall(s, "\\n", "\n") + s = streplaceall(s, "\\\"", "\"") + return streplaceall(s, "\x01", "\\") +} + +func read_atom(rdr) +{ + token = reader_next(rdr) + if (token == "nil") return MAL_NIL + else if (token == "true") return MAL_TRUE + else if (token == "false") return MAL_FALSE + else if (regmatch(NUMBER_REGEXP, token)) return MalNumber(val=tonum(token)) + else if (regmatch(STR_REGEXP, token)) return MalString(val=unescape(token)) + else if (regmatch(STR_BAD_REGEXP, token)) return MalError(message=("expected '\"', got EOF")) + else if (strpart(token, 1:1) == ":") return MalKeyword(val=strpart(token, 2:)) + else return MalSymbol(val=token) +} + +func read_seq(rdr, start_char, end_char) +{ + token = reader_next(rdr) + if (token != start_char) { + return MalError(message=("expected '" + start_char + "', got EOF")) + } + + elements = [] + token = reader_peek(rdr) + while (token != end_char) { + if (token == string(0)) { + return MalError(message=("expected '" + end_char + "', got EOF")) + } + e = read_form(rdr) + if (structof(e) == MalError) return e + grow, elements, [&e] + token = reader_peek(rdr) + } + token = reader_next(rdr) + return elements +} + +func read_list(rdr) +{ + seq = read_seq(rdr, "(", ")") + if (structof(seq) == MalError) return seq + return MalList(val=&seq) +} + +func read_vector(rdr) +{ + seq = read_seq(rdr, "[", "]") + if (structof(seq) == MalError) return seq + return MalVector(val=&seq) +} + +func read_hashmap(rdr) +{ + seq = read_seq(rdr, "{", "}") + if (structof(seq) == MalError) return seq + return array_to_hashmap(seq) +} + +func reader_macro(rdr, symbol_name) +{ + shortcut = reader_next(rdr) + form = read_form(rdr) + if (structof(form) == MalError) return form + seq = [&MalSymbol(val=symbol_name), &form] + return MalList(val=&seq) +} + +func reader_with_meta_macro(rdr) +{ + shortcut = reader_next(rdr) + meta = read_form(rdr) + if (structof(meta) == MalError) return meta + form = read_form(rdr) + if (structof(form) == MalError) return form + seq = [&MalSymbol(val="with-meta"), &form, &meta] + return MalList(val=&seq) +} + +func read_form(rdr) +{ + token = reader_peek(rdr) + if (token == "'") return reader_macro(rdr, "quote") + else if (token == "`") return reader_macro(rdr, "quasiquote") + else if (token == "~") return reader_macro(rdr, "unquote") + else if (token == "~@") return reader_macro(rdr, "splice-unquote") + else if (token == "@") return reader_macro(rdr, "deref") + else if (token == "^") return reader_with_meta_macro(rdr) + else if (token == "(") return read_list(rdr) + else if (token == ")") return MalError(message="unexpected ')'") + else if (token == "[") return read_vector(rdr) + else if (token == "]") return MalError(message="unexpected ']'") + else if (token == "{") return read_hashmap(rdr) + else if (token == "}") return MalError(message="unexpected '}'") + else return read_atom(rdr) +} + +func read_str(str) +{ + tokens = tokenize(str) + rdr = Reader(tokens=&tokens, pos=1) + return read_form(rdr) +} diff --git a/impls/yorick/run b/impls/yorick/run new file mode 100755 index 0000000000..78b865fca2 --- /dev/null +++ b/impls/yorick/run @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +export YORICK_MAL_PATH="$(dirname $0)" +exec yorick -batch "$YORICK_MAL_PATH/${STEP:-stepA_mal}.i" "${@}" diff --git a/impls/yorick/step0_repl.i b/impls/yorick/step0_repl.i new file mode 100644 index 0000000000..6a7fa25016 --- /dev/null +++ b/impls/yorick/step0_repl.i @@ -0,0 +1,33 @@ +func READ(str) +{ + return str +} + +func EVAL(exp, env) +{ + return exp +} + +func PRINT(exp) +{ + return exp +} + +func REP(str) +{ + return PRINT(EVAL(READ(str), "")) +} + +func main(void) +{ + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) write, format="%s\n", REP(line) + } + write, "" +} + +main; diff --git a/impls/yorick/step1_read_print.i b/impls/yorick/step1_read_print.i new file mode 100644 index 0000000000..8a97cb8cf1 --- /dev/null +++ b/impls/yorick/step1_read_print.i @@ -0,0 +1,43 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" + +func READ(str) +{ + return read_str(str) +} + +func EVAL(exp, env) +{ + if (structof(exp) == MalError) return exp + return exp +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func REP(str) +{ + return PRINT(EVAL(READ(str), "")) +} + +func main(void) +{ + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step2_eval.i b/impls/yorick/step2_eval.i new file mode 100644 index 0000000000..40730a4967 --- /dev/null +++ b/impls/yorick/step2_eval.i @@ -0,0 +1,98 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) +} + +func EVAL(ast, env) +{ + // write, format="EVAL: %s\n", pr_str(ast, 1) + // Process non-list types. + type = structof(ast) + if (type == MalSymbol) { + val = h_get(env, ast.val) + if (is_void(val)) return MalError(message=("'" + ast.val + "' not found")) + return val + } else if (type == MalList) { + // Proceed after this switch. + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, (*h.keys)(i), new_val + } + return MalHashmap(val=&res) + } else return ast + // The else branch includes MalError. Now ast is a list. + if (numberof(*ast.val) == 0) return ast + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = h_new() + h_set, repl_env, "+", MalNativeFunction(val="+") + h_set, repl_env, "-", MalNativeFunction(val="-") + h_set, repl_env, "*", MalNativeFunction(val="*") + h_set, repl_env, "/", MalNativeFunction(val="/") + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step3_env.i b/impls/yorick/step3_env.i new file mode 100644 index 0000000000..604fb35a20 --- /dev/null +++ b/impls/yorick/step3_env.i @@ -0,0 +1,118 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) +} + +func EVAL(ast, env) +{ + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + // Process non-list types. + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + // Proceed after this switch. + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, (*h.keys)(i), new_val + } + return MalHashmap(val=&res) + } else return ast + // The else branch includes MalError. Now ast is a list. + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + return EVAL(*lst(3), let_env) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = env_new(pointer(0)) + env_set, repl_env, "+", MalNativeFunction(val="+") + env_set, repl_env, "-", MalNativeFunction(val="-") + env_set, repl_env, "*", MalNativeFunction(val="*") + env_set, repl_env, "/", MalNativeFunction(val="/") + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step4_if_fn_do.i b/impls/yorick/step4_if_fn_do.i new file mode 100644 index 0000000000..6dac870716 --- /dev/null +++ b/impls/yorick/step4_if_fn_do.i @@ -0,0 +1,158 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) +} + +func EVAL(ast, env) +{ + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + // Process non-list types. + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + // Proceed after this switch. + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, (*h.keys)(i), new_val + } + return MalHashmap(val=&res) + } else return ast + // The else branch includes MalError. Now ast is a list. + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + return EVAL(*lst(3), let_env) + } else if (a1 == "do") { + ret = nil + for (i = 2; i <= numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + return ret + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + return EVAL(*lst(4), env) + } else { + return MAL_NIL + } + } else { + return EVAL(*lst(3), env) + } + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + return EVAL(*fn.ast, fn_env) + } else { + return MalError(message="Unknown function type") + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step5_tco.i b/impls/yorick/step5_tco.i new file mode 100644 index 0000000000..a9c8ffd96b --- /dev/null +++ b/impls/yorick/step5_tco.i @@ -0,0 +1,165 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) +} + +func EVAL(ast, env) +{ + while (1) { + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + // Process non-list types (todo: indent right) + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + // Proceed after this switch. + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, (*h.keys)(i), new_val + } + return MalHashmap(val=&res) + } else return ast + // The else branch includes MalError. Now ast is a list. + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step6_file.i b/impls/yorick/step6_file.i new file mode 100644 index 0000000000..9780f11926 --- /dev/null +++ b/impls/yorick/step6_file.i @@ -0,0 +1,193 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) +} + +func EVAL(ast, env) +{ + while (1) { + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + // Process non-list types (todo: indent right) + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + // Proceed after this switch. + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, (*h.keys)(i), new_val + } + return MalHashmap(val=&res) + } else return ast + // The else branch includes MalError. Now ast is a list. + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step7_quote.i b/impls/yorick/step7_quote.i new file mode 100644 index 0000000000..4cd664ac38 --- /dev/null +++ b/impls/yorick/step7_quote.i @@ -0,0 +1,235 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func starts_with(seq, sym) +{ + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step8_macros.i b/impls/yorick/step8_macros.i new file mode 100644 index 0000000000..0060ecec7e --- /dev/null +++ b/impls/yorick/step8_macros.i @@ -0,0 +1,246 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func starts_with(seq, sym) +{ + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "defmacro!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + new_value.macro = 1 + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) + } else { + fn = EVAL(*lst(1), env) + if (structof(fn) == MalError) return fn + if (is_macro(fn)) { + if (numberof(lst) == 1) { + args = [] + } else { + args = lst(2:) + } + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + ast = EVAL(*fn.ast, fn_env) + continue // TCO + } + // Evaluate arguments + if (numberof(lst) == 1) { + args = [] + } else { + args = array(pointer, numberof(lst) - 1) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + args(i) = &e + } + } + // Apply + if (structof(fn) == MalNativeFunction) { + return call_core_fn(fn.val, args) + } else if (structof(fn) == MalFunction) { + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env + RE, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/step9_try.i b/impls/yorick/step9_try.i new file mode 100644 index 0000000000..73df6647b9 --- /dev/null +++ b/impls/yorick/step9_try.i @@ -0,0 +1,267 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func starts_with(seq, sym) +{ + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "defmacro!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + new_value.macro = 1 + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "try*") { + ret = EVAL(*lst(2), env) + if (structof(ret) == MalError && numberof(lst) > 2) { + exc = *ret.obj + if (is_void(exc)) { + exc = MalString(val=ret.message) + } + catch_lst = *(lst(3)->val) + catch_env = env_new(&env) + env_set, catch_env, catch_lst(2)->val, exc + return EVAL(*catch_lst(3), catch_env) + } else { + return ret + } + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) + } else { + fn = EVAL(*lst(1), env) + if (structof(fn) == MalError) return fn + if (is_macro(fn)) { + if (numberof(lst) == 1) { + args = [] + } else { + args = lst(2:) + } + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + ast = EVAL(*fn.ast, fn_env) + continue // TCO + } + // Evaluate arguments + if (numberof(lst) == 1) { + args = [] + } else { + args = array(pointer, numberof(lst) - 1) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + args(i) = &e + } + } + // Apply + if (structof(fn) == MalNativeFunction) { + return call_core_fn(fn.val, args) + } else if (structof(fn) == MalFunction) { + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env + RE, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) { + exc = *result.obj + if (is_void(exc)) { + write, format="Error: %s\n", result.message + } else { + write, format="Error: %s\n", pr_str(exc, 1) + } + } + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/stepA_mal.i b/impls/yorick/stepA_mal.i new file mode 100644 index 0000000000..5251fafe8c --- /dev/null +++ b/impls/yorick/stepA_mal.i @@ -0,0 +1,269 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func starts_with(seq, sym) +{ + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "defmacro!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + new_value.macro = 1 + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "try*") { + ret = EVAL(*lst(2), env) + if (structof(ret) == MalError && numberof(lst) > 2) { + exc = *ret.obj + if (is_void(exc)) { + exc = MalString(val=ret.message) + } + catch_lst = *(lst(3)->val) + catch_env = env_new(&env) + env_set, catch_env, catch_lst(2)->val, exc + return EVAL(*catch_lst(3), catch_env) + } else { + return ret + } + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) + } else { + fn = EVAL(*lst(1), env) + if (structof(fn) == MalError) return fn + if (is_macro(fn)) { + if (numberof(lst) == 1) { + args = [] + } else { + args = lst(2:) + } + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + ast = EVAL(*fn.ast, fn_env) + continue // TCO + } + // Evaluate arguments + if (numberof(lst) == 1) { + args = [] + } else { + args = array(pointer, numberof(lst) - 1) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + args(i) = &e + } + } + // Apply + if (structof(fn) == MalNativeFunction) { + return call_core_fn(fn.val, args) + } else if (structof(fn) == MalFunction) { + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! *host-language* \"yorick\")", repl_env + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env + RE, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + RE, "(println (str \"Mal [\" *host-language* \"]\"))", repl_env + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) { + exc = *result.obj + if (is_void(exc)) { + write, format="Error: %s\n", result.message + } else { + write, format="Error: %s\n", pr_str(exc, 1) + } + } + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/impls/yorick/tests/stepA_mal.mal b/impls/yorick/tests/stepA_mal.mal new file mode 100644 index 0000000000..76bc44ea18 --- /dev/null +++ b/impls/yorick/tests/stepA_mal.mal @@ -0,0 +1,33 @@ +;; Testing basic Yorick interop + +(yorick-eval "7") +;=>7 + +(yorick-eval "\"7\" + \"89\"") +;=>"789" + +(yorick-eval "123 == 123") +;=>1 + +(yorick-eval "123 == 456") +;=>0 + +(yorick-eval "[7, 8, 9]") +;=>(7 8 9) + +(yorick-eval "write, format=\"%s-%d\\x0A\", \"hello\", 1234; return nil;") +;/hello-1234 +;=>nil + +(yorick-eval "extern my_global_var; my_global_var = 8; return nil;") +(yorick-eval "my_global_var") +;=>8 + +(yorick-eval "a = [7, 8, 9]; return a + 10;") +;=>(17 18 19) + +(yorick-eval "[\"ab\", \"cd\", \"ef\"] + [\"X\", \"Y\", \"Z\"]") +;=>("abX" "cdY" "efZ") + +(yorick-eval "strpart(\"ABCDEFGHIJ\", 4:7)") +;=>"DEFG" diff --git a/impls/yorick/types.i b/impls/yorick/types.i new file mode 100644 index 0000000000..a171e31dd1 --- /dev/null +++ b/impls/yorick/types.i @@ -0,0 +1,166 @@ +require, "hash.i" + +struct MalError { + string message + pointer obj +} + +struct MalNil { + int val +} + +MAL_NIL = MalNil() + +struct MalTrue { + int val +} + +MAL_TRUE = MalTrue() + +struct MalFalse { + int val +} + +MAL_FALSE = MalFalse() + +struct MalNumber { + int val +} + +func new_number(s) +{ + return MalNumber(val=atoi(s)) +} + +struct MalSymbol { + string val + pointer meta +} + +struct MalString { + string val + pointer meta +} + +struct MalKeyword { + string val + pointer meta +} + +struct MalList { + pointer val + pointer meta +} + +struct MalVector { + pointer val + pointer meta +} + +func count(obj) { return numberof(*obj.val); } + +func rest(obj) { + seq = count(obj) <= 1 ? [] : ((*obj.val)(2:)) + return MalList(val=&seq) +} + +struct MalHashmap { + pointer val + pointer meta +} + +func hashmap_obj_to_key(obj) { + if (structof(obj) == MalString) return "str:" + obj.val + else if (structof(obj) == MalSymbol) return "sym:" + obj.val + else if (structof(obj) == MalKeyword) return "key:" + obj.val + else error, "Unsupported obj type for hash key" +} + +func hashmap_key_to_obj(key) { + type_str = strpart(key, 1:4) + val = strpart(key, 5:) + if (type_str == "str:") return MalString(val=val) + else if (type_str == "sym:") return MalSymbol(val=val) + else if (type_str == "key:") return MalKeyword(val=val) + else error, "Unsupported key type" +} + +func array_to_hashmap(seq) +{ + if (numberof(seq) % 2 != 0) return MalError(message="Odd number of elements in hashmap") + h = hash_new() + for (i = 1; i <= numberof(seq); i += 2) { + hash_set, h, hashmap_obj_to_key(*seq(i)), *seq(i + 1) + } + return MalHashmap(val=&h) +} + +struct MalNativeFunction { + string val + pointer meta +} + +struct MalFunction { + pointer env + pointer binds + pointer ast + int macro + pointer meta +} + +struct MalAtom { + pointer val + pointer meta +} + +func is_macro(obj) { return (structof(obj) == MalFunction && obj.macro); } + +struct MalAtomVal { + pointer val +} + +func new_boolean(b) { + if (b) return MAL_TRUE + return MAL_FALSE +} + +func equal_seq(seq_a, seq_b) { + if (numberof(seq_a) != numberof(seq_b)) return 0 + for (i = 1; i <= numberof(seq_a); ++i) { + if (!equal(*seq_a(i), *seq_b(i))) return 0 + } + return 1 +} + +func equal_hash(hm_a, hm_b) { + if (numberof(*hm_a.keys) != numberof(*hm_b.keys)) return 0 + for (i = 1; i <= numberof(*hm_a.keys); ++i) { + key_a = (*hm_a.keys)(i) + val_a = *((*hm_a.vals)(i)) + val_b = hash_get(hm_b, key_a) + if (is_void(val_b) || !equal(val_a, val_b)) return 0 + } + return 1 +} + +func equal(a, b) { + ta = structof(a) + tb = structof(b) + if (ta == MalNil) return tb == MalNil + else if (ta == MalTrue) return tb == MalTrue + else if (ta == MalFalse) return tb == MalFalse + else if (ta == MalNumber) return tb == MalNumber && a.val == b.val + else if (ta == MalSymbol) return tb == MalSymbol && a.val == b.val + else if (ta == MalString) return tb == MalString && a.val == b.val + else if (ta == MalKeyword) return tb == MalKeyword && a.val == b.val + else if (ta == MalList || ta == MalVector) { + return (tb == MalList || tb == MalVector) && equal_seq(*(a.val), *(b.val)) + } + else if (ta == MalHashmap) return tb == MalHashmap && equal_hash(*a.val, *b.val) + else return 0 +} + +func streplaceall(s, pattern, subst) +{ + return streplace(s, strfind(pattern, s, n=999), subst) +} diff --git a/impls/zig/Dockerfile b/impls/zig/Dockerfile new file mode 100644 index 0000000000..da927e6f30 --- /dev/null +++ b/impls/zig/Dockerfile @@ -0,0 +1,26 @@ +FROM ubuntu:24.04 +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## +RUN apt-get -y install ca-certificates curl gcc libc6-dev libpcre3-dev libreadline-dev xz-utils + +RUN curl https://ziglang.org/download/0.13.0/zig-linux-x86_64-0.13.0.tar.xz | tar -xJC/opt +RUN ln -fst/usr/local/bin /opt/zig-linux-x86_64-0.13.0/zig + +ENV HOME /mal diff --git a/impls/zig/Makefile b/impls/zig/Makefile new file mode 100644 index 0000000000..1eda252d6a --- /dev/null +++ b/impls/zig/Makefile @@ -0,0 +1,15 @@ + +STEPS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal + +all: $(STEPS) + +zig_opts += --release=safe +zig_opts += -Doptimize=Debug +$(STEPS): + zig build $(zig_opts) -Dname=$@ -Droot_source_file=$@.zig + +.PHONY: all $(STEPS) clean + +clean: + rm -fr .zig-cache/ zig-out/ + rm -f *~ diff --git a/impls/zig/README b/impls/zig/README new file mode 100644 index 0000000000..94ad7da67b --- /dev/null +++ b/impls/zig/README @@ -0,0 +1,24 @@ +debug_alloc in types.zig may help with reference counting. + + +TODO Simplify the printer with the new reader functions in the zig +library. + + +NOTE Before implementing any optimization or optional fix that would +increase the complexity, please take into account that someone has to +maintain the code, and the zig language evolves quickly. + +Some memory leaks are probably already present, especially when an +error interrupts the normal execution flow. + +Examples of things that are deliberately not implemented... + * TCO for try* + * preallocate integers between 0 and 100 at startup + * use ArrayList.ensureTotalCapacityPrecise/HashMap.ensureTotalCapacity + after most calls to new_list/vector/map. + * store symbols in a global hash map, + * implement lists/vectors as slices/cons cells/whatever + * deallocate cyclic structures not detected by reference counting like + (let* (f (fn* () nil))) + (def! a (atom 2)) (def! v [a]) (reset! a v) diff --git a/impls/zig/build.zig b/impls/zig/build.zig new file mode 100644 index 0000000000..8e9232f7eb --- /dev/null +++ b/impls/zig/build.zig @@ -0,0 +1,26 @@ +const Builder = @import("std").Build; + +pub fn build(b: *Builder) void { + + // Two options select the built step. + + const name = b.option([]const u8, "name", "step name (without .zig)") + orelse "stepA_mal"; + + const root_source_file = b.path( + b.option([]const u8, "root_source_file", "step name (with .zig)") + orelse "stepA_mal.zig"); + + const exe = b.addExecutable(.{ + .name = name, + .root_source_file = root_source_file, + .target = b.standardTargetOptions(.{}), + .optimize = b.standardOptimizeOption(.{}), + }); + + exe.linkSystemLibrary("c"); + exe.linkSystemLibrary("pcre"); + exe.linkSystemLibrary("readline"); + b.default_step.dependOn(&exe.step); + b.installArtifact(exe); +} diff --git a/impls/zig/core.zig b/impls/zig/core.zig new file mode 100644 index 0000000000..a9df6e6878 --- /dev/null +++ b/impls/zig/core.zig @@ -0,0 +1,956 @@ +const std = @import("std"); + +const Allocator = std.heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const printer = @import("printer.zig"); +const reader = @import("reader.zig"); +const getline_prompt = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; + +const MalError = @import("error.zig").MalError; + +const hmap = @import("hmap.zig"); + +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const MalHashMap = @import("hmap.zig").MalHashMap; + +// Set by the step file at startup. +pub var apply_function: *const fn(f: MalType, args: []*MalType) MalError!*MalType = undefined; + +const safeAdd = @import("std").math.add; +const safeSub = @import("std").math.sub; +const safeMul = @import("std").math.mul; +const safeDivFloor = @import("std").math.divFloor; + +const stdout_file = std.io.getStdOut(); +const throw = @import("error.zig").throw; + +fn int_plus(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeAdd(i64, x, y); + return MalType.new_int(res); +} + +fn int_minus(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeSub(i64, x, y); + return MalType.new_int(res); +} + +fn int_mult(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeMul(i64, x, y); + return MalType.new_int(res); +} + +fn int_div(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeDivFloor(i64, x, y); + return MalType.new_int(res); +} + +fn int_lt(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + return MalType.new_bool((try a1.as_int()) < (try a2.as_int())); +} + +fn int_leq(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + return MalType.new_bool((try a1.as_int()) <= (try a2.as_int())); +} + +fn int_gt(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + return MalType.new_bool((try a1.as_int()) > (try a2.as_int())); +} + +fn int_geq(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + return MalType.new_bool((try a1.as_int()) >= (try a2.as_int())); +} + +fn _linked_list_equality(l1: []const *MalType, l2:[]const *MalType) bool { + if(l1.len != l2.len) return false; + for(l1, l2) |m1, m2| { + if(! _equality(m1.*, m2.*)) { + return false; + } + } + return true; +} + +fn _hashmap_equality(h1: MalHashMap, h2: MalHashMap) bool { + if(h1.count() != h2.count()) { + return false; + } + + var iterator = h1.iterator(); + while(iterator.next()) |pair| { + const optional_val = h2.get(pair.key_ptr.*); + if(optional_val) |val| { + const el_cmp = _equality(pair.value_ptr.*.*, val.*); + if(! el_cmp) { + return false; + } + } + else { + return false; + } + } + return true; +} + +fn equality(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + return MalType.new_bool(_equality(a1.*, a2.*)); +} + +fn _equality(a1: MalType, a2: MalType) bool { + switch(a1) { + .Nil => { + switch(a2) { + .Nil => return true, + else => return false, + } + }, + .False => { + switch(a2) { + .False => return true, + else => return false, + } + }, + .True => { + switch(a2) { + .True => return true, + else => return false, + } + }, + .Int => |l1| { + switch(a2) { + .Int => |l2| return l1.data == l2.data, + else => return false, + } + }, + .String => |s1| { + switch(a2) { + .String => |s2| return string_eql(s1.data, s2.data), + else => return false, + } + }, + .Symbol => |s1| { + switch(a2) { + .Symbol => |s2| return string_eql(s1.data, s2.data), + else => return false, + } + }, + .Keyword => |s1| { + switch(a2) { + .Keyword => |s2| return string_eql(s1.data, s2.data), + else => return false, + } + }, + .List, .Vector => |l1| { + switch(a2) { + .List, .Vector => |l2| return _linked_list_equality( + l1.data.items, l2.data.items), + else => return false, + } + }, + .HashMap => |h1| { + switch(a2) { + .HashMap => |h2| return _hashmap_equality(h1.data, h2.data), + else => return false, + } + }, + else => { + return false; + }, + } +} + +fn list(args: []*MalType) !*MalType { + const new_mal = try MalType.new_list(); + errdefer new_mal.decref(); + for(args) |x| { + try new_mal.List.data.append(Allocator, x); + x.incref(); + } + return new_mal; +} + +fn vector(args: []*MalType) !*MalType { + const new_mal = try MalType.new_vector(); + errdefer new_mal.decref(); + for(args) |x| { + try new_mal.Vector.data.append(Allocator, x); + x.incref(); + } + return new_mal; +} + +fn map(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const func_mal = args[0]; + const args_mal = args[1]; + var to_map_ll = try args_mal.as_slice(); + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + for(0..to_map_ll.len) |i| { + const new_mal = try apply_function(func_mal.*, to_map_ll[i..i+1]); + try new_list.List.data.append(Allocator, new_mal); + } + return new_list; +} + +fn is_list(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .List => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_vector(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .Vector => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_string(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .String => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_number(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .Int => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_fn(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const is_function = switch(a1.*) { + .FnCore => true, + .Func => |func_data| ! func_data.is_macro, + else => false, + }; + return MalType.new_bool(is_function); +} + +fn is_macro(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const is_func_and_macro = switch(a1.*) { + .Func => |data| data.is_macro, + else => false, + }; + return MalType.new_bool(is_func_and_macro); +} + +fn empty(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const slice = try a1.as_slice(); + return MalType.new_bool(slice.len == 0); +} + +fn prn(args: []*MalType) MalError!*MalType { + try printer.n_stdout(args, true, true); + try stdout_file.writeAll("\n"); + const mal = &MalType.NIL; + return mal; +} + +fn println(args: []*MalType) !*MalType { + try printer.n_stdout(args, false, true); + try stdout_file.writeAll("\n"); + const mal = &MalType.NIL; + return mal; +} + +fn str(args: []*MalType) !*MalType { + const items = try printer.print_mal_to_string(args, false, false); + errdefer Allocator.free(items); + return MalType.new_string(items, false); +} + +fn pr_str(args: []*MalType) !*MalType { + const s = try printer.print_mal_to_string(args, true, true); + errdefer Allocator.free(s); + return MalType.new_string(s, false); +} + +fn slurp(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const path = try a1.as_string(); + const dir = std.fs.cwd(); + const items = try dir.readFileAlloc(Allocator, path, 10000); + return MalType.new_string(items, false); +} + +fn atom(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const result = try MalType.new_atom(a1); + a1.incref(); + return result; +} + +fn is_atom(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + return switch(args[0].*) { + .Atom => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn deref(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + switch(a1.*) { + .Atom => |atom_val| { + atom_val.data.incref(); + return atom_val.data; + }, + else => return MalError.TypeError, + } +} + +fn atom_reset(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + switch(a1.*) { + .Atom => |*atom_val| { + atom_val.data.decref(); + atom_val.data = a2; + // incref for the atom and for the result + a2.incref(); + a2.incref(); + return a2; + }, + else => return MalError.TypeError, + } +} + +fn atom_swap(args: []*MalType) !*MalType { + const n = args.len; + if(n < 2) return MalError.ArgError; + + const atom_val = switch(args[0].*) { + .Atom => |*a| a, + else => return MalError.TypeError, + }; + + var new_args = try Allocator.alloc(*MalType, args.len - 1); + defer Allocator.free(new_args); + var i:usize = 0; + new_args[i] = atom_val.data; i+=1; + for(args[2..args.len]) |x| { + new_args[i] = x; + i += 1; + } + std.debug.assert(i == new_args.len); + + const new_mal = try apply_function(args[1].*, new_args); + atom_val.data.decref(); // after the computation + atom_val.data = new_mal; + new_mal.incref(); + return new_mal; +} + +fn vec(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + switch(a1.*) { + .List => |l| { + const result = try MalType.new_vector(); + errdefer result.decref(); + for(l.data.items) |x| { + try result.Vector.data.append(Allocator, x); + x.incref(); + } + return result; + }, + .Vector => { + a1.incref(); + return a1; + }, + else => return MalError.TypeError, + } +} + +fn cons(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const old_ll = try a2.as_slice(); + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, a1); + a1.incref(); + for(old_ll) |x| { + try new_list.List.data.append(Allocator, x); + x.incref(); + } + return new_list; +} + +pub fn concat(args: []*MalType) !*MalType { + const new_mal = try MalType.new_list(); + errdefer new_mal.decref(); + for(args) |x| { + for(try x.as_slice()) |y| { + try new_mal.List.data.append(Allocator, y); + y.incref(); + } + } + return new_mal; +} + +fn rest(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const new_mal = try MalType.new_list(); + errdefer new_mal.decref(); + switch(a1.*) { + .List, .Vector => |l| { + const old_list = l.data.items; + if(old_list.len != 0) { + for(l.data.items[1..]) |x| { + try new_mal.List.data.append(Allocator, x); + x.incref(); + } + } + }, + .Nil => { }, + else => return MalError.TypeError, + } + return new_mal; +} + +fn nth(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const l = try a1.as_slice(); + const i = try a2.as_int(); + const pos: usize = @intCast(i); + if(pos < 0 or l.len <= pos) { + return MalError.OutOfBounds; + } + const result = l[pos]; + result.incref(); + return result; +} + +fn first(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + switch(a1.*) { + .List, .Vector => |l| { + if(l.data.items.len == 0) return &MalType.NIL; + const result = l.data.items[0]; + result.incref(); + return result; + }, + .Nil => return &MalType.NIL, + else => return MalError.TypeError, + } +} + +fn is_nil(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .Nil => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_true(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .True => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_false(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .False => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_symbol(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .Symbol => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_keyword(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .Keyword => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_map(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .HashMap => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn is_sequential(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return switch(a1.*) { + .List, .Vector => &MalType.TRUE, + else => &MalType.FALSE, + }; +} + +fn symbol(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const string = try a1.as_string(); + return MalType.new_symbol(string, true); +} + +pub fn hash_map(args: []*MalType) !*MalType { + const new_mal = try MalType.new_hashmap(); + errdefer new_mal.decref(); + try hmap.map_insert_from_kvs(&new_mal.HashMap.data, args); + return new_mal; +} + +pub fn hash_map_assoc(args: []*MalType) !*MalType { + if(args.len < 1) return MalError.ArgError; + const a1 = args[0]; + const new_mal = try MalType.new_hashmap(); + errdefer new_mal.decref(); + const base_hmap = try a1.as_map(); + try hmap.map_insert_from_map(&new_mal.HashMap.data, base_hmap); + try hmap.map_insert_from_kvs(&new_mal.HashMap.data, args[1..]); + return new_mal; +} + +pub fn hash_map_dissoc(args: []*MalType) !*MalType { + if(args.len < 1) return MalError.ArgError; + const a1 = args[0]; + const new_mal = try MalType.new_hashmap(); + errdefer new_mal.decref(); + const base_hmap = try a1.as_map(); + try hmap.map_insert_from_map(&new_mal.HashMap.data, base_hmap); + for(args[1..]) |k| { + switch(k.*) { + .Keyword, .String => { + if(new_mal.HashMap.data.fetchRemove(k)) |old| { + old.key.decref(); + old.value.decref(); + } + }, + else => return MalError.TypeError, + } + } + return new_mal; +} + +fn hash_map_get(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const hm = switch(a1.*) { + .HashMap => |m| m.data, + .Nil => return &MalType.NIL, + else => return MalError.TypeError, + }; + switch(a2.*) { + .Keyword, .String => {}, + else => return MalError.TypeError, + } + if(hm.get(a2)) |value| { + value.incref(); + return value; + } + return &MalType.NIL; +} + +fn hash_map_contains(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + switch(a2.*) { + .Keyword, .String => { + const hm = try a1.as_map(); + return MalType.new_bool(hm.contains(a2)); + }, + else => return MalError.TypeError, + } +} + +fn hash_map_keys(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const hm = try a1.as_map(); + const new_mal = try MalType.new_list(); + errdefer new_mal.decref(); + var iterator = hm.keyIterator(); + while(iterator.next()) |key_mal| { + try new_mal.List.data.append(Allocator, key_mal.*); + key_mal.*.incref(); + } + return new_mal; +} + +fn hash_map_vals(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const hm = try a1.as_map(); + const new_mal = try MalType.new_list(); + errdefer new_mal.decref(); + var iterator = hm.valueIterator(); + while(iterator.next()) |val| { + try new_mal.List.data.append(Allocator, val.*); + val.*.incref(); + } + return new_mal; +} + +fn sequence_length(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const len = switch(a1.*) { + .List, .Vector => |l| l.data.items.len, + .String => |s| s.data.len, + .Nil => 0, + else => return MalError.TypeError, + }; + return MalType.new_int(@intCast(len)); +} + +fn keyword(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + switch(a1.*) { + .String => |s| { + return MalType.new_keyword(s.data, true); + }, + .Keyword => { + a1.incref(); + return a1; + }, + else => return MalError.TypeError, + } +} + +fn core_readline(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const prompt = try a1.as_string(); + const optional_read_line = try getline_prompt(prompt); + if(optional_read_line) |read_line| { + return MalType.new_string(read_line, false); + } + return &MalType.NIL; +} + +fn time_ms(args: []*MalType) !*MalType { + if(args.len != 0) return MalError.ArgError; + const itime = std.time.milliTimestamp(); + return try MalType.new_int(@intCast(itime)); +} + +fn meta(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const result = switch(a1.*) { + .List, .Vector => |l| l.metadata, + .FnCore => |l| l.metadata, + .Func => |l| l.metadata, + .HashMap => |l| l.metadata, + else => return MalError.TypeError, + }; + result.incref(); + return result; +} + +fn with_meta(args: []*MalType) !*MalType { + if(args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + switch(a1.*) { + .List => |l| { + const new_mal = try MalType.new_list(); + errdefer new_mal.decref(); + for(l.data.items) |x| { + try new_mal.List.data.append(Allocator, x); + x.incref(); + } + new_mal.List.metadata = a2; + a2.incref(); + return new_mal; + }, + .Vector => |l| { + const new_mal = try MalType.new_vector(); + errdefer new_mal.decref(); + for(l.data.items) |x| { + try new_mal.Vector.data.append(Allocator, x); + x.incref(); + } + new_mal.Vector.metadata = a2; + a2.incref(); + return new_mal; + }, + .FnCore => |l| { + const new_mal = try MalType.newFnCore(l.data); + new_mal.FnCore.metadata = a2; + a2.incref(); + return new_mal; + }, + .Func => |l| { + const new_mal = try MalType.newFunc(l.arg_list, l.body, + l.environment); + l.arg_list.incref(); + l.body.incref(); + l.environment.incref(); + new_mal.Func.metadata = a2; + a2.incref(); + return new_mal; + }, + .HashMap => |l| { + const new_mal = try MalType.new_hashmap(); + errdefer new_mal.decref(); + try hmap.map_insert_from_map(&new_mal.HashMap.data, l.data); + new_mal.HashMap.metadata = a2; + a2.incref(); + return new_mal; + }, + else => return MalError.TypeError, + } +} + +fn seq(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + switch(a1.*) { + .List => |l| { + if(l.data.items.len == 0) return &MalType.NIL; + a1.incref(); + return a1; + }, + .Vector => |l| { + if(l.data.items.len == 0) return &MalType.NIL; + const mal_copy = try MalType.new_list(); + errdefer mal_copy.decref(); + for(l.data.items) |x| { + try mal_copy.List.data.append(Allocator, x); + x.incref(); + } + return mal_copy; + }, + .String => |s| { + if(s.data.len == 0) return &MalType.NIL; + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + for(s.data) |x| { + const one_char = try Allocator.alloc(u8, 1); + one_char[0] = x; + const new_char = try MalType.new_string(one_char, false); + errdefer new_char.decref(); + try new_list.List.data.append(Allocator, new_char); + } + return new_list; + }, + .Nil => { + return &MalType.NIL; + }, + else => { + return MalError.TypeError; + } + } +} + +pub fn conj(args: []*MalType) !*MalType { + if(args.len == 0) return MalError.ArgError; + const container = args[0]; + switch(container.*) { + .List => |l| { + const return_mal = try MalType.new_list(); + errdefer return_mal.decref(); + for(1..args.len) |j| { + const new_item = args[args.len-j]; + try return_mal.List.data.append(Allocator, new_item); + new_item.incref(); + } + for(l.data.items) |x| { + try return_mal.List.data.append(Allocator, x); + x.incref(); + } + return return_mal; + }, + .Vector => |l|{ + const return_mal = try MalType.new_vector(); + errdefer return_mal.decref(); + for(l.data.items) |x| { + try return_mal.Vector.data.append(Allocator, x); + x.incref(); + } + for(args[1..]) |x| { + try return_mal.Vector.data.append(Allocator, x); + x.incref(); + } + return return_mal; + }, + else => return MalError.ArgError, + } +} + +fn read_string(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + const str_to_eval = try a1.as_string(); + var read = try reader.read_str(str_to_eval); + return reader.read_form(&read); +} + +pub fn do_apply(args: []*MalType) !*MalType { + if(args.len < 2) return MalError.ArgError; + const a1 = args[0]; + const last = args[args.len - 1]; + const more_args = try last.as_slice(); + var fargs = try Allocator.alloc(*MalType, args.len + more_args.len - 2); + defer Allocator.free(fargs); + var i:usize = 0; + for(args[1..args.len-1]) |x| { fargs[i] = x; i+=1; } + for(more_args) |x| { fargs[i] = x; i+=1; } + std.debug.assert(i == fargs.len); + return apply_function(a1.*, fargs); +} + +pub fn core_throw(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return throw(a1); +} + +pub const CorePair = struct { + name: []const u8, + func: *const fn(args: []*MalType) MalError!*MalType, +}; + +pub const core_namespace = [_]CorePair { + .{ .name = "+", .func = &int_plus }, + .{ .name = "-", .func = &int_minus }, + .{ .name = "*", .func = &int_mult }, + .{ .name = "/", .func = &int_div }, + .{ .name = "<", .func = &int_lt }, + .{ .name = "<=", .func = &int_leq }, + .{ .name = ">", .func = &int_gt }, + .{ .name = ">=", .func = &int_geq }, + .{ .name = "=", .func = &equality }, + .{ .name = "list?", .func = &is_list }, + .{ .name = "vector?", .func = &is_vector }, + .{ .name = "count", .func = &sequence_length }, + .{ .name = "list", .func = &list, }, + .{ .name = "vector", .func = &vector, }, + .{ .name = "map", .func = &map }, + .{ .name = "empty?", .func = &empty }, + .{ .name = "prn", .func = &prn }, + .{ .name = "println", .func = &println }, + .{ .name = "pr-str", .func = &pr_str }, + .{ .name = "str", .func = &str }, + .{ .name = "slurp", .func = &slurp }, + .{ .name = "atom", .func = &atom }, + .{ .name = "atom?", .func = &is_atom }, + .{ .name = "deref", .func = &deref }, + .{ .name = "reset!", .func = &atom_reset }, + .{ .name = "swap!", .func = &atom_swap }, + .{ .name = "vec", .func = &vec }, + .{ .name = "cons", .func = &cons }, + .{ .name = "concat", .func = &concat }, + .{ .name = "rest", .func = &rest }, + .{ .name = "nth", .func = &nth }, + .{ .name = "first", .func = &first }, + .{ .name = "nil?", .func = &is_nil }, + .{ .name = "true?", .func = &is_true }, + .{ .name = "false?", .func = &is_false }, + .{ .name = "symbol", .func = &symbol }, + .{ .name = "symbol?", .func = &is_symbol }, + .{ .name = "keyword?", .func = &is_keyword }, + .{ .name = "map?", .func = &is_map }, + .{ .name = "sequential?", .func = &is_sequential }, + .{ .name = "apply", .func = &do_apply }, + .{ .name = "hash-map", .func = &hash_map }, + .{ .name = "assoc", .func = &hash_map_assoc }, + .{ .name = "dissoc", .func = &hash_map_dissoc }, + .{ .name = "get", .func = &hash_map_get }, + .{ .name = "contains?", .func = &hash_map_contains }, + .{ .name = "keys", .func = &hash_map_keys }, + .{ .name = "vals", .func = &hash_map_vals }, + .{ .name = "keyword", .func = &keyword }, + .{ .name = "read-string", .func = &read_string }, + .{ .name = "readline", .func = &core_readline }, + .{ .name = "time-ms", .func = &time_ms }, + .{ .name = "meta", .func = &meta }, + .{ .name = "with-meta", .func = &with_meta }, + .{ .name = "fn?", .func = &is_fn }, + .{ .name = "string?", .func = &is_string }, + .{ .name = "number?", .func = &is_number }, + .{ .name = "macro?", .func = &is_macro }, + .{ .name = "seq", .func = &seq }, + .{ .name = "conj", .func = &conj }, + .{ .name = "throw", .func = &core_throw }, +}; diff --git a/impls/zig/env.zig b/impls/zig/env.zig new file mode 100644 index 0000000000..8abafc1d97 --- /dev/null +++ b/impls/zig/env.zig @@ -0,0 +1,110 @@ +const std = @import("std"); +const warn = std.log.warn; +const allocator = std.heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalHashMap = @import("hmap.zig").MalHashMap; +const MalError = @import("error.zig").MalError; +const hash_map = @import("hmap.zig"); +const debug_alloc = @import("types.zig").debug_alloc; + +pub const Env = struct { + outer: ?*Env, + data: MalHashMap, + refcount: i32 = 1, + + pub fn new_root() Env { + return .{.outer = null, .data = .{}}; + } + + pub fn new(outer: *Env) !*Env { + // The caller is in charge of incremeting the reference count + // for outer if necessary. + const env = try allocator.create(Env); + env.* = .{ .outer = outer, .data = .{} }; + if(debug_alloc) warn("Env: new {any}", .{env}); + return env; + } + + pub fn incref(env: *Env) void { + if(debug_alloc) { + warn("Env: incref {any}", .{env}); + } + env.refcount += 1; + // std.debug.assert(env.refcount < 100); + } + + pub fn decref(env: *Env) void { + var e = env; + while (true) { + if(debug_alloc) { + warn("Env: decref {any}", .{e}); + e.print_keys(); + } + std.debug.assert (0 < e.refcount); + e.refcount -= 1; + if(0 < e.refcount) { + break; + } + if(debug_alloc) { + warn("Env: FREE {any}", .{e}); + } + const old = e; + if(e.outer) |outer| { + e = outer; + } else { + warn("INTERNAL ERROR: repl-env should never reach a 0 refcount.", .{}); + break; + } + hash_map.map_destroy(&old.data); + allocator.destroy(old); + } + } + + // Incref both the key and value. + pub fn set(env: *Env, key: *MalType, value: *MalType) !void { + // The caller is in charge of incremeting the reference count + // for the value if necessary. + switch (key.*) { + .Symbol => { + if(debug_alloc) { + warn("Env: set {s} {any}", .{key.Symbol.data, key}); + } + try hash_map.map_insert_incref_key(&env.data, key, value); + }, + else => return MalError.ArgError, + } + } + + pub fn get(env: Env, key: *MalType) !?*MalType { + // The result is not increfed(). + switch (key.*) { + .Symbol => { + if(debug_alloc) { + warn("Env: get {s} {any}", .{key.Symbol.data, key}); + } + var e: * const Env = &env; + while(true) { + if(e.data.get(key)) |value| { + return value; + } + e = e.outer orelse return null; + } + }, + else => return MalError.KeyError, + } + } + + pub fn print_keys(env: Env) void { + var it = env.data.keyIterator(); + var count: i32 = 5; + while (it.next()) |key| { + warn(" key={s},", .{key.*.Symbol.data}); + count -= 1; + if(count <= 0) { + warn(" ...", .{}); + break; + } + } + } +}; diff --git a/impls/zig/error.zig b/impls/zig/error.zig new file mode 100644 index 0000000000..b5ca016bca --- /dev/null +++ b/impls/zig/error.zig @@ -0,0 +1,71 @@ +const assert = @import("std").debug.assert; +const MalType = @import("types.zig").MalType; + +pub const MalError = error { + SystemError, + ApplyError, + KeyError, + ThrownError, + TypeError, + ArgError, + Overflow, + DivisionByZero, + OutOfBounds, + + OutOfMemory, + + InvalidCharacter, + + DiskQuota, + FileTooBig, + InputOutput, + NoSpaceLeft, + DeviceBusy, + InvalidArgument, + AccessDenied, + BrokenPipe, + SystemResources, + OperationAborted, + NotOpenForWriting, + LockViolation, + WouldBlock, + ConnectionResetByPeer, + Unexpected, + + InvalidUtf8, + SharingViolation, + PathAlreadyExists, + FileNotFound, + PipeBusy, + NameTooLong, + InvalidWtf8, + BadPathName, + NetworkNotFound, + AntivirusInterference, + SymLinkLoop, + ProcessFdQuotaExceeded, + SystemFdQuotaExceeded, + NoDevice, + IsDir, + NotDir, + FileLocksNotSupported, + FileBusy, + Unseekable, + ConnectionTimedOut, + NotOpenForReading, + SocketNotConnected, +}; + +var error_data: ?*MalType = null; + +pub fn throw(mal: *MalType) MalError { + assert(error_data == null); + error_data = mal; + mal.incref(); + return MalError.ThrownError; +} + +pub fn get_error_data() ?*MalType { + defer error_data = null; + return error_data; +} diff --git a/impls/zig/hmap.zig b/impls/zig/hmap.zig new file mode 100644 index 0000000000..7611f6fa4b --- /dev/null +++ b/impls/zig/hmap.zig @@ -0,0 +1,92 @@ +const warn = @import("std").log.warn; +const allocator = @import("std").heap.c_allocator; + +const hash_map = @import("std").hash_map; +const MalType = @import("types.zig").MalType; +const string_eql = @import("std").hash_map.eqlString; +const MalError = @import("error.zig").MalError; +const debug_alloc = @import("types.zig").debug_alloc; + +const Context = struct { + + pub fn hash(_: @This(), key: *MalType) u64 { + return switch(key.*) { + .Symbol, .String, .Keyword => |s| hash_map.hashString(s.data), + else => unreachable, + }; + } + + pub fn eql(_: @This(), ma: *MalType, mb: *MalType) bool { + return switch(ma.*) { + .Keyword => |a| switch(mb.*) { + .Keyword => |b| string_eql(a.data, b.data), + else => false, + }, + .String => |a| switch(mb.*) { + .String => |b| string_eql(a.data, b.data), + else => false, + }, + .Symbol => |a| switch(mb.*) { + .Symbol => |b| string_eql(a.data, b.data), + else => false, + }, + else => unreachable, + }; + } +}; + + +pub const MalHashMap = hash_map.HashMapUnmanaged(*MalType, *MalType, + Context, 80); + +pub fn map_destroy(hashmap: *MalHashMap) void { + if (debug_alloc) { + warn("destroy_map_elements", .{}); + } + var iterator = hashmap.iterator(); + while(iterator.next()) |pair| { + pair.key_ptr.*.decref(); + pair.value_ptr.*.decref(); + } + hashmap.deinit(allocator); +} + +// If the key was present in the map, the implementation reuses it, +// instead of the new one. So we need to increment the reference +// counting for the key here. +// The ref count of the value is not incremented here. +pub fn map_insert_incref_key(hashmap: *MalHashMap, key: *MalType, value: *MalType) !void { + switch(key.*) { + .String, .Keyword, .Symbol => { + if (try hashmap.fetchPut(allocator, key, value)) |old| { + // No change in the key reference count. + old.value.decref(); + } else { + key.incref(); + } + }, + else => return MalError.TypeError, + } +} + +pub fn map_insert_from_map(hashmap: *MalHashMap, from: MalHashMap) !void { + var iterator = from.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + try map_insert_incref_key(hashmap, key, value); + value.incref(); + } +} + +pub fn map_insert_from_kvs(hashmap: *MalHashMap, kvs: []const *MalType) !void { + if (kvs.len % 2 == 1) { + return MalError.TypeError; + } + for (0..kvs.len/2) |i| { + const key = kvs[2*i]; + const value = kvs[2*i+1]; + try map_insert_incref_key(hashmap, key, value); + value.incref(); + } +} diff --git a/impls/zig/linked_list.zig b/impls/zig/linked_list.zig new file mode 100644 index 0000000000..ff21bb32a8 --- /dev/null +++ b/impls/zig/linked_list.zig @@ -0,0 +1,13 @@ +const allocator = @import("std").heap.c_allocator; +const ArrayListUnmanaged = @import("std").ArrayListUnmanaged; +const MalType = @import("types.zig").MalType; + +// The name is poorly choosen but historical. + +pub const MalLinkedList = ArrayListUnmanaged(*MalType); + +pub fn list_destroy(ll: *MalLinkedList) void { + for(ll.items) |x| + x.decref(); + ll.deinit(allocator); +} diff --git a/impls/zig/printer.zig b/impls/zig/printer.zig new file mode 100644 index 0000000000..30d6361a9b --- /dev/null +++ b/impls/zig/printer.zig @@ -0,0 +1,114 @@ +const std = @import("std"); +const stdout_writer = std.io.getStdOut().writer(); +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; + +// TODO fix emacs highlighting, remove this +const backslash = + \\\ +; + +pub fn one_stdout(mal: MalType) !void { + try print_to_buffer(mal, stdout_writer, true); +} + +pub fn n_stdout(args: []const *MalType, readably: bool, sep: bool) !void { + try n_writer(stdout_writer, args, readably, sep); +} + +fn n_writer(rb: anytype, args: []const *MalType, readable: bool, sep: bool) !void { + for (args, 0..) |node, idx| { + if(0 < idx and sep) { + try rb.writeAll(" "); + } + try print_to_buffer(node.*, rb, readable); + } +} + +pub fn print_mal_to_string(args: []const *MalType, readable: bool, sep: bool) ![]u8 { + var rb = std.ArrayListUnmanaged(u8) { }; + errdefer rb.deinit(Allocator); + const writer = rb.writer(Allocator); + try n_writer(writer, args, readable, sep); + return rb.toOwnedSlice(Allocator); +} + +fn print_to_buffer(mal: MalType, rb: anytype, readable: bool) MalError!void { + switch(mal) { + .String => |string| { + if(readable) { + try rb.writeAll("\""); + // TODO: optimize this + for(string.data, 0..) |this_char, i| { + if(this_char == '"' or this_char==92) { + try rb.writeAll(backslash); + } + if(this_char == '\n') { + try rb.writeAll("\\n"); + } + else { + try rb.writeAll(string.data[i..i+1]); + } + } + try rb.writeAll("\""); + } + else { + try rb.writeAll(string.data); + } + }, + .Keyword => |kwd| { + try rb.writeAll(":"); + try rb.writeAll(kwd.data); + }, + .Int => |val| { + try rb.print("{0}", .{val.data}); + }, + .Nil => { + try rb.writeAll("nil"); + }, + .True => { + try rb.writeAll("true"); + }, + .False => { + try rb.writeAll("false"); + }, + .List => |l| { + try rb.writeAll("("); + try n_writer(rb, l.data.items, readable, true); + try rb.writeAll(")"); + }, + .Vector => |v| { + try rb.writeAll("["); + try n_writer(rb, v.data.items, readable, true); + try rb.writeAll("]"); + }, + .Atom => |atom_value| { + try rb.writeAll("(atom "); + try print_to_buffer(atom_value.data.*, rb, readable); + try rb.writeAll(")"); + }, + .Func, .FnCore => { + try rb.writeAll("#"); + }, + .Symbol => |value| { + try rb.writeAll(value.data); + }, + .HashMap => |h| { + try rb.writeAll("{"); + var iterator = h.data.iterator(); + var first = true; + while(iterator.next()) |pair| { + if(!first) { + try rb.writeAll(" "); + } + try print_to_buffer(pair.key_ptr.*.*, rb, true); + try rb.writeAll(" "); + try print_to_buffer(pair.value_ptr.*.*, rb, readable); + first = false; + } + try rb.writeAll("}"); + }, + } +} diff --git a/impls/zig/reader.zig b/impls/zig/reader.zig new file mode 100644 index 0000000000..d7d6e51d95 --- /dev/null +++ b/impls/zig/reader.zig @@ -0,0 +1,263 @@ +const fmt = @import("std").fmt; + +const pcre = @cImport({ + @cInclude("pcre.h"); +}); + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; + +const Allocator = @import("std").heap.c_allocator; +const string_eql = @import("std").hash_map.eqlString; +const linked_list = @import("linked_list.zig"); +const assert = @import("std").debug.assert; +const throw = @import("error.zig").throw; +const MalHashMap = @import("hmap.zig").MalHashMap; +const map_insert_incref_key = @import("hmap.zig").map_insert_incref_key; + +const match: [*]const u8 = + \\[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*) +; +var error_msg: [*c]const u8 = undefined; +var erroroffset: c_int = 0; +var re: ?*pcre.pcre = null; + +const Reader = struct { + position: u32, + string: [] const u8, + tokens: [] usize, + + pub fn init(string: [] const u8, tokens: [] usize) Reader { + return Reader { + .position = 0, + .string = string, + .tokens = tokens, + }; + } + + pub fn next(self: *Reader) void { + self.position += 1; + } + + pub fn peek(self: *Reader) ?[]const u8 { + while(!self.eol()) { + const start = self.tokens[2*self.position]; + const end = self.tokens[2*self.position+1]; + if(self.string[start] == ';') { + self.position += 1; + continue; + } + return self.string[start..end]; + } + return null; + } + + pub fn eol(self: *Reader) bool { + return (2 * self.position >= self.tokens.len); + } +}; + +const AliasPair = struct { + name: []const u8, + value: []const u8, + count: u8, +}; + +const alias_pairs = [_] AliasPair { + AliasPair {.name="@", .value="deref", .count=1}, + AliasPair {.name="\'", .value="quote", .count=1}, + AliasPair {.name="`", .value="quasiquote", .count=1}, + AliasPair {.name="~", .value="unquote", .count=1}, + AliasPair {.name="~@", .value="splice-unquote", .count=1}, + AliasPair {.name="^", .value="with-meta", .count=2}, +}; + +pub fn read_form(reader: *Reader) MalError!*MalType { + const token = reader.peek() orelse return MalError.ArgError; + reader.next(); + if(token[0] == '(') { + return try read_list(reader); + } + else if(token[0] == '[') { + return try read_vector(reader); + } + else if(token[0] == ':') { + return MalType.new_keyword(token[1..], true); + } + else if(token[0] == '{') { + return try read_hashmap(reader); + } + for(alias_pairs) |pair| { + const name = pair.name; + const value = pair.value; + const count = pair.count; + if(string_eql(token, name)) { + assert (count == 1 or count == 2); + const result = try MalType.new_list(); + errdefer result.decref(); + const first = try MalType.new_symbol(value, true); + try result.List.data.append(Allocator, first); + for(0..count) |_| { + const second = try read_form(reader); + errdefer second.decref(); + try result.List.data.insert(Allocator, 1, second); + } + return result; + } + } + if(token_is_int(token)) { + const value = try fmt.parseInt(i32, token, 10); + return try MalType.new_int(value); + } + else if(string_eql(token, "nil")) { + return &MalType.NIL; + } + else if(string_eql(token, "true")) { + return &MalType.TRUE; + } + else if(string_eql(token, "false")) { + return &MalType.FALSE; + } + else if(token[0] == '"') { + return try read_atom_string(token); + } + else { + return try MalType.new_symbol(token, true); + } +} + +fn read_list(reader: *Reader) !*MalType { + const result = try MalType.new_list(); + errdefer result.decref(); + while(try read_list_element(reader, ')', "unbalanced '('")) |mal| { + try result.List.data.append(Allocator, mal); + } + return result; +} + +fn read_vector(reader: *Reader) !*MalType { + const result = try MalType.new_vector(); + errdefer result.decref(); + while(try read_list_element(reader, ']', "unbalanced '['")) |mal| { + try result.Vector.data.append(Allocator, mal); + } + return result; +} + +fn read_hashmap(reader: *Reader) !*MalType { + const result = try MalType.new_hashmap(); + errdefer result.decref(); + while(try read_list_element(reader, '}', "unbalanced '{'")) |key| { + const value = try read_form(reader); + errdefer value.decref(); + try map_insert_incref_key(&result.HashMap.data, key, value); + key.decref(); + } + return result; +} + +fn read_list_element(reader: *Reader, + comptime closer: u8, + comptime unbalanced: []const u8, + ) !?*MalType { + if(reader.peek()) |next_token| { + if(next_token[0] == closer) { + reader.next(); + return null; + } + return try read_form(reader); + } + return throw(try MalType.new_string(unbalanced, true)); +} + +fn char_is_int(c: u8) bool { + return (c >= '0' and c <= '9'); +} + +fn token_is_int(token: []const u8) bool { + if(char_is_int(token[0])) + return true; + if(token.len >= 2 and token[0] == '-' and char_is_int(token[1])) + return true; + return false; +} + +fn read_atom_string(token: []const u8) MalError!*MalType { + const n = token.len; + if(token[0] != '"' or token[n-1] != '"' or n <= 1) { + return throw(try MalType.new_string("unbalanced '\"'", true)); + } + + var tmp_buffer = try Allocator.alloc(u8, n-2); + errdefer Allocator.free(tmp_buffer); + var i: usize = 1; + var j: usize = 0; + const escape_char: u8 = '\\'; //TODO: remove this comment required by bad emacs config ' + while(i < n-1) { + if(token[i] != escape_char) { + tmp_buffer[j] = token[i]; + j += 1; + i += 1; + } + else { + if(i==n-2) { + return throw(try MalType.new_string("unbalanced '\"'", true)); + } + if(token[i+1] == 'n') { + tmp_buffer[j] = '\n'; + } else { + tmp_buffer[j] = token[i+1]; + } + j += 1; + i += 2; + } + } + + return try MalType.new_string(tmp_buffer[0..j], false); +} + +pub fn read_str(string: [] const u8) MalError!Reader { + if(re == null) { + re = pcre.pcre_compile(&match[0], 0, &error_msg, &erroroffset, 0); + } + const tokens = try tokenize(re, string); + return Reader.init(string, tokens); +} + +// Allocates an array of matches. Caller is becomes owner of memory. +fn tokenize(regex: ?*pcre.pcre, string: [] const u8) MalError![] usize { + // TODO: pass in allocator + const buffer_size: usize = 3 * string.len + 10; + var indices: [] c_int = try Allocator.alloc(c_int, buffer_size); + defer Allocator.free(indices); + var match_buffer: [] usize = try Allocator.alloc(usize, buffer_size); + defer Allocator.free(match_buffer); + var current_match: usize = 0; + var start_pos: c_int = 0; + + var rc: c_int = 0; + var start_match: usize = 0; + var end_match: usize = 0; + const subject_size: c_int = @intCast(string.len); + + while(start_pos < subject_size) { + rc = pcre.pcre_exec(regex, 0, &string[0], subject_size, start_pos, 0, + &indices[0], @intCast(buffer_size)); + if(rc <= 0) + break; + start_pos = indices[1]; + start_match = @intCast(indices[2]); + end_match = @intCast(indices[3]); + match_buffer[current_match] = start_match; + match_buffer[current_match+1] = end_match; + current_match += 2; + } + + var matches: [] usize = try Allocator.alloc(usize, current_match); + for(0..current_match) |i| { + matches[i] = match_buffer[i]; + } + + return matches; +} diff --git a/impls/zig/readline.zig b/impls/zig/readline.zig new file mode 100644 index 0000000000..e31dfc62d4 --- /dev/null +++ b/impls/zig/readline.zig @@ -0,0 +1,40 @@ +const allocator = @import("std").heap.c_allocator; +const readline = @cImport( + @cInclude("readline/readline.h")); +const rl_hist = @cImport( + @cInclude("readline/history.h")); +const free = @import("std").c.free; + +fn addNullByte(prompt: []const u8) ![]u8 { + const result = try allocator.alloc(u8, prompt.len + 1); + for (0.., prompt) |i, source| + result[i] = source; + result[prompt.len] = 0; + return result; +} + +fn slice_from_cstr(str: [*]const u8) ![]const u8 { + var length: usize = 0; + while(str[length] != 0) { + length += 1; + } + // TODO: check for 0-length + const slice = try allocator.alloc(u8, length); + for (str, 0..length) |source, i| { + slice[i] = source; + } + return slice; +} + +pub fn getline(prompt: []const u8) !?[]const u8 { + const null_terminated_prompt = try addNullByte(prompt); + defer allocator.free(null_terminated_prompt); + const input = readline.readline(&null_terminated_prompt[0]); + if(input) |actual| { + defer free(actual); + const aslice = try slice_from_cstr(actual); + rl_hist.add_history(actual); + return aslice; + } + return null; +} diff --git a/impls/zig/run b/impls/zig/run new file mode 100755 index 0000000000..35613af46a --- /dev/null +++ b/impls/zig/run @@ -0,0 +1,2 @@ +#!/bin/sh +exec $(dirname $0)/zig-out/bin/${STEP:-stepA_mal} "${@}" diff --git a/impls/zig/step0_repl.zig b/impls/zig/step0_repl.zig new file mode 100644 index 0000000000..302cc01eba --- /dev/null +++ b/impls/zig/step0_repl.zig @@ -0,0 +1,30 @@ +const getline = @import("readline.zig").getline; + +const Allocator = @import("std").heap.c_allocator; +const stdout_file = @import("std").io.getStdOut(); + +fn READ(a: []const u8) []const u8 { + return a; +} + +fn EVAL(a: []const u8) []const u8 { + return a; +} + +fn PRINT(a: []const u8) !void { + try stdout_file.writeAll(a); + try stdout_file.writeAll("\n"); +} + +fn rep(input: []const u8) !void { + const read_input = READ(input); + const eval_input = EVAL(read_input); + try PRINT(eval_input); +} + +pub fn main() !void { + while(try getline("user> ")) |line| { + defer Allocator.free(line); + try rep(line); + } +} diff --git a/impls/zig/step1_read_print.zig b/impls/zig/step1_read_print.zig new file mode 100644 index 0000000000..d781d5e24f --- /dev/null +++ b/impls/zig/step1_read_print.zig @@ -0,0 +1,48 @@ +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const get_error_data = @import("error.zig").get_error_data; +const stdout_file = @import("std").io.getStdOut(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +fn EVAL(a: *MalType) *MalType { + a.incref(); + return a; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = EVAL(read_input); + defer eval_input.decref(); + try PRINT(eval_input.*); +} + +pub fn main() !void { + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step2_eval.zig b/impls/zig/step2_eval.zig new file mode 100644 index 0000000000..2b02a0748f --- /dev/null +++ b/impls/zig/step2_eval.zig @@ -0,0 +1,203 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const hash_map = @import("hmap.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = hash_map.MalHashMap { }; + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +fn EVAL(mal: *MalType, env: hash_map.MalHashMap) MalError!*MalType { + + // try stdout_file.writeAll("EVAL: "); + // try PRINT(mal.*); + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + else { + const first_mal = items[0]; + const evaluated_first = try EVAL(first_mal, env); + defer evaluated_first.decref(); + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env); + try args.List.data.append(Allocator, new_item); + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, repl_environment); + defer eval_input.decref(); + try PRINT(eval_input.*); +} + +fn EVAL_symbol(mal: *MalType, env: hash_map.MalHashMap) !*MalType { + if(env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: hash_map.MalHashMap) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: hash_map.MalHashMap) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env); + // key *is* new in this map. + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +const safeAdd = @import("std").math.add; +const safeSub = @import("std").math.sub; +const safeMul = @import("std").math.mul; +const safeDivFloor = @import("std").math.divFloor; + +fn int_plus(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeAdd(i64, x, y); + return MalType.new_int(res); +} + +fn int_minus(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeSub(i64, x, y); + return MalType.new_int(res); +} + +fn int_mult(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeMul(i64, x, y); + return MalType.new_int(res); +} + +fn int_div(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeDivFloor(i64, x, y); + return MalType.new_int(res); +} + +fn make_environment() !void { + + const plus_sym = try MalType.new_symbol("+", true); + const plus_mal = try MalType.newFnCore(&int_plus); + try repl_environment.put(Allocator, plus_sym, plus_mal); + const minus_sym = try MalType.new_symbol("-", true); + const minus_mal = try MalType.newFnCore(&int_minus); + try repl_environment.put(Allocator, minus_sym, minus_mal); + const mult_sym = try MalType.new_symbol("*", true); + const mult_mal = try MalType.newFnCore(&int_mult); + try repl_environment.put(Allocator, mult_sym, mult_mal); + const div_sym = try MalType.new_symbol("/", true); + const div_mal = try MalType.newFnCore(&int_div); + try repl_environment.put(Allocator, div_sym, div_mal); +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + try make_environment(); + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step3_env.zig b/impls/zig/step3_env.zig new file mode 100644 index 0000000000..a5de51db8a --- /dev/null +++ b/impls/zig/step3_env.zig @@ -0,0 +1,256 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal: *MalType, env: *Env) MalError!*MalType { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + return EVAL_let(items[1..], env); + } + else { + const evaluated_first = try EVAL(first_mal, env); + defer evaluated_first.decref(); + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env); + try args.List.data.append(Allocator, new_item); + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_let(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + env.incref(); + defer new_env.decref(); + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + return EVAL(eval_arg, new_env); +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment); + defer eval_input.decref(); + try PRINT(eval_input.*); +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env); + // key *is* new in this map. + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +const safeAdd = @import("std").math.add; +const safeSub = @import("std").math.sub; +const safeMul = @import("std").math.mul; +const safeDivFloor = @import("std").math.divFloor; + +fn int_plus(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeAdd(i64, x, y); + return MalType.new_int(res); +} + +fn int_minus(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeSub(i64, x, y); + return MalType.new_int(res); +} + +fn int_mult(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeMul(i64, x, y); + return MalType.new_int(res); +} + +fn int_div(args: []*MalType) MalError!*MalType { + if (args.len != 2) return MalError.ArgError; + const a1 = args[0]; + const a2 = args[1]; + const x = try a1.as_int(); + const y = try a2.as_int(); + const res = try safeDivFloor(i64, x, y); + return MalType.new_int(res); +} + +fn make_environment() !void { + + const plus_sym = try MalType.new_symbol("+", true); + const plus_mal = try MalType.newFnCore(&int_plus); + try repl_environment.set(plus_sym, plus_mal); + const minus_sym = try MalType.new_symbol("-", true); + const minus_mal = try MalType.newFnCore(&int_minus); + try repl_environment.set(minus_sym, minus_mal); + const mult_sym = try MalType.new_symbol("*", true); + const mult_mal = try MalType.newFnCore(&int_mult); + try repl_environment.set(mult_sym, mult_mal); + const div_sym = try MalType.new_symbol("/", true); + const div_mal = try MalType.newFnCore(&int_div); + try repl_environment.set(div_sym, div_mal); +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + try make_environment(); + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step4_if_fn_do.zig b/impls/zig/step4_if_fn_do.zig new file mode 100644 index 0000000000..121ae0944b --- /dev/null +++ b/impls/zig/step4_if_fn_do.zig @@ -0,0 +1,274 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); +const core = @import("core.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal: *MalType, env: *Env) MalError!*MalType { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + return EVAL_let(items[1..], env); + } + else if(string_eql(symbol, "do")) { + return EVAL_do(items[1..], env); + } + else if(string_eql(symbol, "if")) { + return EVAL_if(items[1..], env); + } + else if(string_eql(symbol, "fn*")) { + return EVAL_fn(items[1..], env); + } + else { + const evaluated_first = try EVAL(first_mal, env); + defer evaluated_first.decref(); + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env); + try args.List.data.append(Allocator, new_item); + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_let(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + env.incref(); + defer new_env.decref(); + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + return EVAL(eval_arg, new_env); +} + +fn EVAL_do(args: []*MalType, env: *Env) !*MalType { + if(args.len == 0) return MalError.ArgError; + const last_mal = args[args.len - 1]; + for (args[0..args.len - 1]) |form| { + const item = try EVAL(form, env); + item.decref(); + } + return EVAL(last_mal, env); +} + +fn EVAL_if(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2 and args.len != 3) return MalError.ArgError; + const first_arg = args[0]; + const evaled = try EVAL(first_arg, env); + const is_true = switch(evaled.*) { + .False => false, + .Nil => false, + else => true, + }; + evaled.decref(); + if(is_true) { + const second_arg = args[1]; + return EVAL(second_arg, env); + } + if(args.len == 2) { + return &MalType.NIL; + } + const third_arg = args[2]; + return EVAL(third_arg, env); +} + +fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const arg_mal = args[0]; + const body_mal = args[1]; + for (try arg_mal.as_slice()) |x| { + switch (x.*) { + .Symbol => {}, + else => return MalError.TypeError, + } + } + const new_func = try MalType.newFunc(arg_mal, body_mal, env); + arg_mal.incref(); + body_mal.incref(); + env.incref(); + return new_func; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(print: bool, input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment); + defer eval_input.decref(); + if(print) { + try PRINT(eval_input.*); + } +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env); + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +fn make_environment() !void { + + for(core.core_namespace) |pair| { + const name = try MalType.new_symbol(pair.name, true); + const func_mal = try MalType.newFnCore(pair.func); + try repl_environment.set(name, func_mal); + name.decref(); + } + + const def_not_string: [] const u8 = + \\(def! not (fn* (a) (if a false true))) + ; + try rep(false, def_not_string); +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + .Func => |funcdata| { + const apply_env = try funcdata.gen_env(args); + defer apply_env.decref(); + return EVAL(funcdata.body, apply_env); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + try make_environment(); + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(true, line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step5_tco.zig b/impls/zig/step5_tco.zig new file mode 100644 index 0000000000..5ae23e406f --- /dev/null +++ b/impls/zig/step5_tco.zig @@ -0,0 +1,305 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); +const core = @import("core.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { + var mal = mal_arg; + var env = env_arg; + var fde = finally_destroy_env; + defer if(fde) env.decref(); + while(true) { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + try EVAL_let(items[1..], &mal, &env, &fde); + continue; + } + else if(string_eql(symbol, "do")) { + try EVAL_do(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "if")) { + try EVAL_if(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "fn*")) { + return EVAL_fn(items[1..], env); + } + else { + const evaluated_first = try EVAL(first_mal, env, false); + defer evaluated_first.decref(); + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env, false); + try args.List.data.append(Allocator, new_item); + } + switch(evaluated_first.*) { + .Func => |func_data| { + if(fde) { + env.decref(); + } + else { + fde = true; + } + env = try func_data.gen_env(args.List.data.items); + mal = func_data.body; + continue; + }, + else => {}, + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } + } +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { + if(args.len != 2) return MalError.ArgError; + const env = env_ptr.*; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + // Change env and fde in case an error occurs later in this procedure + // and fde triggers an env.decref() at the exit of EVAL. + if(!fde.*) { + env.incref(); + fde.* = true; + } + env_ptr.* = new_env; + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env, false); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + mal_ptr.* = eval_arg; +} + +fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len == 0) return MalError.ArgError; + const last_mal = args[args.len - 1]; + for (args[0..args.len - 1]) |form| { + const item = try EVAL(form, env, false); + item.decref(); + } + mal_ptr.* = last_mal; +} + +fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len != 2 and args.len != 3) return MalError.ArgError; + const first_arg = args[0]; + const evaled = try EVAL(first_arg, env, false); + const is_true = switch(evaled.*) { + .False => false, + .Nil => false, + else => true, + }; + evaled.decref(); + if(is_true) { + const second_arg = args[1]; + mal_ptr.* = second_arg; + return; + } + if(args.len == 2) { + mal_ptr.* = &MalType.NIL; + return; + } + const third_arg = args[2]; + mal_ptr.* = third_arg; +} + +fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const arg_mal = args[0]; + const body_mal = args[1]; + for (try arg_mal.as_slice()) |x| { + switch (x.*) { + .Symbol => {}, + else => return MalError.TypeError, + } + } + const new_func = try MalType.newFunc(arg_mal, body_mal, env); + arg_mal.incref(); + body_mal.incref(); + env.incref(); + return new_func; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(print: bool, input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment, false); + defer eval_input.decref(); + if(print) { + try PRINT(eval_input.*); + } +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env, false); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env, false); + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +fn make_environment() !void { + + for(core.core_namespace) |pair| { + const name = try MalType.new_symbol(pair.name, true); + const func_mal = try MalType.newFnCore(pair.func); + try repl_environment.set(name, func_mal); + name.decref(); + } + + const def_not_string: [] const u8 = + \\(def! not (fn* (a) (if a false true))) + ; + try rep(false, def_not_string); +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + .Func => |funcdata| { + const apply_env = try funcdata.gen_env(args); + defer apply_env.decref(); + return EVAL(funcdata.body, apply_env, false); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + try make_environment(); + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(true, line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step6_file.zig b/impls/zig/step6_file.zig new file mode 100644 index 0000000000..ae915c7737 --- /dev/null +++ b/impls/zig/step6_file.zig @@ -0,0 +1,343 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); +const core = @import("core.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { + var mal = mal_arg; + var env = env_arg; + var fde = finally_destroy_env; + defer if(fde) env.decref(); + while(true) { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + try EVAL_let(items[1..], &mal, &env, &fde); + continue; + } + else if(string_eql(symbol, "do")) { + try EVAL_do(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "if")) { + try EVAL_if(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "fn*")) { + return EVAL_fn(items[1..], env); + } + else { + const evaluated_first = try EVAL(first_mal, env, false); + defer evaluated_first.decref(); + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env, false); + try args.List.data.append(Allocator, new_item); + } + switch(evaluated_first.*) { + .Func => |func_data| { + if(fde) { + env.decref(); + } + else { + fde = true; + } + env = try func_data.gen_env(args.List.data.items); + mal = func_data.body; + continue; + }, + else => {}, + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } + } +} + +fn eval(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return EVAL(a1, &repl_environment, false); +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { + if(args.len != 2) return MalError.ArgError; + const env = env_ptr.*; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + // Change env and fde in case an error occurs later in this procedure + // and fde triggers an env.decref() at the exit of EVAL. + if(!fde.*) { + env.incref(); + fde.* = true; + } + env_ptr.* = new_env; + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env, false); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + mal_ptr.* = eval_arg; +} + +fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len == 0) return MalError.ArgError; + const last_mal = args[args.len - 1]; + for (args[0..args.len - 1]) |form| { + const item = try EVAL(form, env, false); + item.decref(); + } + mal_ptr.* = last_mal; +} + +fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len != 2 and args.len != 3) return MalError.ArgError; + const first_arg = args[0]; + const evaled = try EVAL(first_arg, env, false); + const is_true = switch(evaled.*) { + .False => false, + .Nil => false, + else => true, + }; + evaled.decref(); + if(is_true) { + const second_arg = args[1]; + mal_ptr.* = second_arg; + return; + } + if(args.len == 2) { + mal_ptr.* = &MalType.NIL; + return; + } + const third_arg = args[2]; + mal_ptr.* = third_arg; +} + +fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const arg_mal = args[0]; + const body_mal = args[1]; + for (try arg_mal.as_slice()) |x| { + switch (x.*) { + .Symbol => {}, + else => return MalError.TypeError, + } + } + const new_func = try MalType.newFunc(arg_mal, body_mal, env); + arg_mal.incref(); + body_mal.incref(); + env.incref(); + return new_func; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(print: bool, input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment, false); + defer eval_input.decref(); + if(print) { + try PRINT(eval_input.*); + } +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env, false); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env, false); + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +fn make_environment() !void { + + for(core.core_namespace) |pair| { + const name = try MalType.new_symbol(pair.name, true); + const func_mal = try MalType.newFnCore(pair.func); + try repl_environment.set(name, func_mal); + name.decref(); + } + + const eval_sym = try MalType.new_symbol("eval", true); + const eval_mal = try MalType.newFnCore(eval); + try repl_environment.set(eval_sym, eval_mal); + eval_sym.decref(); + + const def_not_string: [] const u8 = + \\(def! not (fn* (a) (if a false true))) + ; + try rep(false, def_not_string); + + const load_file_string: [] const u8 = + \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + ; + try rep(false, load_file_string); +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + .Func => |funcdata| { + const apply_env = try funcdata.gen_env(args); + defer apply_env.decref(); + return EVAL(funcdata.body, apply_env, false); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + + // Break a circular dependency between modules. + core.apply_function = &apply_function; + + try make_environment(); + + const args = try std.process.argsAlloc(Allocator); + const arg_list = try MalType.new_list(); + if(1 < args.len) { + for (args[2..]) |arg| { + const new_mal = try MalType.new_string(arg, false); + try arg_list.List.data.append(Allocator, new_mal); + } + } + const argv_sym = try MalType.new_symbol("*ARGV*", true); + try repl_environment.set(argv_sym, arg_list); + argv_sym.decref(); + + if(args.len > 1) { + const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); + try rep(false, run_cmd); + return; + } + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(true, line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step7_quote.zig b/impls/zig/step7_quote.zig new file mode 100644 index 0000000000..ab62ca6ff9 --- /dev/null +++ b/impls/zig/step7_quote.zig @@ -0,0 +1,431 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); +const core = @import("core.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { + var mal = mal_arg; + var env = env_arg; + var fde = finally_destroy_env; + defer if(fde) env.decref(); + while(true) { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + try EVAL_let(items[1..], &mal, &env, &fde); + continue; + } + else if(string_eql(symbol, "do")) { + try EVAL_do(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "if")) { + try EVAL_if(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "fn*")) { + return EVAL_fn(items[1..], env); + } + else if(string_eql(symbol, "quote")) { + return EVAL_quote(items[1..]); + } + else if(string_eql(symbol, "quasiquote")) { + if(items.len != 2) return MalError.ArgError; + const second = items[1]; + mal = try quasiquote(second); + continue; + } + else { + const evaluated_first = try EVAL(first_mal, env, false); + defer evaluated_first.decref(); + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env, false); + try args.List.data.append(Allocator, new_item); + } + switch(evaluated_first.*) { + .Func => |func_data| { + if(fde) { + env.decref(); + } + else { + fde = true; + } + env = try func_data.gen_env(args.List.data.items); + mal = func_data.body; + continue; + }, + else => {}, + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } + } +} + +fn eval(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return EVAL(a1, &repl_environment, false); +} + +fn starts_with(mal: MalType, sym: []const u8) ?*MalType { + const ll = switch(mal) { + .List => |l| l, + else => return null, + }; + const items = ll.data.items; + if(items.len != 2) { + return null; + } + const ss = switch(items[0].*) { + .Symbol => |s| s, + else => return null, + }; + if(string_eql(ss.data, sym)) { + return items[1]; + } + return null; +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { + if(args.len != 2) return MalError.ArgError; + const env = env_ptr.*; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + // Change env and fde in case an error occurs later in this procedure + // and fde triggers an env.decref() at the exit of EVAL. + if(!fde.*) { + env.incref(); + fde.* = true; + } + env_ptr.* = new_env; + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env, false); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + mal_ptr.* = eval_arg; +} + +fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len == 0) return MalError.ArgError; + const last_mal = args[args.len - 1]; + for (args[0..args.len - 1]) |form| { + const item = try EVAL(form, env, false); + item.decref(); + } + mal_ptr.* = last_mal; +} + +fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len != 2 and args.len != 3) return MalError.ArgError; + const first_arg = args[0]; + const evaled = try EVAL(first_arg, env, false); + const is_true = switch(evaled.*) { + .False => false, + .Nil => false, + else => true, + }; + evaled.decref(); + if(is_true) { + const second_arg = args[1]; + mal_ptr.* = second_arg; + return; + } + if(args.len == 2) { + mal_ptr.* = &MalType.NIL; + return; + } + const third_arg = args[2]; + mal_ptr.* = third_arg; +} + +fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const arg_mal = args[0]; + const body_mal = args[1]; + for (try arg_mal.as_slice()) |x| { + switch (x.*) { + .Symbol => {}, + else => return MalError.TypeError, + } + } + const new_func = try MalType.newFunc(arg_mal, body_mal, env); + arg_mal.incref(); + body_mal.incref(); + env.incref(); + return new_func; +} + +fn EVAL_quote(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const quoted = args[0]; + quoted.incref(); + return quoted; +} + +fn quasiquote(ast: *MalType) MalError!*MalType { + switch (ast.*) { + .Symbol, .HashMap => { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); + try new_list.List.data.append(Allocator, ast); + ast.incref(); + return new_list; + }, + .List => |l| { + if(starts_with(ast.*, "unquote")) |unquoted| { + unquoted.incref(); + return unquoted; + } + return try qq_loop(l.data.items); + }, + .Vector => |l| { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); + try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); + return new_list; + }, + else => { + ast.incref(); + return ast; + }, + } +} + +fn qq_loop(items: []*MalType) !*MalType { + var result = try MalType.new_list(); + errdefer result.decref(); + for (0..items.len) |i| { + const elt = items[items.len - 1 - i]; + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + if(starts_with(elt.*, "splice-unquote")) |unquoted| { + try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); + try new_list.List.data.append(Allocator, unquoted); + unquoted.incref(); + } + else { + try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); + try new_list.List.data.append(Allocator, try quasiquote(elt)); + } + try new_list.List.data.append(Allocator, result); + result = new_list; + } + return result; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(print: bool, input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment, false); + defer eval_input.decref(); + if(print) { + try PRINT(eval_input.*); + } +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env, false); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env, false); + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +fn make_environment() !void { + + for(core.core_namespace) |pair| { + const name = try MalType.new_symbol(pair.name, true); + const func_mal = try MalType.newFnCore(pair.func); + try repl_environment.set(name, func_mal); + name.decref(); + } + + const eval_sym = try MalType.new_symbol("eval", true); + const eval_mal = try MalType.newFnCore(eval); + try repl_environment.set(eval_sym, eval_mal); + eval_sym.decref(); + + const def_not_string: [] const u8 = + \\(def! not (fn* (a) (if a false true))) + ; + try rep(false, def_not_string); + + const load_file_string: [] const u8 = + \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + ; + try rep(false, load_file_string); +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + .Func => |funcdata| { + const apply_env = try funcdata.gen_env(args); + defer apply_env.decref(); + return EVAL(funcdata.body, apply_env, false); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + + // Break a circular dependency between modules. + core.apply_function = &apply_function; + + try make_environment(); + + const args = try std.process.argsAlloc(Allocator); + const arg_list = try MalType.new_list(); + if(1 < args.len) { + for (args[2..]) |arg| { + const new_mal = try MalType.new_string(arg, false); + try arg_list.List.data.append(Allocator, new_mal); + } + } + const argv_sym = try MalType.new_symbol("*ARGV*", true); + try repl_environment.set(argv_sym, arg_list); + argv_sym.decref(); + + if(args.len > 1) { + const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); + try rep(false, run_cmd); + return; + } + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(true, line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step8_macros.zig b/impls/zig/step8_macros.zig new file mode 100644 index 0000000000..cc59670fb4 --- /dev/null +++ b/impls/zig/step8_macros.zig @@ -0,0 +1,469 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); +const core = @import("core.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { + var mal = mal_arg; + var env = env_arg; + var fde = finally_destroy_env; + defer if(fde) env.decref(); + while(true) { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "defmacro!")) { + return EVAL_defmacro(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + try EVAL_let(items[1..], &mal, &env, &fde); + continue; + } + else if(string_eql(symbol, "do")) { + try EVAL_do(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "if")) { + try EVAL_if(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "fn*")) { + return EVAL_fn(items[1..], env); + } + else if(string_eql(symbol, "quote")) { + return EVAL_quote(items[1..]); + } + else if(string_eql(symbol, "quasiquote")) { + if(items.len != 2) return MalError.ArgError; + const second = items[1]; + mal = try quasiquote(second); + continue; + } + else { + const evaluated_first = try EVAL(first_mal, env, false); + defer evaluated_first.decref(); + switch (evaluated_first.*) { + .Func => |func_data| { + if(func_data.is_macro) { + mal = try apply_function(evaluated_first.*, items[1..]); + continue; + } + }, + else => {} + } + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env, false); + try args.List.data.append(Allocator, new_item); + } + switch(evaluated_first.*) { + .Func => |func_data| { + if(fde) { + env.decref(); + } + else { + fde = true; + } + env = try func_data.gen_env(args.List.data.items); + mal = func_data.body; + continue; + }, + else => {}, + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } + } +} + +fn eval(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return EVAL(a1, &repl_environment, false); +} + +fn starts_with(mal: MalType, sym: []const u8) ?*MalType { + const ll = switch(mal) { + .List => |l| l, + else => return null, + }; + const items = ll.data.items; + if(items.len != 2) { + return null; + } + const ss = switch(items[0].*) { + .Symbol => |s| s, + else => return null, + }; + if(string_eql(ss.data, sym)) { + return items[1]; + } + return null; +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_defmacro(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + errdefer new_value.decref(); + const f = switch (new_value.*) { + .Func => |func_data| func_data, + else => return MalError.TypeError, + }; + const macro = try MalType.newFunc(f.arg_list, f.body, f.environment); + f.arg_list.incref(); + f.body.incref(); + f.environment.incref(); + macro.Func.is_macro = true; + try env.set(symbol_name, macro); + macro.incref(); + return macro; +} + +fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { + if(args.len != 2) return MalError.ArgError; + const env = env_ptr.*; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + // Change env and fde in case an error occurs later in this procedure + // and fde triggers an env.decref() at the exit of EVAL. + if(!fde.*) { + env.incref(); + fde.* = true; + } + env_ptr.* = new_env; + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env, false); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + mal_ptr.* = eval_arg; +} + +fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len == 0) return MalError.ArgError; + const last_mal = args[args.len - 1]; + for (args[0..args.len - 1]) |form| { + const item = try EVAL(form, env, false); + item.decref(); + } + mal_ptr.* = last_mal; +} + +fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len != 2 and args.len != 3) return MalError.ArgError; + const first_arg = args[0]; + const evaled = try EVAL(first_arg, env, false); + const is_true = switch(evaled.*) { + .False => false, + .Nil => false, + else => true, + }; + evaled.decref(); + if(is_true) { + const second_arg = args[1]; + mal_ptr.* = second_arg; + return; + } + if(args.len == 2) { + mal_ptr.* = &MalType.NIL; + return; + } + const third_arg = args[2]; + mal_ptr.* = third_arg; +} + +fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const arg_mal = args[0]; + const body_mal = args[1]; + for (try arg_mal.as_slice()) |x| { + switch (x.*) { + .Symbol => {}, + else => return MalError.TypeError, + } + } + const new_func = try MalType.newFunc(arg_mal, body_mal, env); + arg_mal.incref(); + body_mal.incref(); + env.incref(); + return new_func; +} + +fn EVAL_quote(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const quoted = args[0]; + quoted.incref(); + return quoted; +} + +fn quasiquote(ast: *MalType) MalError!*MalType { + switch (ast.*) { + .Symbol, .HashMap => { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); + try new_list.List.data.append(Allocator, ast); + ast.incref(); + return new_list; + }, + .List => |l| { + if(starts_with(ast.*, "unquote")) |unquoted| { + unquoted.incref(); + return unquoted; + } + return try qq_loop(l.data.items); + }, + .Vector => |l| { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); + try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); + return new_list; + }, + else => { + ast.incref(); + return ast; + }, + } +} + +fn qq_loop(items: []*MalType) !*MalType { + var result = try MalType.new_list(); + errdefer result.decref(); + for (0..items.len) |i| { + const elt = items[items.len - 1 - i]; + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + if(starts_with(elt.*, "splice-unquote")) |unquoted| { + try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); + try new_list.List.data.append(Allocator, unquoted); + unquoted.incref(); + } + else { + try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); + try new_list.List.data.append(Allocator, try quasiquote(elt)); + } + try new_list.List.data.append(Allocator, result); + result = new_list; + } + return result; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(print: bool, input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment, false); + defer eval_input.decref(); + if(print) { + try PRINT(eval_input.*); + } +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env, false); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env, false); + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +fn make_environment() !void { + + for(core.core_namespace) |pair| { + const name = try MalType.new_symbol(pair.name, true); + const func_mal = try MalType.newFnCore(pair.func); + try repl_environment.set(name, func_mal); + name.decref(); + } + + const eval_sym = try MalType.new_symbol("eval", true); + const eval_mal = try MalType.newFnCore(eval); + try repl_environment.set(eval_sym, eval_mal); + eval_sym.decref(); + + const def_not_string: [] const u8 = + \\(def! not (fn* (a) (if a false true))) + ; + try rep(false, def_not_string); + + const load_file_string: [] const u8 = + \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + ; + try rep(false, load_file_string); + + const def_cond_macro_string: [] const u8 = + \\(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) + ; + try rep(false, def_cond_macro_string); + +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + .Func => |funcdata| { + const apply_env = try funcdata.gen_env(args); + defer apply_env.decref(); + return EVAL(funcdata.body, apply_env, false); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + + // Break a circular dependency between modules. + core.apply_function = &apply_function; + + try make_environment(); + + const args = try std.process.argsAlloc(Allocator); + const arg_list = try MalType.new_list(); + if(1 < args.len) { + for (args[2..]) |arg| { + const new_mal = try MalType.new_string(arg, false); + try arg_list.List.data.append(Allocator, new_mal); + } + } + const argv_sym = try MalType.new_symbol("*ARGV*", true); + try repl_environment.set(argv_sym, arg_list); + argv_sym.decref(); + + if(args.len > 1) { + const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); + try rep(false, run_cmd); + return; + } + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(true, line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/step9_try.zig b/impls/zig/step9_try.zig new file mode 100644 index 0000000000..279609b515 --- /dev/null +++ b/impls/zig/step9_try.zig @@ -0,0 +1,506 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); +const core = @import("core.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { + var mal = mal_arg; + var env = env_arg; + var fde = finally_destroy_env; + defer if(fde) env.decref(); + while(true) { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "defmacro!")) { + return EVAL_defmacro(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + try EVAL_let(items[1..], &mal, &env, &fde); + continue; + } + else if(string_eql(symbol, "do")) { + try EVAL_do(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "if")) { + try EVAL_if(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "fn*")) { + return EVAL_fn(items[1..], env); + } + else if(string_eql(symbol, "quote")) { + return EVAL_quote(items[1..]); + } + else if(string_eql(symbol, "quasiquote")) { + if(items.len != 2) return MalError.ArgError; + const second = items[1]; + mal = try quasiquote(second); + continue; + } + else if(string_eql(symbol, "try*")) { + return EVAL_try(items[1..], env); + } + else { + const evaluated_first = try EVAL(first_mal, env, false); + defer evaluated_first.decref(); + switch (evaluated_first.*) { + .Func => |func_data| { + if(func_data.is_macro) { + mal = try apply_function(evaluated_first.*, items[1..]); + continue; + } + }, + else => {} + } + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env, false); + try args.List.data.append(Allocator, new_item); + } + switch(evaluated_first.*) { + .Func => |func_data| { + if(fde) { + env.decref(); + } + else { + fde = true; + } + env = try func_data.gen_env(args.List.data.items); + mal = func_data.body; + continue; + }, + else => {}, + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } + } +} + +fn eval(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return EVAL(a1, &repl_environment, false); +} + +fn starts_with(mal: MalType, sym: []const u8) ?*MalType { + const ll = switch(mal) { + .List => |l| l, + else => return null, + }; + const items = ll.data.items; + if(items.len != 2) { + return null; + } + const ss = switch(items[0].*) { + .Symbol => |s| s, + else => return null, + }; + if(string_eql(ss.data, sym)) { + return items[1]; + } + return null; +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_defmacro(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + errdefer new_value.decref(); + const f = switch (new_value.*) { + .Func => |func_data| func_data, + else => return MalError.TypeError, + }; + const macro = try MalType.newFunc(f.arg_list, f.body, f.environment); + f.arg_list.incref(); + f.body.incref(); + f.environment.incref(); + macro.Func.is_macro = true; + try env.set(symbol_name, macro); + macro.incref(); + return macro; +} + +fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { + if(args.len != 2) return MalError.ArgError; + const env = env_ptr.*; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + // Change env and fde in case an error occurs later in this procedure + // and fde triggers an env.decref() at the exit of EVAL. + if(!fde.*) { + env.incref(); + fde.* = true; + } + env_ptr.* = new_env; + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env, false); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + mal_ptr.* = eval_arg; +} + +fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len == 0) return MalError.ArgError; + const last_mal = args[args.len - 1]; + for (args[0..args.len - 1]) |form| { + const item = try EVAL(form, env, false); + item.decref(); + } + mal_ptr.* = last_mal; +} + +fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len != 2 and args.len != 3) return MalError.ArgError; + const first_arg = args[0]; + const evaled = try EVAL(first_arg, env, false); + const is_true = switch(evaled.*) { + .False => false, + .Nil => false, + else => true, + }; + evaled.decref(); + if(is_true) { + const second_arg = args[1]; + mal_ptr.* = second_arg; + return; + } + if(args.len == 2) { + mal_ptr.* = &MalType.NIL; + return; + } + const third_arg = args[2]; + mal_ptr.* = third_arg; +} + +fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const arg_mal = args[0]; + const body_mal = args[1]; + for (try arg_mal.as_slice()) |x| { + switch (x.*) { + .Symbol => {}, + else => return MalError.TypeError, + } + } + const new_func = try MalType.newFunc(arg_mal, body_mal, env); + arg_mal.incref(); + body_mal.incref(); + env.incref(); + return new_func; +} + +fn EVAL_quote(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const quoted = args[0]; + quoted.incref(); + return quoted; +} + +fn EVAL_try(args: []*MalType, env: *Env) !*MalType { + if(args.len != 1 and args.len != 2) return MalError.ArgError; + const mal_to_try = args[0]; + if(args.len == 1) { + return EVAL(mal_to_try, env, false); + } + const catch_mal = args[1]; + const catch_list = switch (catch_mal.*) { + .List => |l| l.data.items, + else => return MalError.TypeError, + }; + if(catch_list.len != 3) return MalError.ArgError; + switch (catch_list[0].*) { + .Symbol => |s| { + if(!string_eql(s.data, "catch*")) return MalError.ArgError; + }, + else => return MalError.ArgError, + } + + const evaled_mal = EVAL(mal_to_try, env, false) catch |err| { + const err_symbol = catch_list[1]; + const err_body = catch_list[2]; + const err_val = get_error_data() + orelse try MalType.new_string(@errorName(err), true); + const new_env = try Env.new(env); + env.incref(); + defer new_env.decref(); + try new_env.set(err_symbol, err_val); // no incref for err_val. + const result = EVAL(err_body, new_env, false); + return result; + }; + return evaled_mal; +} + +fn quasiquote(ast: *MalType) MalError!*MalType { + switch (ast.*) { + .Symbol, .HashMap => { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); + try new_list.List.data.append(Allocator, ast); + ast.incref(); + return new_list; + }, + .List => |l| { + if(starts_with(ast.*, "unquote")) |unquoted| { + unquoted.incref(); + return unquoted; + } + return try qq_loop(l.data.items); + }, + .Vector => |l| { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); + try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); + return new_list; + }, + else => { + ast.incref(); + return ast; + }, + } +} + +fn qq_loop(items: []*MalType) !*MalType { + var result = try MalType.new_list(); + errdefer result.decref(); + for (0..items.len) |i| { + const elt = items[items.len - 1 - i]; + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + if(starts_with(elt.*, "splice-unquote")) |unquoted| { + try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); + try new_list.List.data.append(Allocator, unquoted); + unquoted.incref(); + } + else { + try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); + try new_list.List.data.append(Allocator, try quasiquote(elt)); + } + try new_list.List.data.append(Allocator, result); + result = new_list; + } + return result; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(print: bool, input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment, false); + defer eval_input.decref(); + if(print) { + try PRINT(eval_input.*); + } +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env, false); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env, false); + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +fn make_environment() !void { + + for(core.core_namespace) |pair| { + const name = try MalType.new_symbol(pair.name, true); + const func_mal = try MalType.newFnCore(pair.func); + try repl_environment.set(name, func_mal); + name.decref(); + } + + const eval_sym = try MalType.new_symbol("eval", true); + const eval_mal = try MalType.newFnCore(eval); + try repl_environment.set(eval_sym, eval_mal); + eval_sym.decref(); + + const def_not_string: [] const u8 = + \\(def! not (fn* (a) (if a false true))) + ; + try rep(false, def_not_string); + + const load_file_string: [] const u8 = + \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + ; + try rep(false, load_file_string); + + const def_cond_macro_string: [] const u8 = + \\(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) + ; + try rep(false, def_cond_macro_string); + +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + .Func => |funcdata| { + const apply_env = try funcdata.gen_env(args); + defer apply_env.decref(); + return EVAL(funcdata.body, apply_env, false); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + + // Break a circular dependency between modules. + core.apply_function = &apply_function; + + try make_environment(); + + const args = try std.process.argsAlloc(Allocator); + const arg_list = try MalType.new_list(); + if(1 < args.len) { + for (args[2..]) |arg| { + const new_mal = try MalType.new_string(arg, false); + try arg_list.List.data.append(Allocator, new_mal); + } + } + const argv_sym = try MalType.new_symbol("*ARGV*", true); + try repl_environment.set(argv_sym, arg_list); + argv_sym.decref(); + + if(args.len > 1) { + const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); + try rep(false, run_cmd); + return; + } + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(true, line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/stepA_mal.zig b/impls/zig/stepA_mal.zig new file mode 100644 index 0000000000..f1c61cc343 --- /dev/null +++ b/impls/zig/stepA_mal.zig @@ -0,0 +1,518 @@ +const std = @import("std"); + +const reader = @import("reader.zig"); +const printer = @import("printer.zig"); +const getline = @import("readline.zig").getline; +const string_eql = std.hash_map.eqlString; +const hash_map = @import("hmap.zig"); +const core = @import("core.zig"); + +const Allocator = @import("std").heap.c_allocator; + +const MalType = @import("types.zig").MalType; +const MalError = @import("error.zig").MalError; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; +const Env = @import("env.zig").Env; +const get_error_data = @import("error.zig").get_error_data; +const throw = @import("error.zig").throw; +const stdout_file = std.io.getStdOut(); + +var repl_environment = Env.new_root(); + +fn READ(a: []const u8) !*MalType { + var read = try reader.read_str(a); + return reader.read_form(&read); +} + +// Do not allocate this one on each EVAL run. +// The string is static, but will never be deallocated. +var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; + +fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { + var mal = mal_arg; + var env = env_arg; + var fde = finally_destroy_env; + defer if(fde) env.decref(); + while(true) { + + if(try env.get(&DEBUG_EVAL)) |dbgeval| { + switch (dbgeval.*) { + .Nil, .False => {}, + else => { + try stdout_file.writeAll("EVAL: "); + try PRINT(mal.*); + } + } + } + + switch(mal.*) { + .List => |ll| { + const items = ll.data.items; + if(items.len == 0) { + mal.incref(); + return mal; + } + const first_mal = items[0]; + const symbol = switch(first_mal.*) { + .Symbol => |symbol| symbol.data, + else => "", + }; + if(string_eql(symbol, "def!")) { + return EVAL_def(items[1..], env); + } + else if(string_eql(symbol, "defmacro!")) { + return EVAL_defmacro(items[1..], env); + } + else if(string_eql(symbol, "let*")) { + try EVAL_let(items[1..], &mal, &env, &fde); + continue; + } + else if(string_eql(symbol, "do")) { + try EVAL_do(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "if")) { + try EVAL_if(items[1..], &mal, env); + continue; + } + else if(string_eql(symbol, "fn*")) { + return EVAL_fn(items[1..], env); + } + else if(string_eql(symbol, "quote")) { + return EVAL_quote(items[1..]); + } + else if(string_eql(symbol, "quasiquote")) { + if(items.len != 2) return MalError.ArgError; + const second = items[1]; + mal = try quasiquote(second); + continue; + } + else if(string_eql(symbol, "try*")) { + return EVAL_try(items[1..], env); + } + else { + const evaluated_first = try EVAL(first_mal, env, false); + defer evaluated_first.decref(); + switch (evaluated_first.*) { + .Func => |func_data| { + if(func_data.is_macro) { + mal = try apply_function(evaluated_first.*, items[1..]); + continue; + } + }, + else => {} + } + // A slice would be sufficient, but a List is convenient + // for partial deallocation in case of error. + const args = try MalType.new_list(); + defer args.decref(); + for(items[1..]) |x| { + const new_item = try EVAL(x, env, false); + try args.List.data.append(Allocator, new_item); + } + switch(evaluated_first.*) { + .Func => |func_data| { + if(fde) { + env.decref(); + } + else { + fde = true; + } + env = try func_data.gen_env(args.List.data.items); + mal = func_data.body; + continue; + }, + else => {}, + } + return apply_function(evaluated_first.*, args.List.data.items); + } + }, + .Symbol => { + return EVAL_symbol(mal, env); + }, + .Vector => |ll| { + return EVAL_vector(ll.data.items, env); + }, + .HashMap => |hmap| { + return EVAL_map(hmap.data, env); + }, + else => { + mal.incref(); + return mal; + }, + } + } +} + +fn eval(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const a1 = args[0]; + return EVAL(a1, &repl_environment, false); +} + +fn starts_with(mal: MalType, sym: []const u8) ?*MalType { + const ll = switch(mal) { + .List => |l| l, + else => return null, + }; + const items = ll.data.items; + if(items.len != 2) { + return null; + } + const ss = switch(items[0].*) { + .Symbol => |s| s, + else => return null, + }; + if(string_eql(ss.data, sym)) { + return items[1]; + } + return null; +} + +fn EVAL_def(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + try env.set(symbol_name, new_value); + new_value.incref(); + return new_value; +} + +fn EVAL_defmacro(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const symbol_name = args[0]; + const second_arg = args[1]; + const new_value = try EVAL(second_arg, env, false); + errdefer new_value.decref(); + const f = switch (new_value.*) { + .Func => |func_data| func_data, + else => return MalError.TypeError, + }; + const macro = try MalType.newFunc(f.arg_list, f.body, f.environment); + f.arg_list.incref(); + f.body.incref(); + f.environment.incref(); + macro.Func.is_macro = true; + try env.set(symbol_name, macro); + macro.incref(); + return macro; +} + +fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { + if(args.len != 2) return MalError.ArgError; + const env = env_ptr.*; + const binding_arg = args[0]; + const eval_arg = args[1]; + const binds = try binding_arg.as_slice(); + if(binds.len % 2 != 0) return MalError.ArgError; + const new_env = try Env.new(env); + // Change env and fde in case an error occurs later in this procedure + // and fde triggers an env.decref() at the exit of EVAL. + if(!fde.*) { + env.incref(); + fde.* = true; + } + env_ptr.* = new_env; + for(0..binds.len / 2) |i| { + const key = binds[2*i]; + const val_mal = binds[2*i + 1]; + const evaled_mal = try EVAL(val_mal, new_env, false); + errdefer evaled_mal.decref(); + try new_env.set(key, evaled_mal); + // Do not increment the refcount for the value. + } + mal_ptr.* = eval_arg; +} + +fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len == 0) return MalError.ArgError; + const last_mal = args[args.len - 1]; + for (args[0..args.len - 1]) |form| { + const item = try EVAL(form, env, false); + item.decref(); + } + mal_ptr.* = last_mal; +} + +fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { + if(args.len != 2 and args.len != 3) return MalError.ArgError; + const first_arg = args[0]; + const evaled = try EVAL(first_arg, env, false); + const is_true = switch(evaled.*) { + .False => false, + .Nil => false, + else => true, + }; + evaled.decref(); + if(is_true) { + const second_arg = args[1]; + mal_ptr.* = second_arg; + return; + } + if(args.len == 2) { + mal_ptr.* = &MalType.NIL; + return; + } + const third_arg = args[2]; + mal_ptr.* = third_arg; +} + +fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { + if(args.len != 2) return MalError.ArgError; + const arg_mal = args[0]; + const body_mal = args[1]; + for (try arg_mal.as_slice()) |x| { + switch (x.*) { + .Symbol => {}, + else => return MalError.TypeError, + } + } + const new_func = try MalType.newFunc(arg_mal, body_mal, env); + arg_mal.incref(); + body_mal.incref(); + env.incref(); + return new_func; +} + +fn EVAL_quote(args: []*MalType) !*MalType { + if(args.len != 1) return MalError.ArgError; + const quoted = args[0]; + quoted.incref(); + return quoted; +} + +fn EVAL_try(args: []*MalType, env: *Env) !*MalType { + if(args.len != 1 and args.len != 2) return MalError.ArgError; + const mal_to_try = args[0]; + if(args.len == 1) { + return EVAL(mal_to_try, env, false); + } + const catch_mal = args[1]; + const catch_list = switch (catch_mal.*) { + .List => |l| l.data.items, + else => return MalError.TypeError, + }; + if(catch_list.len != 3) return MalError.ArgError; + switch (catch_list[0].*) { + .Symbol => |s| { + if(!string_eql(s.data, "catch*")) return MalError.ArgError; + }, + else => return MalError.ArgError, + } + + const evaled_mal = EVAL(mal_to_try, env, false) catch |err| { + const err_symbol = catch_list[1]; + const err_body = catch_list[2]; + const err_val = get_error_data() + orelse try MalType.new_string(@errorName(err), true); + const new_env = try Env.new(env); + env.incref(); + defer new_env.decref(); + try new_env.set(err_symbol, err_val); // no incref for err_val. + const result = EVAL(err_body, new_env, false); + return result; + }; + return evaled_mal; +} + +fn quasiquote(ast: *MalType) MalError!*MalType { + switch (ast.*) { + .Symbol, .HashMap => { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); + try new_list.List.data.append(Allocator, ast); + ast.incref(); + return new_list; + }, + .List => |l| { + if(starts_with(ast.*, "unquote")) |unquoted| { + unquoted.incref(); + return unquoted; + } + return try qq_loop(l.data.items); + }, + .Vector => |l| { + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); + try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); + return new_list; + }, + else => { + ast.incref(); + return ast; + }, + } +} + +fn qq_loop(items: []*MalType) !*MalType { + var result = try MalType.new_list(); + errdefer result.decref(); + for (0..items.len) |i| { + const elt = items[items.len - 1 - i]; + const new_list = try MalType.new_list(); + errdefer new_list.decref(); + if(starts_with(elt.*, "splice-unquote")) |unquoted| { + try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); + try new_list.List.data.append(Allocator, unquoted); + unquoted.incref(); + } + else { + try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); + try new_list.List.data.append(Allocator, try quasiquote(elt)); + } + try new_list.List.data.append(Allocator, result); + result = new_list; + } + return result; +} + +fn PRINT(mal: MalType) !void { + try printer.one_stdout(mal); + try stdout_file.writeAll("\n"); +} + +fn rep(print: bool, input: []const u8) !void { + const read_input = try READ(input); + defer read_input.decref(); + const eval_input = try EVAL(read_input, &repl_environment, false); + defer eval_input.decref(); + if(print) { + try PRINT(eval_input.*); + } +} + +fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { + if(try env.get(mal)) |value| { + value.incref(); + return value; + } + const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", + .{mal.Symbol.data}); + return throw(try MalType.new_string(err, false)); +} + +fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { + const ret_mal = try MalType.new_vector(); + errdefer ret_mal.decref(); + for(ll) |x| { + const new_mal = try EVAL(x, env, false); + try ret_mal.Vector.data.append(Allocator, new_mal); + } + return ret_mal; +} + +fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { + const new_hashmap = try MalType.new_hashmap(); + errdefer new_hashmap.decref(); + var iterator = hmap.iterator(); + while(iterator.next()) |pair| { + const key = pair.key_ptr.*; + const value = pair.value_ptr.*; + const evaled_value = try EVAL(value, env, false); + try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); + } + return new_hashmap; +} + +fn make_environment() !void { + + for(core.core_namespace) |pair| { + const name = try MalType.new_symbol(pair.name, true); + const func_mal = try MalType.newFnCore(pair.func); + try repl_environment.set(name, func_mal); + name.decref(); + } + + const eval_sym = try MalType.new_symbol("eval", true); + const eval_mal = try MalType.newFnCore(eval); + try repl_environment.set(eval_sym, eval_mal); + eval_sym.decref(); + + const def_not_string: [] const u8 = + \\(def! not (fn* (a) (if a false true))) + ; + try rep(false, def_not_string); + + const load_file_string: [] const u8 = + \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) + ; + try rep(false, load_file_string); + + const def_cond_macro_string: [] const u8 = + \\(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) + ; + try rep(false, def_cond_macro_string); + + const host_language_sym = try MalType.new_symbol("*host-language*", true); + const host_language_mal = try MalType.new_string("Zig", true); + try repl_environment.set(host_language_sym, host_language_mal); +} + +fn do_print_header() !void { + const welcome_msg_cmd: [] const u8 = + \\(println (str "Mal [" *host-language* "]")) + ; + try rep(false, welcome_msg_cmd); +} + +pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { + + switch(f) { + .FnCore => |fncoredata| { + return fncoredata.data(args); + }, + .Func => |funcdata| { + const apply_env = try funcdata.gen_env(args); + defer apply_env.decref(); + return EVAL(funcdata.body, apply_env, false); + }, + else => { + return MalError.ApplyError; + }, + } +} + +pub fn main() !void { + + // Break a circular dependency between modules. + core.apply_function = &apply_function; + + try make_environment(); + + const args = try std.process.argsAlloc(Allocator); + const arg_list = try MalType.new_list(); + if(1 < args.len) { + for (args[2..]) |arg| { + const new_mal = try MalType.new_string(arg, false); + try arg_list.List.data.append(Allocator, new_mal); + } + } + const argv_sym = try MalType.new_symbol("*ARGV*", true); + try repl_environment.set(argv_sym, arg_list); + argv_sym.decref(); + + if(args.len > 1) { + const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); + try rep(false, run_cmd); + return; + } + + try do_print_header(); + + while(try getline("user> ")) |line| { + defer Allocator.free(line); + rep(true, line) catch |err| { + try stdout_file.writeAll("Error: "); + try stdout_file.writeAll(@errorName(err)); + try stdout_file.writeAll("\n"); + if(get_error_data()) |mal| { + defer mal.decref(); + try stdout_file.writeAll("MAL error object is: "); + try PRINT(mal.*); + } + }; + } +} diff --git a/impls/zig/types.zig b/impls/zig/types.zig new file mode 100644 index 0000000000..e061f25592 --- /dev/null +++ b/impls/zig/types.zig @@ -0,0 +1,325 @@ +const std = @import("std"); + +const allocator = std.heap.c_allocator; +const warn = std.log.warn; +const Env = @import("env.zig").Env; +const MalError = @import("error.zig").MalError; +const MalHashMap = @import("hmap.zig").MalHashMap; +const MalLinkedList = @import("linked_list.zig").MalLinkedList; + +const linked_list = @import("linked_list.zig"); +const hash_map = @import("hmap.zig"); +const map_destroy = @import("hmap.zig").map_destroy; + +pub const debug_alloc = false; + +pub const ListData = struct { + data: MalLinkedList, + reference_count: i32 = 1, + metadata: *MalType = &MalType.NIL, +}; + +pub const FnCoreData = struct { + data: *const fn (args: []*MalType) MalError!*MalType, + reference_count: i32 = 1, // May reach 0 when metadata. + metadata: *MalType = &MalType.NIL, +}; + +pub const MalFuncData = struct { + arg_list: *MalType, + body: *MalType, + environment: *Env, + is_macro: bool = false, + reference_count: i32 = 1, + metadata: *MalType = &MalType.NIL, + + pub fn gen_env(self: MalFuncData, args: []*MalType) !*Env { + const binds = try self.arg_list.as_slice(); + var res = try Env.new(self.environment); + self.environment.incref(); + errdefer res.decref(); + if (2 <= binds.len + and std.hash_map.eqlString(binds[binds.len - 2].Symbol.data, "&")) + { + if (args.len < binds.len - 2) + return MalError.TypeError; + for (binds[0..binds.len-2], args[0..binds.len-2]) |k, v| { + try res.set(k, v); + v.incref(); + } + const more = try MalType.new_list(); + errdefer more.decref(); + for (args[binds.len-2..args.len]) |x| { + try more.List.data.append(allocator, x); + x.incref(); + } + try res.set(binds[binds.len - 1], more); + // Do not increment the reference count for this value. + } + else { + if (args.len != binds.len) { + return MalError.TypeError; + } + for(binds, args) |k, v| { + try res.set(k, v); + v.incref(); + } + } + return res; + } +}; + +pub const StringData = struct { + data: [] const u8, + reference_count: i32 = 1, +}; + +pub const HashMapData = struct { + data: MalHashMap, + reference_count: i32 = 1, + metadata: *MalType = &MalType.NIL, +}; + +pub const MalType = union(enum) { + List: ListData, + Vector: ListData, + Int: struct { + data: i64, + reference_count: i32 = 1, + }, + Symbol: StringData, + String: StringData, + Keyword: StringData, + Nil: void, + True: void, + False: void, + FnCore: FnCoreData, + Func: MalFuncData, + Atom: struct { + data: *MalType, + reference_count: i32 = 1, + }, + HashMap: HashMapData, + + // Define some frequent values in advance. They are not allocated + // on the heap, but should never be deallocated anyway. + pub var NIL = MalType { .Nil = undefined }; + pub var FALSE = MalType { .False = undefined }; + pub var TRUE = MalType { .True = undefined }; + + pub fn new_symbol(value: []const u8, copy: bool) !*MalType { + const mal = try allocator.create(MalType); + errdefer allocator.destroy(mal); + const data = if (copy) try allocator.dupe(u8, value) else value; + mal.* = .{.Symbol=.{.data = data}}; + if (debug_alloc) warn("Init {any}", .{mal}); + return mal; + } + + pub fn new_string(value: []const u8, copy: bool) !*MalType { + const mal = try allocator.create(MalType); + errdefer allocator.destroy(mal); + const data = if (copy) try allocator.dupe(u8, value) else value; + mal.* = .{.String=.{.data = data}}; + if (debug_alloc) warn("Init {any}", .{mal}); + return mal; + } + + pub fn new_keyword(value: []const u8, copy: bool) !*MalType { + const mal = try allocator.create(MalType); + errdefer allocator.destroy(mal); + const data = if (copy) try allocator.dupe(u8, value) else value; + mal.* = .{.Keyword=.{.data = data}}; + if (debug_alloc) warn("Init {any}", .{mal}); + return mal; + } + + pub fn new_int(value: i64) !*MalType { + const mal = try allocator.create(MalType); + mal.* = .{.Int=.{.data = value}}; + if (debug_alloc) warn("Init {any}", .{mal}); + return mal; + } + + pub fn new_bool(b: bool) *MalType { + if(b) { + return &TRUE; + } + else { + return &FALSE; + } + } + + pub fn newFnCore(f: *const fn (args: []*MalType) MalError!*MalType) !*MalType { + const mal = try allocator.create(MalType); + mal.* = .{.FnCore=.{.data = f}}; + if (debug_alloc) warn("Init core function", .{}); + return mal; + } + + pub fn newFunc(arg_list: *MalType, + body: *MalType, + environment: *Env, + ) !*MalType + { + const mal = try allocator.create(MalType); + mal.* = .{.Func=.{ + .arg_list = arg_list, + .body = body, + .environment = environment, + }}; + if (debug_alloc) warn("Init {any}", .{mal}); + return mal; + } + + pub fn new_list() !*MalType { + const mal = try allocator.create(MalType); + mal.* = .{.List=.{.data = MalLinkedList { }}}; + if (debug_alloc) warn("Init {any}", .{mal}); + return mal; + } + + pub fn new_vector() !*MalType { + const mal = try allocator.create(MalType); + errdefer allocator.destroy(mal); + mal.* = .{.Vector=.{.data = MalLinkedList { }}}; + if (debug_alloc) warn("Init {any}", .{mal}); + return mal; + } + + pub fn new_atom(mal: *MalType) !*MalType { + const new_mal = try allocator.create(MalType); + errdefer allocator.destroy(new_mal); + new_mal.* = .{.Atom=.{.data = mal}}; + if (debug_alloc) warn("Init {any}", .{new_mal}); + return new_mal; + } + + pub fn new_hashmap() !*MalType { + const new_mal = try allocator.create(MalType); + errdefer allocator.destroy(new_mal); + new_mal.* = .{.HashMap=.{.data = .{}}}; + if (debug_alloc) warn("Init {any}", .{new_mal}); + return new_mal; + } + + // Trivial but convenient checkers/getters. + + pub fn as_slice(self: MalType) ![]*MalType { + return switch (self) { + .List, .Vector => |x| x.data.items, + else => MalError.TypeError, + }; + } + + pub fn as_int(mal: MalType) !i64 { + return switch (mal) { + .Int => |val| val.data, + else => MalError.TypeError, + }; + } + + pub fn as_string(self: MalType) ![]const u8 { + return switch (self) { + .String => |s| s.data, + else => MalError.TypeError, + }; + } + + pub fn as_map(self: MalType) !MalHashMap { + switch (self) { + .HashMap => |x| return x.data, + else => return MalError.TypeError, + } + } + + pub fn decref(mal: *MalType) void { + switch(mal.*) { + .List, .Vector => |*l| { + std.debug.assert (0 < l.reference_count); + l.reference_count -= 1; + if (l.reference_count == 0) { + if (debug_alloc) warn("Free {any}", .{mal}); + linked_list.list_destroy(&l.data); + l.metadata.decref(); + allocator.destroy(mal); + } + }, + .Keyword, .String, .Symbol => |*l| { + std.debug.assert (0 < l.reference_count); + l.reference_count -= 1; + if (l.reference_count == 0) { + if (debug_alloc) warn("Free {s} {any}", .{l.data, mal}); + allocator.free(l.data); + allocator.destroy(mal); + } + }, + .Atom => |*l| { + std.debug.assert (0 < l.reference_count); + l.reference_count -= 1; + if (l.reference_count == 0) { + if (debug_alloc) warn("Free {any}", .{mal}); + l.data.decref(); + allocator.destroy(mal); + } + }, + .HashMap => |*l| { + std.debug.assert (0 <= l.reference_count); + l.reference_count -= 1; + if (l.reference_count == 0) { + if (debug_alloc) warn("Free {any}", .{mal}); + map_destroy(&l.data); + l.metadata.decref(); + allocator.destroy(mal); + } + }, + .Func => |*l| { + std.debug.assert (0 < l.reference_count); + l.reference_count -= 1; + if (l.reference_count == 0) { + if (debug_alloc) warn("Free {any}", .{mal}); + l.arg_list.decref(); + l.body.decref(); + l.environment.decref(); + l.metadata.decref(); + allocator.destroy(mal); + } + }, + .Int => |*l| { + std.debug.assert (0 < l.reference_count); + l.reference_count -= 1; + if (l.reference_count == 0) { + if (debug_alloc) warn("Free {any}", .{mal}); + allocator.destroy(mal); + } + }, + .FnCore => |*l| { + std.debug.assert (0 < l.reference_count); + l.reference_count -= 1; + if (l.reference_count == 0) { + if (debug_alloc) warn("Free {any}", .{mal}); + l.metadata.decref(); + allocator.destroy(mal); + } + }, + .Nil, .False, .True => {}, + } + } + + pub fn incref(mal: *MalType) void { + // A procedure instead of a function returning its argument + // because it must most of the time be applied *after* a + // successful assignment. + switch(mal.*) { + .List, .Vector => |*l| l.reference_count += 1, + .Int => |*l| l.reference_count += 1, + .Keyword, .String, .Symbol => |*l| l.reference_count += 1, + .FnCore => |*l| l.reference_count += 1, + .Func => |*l| l.reference_count += 1, + .Atom => |*l| l.reference_count += 1, + .HashMap => |*l| l.reference_count += 1, + .Nil, .False, .True => {}, + } + } + +}; diff --git a/java/Makefile b/java/Makefile deleted file mode 100644 index f242ec0452..0000000000 --- a/java/Makefile +++ /dev/null @@ -1,17 +0,0 @@ - -TESTS = - - -SOURCES_BASE = src/main/java/mal/readline.java src/main/java/mal/types.java \ - src/main/java/mal/reader.java src/main/java/mal/printer.java -SOURCES_LISP = src/main/java/mal/env.java src/main/java/mal/core.java \ - src/main/java/mal/stepA_mal.java -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -#.PHONY: stats tests $(TESTS) -.PHONY: stats - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/java/src/main/java/mal/env.java b/java/src/main/java/mal/env.java deleted file mode 100644 index 711a9eee76..0000000000 --- a/java/src/main/java/mal/env.java +++ /dev/null @@ -1,58 +0,0 @@ -package mal; - -import java.util.HashMap; - -import mal.types.MalThrowable; -import mal.types.MalException; -import mal.types.MalVal; -import mal.types.MalSymbol; -import mal.types.MalList; - -public class env { - public static class Env { - Env outer = null; - HashMap data = new HashMap(); - - public Env(Env outer) { - this.outer = outer; - } - public Env(Env outer, MalList binds, MalList exprs) { - this.outer = outer; - for (Integer i=0; i)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, HashMap env) throws MalThrowable { - MalVal a0; - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - if (!(a0 instanceof MalSymbol)) { - throw new MalError("attempt to apply on non-symbol '" - + printer._pr_str(a0,true) + "'"); - } - MalVal args = eval_ast(ast.rest(), env); - MalSymbol fsym = (MalSymbol)a0; - ILambda f = (ILambda)env.get(fsym.getName()); - if (f == null) { - throw new MalError("'" + fsym.getName() + "' not found"); - } - return f.apply((MalList)args); - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(HashMap env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - static MalFunction add = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).add((MalInteger)a.nth(1)); - } - }; - static MalFunction subtract = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).subtract((MalInteger)a.nth(1)); - } - }; - static MalFunction multiply = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).multiply((MalInteger)a.nth(1)); - } - }; - static MalFunction divide = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).divide((MalInteger)a.nth(1)); - } - }; - - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - HashMap repl_env = new HashMap(); - repl_env.put("+", add); - repl_env.put("-", subtract); - repl_env.put("*", multiply); - repl_env.put("/", divide); - - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - } - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/step3_env.java b/java/src/main/java/mal/step3_env.java deleted file mode 100644 index d3e221b334..0000000000 --- a/java/src/main/java/mal/step3_env.java +++ /dev/null @@ -1,156 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; - -public class step3_env { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, res; - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - if (!(a0 instanceof MalSymbol)) { - throw new MalError("attempt to apply on non-symbol '" - + printer._pr_str(a0,true) + "'"); - } - - switch (((MalSymbol)a0).getName()) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - return EVAL(a2, let_env); - default: - MalVal args = eval_ast(ast.rest(), env); - ILambda f = (ILambda)env.get((MalSymbol)a0); - return f.apply((MalList)args); - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - static MalFunction add = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).add((MalInteger)a.nth(1)); - } - }; - static MalFunction subtract = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).subtract((MalInteger)a.nth(1)); - } - }; - static MalFunction multiply = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).multiply((MalInteger)a.nth(1)); - } - }; - static MalFunction divide = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).divide((MalInteger)a.nth(1)); - } - }; - - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - Env repl_env = new Env(null); - repl_env.set(new MalSymbol("+"), add); - repl_env.set(new MalSymbol("-"), subtract); - repl_env.set(new MalSymbol("*"), multiply); - repl_env.set(new MalSymbol("/"), divide); - - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - } - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/step4_if_fn_do.java b/java/src/main/java/mal/step4_if_fn_do.java deleted file mode 100644 index ff15709f55..0000000000 --- a/java/src/main/java/mal/step4_if_fn_do.java +++ /dev/null @@ -1,165 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class step4_if_fn_do { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - return EVAL(a2, let_env); - case "do": - el = (MalList)eval_ast(ast.rest(), env); - return el.nth(el.size()-1); - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - a3 = ast.nth(3); - return EVAL(a3, env); - } else { - return types.Nil; - } - } else { - // eval true slot form - a2 = ast.nth(2); - return EVAL(a2, env); - } - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction () { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - return f.apply(el.rest()); - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(new MalSymbol(key), core.ns.get(key)); - } - - // core.mal: defined using the language itself - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - } - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/step5_tco.java b/java/src/main/java/mal/step5_tco.java deleted file mode 100644 index 43c87b73fd..0000000000 --- a/java/src/main/java/mal/step5_tco.java +++ /dev/null @@ -1,178 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class step5_tco { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast.nth(ast.size()-1); - break; - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast.nth(3); - } else { - return types.Nil; - } - } else { - // eval true slot form - orig_ast = ast.nth(2); - } - break; - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction (a2f, (mal.env.Env)env, a1f) { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.slice(1)); - } else { - return f.apply(el.rest()); - } - } - - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(new MalSymbol(key), core.ns.get(key)); - } - - // core.mal: defined using the language itself - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - } - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/step6_file.java b/java/src/main/java/mal/step6_file.java deleted file mode 100644 index 19c4c1cd32..0000000000 --- a/java/src/main/java/mal/step6_file.java +++ /dev/null @@ -1,196 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class step6_file { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast.nth(ast.size()-1); - break; - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast.nth(3); - } else { - return types.Nil; - } - } else { - // eval true slot form - orig_ast = ast.nth(2); - } - break; - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction (a2f, (mal.env.Env)env, a1f) { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.slice(1)); - } else { - return f.apply(el.rest()); - } - } - - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - final Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(new MalSymbol(key), core.ns.get(key)); - } - repl_env.set(new MalSymbol("eval"), new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(args.nth(0), repl_env); - } - }); - MalList _argv = new MalList(); - for (Integer i=1; i < args.length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - - // core.mal: defined using the language itself - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - - Integer fileIdx = 0; - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - fileIdx = 1; - } - if (args.length > fileIdx) { - RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); - return; - } - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/step7_quote.java b/java/src/main/java/mal/step7_quote.java deleted file mode 100644 index 6d015b4851..0000000000 --- a/java/src/main/java/mal/step7_quote.java +++ /dev/null @@ -1,228 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class step7_quote { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalList ast = (MalList)orig_ast; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast.nth(1); - case "quasiquote": - orig_ast = quasiquote(ast.nth(1)); - break; - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast.nth(ast.size()-1); - break; - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast.nth(3); - } else { - return types.Nil; - } - } else { - // eval true slot form - orig_ast = ast.nth(2); - } - break; - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction (a2f, (mal.env.Env)env, a1f) { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.slice(1)); - } else { - return f.apply(el.rest()); - } - } - - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - final Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(new MalSymbol(key), core.ns.get(key)); - } - repl_env.set(new MalSymbol("eval"), new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(args.nth(0), repl_env); - } - }); - MalList _argv = new MalList(); - for (Integer i=1; i < args.length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - - // core.mal: defined using the language itself - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - - Integer fileIdx = 0; - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - fileIdx = 1; - } - if (args.length > fileIdx) { - RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); - return; - } - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/step8_macros.java b/java/src/main/java/mal/step8_macros.java deleted file mode 100644 index 38a4aef73f..0000000000 --- a/java/src/main/java/mal/step8_macros.java +++ /dev/null @@ -1,268 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class step8_macros { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static Boolean is_macro_call(MalVal ast, Env env) - throws MalThrowable { - if (ast instanceof MalList) { - MalVal a0 = ((MalList)ast).nth(0); - if (a0 instanceof MalSymbol && - env.find(((MalSymbol)a0)) != null) { - MalVal mac = env.get(((MalSymbol)a0)); - if (mac instanceof MalFunction && - ((MalFunction)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) - throws MalThrowable { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); - MalFunction mac = (MalFunction) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast.nth(1); - case "quasiquote": - orig_ast = quasiquote(ast.nth(1)); - break; - case "defmacro!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - ((MalFunction)res).setMacro(); - env.set((MalSymbol)a1, res); - return res; - case "macroexpand": - a1 = ast.nth(1); - return macroexpand(a1, env); - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast.nth(ast.size()-1); - break; - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast.nth(3); - } else { - return types.Nil; - } - } else { - // eval true slot form - orig_ast = ast.nth(2); - } - break; - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction (a2f, (mal.env.Env)env, a1f) { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.slice(1)); - } else { - return f.apply(el.rest()); - } - } - - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - final Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(new MalSymbol(key), core.ns.get(key)); - } - repl_env.set(new MalSymbol("eval"), new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(args.nth(0), repl_env); - } - }); - MalList _argv = new MalList(); - for (Integer i=1; i < args.length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - - // core.mal: defined using the language itself - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - Integer fileIdx = 0; - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - fileIdx = 1; - } - if (args.length > fileIdx) { - RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); - return; - } - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/step9_try.java b/java/src/main/java/mal/step9_try.java deleted file mode 100644 index ceeff27414..0000000000 --- a/java/src/main/java/mal/step9_try.java +++ /dev/null @@ -1,299 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.io.StringWriter; -import java.io.PrintWriter; -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class step9_try { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static Boolean is_macro_call(MalVal ast, Env env) - throws MalThrowable { - if (ast instanceof MalList) { - MalVal a0 = ((MalList)ast).nth(0); - if (a0 instanceof MalSymbol && - env.find(((MalSymbol)a0)) != null) { - MalVal mac = env.get(((MalSymbol)a0)); - if (mac instanceof MalFunction && - ((MalFunction)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) - throws MalThrowable { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); - MalFunction mac = (MalFunction) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast.nth(1); - case "quasiquote": - orig_ast = quasiquote(ast.nth(1)); - break; - case "defmacro!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - ((MalFunction)res).setMacro(); - env.set((MalSymbol)a1, res); - return res; - case "macroexpand": - a1 = ast.nth(1); - return macroexpand(a1, env); - case "try*": - try { - return EVAL(ast.nth(1), env); - } catch (Throwable t) { - if (ast.size() > 2) { - MalVal exc; - a2 = ast.nth(2); - MalVal a20 = ((MalList)a2).nth(0); - if (((MalSymbol)a20).getName().equals("catch*")) { - if (t instanceof MalException) { - exc = ((MalException)t).getValue(); - } else { - StringWriter sw = new StringWriter(); - t.printStackTrace(new PrintWriter(sw)); - String tstr = sw.toString(); - exc = new MalString(t.getMessage() + ": " + tstr); - } - return EVAL(((MalList)a2).nth(2), - new Env(env, ((MalList)a2).slice(1,2), - new MalList(exc))); - } - } - throw t; - } - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast.nth(ast.size()-1); - break; - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast.nth(3); - } else { - return types.Nil; - } - } else { - // eval true slot form - orig_ast = ast.nth(2); - } - break; - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction (a2f, (mal.env.Env)env, a1f) { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.slice(1)); - } else { - return f.apply(el.rest()); - } - } - - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - final Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(new MalSymbol(key), core.ns.get(key)); - } - repl_env.set(new MalSymbol("eval"), new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(args.nth(0), repl_env); - } - }); - MalList _argv = new MalList(); - for (Integer i=1; i < args.length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - - // core.mal: defined using the language itself - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - Integer fileIdx = 0; - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - fileIdx = 1; - } - if (args.length > fileIdx) { - RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalException e) { - System.out.println("Error: " + printer._pr_str(e.getValue(), false)); - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/java/src/main/java/mal/stepA_mal.java b/java/src/main/java/mal/stepA_mal.java deleted file mode 100644 index f8d4056b1c..0000000000 --- a/java/src/main/java/mal/stepA_mal.java +++ /dev/null @@ -1,301 +0,0 @@ -package mal; - -import java.io.IOException; - -import java.io.StringWriter; -import java.io.PrintWriter; -import java.util.List; -import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; -import mal.types.*; -import mal.readline; -import mal.reader; -import mal.printer; -import mal.env.Env; -import mal.core; - -public class stepA_mal { - // read - public static MalVal READ(String str) throws MalThrowable { - return reader.read_str(str); - } - - // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; - } - - public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { - return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); - } - } - - public static Boolean is_macro_call(MalVal ast, Env env) - throws MalThrowable { - if (ast instanceof MalList) { - MalVal a0 = ((MalList)ast).nth(0); - if (a0 instanceof MalSymbol && - env.find(((MalSymbol)a0)) != null) { - MalVal mac = env.get(((MalSymbol)a0)); - if (mac instanceof MalFunction && - ((MalFunction)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) - throws MalThrowable { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); - MalFunction mac = (MalFunction) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } - } - - public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a0, a1,a2, a3, res; - MalList el; - - while (true) { - - //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); - } - - // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { return expanded; } - MalList ast = (MalList) expanded; - if (ast.size() == 0) { return ast; } - a0 = ast.nth(0); - String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() - : "__<*fn*>__"; - switch (a0sym) { - case "def!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - env.set(((MalSymbol)a1), res); - return res; - case "let*": - a1 = ast.nth(1); - a2 = ast.nth(2); - MalSymbol key; - MalVal val; - Env let_env = new Env(env); - for(int i=0; i<((MalList)a1).size(); i+=2) { - key = (MalSymbol)((MalList)a1).nth(i); - val = ((MalList)a1).nth(i+1); - let_env.set(key, EVAL(val, let_env)); - } - orig_ast = a2; - env = let_env; - break; - case "quote": - return ast.nth(1); - case "quasiquote": - orig_ast = quasiquote(ast.nth(1)); - break; - case "defmacro!": - a1 = ast.nth(1); - a2 = ast.nth(2); - res = EVAL(a2, env); - ((MalFunction)res).setMacro(); - env.set((MalSymbol)a1, res); - return res; - case "macroexpand": - a1 = ast.nth(1); - return macroexpand(a1, env); - case "try*": - try { - return EVAL(ast.nth(1), env); - } catch (Throwable t) { - if (ast.size() > 2) { - MalVal exc; - a2 = ast.nth(2); - MalVal a20 = ((MalList)a2).nth(0); - if (((MalSymbol)a20).getName().equals("catch*")) { - if (t instanceof MalException) { - exc = ((MalException)t).getValue(); - } else { - StringWriter sw = new StringWriter(); - t.printStackTrace(new PrintWriter(sw)); - String tstr = sw.toString(); - exc = new MalString(t.getMessage() + ": " + tstr); - } - return EVAL(((MalList)a2).nth(2), - new Env(env, ((MalList)a2).slice(1,2), - new MalList(exc))); - } - } - throw t; - } - case "do": - eval_ast(ast.slice(1, ast.size()-1), env); - orig_ast = ast.nth(ast.size()-1); - break; - case "if": - a1 = ast.nth(1); - MalVal cond = EVAL(a1, env); - if (cond == types.Nil || cond == types.False) { - // eval false slot form - if (ast.size() > 3) { - orig_ast = ast.nth(3); - } else { - return types.Nil; - } - } else { - // eval true slot form - orig_ast = ast.nth(2); - } - break; - case "fn*": - final MalList a1f = (MalList)ast.nth(1); - final MalVal a2f = ast.nth(2); - final Env cur_env = env; - return new MalFunction (a2f, (mal.env.Env)env, a1f) { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(a2f, new Env(cur_env, a1f, args)); - } - }; - default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); - MalVal fnast = f.getAst(); - if (fnast != null) { - orig_ast = fnast; - env = f.genEnv(el.slice(1)); - } else { - return f.apply(el.rest()); - } - } - - } - } - - // print - public static String PRINT(MalVal exp) { - return printer._pr_str(exp, true); - } - - // repl - public static MalVal RE(Env env, String str) throws MalThrowable { - return EVAL(READ(str), env); - } - - public static void main(String[] args) throws MalThrowable { - String prompt = "user> "; - - final Env repl_env = new Env(null); - - // core.java: defined using Java - for (String key : core.ns.keySet()) { - repl_env.set(new MalSymbol(key), core.ns.get(key)); - } - repl_env.set(new MalSymbol("eval"), new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return EVAL(args.nth(0), repl_env); - } - }); - MalList _argv = new MalList(); - for (Integer i=1; i < args.length; i++) { - _argv.conj_BANG(new MalString(args[i])); - } - repl_env.set(new MalSymbol("*ARGV*"), _argv); - - - // core.mal: defined using the language itself - RE(repl_env, "(def! *host-language* \"java\")"); - RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); - RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - Integer fileIdx = 0; - if (args.length > 0 && args[0].equals("--raw")) { - readline.mode = readline.Mode.JAVA; - fileIdx = 1; - } - if (args.length > fileIdx) { - RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); - return; - } - - // repl loop - RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); - while (true) { - String line; - try { - line = readline.readline(prompt); - if (line == null) { continue; } - } catch (readline.EOFException e) { - break; - } catch (IOException e) { - System.out.println("IOException: " + e.getMessage()); - break; - } - try { - System.out.println(PRINT(RE(repl_env, line))); - } catch (MalContinue e) { - continue; - } catch (MalException e) { - System.out.println("Error: " + printer._pr_str(e.getValue(), false)); - continue; - } catch (MalThrowable t) { - System.out.println("Error: " + t.getMessage()); - continue; - } catch (Throwable t) { - System.out.println("Uncaught " + t + ": " + t.getMessage()); - continue; - } - } - } -} diff --git a/js/Makefile b/js/Makefile deleted file mode 100644 index 98c429145f..0000000000 --- a/js/Makefile +++ /dev/null @@ -1,36 +0,0 @@ - -TESTS = tests/types.js tests/reader.js - -SOURCES_BASE = node_readline.js types.js reader.js printer.js -SOURCES_LISP = env.js core.js stepA_mal.js -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) -WEB_SOURCES = $(SOURCES:node_readline.js=jq_readline.js) - -all: node_modules mal.js web/mal.js - -node_modules: - npm install - -mal.js: $(SOURCES) - echo "#!/usr/bin/env node" > $@ - cat $+ | grep -v "= *require('./" >> $@ - chmod +x $@ - -web/mal.js: $(WEB_SOURCES) - cat $+ | grep -v "= *require('./" > $@ - -clean: - rm -f mal.js web/mal.js - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - node $@ || exit 1; \ diff --git a/js/env.js b/js/env.js deleted file mode 100644 index 421b2200ce..0000000000 --- a/js/env.js +++ /dev/null @@ -1,52 +0,0 @@ -// Node vs browser behavior -var env = {}; -if (typeof module === 'undefined') { - var exports = env; -} - -// Env implementation -function Env(outer, binds, exprs) { - this.data = {}; - this.outer = outer || null; - - if (binds && exprs) { - // Returns a new Env with symbols in binds bound to - // corresponding values in exprs - // TODO: check types of binds and exprs and compare lengths - for (var i=0; i "; - - if (!rl_history_loaded) { - rl_history_loaded = true; - var lines = []; - if (fs.existsSync(HISTORY_FILE)) { - lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); - } - // Max of 2000 lines - lines = lines.slice(Math.max(lines.length - 2000, 0)); - for (var i=0; i "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step2_eval.js b/js/step2_eval.js deleted file mode 100644 index 58d561c8d9..0000000000 --- a/js/step2_eval.js +++ /dev/null @@ -1,78 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env[ast]; - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - var el = eval_ast(ast, env), f = el[0]; - return f.apply(f, el.slice(1)); -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -repl_env = {}; -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -repl_env['+'] = function(a,b){return a+b;}; -repl_env['-'] = function(a,b){return a-b;}; -repl_env['*'] = function(a,b){return a*b;}; -repl_env['/'] = function(a,b){return a/b;}; - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step3_env.js b/js/step3_env.js deleted file mode 100644 index ca8f818096..0000000000 --- a/js/step3_env.js +++ /dev/null @@ -1,92 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - default: - var el = eval_ast(ast, env), f = el[0]; - return f.apply(f, el.slice(1)); - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -repl_env.set(types._symbol('+'), function(a,b){return a+b;}); -repl_env.set(types._symbol('-'), function(a,b){return a-b;}); -repl_env.set(types._symbol('*'), function(a,b){return a*b;}); -repl_env.set(types._symbol('/'), function(a,b){return a/b;}); - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step4_if_fn_do.js b/js/step4_if_fn_do.js deleted file mode 100644 index 937d0eabb0..0000000000 --- a/js/step4_if_fn_do.js +++ /dev/null @@ -1,108 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - case "do": - var el = eval_ast(ast.slice(1), env); - return el[el.length-1]; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - return typeof a3 !== "undefined" ? EVAL(a3, env) : null; - } else { - return EVAL(a2, env); - } - case "fn*": - return function() { - return EVAL(a2, new Env(env, a1, arguments)); - }; - default: - var el = eval_ast(ast, env), f = el[0]; - return f.apply(f, el.slice(1)); - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step5_tco.js b/js/step5_tco.js deleted file mode 100644 index 03de2cca5a..0000000000 --- a/js/step5_tco.js +++ /dev/null @@ -1,119 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step6_file.js b/js/step6_file.js deleted file mode 100644 index 813c66d9ec..0000000000 --- a/js/step6_file.js +++ /dev/null @@ -1,129 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } -repl_env.set(types._symbol('eval'), function(ast) { - return EVAL(ast, repl_env); }); -repl_env.set(types._symbol('*ARGV*'), []); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set('*ARGV*', process.argv.slice(3)); - rep('(load-file "' + process.argv[2] + '")'); - process.exit(0); -} - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step7_quote.js b/js/step7_quote.js deleted file mode 100644 index b39ebbd4a0..0000000000 --- a/js/step7_quote.js +++ /dev/null @@ -1,154 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function is_pair(x) { - return types._sequential_Q(x) && x.length > 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; - } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; - } -} - -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "quote": - return a1; - case "quasiquote": - ast = quasiquote(a1); - break; - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } -repl_env.set(types._symbol('eval'), function(ast) { - return EVAL(ast, repl_env); }); -repl_env.set(types._symbol('*ARGV*'), []); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set('*ARGV*', process.argv.slice(3)); - rep('(load-file "' + process.argv[2] + '")'); - process.exit(0); -} - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step8_macros.js b/js/step8_macros.js deleted file mode 100644 index 397379e70b..0000000000 --- a/js/step8_macros.js +++ /dev/null @@ -1,180 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function is_pair(x) { - return types._sequential_Q(x) && x.length > 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; - } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; - } -} - -function is_macro_call(ast, env) { - return types._list_Q(ast) && - types._symbol_Q(ast[0]) && - env.find(ast[0]) && - env.get(ast[0])._ismacro_; -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - var mac = env.get(ast[0]); - ast = mac.apply(mac, ast.slice(1)); - } - return ast; -} - -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - ast = macroexpand(ast, env); - if (!types._list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "quote": - return a1; - case "quasiquote": - ast = quasiquote(a1); - break; - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } -repl_env.set(types._symbol('eval'), function(ast) { - return EVAL(ast, repl_env); }); -repl_env.set(types._symbol('*ARGV*'), []); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); - rep('(load-file "' + process.argv[2] + '")'); - process.exit(0); -} - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/step9_try.js b/js/step9_try.js deleted file mode 100644 index 6be44749ec..0000000000 --- a/js/step9_try.js +++ /dev/null @@ -1,191 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function is_pair(x) { - return types._sequential_Q(x) && x.length > 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; - } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; - } -} - -function is_macro_call(ast, env) { - return types._list_Q(ast) && - types._symbol_Q(ast[0]) && - env.find(ast[0]) && - env.get(ast[0])._ismacro_; -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - var mac = env.get(ast[0]); - ast = mac.apply(mac, ast.slice(1)); - } - return ast; -} - -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - ast = macroexpand(ast, env); - if (!types._list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "quote": - return a1; - case "quasiquote": - ast = quasiquote(a1); - break; - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "try*": - try { - return EVAL(a1, env); - } catch (exc) { - if (a2 && a2[0].value === "catch*") { - if (exc instanceof Error) { exc = exc.message; } - return EVAL(a2[2], new Env(env, [a2[1]], [exc])); - } else { - throw exc; - } - } - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } -repl_env.set(types._symbol('eval'), function(ast) { - return EVAL(ast, repl_env); }); -repl_env.set(types._symbol('*ARGV*'), []); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); - rep('(load-file "' + process.argv[2] + '")'); - process.exit(0); -} - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/stepA_mal.js b/js/stepA_mal.js deleted file mode 100644 index d879cd3e86..0000000000 --- a/js/stepA_mal.js +++ /dev/null @@ -1,203 +0,0 @@ -if (typeof module !== 'undefined') { - var types = require('./types'); - var readline = require('./node_readline'); - var reader = require('./reader'); - var printer = require('./printer'); - var Env = require('./env').Env; - var core = require('./core'); - var interop = require('./interop'); -} - -// read -function READ(str) { - return reader.read_str(str); -} - -// eval -function is_pair(x) { - return types._sequential_Q(x) && x.length > 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; - } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; - } -} - -function is_macro_call(ast, env) { - return types._list_Q(ast) && - types._symbol_Q(ast[0]) && - env.find(ast[0]) && - env.get(ast[0])._ismacro_; -} - -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - var mac = env.get(ast[0]); - ast = mac.apply(mac, ast.slice(1)); - } - return ast; -} - -function eval_ast(ast, env) { - if (types._symbol_Q(ast)) { - return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); - } else if (types._vector_Q(ast)) { - var v = ast.map(function(a) { return EVAL(a, env); }); - v.__isvector__ = true; - return v; - } else if (types._hash_map_Q(ast)) { - var new_hm = {}; - for (k in ast) { - new_hm[EVAL(k, env)] = EVAL(ast[k], env); - } - return new_hm; - } else { - return ast; - } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - - // apply list - ast = macroexpand(ast, env); - if (!types._list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i], EVAL(a1[i+1], let_env)); - } - ast = a2; - env = let_env; - break; - case "quote": - return a1; - case "quasiquote": - ast = quasiquote(a1); - break; - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "js*": - return eval(a1.toString()); - case ".": - var el = eval_ast(ast.slice(2), env), - r = interop.resolve_js(a1.toString()), - obj = r[0], f = r[1]; - var res = f.apply(obj, el); - console.log("DEBUG3:", res); - return interop.js_to_mal(res); - case "try*": - try { - return EVAL(a1, env); - } catch (exc) { - if (a2 && a2[0].value === "catch*") { - if (exc instanceof Error) { exc = exc.message; } - return EVAL(a2[2], new Env(env, [a2[1]], [exc])); - } else { - throw exc; - } - } - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types._function(EVAL, Env, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0]; - if (f.__ast__) { - ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } - } - - } -} - -function EVAL(ast, env) { - var result = _EVAL(ast, env); - return (typeof result !== "undefined") ? result : null; -} - -// print -function PRINT(exp) { - return printer._pr_str(exp, true); -} - -// repl -var repl_env = new Env(); -var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; - -// core.js: defined using javascript -for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } -repl_env.set(types._symbol('eval'), function(ast) { - return EVAL(ast, repl_env); }); -repl_env.set(types._symbol('*ARGV*'), []); - -// core.mal: defined using the language itself -rep("(def! *host-language* \"javascript\")") -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (typeof process !== 'undefined' && process.argv.length > 2) { - repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); - rep('(load-file "' + process.argv[2] + '")'); - process.exit(0); -} - -// repl loop -if (typeof require !== 'undefined' && require.main === module) { - // Synchronous node.js commandline mode - rep("(println (str \"Mal [\" *host-language* \"]\"))"); - while (true) { - var line = readline.readline("user> "); - if (line === null) { break; } - try { - if (line) { printer.println(rep(line)); } - } catch (exc) { - if (exc instanceof reader.BlankException) { continue; } - if (exc.stack) { printer.println(exc.stack); } - else { printer.println(exc); } - } - } -} diff --git a/js/tests/stepA_mal.mal b/js/tests/stepA_mal.mal deleted file mode 100644 index f785292d48..0000000000 --- a/js/tests/stepA_mal.mal +++ /dev/null @@ -1,24 +0,0 @@ -;; Testing basic bash interop - -(js* "7") -;=>7 - -(js* "'7'") -;=>"7" - -(js* "[7,8,9]") -;=>(7 8 9) - -(js* "console.log('hello');") -; hello -;=>nil - -(js* "foo=8;") -(js* "foo;") -;=>8 - -(js* "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") -;=>"XaY XbY XcY" - -(js* "[1,2,3].map(function(x){return 1+x})") -;=>(2 3 4) diff --git a/lib b/lib new file mode 120000 index 0000000000..092ad3b847 --- /dev/null +++ b/lib @@ -0,0 +1 @@ +impls/lib \ No newline at end of file diff --git a/lua/Makefile b/lua/Makefile deleted file mode 100644 index 169c587380..0000000000 --- a/lua/Makefile +++ /dev/null @@ -1,26 +0,0 @@ -TESTS = - -SOURCES_BASE = utils.lua types.lua reader.lua printer.lua -SOURCES_LISP = env.lua core.lua stepA_mal.lua -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: libs - -.PHONY: stats tests $(TESTS) - -clean: - rm -f linenoise.so - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - - -.PHONY: libs -libs: linenoise.so - -linenoise.so: - luarocks install --tree=./ linenoise - ln -sf lib/lua/5.1/linenoise.so $@ - diff --git a/lua/core.lua b/lua/core.lua deleted file mode 100644 index 279a6d6f2d..0000000000 --- a/lua/core.lua +++ /dev/null @@ -1,228 +0,0 @@ -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local readline = require('readline') - -local Nil, List, _pr_str = types.Nil, types.List, printer._pr_str - -local M = {} - --- string functions - -function pr_str(...) - return table.concat( - utils.map(function(e) return _pr_str(e, true) end, arg), " ") -end - -function str(...) - return table.concat( - utils.map(function(e) return _pr_str(e, false) end, arg), "") -end - -function prn(...) - print(table.concat( - utils.map(function(e) return _pr_str(e, true) end, arg), " ")) - io.flush() - return Nil -end - -function println(...) - print(table.concat( - utils.map(function(e) return _pr_str(e, false) end, arg), " ")) - io.flush() - return Nil -end - -function slurp(file) - local lines = {} - for line in io.lines(file) do - lines[#lines+1] = line - end - return table.concat(lines, "\n") .. "\n" -end - -function do_readline(prompt) - local line = readline.readline(prompt) - if line == nil then - return Nil - else - return line - end -end - --- hash map functions - -function assoc(hm, ...) - return types._assoc_BANG(types.copy(hm), unpack(arg)) -end - -function dissoc(hm, ...) - return types._dissoc_BANG(types.copy(hm), unpack(arg)) -end - -function get(hm, key) - local res = hm[key] - if res == nil then return Nil end - return res -end - -function keys(hm) - local res = {} - for k,v in pairs(hm) do - res[#res+1] = k - end - return List:new(res) -end - -function vals(hm) - local res = {} - for k,v in pairs(hm) do - res[#res+1] = v - end - return List:new(res) -end - --- sequential functions - -function cons(a,lst) - local new_lst = lst:slice(1) - table.insert(new_lst, 1, a) - return List:new(new_lst) -end - -function concat(...) - local new_lst = {} - for i = 1, #arg do - for j = 1, #arg[i] do - table.insert(new_lst, arg[i][j]) - end - end - return List:new(new_lst) -end - -function nth(seq, idx) - if idx+1 <= #seq then - return seq[idx+1] - else - types.throw("nth: index out of range") - end -end - -function first(a) - if #a == 0 then - return Nil - else - return a[1] - end -end - -function apply(f, ...) - if types._malfunc_Q(f) then - f = f.fn - end - local args = concat(types.slice(arg, 1, #arg-1), - arg[#arg]) - return f(unpack(args)) -end - -function map(f, lst) - if types._malfunc_Q(f) then - f = f.fn - end - return List:new(utils.map(f, lst)) -end - --- metadata functions - -function meta(obj) - local m = getmetatable(obj) - if m == nil or m.meta == nil then return Nil end - return m.meta -end - -function with_meta(obj, meta) - local new_obj = types.copy(obj) - getmetatable(new_obj).meta = meta - return new_obj -end - --- atom functions - -function swap_BANG(atm,f,...) - if types._malfunc_Q(f) then - f = f.fn - end - local args = List:new(arg) - table.insert(args, 1, atm.val) - atm.val = f(unpack(args)) - return atm.val -end - -M.ns = { - ['='] = types._equal_Q, - throw = types.throw, - - ['nil?'] = function(a) return a==Nil end, - ['true?'] = function(a) return a==true end, - ['false?'] = function(a) return a==false end, - symbol = function(a) return types.Symbol:new(a) end, - ['symbol?'] = function(a) return types._symbol_Q(a) end, - keyword = function(a) return "\177"..a end, - ['keyword?'] = function(a) return types._keyword_Q(a) end, - - ['pr-str'] = pr_str, - str = str, - prn = prn, - println = println, - ['read-string'] = reader.read_str, - readline = do_readline, - slurp = slurp, - - ['<'] = function(a,b) return a'] = function(a,b) return a>b end, - ['>='] = function(a,b) return a>=b end, - ['+'] = function(a,b) return a+b end, - ['-'] = function(a,b) return a-b end, - ['*'] = function(a,b) return a*b end, - ['/'] = function(a,b) return math.floor(a/b) end, - -- TODO: get actual milliseconds - ['time-ms'] = function() return os.time() * 1000 end, - - list = function(...) return List:new(arg) end, - ['list?'] = function(a) return types._list_Q(a) end, - vector = function(...) return types.Vector:new(arg) end, - ['vector?'] = types._vector_Q, - ['hash-map'] = types.hash_map, - ['map?'] = types._hash_map_Q, - assoc = assoc, - dissoc = dissoc, - get = get, - ['contains?'] = function(a,b) return a[b] ~= nil end, - keys = keys, - vals = vals, - - ['sequential?'] = types._sequential_Q, - cons = cons, - concat = concat, - nth = nth, - first = first, - rest = function(a) return List:new(a:slice(2)) end, - ['empty?'] = function(a) return a==Nil or #a == 0 end, - count = function(a) return #a end, - apply = apply, - map = map, - conj = function(...) return Nil end, - - meta = meta, - ['with-meta'] = with_meta, - atom = function(a) return types.Atom:new(a) end, - ['atom?'] = types._atom_Q, - deref = function(a) return a.val end, - ['reset!'] = function(a,b) a.val = b; return b end, - ['swap!'] = swap_BANG, -} - -return M - diff --git a/lua/env.lua b/lua/env.lua deleted file mode 100644 index ee19c90f31..0000000000 --- a/lua/env.lua +++ /dev/null @@ -1,53 +0,0 @@ -local rex = require('rex_pcre') -local string = require('string') -local table = require('table') -local utils = require('utils') -local types = require('types') - -local Env = {} - -function Env:new(outer, binds, exprs) - local data = {} - local newObj = {outer = outer, data = data} - self.__index = self - if binds then - for i, b in ipairs(binds) do - if binds[i].val == '&' then - local new_exprs = types.List:new() - for j = i, #exprs do - table.insert(new_exprs, exprs[j]) - end - table.remove(exprs, 1) - data[binds[i+1].val] = new_exprs - break - end - data[binds[i].val] = exprs[i] - end - end - return setmetatable(newObj, self) -end -function Env:find(sym) - if self.data[sym.val] ~= nil then - return self - else - if self.outer ~= nil then - return self.outer:find(sym) - else - return nil - end - end -end -function Env:set(sym,val) - self.data[sym.val] = val - return val -end -function Env:get(sym) - local env = self:find(sym) - if env then - return env.data[sym.val] - else - types.throw("'"..sym.val.."' not found") - end -end - -return Env diff --git a/lua/printer.lua b/lua/printer.lua deleted file mode 100644 index 8c1cdad5d9..0000000000 --- a/lua/printer.lua +++ /dev/null @@ -1,55 +0,0 @@ -local string = require('string') -local table = require('table') -local types = require('types') -local utils = require('utils') - -local M = {} - -function M._pr_str(obj, print_readably) - local _r = print_readably - if utils.instanceOf(obj, types.Symbol) then - return obj.val - elseif types._list_Q(obj) then - return "(" .. table.concat(utils.map(function(e) - return M._pr_str(e,_r) end, obj), " ") .. ")" - elseif types._vector_Q(obj) then - return "[" .. table.concat(utils.map(function(e) - return M._pr_str(e,_r) end, obj), " ") .. "]" - elseif types._hash_map_Q(obj) then - local res = {} - for k,v in pairs(obj) do - res[#res+1] = M._pr_str(k, _r) - res[#res+1] = M._pr_str(v, _r) - end - return "{".. table.concat(res, " ").."}" - elseif type(obj) == 'string' then - if string.sub(obj,1,1) == "\177" then - return ':' .. string.sub(obj,2) - else - if _r then - local sval = obj:gsub('\\', '\\\\') - sval = sval:gsub('"', '\\"') - sval = sval:gsub('\n', '\\n') - return '"' .. sval .. '"' - else - return obj - end - end - elseif obj == types.Nil then - return "nil" - elseif obj == true then - return "true" - elseif obj == false then - return "false" - elseif types._malfunc_Q(obj) then - return "(fn* "..M._pr_str(obj.params).." "..M._pr_str(obj.ast)..")" - elseif types._atom_Q(obj) then - return "(atom "..M._pr_str(obj.val)..")" - elseif type(obj) == 'function' then - return "#" - else - return string.format("%s", obj) - end -end - -return M diff --git a/lua/readline.lua b/lua/readline.lua deleted file mode 100644 index 5acdb543ec..0000000000 --- a/lua/readline.lua +++ /dev/null @@ -1,33 +0,0 @@ -local LN = require('linenoise') - -local M = {} - -local history_loaded = false -local history_file = os.getenv("HOME") .. "/.mal-history" - -M.raw = false - -function M.readline(prompt) - if not history_loaded then - history_loaded = true - for line in io.lines(history_file) do - LN.historyadd(line) - end - end - - if M.raw then - io.write(prompt); io.flush(); - line = io.read() - else - line = LN.linenoise(prompt) - end - if line then - LN.historyadd(line) - local f = io.open(history_file, "a") - f:write(line.."\n") - f:close() - end - return line -end - -return M diff --git a/lua/step3_env.lua b/lua/step3_env.lua deleted file mode 100755 index dbdb879a1f..0000000000 --- a/lua/step3_env.lua +++ /dev/null @@ -1,92 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - local a0,a1,a2 = ast[1], ast[2],ast[3] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - return EVAL(a2, let_env) - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - return f(unpack(args)) - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - -repl_env:set(types.Symbol:new('+'), function(a,b) return a+b end) -repl_env:set(types.Symbol:new('-'), function(a,b) return a-b end) -repl_env:set(types.Symbol:new('*'), function(a,b) return a*b end) -repl_env:set(types.Symbol:new('/'), function(a,b) return math.floor(a/b) end) - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true -end - -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() - print(rep(line)) - end, function(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end - end) -end diff --git a/lua/step4_if_fn_do.lua b/lua/step4_if_fn_do.lua deleted file mode 100755 index 65b3a0a547..0000000000 --- a/lua/step4_if_fn_do.lua +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local core = require('core') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - return EVAL(a2, let_env) - elseif 'do' == a0sym then - local el = eval_ast(ast:slice(2,#ast), env) - return el[#el] - elseif 'if' == a0sym then - local cond = EVAL(a1, env) - if cond == types.Nil or cond == false then - if a3 then return EVAL(a3, env) else return types.Nil end - else - return EVAL(a2, env) - end - elseif 'fn*' == a0sym then - return function(...) - return EVAL(a2, Env:new(env, a1, arg)) - end - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - return f(unpack(args)) - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - --- core.lua: defined using Lua -for k,v in pairs(core.ns) do - repl_env:set(types.Symbol:new(k), v) -end - --- core.mal: defined using mal -rep("(def! not (fn* (a) (if a false true)))") - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true -end - -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() - print(rep(line)) - end, function(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end - end) -end diff --git a/lua/step5_tco.lua b/lua/step5_tco.lua deleted file mode 100755 index 237f5ead11..0000000000 --- a/lua/step5_tco.lua +++ /dev/null @@ -1,118 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local core = require('core') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - while true do - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - env = let_env - ast = a2 -- TCO - elseif 'do' == a0sym then - local el = eval_ast(ast:slice(2,#ast-1), env) - ast = ast[#ast] -- TCO - elseif 'if' == a0sym then - local cond = EVAL(a1, env) - if cond == types.Nil or cond == false then - if a3 then ast = a3 else return types.Nil end -- TCO - else - ast = a2 -- TCO - end - elseif 'fn*' == a0sym then - return types.MalFunc:new(function(...) - return EVAL(a2, Env:new(env, a1, arg)) - end, a2, env, a1) - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - if types._malfunc_Q(f) then - ast = f.ast - env = Env:new(f.env, f.params, args) -- TCO - else - return f(unpack(args)) - end - end - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - --- core.lua: defined using Lua -for k,v in pairs(core.ns) do - repl_env:set(types.Symbol:new(k), v) -end - --- core.mal: defined using mal -rep("(def! not (fn* (a) (if a false true)))") - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true -end - -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() - print(rep(line)) - end, function(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end - end) -end diff --git a/lua/step6_file.lua b/lua/step6_file.lua deleted file mode 100755 index 79928883fd..0000000000 --- a/lua/step6_file.lua +++ /dev/null @@ -1,128 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local core = require('core') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - while true do - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - env = let_env - ast = a2 -- TCO - elseif 'do' == a0sym then - local el = eval_ast(ast:slice(2,#ast-1), env) - ast = ast[#ast] -- TCO - elseif 'if' == a0sym then - local cond = EVAL(a1, env) - if cond == types.Nil or cond == false then - if a3 then ast = a3 else return types.Nil end -- TCO - else - ast = a2 -- TCO - end - elseif 'fn*' == a0sym then - return types.MalFunc:new(function(...) - return EVAL(a2, Env:new(env, a1, arg)) - end, a2, env, a1) - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - if types._malfunc_Q(f) then - ast = f.ast - env = Env:new(f.env, f.params, args) -- TCO - else - return f(unpack(args)) - end - end - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - --- core.lua: defined using Lua -for k,v in pairs(core.ns) do - repl_env:set(types.Symbol:new(k), v) -end -repl_env:set(types.Symbol:new('eval'), - function(ast) return EVAL(ast, repl_env) end) -repl_env:set(types.Symbol:new('*ARGV*'), types.List:new(types.slice(arg,2))) - --- core.mal: defined using mal -rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true - table.remove(arg,1) -end - -if #arg > 0 then - rep("(load-file \""..arg[1].."\")") - os.exit(0) -end - -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() - print(rep(line)) - end, function(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end - end) -end diff --git a/lua/step7_quote.lua b/lua/step7_quote.lua deleted file mode 100755 index 32bf60c399..0000000000 --- a/lua/step7_quote.lua +++ /dev/null @@ -1,154 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local core = require('core') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 -end - -function quasiquote(ast) - if not is_pair(ast) then - return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) - else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) - end -end - -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - while true do - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - env = let_env - ast = a2 -- TCO - elseif 'quote' == a0sym then - return a1 - elseif 'quasiquote' == a0sym then - ast = quasiquote(a1) -- TCO - elseif 'do' == a0sym then - local el = eval_ast(ast:slice(2,#ast-1), env) - ast = ast[#ast] -- TCO - elseif 'if' == a0sym then - local cond = EVAL(a1, env) - if cond == types.Nil or cond == false then - if a3 then ast = a3 else return types.Nil end -- TCO - else - ast = a2 -- TCO - end - elseif 'fn*' == a0sym then - return types.MalFunc:new(function(...) - return EVAL(a2, Env:new(env, a1, arg)) - end, a2, env, a1) - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - if types._malfunc_Q(f) then - ast = f.ast - env = Env:new(f.env, f.params, args) -- TCO - else - return f(unpack(args)) - end - end - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - --- core.lua: defined using Lua -for k,v in pairs(core.ns) do - repl_env:set(types.Symbol:new(k), v) -end -repl_env:set(types.Symbol:new('eval'), - function(ast) return EVAL(ast, repl_env) end) -repl_env:set(types.Symbol:new('*ARGV*'), types.List:new(types.slice(arg,2))) - --- core.mal: defined using mal -rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true - table.remove(arg,1) -end - -if #arg > 0 then - rep("(load-file \""..arg[1].."\")") - os.exit(0) -end - -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() - print(rep(line)) - end, function(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end - end) -end diff --git a/lua/step8_macros.lua b/lua/step8_macros.lua deleted file mode 100755 index 25a9238e61..0000000000 --- a/lua/step8_macros.lua +++ /dev/null @@ -1,183 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local core = require('core') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 -end - -function quasiquote(ast) - if not is_pair(ast) then - return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) - else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) - end -end - -function is_macro_call(ast, env) - if types._list_Q(ast) and - types._symbol_Q(ast[1]) and - env:find(ast[1]) then - local f = env:get(ast[1]) - return types._malfunc_Q(f) and f.ismacro - end -end - -function macroexpand(ast, env) - while is_macro_call(ast, env) do - local mac = env:get(ast[1]) - ast = mac.fn(unpack(ast:slice(2))) - end - return ast -end - -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - while true do - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - -- apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast) then return ast end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - env = let_env - ast = a2 -- TCO - elseif 'quote' == a0sym then - return a1 - elseif 'quasiquote' == a0sym then - ast = quasiquote(a1) -- TCO - elseif 'defmacro!' == a0sym then - local mac = EVAL(a2, env) - mac.ismacro = true - return env:set(a1, mac) - elseif 'macroexpand' == a0sym then - return macroexpand(a1, env) - elseif 'do' == a0sym then - local el = eval_ast(ast:slice(2,#ast-1), env) - ast = ast[#ast] -- TCO - elseif 'if' == a0sym then - local cond = EVAL(a1, env) - if cond == types.Nil or cond == false then - if a3 then ast = a3 else return types.Nil end -- TCO - else - ast = a2 -- TCO - end - elseif 'fn*' == a0sym then - return types.MalFunc:new(function(...) - return EVAL(a2, Env:new(env, a1, arg)) - end, a2, env, a1) - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - if types._malfunc_Q(f) then - ast = f.ast - env = Env:new(f.env, f.params, args) -- TCO - else - return f(unpack(args)) - end - end - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - --- core.lua: defined using Lua -for k,v in pairs(core.ns) do - repl_env:set(types.Symbol:new(k), v) -end -repl_env:set(types.Symbol:new('eval'), - function(ast) return EVAL(ast, repl_env) end) -repl_env:set(types.Symbol:new('*ARGV*'), types.List:new(types.slice(arg,2))) - --- core.mal: defined using mal -rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true - table.remove(arg,1) -end - -if #arg > 0 then - rep("(load-file \""..arg[1].."\")") - os.exit(0) -end - -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() - print(rep(line)) - end, function(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end - end) -end diff --git a/lua/step9_try.lua b/lua/step9_try.lua deleted file mode 100755 index 315d69832e..0000000000 --- a/lua/step9_try.lua +++ /dev/null @@ -1,203 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local core = require('core') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 -end - -function quasiquote(ast) - if not is_pair(ast) then - return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) - else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) - end -end - -function is_macro_call(ast, env) - if types._list_Q(ast) and - types._symbol_Q(ast[1]) and - env:find(ast[1]) then - local f = env:get(ast[1]) - return types._malfunc_Q(f) and f.ismacro - end -end - -function macroexpand(ast, env) - while is_macro_call(ast, env) do - local mac = env:get(ast[1]) - ast = mac.fn(unpack(ast:slice(2))) - end - return ast -end - -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - while true do - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - -- apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast) then return ast end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - env = let_env - ast = a2 -- TCO - elseif 'quote' == a0sym then - return a1 - elseif 'quasiquote' == a0sym then - ast = quasiquote(a1) -- TCO - elseif 'defmacro!' == a0sym then - local mac = EVAL(a2, env) - mac.ismacro = true - return env:set(a1, mac) - elseif 'macroexpand' == a0sym then - return macroexpand(a1, env) - elseif 'try*' == a0sym then - local exc, result = nil, nil - xpcall(function() - result = EVAL(a1, env) - end, function(err) - exc = err - end) - if exc ~= nil then - if types._malexception_Q(exc) then - exc = exc.val - end - if a2 and a2[1].val == 'catch*' then - result = EVAL(a2[3], Env:new(env, {a2[2]}, {exc})) - else - types.throw(exc) - end - end - return result - elseif 'do' == a0sym then - local el = eval_ast(ast:slice(2,#ast-1), env) - ast = ast[#ast] -- TCO - elseif 'if' == a0sym then - local cond = EVAL(a1, env) - if cond == types.Nil or cond == false then - if a3 then ast = a3 else return types.Nil end -- TCO - else - ast = a2 -- TCO - end - elseif 'fn*' == a0sym then - return types.MalFunc:new(function(...) - return EVAL(a2, Env:new(env, a1, arg)) - end, a2, env, a1) - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - if types._malfunc_Q(f) then - ast = f.ast - env = Env:new(f.env, f.params, args) -- TCO - else - return f(unpack(args)) - end - end - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - --- core.lua: defined using Lua -for k,v in pairs(core.ns) do - repl_env:set(types.Symbol:new(k), v) -end -repl_env:set(types.Symbol:new('eval'), - function(ast) return EVAL(ast, repl_env) end) -repl_env:set(types.Symbol:new('*ARGV*'), types.List:new(types.slice(arg,2))) - --- core.mal: defined using mal -rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -function print_exception(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end -end - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true - table.remove(arg,1) -end - -if #arg > 0 then - xpcall(function() rep("(load-file \""..arg[1].."\")") end, - print_exception) - os.exit(0) -end - -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() print(rep(line)) end, - print_exception) -end diff --git a/lua/stepA_mal.lua b/lua/stepA_mal.lua deleted file mode 100755 index db31789901..0000000000 --- a/lua/stepA_mal.lua +++ /dev/null @@ -1,205 +0,0 @@ -#!/usr/bin/env lua - -local table = require('table') - -local readline = require('readline') -local utils = require('utils') -local types = require('types') -local reader = require('reader') -local printer = require('printer') -local Env = require('env') -local core = require('core') -local List, Vector, HashMap = types.List, types.Vector, types.HashMap - --- read -function READ(str) - return reader.read_str(str) -end - --- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 -end - -function quasiquote(ast) - if not is_pair(ast) then - return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) - else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) - end -end - -function is_macro_call(ast, env) - if types._list_Q(ast) and - types._symbol_Q(ast[1]) and - env:find(ast[1]) then - local f = env:get(ast[1]) - return types._malfunc_Q(f) and f.ismacro - end -end - -function macroexpand(ast, env) - while is_macro_call(ast, env) do - local mac = env:get(ast[1]) - ast = mac.fn(unpack(ast:slice(2))) - end - return ast -end - -function eval_ast(ast, env) - if types._symbol_Q(ast) then - return env:get(ast) - elseif types._list_Q(ast) then - return List:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._vector_Q(ast) then - return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) - elseif types._hash_map_Q(ast) then - local new_hm = {} - for k,v in pairs(ast) do - new_hm[EVAL(k, env)] = EVAL(v, env) - end - return HashMap:new(new_hm) - else - return ast - end -end - -function EVAL(ast, env) - while true do - --print("EVAL: "..printer._pr_str(ast,true)) - if not types._list_Q(ast) then return eval_ast(ast, env) end - - -- apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast) then return ast end - - local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] - local a0sym = types._symbol_Q(a0) and a0.val or "" - if 'def!' == a0sym then - return env:set(a1, EVAL(a2, env)) - elseif 'let*' == a0sym then - local let_env = Env:new(env) - for i = 1,#a1,2 do - let_env:set(a1[i], EVAL(a1[i+1], let_env)) - end - env = let_env - ast = a2 -- TCO - elseif 'quote' == a0sym then - return a1 - elseif 'quasiquote' == a0sym then - ast = quasiquote(a1) -- TCO - elseif 'defmacro!' == a0sym then - local mac = EVAL(a2, env) - mac.ismacro = true - return env:set(a1, mac) - elseif 'macroexpand' == a0sym then - return macroexpand(a1, env) - elseif 'try*' == a0sym then - local exc, result = nil, nil - xpcall(function() - result = EVAL(a1, env) - end, function(err) - exc = err - end) - if exc ~= nil then - if types._malexception_Q(exc) then - exc = exc.val - end - if a2 and a2[1].val == 'catch*' then - result = EVAL(a2[3], Env:new(env, {a2[2]}, {exc})) - else - types.throw(exc) - end - end - return result - elseif 'do' == a0sym then - local el = eval_ast(ast:slice(2,#ast-1), env) - ast = ast[#ast] -- TCO - elseif 'if' == a0sym then - local cond = EVAL(a1, env) - if cond == types.Nil or cond == false then - if a3 then ast = a3 else return types.Nil end -- TCO - else - ast = a2 -- TCO - end - elseif 'fn*' == a0sym then - return types.MalFunc:new(function(...) - return EVAL(a2, Env:new(env, a1, arg)) - end, a2, env, a1) - else - local args = eval_ast(ast, env) - local f = table.remove(args, 1) - if types._malfunc_Q(f) then - ast = f.ast - env = Env:new(f.env, f.params, args) -- TCO - else - return f(unpack(args)) - end - end - end -end - --- print -function PRINT(exp) - return printer._pr_str(exp, true) -end - --- repl -local repl_env = Env:new() -function rep(str) - return PRINT(EVAL(READ(str),repl_env)) -end - --- core.lua: defined using Lua -for k,v in pairs(core.ns) do - repl_env:set(types.Symbol:new(k), v) -end -repl_env:set(types.Symbol:new('eval'), - function(ast) return EVAL(ast, repl_env) end) -repl_env:set(types.Symbol:new('*ARGV*'), types.List:new(types.slice(arg,2))) - --- core.mal: defined using mal -rep("(def! *host-language* \"lua\")") -rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -function print_exception(exc) - if exc then - if types._malexception_Q(exc) then - exc = printer._pr_str(exc.val, true) - end - print("Error: " .. exc) - print(debug.traceback()) - end -end - -if #arg > 0 and arg[1] == "--raw" then - readline.raw = true - table.remove(arg,1) -end - -if #arg > 0 then - xpcall(function() rep("(load-file \""..arg[1].."\")") end, - print_exception) - os.exit(0) -end - -rep("(println (str \"Mal [\" *host-language* \"]\"))") -while true do - line = readline.readline("user> ") - if not line then break end - xpcall(function() print(rep(line)) end, - print_exception) -end diff --git a/lua/types.lua b/lua/types.lua deleted file mode 100644 index 23a003bec6..0000000000 --- a/lua/types.lua +++ /dev/null @@ -1,193 +0,0 @@ -local utils = require('utils') - -local M = {} - --- type functions - -function M._sequential_Q(obj) - return M._list_Q(obj) or M._vector_Q(obj) -end - -function M._equal_Q(a,b) - if M._symbol_Q(a) and M._symbol_Q(b) then - return a.val == b.val - elseif M._sequential_Q(a) and M._sequential_Q(b) then - if #a ~= #b then return false end - for i, v in ipairs(a) do - if not M._equal_Q(v,b[i]) then return false end - end - return true - else - return a == b - end -end - -function M.copy(obj) - if type(obj) ~= "table" then return obj end - - -- copy object data - local new_obj = {} - for k,v in pairs(obj) do - new_obj[k] = v - end - - -- copy metatable and link to original - local old_mt = getmetatable(obj) - if old_mt ~= nil then - local new_mt = {} - for k,v in pairs(old_mt) do - new_mt[k] = v - end - setmetatable(new_mt, old_mt) - setmetatable(new_obj, new_mt) - end - - return new_obj -end - -function M.slice(lst, start, last) - if last == nil then last = #lst end - local new_lst = {} - if start <= last then - for i = start, last do - new_lst[#new_lst+1] = lst[i] - end - end - return new_lst -end - --- Error/exceptions - -M.MalException = {} -function M.MalException:new(val) - local newObj = {val = val} - self.__index = self - return setmetatable(newObj, self) -end -function M._malexception_Q(obj) - return utils.instanceOf(obj, M.MalException) -end - -function M.throw(val) - error(M.MalException:new(val)) -end - --- Nil - -local NilType = {} -function NilType:new(val) - local newObj = {} - self.__index = self - return setmetatable(newObj, self) -end -M.Nil = NilType:new() -function M._nil_Q(obj) - return obj == Nil -end - --- Strings -function M._string_Q(obj) - return type(obj) == "string" -end - --- Symbols - -M.Symbol = {} -function M.Symbol:new(val) - local newObj = {val = val} - self.__index = self - return setmetatable(newObj, self) -end -function M._symbol_Q(obj) - return utils.instanceOf(obj, M.Symbol) -end - --- Keywords -function M._keyword_Q(obj) - return M._string_Q(obj) and "\177" == string.sub(obj,1,1) -end - - --- Lists - -M.List = {} -function M.List:new(lst) - local newObj = lst and lst or {} - self.__index = self - return setmetatable(newObj, self) -end -function M._list_Q(obj) - return utils.instanceOf(obj, M.List) -end -function M.List:slice(start,last) - return M.List:new(M.slice(self,start,last)) -end - --- Vectors - -M.Vector = {} -function M.Vector:new(lst) - local newObj = lst and lst or {} - self.__index = self - return setmetatable(newObj, self) -end -function M._vector_Q(obj) - return utils.instanceOf(obj, M.Vector) -end -function M.Vector:slice(start,last) - return M.Vector:new(M.slice(self,start,last)) -end - --- Hash Maps --- -M.HashMap = {} -function M.HashMap:new(val) - local newObj = val and val or {} - self.__index = self - return setmetatable(newObj, self) -end -function M.hash_map(...) - return M._assoc_BANG(M.HashMap:new(), unpack(arg)) -end -function M._hash_map_Q(obj) - return utils.instanceOf(obj, M.HashMap) -end -function M._assoc_BANG(hm, ...) - for i = 1, #arg, 2 do - hm[arg[i]] = arg[i+1] - end - return hm -end -function M._dissoc_BANG(hm, ...) - for i = 1, #arg do - hm[arg[i]] = nil - end - return hm -end - --- Functions - -M.MalFunc = {} -function M.MalFunc:new(fn, ast, env, params) - local newObj = {fn = fn, ast = ast, env = env, - params = params, ismacro = false} - self.__index = self - return setmetatable(newObj, self) -end -function M._malfunc_Q(obj) - return utils.instanceOf(obj, M.MalFunc) -end - --- Atoms - -M.Atom = {} -function M.Atom:new(val) - local newObj = {val = val} - self.__index = self - return setmetatable(newObj, self) -end -function M._atom_Q(obj) - return utils.instanceOf(obj, M.Atom) -end - -return M diff --git a/make/Makefile b/make/Makefile deleted file mode 100644 index 70dea08b9f..0000000000 --- a/make/Makefile +++ /dev/null @@ -1,28 +0,0 @@ - -TESTS = tests/types.mk tests/reader.mk tests/stepA_mal.mk - -SOURCES_BASE = util.mk numbers.mk readline.mk gmsl.mk types.mk \ - reader.mk printer.mk -SOURCES_LISP = env.mk core.mk stepA_mal.mk -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -mal.mk: $(SOURCES) - echo "#!/usr/bin/make -f" > $@ - cat $+ | grep -v "^include " >> $@ - chmod +x $@ - -clean: - rm -f mal.mk - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - make -f $@ || exit 1; \ diff --git a/make/core.mk b/make/core.mk deleted file mode 100644 index c2cef59646..0000000000 --- a/make/core.mk +++ /dev/null @@ -1,278 +0,0 @@ -# -# mal (Make a Lisp) Core functions -# - -ifndef __mal_core_included -__mal_core_included := true - -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)util.mk -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk - - -# Errors/Exceptions -throw = $(eval __ERROR := $(1)) - - -# General functions - -# Return the type of the object (or "make" if it's not a object -obj_type = $(call _string,$(call _obj_type,$(1))) - -equal? = $(if $(call _equal?,$(word 1,$(1)),$(word 2,$(1))),$(__true),$(__false)) - - -# Scalar functions -nil? = $(if $(call _nil?,$(1)),$(__true),$(__false)) -true? = $(if $(call _true?,$(1)),$(__true),$(__false)) -false? = $(if $(call _false?,$(1)),$(__true),$(__false)) - - -# Symbol functions -symbol = $(call _symbol,$(call str_decode,$($(1)_value))) -symbol? = $(if $(call _symbol?,$(1)),$(__true),$(__false)) - -# Keyword functions -keyword = $(call _keyword,$(call str_decode,$($(1)_value))) -keyword? = $(if $(call _keyword?,$(1)),$(__true),$(__false)) - - -# Number functions -number? = $(if $(call _number?,$(1)),$(__true),$(__false)) - -number_lt = $(if $(call int_lt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_lte = $(if $(call int_lte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_gt = $(if $(call int_gt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_gte = $(if $(call int_gte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) - -number_plus = $(call _pnumber,$(call int_add_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_subtract = $(call _pnumber,$(call int_sub_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_multiply = $(call _pnumber,$(call int_mult_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_divide = $(call _pnumber,$(call int_div_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) - -time_ms = $(call _number,$(shell echo $$(date +%s%3N))) - -# String functions - -string? = $(if $(call _string?,$(1)),$(__true),$(__false)) - -pr_str = $(call _string,$(call _pr_str_mult,$(1),yes, )) -str = $(call _string,$(call _pr_str_mult,$(1),,)) -prn = $(info $(call _pr_str_mult,$(1),yes, )) -println = $(info $(subst \n,$(NEWLINE),$(call _pr_str_mult,$(1),, ))) - -readline= $(foreach res,$(call _string,$(call READLINE,"$(call str_decode,$($(1)_value))")),$(if $(READLINE_EOF),$(eval READLINE_EOF :=)$(__nil),$(res))) -read_str= $(call READ_STR,$(1)) -slurp = $(call _string,$(call _read_file,$(call str_decode,$($(1)_value)))) - -subs = $(strip \ - $(foreach start,$(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),\ - $(foreach end,$(if $(3),$(call int_decode,$($(3)_value)),$(words $($(word 1,$(1))_value))),\ - $(call _string,$(wordlist $(start),$(end),$($(word 1,$(1))_value)))))) - - - -# Function functions -function? = $(if $(call _function?,$(1)),$(__true),$(__false)) - - -# List functions -list? = $(if $(call _list?,$(1)),$(__true),$(__false)) - - -# Vector functions -vector? = $(if $(call _vector?,$(1)),$(__true),$(__false)) - - -# Hash map (associative array) functions -hash_map? = $(if $(call _hash_map?,$(1)),$(__true),$(__false)) - -# set a key/value in a copy of the hash map -assoc = $(word 1,\ - $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ - $(hm) \ - $(call _assoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) - -# unset keys in a copy of the hash map -# TODO: this could be made more efficient by copying only the -# keys that not being removed. -dissoc = $(word 1,\ - $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ - $(hm) \ - $(call _dissoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) - -keys = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(word 4,$(subst _, ,$(v))),$(if $(filter $(__keyword)%,$(vval)),$(call _keyword,$(patsubst $(__keyword)%,%,$(vval))),$(call _string,$(vval))))))) - -vals = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$($(v))))) - -# Hash map and vector functions - -# retrieve the value of a string key object from the hash map, or -# retrive a vector by number object index -get = $(strip \ - $(if $(call _nil?,$(word 1,$(1))),\ - $(__nil),\ - $(if $(call _hash_map?,$(word 1,$(1))),\ - $(call _get,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),\ - $(call _get,$(word 1,$(1)),$(call int_decode,$($(word 2,$(1))_value)))))) - -contains? = $(if $(call _contains?,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),$(__true),$(__false)) - - -# sequence operations - -sequential? = $(if $(call _sequential?,$(1)),$(__true),$(__false)) - -cons = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(word 1,$(1)) $(call __get_obj_values,$(word 2,$(1))))))) - -concat = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(foreach lst,$1,$(call __get_obj_values,$(lst))))))) - -nth = $(strip \ - $(if $(call int_lt,$($(word 2,$(1))_value),$(call int_encode,$(call _count,$(word 1,$(1))))),\ - $(word $(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)),\ - $(call _error,nth: index out of range))) - -sfirst = $(word 1,$($(1)_value)) - -slast = $(word $(words $($(1)_value)),$($(1)_value)) - -empty? = $(if $(call _EQ,0,$(if $(call _hash_map?,$(1)),$($(1)_size),$(words $($(1)_value)))),$(__true),$(__false)) - -count = $(call _number,$(call _count,$(1))) - -conj = $(word 1,$(foreach new_list,$(call __new_obj_like,$(word 1,$(1))),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value))) \ - $(if $(call _list?,$(new_list)),\ - $(foreach elem,$(wordlist 2,$(words $(1)),$(1)),\ - $(eval $(new_list)_value := $(strip $(elem) $($(new_list)_value)))),\ - $(eval $(new_list)_value := $(strip $($(new_list)_value) $(wordlist 2,$(words $(1)),$(1))))))) - -# Creates a new vector/list of the everything after but the first -# element -srest = $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(wordlist 2,$(words $($(1)_value)),$($(1)_value))))) - -# Takes a space separated arguments and invokes the first argument -# (function object) using the remaining arguments. -sapply = $(call $(word 1,$(1))_value,\ - $(strip \ - $(wordlist 2,$(call int_sub,$(words $(1)),1),$(1)) \ - $($(word $(words $(1)),$(1))_value))) - -# Map a function object over a list object -smap = $(strip\ - $(foreach func,$(word 1,$(1)),\ - $(foreach lst,$(word 2,$(1)),\ - $(foreach type,$(word 2,$(subst _, ,$(lst))),\ - $(foreach new_hcode,$(call __new_obj_hash_code),\ - $(foreach sz,$(words $(call __get_obj_values,$(lst))),\ - $(eval $(__obj_magic)_$(type)_$(new_hcode)_value := $(strip \ - $(foreach val,$(call __get_obj_values,$(lst)),\ - $(call $(func)_value,$(val))))))\ - $(__obj_magic)_$(type)_$(new_hcode)))))) - - -# Metadata functions - -with_meta = $(strip \ - $(foreach new_obj,$(call _clone_obj,$(word 1,$(1))),\ - $(eval $(new_obj)_meta := $(strip $(word 2,$(1))))\ - $(new_obj))) - -meta = $(strip $($(1)_meta)) - - -# Atom functions - -atom = $(strip \ - $(foreach hcode,$(call __new_obj_hash_code),\ - $(foreach new_atom,$(__obj_magic)_atom_$(hcode),\ - $(new_atom)\ - $(eval $(new_atom)_value := $(1))))) -atom? = $(if $(call _atom?,$(1)),$(__true),$(__false)) - -deref = $($(1)_value) - -reset! = $(eval $(word 1,$(1))_value := $(word 2,$(1)))$(word 2,$(1)) - -swap! = $(foreach resp,$(call $(word 2,$(1))_value,$($(word 1,$(1))_value) $(wordlist 3,$(words $(1)),$(1))),\ - $(eval $(word 1,$(1))_value := $(resp))\ - $(resp)) - - - - -# Namespace of core functions - -core_ns = type obj_type \ - = equal? \ - throw throw \ - nil? nil? \ - true? true? \ - false? false? \ - symbol symbol \ - symbol? symbol? \ - keyword keyword \ - keyword? keyword? \ - function? function? \ - string? string? \ - \ - pr-str pr_str \ - str str \ - prn prn \ - println println \ - readline readline \ - read-string read_str \ - slurp slurp \ - subs subs \ - number? number? \ - < number_lt \ - <= number_lte \ - > number_gt \ - >= number_gte \ - + number_plus \ - - number_subtract \ - * number_multiply \ - / number_divide \ - time-ms time_ms \ - \ - list _list \ - list? list? \ - vector _vector \ - vector? vector? \ - hash-map _hash_map \ - map? hash_map? \ - assoc assoc \ - dissoc dissoc \ - get get \ - contains? contains? \ - keys keys \ - vals vals \ - \ - sequential? sequential? \ - cons cons \ - concat concat \ - nth nth \ - first sfirst \ - rest srest \ - last slast \ - empty? empty? \ - count count \ - conj conj \ - apply sapply \ - map smap \ - \ - with-meta with_meta \ - meta meta \ - atom atom \ - atom? atom? \ - deref deref \ - reset! reset! \ - swap! swap! - -endif diff --git a/make/env.mk b/make/env.mk deleted file mode 100644 index d508283e9e..0000000000 --- a/make/env.mk +++ /dev/null @@ -1,50 +0,0 @@ -# -# mal (Make Lisp) Object Types and Functions -# - -ifndef __mal_env_included -__mal_env_included := true - -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk - -# -# ENV -# - -# An ENV environment is a hash-map with an __outer__ reference to an -# outer environment -define BIND_ARGS -$(strip \ - $(word 1,$(1) \ - $(foreach fparam,$(call _nth,$(2),0),\ - $(if $(call _EQ,&,$($(fparam)_value)), - $(call ENV_SET,$(1),$($(call _nth,$(2),1)_value),$(strip \ - $(foreach new_list,$(call _list), - $(word 1,$(new_list) \ - $(foreach val,$(3),$(call _conj!,$(new_list),$(val))))))),\ - $(foreach val,$(word 1,$(3)),\ - $(call ENV_SET,$(1),$($(fparam)_value),$(val))\ - $(foreach left,$(call srest,$(2)),\ - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call BIND_ARGS,$(1),$(left),$(wordlist 2,$(words $(3)),$(3)))))))))) -endef - -# Create a new ENV and optional bind values in it -# $(1): outer environment (set as a key named __outer__) -# $(2): list/vector object of bind forms -# $(3): space separated list of expressions to bind -ENV = $(strip $(foreach new_env,$(call _assoc!,$(call _hash_map),__outer__,$(if $(1),$(1),$(__nil))),$(if $(2),$(call BIND_ARGS,$(new_env),$(2),$(3)),$(new_env)))) -ENV_FIND = $(strip \ - $(if $(call _contains?,$(1),$(subst =,$(__equal),$(2))),\ - $(1),\ - $(if $(call _EQ,$(__nil),$(call _get,$(1),__outer__)),\ - ,\ - $(call ENV_FIND,$(call _get,$(1),__outer__),$(2))))) - -ENV_GET = $(foreach env,|$(call ENV_FIND,$(1),$(2))|,$(if $(call _EQ,||,$(env)),$(call _error,'$(2)' not found),$(call _get,$(strip $(subst |,,$(env))),$(subst =,$(__equal),$(2))))) - -ENV_SET = $(if $(call _assoc!,$(1),$(subst =,$(__equal),$(2)),$(3)),$(1),) - -endif diff --git a/make/numbers.mk b/make/numbers.mk deleted file mode 100644 index b0fa29a312..0000000000 --- a/make/numbers.mk +++ /dev/null @@ -1,409 +0,0 @@ -# -# mal (Make a Lisp) number types -# - -ifndef __mal_numbers_included -__mal_numbers_included := true - -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)util.mk - -LIST20_X := x x x x x x x x x x x x x x x x x x x x -LIST100_X := $(foreach x,$(LIST20_X),X X X X X) -LIST100_0 := $(foreach x,$(LIST20_X),0 0 0 0 0) -LIST100_9 := $(foreach x,$(LIST20_X),9 9 9 9 9) - -### -### general numeric utility functions -### - -int_encode = $(strip $(call _reverse,\ - $(eval __temp := $(1))\ - $(foreach a,0 1 2 3 4 5 6 7 8 9,\ - $(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp))) - -int_decode = $(strip $(call _join,$(call _reverse,$(1)))) - -# trim extaneous zero digits off the end (front of number) -_trim_zeros = $(if $(call _EQ,0,$(strip $(1))),0,$(if $(call _EQ,0,$(word 1,$(1))),$(call _trim_zeros,$(wordlist 2,$(words $(1)),$(1))),$(1))) -trim_zeros = $(strip $(if $(call _EQ,0,$(strip $(1))),$(1),$(call _reverse,$(call _trim_zeros,$(call _reverse,$(1)))))) - -# drop the last element of a list of words/digits -drop_last = $(call _reverse,$(wordlist 2,$(words $(1)),$(call _reverse,$(1)))) - -### utility function tests - -#$(info $(filter-out 1,$(filter 1%,1 132 456))) -#$(info (int_encode 13): [$(call int_encode,13)]) -#$(info (int_encode 156463): [$(call int_encode,156463)]) -#$(info (int_decode (int_encode 156463)): [$(call int_decode,$(call int_encode,156463))]) - -#$(info trim_zeros(0 0 0): [$(call trim_zeros,0 0 0)]) - - -### -### comparisons -### - -# compare two digits and return 'true' if digit 1 is less than or -# equal to digit 2 -_lte_digit = $(strip \ - $(if $(call _EQ,$(1),$(2)),\ - true,\ - $(if $(call _EQ,0,$(1)),\ - true,\ - $(if $(wordlist $(1),$(2),$(LIST20_X)),\ - true,\ - )))) - -# compare two lists of digits (MSB->LSB) of equal length and return -# 'true' if number 1 is less than number 2 -_lte_digits = $(strip \ - $(if $(strip $(1)),\ - $(if $(call _EQ,$(word 1,$(1)),$(word 1,$(2))),\ - $(call _lte_digits,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),\ - $(if $(call _lte_digit,$(word 1,$(1)),$(word 1,$(2))),true,)),\ - true)) - -### lte/less than or equal to - -int_lte_encoded = $(strip \ - $(foreach len1,$(words $(1)),$(foreach len2,$(words $(2)),\ - $(if $(call _EQ,$(len1),$(len2)),\ - $(call _lte_digits,$(call _reverse,$(1)),$(call _reverse,$(2))),\ - $(if $(wordlist $(len1),$(len2),$(LIST100_X)),\ - true,\ - ))))) - -int_lte = $(call int_lte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) - -### lt/less than - -int_lt_encoded = $(strip \ - $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ - ,\ - $(call int_lte_encoded,$(1),$(2)))) - -int_lt = $(call int_lt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) - -### gte/greater than or equal to - -int_gte_encoded = $(strip \ - $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ - true,\ - $(if $(call int_lte_encoded,$(1),$(2)),,true))) - -int_gte = $(call int_gte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) - -### gt/greater than - -int_gt_encoded = $(strip \ - $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ - ,\ - $(call int_gte_encoded,$(1),$(2)))) - -int_gt = $(call int_gt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) - -#$(info _lte_digit,7,8: [$(call _lte_digit,7,8)]) -#$(info _lte_digit,8,8: [$(call _lte_digit,8,8)]) -#$(info _lte_digit,2,1: [$(call _lte_digit,2,1)]) -#$(info _lte_digit,0,0: [$(call _lte_digit,0,0)]) -#$(info _lte_digit,0,1: [$(call _lte_digit,0,1)]) -#$(info _lte_digit,1,0: [$(call _lte_digit,1,0)]) - -#$(info _lte_digits,1 2 3,1 2 4: [$(call _lte_digits,1 2 3,1 2 4)]) -#$(info _lte_digits,1 2 4,1 2 4: [$(call _lte_digits,1 2 4,1 2 4)]) -#$(info _lte_digits,1 2 5,1 2 4: [$(call _lte_digits,1 2 5,1 2 4)]) -#$(info _lte_digits,4 1,9 0: [$(call _lte_digits,4 1,9 0)]) - -#$(info int_lte_encoded,1,1: [$(call int_lte_encoded,1,1)]) -#$(info int_lte_encoded,1,2: [$(call int_lte_encoded,1,2)]) -#$(info int_lte_encoded,2,1: [$(call int_lte_encoded,2,1)]) -#$(info int_lte_encoded,0,3: [$(call int_lte_encoded,0,3)]) -#$(info int_lte_encoded,3,0: [$(call int_lte_encoded,3,0)]) -#$(info int_lte_encoded,1 4,0 9: [$(call int_lte_encoded,1 4,0 9)]) -#$(info int_lte_encoded,4 3 2 1,4 3 2 1: [$(call int_lte_encoded,4 3 2 1,4 3 2 1)]) -#$(info int_lte_encoded,5 3 2 1,4 3 2 1: [$(call int_lte_encoded,5 3 2 1,4 3 2 1)]) -#$(info int_lte_encoded,4 3 2 1,5 3 2 1: [$(call int_lte_encoded,4 3 2 1,5 3 2 1)]) - -#$(info int_lte,1,1: [$(call int_lte,1,1)]) -#$(info int_lte,1,2: [$(call int_lte,1,2)]) -#$(info int_lte,2,1: [$(call int_lte,2,1)]) -#$(info int_lte,0,3: [$(call int_lte,0,3)]) -#$(info int_lte,3,0: [$(call int_lte,3,0)]) -#$(info int_lte,1234,1234: [$(call int_lte,1234,1234)]) -#$(info int_lte,1235,1234: [$(call int_lte,1235,1234)]) -#$(info int_lte,1234,1235: [$(call int_lte,1234,1235)]) -# -#$(info int_lt,1,1: [$(call int_lt,1,1)]) -#$(info int_lt,1,2: [$(call int_lt,1,2)]) -#$(info int_lt,2,1: [$(call int_lt,2,1)]) -#$(info int_lt,0,3: [$(call int_lt,0,3)]) -#$(info int_lt,3,0: [$(call int_lt,3,0)]) -#$(info int_lt,1234,1234: [$(call int_lt,1234,1234)]) -#$(info int_lt,1235,1234: [$(call int_lt,1235,1234)]) -#$(info int_lt,1234,1235: [$(call int_lt,1234,1235)]) -# -#$(info int_gte,1,1: [$(call int_gte,1,1)]) -#$(info int_gte,1,2: [$(call int_gte,1,2)]) -#$(info int_gte,2,1: [$(call int_gte,2,1)]) -#$(info int_gte,0,3: [$(call int_gte,0,3)]) -#$(info int_gte,3,0: [$(call int_gte,3,0)]) -#$(info int_gte,1234,1234: [$(call int_gte,1234,1234)]) -#$(info int_gte,1235,1234: [$(call int_gte,1235,1234)]) -#$(info int_gte,1234,1235: [$(call int_gte,1234,1235)]) -# -#$(info int_gt,1,1: [$(call int_gt,1,1)]) -#$(info int_gt,1,2: [$(call int_gt,1,2)]) -#$(info int_gt,2,1: [$(call int_gt,2,1)]) -#$(info int_gt,0,3: [$(call int_gt,0,3)]) -#$(info int_gt,3,0: [$(call int_gt,3,0)]) -#$(info int_gt,1234,1234: [$(call int_gt,1234,1234)]) -#$(info int_gt,1235,1234: [$(call int_gt,1235,1234)]) -#$(info int_gt,1234,1235: [$(call int_gt,1234,1235)]) - - -### -### addition -### - - -# add_digits_with_carry -_add_digit = $(words $(if $(strip $(1)),$(wordlist 1,$(1),$(LIST20_X)),) \ - $(if $(strip $(2)),$(wordlist 1,$(2),$(LIST20_X)),)) - -# add one to a single digit -_inc_digit = $(words $(wordlist 1,$(if $(1),$(1),0),$(LIST20_X)) x) - -# add two encoded numbers digit by digit without resolving carries -# (each digit will be larger than 9 if there is a carry value) -_add = $(if $(1)$(2),$(call _add_digit,$(word 1,$(1)),$(word 1,$(2))) $(call _add,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),) - -# take the result of _add and resolve the carry values digit by digit -_resolve_carries = $(strip \ - $(if $(1),\ - $(foreach num,$(word 1,$(1)),\ - $(if $(filter-out 1,$(filter 1%,$(num))),\ - $(call _resolve_carries,$(call _inc_digit,$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1)),$(2) $(patsubst 1%,%,$(num))),\ - $(call _resolve_carries,$(wordlist 2,$(words $(1)),$(1)),$(2) $(num)))),\ - $(2))) - -# add two encoded numbers, returns encoded number -int_add_encoded = $(call _resolve_carries,$(call _add,$(1),$(2))) - -# add two unencoded numbers, returns unencoded number -int_add = $(call int_decode,$(call int_add_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) - -### addition tests - -#$(info _add_digit(7,6,1): [$(call _add_digit,7,6,1)]) -#$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)]) -#$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)]) -#$(info _carries(12 14 15): [$(call _carries,12 14 15)]) -#$(info _inc_digit(0): $(call _inc_digit,0)) -#$(info _inc_digit(1): $(call _inc_digit,1)) -#$(info _inc_digit(9): $(call _inc_digit,9)) -#$(info _inc_digit(18): $(call _inc_digit,18)) -#$(info int_add_encoded(0,0): [$(call int_add_encoded,0,0)]) - -#$(info int_add(1,2): [$(call int_add,1,2)]) -#$(info int_add(9,9): [$(call int_add,9,9)]) -#$(info int_add(0,9): [$(call int_add,0,9)]) -#$(info int_add(9,0): [$(call int_add,9,0)]) -#$(info int_add(0,0): [$(call int_add,0,0)]) -#$(info int_add(123,456): [$(call int_add,123,456)]) -#$(info int_add(678,789): [$(call int_add,678,789)]) -#$(info int_add(1,12): [$(call int_add,1,12)]) -#$(info int_add(123,5): [$(call int_add,123,5)]) -#$(info int_add(123456,9): [$(call int_add,123456,9)]) -#$(info int_add(999999991,9): [$(call int_add,999999991,9)]) - -### -### subtraction -### - -_get_zeros = $(if $(call _EQ,0,$(word 1,$(1))),$(call _get_zeros,$(wordlist 2,$(words $(1)),$(1)),$(2) 0),$(2)) - -# return a 9's complement of a single digit -_complement9 = $(strip \ - $(if $(call _EQ,0,$(1)),9,\ - $(if $(call _EQ,1,$(1)),8,\ - $(if $(call _EQ,2,$(1)),7,\ - $(if $(call _EQ,3,$(1)),6,\ - $(if $(call _EQ,4,$(1)),5,\ - $(if $(call _EQ,5,$(1)),4,\ - $(if $(call _EQ,6,$(1)),3,\ - $(if $(call _EQ,7,$(1)),2,\ - $(if $(call _EQ,8,$(1)),1,\ - $(if $(call _EQ,9,$(1)),0))))))))))) - -# return a 10's complement of a single digit -_complement10 = $(call _inc_digit,$(call _complement9,$(1))) - -# -_complement_rest = $(if $(strip $(1)),\ - $(strip \ - $(call _complement10,$(word 1,$(1))) \ - $(foreach digit,$(wordlist 2,$(words $(1)),$(1)),\ - $(call _complement9,$(digit)))),) - -# return the complement of a number -_complement = $(strip $(call _get_zeros,$(1)) \ - $(call _complement_rest,$(wordlist $(call _inc_digit,$(words $(call _get_zeros,$(1)))),$(words $(1)),$(1)))) - -# subtracted encoded number 2 from encoded number 1 and return and -# encoded number result -int_sub_encoded = $(strip \ - $(if $(call _EQ,0,$(strip $(2))),\ - $(1),\ - $(call trim_zeros,\ - $(call drop_last,\ - $(call int_add_encoded,\ - $(1),\ - $(wordlist 1,$(words $(1)),$(call _complement,$(2)) $(LIST100_9))))))) - -# subtract unencoded number 2 from unencoded number 1 and return -# unencoded result -int_sub = $(call int_decode,$(call int_sub_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) - -### subtraction tests - -#$(info _get_zeros(5 7): [$(call _get_zeros,5 7)]) -#$(info _get_zeros(0 0 0 2): [$(call _get_zeros,0 0 0 2)]) -#$(info _get_zeros(0 0 0 2 5): [$(call _get_zeros,0 0 0 2 5)]) - -#$(info _complement(0): [$(call _complement,0)]) -#$(info _complement(1): [$(call _complement,1)]) -#$(info _complement(9): [$(call _complement,9)]) -#$(info _complement(5 7): [$(call _complement,5 7)]) -#$(info _complement(0 0 0 2): [$(call _complement,0 0 0 2)]) -#$(info _complement(0 0 0 5 4 3 2 1): [$(call _complement,0 0 0 5 4 3 2 1)]) - -#$(info int_sub_encoded(0 0 1, 3 1): [$(call int_sub_encoded,0 0 1,3 1)]) -#$(info int_sub_encoded(2, 2): [$(call int_sub_encoded,2,2)]) - -#$(info int_sub(2,1): [$(call int_sub,2,1)]) -#$(info int_sub(2,0): [$(call int_sub,2,0)]) -#$(info int_sub(2,2): [$(call int_sub,2,2)]) -#$(info int_sub(100,13): [$(call int_sub,100,13)]) -#$(info int_sub(100,99): [$(call int_sub,100,99)]) -#$(info int_sub(91,19): [$(call int_sub,91,19)]) - - -### -### multiplication -### - -# multiply two digits -#_mult_digit = $(words $(foreach x,$(1),$(2))) -_mult_digit = $(strip \ - $(words $(foreach x,$(wordlist 1,$(1),$(LIST20_X)),\ - $(wordlist 1,$(2),$(LIST20_X))))) - -# multipy every digit of number 1 with number 2 -# params: digits, digit, indent_zeros, results -_mult_row = $(if $(strip $(1)),$(call _mult_row,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)0,$(4) $(call _mult_digit,$(word 1,$(1)),$(2))$(3)),$(4)) - -# multiply every digit of number 2 with every digit of number 1 adding -# correct zero padding to the end of each result -# params: digits, digits, indent_zeros, results -_mult_each = $(if $(strip $(2)),$(call _mult_each,$(1),$(wordlist 2,$(words $(2)),$(2)),$(3)0,$(4) $(call _mult_row,$(1),$(word 1,$(2)),$(3))),$(4)) - -# add up a bunch of unencoded numbers. Basically reduce into the first number -_add_many = $(if $(word 2,$(1)),$(call _add_many,$(call int_add,$(word 1,$(1)),$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1))),$(1)) - -# multiply two encoded numbers, returns encoded number -int_mult_encoded = $(call trim_zeros,$(call int_encode,$(call _add_many,$(call _mult_each,$(1),$(2))))) - -# multiply two unencoded numbers, returns unencoded number -int_mult = $(call int_decode,$(call int_mult_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) - -#$(info _mult_digit(8,6): [$(call _mult_digit,8,6)]) -#$(info _mult_digit(7,6): [$(call _mult_digit,7,6)]) -#$(info _mult_row(8,6): [$(call _mult_row,8,6)]) -#$(info _mult_row(8 7,6): [$(call _mult_row,8 7,6)]) -#$(info _mult_row(8 7 3,6): [$(call _mult_row,8 7 3,6)]) -#$(info _mult_each(8 7 6, 4 3 2): [$(call _mult_each,8 7 6,4 3 2)]) -#$(info _add_many(123 234 345 456): [$(call _add_many,123 234 345 456)]) - -#$(info int_mult_encoded(8 7 3,6): [$(call int_mult_encoded,8 7 3,6)]) -#$(info int_mult_encoded(8 7 3,0): [$(call int_mult_encoded,8 7 3,0)]) - -#$(info int_mult(378,6): [$(call int_mult,378,6)]) -#$(info int_mult(678,234): [$(call int_mult,678,234)]) -#$(info int_mult(1,23456): [$(call int_mult,1,23456)]) -#$(info int_mult(0,23456): [$(call int_mult,0,23456)]) -#$(info int_mult(0,0): [$(call int_mult,0,0)]) - -### -### division -### - -# return list of zeros needed to pad number 2 to the same length as number 1 -_zero_pad = $(strip $(wordlist 1,$(call int_sub,$(words $(1)),$(words $(2))),$(LIST100_0))) - -# num1, num2, zero pad, result_accumulator -# algorithm: -# - B = pad with zeros to make same digit length as A -# - loop -# - if (B <= A) -# - A = subtract B from A -# - C = C + 10^(B pad.length) -# - else -# - if B.length < origin B.length: break -# - chop least significant digit of B -_div = $(strip \ - $(if $(call int_lte_encoded,$(3) $(2),$(1)),\ - $(call _div,$(call int_sub_encoded,$(1),$(3) $(2)),$(2),$(3),$(call int_add_encoded,$(4),$(3) 1)),\ - $(if $(3),\ - $(call _div,$(1),$(2),$(wordlist 2,$(words $(3)),$(3)),$(4)),\ - $(4)))) - -# divide two encoded numbers, returns encoded number -int_div_encoded = $(strip \ - $(if $(call _EQ,0,$(1)),\ - 0,\ - $(if $(call _EQ,$(1),$(2)),\ - 1,\ - $(if $(call int_gt_encoded,$(2),$(1)),\ - 0,\ - $(call _div,$(1),$(2),$(call _zero_pad,$(1),$(2)),0))))) - -# divide two unencoded numbers, returns unencoded number -int_div = $(call int_decode,$(call int_div_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) - -### division tests - -#$(info _zero_pad(1 2 3 4,1 3): [$(call _zero_pad,1 2 3 4,1 3)]) -#$(info _zero_pad(1 2,1 3): [$(call _zero_pad,1 2,1 3)]) -#$(info _zero_pad(2,1 3): [$(call _zero_pad,1 2,1 3)]) -# -#$(info int_div_encoded(2,1): [$(call int_div_encoded,2,1)]) -#$(info int_div_encoded(3,1): [$(call int_div_encoded,3,1)]) -#$(info int_div_encoded(3,2): [$(call int_div_encoded,3,2)]) -#$(info int_div_encoded(0,7): [$(call int_div_encoded,0,7)]) -#$(info int_div_encoded(0 3,0 2): [$(call int_div_encoded,0 3,0 2)]) -#$(info int_div_encoded(0 3,5): [$(call int_div_encoded,0 3,5)]) -# -#$(info int_div(5,1): [$(call int_div,5,1)]) -#$(info int_div(5,2): [$(call int_div,5,2)]) -#$(info int_div(123,7): [$(call int_div,123,7)]) -#$(info int_div(100,7): [$(call int_div,100,7)]) - - -### combination tests - -# (/ (- (+ 515 (* 222 311)) 300) 41) -#$(info int_mult,222,311: [$(call int_mult,222,311)]) -#$(info int_add(515,69042): [$(call int_add,515,69042)]) -#$(info int_sub(69557,300): [$(call int_sub,69557,300)]) -#$(info int_div(69257,41): [$(call int_div,69257,41)]) - -############################################################### - -all: - @true - -endif - -# vim: ts=2 et diff --git a/make/printer.mk b/make/printer.mk deleted file mode 100644 index 10b97893dc..0000000000 --- a/make/printer.mk +++ /dev/null @@ -1,47 +0,0 @@ -# -# mal (Make a Lisp) printer -# - -ifndef __mal_printer_included -__mal_printer_included := true - -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)util.mk -include $(_TOP_DIR)types.mk - -# return a printable form of the argument, the second parameter is -# 'print_readably' which backslashes quotes in string values -_pr_str = $(if $(1),$(foreach ot,$(call _obj_type,$(1)),$(if $(call _EQ,make,$(ot)),$(call _error,_pr_str failed on $(1)),$(call $(ot)_pr_str,$(1),$(2)))),) - -# Like _pr_str but takes multiple values in first argument, the second -# parameter is 'print_readably' which backslashes quotes in string -# values, the third parameter is the delimeter to use between each -# _pr_str'd value -_pr_str_mult = $(call _pr_str,$(word 1,$(1)),$(2))$(if $(word 2,$(1)),$(3)$(call _pr_str_mult,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)),) - - -# Type specific printing - -nil_pr_str = nil -true_pr_str = true -false_pr_str = false - -number_pr_str = $(call int_decode,$($(1)_value)) - -symbol_pr_str = $($(1)_value) - -keyword_pr_str = $(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))) - -string_pr_str = $(if $(filter $(__keyword)%,$(call str_decode,$($(1)_value))),$(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))),$(if $(2),"$(subst $(DQUOTE),$(ESC_DQUOTE),$(subst $(SLASH),$(SLASH)$(SLASH),$(call str_decode,$($(1)_value))))",$(call str_decode,$($(1)_value)))) - -function_pr_str = <$(if $(word 6,$(value $(1)_value)),$(wordlist 1,5,$(value $(1)_value))...,$(value $(1)_value))> - -list_pr_str = ($(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))) - -vector_pr_str = [$(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))] - -hash_map_pr_str = {$(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(foreach hcode,$(word 3,$(subst _, ,$(1))),$(patsubst $(1)_%,%,$(v:%_value=%))),$(if $(filter $(__keyword)%,$(vval)),$(patsubst $(__keyword)%,$(COLON)%,$(vval)),"$(vval)")) $(call _pr_str,$($(v)),$(2)))} - -atom_pr_str = (atom $(call _pr_str,$($(1)_value),$(2))) - -endif diff --git a/make/reader.mk b/make/reader.mk deleted file mode 100755 index 8571785879..0000000000 --- a/make/reader.mk +++ /dev/null @@ -1,184 +0,0 @@ -# -# mal (Make Lisp) Parser/Reader -# - -ifndef __mal_reader_included -__mal_reader_included := true - -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)util.mk -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)readline.mk - -READER_DEBUG ?= - -_TOKEN_DELIMS := $(SEMI) $(COMMA) $(DQUOTE) $(QQUOTE) $(_SP) $(_NL) $(_LC) $(_RC) $(_LP) $(_RP) $(LBRACKET) $(RBRACKET) - -define READ_NUMBER -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(_TOKEN_DELIMS),$(ch)),\ - ,\ - $(if $(filter-out $(NUMBERS),$(ch)),\ - $(call _error,Invalid number character '$(ch)'),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_NUMBER ch: $(ch) | $($(1))))\ - $(ch)$(strip $(call READ_NUMBER,$(1))))),\ - )) -endef - -define READ_STRING -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(and $(filter \,$(ch)),$(filter $(DQUOTE),$(word 2,$($(1))))),\ - $(eval $(1) := $(wordlist 3,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: \$(word 1,$($(1))) | $($(1))))\ - $(DQUOTE) $(strip $(call READ_STRING,$(1))),\ - $(if $(filter $(DQUOTE),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: $(ch) | $($(1))))\ - $(ch) $(strip $(call READ_STRING,$(1))))),)) -endef - -define READ_SYMBOL -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(_TOKEN_DELIMS),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_SYMBOL ch: $(ch) | $($(1))))\ - $(ch)$(strip $(call READ_SYMBOL,$(1)))),\ - )) -endef - -define READ_KEYWORD -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(_TOKEN_DELIMS),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_KEYWORD ch: $(ch) | $($(1))))\ - $(ch)$(strip $(call READ_KEYWORD,$(1)))),\ - )) -endef - -define READ_ATOM -$(foreach ch,$(word 1,$($(1))),\ - $(if $(filter $(NUMBERS),$(ch)),\ - $(call _number,$(call READ_NUMBER,$(1))),\ - $(if $(filter $(DQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call __string,$(strip $(call READ_STRING,$(1))))\ - $(eval $(if $(filter $(DQUOTE),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(DQUOTE)' in; $($(1))))),\ - $(if $(filter $(COLON),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _keyword,$(call READ_KEYWORD,$(1))),\ - $(foreach sym,$(call READ_SYMBOL,$(1)),\ - $(if $(call _EQ,nil,$(sym)),\ - $(__nil),\ - $(if $(call _EQ,true,$(sym)),\ - $(__true),\ - $(if $(call _EQ,false,$(sym)),\ - $(__false),\ - $(call _symbol,$(sym)))))))))) -endef - -# read and return tokens until $(2) found -define READ_UNTIL -$(and $(READER_DEBUG),$(info READ_UNTIL: $($(1)) [$(2) $(3)])) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(2),$(ch)),\ - ,\ - $(call READ_FORM,$(1))\ - $(call READ_UNTIL,$(1),$(2),$(3))),\ - $(call _error,Expected '$(3)'))) -endef - -define DROP_UNTIL -$(and $(READER_DEBUG),$(info DROP_UNTIL: $($(1)) [$(2)])) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(2),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call DROP_UNTIL,$(1),$(2),$(3))),\ - )) -endef - -define READ_SPACES -$(and $(READER_DEBUG),$(info READ_SPACES: $($(1)))) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(filter $(_SP) $(_NL) $(COMMA),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call READ_SPACES,$(1)),)) -endef - -define READ_FORM -$(and $(READER_DEBUG),$(info READ_FORM: $($(1)))) -$(call READ_SPACES,$(1)) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(filter $(SEMI),$(ch)),\ - $(call DROP_UNTIL,$(1),$(_NL)),\ - $(if $(filter $(SQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,quote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(QQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,quasiquote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(UNQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,unquote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(_SUQ),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,splice-unquote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(CARET),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(foreach meta,$(strip $(call READ_FORM,$(1))),\ - $(call _list,$(call _symbol,with-meta) $(strip $(call READ_FORM,$(1))) $(meta))),\ - $(if $(filter $(ATSIGN),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,deref) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(_RC),$(ch)),\ - $(call _error,Unexpected '$(RCURLY)'),\ - $(if $(filter $(_LC),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(foreach thm,$(call _hash_map),\ - $(call do,$(call _assoc_seq!,$(thm),$(strip $(call READ_UNTIL,$(1),$(_RC),$(RCURLY)))))\ - $(eval $(if $(filter $(_RC),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(RCURLY)')))\ - $(thm)),\ - $(if $(filter $(_RP),$(ch)),\ - $(call _error,Unexpected '$(RPAREN)'),\ - $(if $(filter $(_LP),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(foreach tlist,$(call _list),\ - $(eval $(foreach item,$(strip $(call READ_UNTIL,$(1),$(_RP),$(RPAREN))),\ - $(call do,$(call _conj!,$(tlist),$(item)))))\ - $(eval $(if $(filter $(_RP),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(RPAREN)')))\ - $(tlist)),\ - $(if $(filter $(RBRACKET),$(ch)),\ - $(call _error,Unexpected '$(RBRACKET)'),\ - $(if $(filter $(LBRACKET),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(foreach tvec,$(call _vector),\ - $(eval $(foreach item,$(strip $(call READ_UNTIL,$(1),$(RBRACKET),$(RBRACKET))),\ - $(call do,$(call _conj!,$(tvec),$(item)))))\ - $(eval $(if $(filter $(RBRACKET),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(RBRACKET)')))\ - $(tvec)),\ - $(call READ_ATOM,$(1)))))))))))))))) -$(call READ_SPACES,$(1)) -endef - -# read-str from a raw "string" or from a string object -READ_STR = $(strip $(eval __reader_temp := $(call str_encode,$(if $(call _string?,$(1)),$(call str_decode,$($(1)_value)),$(1))))$(call READ_FORM,__reader_temp)) - -endif diff --git a/make/readline.mk b/make/readline.mk deleted file mode 100644 index 1208f5c2a5..0000000000 --- a/make/readline.mk +++ /dev/null @@ -1,15 +0,0 @@ -# -# mal (Make Lisp) shell readline wrapper -# - -ifndef __mal_readline_included -__mal_readline_included := true - -# Call bash read/readline. Since each call is in a separate shell -# instance we need to restore and save after each call in order to -# have readline history. -READLINE_EOF := -READLINE_HISTORY_FILE := $${HOME}/.mal-history -READLINE = $(eval __readline_temp := $(shell history -r $(READLINE_HISTORY_FILE); read -u 0 -r -e -p $(if $(1),$(1),"user> ") line && history -s -- "$${line}" && history -a $(READLINE_HISTORY_FILE) && echo "$${line}" || echo "__||EOF||__"))$(if $(filter __||EOF||__,$(__readline_temp)),$(eval READLINE_EOF := yes),$(__readline_temp)) - -endif diff --git a/make/step0_repl.mk b/make/step0_repl.mk deleted file mode 100644 index b8b1309eaf..0000000000 --- a/make/step0_repl.mk +++ /dev/null @@ -1,26 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk - -SHELL := /bin/bash - -define READ -$(call READLINE) -endef - -define EVAL -$(if $(READLINE_EOF),,\ - $(if $(findstring =,$(1)),$(eval $(1))$($(word 1,$(1))),$(eval __return := $(1))$(__return))) -endef - -define PRINT -$(1) -endef - -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ))))) -REPL = $(info $(call REP))$(if $(READLINE_EOF),,$(call REPL)) - -# Call the read-eval-print loop -$(call REPL) diff --git a/make/step1_read_print.mk b/make/step1_read_print.mk deleted file mode 100644 index f695a7e174..0000000000 --- a/make/step1_read_print.mk +++ /dev/null @@ -1,32 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: just return the input -define EVAL -$(if $(READLINE_EOF)$(__ERROR),,$(1)) -endef - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: read, eval, print, loop -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) diff --git a/make/step2_eval.mk b/make/step2_eval.mk deleted file mode 100644 index 34b1dabb7f..0000000000 --- a/make/step2_eval.mk +++ /dev/null @@ -1,73 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(if $(call _contains?,$(2),$(key)),\ - $(call _get,$(2),$(key)),\ - $(call _error,'$(key)' not found in REPL_ENV ($(2))))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1))))\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(call _apply,$(call sfirst,$(el)),$(call srest,$(el))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(strip $(call EVAL_INVOKE,$(1),$(2))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call _hash_map) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -$(call do,$(call _assoc!,$(REPL_ENV),+,number_plus)) -$(call do,$(call _assoc!,$(REPL_ENV),-,number_subtract)) -$(call do,$(call _assoc!,$(REPL_ENV),*,number_multiply)) -$(call do,$(call _assoc!,$(REPL_ENV),/,number_divide)) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) diff --git a/make/step3_env.mk b/make/step3_env.mk deleted file mode 100644 index ddcb70fe58..0000000000 --- a/make/step3_env.mk +++ /dev/null @@ -1,96 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(call _apply,$(call sfirst,$(el)),$(call srest,$(el)))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(strip $(call EVAL_INVOKE,$(1),$(2))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# Setup the environment -REPL_ENV := $(call ENV_SET,$(REPL_ENV),+,number_plus) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),-,number_subtract) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*,number_multiply) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),/,number_divide) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) diff --git a/make/step4_if_fn_do.mk b/make/step4_if_fn_do.mk deleted file mode 100644 index 22d1d2148e..0000000000 --- a/make/step4_if_fn_do.mk +++ /dev/null @@ -1,114 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) diff --git a/make/step6_file.mk b/make/step6_file.mk deleted file mode 100644 index b05f723ef6..0000000000 --- a/make/step6_file.mk +++ /dev/null @@ -1,129 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) - -# Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) - -.PHONY: none $(MAKECMDGOALS) -none $(MAKECMDGOALS): - @true diff --git a/make/step7_quote.mk b/make/step7_quote.mk deleted file mode 100644 index 2af0248883..0000000000 --- a/make/step7_quote.mk +++ /dev/null @@ -1,146 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) - -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) - -# Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) - -.PHONY: none $(MAKECMDGOALS) -none $(MAKECMDGOALS): - @true diff --git a/make/step8_macros.mk b/make/step8_macros.mk deleted file mode 100644 index 172e64d382..0000000000 --- a/make/step8_macros.mk +++ /dev/null @@ -1,171 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) - -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef - -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(call ENV_FIND,$(2),_macro_$($(call _nth,$(1),0)_value)),) -endef - -define MACROEXPAND -$(strip $(if $(__ERROR),,\ - $(if $(call IS_MACRO_CALL,$(1),$(2)),\ - $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ - $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ - $(1)))) -endef - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(call ENV_SET,$(2),_macro_$($(a1)_value),true),,)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,macroexpand,$($(a0)_value)),\ - $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(foreach ast,$(call MACROEXPAND,$(1),$(2)), - $(if $(call _list?,$(ast)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil))),\ - $(ast))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) -$(call do,$(call REP, (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )) - -# Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) - -.PHONY: none $(MAKECMDGOALS) -none $(MAKECMDGOALS): - @true diff --git a/make/step9_try.mk b/make/step9_try.mk deleted file mode 100644 index 587f400ed1..0000000000 --- a/make/step9_try.mk +++ /dev/null @@ -1,186 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) - -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef - -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(call ENV_FIND,$(2),_macro_$($(call _nth,$(1),0)_value)),) -endef - -define MACROEXPAND -$(strip $(if $(__ERROR),,\ - $(if $(call IS_MACRO_CALL,$(1),$(2)),\ - $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ - $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ - $(1)))) -endef - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(call ENV_SET,$(2),_macro_$($(a1)_value),true),,)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,macroexpand,$($(a0)_value)),\ - $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ - $(if $(call _EQ,try*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach res,$(call EVAL,$(a1),$(2)),\ - $(if $(__ERROR),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach a20,$(call _nth,$(a2),0),\ - $(if $(call _EQ,catch*,$($(a20)_value)),\ - $(foreach a21,$(call _nth,$(a2),1),\ - $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call _list,$(a21)),\ - $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ - $(eval __ERROR :=)\ - $(call EVAL,$(a22),$(catch_env)))))),\ - $(res)))),\ - $(res)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args))))))))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(foreach ast,$(call MACROEXPAND,$(1),$(2)), - $(if $(call _list?,$(ast)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil))),\ - $(ast))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) -$(call do,$(call REP, (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )) - -# Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - -# repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) - -.PHONY: none $(MAKECMDGOALS) -none $(MAKECMDGOALS): - @true diff --git a/make/stepA_mal.mk b/make/stepA_mal.mk deleted file mode 100644 index 80909c778b..0000000000 --- a/make/stepA_mal.mk +++ /dev/null @@ -1,193 +0,0 @@ -# -# mal (Make Lisp) -# -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk -include $(_TOP_DIR)reader.mk -include $(_TOP_DIR)printer.mk -include $(_TOP_DIR)env.mk -include $(_TOP_DIR)core.mk - -SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= - -# READ: read and parse input -define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) -endef - -# EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) - -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef - -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(call ENV_FIND,$(2),_macro_$($(call _nth,$(1),0)_value)),) -endef - -define MACROEXPAND -$(strip $(if $(__ERROR),,\ - $(if $(call IS_MACRO_CALL,$(1),$(2)),\ - $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ - $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ - $(1)))) -endef - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) -endef - -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(call ENV_SET,$(2),_macro_$($(a1)_value),true),,)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,macroexpand,$($(a0)_value)),\ - $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ - $(if $(call _EQ,make*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ - $(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\ - $(if $(call _EQ,try*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach res,$(call EVAL,$(a1),$(2)),\ - $(if $(__ERROR),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach a20,$(call _nth,$(a2),0),\ - $(if $(call _EQ,catch*,$($(a20)_value)),\ - $(foreach a21,$(call _nth,$(a2),1),\ - $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call _list,$(a21)),\ - $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ - $(eval __ERROR :=)\ - $(call EVAL,$(a22),$(catch_env)))))),\ - $(res)))),\ - $(res)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))))))) -endef - -define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ - $(if $(call _list?,$(1)),\ - $(foreach ast,$(call MACROEXPAND,$(1),$(2)), - $(if $(call _list?,$(ast)),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil))),\ - $(ast))),\ - $(call EVAL_AST,$(1),$(2))))) -endef - - -# PRINT: -define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) -endef - -# REPL: -REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) - -# core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) - -# core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! *host-language* "make") )) -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) -$(call do,$(call REP, (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs)))))))) )) - -# Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - -# repl loop -$(if $(strip $(INTERACTIVE)),\ - $(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \ - $(call REPL)) - -.PHONY: none $(MAKECMDGOALS) -none $(MAKECMDGOALS): - @true diff --git a/make/tests/stepA_mal.mal b/make/tests/stepA_mal.mal deleted file mode 100644 index 768a9293c1..0000000000 --- a/make/tests/stepA_mal.mal +++ /dev/null @@ -1,19 +0,0 @@ -;; Testing basic make interop - -(make* "7") -;=>"7" - -(make* "$(info foo)") -; foo -;=>"" - -(make* "$(eval foo := 8)") -(make* "$(foo)") -;=>"8" - -(make* "$(foreach v,a b c,X$(v)Y)") -;=>"XaY XbY XcY" - -(read-string (make* "($(foreach v,1 2 3,$(call int_add,1,$(v))))")) -;=>(2 3 4) - diff --git a/make/types.mk b/make/types.mk deleted file mode 100644 index 63203963c9..0000000000 --- a/make/types.mk +++ /dev/null @@ -1,258 +0,0 @@ -# -# mal (Make a Lisp) object types -# - -ifndef __mal_types_included -__mal_types_included := true - -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)gmsl.mk -include $(_TOP_DIR)util.mk -include $(_TOP_DIR)numbers.mk - - -# Low-level type implemenation - -# magic is \u2344 \u204a -__obj_magic = â„⊠-# \u2256 -__equal = ≛ -__keyword = Êž -__obj_hash_code = 0 - -__new_obj_hash_code = $(eval __obj_hash_code := $(call int_add,1,$(__obj_hash_code)))$(__obj_hash_code) - -__new_obj = $(__obj_magic)_$(1)_$(call __new_obj_hash_code) - -__new_obj_like = $(foreach type,$(word 2,$(subst _, ,$(1))),$(__obj_magic)_$(type)_$(__new_obj_hash_code)) - -__get_obj_values = $(strip \ - $(if $(filter $(__obj_magic)_hmap_%,$(1)),\ - $(sort $(foreach v,$(filter %_value,$(filter $(1)_%,$(.VARIABLES))),$(if $(call _undefined?,$(v)),,$(v)))),\ - $($(1)_value))) - - -# Visualize Objects in memory -__var_name = $(word 2,$(subst _, ,$(1)))_$(word 3,$(subst _, ,$(1))) -__var_idx := 0 -__var_print = $(foreach v,$(1),\ - $(foreach var,$(call __var_name,$(v)),\ - $(if $(or $(call _list?,$(v)),$(call _vector?,$(v))),\ - $(info $(2)$(var):)\ - $(eval __var_idx := $(call int_add,1,$(__var_idx)))\ - $(foreach lidx,__lidx_$(__var_idx),\ - $(eval $(lidx) := 0)\ - $(foreach val,$($(v)_value),\ - $(call __var_print,$(val),$(2)$(SPACE)$(SPACE)$($(lidx)): )\ - $(eval $(lidx) := $(call int_add,1,$($(lidx)))))),\ - $(if $(call _hash_map?,$(v)),\ - $(info $(2)$(var):)\ - $(foreach vkey,$(filter $(v)_%,$(.VARIABLES)),\ - $(foreach key,$(word 4,$(subst _, ,$(vkey))),\ - $(info $(2)$(SPACE)$(SPACE)$(subst $(__equal),=,$(key)): )\ - $(call __var_print,$($(vkey)),$(2)$(SPACE)$(SPACE)$(SPACE)$(SPACE)))),\ - $(if $(call _symbol?,$(v)),\ - $(info $(2)$(var): $($(v)_value)),\ - $(if $(call _keyword?,$(v)),\ - $(info $(2)$(var): $($(v)_value)),\ - $(if $(call _number?,$(v)),\ - $(info $(2)$(var): $(call int_decode,$($(v)_value))),\ - $(if $(call _nil?,$(v)),\ - $(info $(2)nil),\ - $(if $(call _function?,$(v)),\ - $(if $(word 6,$(value $(v)_value)),\ - $(info $(2)$(var): $(wordlist 1,5,$(value $(v)_value))...),\ - $(info $(2)$(var): $(value $(v)_value))),\ - $(info $(2)$(var): ...)))))))))) - -_visualize_memory = $(foreach var,$(sort $(foreach vv,$(filter $(__obj_magic)_%,$(.VARIABLES)),$(call __var_name,$(vv)))),$(call __var_print,$(__obj_magic)_$(var))) - - -# Errors/Exceptions -__ERROR := -_error = $(eval __ERROR := $(call _string,$(1))) - - -# Constant atomic values -__undefined = $(__obj_magic)_undf_0 -__nil = $(__obj_magic)__nil_0 -__true = $(__obj_magic)_true_0 -__false = $(__obj_magic)_fals_0 - - -# General functions - -# Return the type of the object (or "make" if it's not a object -_obj_type = $(strip \ - $(if $(filter $(__obj_magic)_symb_%,$(1)),symbol,\ - $(if $(filter $(__obj_magic)_list_%,$(1)),list,\ - $(if $(filter $(__obj_magic)_numb_%,$(1)),number,\ - $(if $(filter $(__obj_magic)_func_%,$(1)),function,\ - $(if $(filter $(__obj_magic)_strn_%,$(1)),\ - $(if $(filter $(__keyword)%,$($(1)_value)),keyword,string),\ - $(if $(filter $(__obj_magic)__nil_%,$(1)),nil,\ - $(if $(filter $(__obj_magic)_true_%,$(1)),true,\ - $(if $(filter $(__obj_magic)_fals_%,$(1)),false,\ - $(if $(filter $(__obj_magic)_vect_%,$(1)),vector,\ - $(if $(filter $(__obj_magic)_atom_%,$(1)),atom,\ - $(if $(filter $(__obj_magic)_hmap_%,$(1)),hash_map,\ - $(if $(filter $(__obj_magic)_undf_%,$(1)),undefined,\ - make))))))))))))) - -_clone_obj = $(strip \ - $(foreach new_hcode,$(call __new_obj_hash_code),\ - $(foreach new_obj,$(foreach type,$(word 2,$(subst _, ,$(1))),$(__obj_magic)_$(type)_$(new_hcode)),\ - $(if $(filter $(__obj_magic)_hmap_%,$(1)),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_obj)_%) := $($(v))))\ - $(eval $(new_obj)_size := $($(1)_size)),\ - $(if $(filter $(__obj_magic)_func_%,$(1)),\ - $(eval $(new_obj)_value = $(value $(1)_value)),\ - $(eval $(new_obj)_value := $(strip $($(1)_value)))))\ - $(new_obj)))) - -_equal? = $(strip \ - $(foreach ot1,$(call _obj_type,$(1)),$(foreach ot2,$(call _obj_type,$(2)),\ - $(if $(or $(call _EQ,$(ot1),$(ot2)),\ - $(and $(call _sequential?,$(1)),$(call _sequential?,$(2)))),\ - $(if $(or $(call _string?,$(1)),$(call _symbol?,$(1)),$(call _keyword?,$(1)),$(call _number?,$(1))),\ - $(call _EQ,$($(1)_value),$($(2)_value)),\ - $(if $(or $(call _vector?,$(1)),$(call _list?,$(1)),$(call _hash_map?,$(1))),\ - $(if $(and $(call _EQ,$(call _count,$(1)),$(call _count,$(2))),\ - $(call _EQ,$(call _count,$(1)),$(words $(call gmsl_pairmap,_equal?,$(call __get_obj_values,$(1)),$(call __get_obj_values,$(2)))))),$(__true),),\ - $(call _EQ,$(1),$(2)))))))) - -_undefined? = $(or $(call _EQ,undefined,$(origin $(1))),$(filter $(__undefined),$($(1)))) - -_nil? = $(if $(filter $(__obj_magic)__nil_%,$(1)),$(__true),) - -_true? = $(if $(filter $(__obj_magic)_true_%,$(1)),$(__true),) - -_false? = $(if $(filter $(__obj_magic)_fals_%,$(1)),$(__true),) - - -# Symbols -_symbol = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_symb_$(hcode)$(eval $(__obj_magic)_symb_$(hcode)_value := $(1))) -_symbol? = $(if $(filter $(__obj_magic)_symb_%,$(1)),$(__true),) - - -# Keywords -_keyword = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_strn_$(hcode)$(eval $(__obj_magic)_strn_$(hcode)_value := $(__keyword)$(1))) -_keyword? = $(if $(filter $(__obj_magic)_strn_%,$(1)),$(if $(filter $(__keyword)%,$($(1)_value)),$(__true),)) - - -# Numbers -_pnumber = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_numb_$(hcode)$(eval $(__obj_magic)_numb_$(hcode)_value := $(1))) -_number = $(call _pnumber,$(call int_encode,$(1))) -_number? = $(if $(filter $(__obj_magic)_numb_%,$(1)),$(__true),) - - -# Strings -__string = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_strn_$(hcode)$(eval $(__obj_magic)_strn_$(hcode)_value := $(1))) -_string = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_strn_$(hcode)$(eval $(__obj_magic)_strn_$(hcode)_value := $(call str_encode,$(1)))) -_string? = $(if $(filter $(__obj_magic)_strn_%,$(1)),$(__true),) - -# Functions - -# Return a function object. The first parameter is the -# function/macro 'source'. Note that any $ must be escaped as $$ to be -# preserved and become positional arguments for when the -# function/macro is later invoked. -_function = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_func_$(hcode)$(eval $(__obj_magic)_func_$(hcode)_value = $(1))) -_function? = $(if $(filter $(__obj_magic)_func_%,$(1)),$(__true),) - -# Takes a function name and a list object of arguments and invokes -# the function with space separated arguments -_apply = $(call $(1),$($(2)_value)) - -# Takes a function object and a list object of arguments and invokes -# the function with space separated arguments -apply = $(call $(1)_value,$($(2)_value)) - - -# Lists -_list = $(word 1,$(foreach new_list,$(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_list_$(hcode)),$(new_list) $(eval $(new_list)_value := $1))) -_list? = $(if $(filter $(__obj_magic)_list_%,$(1)),$(__true),) - - -# Vectors (same as lists for now) -_vector = $(word 1,$(foreach new_vect,$(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_vect_$(hcode)),$(new_vect) $(eval $(new_vect)_value := $1))) -_vector? = $(if $(filter $(__obj_magic)_vect_%,$(1)),$(__true),) - - -# Hash maps (associative arrays) -_hash_map = $(word 1,$(foreach hcode,$(call __new_obj_hash_code),$(foreach new_hmap,$(__obj_magic)_hmap_$(hcode),$(new_hmap) $(eval $(new_hmap)_size := 0) $(if $(1),$(call _assoc_seq!,$(new_hmap),$(1)))))) -_hash_map? = $(if $(filter $(__obj_magic)_hmap_%,$(1)),$(__true),) - -# Set multiple key/values in a map -_assoc_seq! = $(call _assoc!,$(1),$(call str_decode,$($(word 1,$(2))_value)),$(word 2,$(2)))$(if $(word 3,$(2)),$(call _assoc_seq!,$(1),$(wordlist 3,$(words $(2)),$(2))),) - -_dissoc_seq! = $(foreach key,$(2),\ - $(call _dissoc!,$(1),$(call str_decode,$($(key)_value)))) - -# set a key/value in the hash map -_assoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),$(eval $(1)_size := $(call int_add,$($(1)_size),1)),)$(eval $(1)_$(k)_value := $(3))$(1)) - -# unset a key in the hash map -_dissoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$(eval $(1)_$(k)_value := $(__undefined))$(eval $(1)_size := $(call int_sub,$($(1)_size),1))))$(1) - -# Hash map and vector functions - -# retrieve the value of a plain string key from the hash map, or -# retrive a vector by plain index -_get = $(strip \ - $(if $(call _hash_map?,$(1)),\ - $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$($(1)_$(k)_value))),\ - $(if $(call _vector?,$(1)),\ - $(word $(call int_add,1,$(2)),$($(1)_value)),\ - ,))) - -_contains? = $(strip \ - $(if $(call _hash_map?,$(1)),\ - $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$(__true))),\ - $(if $(call _vector?,$(1)),\ - $(if $(word $(call int_add,1,$(2)),$($(1)_value)),$(__true),),\ - ,))) - - -# sequence operations - -_sequential? = $(if $(filter $(__obj_magic)_list_% $(__obj_magic)_vect_%,$(1)),$(__true),) - -_nth = $(word $(call int_add,1,$(2)),$($(1)_value)) - -# conj that mutates a sequence in-place to append the call arguments -_conj! = $(eval $(1)_value := $(strip $($(1)_value) $2 $3 $4 $5 $6 $7 $8 $9 $(10) $(11) $(12) $(13) $(14) $(15) $(16) $(17) $(18) $(19) $(20)))$(1) - -_count = $(strip \ - $(if $(call _hash_map?,$(1)),\ - $($(1)_size),\ - $(words $($(1)_value)))) - -# Creates a new vector/list of the everything after but the first -# element -srest = $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(wordlist 2,$(words $($(1)_value)),$($(1)_value))))) - -# maps a make function over a list object, using mutating _conj! -_smap = $(word 1,\ - $(foreach new_list,$(call _list),\ - $(new_list)\ - $(foreach v,$(call __get_obj_values,$(2)),\ - $(call _conj!,$(new_list),$(call $(1),$(v),$(3),$(4)))))) - -# Same as _smap but returns a vector -_smap_vec = $(word 1,\ - $(foreach new_vector,$(call _vector),\ - $(new_vector)\ - $(foreach v,$(call __get_obj_values,$(2)),\ - $(call _conj!,$(new_vector),$(call $(1),$(v),$(3),$(4)))))) - - -# atoms - -_atom? = $(if $(filter $(__obj_magic)_atom_%,$(1)),$(__true),) - - -endif diff --git a/make/util.mk b/make/util.mk deleted file mode 100644 index ffe635dc57..0000000000 --- a/make/util.mk +++ /dev/null @@ -1,97 +0,0 @@ -# -# mal (Make Lisp) utility functions/definitions -# - -ifndef __mal_util_included -__mal_util_included := true - -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)gmsl.mk - -SEMI := ; -COMMA := , -COLON := : -LCURLY := { -RCURLY := } -LPAREN := ( -RPAREN := ) -LBRACKET := [ -RBRACKET := ] -DQUOTE := "# " -SLASH := $(strip \ ) -ESC_DQUOTE := $(SLASH)$(DQUOTE) -SQUOTE := '# ' -QQUOTE := `# ` -SPACE := -SPACE += -NUMBERS := 0 1 2 3 4 5 6 7 8 9 -UNQUOTE := ~ -SPLICE_UNQUOTE := ~@ -define NEWLINE - - -endef -CARET := ^ -ATSIGN := @ - -# \u00ab -_LP := « -# \u00bb -_RP := » -# \u00ed -_LC := í -# \u00ec -_RC := ì -## \u00a7 -_SP := § -## \u00ae -_SUQ := ® -## \u015e -_DOL := Åž -## \u00b6 -_NL := ¶ -## \u00a8 -###_EDQ := ¨ - - -# -# Utility functions -# - -_EQ = $(if $(subst x$1,,x$2)$(subst x$2,,x$1),,true) - -_NOT = $(if $1,,true) - -# take a list of words and join them with a separator -# params: words, seperator, result -_join = $(strip \ - $(if $(strip $(1)),\ - $(if $(strip $(3)),\ - $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)$(2)$(word 1,$(1))),\ - $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(word 1,$(1)))),\ - $(3))) - -#$(info _join(1 2 3 4): [$(call _join,1 2 3 4)]) -#$(info _join(1 2 3 4,X): [$(call _join,1 2 3 4, )]) -#$(info _join(1): [$(call _join,1)]) -#$(info _join(): [$(call _join,)]) - -# reverse list of words -_reverse = $(if $(1),$(call _reverse,$(wordlist 2,$(words $(1)),$(1)))) $(firstword $(1)) - -#$(info reverse(1 2 3 4 5): $(call reverse,1 2 3 4 5)) - -# str_encode: take a string and return an encoded version of it with -# every character separated by a space and special characters replaced -# with special Unicode characters -str_encode = $(strip $(eval __temp := $$(subst $$$$,$(_DOL) ,$$(subst $(SPLICE_UNQUOTE),$(_SUQ) ,$$(subst $$(LPAREN),$$(_LP) ,$$(subst $$(RPAREN),$$(_RP) ,$$(subst $$(LCURLY),$$(_LC) ,$$(subst $$(RCURLY),$$(_RC) ,$$(subst $$(NEWLINE),$$(_NL) ,$$(subst $$(SPACE),$(_SP) ,$$1)))))))))$(foreach a,$(gmsl_characters),$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp)) - -# str_decode: take an encoded string an return an unencoded version of -# it by replacing the special Unicode charactes with the real -# characters and with all characters joined into a regular string -str_decode = $(subst $(_SP),$(SPACE),$(subst $(_NL),$(NEWLINE),$(subst $(_LC),$(LCURLY),$(subst $(_RC),$(RCURLY),$(subst $(_LP),$(LPAREN),$(subst $(_RP),$(RPAREN),$(subst $(_SUQ),$(SPLICE_UNQUOTE),$(subst $(_DOL),$$,$(strip $(call _join,$(1))))))))))) - -# Read a whole file substituting newlines with $(_NL) -_read_file = $(subst $(_NL),$(NEWLINE),$(shell out=""; while read -r l; do out="$${out}$${l}$(_NL)"; done < $(1); echo "$$out")) - -endif diff --git a/mal.html b/mal.html deleted file mode 100644 index 89d9c4120c..0000000000 --- a/mal.html +++ /dev/null @@ -1,271 +0,0 @@ - - - - - - - - - - - - Mal Web RELP - - -
-

Mal

- -

Mal Web REPL

- - - -
-
-
-
- -

 

-
-
-
- View source on Github

-
-
- -
- -
-

Mal at a glance

-
- -
-
-

Datatypes

- - - - - - - - - - - - - - - - - -
Maps{"key1" "val1", "key2" 123}
Lists(1 2 3 "four")
Vectors[1 2 3 4 "a" "b" "c" 1 2]
Scalarsa-symbol, "a string", 123, nil, true, false
-
-
-

Functions

- - - - - - - - - - - - - -
Calling(<function> - <args*>)
Defining named functions(def! <name> - (fn* - [<args*>] - <action*>))
Anonymous function(fn* |name| - [<args*>] - <action*>)
-
-
-

Useful Macros and Special Forms

- - - - - - - - - - - - - - -
Conditionalsif cond or
Multiple Actions (side-effects)(do - <action*>...)
Defining thingsdef! defmacro! let*
-
-
- -
-
-

Useful Functions

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Math+ - * /
Comparison/Boolean= < > <= >= not
Predicatesnil? true? false? symbol? list? vector? map? sequential?
Data processingmap apply
Data createlist vector hash-map
Data inspectionfirst rest get keys vals count get nth contains? empty?
Data manipulationconj cons concat assoc dissoc
Lists and Vectorsfirst rest nth
Hash Mapsget keys vals contains?
-
-
-

JavaScript Interop

- - - - - - - - - -
Evaluate JavaScript(js* "JS string to eval")
Method call/access(. js-fn arg...)
-
-
- -
- - - -
- - - - - - - diff --git a/mal/Makefile b/mal/Makefile deleted file mode 100644 index 0848621f18..0000000000 --- a/mal/Makefile +++ /dev/null @@ -1,20 +0,0 @@ - -TESTS = - -SOURCES_BASE = -SOURCES_LISP = env.mal core.mal stepA_mal.mal -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -#.PHONY: stats tests $(TESTS) -.PHONY: stats - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -#tests: $(TESTS) -# -#$(TESTS): -# @echo "Running $@"; \ -# python $@ || exit 1; \ diff --git a/mal/core.mal b/mal/core.mal deleted file mode 100644 index a6b6bb90af..0000000000 --- a/mal/core.mal +++ /dev/null @@ -1,59 +0,0 @@ -(def! core_ns - [["=" =] - ["throw" throw] - ["nil?" nil?] - ["true?" true?] - ["false?" false?] - ["symbol" symbol] - ["symbol?" symbol?] - ["keyword" keyword] - ["keyword?" keyword?] - - ["pr-str" pr-str] - ["str" str] - ["prn" prn] - ["println" println] - ["readline" readline] - ["read-string" read-string] - ["slurp" slurp] - ["<" <] - ["<=" <=] - [">" >] - [">=" >=] - ["+" +] - ["-" -] - ["*" *] - ["/" /] - - ["list" list] - ["list?" list?] - ["vector" vector] - ["vector?" vector?] - ["hash-map" hash-map] - ["map?" map?] - ["assoc" assoc] - ["dissoc" dissoc] - ["get" get] - ["contains?" contains?] - ["keys" keys] - ["vals" vals] - - ["sequential?" sequential?] - ["cons" cons] - ["concat" concat] - ["nth" nth] - ["first" first] - ["rest" rest] - ["empty?" empty?] - ["count" count] - ["conj" conj] - ["apply" apply] - ["map" map] - - ["with-meta" with-meta] - ["meta" meta] - ["atom" atom] - ["atom?" atom?] - ["deref" deref] - ["reset!" reset!] - ["swap!" swap!]]) diff --git a/mal/env.mal b/mal/env.mal deleted file mode 100644 index 40937c5807..0000000000 --- a/mal/env.mal +++ /dev/null @@ -1,40 +0,0 @@ -;; env - -(def! bind-env (fn* [env b e] - (if (empty? b) - env - - (if (= "&" (str (first b))) - (assoc env (str (nth b 1)) e) - - (bind-env (assoc env (str (first b)) (first e)) - (rest b) (rest e)))))) - -(def! new-env (fn* [& args] - (if (<= (count args) 1) - (atom {"--outer--" (first args)}) - (atom (bind-env {"--outer--" (first args)} - (nth args 1) (nth args 2)))))) - -(def! env-find (fn* [env k] - (let* [ks (str k) - data @env] - (if (contains? data ks) - env - (if (get data "--outer--") - (env-find (get data "--outer--") ks) - nil))))) - -(def! env-get (fn* [env k] - (let* [ks (str k) - e (env-find env ks)] - (if e - (get @e ks) - (throw (str "'" ks "' not found")))))) - -(def! env-set (fn* [env k v] - (do - (swap! env assoc (str k) v) - v))) - -;;(prn "loaded env.mal") diff --git a/mal/step1_read_print.mal b/mal/step1_read_print.mal deleted file mode 100644 index 991a745f7d..0000000000 --- a/mal/step1_read_print.mal +++ /dev/null @@ -1,30 +0,0 @@ -;; read -(def! READ (fn* [strng] - (read-string strng))) - -;; eval -(def! EVAL (fn* [ast env] - ast)) - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) {})))) - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/step2_eval.mal b/mal/step2_eval.mal deleted file mode 100644 index 9c5f2eb126..0000000000 --- a/mal/step2_eval.mal +++ /dev/null @@ -1,62 +0,0 @@ -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (or (get env (str ast)) - (throw (str ast " not found"))) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env {"+" + - "-" - - "*" * - "/" /}) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/step3_env.mal b/mal/step3_env.mal deleted file mode 100644 index 6677b04e4a..0000000000 --- a/mal/step3_env.mal +++ /dev/null @@ -1,82 +0,0 @@ -(load-file "../mal/env.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -(env-set repl-env "+" +) -(env-set repl-env "-" -) -(env-set repl-env "*" *) -(env-set repl-env "/" /) - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/step4_if_fn_do.mal b/mal/step4_if_fn_do.mal deleted file mode 100644 index 85a91099d2..0000000000 --- a/mal/step4_if_fn_do.mal +++ /dev/null @@ -1,100 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (repl-loop))) -(-main) diff --git a/mal/step6_file.mal b/mal/step6_file.mal deleted file mode 100644 index b36820da4c..0000000000 --- a/mal/step6_file.mal +++ /dev/null @@ -1,105 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/step7_quote.mal b/mal/step7_quote.mal deleted file mode 100644 index 042443c762..0000000000 --- a/mal/step7_quote.mal +++ /dev/null @@ -1,133 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/step8_macros.mal b/mal/step8_macros.mal deleted file mode 100644 index e5e308c168..0000000000 --- a/mal/step8_macros.mal +++ /dev/null @@ -1,167 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! is-macro-call (fn* [ast env] - (if (list? ast) - (let* [a0 (first ast)] - (if (symbol? a0) - (if (env-find env a0) - (let* [m (meta (env-get env a0))] - (if m - (if (get m "ismacro") - true))))))))) - -(def! MACROEXPAND (fn* [ast env] - (if (is-macro-call ast env) - (let* [mac (env-get env (first ast))] - (MACROEXPAND (apply mac (rest ast)) env)) - ast))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - ast - - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'defmacro! a0) - (let* [a1 (nth ast 1) - a2 (nth ast 2) - f (EVAL a2 env) - m (or (meta f) {}) - mac (with-meta f (assoc m "ismacro" true))] - (env-set env a1 mac)) - - (= 'macroexpand a0) - (let* [a1 (nth ast 1)] - (MACROEXPAND a1 env)) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/step9_try.mal b/mal/step9_try.mal deleted file mode 100644 index ac54cef805..0000000000 --- a/mal/step9_try.mal +++ /dev/null @@ -1,178 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! is-macro-call (fn* [ast env] - (if (list? ast) - (let* [a0 (first ast)] - (if (symbol? a0) - (if (env-find env a0) - (let* [m (meta (env-get env a0))] - (if m - (if (get m "ismacro") - true))))))))) - -(def! MACROEXPAND (fn* [ast env] - (if (is-macro-call ast env) - (let* [mac (env-get env (first ast))] - (MACROEXPAND (apply mac (rest ast)) env)) - ast))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - ast - - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'defmacro! a0) - (let* [a1 (nth ast 1) - a2 (nth ast 2) - f (EVAL a2 env) - m (or (meta f) {}) - mac (with-meta f (assoc m "ismacro" true))] - (env-set env a1 mac)) - - (= 'macroexpand a0) - (let* [a1 (nth ast 1)] - (MACROEXPAND a1 env)) - - (= 'try* a0) - (if (= 'catch* (nth (nth ast 2) 0)) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (EVAL (nth (nth ast 2) 2) - (new-env env - [(nth (nth ast 2)1)] - [exc])))) - (EVAL (nth ast 1) env)) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (repl-loop)))) -(apply -main *ARGV*) diff --git a/mal/stepA_mal.mal b/mal/stepA_mal.mal deleted file mode 100644 index 3e2a258cc7..0000000000 --- a/mal/stepA_mal.mal +++ /dev/null @@ -1,181 +0,0 @@ -(load-file "../mal/env.mal") -(load-file "../mal/core.mal") - -;; read -(def! READ (fn* [strng] - (read-string strng))) - - -;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (if (> (count x) 0) - true)))) - -(def! QUASIQUOTE (fn* [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (nth ast 1) - - (if (is-pair (first ast)) - (if (= 'splice-unquote (first (first ast))) - true)) - (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) - -(def! is-macro-call (fn* [ast env] - (if (list? ast) - (let* [a0 (first ast)] - (if (symbol? a0) - (if (env-find env a0) - (let* [m (meta (env-get env a0))] - (if m - (if (get m "ismacro") - true))))))))) - -(def! MACROEXPAND (fn* [ast env] - (if (is-macro-call ast env) - (let* [mac (env-get env (first ast))] - (MACROEXPAND (apply mac (rest ast)) env)) - ast))) - -(def! eval-ast (fn* [ast env] (do - ;;(do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast)))) - -(def! LET (fn* [env args] - (if (> (count args) 0) - (do - (env-set env (nth args 0) (EVAL (nth args 1) env)) - (LET env (rest (rest args))))))) - -(def! EVAL (fn* [ast env] (do - ;;(do (prn "EVAL" ast "/" (keys @env)) ) - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - ast - - (let* [a0 (first ast)] - (cond - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (let* [let-env (new-env env)] - (do - (LET let-env (nth ast 1)) - (EVAL (nth ast 2) let-env))) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquote a0) - (let* [a1 (nth ast 1)] - (EVAL (QUASIQUOTE a1) env)) - - (= 'defmacro! a0) - (let* [a1 (nth ast 1) - a2 (nth ast 2) - f (EVAL a2 env) - m (or (meta f) {}) - mac (with-meta f (assoc m "ismacro" true))] - (env-set env a1 mac)) - - (= 'macroexpand a0) - (let* [a1 (nth ast 1)] - (MACROEXPAND a1 env)) - - (= 'try* a0) - (if (= 'catch* (nth (nth ast 2) 0)) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (EVAL (nth (nth ast 2) 2) - (new-env env - [(nth (nth ast 2)1)] - [exc])))) - (EVAL (nth ast 1) env)) - - (= 'do a0) - (let* [el (eval-ast (rest ast) env)] - (nth el (- (count el) 1))) - - (= 'if a0) - (let* [cond (EVAL (nth ast 1) env)] - (if (or (= cond nil) (= cond false)) - (if (> (count ast) 3) - (EVAL (nth ast 3) env) - nil) - (EVAL (nth ast 2) env))) - - (= 'fn* a0) - (fn* [& args] - (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))))))) - - -;; print -(def! PRINT (fn* [exp] (pr-str exp))) - -;; repl -(def! repl-env (new-env)) -(def! rep (fn* [strng] - (PRINT (EVAL (READ strng) repl-env)))) - -;; core.mal: defined directly using mal -(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) -(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) -(env-set repl-env '*ARGV* (rest *ARGV*)) - -;; core.mal: defined using the new language itself -(rep (str "(def! *host-language* \"" *host-language* "-mal\")")) -(rep "(def! not (fn* [a] (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -;; repl loop -(def! repl-loop (fn* [] - (let* [line (readline "mal-user> ")] - (if line - (do - (if (not (= "" line)) - (try* - (println (rep line)) - (catch* exc - (println "Uncaught exception:" exc)))) - (repl-loop)))))) - -(def! -main (fn* [& args] - (if (> (count args) 0) - (rep (str "(load-file \"" (first args) "\")")) - (do - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (repl-loop))))) -(apply -main *ARGV*) diff --git a/matlab/+types/HashMap.m b/matlab/+types/HashMap.m deleted file mode 100644 index f48ba813a3..0000000000 --- a/matlab/+types/HashMap.m +++ /dev/null @@ -1,47 +0,0 @@ -classdef HashMap < handle - properties - data = containers.Map(); - meta = types.nil; - end - methods - function obj = HashMap(varargin) - if nargin == 0 - obj.data = containers.Map(); - else - obj.data = containers.Map(varargin(1:2:end), ... - varargin(2:2:end)); - end - end - - function len = length(obj) - len = length(obj.data); - end - - function ret = get(obj, key) - ret = obj.data(key); - end - - function ret = set(obj, key, val) - obj.data(key) = val; - ret = val; - end - - function ret = keys(obj) - ret = obj.data.keys(); - end - - function ret = values(obj) - ret = obj.data.values(); - end - - function ret = clone(obj) - ret = types.HashMap(); - if length(obj) > 0 - ret.data = containers.Map(obj.data.keys(), obj.data.values()); - else - ret.data = containers.Map(); - end - ret.meta = obj.meta; - end - end -end diff --git a/matlab/Env.m b/matlab/Env.m deleted file mode 100644 index 66862ffe15..0000000000 --- a/matlab/Env.m +++ /dev/null @@ -1,50 +0,0 @@ -classdef Env < handle - properties - data - outer - end - methods - function env = Env(outer, binds, exprs) - env.data = containers.Map(); - env.outer = outer; - - if nargin > 1 - env = Env(outer); - for i=1:length(binds) - k = binds.get(i).name; - if strcmp(k, '&') - env.data(binds.get(i+1).name) = exprs.slice(i); - break; - else - env.data(k) = exprs.get(i); - end - end - end - end - - function ret = set(env, k, v) - env.data(k.name) = v; - ret = v; - end - function ret = find(env, k) - if env.data.isKey(k.name) - ret = env; - else - if ~islogical(env.outer) - ret = env.outer.find(k); - else - ret = false; - end - end - end - function ret = get(env, k) - fenv = env.find(k); - if ~islogical(fenv) - ret = fenv.data(k.name); - else - throw(MException('ENV:notfound', ... - sprintf('''%s'' not found', k.name))); - end - end - end -end diff --git a/matlab/Makefile b/matlab/Makefile deleted file mode 100644 index eba8fa4355..0000000000 --- a/matlab/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -SOURCES_BASE = types.m types/Nil.m types/MalException.m \ - types/Symbol.m types/List.m types/Vector.m \ - types/HashMap.m types/Function.m types/Atom.m \ - types/Reader.m reader.m printer.m -SOURCES_LISP = Env.m core.m stepA_mal.m -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ - -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/matlab/core.m b/matlab/core.m deleted file mode 100644 index 2f9e1f3b64..0000000000 --- a/matlab/core.m +++ /dev/null @@ -1,221 +0,0 @@ -classdef core - methods(Static) - function ret = throw(obj) - ret = types.nil; - throw(types.MalException(obj)); - end - - function str = pr_str(varargin) - strs = cellfun(@(s) printer.pr_str(s,true), varargin, ... - 'UniformOutput', false); - str = strjoin(strs, ' '); - end - function str = do_str(varargin) - strs = cellfun(@(s) printer.pr_str(s,false), varargin, ... - 'UniformOutput', false); - str = strjoin(strs, ''); - end - function ret = prn(varargin) - strs = cellfun(@(s) printer.pr_str(s,true), varargin, ... - 'UniformOutput', false); - fprintf('%s\n', strjoin(strs, ' ')); - ret = types.nil; - end - function ret = println(varargin) - strs = cellfun(@(s) printer.pr_str(s,false), varargin, ... - 'UniformOutput', false); - fprintf('%s\n', strjoin(strs, ' ')); - ret = types.nil; - end - - function ret = time_ms() - secs = now-repmat(datenum('1970-1-1 00:00:00'),size(now)); - ret = floor(secs.*repmat(24*3600.0*1000,size(now))); - end - - function new_hm = assoc(hm, varargin) - new_hm = clone(hm); - for i=1:2:length(varargin) - new_hm.set(varargin{i}, varargin{i+1}); - end - end - - function new_hm = dissoc(hm, varargin) - new_hm = clone(hm); - ks = intersect(hm.keys(),varargin); - remove(new_hm.data, ks); - end - - function ret = get(hm, key) - if hm == types.nil - ret = types.nil; - else - if hm.data.isKey(key) - ret = hm.data(key); - else - ret = types.nil; - end - end - end - - function ret = keys(hm) - ks = hm.keys(); - ret = types.List(ks{:}); - end - - function ret = vals(hm) - vs = hm.values(); - ret = types.List(vs{:}); - end - - function ret = cons(a, seq) - cella = [{a}, seq.data]; - ret = types.List(cella{:}); - end - - function ret = concat(varargin) - if nargin == 0 - cella = {}; - else - cells = cellfun(@(x) x.data, varargin, ... - 'UniformOutput', false); - cella = cat(2,cells{:}); - end - ret = types.List(cella{:}); - end - - function ret = first(seq) - if length(seq) < 1 - ret = types.nil; - else - ret = seq.get(1); - end - end - - function ret = rest(seq) - cella = seq.data(2:end); - ret = types.List(cella{:}); - end - - function ret = nth(seq, idx) - if idx+1 > length(seq) - throw(MException('Range:nth', ... - 'nth: index out of range')) - end - ret = seq.get(idx+1); - end - - function ret = apply(varargin) - f = varargin{1}; - if isa(f, 'types.Function') - f = f.fn; - end - first_args = varargin(2:end-1); - rest_args = varargin{end}.data; - args = [first_args rest_args]; - ret = f(args{:}); - end - - function ret = map(f, lst) - if isa(f, 'types.Function') - f = f.fn; - end - cells = cellfun(@(x) f(x), lst.data, 'UniformOutput', false); - ret = types.List(cells{:}); - end - - function new_obj = with_meta(obj, meta) - new_obj = clone(obj); - new_obj.meta = meta; - end - - function meta = meta(obj) - switch class(obj) - case {'types.List', 'types.Vector', - 'types.HashMap', 'types.Function'} - meta = obj.meta; - otherwise - meta = types.nil; - end - end - - function ret = reset_BANG(atm, val) - atm.val = val; - ret = val; - end - - function ret = swap_BANG(atm, f, varargin) - args = [{atm.val} varargin]; - if isa(f, 'types.Function') - f = f.fn; - end - atm.val = f(args{:}); - ret = atm.val; - end - - function n = ns() - n = containers.Map(); - n('=') = @types.equal; - n('throw') = @core.throw; - n('nil?') = @(a) isa(a, 'types.Nil'); - n('true?') = @(a) isa(a, 'logical') && a == true; - n('false?') = @(a) isa(a, 'logical') && a == false; - n('symbol') = @(a) types.Symbol(a); - n('symbol?') = @(a) isa(a, 'types.Symbol'); - n('keyword') = @types.keyword; - n('keyword?') = @types.keyword_Q; - - n('pr-str') = @core.pr_str; - n('str') = @core.do_str; - n('prn') = @core.prn; - n('println') = @core.println; - n('read-string') = @reader.read_str; - n('readline') = @(p) input(p, 's'); - n('slurp') = @fileread; - - n('<') = @(a,b) a') = @(a,b) a>b; - n('>=') = @(a,b) a>=b; - n('+') = @(a,b) a+b; - n('-') = @(a,b) a-b; - n('*') = @(a,b) a*b; - n('/') = @(a,b) floor(a/b); - n('time-ms') = @core.time_ms; - - n('list') = @(varargin) types.List(varargin{:}); - n('list?') = @types.list_Q; - n('vector') = @(varargin) types.Vector(varargin{:}); - n('vector?') = @types.vector_Q; - n('hash-map') = @(varargin) types.HashMap(varargin{:}); - n('map?') = @types.hash_map_Q; - n('assoc') = @core.assoc; - n('dissoc') = @core.dissoc; - n('get') = @core.get; - n('contains?') = @(a,b) a.data.isKey(b); - n('keys') = @core.keys; - n('vals') = @core.vals; - - n('sequential?') = @types.sequential_Q; - n('cons') = @core.cons; - n('concat') = @core.concat; - n('nth') = @core.nth; - n('first') = @core.first; - n('rest') = @core.rest; - n('empty?') = @(a) length(a) == 0; - n('count') = @(a) length(a); - n('apply') = @core.apply; - n('map') = @core.map; - n('conj') = @(x) disp('not implemented yet'); - - n('with-meta') = @core.with_meta; - n('meta') = @core.meta; - n('atom') = @types.Atom; - n('atom?') = @(a) isa(a, 'types.Atom'); - n('deref') = @(a) a.val; - n('reset!') = @core.reset_BANG; - n('swap!') = @core.swap_BANG; - end - end -end - diff --git a/matlab/printer.m b/matlab/printer.m deleted file mode 100644 index 5200a6ee69..0000000000 --- a/matlab/printer.m +++ /dev/null @@ -1,55 +0,0 @@ -% this is just being used as a namespace -classdef printer - methods (Static = true) - function str = pr_str(obj, print_readably) - switch class(obj) - case 'types.Symbol' - str = obj.name; - case 'double' - str = num2str(obj); - case 'char' - if types.keyword_Q(obj) - str = sprintf(':%s', obj(2:end)); - else - if print_readably - str = strrep(obj, '\', '\\'); - str = strrep(str, '"', '\"'); - str = strrep(str, char(10), '\n'); - str = sprintf('"%s"', str); - else - str = obj; - end - end - case 'types.List' - strs = cellfun(@(x) printer.pr_str(x, print_readably), ... - obj.data, 'UniformOutput', false); - str = sprintf('(%s)', strjoin(strs, ' ')); - case 'types.Vector' - strs = cellfun(@(x) printer.pr_str(x, print_readably), ... - obj.data, 'UniformOutput', false); - str = sprintf('[%s]', strjoin(strs, ' ')); - case 'types.HashMap' - strs = {}; - ks = obj.keys(); - for i=1:length(ks) - k = ks{i}; - strs{end+1} = printer.pr_str(k, print_readably); - strs{end+1} = printer.pr_str(obj.get(k), print_readably); - end - str = sprintf('{%s}', strjoin(strs, ' ')); - case 'types.Nil' - str = 'nil'; - case 'logical' - if eq(obj, true) - str = 'true'; - else - str = 'false'; - end - case 'types.Atom' - str = sprintf('(atom %s)', printer.pr_str(obj.val,true)); - otherwise - str = '#'; - end - end - end -end diff --git a/matlab/reader.m b/matlab/reader.m deleted file mode 100644 index e0018cafb2..0000000000 --- a/matlab/reader.m +++ /dev/null @@ -1,122 +0,0 @@ -% this is just being used as a namespace -classdef reader - methods (Static = true) - function tokens = tokenize(str) - re = '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"|;[^\n]*|[^\s\[\]{}(''"`,;)]*)'; - % extract the capture group (to ignore spaces and commas) - tokens = cellfun(@(x) x(1), regexp(str, re, 'tokens')); - comments = cellfun(@(x) length(x) > 0 && x(1) == ';', tokens); - tokens = tokens(~comments); - end - - function atm = read_atom(rdr) - token = rdr.next(); - %fprintf('in read_atom: %s\n', token); - if not(isempty(regexp(token, '^-?[0-9]+$', 'match'))) - atm = str2double(token); - elseif strcmp(token(1), '"') - atm = token(2:length(token)-1); - atm = strrep(atm, '\"', '"'); - atm = strrep(atm, '\n', char(10)); - elseif strcmp(token(1), ':') - atm = types.keyword(token); - elseif strcmp(token, 'nil') - atm = types.nil; - elseif strcmp(token, 'true') - atm = true; - elseif strcmp(token, 'false') - atm = false; - else - atm = types.Symbol(token); - end - end - - function seq = read_seq(rdr, start, last) - %fprintf('in read_seq\n'); - seq = {}; - token = rdr.next(); - if not(strcmp(token, start)) - error(sprintf('expected ''%s''', start)); - end - token = rdr.peek(); - while true - if eq(token, false) - error(sprintf('expected ''%s''', last)); - end - if strcmp(token, last), break, end - seq{end+1} = reader.read_form(rdr); - token = rdr.peek(); - end - rdr.next(); - end - - function lst = read_list(rdr) - seq = reader.read_seq(rdr, '(', ')'); - lst = types.List(seq{:}); - end - - function vec = read_vector(rdr) - seq = reader.read_seq(rdr, '[', ']'); - vec = types.Vector(seq{:}); - end - - function map = read_hash_map(rdr) - seq = reader.read_seq(rdr, '{', '}'); - map = types.HashMap(seq{:}); - end - - function ast = read_form(rdr) - %fprintf('in read_form\n'); - token = rdr.peek(); - switch token - case '''' - rdr.next(); - ast = types.List(types.Symbol('quote'), ... - reader.read_form(rdr)); - case '`' - rdr.next(); - ast = types.List(types.Symbol('quasiquote'), ... - reader.read_form(rdr)); - case '~' - rdr.next(); - ast = types.List(types.Symbol('unquote'), ... - reader.read_form(rdr)); - case '~@' - rdr.next(); - ast = types.List(types.Symbol('splice-unquote'), ... - reader.read_form(rdr)); - case '^' - rdr.next(); - meta = reader.read_form(rdr); - ast = types.List(types.Symbol('with-meta'), ... - reader.read_form(rdr), meta); - case '@' - rdr.next(); - ast = types.List(types.Symbol('deref'), ... - reader.read_form(rdr)); - - case ')' - error('unexpected '')'''); - case '(' - ast = reader.read_list(rdr); - case ']' - error('unexpected '']'''); - case '[' - ast = reader.read_vector(rdr); - case '}' - error('unexpected ''}'''); - case '{' - ast = reader.read_hash_map(rdr); - otherwise - ast = reader.read_atom(rdr); - end - end - - function ast = read_str(str) - %fprintf('in read_str\n'); - tokens = reader.tokenize(str); - rdr = types.Reader(tokens); - ast = reader.read_form(rdr); - end - end -end diff --git a/matlab/step1_read_print.m b/matlab/step1_read_print.m deleted file mode 100644 index 8b63b3645b..0000000000 --- a/matlab/step1_read_print.m +++ /dev/null @@ -1,35 +0,0 @@ -function step1_read_print(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = EVAL(ast, env) - ret = ast; -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, '')); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step2_eval.m b/matlab/step2_eval.m deleted file mode 100644 index d742d6f469..0000000000 --- a/matlab/step2_eval.m +++ /dev/null @@ -1,77 +0,0 @@ -function step2_eval(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env(ast.name); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - el = eval_ast(ast, env); - f = el.get(1); - args = el.data(2:end); - ret = f(args{:}); -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = containers.Map(); - repl_env('+') = @(a,b) a+b; - repl_env('-') = @(a,b) a-b; - repl_env('*') = @(a,b) a*b; - repl_env('/') = @(a,b) floor(a/b); - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step3_env.m b/matlab/step3_env.m deleted file mode 100644 index 55a3668fd6..0000000000 --- a/matlab/step3_env.m +++ /dev/null @@ -1,93 +0,0 @@ -function step3_env(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - ret = EVAL(ast.get(3), let_env); - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.data(2:end); - ret = f(args{:}); - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - repl_env.set(types.Symbol('+'), @(a,b) a+b); - repl_env.set(types.Symbol('-'), @(a,b) a-b); - repl_env.set(types.Symbol('*'), @(a,b) a*b); - repl_env.set(types.Symbol('/'), @(a,b) floor(a/b)); - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step4_if_fn_do.m b/matlab/step4_if_fn_do.m deleted file mode 100644 index a8641942d8..0000000000 --- a/matlab/step4_if_fn_do.m +++ /dev/null @@ -1,117 +0,0 @@ -function step4_if_fn_do(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - ret = EVAL(ast.get(3), let_env); - case 'do' - el = eval_ast(ast.slice(2), env); - ret = el.get(length(el)); - case 'if' - cond = EVAL(ast.get(2), env); - if strcmp(class(cond), 'types.Nil') || ... - (islogical(cond) && cond == false) - if length(ast) > 3 - ret = EVAL(ast.get(4), env); - else - ret = types.nil; - end - else - ret = EVAL(ast.get(3), env); - end - case 'fn*' - ret = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ... - types.List(varargin{:}))); - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.data(2:end); - ret = f(args{:}); - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - - % core.m: defined using matlab - ns = core.ns(); ks = ns.keys(); - for i=1:length(ks) - k = ks{i}; - repl_env.set(types.Symbol(k), ns(k)); - end - - % core.mal: defined using the langauge itself - rep('(def! not (fn* (a) (if a false true)))', repl_env); - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step5_tco.m b/matlab/step5_tco.m deleted file mode 100644 index c0c46f65c6..0000000000 --- a/matlab/step5_tco.m +++ /dev/null @@ -1,130 +0,0 @@ -function step5_tco(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - return; - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - env = let_env; - ast = ast.get(3); % TCO - case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); - ast = ast.get(length(ast)); % TCO - case 'if' - cond = EVAL(ast.get(2), env); - if strcmp(class(cond), 'types.Nil') || ... - (islogical(cond) && cond == false) - if length(ast) > 3 - ast = ast.get(4); % TCO - else - ret = types.nil; - return; - end - else - ast = ast.get(3); % TCO - end - case 'fn*' - fn = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ... - types.List(varargin{:}))); - ret = types.Function(fn, ast.get(3), env, ast.get(2)); - return; - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); - if isa(f, 'types.Function') - env = Env(f.env, f.params, args); - ast = f.ast; % TCO - else - ret = f(args.data{:}); - return - end - end - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - - % core.m: defined using matlab - ns = core.ns(); ks = ns.keys(); - for i=1:length(ks) - k = ks{i}; - repl_env.set(types.Symbol(k), ns(k)); - end - - % core.mal: defined using the langauge itself - rep('(def! not (fn* (a) (if a false true)))', repl_env); - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step6_file.m b/matlab/step6_file.m deleted file mode 100644 index 6a9476d58f..0000000000 --- a/matlab/step6_file.m +++ /dev/null @@ -1,139 +0,0 @@ -function step6_file(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - return; - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - env = let_env; - ast = ast.get(3); % TCO - case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); - ast = ast.get(length(ast)); % TCO - case 'if' - cond = EVAL(ast.get(2), env); - if strcmp(class(cond), 'types.Nil') || ... - (islogical(cond) && cond == false) - if length(ast) > 3 - ast = ast.get(4); % TCO - else - ret = types.nil; - return; - end - else - ast = ast.get(3); % TCO - end - case 'fn*' - fn = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ... - types.List(varargin{:}))); - ret = types.Function(fn, ast.get(3), env, ast.get(2)); - return; - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); - if isa(f, 'types.Function') - env = Env(f.env, f.params, args); - ast = f.ast; % TCO - else - ret = f(args.data{:}); - return - end - end - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - - % core.m: defined using matlab - ns = core.ns(); ks = ns.keys(); - for i=1:length(ks) - k = ks{i}; - repl_env.set(types.Symbol(k), ns(k)); - end - repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); - rest_args = args(2:end); - repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); - - % core.mal: defined using the langauge itself - rep('(def! not (fn* (a) (if a false true)))', repl_env); - rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env); - - if ~isempty(args) - rep(sprintf('(load-file "%s")', args{1}), repl_env); - quit; - end - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step7_quote.m b/matlab/step7_quote.m deleted file mode 100644 index 3d1149aae9..0000000000 --- a/matlab/step7_quote.m +++ /dev/null @@ -1,167 +0,0 @@ -function step7_quote(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = is_pair(ast) - ret = types.sequential_Q(ast) && length(ast) > 0; -end - -function ret = quasiquote(ast) - if ~is_pair(ast) - ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); - end -end - -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - return; - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - env = let_env; - ast = ast.get(3); % TCO - case 'quote' - ret = ast.get(2); - return; - case 'quasiquote' - ast = quasiquote(ast.get(2)); % TCO - case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); - ast = ast.get(length(ast)); % TCO - case 'if' - cond = EVAL(ast.get(2), env); - if strcmp(class(cond), 'types.Nil') || ... - (islogical(cond) && cond == false) - if length(ast) > 3 - ast = ast.get(4); % TCO - else - ret = types.nil; - return; - end - else - ast = ast.get(3); % TCO - end - case 'fn*' - fn = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ... - types.List(varargin{:}))); - ret = types.Function(fn, ast.get(3), env, ast.get(2)); - return; - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); - if isa(f, 'types.Function') - env = Env(f.env, f.params, args); - ast = f.ast; % TCO - else - ret = f(args.data{:}); - return - end - end - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - - % core.m: defined using matlab - ns = core.ns(); ks = ns.keys(); - for i=1:length(ks) - k = ks{i}; - repl_env.set(types.Symbol(k), ns(k)); - end - repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); - rest_args = args(2:end); - repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); - - % core.mal: defined using the langauge itself - rep('(def! not (fn* (a) (if a false true)))', repl_env); - rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env); - - if ~isempty(args) - rep(sprintf('(load-file "%s")', args{1}), repl_env); - quit; - end - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step8_macros.m b/matlab/step8_macros.m deleted file mode 100644 index 5567649b77..0000000000 --- a/matlab/step8_macros.m +++ /dev/null @@ -1,201 +0,0 @@ -function step8_macros(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = is_pair(ast) - ret = types.sequential_Q(ast) && length(ast) > 0; -end - -function ret = quasiquote(ast) - if ~is_pair(ast) - ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); - end -end - -function ret = is_macro_call(ast, env) - if types.list_Q(ast) && isa(ast.get(1), 'types.Symbol') && ... - ~islogical(env.find(ast.get(1))) - f = env.get(ast.get(1)); - ret = isa(f,'types.Function') && f.is_macro; - else - ret = false; - end -end - -function ret = macroexpand(ast, env) - while is_macro_call(ast, env) - mac = env.get(ast.get(1)); - args = ast.slice(2); - ast = mac.fn(args.data{:}); - end - ret = ast; -end - -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - ast = macroexpand(ast, env); - if ~types.list_Q(ast) - ret = ast; - return; - end - - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - return; - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - env = let_env; - ast = ast.get(3); % TCO - case 'quote' - ret = ast.get(2); - return; - case 'quasiquote' - ast = quasiquote(ast.get(2)); % TCO - case 'defmacro!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - ret.is_macro = true; - return; - case 'macroexpand' - ret = macroexpand(ast.get(2), env); - return; - case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); - ast = ast.get(length(ast)); % TCO - case 'if' - cond = EVAL(ast.get(2), env); - if strcmp(class(cond), 'types.Nil') || ... - (islogical(cond) && cond == false) - if length(ast) > 3 - ast = ast.get(4); % TCO - else - ret = types.nil; - return; - end - else - ast = ast.get(3); % TCO - end - case 'fn*' - fn = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ... - types.List(varargin{:}))); - ret = types.Function(fn, ast.get(3), env, ast.get(2)); - return; - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); - if isa(f, 'types.Function') - env = Env(f.env, f.params, args); - ast = f.ast; % TCO - else - ret = f(args.data{:}); - return - end - end - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - - % core.m: defined using matlab - ns = core.ns(); ks = ns.keys(); - for i=1:length(ks) - k = ks{i}; - repl_env.set(types.Symbol(k), ns(k)); - end - repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); - rest_args = args(2:end); - repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); - - % core.mal: defined using the langauge itself - rep('(def! not (fn* (a) (if a false true)))', repl_env); - rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env); - rep('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))', repl_env); - rep('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))', repl_env); - - if ~isempty(args) - rep(sprintf('(load-file "%s")', args{1}), repl_env); - quit; - end - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - fprintf('Error: %s\n', err.message); - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/step9_try.m b/matlab/step9_try.m deleted file mode 100644 index 1f338b2b63..0000000000 --- a/matlab/step9_try.m +++ /dev/null @@ -1,224 +0,0 @@ -function step9_try(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = is_pair(ast) - ret = types.sequential_Q(ast) && length(ast) > 0; -end - -function ret = quasiquote(ast) - if ~is_pair(ast) - ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); - end -end - -function ret = is_macro_call(ast, env) - if types.list_Q(ast) && isa(ast.get(1), 'types.Symbol') && ... - ~islogical(env.find(ast.get(1))) - f = env.get(ast.get(1)); - ret = isa(f,'types.Function') && f.is_macro; - else - ret = false; - end -end - -function ret = macroexpand(ast, env) - while is_macro_call(ast, env) - mac = env.get(ast.get(1)); - args = ast.slice(2); - ast = mac.fn(args.data{:}); - end - ret = ast; -end - -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - ast = macroexpand(ast, env); - if ~types.list_Q(ast) - ret = ast; - return; - end - - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - return; - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - env = let_env; - ast = ast.get(3); % TCO - case 'quote' - ret = ast.get(2); - return; - case 'quasiquote' - ast = quasiquote(ast.get(2)); % TCO - case 'defmacro!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - ret.is_macro = true; - return; - case 'macroexpand' - ret = macroexpand(ast.get(2), env); - return; - case 'try*' - try - ret = EVAL(ast.get(2), env); - return; - catch e - if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*') - if isa(e, 'types.MalException') - exc = e.obj; - else - exc = e.message; - end - catch_env = Env(env, types.List(ast.get(3).get(2)), ... - types.List(exc)); - ret = EVAL(ast.get(3).get(3), catch_env); - return; - else - throw(e); - end - end - case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); - ast = ast.get(length(ast)); % TCO - case 'if' - cond = EVAL(ast.get(2), env); - if strcmp(class(cond), 'types.Nil') || ... - (islogical(cond) && cond == false) - if length(ast) > 3 - ast = ast.get(4); % TCO - else - ret = types.nil; - return; - end - else - ast = ast.get(3); % TCO - end - case 'fn*' - fn = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ... - types.List(varargin{:}))); - ret = types.Function(fn, ast.get(3), env, ast.get(2)); - return; - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); - if isa(f, 'types.Function') - env = Env(f.env, f.params, args); - ast = f.ast; % TCO - else - ret = f(args.data{:}); - return - end - end - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - - % core.m: defined using matlab - ns = core.ns(); ks = ns.keys(); - for i=1:length(ks) - k = ks{i}; - repl_env.set(types.Symbol(k), ns(k)); - end - repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); - rest_args = args(2:end); - repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); - - % core.mal: defined using the langauge itself - rep('(def! not (fn* (a) (if a false true)))', repl_env); - rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env); - rep('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))', repl_env); - rep('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))', repl_env); - - if ~isempty(args) - rep(sprintf('(load-file "%s")', args{1}), repl_env); - quit; - end - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - if isa(err, 'types.MalException') - fprintf('Error: %s\n', printer.pr_str(err.obj, true)); - else - fprintf('Error: %s\n', err.message); - end - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/stepA_mal.m b/matlab/stepA_mal.m deleted file mode 100644 index 6f74b6a451..0000000000 --- a/matlab/stepA_mal.m +++ /dev/null @@ -1,226 +0,0 @@ -function stepA_mal(varargin), main(varargin), end - -% read -function ret = READ(str) - ret = reader.read_str(str); -end - -% eval -function ret = is_pair(ast) - ret = types.sequential_Q(ast) && length(ast) > 0; -end - -function ret = quasiquote(ast) - if ~is_pair(ast) - ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); - end -end - -function ret = is_macro_call(ast, env) - if types.list_Q(ast) && isa(ast.get(1), 'types.Symbol') && ... - ~islogical(env.find(ast.get(1))) - f = env.get(ast.get(1)); - ret = isa(f,'types.Function') && f.is_macro; - else - ret = false; - end -end - -function ret = macroexpand(ast, env) - while is_macro_call(ast, env) - mac = env.get(ast.get(1)); - args = ast.slice(2); - ast = mac.fn(args.data{:}); - end - ret = ast; -end - -function ret = eval_ast(ast, env) - switch class(ast) - case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.Vector' - ret = types.Vector(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end - case 'types.HashMap' - ret = types.HashMap(); - ks = ast.keys(); - for i=1:length(ks) - k = ks{i}; - ret.set(EVAL(k, env), EVAL(ast.get(k), env)); - end - otherwise - ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~types.list_Q(ast) - ret = eval_ast(ast, env); - return; - end - - % apply - ast = macroexpand(ast, env); - if ~types.list_Q(ast) - ret = ast; - return; - end - - if isa(ast.get(1),'types.Symbol') - a1sym = ast.get(1).name; - else - a1sym = '_@$fn$@_'; - end - switch (a1sym) - case 'def!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - return; - case 'let*' - let_env = Env(env); - for i=1:2:length(ast.get(2)) - let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); - end - env = let_env; - ast = ast.get(3); % TCO - case 'quote' - ret = ast.get(2); - return; - case 'quasiquote' - ast = quasiquote(ast.get(2)); % TCO - case 'defmacro!' - ret = env.set(ast.get(2), EVAL(ast.get(3), env)); - ret.is_macro = true; - return; - case 'macroexpand' - ret = macroexpand(ast.get(2), env); - return; - case 'try*' - try - ret = EVAL(ast.get(2), env); - return; - catch e - if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*') - if isa(e, 'types.MalException') - exc = e.obj; - else - exc = e.message; - end - catch_env = Env(env, types.List(ast.get(3).get(2)), ... - types.List(exc)); - ret = EVAL(ast.get(3).get(3), catch_env); - return; - else - throw(e); - end - end - case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); - ast = ast.get(length(ast)); % TCO - case 'if' - cond = EVAL(ast.get(2), env); - if strcmp(class(cond), 'types.Nil') || ... - (islogical(cond) && cond == false) - if length(ast) > 3 - ast = ast.get(4); % TCO - else - ret = types.nil; - return; - end - else - ast = ast.get(3); % TCO - end - case 'fn*' - fn = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ... - types.List(varargin{:}))); - ret = types.Function(fn, ast.get(3), env, ast.get(2)); - return; - otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); - if isa(f, 'types.Function') - env = Env(f.env, f.params, args); - ast = f.ast; % TCO - else - ret = f(args.data{:}); - return - end - end - end -end - -% print -function ret = PRINT(ast) - ret = printer.pr_str(ast, true); -end - -% REPL -function ret = rep(str, env) - ret = PRINT(EVAL(READ(str), env)); -end - -function main(args) - repl_env = Env(false); - - % core.m: defined using matlab - ns = core.ns(); ks = ns.keys(); - for i=1:length(ks) - k = ks{i}; - repl_env.set(types.Symbol(k), ns(k)); - end - repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); - rest_args = args(2:end); - repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); - - % core.mal: defined using the langauge itself - rep('(def! *host-language* "matlab")', repl_env); - rep('(def! not (fn* (a) (if a false true)))', repl_env); - rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env); - rep('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))', repl_env); - rep('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))', repl_env); - - if ~isempty(args) - rep(sprintf('(load-file "%s")', args{1}), repl_env); - quit; - end - - %cleanObj = onCleanup(@() disp('*** here1 ***')); - rep('(println (str "Mal [" *host-language* "]"))', repl_env); - while (true) - line = input('user> ', 's'); - if strcmp(strtrim(line),''), continue, end - try - fprintf('%s\n', rep(line, repl_env)); - catch err - if isa(err, 'types.MalException') - fprintf('Error: %s\n', printer.pr_str(err.obj, true)); - else - fprintf('Error: %s\n', err.message); - end - fprintf('%s\n', getReport(err, 'extended')); - end - end -end diff --git a/matlab/types.m b/matlab/types.m deleted file mode 100644 index 4d78f916d1..0000000000 --- a/matlab/types.m +++ /dev/null @@ -1,57 +0,0 @@ -classdef types - properties (Constant = true) - nil = types.Nil(); - end - - methods(Static) - function ret = equal(a,b) - ret = false; - ota = class(a); otb = class(b); - if ~(strcmp(ota,otb) || ... - (types.sequential_Q(a) && types.sequential_Q(b))) - return; - end - switch (ota) - case {'types.List', 'types.Vector'} - if ~(length(a) == length(b)) - return; - end - for i=1:length(a) - if ~(types.equal(a.get(i), b.get(i))) - return; - end - end - ret = true; - case 'char' - ret = strcmp(a,b); - otherwise - ret = a == b; - end - end - - function ret = sequential_Q(obj) - ret = strcmp(class(obj), 'types.List') || ... - strcmp(class(obj), 'types.Vector'); - end - - function ret = list_Q(obj) - ret = strcmp(class(obj), 'types.List'); - end - function ret = vector_Q(obj) - ret = strcmp(class(obj), 'types.Vector'); - end - function ret = hash_map_Q(obj) - ret = strcmp(class(obj), 'types.HashMap'); - end - - function ret = keyword(str) - ret = sprintf('%s%s', native2unicode(hex2dec('029e'),'UTF-8'), ... - str(2:end)); - end - function ret = keyword_Q(obj) - ret = length(obj) > 1 && ... - strcmp(obj(1), native2unicode(hex2dec('029e'),'UTF-8')); - end - end -end - diff --git a/miniMAL/Makefile b/miniMAL/Makefile deleted file mode 100644 index 8c838d3f79..0000000000 --- a/miniMAL/Makefile +++ /dev/null @@ -1,12 +0,0 @@ - -SOURCES_BASE = node_readline.js miniMAL-core.json \ - types.json reader.json printer.json -SOURCES_LISP = env.json core.json stepA_mal.json -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/miniMAL/core.json b/miniMAL/core.json deleted file mode 100644 index 164a846aa8..0000000000 --- a/miniMAL/core.json +++ /dev/null @@ -1,154 +0,0 @@ -["do", - -["def", "_path", ["require", ["`", "path"]]], - -["def", "_node_readline", ["require", [".", "_path", ["`", "resolve"], - ["`", "."], - ["`", "node_readline.js"]]]], - -["def", "div", ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]], - -["def", "time-ms", ["fn", [], - [".", ["new", "Date"], ["`", "getTime"]]]], - - -["def", "assoc", ["fn", ["src-hm", "&", "kvs"], - ["let", ["hm", ["clone", "src-hm"]], - ["assocs!", "hm", "kvs"]]]], - -["def", "dissoc", ["fn", ["src-hm", "&", "ks"], - ["let", ["hm", ["clone", "src-hm"]], - ["do", - ["map", ["fn", ["k"], ["del", "hm", "k"]], "ks"], - "hm"]]]], - -["def", "_get", ["fn", ["obj", "key"], - ["if", ["nil?", "obj"], - null, - ["if", ["contains?", "obj", "key"], - ["get", "obj", "key"], - null]]]], - -["def", "_count", ["fn", ["a"], - ["if", ["=", null, "a"], - 0, - ["count", "a"]]]], - -["def", "_nth", ["fn", ["seq", "idx"], - ["if", [">=", "idx", ["count", "seq"]], - ["throw", "nth: index out of range"], - ["nth", "seq", "idx"]]]], - -["def", "_first", ["fn", ["seq"], - ["if", ["empty?", "seq"], - null, - ["first", "seq"]]]], - -["def", "_apply", ["fn", ["f", "&", "args"], - ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"], - "fargs", ["concat", ["slice", "args", 0, ["-", ["count", "args"], 1]], - ["nth", "args", ["-", ["count", "args"], 1]]]], - ["apply", "fn", "fargs"]]]], - -["def", "_map", ["fn", ["f", "seq"], - ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"]], - ["map", "fn", "seq"]]]], - -["def", "with_meta", ["fn", ["obj", "m"], - ["let", ["new-obj", ["clone", "obj"]], - ["do", - ["set", "new-obj", ["`", "__meta__"], "m"], - "new-obj"]]]], - -["def", "meta", ["fn", ["obj"], - ["if", ["or", ["sequential?", "obj"], - ["map?", "obj"], - ["malfunc?", "obj"]], - ["if", ["contains?", "obj", ["`", "__meta__"]], - ["get", "obj", ["`", "__meta__"]], - null], - null]]], - -["def", "reset!", ["fn", ["atm", "val"], - ["set", "atm", ["`", "val"], "val"]]], - -["def", "swap!", ["fn", ["atm", "f", "&", "args"], - ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"], - "fargs", ["cons", ["get", "atm", ["`", "val"]], "args"], - "val", ["apply", "fn", "fargs"]], - ["do", - ["set", "atm", ["`", "val"], "val"], - "val"]]]], - -["def", "core-ns", - ["hash-map", - ["`", "="], "equal?", - ["`", "throw"], "throw", - - ["`", "nil?"], "nil?", - ["`", "true?"], "true?", - ["`", "false?"], "false?", - ["`", "symbol"], "symbol", - ["`", "symbol?"], "symbol?", - ["`", "keyword"], "keyword", - ["`", "keyword?"], "keyword?", - - ["`", "pr-str"], ["fn", ["&", "a"], ["pr-list", "a", true, ["`", " "]]], - ["`", "str"], ["fn", ["&", "a"], ["pr-list", "a", false, ["`", ""]]], - ["`", "prn"], ["fn", ["&", "a"], - ["do", - ["println", ["pr-list", "a", true, ["`", " "]]], - null]], - ["`", "println"], ["fn", ["&", "a"], - ["do", - ["println", ["pr-list", "a", false, ["`", " "]]], - null]], - ["`", "read-string"], "read-str", - ["`", "readline"], ["fn", ["p"], - [".", "_node_readline", ["`", "readline"], "p"]], - ["`", "slurp"], "slurp", - - ["`", "<"], "<", - ["`", "<="], "<=", - ["`", ">"], ">", - ["`", ">="], ">=", - ["`", "+"], "+", - ["`", "-"], "-", - ["`", "*"], "*", - ["`", "/"], "div", - ["`", "time-ms"], "time-ms", - - ["`", "list"], "list", - ["`", "list?"], "list?", - ["`", "vector"], "vector", - ["`", "vector?"], "vector?", - ["`", "hash-map"], "hash-map", - ["`", "assoc"], "assoc", - ["`", "dissoc"], "dissoc", - ["`", "map?"], "map?", - ["`", "get"], "_get", - ["`", "contains?"], "contains?", - ["`", "keys"], "keys", - ["`", "vals"], "vals", - - ["`", "sequential?"], "sequential?", - ["`", "cons"], "cons", - ["`", "concat"], "concat", - ["`", "nth"], "_nth", - ["`", "first"], "_first", - ["`", "rest"], ["fn", ["a"], ["rest", "a"]], - ["`", "empty?"], "empty?", - ["`", "count"], "_count", - ["`", "apply"], "_apply", - ["`", "map"], "_map", - ["`", "conj"], null, - - ["`", "with-meta"], "with_meta", - ["`", "meta"], "meta", - ["`", "atom"], "atom", - ["`", "atom?"], "atom?", - ["`", "deref"], ["fn", ["a"], ["get", "a", ["`", "val"]]], - ["`", "reset!"], "reset!", - ["`", "swap!"], "swap!"]], - -null] diff --git a/miniMAL/miniMAL-core.json b/miniMAL/miniMAL-core.json deleted file mode 100644 index c22376a86b..0000000000 --- a/miniMAL/miniMAL-core.json +++ /dev/null @@ -1,111 +0,0 @@ -["do", - -["def", "map", ["fn", ["a", "b"], [".", "b", ["`", "map"], "a"]]], -["def", "not", ["fn", ["a"], ["if", "a", false, true]]], - -["def", "nil?", ["fn", ["a"], ["=", null, "a"]]], -["def", "true?", ["fn", ["a"], ["=", true, "a"]]], -["def", "false?", ["fn", ["a"], ["=", false, "a"]]], -["def", "string?", ["fn", ["a"], - ["if", ["=", "a", null], - false, - ["=", ["`", "String"], - [".-", [".-", "a", ["`", "constructor"]], - ["`", "name"]]]]]], - -["def", "pr-list*", ["fn", ["a", "pr", "sep"], - [".", ["map", ["fn", ["x"], - ["if", "pr", - [".", "JSON", ["`", "stringify"], "x"], - ["if", ["string?", "x"], - "x", - [".", "JSON", ["`", "stringify"], "x"]]]], - "a"], - ["`", "join"], "sep"]]], -["def", "pr-str", ["fn", ["&", "a"], - ["pr-list*", "a", true, ["`", " "]]]], -["def", "str", ["fn", ["&", "a"], - ["pr-list*", "a", false, ["`", ""]]]], -["def", "prn", ["fn", ["&", "a"], - [".", "console", ["`", "log"], - ["pr-list*", "a", true, ["`", " "]]]]], -["def", "println", ["fn", ["&", "a"], - [".", "console", ["`", "log"], - ["pr-list*", "a", false, ["`", " "]]]]], - -["def", ">=", ["fn", ["a", "b"], - ["if", ["<", "a", "b"], false, true]]], -["def", ">", ["fn", ["a", "b"], - ["if", [">=", "a", "b"], ["if", ["=", "a", "b"], false, true], false]]], -["def", "<=", ["fn", ["a", "b"], - ["if", [">", "a", "b"], false, true]]], - -["def", "list", ["fn", ["&", "a"], "a"]], -["def", "list?", ["fn", ["a"], [".", "Array", ["`", "isArray"], "a"]]], -["def", "get", ["fn", ["a", "b"], [".-", "a", "b"]]], -["def", "set", ["fn", ["a", "b", "c"], [".-", "a", "b", "c"]]], -["def", "contains?", ["fn", ["a", "b"], [".", "a", ["`", "hasOwnProperty"], "b"]]], -["def", "keys", ["fn", ["a"], [".", "Object", ["`", "keys"], "a"]]], -["def", "vals", ["fn", ["a"], ["map",["fn",["k"],["get","a","k"]],["keys", "a"]]]], - -["def", "cons", ["fn", ["a", "b"], - [".", ["`", []], - ["`", "concat"], ["list", "a"], "b"]]], -["def", "concat", ["fn", ["&", "a"], - [".", [".-", ["list"], ["`", "concat"]], - ["`", "apply"], ["list"], "a"]]], -["def", "nth", "get"], -["def", "first", ["fn", ["a"], ["nth", "a", 0]]], -["def", "rest", ["fn", ["a"], [".", "a", ["`", "slice"], 1]]], -["def", "empty?", ["fn", ["a"], ["if", ["list?", "a"], ["if", ["=", 0, [".-", "a", ["`", "length"]]], true, false], ["=", "a", null]]]], -["def", "count", ["fn", ["a"], - [".-", "a", ["`", "length"]]]], -["def", "slice", ["fn", ["a", "start", "&", "endl"], - ["let", ["end", ["if", ["count", "endl"], - ["get", "endl", 0], - [".-", "a", ["`", "length"]]]], - [".", "a", ["`", "slice"], "start", "end"]]]], - -["def", "apply", ["fn", ["a", "b"], [".", "a", ["`", "apply"], "a", "b"]]], - -["def", "and", ["~", ["fn", ["&", "xs"], - ["if", ["empty?", "xs"], - true, - ["if", ["=", 1, ["count", "xs"]], - ["first", "xs"], - ["list", ["`", "let"], ["list", ["`", "and_FIXME"], ["first", "xs"]], - ["list", ["`", "if"], ["`", "and_FIXME"], - ["concat", ["`", ["and"]], ["rest", "xs"]], - ["`", "and_FIXME"]]]]]]]], - -["def", "or", ["~", ["fn", ["&", "xs"], - ["if", ["empty?", "xs"], - null, - ["if", ["=", 1, ["count", "xs"]], - ["first", "xs"], - ["list", ["`", "let"], ["list", ["`", "or_FIXME"], ["first", "xs"]], - ["list", ["`", "if"], ["`", "or_FIXME"], - ["`", "or_FIXME"], - ["concat", ["`", ["or"]], ["rest", "xs"]]]]]]]]], - -["def", "classOf", ["fn", ["a"], - [".", [".-", [".-", "Object", ["`", "prototype"]], ["`", "toString"]], - ["`", "call"], "a"]]], - - -["def", "repl", ["fn",["prompt", "rep"], - ["let", ["r", ["require", ["`", "repl"]], - "evl", ["fn", ["l", "c", "f", "cb"], - ["let", ["line", ["slice", "l", 1, ["-", [".-", "l", ["`", "length"]], 2]]], - ["do", - ["println", ["rep", "line"]], - ["cb"]]]], - "opts", {"ignoreUndefined": true, - "terminal": false}, - "opts", ["assoc!", "opts", ["`", "prompt"], "prompt"], - "opts", ["assoc!", "opts", ["`", "eval"], "evl"]], - [".", "r", ["`", "start"], "opts"]]]], - -null -] - diff --git a/miniMAL/node_readline.js b/miniMAL/node_readline.js deleted file mode 120000 index 7771772e4c..0000000000 --- a/miniMAL/node_readline.js +++ /dev/null @@ -1 +0,0 @@ -../js/node_readline.js \ No newline at end of file diff --git a/miniMAL/package.json b/miniMAL/package.json deleted file mode 100644 index 24d7a03ae0..0000000000 --- a/miniMAL/package.json +++ /dev/null @@ -1,8 +0,0 @@ -{ - "name": "mal-miniMAL", - "version": "0.0.1", - "description": "Make a Lisp (mal) language implemented in miniMAL", - "dependencies": { - "minimal-lisp": "0.0.3" - } -} diff --git a/miniMAL/step0_repl.json b/miniMAL/step0_repl.json deleted file mode 100644 index 659993001d..0000000000 --- a/miniMAL/step0_repl.json +++ /dev/null @@ -1,21 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], - -["def", "READ", ["fn", ["strng"], - "strng"]], - -["def", "EVAL", ["fn", ["ast", "env"], - "ast"]], - -["def", "PRINT", ["fn", ["exp"], - "exp"]], - -["def", "rep", ["fn", ["strng"], - ["PRINT", ["EVAL", ["READ", "strng"], null]]]], - -["repl", ["`", "user> "], "rep"], - -null - -] diff --git a/miniMAL/step1_read_print.json b/miniMAL/step1_read_print.json deleted file mode 100644 index dc1f2695f6..0000000000 --- a/miniMAL/step1_read_print.json +++ /dev/null @@ -1,27 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], - -["def", "READ", ["fn", ["strng"], - ["read-str", "strng"]]], - -["def", "EVAL", ["fn", ["ast", "env"], - "ast"]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], null]], - ["catch", "exc", - ["str", ["`", "Error: "], "exc"]]]]], - -["repl", ["`", "user> "], "rep"], - -null - -] diff --git a/miniMAL/step2_eval.json b/miniMAL/step2_eval.json deleted file mode 100644 index ee95fe2965..0000000000 --- a/miniMAL/step2_eval.json +++ /dev/null @@ -1,60 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], - -["def", "READ", ["fn", ["strng"], - ["read-str", "strng"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["let", ["sym", ["get", "ast", ["`", "val"]]], - ["if", ["contains?", "env", "sym"], - ["get", "env", "sym"], - ["throw", ["str", ["`", "'"], "sym", ["`", "' not found"]]]]], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["apply", "f", "args"]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", - ["hash-map", - ["`", "+"], "+", - ["`", "-"], "-", - ["`", "*"], "*", - ["`", "/"], ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["repl", ["`", "user> "], "rep"], - -null - -] diff --git a/miniMAL/step3_env.json b/miniMAL/step3_env.json deleted file mode 100644 index e72de0767d..0000000000 --- a/miniMAL/step3_env.json +++ /dev/null @@ -1,74 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], - -["def", "READ", ["fn", ["strng"], - ["read-str", "strng"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["apply", "f", "args"]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], -["env-set", "repl-env", ["symbol", ["`", "+"]], "+"], -["env-set", "repl-env", ["symbol", ["`", "-"]], "-"], -["env-set", "repl-env", ["symbol", ["`", "*"]], "*"], -["def", "div", ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]], -["env-set", "repl-env", ["symbol", ["`", "/"]], "div"], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["repl", ["`", "user> "], "rep"], - -null - -] diff --git a/miniMAL/step4_if_fn_do.json b/miniMAL/step4_if_fn_do.json deleted file mode 100644 index 97e80210c5..0000000000 --- a/miniMAL/step4_if_fn_do.json +++ /dev/null @@ -1,92 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], -["load-file", ["`", "core.json"]], - -["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["if", ["=", ["`", "do"], "a0"], - ["let", ["el", ["eval-ast", ["rest", "ast"], "env"]], - ["nth", "el", ["-", ["count", "el"], 1]]], - ["if", ["=", ["`", "if"], "a0"], - ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["or", ["=", "cond", null], ["=", "cond", false]], - ["if", [">", ["count", "ast"], 3], - ["EVAL", ["nth", "ast", 3], "env"], - null], - ["EVAL", ["nth", "ast", 2], "env"]]], - ["if", ["=", ["`", "fn*"], "a0"], - ["fn", ["&", "args"], - ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], - ["EVAL", ["nth", "ast", 2], "e"]]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["apply", "f", "args"]]]]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["`", "core.mal: defined using miniMAL"], -["map", ["fn", ["k"], ["env-set", "repl-env", - ["symbol", "k"], - ["get", "core-ns", "k"]]], - ["keys", "core-ns"]], - -["`", "core.mal: defined using mal itself"], -["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], - -["repl", ["`", "user> "], "rep"], - -null - -] diff --git a/miniMAL/step5_tco.json b/miniMAL/step5_tco.json deleted file mode 100644 index 06fd342c65..0000000000 --- a/miniMAL/step5_tco.json +++ /dev/null @@ -1,100 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], -["load-file", ["`", "core.json"]], - -["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["if", ["=", ["`", "do"], "a0"], - ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], - ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], - ["if", ["=", ["`", "if"], "a0"], - ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["or", ["=", "cond", null], ["=", "cond", false]], - ["if", [">", ["count", "ast"], 3], - ["EVAL", ["nth", "ast", 3], "env"], - null], - ["EVAL", ["nth", "ast", 2], "env"]]], - ["if", ["=", ["`", "fn*"], "a0"], - ["malfunc", - ["fn", ["&", "args"], - ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], - ["EVAL", ["nth", "ast", 2], "e"]]], - ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], - ["env-new", ["get", "f", ["`", "env"]], - ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["`", "core.mal: defined using miniMAL"], -["map", ["fn", ["k"], ["env-set", "repl-env", - ["symbol", "k"], - ["get", "core-ns", "k"]]], - ["keys", "core-ns"]], - -["`", "core.mal: defined using mal itself"], -["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], - -["repl", ["`", "user> "], "rep"], - -null - -] diff --git a/miniMAL/step6_file.json b/miniMAL/step6_file.json deleted file mode 100644 index 08f22c43f8..0000000000 --- a/miniMAL/step6_file.json +++ /dev/null @@ -1,107 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], -["load-file", ["`", "core.json"]], - -["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["if", ["=", ["`", "do"], "a0"], - ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], - ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], - ["if", ["=", ["`", "if"], "a0"], - ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["or", ["=", "cond", null], ["=", "cond", false]], - ["if", [">", ["count", "ast"], 3], - ["EVAL", ["nth", "ast", 3], "env"], - null], - ["EVAL", ["nth", "ast", 2], "env"]]], - ["if", ["=", ["`", "fn*"], "a0"], - ["malfunc", - ["fn", ["&", "args"], - ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], - ["EVAL", ["nth", "ast", 2], "e"]]], - ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], - ["env-new", ["get", "f", ["`", "env"]], - ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["`", "core.mal: defined using miniMAL"], -["map", ["fn", ["k"], ["env-set", "repl-env", - ["symbol", "k"], - ["get", "core-ns", "k"]]], - ["keys", "core-ns"]], -["env-set", "repl-env", ["symbol", ["`", "eval"]], - ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], -["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "*ARGV*", 1]], - -["`", "core.mal: defined using mal itself"], -["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], -["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"]], - -["if", ["not", ["empty?", "*ARGV*"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "*ARGV*", 0], ["`", "\")"]]], - ["repl", ["`", "user> "], "rep"]], - -null - -] diff --git a/miniMAL/step7_quote.json b/miniMAL/step7_quote.json deleted file mode 100644 index 78fd49eda2..0000000000 --- a/miniMAL/step7_quote.json +++ /dev/null @@ -1,131 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], -["load-file", ["`", "core.json"]], - -["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], - -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], - -["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], - ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["if", ["=", ["`", "quote"], "a0"], - ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquote"], "a0"], - ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], - ["if", ["=", ["`", "do"], "a0"], - ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], - ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], - ["if", ["=", ["`", "if"], "a0"], - ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["or", ["=", "cond", null], ["=", "cond", false]], - ["if", [">", ["count", "ast"], 3], - ["EVAL", ["nth", "ast", 3], "env"], - null], - ["EVAL", ["nth", "ast", 2], "env"]]], - ["if", ["=", ["`", "fn*"], "a0"], - ["malfunc", - ["fn", ["&", "args"], - ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], - ["EVAL", ["nth", "ast", 2], "e"]]], - ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], - ["env-new", ["get", "f", ["`", "env"]], - ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["`", "core.mal: defined using miniMAL"], -["map", ["fn", ["k"], ["env-set", "repl-env", - ["symbol", "k"], - ["get", "core-ns", "k"]]], - ["keys", "core-ns"]], -["env-set", "repl-env", ["symbol", ["`", "eval"]], - ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], -["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "*ARGV*", 1]], - -["`", "core.mal: defined using mal itself"], -["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], -["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"]], - -["if", ["not", ["empty?", "*ARGV*"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "*ARGV*", 0], ["`", "\")"]]], - ["repl", ["`", "user> "], "rep"]], - -null - -] diff --git a/miniMAL/step8_macros.json b/miniMAL/step8_macros.json deleted file mode 100644 index 8b93fd0f4a..0000000000 --- a/miniMAL/step8_macros.json +++ /dev/null @@ -1,157 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], -["load-file", ["`", "core.json"]], - -["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], - -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], - -["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], - ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], - -["def", "macro?", ["fn", ["ast", "env"], - ["and", ["list?", "ast"], - ["symbol?", ["first", "ast"]], - ["not", ["=", null, ["env-find", "env", ["first", "ast"]]]], - ["let", ["fn", ["env-get", "env", ["first", "ast"]]], - ["and", ["malfunc?", "fn"], - ["get", "fn", ["`", "macro?"]]]]]]], - -["def", "macroexpand", ["fn", ["ast", "env"], - ["if", ["macro?", "ast", "env"], - ["let", ["mac", ["get", ["env-get", "env", ["first", "ast"]], ["`", "fn"]]], - ["macroexpand", ["apply", "mac", ["rest", "ast"]], "env"]], - "ast"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["ast", ["macroexpand", "ast", "env"]], - ["if", ["not", ["list?", "ast"]], - "ast", - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["if", ["=", ["`", "quote"], "a0"], - ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquote"], "a0"], - ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], - ["if", ["=", ["`", "defmacro!"], "a0"], - ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], - ["do", - ["set", "func", ["`", "macro?"], true], - ["env-set", "env", ["nth", "ast", 1], "func"]]], - ["if", ["=", ["`", "macroexpand"], "a0"], - ["macroexpand", ["nth", "ast", 1], "env"], - ["if", ["=", ["`", "do"], "a0"], - ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], - ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], - ["if", ["=", ["`", "if"], "a0"], - ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["or", ["=", "cond", null], ["=", "cond", false]], - ["if", [">", ["count", "ast"], 3], - ["EVAL", ["nth", "ast", 3], "env"], - null], - ["EVAL", ["nth", "ast", 2], "env"]]], - ["if", ["=", ["`", "fn*"], "a0"], - ["malfunc", - ["fn", ["&", "args"], - ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], - ["EVAL", ["nth", "ast", 2], "e"]]], - ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], - ["env-new", ["get", "f", ["`", "env"]], - ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["`", "core.mal: defined using miniMAL"], -["map", ["fn", ["k"], ["env-set", "repl-env", - ["symbol", "k"], - ["get", "core-ns", "k"]]], - ["keys", "core-ns"]], -["env-set", "repl-env", ["symbol", ["`", "eval"]], - ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], -["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "*ARGV*", 1]], - -["`", "core.mal: defined using mal itself"], -["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], -["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"]], -["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], -["rep", ["`", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"]], - -["if", ["not", ["empty?", "*ARGV*"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "*ARGV*", 0], ["`", "\")"]]], - ["repl", ["`", "user> "], "rep"]], - -null - -] diff --git a/miniMAL/step9_try.json b/miniMAL/step9_try.json deleted file mode 100644 index 585a1b0eba..0000000000 --- a/miniMAL/step9_try.json +++ /dev/null @@ -1,168 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], -["load-file", ["`", "core.json"]], - -["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], - -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], - -["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], - ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], - -["def", "macro?", ["fn", ["ast", "env"], - ["and", ["list?", "ast"], - ["symbol?", ["first", "ast"]], - ["not", ["=", null, ["env-find", "env", ["first", "ast"]]]], - ["let", ["fn", ["env-get", "env", ["first", "ast"]]], - ["and", ["malfunc?", "fn"], - ["get", "fn", ["`", "macro?"]]]]]]], - -["def", "macroexpand", ["fn", ["ast", "env"], - ["if", ["macro?", "ast", "env"], - ["let", ["mac", ["get", ["env-get", "env", ["first", "ast"]], ["`", "fn"]]], - ["macroexpand", ["apply", "mac", ["rest", "ast"]], "env"]], - "ast"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["ast", ["macroexpand", "ast", "env"]], - ["if", ["not", ["list?", "ast"]], - "ast", - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["if", ["=", ["`", "quote"], "a0"], - ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquote"], "a0"], - ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], - ["if", ["=", ["`", "defmacro!"], "a0"], - ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], - ["do", - ["set", "func", ["`", "macro?"], true], - ["env-set", "env", ["nth", "ast", 1], "func"]]], - ["if", ["=", ["`", "macroexpand"], "a0"], - ["macroexpand", ["nth", "ast", 1], "env"], - ["if", ["=", ["`", "try*"], "a0"], - ["if", ["=", ["`", "catch*"], - ["get", ["nth", ["nth", "ast", 2], 0], ["`", "val"]]], - ["try", - ["EVAL", ["nth", "ast", 1], "env"], - ["catch", "exc", - ["EVAL", ["nth", ["nth", "ast", 2], 2], - ["env-new", "env", - ["list", ["nth", ["nth", "ast", 2], 1]], - ["list", "exc"]]]]], - ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["=", ["`", "do"], "a0"], - ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], - ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], - ["if", ["=", ["`", "if"], "a0"], - ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["or", ["=", "cond", null], ["=", "cond", false]], - ["if", [">", ["count", "ast"], 3], - ["EVAL", ["nth", "ast", 3], "env"], - null], - ["EVAL", ["nth", "ast", 2], "env"]]], - ["if", ["=", ["`", "fn*"], "a0"], - ["malfunc", - ["fn", ["&", "args"], - ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], - ["EVAL", ["nth", "ast", 2], "e"]]], - ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], - ["env-new", ["get", "f", ["`", "env"]], - ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["`", "core.mal: defined using miniMAL"], -["map", ["fn", ["k"], ["env-set", "repl-env", - ["symbol", "k"], - ["get", "core-ns", "k"]]], - ["keys", "core-ns"]], -["env-set", "repl-env", ["symbol", ["`", "eval"]], - ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], -["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "*ARGV*", 1]], - -["`", "core.mal: defined using mal itself"], -["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], -["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"]], -["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], -["rep", ["`", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"]], - -["if", ["not", ["empty?", "*ARGV*"]], - ["rep", ["str", ["`", "(load-file \""], ["get", "*ARGV*", 0], ["`", "\")"]]], - ["repl", ["`", "user> "], "rep"]], - -null - -] diff --git a/miniMAL/stepA_mal.json b/miniMAL/stepA_mal.json deleted file mode 100644 index 2181d3029e..0000000000 --- a/miniMAL/stepA_mal.json +++ /dev/null @@ -1,171 +0,0 @@ -["do", - -["load-file", ["`", "miniMAL-core.json"]], -["load-file", ["`", "types.json"]], -["load-file", ["`", "reader.json"]], -["load-file", ["`", "printer.json"]], -["load-file", ["`", "env.json"]], -["load-file", ["`", "core.json"]], - -["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], - -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], - -["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], - ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], - -["def", "macro?", ["fn", ["ast", "env"], - ["and", ["list?", "ast"], - ["symbol?", ["first", "ast"]], - ["not", ["=", null, ["env-find", "env", ["first", "ast"]]]], - ["let", ["fn", ["env-get", "env", ["first", "ast"]]], - ["and", ["malfunc?", "fn"], - ["get", "fn", ["`", "macro?"]]]]]]], - -["def", "macroexpand", ["fn", ["ast", "env"], - ["if", ["macro?", "ast", "env"], - ["let", ["mac", ["get", ["env-get", "env", ["first", "ast"]], ["`", "fn"]]], - ["macroexpand", ["apply", "mac", ["rest", "ast"]], "env"]], - "ast"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], - ["if", ["symbol?", "ast"], - ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], - ["if", ["vector?", "ast"], - ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], - ["if", ["map?", "ast"], - ["let", ["new-hm", ["hash-map"]], - ["do", - ["map", ["fn", ["k"], ["set", "new-hm", - ["EVAL", "k", "env"], - ["EVAL", ["get", "ast", "k"], "env"]]], - ["keys", "ast"]], - "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["ast", ["macroexpand", "ast", "env"]], - ["if", ["not", ["list?", "ast"]], - "ast", - ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], - ["if", ["=", ["`", "def!"], "a0"], - ["env-set", "env", ["nth", "ast", 1], - ["EVAL", ["nth", "ast", 2], "env"]], - ["if", ["=", ["`", "let*"], "a0"], - ["let", ["let-env", ["env-new", "env"]], - ["do", - ["LET", "let-env", ["nth", "ast", 1]], - ["EVAL", ["nth", "ast", 2], "let-env"]]], - ["if", ["=", ["`", "quote"], "a0"], - ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquote"], "a0"], - ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], - ["if", ["=", ["`", "defmacro!"], "a0"], - ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], - ["do", - ["set", "func", ["`", "macro?"], true], - ["env-set", "env", ["nth", "ast", 1], "func"]]], - ["if", ["=", ["`", "macroexpand"], "a0"], - ["macroexpand", ["nth", "ast", 1], "env"], - ["if", ["=", ["`", "try*"], "a0"], - ["if", ["=", ["`", "catch*"], - ["get", ["nth", ["nth", "ast", 2], 0], ["`", "val"]]], - ["try", - ["EVAL", ["nth", "ast", 1], "env"], - ["catch", "exc", - ["EVAL", ["nth", ["nth", "ast", 2], 2], - ["env-new", "env", - ["list", ["nth", ["nth", "ast", 2], 1]], - ["list", "exc"]]]]], - ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["=", ["`", "do"], "a0"], - ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], - ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], - ["if", ["=", ["`", "if"], "a0"], - ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], - ["if", ["or", ["=", "cond", null], ["=", "cond", false]], - ["if", [">", ["count", "ast"], 3], - ["EVAL", ["nth", "ast", 3], "env"], - null], - ["EVAL", ["nth", "ast", 2], "env"]]], - ["if", ["=", ["`", "fn*"], "a0"], - ["malfunc", - ["fn", ["&", "args"], - ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], - ["EVAL", ["nth", "ast", 2], "e"]]], - ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], - ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], - ["env-new", ["get", "f", ["`", "env"]], - ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]], - -["def", "PRINT", ["fn", ["exp"], - ["pr-str", "exp", true]]], - - -["def", "repl-env", ["env-new"]], - -["def", "rep", ["fn", ["strng"], - ["try", - ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], - ["catch", "exc", - ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], - -["`", "core.mal: defined using miniMAL"], -["map", ["fn", ["k"], ["env-set", "repl-env", - ["symbol", "k"], - ["get", "core-ns", "k"]]], - ["keys", "core-ns"]], -["env-set", "repl-env", ["symbol", ["`", "eval"]], - ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], -["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], - ["slice", "*ARGV*", 1]], - -["`", "core.mal: defined using mal itself"], -["rep", ["`", "(def! *host-language* \"miniMAL\")"]], -["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], -["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"]], -["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], -["rep", ["`", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"]], - -["if", ["not", ["empty?", "*ARGV*"]], - ["println", ["rep", ["str", ["`", "(load-file \""], ["get", "*ARGV*", 0], ["`", "\")"]]]], - ["do", - ["rep", ["`", "(println (str \"Mal [\" *host-language* \"]\"))"]], - ["repl", ["`", "user> "], "rep"]]], - -null - -] diff --git a/nim/Makefile b/nim/Makefile deleted file mode 100644 index e8c450e815..0000000000 --- a/nim/Makefile +++ /dev/null @@ -1,33 +0,0 @@ -##################### - -SOURCES_BASE = types.nim reader.nim printer.nim -SOURCES_LISP = env.nim core.nim stepA_mal.nim -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -##################### - -SRCS = step0_repl.nim step1_read_print.nim step2_eval.nim step3_env.nim \ - step4_if_fn_do.nim step5_tco.nim step6_file.nim step7_quote.nim \ - step8_macros.nim step9_try.nim stepA_mal.nim -BINS = $(SRCS:%.nim=%) - -##################### - -all: $(BINS) mal - -mal: $(word $(words $(BINS)),$(BINS)) - cp $< $@ - -$(BINS): %: %.nim - nim -d:release c $@ - -clean: - rm -rf nimcache/ $(BINS) - rm -f mal - -.PHONY: stats stats-lisp - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/nim/env.nim b/nim/env.nim deleted file mode 100644 index 7432d09b15..0000000000 --- a/nim/env.nim +++ /dev/null @@ -1,25 +0,0 @@ -import tables, types - -proc initEnv*(outer: Env = nil, binds, exprs: MalType = nilObj): Env = - result = Env(data: initTable[string, MalType](), outer: outer) - - if binds.kind in {List, Vector}: - for i, e in binds.list: - if e.str == "&": - result.data[binds.list[i+1].str] = list(exprs.list[i .. -1]) - break - else: - result.data[e.str] = exprs.list[i] - -proc set*(e: var Env, key: string, value: MalType): MalType {.discardable.} = - e.data[key] = value - value - -proc find*(e: Env, key: string): Env = - if e.data.hasKey(key): return e - if e.outer != nil: return e.outer.find(key) - -proc get*(e: Env, key: string): MalType = - let env = e.find(key) - if env == nil: raise newException(ValueError, "'" & key & "' not found") - env.data[key] diff --git a/nim/nim.cfg b/nim/nim.cfg deleted file mode 100644 index dbf197acec..0000000000 --- a/nim/nim.cfg +++ /dev/null @@ -1,2 +0,0 @@ -deadCodeElim: off -gc: markandsweep diff --git a/nim/reader.nim b/nim/reader.nim deleted file mode 100644 index 10fce10ffb..0000000000 --- a/nim/reader.nim +++ /dev/null @@ -1,108 +0,0 @@ -import nre, optional_t, strutils, types - -let - tokenRE = re"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)""" - intRE = re"-?[0-9]+$" - -type - Blank* = object of Exception - - Reader = object - tokens: seq[string] - position: int - -proc next(r: var Reader): string = - if r.position >= r.tokens.len: - result = nil - else: - result = r.tokens[r.position] - inc r.position - -proc peek(r: Reader): string = - if r.position >= r.tokens.len: nil - else: r.tokens[r.position] - -proc tokenize(str: string): seq[string] = - result = @[] - for match in str.findIter(tokenRE): - if match.captures[0][0] != ';': - result.add match.captures[0] - -proc read_form(r: var Reader): MalType - -proc read_seq(r: var Reader, fr, to: string): seq[MalType] = - result = @[] - var t = r.next - if t != fr: raise newException(ValueError, "expected '" & fr & "'") - - t = r.peek - while t != to: - if t == nil: raise newException(ValueError, "expected '" & to & "', got EOF") - result.add r.read_form - t = r.peek - discard r.next - -proc read_list(r: var Reader): MalType = - result = list r.read_seq("(", ")") - -proc read_vector(r: var Reader): MalType = - result = vector r.read_seq("[", "]") - -proc read_hash_map(r: var Reader): MalType = - result = hash_map r.read_seq("{", "}") - -proc read_atom(r: var Reader): MalType = - let t = r.next - if t.match(intRE): number t.parseInt - elif t[0] == '"': str t[1 .. ") - echo line.rep - except: - echo getCurrentExceptionMsg() diff --git a/nim/step3_env.nim b/nim/step3_env.nim deleted file mode 100644 index 98438fe80c..0000000000 --- a/nim/step3_env.nim +++ /dev/null @@ -1,70 +0,0 @@ -import rdstdin, tables, sequtils, types, reader, printer, env - -proc read(str: string): MalType = str.read_str - -proc eval(ast: MalType, env: var Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: var Env): MalType = - case ast.kind - of List: - let - a0 = ast.list[0] - a1 = ast.list[1] - a2 = ast.list[2] - - case a0.str - of "def!": - result = env.set(a1.str, a2.eval(env)) - of "let*": - var letEnv: Env - letEnv.deepCopy(env) - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - letEnv.set(a1.list[i].str, a1.list[i+1].eval(letEnv)) - else: discard - result = a2.eval(letEnv) - else: - let el = ast.eval_ast(env) - result = el.list[0].fun(el.list[1 .. -1]) - else: - result = ast.eval_ast(env) - -proc print(exp: MalType): string = exp.pr_str - -template wrapNumberFun(op: expr): expr = - fun proc(xs: varargs[MalType]): MalType = number op(xs[0].number, xs[1].number) - -var repl_env = initEnv() - -repl_env.set("+", wrapNumberFun(`+`)) -repl_env.set("-", wrapNumberFun(`-`)) -repl_env.set("*", wrapNumberFun(`*`)) -repl_env.set("/", wrapNumberFun(`div`)) -#repl_env.set("/", wrapNumberFun(proc(x,y: int): int = int(x.float / y.float))) - -proc rep(str: string): string = - str.read.eval(repl_env).print - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/nim/step4_if_fn_do.nim b/nim/step4_if_fn_do.nim deleted file mode 100644 index a4a8dd18ab..0000000000 --- a/nim/step4_if_fn_do.nim +++ /dev/null @@ -1,104 +0,0 @@ -import rdstdin, tables, sequtils, types, reader, printer, env, core - -proc read(str: string): MalType = str.read_str - -proc eval(ast: MalType, env: var Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: var Env): MalType = - case ast.kind - of List: - let a0 = ast.list[0] - case a0.kind - of Symbol: - case a0.str - of "def!": - let - a1 = ast.list[1] - a2 = ast.list[2] - result = env.set(a1.str, a2.eval(env)) - - of "let*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var letEnv: Env - letEnv.deepCopy(env) - - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - letEnv.set(a1.list[i].str, a1.list[i+1].eval(letEnv)) - else: discard - result = a2.eval(letEnv) - - of "do": - let el = (list ast.list[1 .. -1]).eval_ast(env) - result = el.list[el.list.high] - - of "if": - let - a1 = ast.list[1] - a2 = ast.list[2] - cond = a1.eval(env) - - if cond.kind in {Nil, False}: - if ast.list.len > 3: result = ast.list[3].eval(env) - else: result = nilObj - else: result = a2.eval(env) - - of "fn*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var env2 = env - result = fun(proc(a: varargs[MalType]): MalType = - var newEnv = initEnv(env2, a1, list(a)) - a2.eval(newEnv)) - - else: - let el = ast.eval_ast(env) - result = el.list[0].fun(el.list[1 .. -1]) - - else: - let el = ast.eval_ast(env) - result = el.list[0].fun(el.list[1 .. -1]) - - else: - result = ast.eval_ast(env) - -proc print(exp: MalType): string = exp.pr_str - -var repl_env = initEnv() - -for k, v in ns.items: - repl_env.set(k, v) - -# core.nim: defined using nim -proc rep(str: string): string = - str.read.eval(repl_env).print - -# core.mal: defined using mal itself -discard rep "(def! not (fn* (a) (if a false true)))" - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/nim/step5_tco.nim b/nim/step5_tco.nim deleted file mode 100644 index bbbb160e67..0000000000 --- a/nim/step5_tco.nim +++ /dev/null @@ -1,115 +0,0 @@ -import rdstdin, tables, sequtils, types, reader, printer, env, core - -proc read(str: string): MalType = str.read_str - -proc eval(ast: MalType, env: var Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: var Env): MalType = - var ast = ast - - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. -1])) - else: - return f.fun(el.list[1 .. -1]) - - while true: - if ast.kind != List: return ast.eval_ast(env) - - let a0 = ast.list[0] - case a0.kind - of Symbol: - case a0.str - of "def!": - let - a1 = ast.list[1] - a2 = ast.list[2] - return env.set(a1.str, a2.eval(env)) - - of "let*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var let_env = Env(env) - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) - else: raise newException(ValueError, "Illegal kind in let*") - ast = a2 - env = let_env - # Continue loop (TCO) - - of "do": - let last = ast.list.high - let el = (list ast.list[1 .. 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 - - of "fn*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var env2 = env - let fn = proc(a: varargs[MalType]): MalType = - var newEnv = initEnv(env2, a1, list(a)) - a2.eval(newEnv) - return malfun(fn, a2, a1, env) - - else: - defaultApply() - - else: - defaultApply() - -proc print(exp: MalType): string = exp.pr_str - -var repl_env = initEnv() - -for k, v in ns.items: - repl_env.set(k, v) - -# core.nim: defined using nim -proc rep(str: string): string = - str.read.eval(repl_env).print - -# core.mal: defined using mal itself -discard rep "(def! not (fn* (a) (if a false true)))" - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/nim/step6_file.nim b/nim/step6_file.nim deleted file mode 100644 index a0a569ed4e..0000000000 --- a/nim/step6_file.nim +++ /dev/null @@ -1,125 +0,0 @@ -import rdstdin, tables, sequtils, os, types, reader, printer, env, core - -proc read(str: string): MalType = str.read_str - -proc eval(ast: MalType, env: var Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: var Env): MalType = - var ast = ast - - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. -1])) - else: - return f.fun(el.list[1 .. -1]) - - while true: - if ast.kind != List: return ast.eval_ast(env) - - let a0 = ast.list[0] - case a0.kind - of Symbol: - case a0.str - of "def!": - let - a1 = ast.list[1] - a2 = ast.list[2] - return env.set(a1.str, a2.eval(env)) - - of "let*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var let_env = Env(env) - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) - else: raise newException(ValueError, "Illegal kind in let*") - ast = a2 - env = let_env - # Continue loop (TCO) - - of "do": - let last = ast.list.high - let el = (list ast.list[1 .. 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 - - of "fn*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var env2 = env - let fn = proc(a: varargs[MalType]): MalType = - var newEnv = initEnv(env2, a1, list(a)) - a2.eval(newEnv) - return malfun(fn, a2, a1, env) - - else: - defaultApply() - - else: - defaultApply() - -proc print(exp: MalType): string = exp.pr_str - -var repl_env = initEnv() - -for k, v in ns.items: - repl_env.set(k, v) -repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) -var ps = commandLineParams() -repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) - - -# core.nim: defined using nim -proc rep(str: string): string {.discardable.} = - str.read.eval(repl_env).print - -# core.mal: defined using mal itself -rep "(def! not (fn* (a) (if a false true)))" -rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - -if paramCount() >= 1: - rep "(load-file \"" & paramStr(1) & "\")" - quit() - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except Blank: discard - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/nim/step7_quote.nim b/nim/step7_quote.nim deleted file mode 100644 index 848913d49e..0000000000 --- a/nim/step7_quote.nim +++ /dev/null @@ -1,146 +0,0 @@ -import rdstdin, tables, sequtils, os, types, reader, printer, env, core - -proc read(str: string): MalType = str.read_str - -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 - -proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. -1])) - else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. -1]))) - -proc eval(ast: MalType, env: var Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: var Env): MalType = - var ast = ast - - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. -1])) - else: - return f.fun(el.list[1 .. -1]) - - while true: - if ast.kind != List: return ast.eval_ast(env) - - let a0 = ast.list[0] - case a0.kind - of Symbol: - case a0.str - of "def!": - let - a1 = ast.list[1] - a2 = ast.list[2] - return env.set(a1.str, a2.eval(env)) - - of "let*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var let_env = Env(env) - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) - else: raise newException(ValueError, "Illegal kind in let*") - ast = a2 - env = let_env - # Continue loop (TCO) - - of "quote": - return ast.list[1] - - of "quasiquote": - ast = ast.list[1].quasiquote - # Continue loop (TCO) - - of "do": - let last = ast.list.high - let el = (list ast.list[1 .. 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 - - of "fn*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var env2 = env - let fn = proc(a: varargs[MalType]): MalType = - var newEnv = initEnv(env2, a1, list(a)) - a2.eval(newEnv) - return malfun(fn, a2, a1, env) - - else: - defaultApply() - - else: - defaultApply() - -proc print(exp: MalType): string = exp.pr_str - -var repl_env = initEnv() - -for k, v in ns.items: - repl_env.set(k, v) -repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) -var ps = commandLineParams() -repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) - - -# core.nim: defined using nim -proc rep(str: string): string {.discardable.} = - str.read.eval(repl_env).print - -# core.mal: defined using mal itself -rep "(def! not (fn* (a) (if a false true)))" -rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - -if paramCount() >= 1: - rep "(load-file \"" & paramStr(1) & "\")" - quit() - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except Blank: discard - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/nim/step8_macros.nim b/nim/step8_macros.nim deleted file mode 100644 index 96981a76a0..0000000000 --- a/nim/step8_macros.nim +++ /dev/null @@ -1,171 +0,0 @@ -import rdstdin, tables, sequtils, os, types, reader, printer, env, core - -proc read(str: string): MalType = str.read_str - -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 - -proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. -1])) - else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. -1]))) - -proc is_macro_call(ast: MalType, env: Env): bool = - ast.kind == List and ast.list[0].kind == Symbol and - env.find(ast.list[0].str) != nil and env.get(ast.list[0].str).macro_q - -proc macroexpand(ast: MalType, env: Env): MalType = - result = ast - while result.is_macro_call(env): - let mac = env.get(result.list[0].str) - result = mac.malfun.fn(result.list[1 .. -1]).macroexpand(env) - -proc eval(ast: MalType, env: Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: Env): MalType = - var ast = ast - var env = env - - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. -1])) - else: - return f.fun(el.list[1 .. -1]) - - while true: - if ast.kind != List: return ast.eval_ast(env) - - ast = ast.macroexpand(env) - if ast.kind != List: return ast - if ast.list.len == 0: return ast - - let a0 = ast.list[0] - case a0.kind - of Symbol: - case a0.str - of "def!": - let - a1 = ast.list[1] - a2 = ast.list[2] - return env.set(a1.str, a2.eval(env)) - - of "let*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var let_env = Env(env) - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) - else: raise newException(ValueError, "Illegal kind in let*") - ast = a2 - env = let_env - # Continue loop (TCO) - - of "quote": - return ast.list[1] - - of "quasiquote": - ast = ast.list[1].quasiquote - # Continue loop (TCO) - - of "defmacro!": - var fun = ast.list[2].eval(env) - fun.malfun.is_macro = true - return env.set(ast.list[1].str, fun) - - of "macroexpand": - return ast.list[1].macroexpand(env) - - of "do": - let last = ast.list.high - let el = (list ast.list[1 .. 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 - - of "fn*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var env2 = env - let fn = proc(a: varargs[MalType]): MalType = - var newEnv = initEnv(env2, a1, list(a)) - a2.eval(newEnv) - return malfun(fn, a2, a1, env) - - else: - defaultApply() - - else: - defaultApply() - -proc print(exp: MalType): string = exp.pr_str - -var repl_env = initEnv() - -for k, v in ns.items: - repl_env.set(k, v) -repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) -var ps = commandLineParams() -repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) - - -# core.nim: defined using nim -proc rep(str: string): string {.discardable.} = - str.read.eval(repl_env).print - -# core.mal: defined using mal itself -rep "(def! not (fn* (a) (if a false true)))" -rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - -if paramCount() >= 1: - rep "(load-file \"" & paramStr(1) & "\")" - quit() - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except Blank: discard - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/nim/step9_try.nim b/nim/step9_try.nim deleted file mode 100644 index 6d77ac7aae..0000000000 --- a/nim/step9_try.nim +++ /dev/null @@ -1,190 +0,0 @@ -import rdstdin, tables, sequtils, os, types, reader, printer, env, core - -proc read(str: string): MalType = str.read_str - -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 - -proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. -1])) - else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. -1]))) - -proc is_macro_call(ast: MalType, env: Env): bool = - ast.kind == List and ast.list[0].kind == Symbol and - env.find(ast.list[0].str) != nil and env.get(ast.list[0].str).macro_q - -proc macroexpand(ast: MalType, env: Env): MalType = - result = ast - while result.is_macro_call(env): - let mac = env.get(result.list[0].str) - result = mac.malfun.fn(result.list[1 .. -1]).macroexpand(env) - -proc eval(ast: MalType, env: Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: Env): MalType = - var ast = ast - var env = env - - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. -1])) - else: - return f.fun(el.list[1 .. -1]) - - while true: - if ast.kind != List: return ast.eval_ast(env) - - ast = ast.macroexpand(env) - if ast.kind != List: return ast - if ast.list.len == 0: return ast - - let a0 = ast.list[0] - case a0.kind - of Symbol: - case a0.str - of "def!": - let - a1 = ast.list[1] - a2 = ast.list[2] - res = a2.eval(env) - return env.set(a1.str, res) - - of "let*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var let_env = Env(env) - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) - else: raise newException(ValueError, "Illegal kind in let*") - ast = a2 - env = let_env - # Continue loop (TCO) - - of "quote": - return ast.list[1] - - of "quasiquote": - ast = ast.list[1].quasiquote - # Continue loop (TCO) - - of "defmacro!": - var fun = ast.list[2].eval(env) - fun.malfun.is_macro = true - return env.set(ast.list[1].str, fun) - - of "macroexpand": - return ast.list[1].macroexpand(env) - - of "try*": - let - a1 = ast.list[1] - a2 = ast.list[2] - if a2.list[0].str == "catch*": - try: - return a1.eval(env) - except MalError: - let exc = (ref MalError) getCurrentException() - var catchEnv = initEnv(env, list a2.list[1], exc.t) - return a2.list[2].eval(catchEnv) - except: - let exc = getCurrentExceptionMsg() - var catchEnv = initEnv(env, list a2.list[1], list str(exc)) - return a2.list[2].eval(catchEnv) - else: - return a1.eval(env) - - of "do": - let last = ast.list.high - let el = (list ast.list[1 .. 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 - - of "fn*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var env2 = env - let fn = proc(a: varargs[MalType]): MalType = - var newEnv = initEnv(env2, a1, list(a)) - a2.eval(newEnv) - return malfun(fn, a2, a1, env) - - else: - defaultApply() - - else: - defaultApply() - -proc print(exp: MalType): string = exp.pr_str - -var repl_env = initEnv() - -for k, v in ns.items: - repl_env.set(k, v) -repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) -var ps = commandLineParams() -repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) - - -# core.nim: defined using nim -proc rep(str: string): string {.discardable.} = - str.read.eval(repl_env).print - -# core.mal: defined using mal itself -rep "(def! not (fn* (a) (if a false true)))" -rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" - -if paramCount() >= 1: - rep "(load-file \"" & paramStr(1) & "\")" - quit() - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except Blank: discard - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/nim/stepA_mal.nim b/nim/stepA_mal.nim deleted file mode 100644 index b138bd9f48..0000000000 --- a/nim/stepA_mal.nim +++ /dev/null @@ -1,191 +0,0 @@ -import rdstdin, tables, sequtils, os, types, reader, printer, env, core - -proc read(str: string): MalType = str.read_str - -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 - -proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. -1])) - else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. -1]))) - -proc is_macro_call(ast: MalType, env: Env): bool = - ast.kind == List and ast.list.len > 0 and ast.list[0].kind == Symbol and - env.find(ast.list[0].str) != nil and env.get(ast.list[0].str).macro_q - -proc macroexpand(ast: MalType, env: Env): MalType = - result = ast - while result.is_macro_call(env): - let mac = env.get(result.list[0].str) - result = mac.malfun.fn(result.list[1 .. -1]).macroexpand(env) - -proc eval(ast: MalType, env: Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(MalType, it.eval(env)) - of Vector: - result = vector ast.list.mapIt(MalType, it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - -proc eval(ast: MalType, env: Env): MalType = - var ast = ast - var env = env - - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. -1])) - else: - return f.fun(el.list[1 .. -1]) - - while true: - if ast.kind != List: return ast.eval_ast(env) - - ast = ast.macroexpand(env) - if ast.kind != List: return ast - if ast.list.len == 0: return ast - - let a0 = ast.list[0] - case a0.kind - of Symbol: - case a0.str - of "def!": - let - a1 = ast.list[1] - a2 = ast.list[2] - res = a2.eval(env) - return env.set(a1.str, res) - - of "let*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var let_env = Env(env) - case a1.kind - of List, Vector: - for i in countup(0, a1.list.high, 2): - let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) - else: raise newException(ValueError, "Illegal kind in let*") - ast = a2 - env = let_env - # Continue loop (TCO) - - of "quote": - return ast.list[1] - - of "quasiquote": - ast = ast.list[1].quasiquote - # Continue loop (TCO) - - of "defmacro!": - var fun = ast.list[2].eval(env) - fun.malfun.is_macro = true - return env.set(ast.list[1].str, fun) - - of "macroexpand": - return ast.list[1].macroexpand(env) - - of "try*": - let - a1 = ast.list[1] - a2 = ast.list[2] - if a2.list[0].str == "catch*": - try: - return a1.eval(env) - except MalError: - let exc = (ref MalError) getCurrentException() - var catchEnv = initEnv(env, list a2.list[1], exc.t) - return a2.list[2].eval(catchEnv) - except: - let exc = getCurrentExceptionMsg() - var catchEnv = initEnv(env, list a2.list[1], list str(exc)) - return a2.list[2].eval(catchEnv) - else: - return a1.eval(env) - - of "do": - let last = ast.list.high - let el = (list ast.list[1 .. 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 - - of "fn*": - let - a1 = ast.list[1] - a2 = ast.list[2] - var env2 = env - let fn = proc(a: varargs[MalType]): MalType = - var newEnv = initEnv(env2, a1, list(a)) - a2.eval(newEnv) - return malfun(fn, a2, a1, env) - - else: defaultApply() - - else: defaultApply() - -proc print(exp: MalType): string = exp.pr_str - -var repl_env = initEnv() - -for k, v in ns.items: - repl_env.set(k, v) -repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) -var ps = commandLineParams() -repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) - - -# core.nim: defined using nim -proc rep(str: string): string {.discardable.} = - str.read.eval(repl_env).print - -# core.mal: defined using mal itself -rep "(def! not (fn* (a) (if a false true)))" -rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" -rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" -rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" -rep "(def! *host-language* \"nim\")" - -if paramCount() >= 1: - rep "(load-file \"" & paramStr(1) & "\")" - quit() - -rep "(println (str \"Mal [\" *host-language* \"]\"))" - -while true: - try: - let line = readLineFromStdin("user> ") - echo line.rep - except Blank: discard - except: - echo getCurrentExceptionMsg() - echo getCurrentException().getStackTrace() diff --git a/ocaml/Makefile b/ocaml/Makefile deleted file mode 100644 index 9245dd5bf8..0000000000 --- a/ocaml/Makefile +++ /dev/null @@ -1,37 +0,0 @@ -STEPS = step0_repl.ml step1_read_print.ml step2_eval.ml step3_env.ml \ - step4_if_fn_do.ml step5_tco.ml step6_file.ml step7_quote.ml \ - step8_macros.ml step9_try.ml stepA_mal.ml -MODULES = types.ml reader.ml printer.ml env.ml core.ml -LIBS = str.cmxa unix.cmxa -MAL_LIB = mal_lib.cmxa - -STEP_BINS = $(STEPS:%.ml=%) -LAST_STEP_BIN = $(word $(words $(STEP_BINS)),$(STEP_BINS)) - -all: $(STEP_BINS) mal - -mal: $(LAST_STEP_BIN) - cp $< $@ - -# ocaml repl apparently needs bytecode, not native, compilation. -# Just do it all right here: -repl: - ocamlc -c $(LIBS:%.cmxa=%.cma) $(MODULES) $(STEPS) - rlwrap ocaml $(LIBS:%.cmxa=%.cma) $(MODULES:%.ml=%.cmo) - -$(MAL_LIB): $(MODULES) - ocamlopt -a $(MODULES) -o $@ - -$(STEP_BINS): %: %.ml $(MAL_LIB) - ocamlopt $(LIBS) $(MAL_LIB) $< -o $@ - -clean: - rm -f $(STEP_BINS) mal mal_lib.* *.cmo *.cmx *.cmi *.o - -stats: $(MODULES) stepA_mal.ml - @wc $^ - -stats-lisp: env.ml core.ml stepA_mal.ml - @wc $^ - -.PHONY: all repl clean stats stats-lisp diff --git a/ocaml/core.ml b/ocaml/core.ml deleted file mode 100644 index 12bf3c33ef..0000000000 --- a/ocaml/core.ml +++ /dev/null @@ -1,206 +0,0 @@ -module T = Types.Types -let ns = Env.make None - -let num_fun t f = Types.fn - (function - | [(T.Int a); (T.Int b)] -> t (f a b) - | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) - -let mk_int x = T.Int x -let mk_bool x = T.Bool x - -let seq = function - | T.List { T.value = xs } -> xs - | T.Vector { T.value = xs } -> xs - | T.Map { T.value = xs } -> - Types.MalMap.fold (fun k v list -> k :: v :: list) xs [] - | _ -> [] - -let rec assoc = function - | c :: k :: v :: (_ :: _ as xs) -> assoc ((assoc [c; k; v]) :: xs) - | [T.Nil; k; v] -> Types.map (Types.MalMap.add k v Types.MalMap.empty) - | [T.Map { T.value = m; T.meta = meta }; k; v] - -> T.Map { T.value = (Types.MalMap.add k v m); - T.meta = meta } - | _ -> T.Nil - -let rec dissoc = function - | c :: x :: (_ :: _ as xs) -> dissoc ((dissoc [c; x]) :: xs) - | [T.Map { T.value = m; T.meta = meta }; k] - -> T.Map { T.value = (Types.MalMap.remove k m); - T.meta = meta } - | _ -> T.Nil - -let rec conj = function - | c :: x :: (_ :: _ as xs) -> conj ((conj [c; x]) :: xs) - | [T.Map { T.value = c; T.meta = meta }; T.Vector { T.value = [k; v] }] - -> T.Map { T.value = (Types.MalMap.add k v c); - T.meta = meta } - | [T.List { T.value = c; T.meta = meta }; x ] - -> T.List { T.value = x :: c; - T.meta = meta } - | [T.Vector { T.value = c; T.meta = meta }; x ] - -> T.Vector { T.value = c @ [x]; - T.meta = meta } - | _ -> T.Nil - -let init env = begin - Env.set env (Types.symbol "throw") - (Types.fn (function [ast] -> raise (Types.MalExn ast) | _ -> T.Nil)); - - Env.set env (Types.symbol "+") (num_fun mk_int ( + )); - Env.set env (Types.symbol "-") (num_fun mk_int ( - )); - Env.set env (Types.symbol "*") (num_fun mk_int ( * )); - Env.set env (Types.symbol "/") (num_fun mk_int ( / )); - Env.set env (Types.symbol "<") (num_fun mk_bool ( < )); - Env.set env (Types.symbol "<=") (num_fun mk_bool ( <= )); - Env.set env (Types.symbol ">") (num_fun mk_bool ( > )); - Env.set env (Types.symbol ">=") (num_fun mk_bool ( >= )); - - Env.set env (Types.symbol "list") (Types.fn (function xs -> Types.list xs)); - Env.set env (Types.symbol "list?") - (Types.fn (function [T.List _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "vector") (Types.fn (function xs -> Types.vector xs)); - Env.set env (Types.symbol "vector?") - (Types.fn (function [T.Vector _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "empty?") - (Types.fn (function - | [T.List {T.value = []}] -> T.Bool true - | [T.Vector {T.value = []}] -> T.Bool true - | _ -> T.Bool false)); - Env.set env (Types.symbol "count") - (Types.fn (function - | [T.List {T.value = xs}] - | [T.Vector {T.value = xs}] -> T.Int (List.length xs) - | _ -> T.Int 0)); - Env.set env (Types.symbol "=") - (Types.fn (function - | [T.List a; T.Vector b] -> T.Bool (a = b) - | [T.Vector a; T.List b] -> T.Bool (a = b) - | [a; b] -> T.Bool (a = b) - | _ -> T.Bool false)); - - Env.set env (Types.symbol "pr-str") - (Types.fn (function xs -> - T.String (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)))); - Env.set env (Types.symbol "str") - (Types.fn (function xs -> - T.String (String.concat "" (List.map (fun s -> Printer.pr_str s false) xs)))); - Env.set env (Types.symbol "prn") - (Types.fn (function xs -> - print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)); - T.Nil)); - Env.set env (Types.symbol "println") - (Types.fn (function xs -> - print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s false) xs)); - T.Nil)); - - Env.set env (Types.symbol "compare") - (Types.fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil)); - Env.set env (Types.symbol "with-meta") - (Types.fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil)); - Env.set env (Types.symbol "meta") - (Types.fn (function [x] -> Printer.meta x | _ -> T.Nil)); - - Env.set env (Types.symbol "read-string") - (Types.fn (function [T.String x] -> Reader.read_str x | _ -> T.Nil)); - Env.set env (Types.symbol "slurp") - (Types.fn (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil)); - - Env.set env (Types.symbol "cons") - (Types.fn (function [x; xs] -> Types.list (x :: (seq xs)) | _ -> T.Nil)); - Env.set env (Types.symbol "concat") - (Types.fn (let rec concat = - function - | x :: y :: more -> concat ((Types.list ((seq x) @ (seq y))) :: more) - | [x] -> x - | [] -> Types.list [] - in concat)); - - Env.set env (Types.symbol "nth") - (Types.fn (function [xs; T.Int i] -> List.nth (seq xs) i | _ -> T.Nil)); - Env.set env (Types.symbol "first") - (Types.fn (function - | [xs] -> (match seq xs with x :: _ -> x | _ -> T.Nil) - | _ -> T.Nil)); - Env.set env (Types.symbol "rest") - (Types.fn (function - | [xs] -> Types.list (match seq xs with _ :: xs -> xs | _ -> []) - | _ -> T.Nil)); - - Env.set env (Types.symbol "symbol") - (Types.fn (function [T.String x] -> Types.symbol x | _ -> T.Nil)); - Env.set env (Types.symbol "symbol?") - (Types.fn (function [T.Symbol _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "keyword") - (Types.fn (function [T.String x] -> T.Keyword x | _ -> T.Nil)); - Env.set env (Types.symbol "keyword?") - (Types.fn (function [T.Keyword _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "nil?") - (Types.fn (function [T.Nil] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "true?") - (Types.fn (function [T.Bool true] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "false?") - (Types.fn (function [T.Bool false] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "sequential?") - (Types.fn (function [T.List _] | [T.Vector _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "apply") - (Types.fn (function - | (T.Fn { T.value = f } :: apply_args) -> - (match List.rev apply_args with - | last_arg :: rev_args -> - f ((List.rev rev_args) @ (seq last_arg)) - | [] -> f []) - | _ -> raise (Invalid_argument "First arg to apply must be a fn"))); - Env.set env (Types.symbol "map") - (Types.fn (function - | [T.Fn { T.value = f }; xs] -> - Types.list (List.map (fun x -> f [x]) (seq xs)) - | _ -> T.Nil)); - Env.set env (Types.symbol "readline") - (Types.fn (function - | [T.String x] -> print_string x; T.String (read_line ()) - | _ -> T.String (read_line ()))); - - Env.set env (Types.symbol "map?") - (Types.fn (function [T.Map _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "hash-map") - (Types.fn (function xs -> Types.list_into_map Types.MalMap.empty xs)); - Env.set env (Types.symbol "assoc") (Types.fn assoc); - Env.set env (Types.symbol "dissoc") (Types.fn dissoc); - Env.set env (Types.symbol "get") - (Types.fn (function - | [T.Map { T.value = m }; k] - -> (try Types.MalMap.find k m with _ -> T.Nil) - | _ -> T.Nil)); - Env.set env (Types.symbol "keys") - (Types.fn (function - | [T.Map { T.value = m }] - -> Types.list (Types.MalMap.fold (fun k _ c -> k :: c) m []) - | _ -> T.Nil)); - Env.set env (Types.symbol "vals") - (Types.fn (function - | [T.Map { T.value = m }] - -> Types.list (Types.MalMap.fold (fun _ v c -> v :: c) m []) - | _ -> T.Nil)); - Env.set env (Types.symbol "contains?") - (Types.fn (function - | [T.Map { T.value = m }; k] -> T.Bool (Types.MalMap.mem k m) - | _ -> T.Bool false)); - Env.set env (Types.symbol "conj") (Types.fn conj); - - Env.set env (Types.symbol "atom?") - (Types.fn (function [T.Atom _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "atom") - (Types.fn (function [x] -> T.Atom (ref x) | _ -> T.Nil)); - Env.set env (Types.symbol "deref") - (Types.fn (function [T.Atom x] -> !x | _ -> T.Nil)); - Env.set env (Types.symbol "reset!") - (Types.fn (function [T.Atom x; v] -> x := v; v | _ -> T.Nil)); - Env.set env (Types.symbol "swap!") - (Types.fn (function T.Atom x :: T.Fn { T.value = f } :: args - -> let v = f (!x :: args) in x := v; v | _ -> T.Nil)); - - Env.set env (Types.symbol "time-ms") - (Types.fn (function _ -> T.Int (truncate (1000.0 *. Unix.gettimeofday ())))); -end diff --git a/ocaml/env.ml b/ocaml/env.ml deleted file mode 100644 index cb32360eb0..0000000000 --- a/ocaml/env.ml +++ /dev/null @@ -1,33 +0,0 @@ -module T = Types.Types -module Data = Map.Make (String) - -type env = { - outer : env option; - data : Types.mal_type Data.t ref; -} - -let make outer = { outer = outer; data = ref Data.empty } - -let set env sym value = - match sym with - | T.Symbol { T.value = key } -> env.data := Data.add key value !(env.data) - | _ -> raise (Invalid_argument "set requires a Symbol for its key") - -let rec find env sym = - match sym with - | T.Symbol { T.value = key } -> - (if Data.mem key !(env.data) then - Some env - else - match env.outer with - | Some outer -> find outer sym - | None -> None) - | _ -> raise (Invalid_argument "find requires a Symbol for its key") - -let get env sym = - match sym with - | T.Symbol { T.value = key } -> - (match find env sym with - | Some found_env -> Data.find key !(found_env.data) - | None -> raise (Invalid_argument ("'" ^ key ^ "' not found"))) - | _ -> raise (Invalid_argument "get requires a Symbol for its key") diff --git a/ocaml/printer.ml b/ocaml/printer.ml deleted file mode 100644 index 135c3cee03..0000000000 --- a/ocaml/printer.ml +++ /dev/null @@ -1,38 +0,0 @@ -module T = Types.Types - -let meta obj = - match obj with - | T.List { T.meta = meta } -> meta - | T.Map { T.meta = meta } -> meta - | T.Vector { T.meta = meta } -> meta - | T.Symbol { T.meta = meta } -> meta - | T.Fn { T.meta = meta } -> meta - | _ -> T.Nil - -let rec pr_str mal_obj print_readably = - let r = print_readably in - match mal_obj with - | T.Int i -> string_of_int i - | T.Symbol { T.value = s } -> s - | T.Keyword s -> ":" ^ s - | T.Nil -> "nil" - | T.Bool true -> "true" - | T.Bool false -> "false" - | T.String s -> - if r - then "\"" ^ (Reader.gsub (Str.regexp "\\([\"\\\n]\\)") - (function - | "\n" -> "\\n" - | x -> "\\" ^ x) - s) ^ "\"" - else s - | T.List { T.value = xs } -> - "(" ^ (String.concat " " (List.map (fun s -> pr_str s r) xs)) ^ ")" - | T.Vector { T.value = xs } -> - "[" ^ (String.concat " " (List.map (fun s -> pr_str s r) xs)) ^ "]" - | T.Map { T.value = xs } -> - "{" ^ (Types.MalMap.fold (fun k v s -> s ^ (if s = "" then "" else ", ") ^ (pr_str k r) - ^ " " ^ (pr_str v r)) xs "") - ^ "}" - | T.Fn f -> "#" - | T.Atom x -> "(atom " ^ (pr_str !x r) ^ ")" diff --git a/ocaml/reader.ml b/ocaml/reader.ml deleted file mode 100644 index 7456cf8e1c..0000000000 --- a/ocaml/reader.ml +++ /dev/null @@ -1,111 +0,0 @@ -module T = Types.Types - (* ^file ^module *) - -let slurp filename = - let chan = open_in filename in - let b = Buffer.create 27 in - Buffer.add_channel b chan (in_channel_length chan) ; - close_in chan ; - Buffer.contents b - -let find_re re str = - List.map (function | Str.Delim x -> x | Str.Text x -> "impossible!") - (List.filter (function | Str.Delim x -> true | Str.Text x -> false) - (Str.full_split re str)) - -let gsub re f str = - String.concat - "" (List.map (function | Str.Delim x -> f x | Str.Text x -> x) - (Str.full_split re str)) - -let token_re = (Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"\\|;.*\\|[^][ \n{}('\"`,;)]*") - -type reader = { - form : Types.mal_type; - tokens : string list; -} - -type list_reader = { - list_form : Types.mal_type list; - tokens : string list; -} - -let read_atom token = - match token with - | "nil" -> T.Nil - | "true" -> T.Bool true - | "false" -> T.Bool false - | _ -> - match token.[0] with - | '0'..'9' -> T.Int (int_of_string token) - | '"' -> T.String (gsub (Str.regexp "\\\\.") - (function - | "\\n" -> "\n" - | x -> String.sub x 1 1) - (String.sub token 1 ((String.length token) - 2))) - | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token) - | _ -> Types.symbol token - -let with_meta obj meta = - match obj with - | T.List { T.value = v } - -> T.List { T.value = v; T.meta = meta }; | T.Map { T.value = v } - -> T.Map { T.value = v; T.meta = meta }; | T.Vector { T.value = v } - -> T.Vector { T.value = v; T.meta = meta }; | T.Symbol { T.value = v } - -> T.Symbol { T.value = v; T.meta = meta }; | T.Fn { T.value = v } - -> T.Fn { T.value = v; T.meta = meta }; - | _ -> raise (Invalid_argument "metadata not supported on this type") - -let rec read_list eol list_reader = - match list_reader.tokens with - | [] -> output_string stderr ("expected '" ^ eol ^ "', got EOF\n"); - flush stderr; - raise End_of_file; - | token :: tokens -> - if Str.string_match (Str.regexp eol) token 0 then - {list_form = list_reader.list_form; tokens = tokens} - else if token.[0] = ';' then - read_list eol { list_form = list_reader.list_form; - tokens = tokens } - else - let reader = read_form list_reader.tokens in - read_list eol {list_form = list_reader.list_form @ [reader.form]; - tokens = reader.tokens} -and read_quote sym tokens = - let reader = read_form tokens in - {form = Types.list [ Types.symbol sym; reader.form ]; - tokens = reader.tokens} -and read_form all_tokens = - match all_tokens with - | [] -> raise End_of_file; - | token :: tokens -> - match token with - | "'" -> read_quote "quote" tokens - | "`" -> read_quote "quasiquote" tokens - | "~" -> read_quote "unquote" tokens - | "~@" -> read_quote "splice-unquote" tokens - | "@" -> read_quote "deref" tokens - | "^" -> - let meta = read_form tokens in - let value = read_form meta.tokens in - {(*form = with_meta value.form meta.form;*) - form = Types.list [Types.symbol "with-meta"; value.form; meta.form]; - tokens = value.tokens} - | "(" -> - let list_reader = read_list ")" {list_form = []; tokens = tokens} in - {form = Types.list list_reader.list_form; - tokens = list_reader.tokens} - | "{" -> - let list_reader = read_list "}" {list_form = []; tokens = tokens} in - {form = Types.list_into_map Types.MalMap.empty list_reader.list_form; - tokens = list_reader.tokens} - | "[" -> - let list_reader = read_list "]" {list_form = []; tokens = tokens} in - {form = Types.vector list_reader.list_form; - tokens = list_reader.tokens} - | _ -> if token.[0] = ';' - then read_form tokens - else {form = read_atom token; tokens = tokens} - -let read_str str = (read_form (List.filter ((<>) "") (find_re token_re str))).form - diff --git a/ocaml/step0_repl.ml b/ocaml/step0_repl.ml deleted file mode 100644 index e3478f726b..0000000000 --- a/ocaml/step0_repl.ml +++ /dev/null @@ -1,23 +0,0 @@ -(* - To try things at the ocaml repl: - rlwrap ocaml - - To see type signatures of all functions: - ocamlc -i step0_repl.ml - - To run the program: - ocaml step0_repl.ml -*) - -let read str = str -let eval ast any = ast -let print exp = exp -let rep str = print (eval (read str) "") - -let rec main = - try - while true do - print_string "user> "; - print_endline (rep (read_line ())); - done - with End_of_file -> () diff --git a/ocaml/step1_read_print.ml b/ocaml/step1_read_print.ml deleted file mode 100644 index 1735e11974..0000000000 --- a/ocaml/step1_read_print.ml +++ /dev/null @@ -1,15 +0,0 @@ -let read str = Reader.read_str str -let eval ast any = ast -let print exp = Printer.pr_str exp true -let rep str = print (eval (read str) "") - -let rec main = - try - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line); - with End_of_file -> () - done - with End_of_file -> () diff --git a/ocaml/step2_eval.ml b/ocaml/step2_eval.ml deleted file mode 100644 index 3778292073..0000000000 --- a/ocaml/step2_eval.ml +++ /dev/null @@ -1,64 +0,0 @@ -module T = Types.Types - -module Env = - Map.Make ( - String - (*(struct - type t = Types.Symbol - let compare (Types.Symbol a) (Types.Symbol b) = compare a b - end)*) - ) - -let num_fun f = Types.fn - (function - | [(T.Int a); (T.Int b)] -> T.Int (f a b) - | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) - -let repl_env = ref (List.fold_left (fun a b -> b a) Env.empty - [ Env.add "+" (num_fun ( + )); - Env.add "-" (num_fun ( - )); - Env.add "*" (num_fun ( * )); - Env.add "/" (num_fun ( / )) ]) - -let rec eval_ast ast env = - match ast with - | T.Symbol { T.value = s } -> - (try Env.find s !env - with Not_found -> raise (Invalid_argument ("Symbol '" ^ s ^ "' not found"))) - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - let result = eval_ast ast env in - match result with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> (f args) - | _ -> result - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - done - with End_of_file -> () diff --git a/ocaml/step3_env.ml b/ocaml/step3_env.ml deleted file mode 100644 index 73d4236dd9..0000000000 --- a/ocaml/step3_env.ml +++ /dev/null @@ -1,73 +0,0 @@ -module T = Types.Types - -let num_fun f = Types.fn - (function - | [(T.Int a); (T.Int b)] -> T.Int (f a b) - | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) - -let repl_env = Env.make None - -let init_repl env = begin - Env.set env (Types.symbol "+") (num_fun ( + )); - Env.set env (Types.symbol "-") (num_fun ( - )); - Env.set env (Types.symbol "*") (num_fun ( * )); - Env.set env (Types.symbol "/") (num_fun ( / )); -end - -let rec eval_ast ast env = - match ast with - | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> - let value = (eval expr env) in - Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> - (let sub_env = Env.make (Some env) in - let rec bind_pairs = (function - | sym :: expr :: more -> - Env.set sub_env sym (eval expr sub_env); - bind_pairs more - | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") - | [] -> ()) - in bind_pairs bindings; - eval body sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args - | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - init_repl repl_env; - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - done - with End_of_file -> () diff --git a/ocaml/step4_if_fn_do.ml b/ocaml/step4_if_fn_do.ml deleted file mode 100644 index f08aa55223..0000000000 --- a/ocaml/step4_if_fn_do.ml +++ /dev/null @@ -1,83 +0,0 @@ -module T = Types.Types - -let repl_env = Env.make (Some Core.ns) - -let rec eval_ast ast env = - match ast with - | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> - let value = (eval expr env) in - Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> - (let sub_env = Env.make (Some env) in - let rec bind_pairs = (function - | sym :: expr :: more -> - Env.set sub_env sym (eval expr sub_env); - bind_pairs more - | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") - | [] -> ()) - in bind_pairs bindings; - eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> - List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> - Types.fn - (function args -> - let sub_env = Env.make (Some env) in - let rec bind_args a b = - (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> - Env.set sub_env name arg; - bind_args names args; - | [], [] -> () - | _ -> raise (Invalid_argument "Bad param count in fn call")) - in bind_args arg_names args; - eval expr sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args - | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - Core.init Core.ns; - ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - done - with End_of_file -> () diff --git a/ocaml/step6_file.ml b/ocaml/step6_file.ml deleted file mode 100644 index e9d48d3ffe..0000000000 --- a/ocaml/step6_file.ml +++ /dev/null @@ -1,95 +0,0 @@ -module T = Types.Types - -let repl_env = Env.make (Some Core.ns) - -let rec eval_ast ast env = - match ast with - | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> - let value = (eval expr env) in - Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> - (let sub_env = Env.make (Some env) in - let rec bind_pairs = (function - | sym :: expr :: more -> - Env.set sub_env sym (eval expr sub_env); - bind_pairs more - | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") - | [] -> ()) - in bind_pairs bindings; - eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> - List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> - Types.fn - (function args -> - let sub_env = Env.make (Some env) in - let rec bind_args a b = - (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> - Env.set sub_env name arg; - bind_args names args; - | [], [] -> () - | _ -> raise (Invalid_argument "Bad param count in fn call")) - in bind_args arg_names args; - eval expr sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args - | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") - (Types.list (if Array.length Sys.argv > 1 - then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) - else [])); - Env.set repl_env (Types.symbol "eval") - (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); - let code = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - in print_endline code; ignore (rep code repl_env); - ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); - - if Array.length Sys.argv > 1 then - ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env) - else - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - done - with End_of_file -> () diff --git a/ocaml/step7_quote.ml b/ocaml/step7_quote.ml deleted file mode 100644 index 3291f48fba..0000000000 --- a/ocaml/step7_quote.ml +++ /dev/null @@ -1,110 +0,0 @@ -module T = Types.Types - -let repl_env = Env.make (Some Core.ns) - -let rec quasiquote ast = - match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] - -let rec eval_ast ast env = - match ast with - | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> - let value = (eval expr env) in - Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> - (let sub_env = Env.make (Some env) in - let rec bind_pairs = (function - | sym :: expr :: more -> - Env.set sub_env sym (eval expr sub_env); - bind_pairs more - | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") - | [] -> ()) - in bind_pairs bindings; - eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> - List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> - Types.fn - (function args -> - let sub_env = Env.make (Some env) in - let rec bind_args a b = - (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> - Env.set sub_env name arg; - bind_args names args; - | [], [] -> () - | _ -> raise (Invalid_argument "Bad param count in fn call")) - in bind_args arg_names args; - eval expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> - eval (quasiquote ast) env - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args - | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") - (Types.list (if Array.length Sys.argv > 1 - then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) - else [])); - Env.set repl_env (Types.symbol "eval") - (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); - let code = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" - in ignore (rep code repl_env); - ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); - - if Array.length Sys.argv > 1 then - ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env) - else - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - done - with End_of_file -> () diff --git a/ocaml/step8_macros.ml b/ocaml/step8_macros.ml deleted file mode 100644 index 7f61c597ca..0000000000 --- a/ocaml/step8_macros.ml +++ /dev/null @@ -1,144 +0,0 @@ -module T = Types.Types - -let repl_env = Env.make (Some Core.ns) - -let rec quasiquote ast = - match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] - -let kw_macro = T.Keyword "macro" - -let is_macro_call ast env = - match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.meta = T.Map { T.value = meta } } - -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta) - | _ -> false) - | _ -> false - -let rec macroexpand ast env = - if is_macro_call ast env - then match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.value = f } -> macroexpand (f args) env - | _ -> ast) - | _ -> ast - else ast - -let rec eval_ast ast env = - match ast with - | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match macroexpand ast env with - | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> - let value = (eval expr env) in - Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } -> - (match (eval expr env) with - | T.Fn { T.value = f; T.meta = meta } -> - let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]} - in Env.set env key fn; fn - | _ -> raise (Invalid_argument "defmacro! value must be a fn")) - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> - (let sub_env = Env.make (Some env) in - let rec bind_pairs = (function - | sym :: expr :: more -> - Env.set sub_env sym (eval expr sub_env); - bind_pairs more - | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") - | [] -> ()) - in bind_pairs bindings; - eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> - List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> - Types.fn - (function args -> - let sub_env = Env.make (Some env) in - let rec bind_args a b = - (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> - Env.set sub_env name arg; - bind_args names args; - | [], [] -> () - | _ -> raise (Invalid_argument "Bad param count in fn call")) - in bind_args arg_names args; - eval expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> - eval (quasiquote ast) env - | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> - macroexpand ast env - | T.List _ as ast -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args - | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") - (Types.list (if Array.length Sys.argv > 1 - then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) - else [])); - Env.set repl_env (Types.symbol "eval") - (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); - - ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" repl_env); - ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); - ignore (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" repl_env); - ignore (rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" repl_env); - - if Array.length Sys.argv > 1 then - ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env) - else - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - | _ -> - output_string stderr ("Erroringness!\n"); - flush stderr - done - with End_of_file -> () diff --git a/ocaml/step9_try.ml b/ocaml/step9_try.ml deleted file mode 100644 index dd220db1fa..0000000000 --- a/ocaml/step9_try.ml +++ /dev/null @@ -1,156 +0,0 @@ -module T = Types.Types - -let repl_env = Env.make (Some Core.ns) - -let rec quasiquote ast = - match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] - -let kw_macro = T.Keyword "macro" - -let is_macro_call ast env = - match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.meta = T.Map { T.value = meta } } - -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta) - | _ -> false) - | _ -> false - -let rec macroexpand ast env = - if is_macro_call ast env - then match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.value = f } -> macroexpand (f args) env - | _ -> ast) - | _ -> ast - else ast - -let rec eval_ast ast env = - match ast with - | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match macroexpand ast env with - | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> - let value = (eval expr env) in - Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } -> - (match (eval expr env) with - | T.Fn { T.value = f; T.meta = meta } -> - let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]} - in Env.set env key fn; fn - | _ -> raise (Invalid_argument "devmacro! value must be a fn")) - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> - (let sub_env = Env.make (Some env) in - let rec bind_pairs = (function - | sym :: expr :: more -> - Env.set sub_env sym (eval expr sub_env); - bind_pairs more - | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") - | [] -> ()) - in bind_pairs bindings; - eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> - List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> - Types.fn - (function args -> - let sub_env = Env.make (Some env) in - let rec bind_args a b = - (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> - Env.set sub_env name arg; - bind_args names args; - | [], [] -> () - | _ -> raise (Invalid_argument "Bad param count in fn call")) - in bind_args arg_names args; - eval expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> - eval (quasiquote ast) env - | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> - macroexpand ast env - | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; - T.List { T.value = [T.Symbol { T.value = "catch*" }; - local ; handler]}]} -> - (try (eval scary env) - with exn -> - let value = match exn with - | Types.MalExn value -> value - | Invalid_argument msg -> T.String msg - | _ -> (T.String "OCaml exception") in - let sub_env = Env.make (Some env) in - Env.set sub_env local value; - eval handler sub_env) - | T.List _ as ast -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args - | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") - (Types.list (if Array.length Sys.argv > 1 - then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) - else [])); - Env.set repl_env (Types.symbol "eval") - (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); - - ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" repl_env); - ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); - ignore (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" repl_env); - ignore (rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" repl_env); - - if Array.length Sys.argv > 1 then - ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env) - else - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - | _ -> - output_string stderr ("Erroringness!\n"); - flush stderr - done - with End_of_file -> () diff --git a/ocaml/stepA_mal.ml b/ocaml/stepA_mal.ml deleted file mode 100644 index 1aab28addb..0000000000 --- a/ocaml/stepA_mal.ml +++ /dev/null @@ -1,159 +0,0 @@ -module T = Types.Types - -let repl_env = Env.make (Some Core.ns) - -let rec quasiquote ast = - match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] - -let kw_macro = T.Keyword "macro" - -let is_macro_call ast env = - match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.meta = T.Map { T.value = meta } } - -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta) - | _ -> false) - | _ -> false - -let rec macroexpand ast env = - if is_macro_call ast env - then match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.value = f } -> macroexpand (f args) env - | _ -> ast) - | _ -> ast - else ast - -let rec eval_ast ast env = - match ast with - | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Vector { T.value = xs; T.meta = meta } - -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } - | T.Map { T.value = xs; T.meta = meta } - -> T.Map {T.meta = meta; - T.value = (Types.MalMap.fold - (fun k v m - -> Types.MalMap.add (eval k env) (eval v env) m) - xs - Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match macroexpand ast env with - | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> - let value = (eval expr env) in - Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } -> - (match (eval expr env) with - | T.Fn { T.value = f; T.meta = meta } -> - let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]} - in Env.set env key fn; fn - | _ -> raise (Invalid_argument "devmacro! value must be a fn")) - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> - (let sub_env = Env.make (Some env) in - let rec bind_pairs = (function - | sym :: expr :: more -> - Env.set sub_env sym (eval expr sub_env); - bind_pairs more - | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") - | [] -> ()) - in bind_pairs bindings; - eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> - List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> - if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> - Types.fn - (function args -> - let sub_env = Env.make (Some env) in - let rec bind_args a b = - (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> - Env.set sub_env name arg; - bind_args names args; - | [], [] -> () - | _ -> raise (Invalid_argument "Bad param count in fn call")) - in bind_args arg_names args; - eval expr sub_env) - | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> - eval (quasiquote ast) env - | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> - macroexpand ast env - | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; - T.List { T.value = [T.Symbol { T.value = "catch*" }; - local ; handler]}]} -> - (try (eval scary env) - with exn -> - let value = match exn with - | Types.MalExn value -> value - | Invalid_argument msg -> T.String msg - | _ -> (T.String "OCaml exception") in - let sub_env = Env.make (Some env) in - Env.set sub_env local value; - eval handler sub_env) - | T.List _ as ast -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args - | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env - -let read str = Reader.read_str str -let print exp = Printer.pr_str exp true -let rep str env = print (eval (read str) env) - -let rec main = - try - Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") - (Types.list (if Array.length Sys.argv > 1 - then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) - else [])); - Env.set repl_env (Types.symbol "eval") - (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); - - ignore (rep "(def! *host-language* \"ocaml\")" repl_env); - ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" repl_env); - ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); - ignore (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" repl_env); - ignore (rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" repl_env); - - if Array.length Sys.argv > 1 then - ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env) - else begin - ignore (rep "(println (str \"Mal [\" *host-language* \"]\"))" repl_env); - while true do - print_string "user> "; - let line = read_line () in - try - print_endline (rep line repl_env); - with End_of_file -> () - | Invalid_argument x -> - output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); - flush stderr - | _ -> - output_string stderr ("Erroringness!\n"); - flush stderr - done - end - with End_of_file -> () diff --git a/ocaml/types.ml b/ocaml/types.ml deleted file mode 100644 index 9df9761042..0000000000 --- a/ocaml/types.ml +++ /dev/null @@ -1,50 +0,0 @@ -module rec Types - : sig - type 'a with_meta = { value : 'a; meta : t } - and t = - | List of t list with_meta - | Vector of t list with_meta - | Map of t MalMap.t with_meta - | Int of int - | Symbol of string with_meta - | Keyword of string - | Nil - | Bool of bool - | String of string - | Fn of (t list -> t) with_meta - | Atom of t ref - end = Types - -and MalValue - : sig - type t = Types.t - val compare : t -> t -> int - end - = struct - type t = Types.t - let compare = Pervasives.compare - end - -and MalMap - : Map.S with type key = MalValue.t - = Map.Make(MalValue) - -exception MalExn of Types.t - -let to_bool x = match x with - | Types.Nil | Types.Bool false -> false - | _ -> true - -type mal_type = MalValue.t - -let list x = Types.List { Types.value = x; meta = Types.Nil } -let map x = Types.Map { Types.value = x; meta = Types.Nil } -let vector x = Types.Vector { Types.value = x; meta = Types.Nil } -let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil } -let fn f = Types.Fn { Types.value = f; meta = Types.Nil } - -let rec list_into_map target source = - match source with - | k :: v :: more -> list_into_map (MalMap.add k v target) more - | [] -> map target - | _ :: [] -> raise (Invalid_argument "Literal maps must contain an even number of forms") diff --git a/perf.mal b/perf.mal deleted file mode 100644 index 83bbc0da99..0000000000 --- a/perf.mal +++ /dev/null @@ -1,27 +0,0 @@ -(defmacro! time - (fn* (exp) - `(let* (start_FIXME (time-ms) - ret_FIXME ~exp) - (do - (prn (str "Elapsed time: " (- (time-ms) start_FIXME) " msecs")) - ret_FIXME)))) - -(def! run-fn-for* - (fn* [fn max-ms acc-ms iters] - (let* [start (time-ms) - _ (fn) - elapsed (- (time-ms) start) - new-iters (+ 1 iters) - new-acc-ms (+ acc-ms elapsed)] - ;(do (prn "here:" new-acc-ms "/" max-ms "iters:" new-iters) ) - (if (>= new-acc-ms max-ms) - (/ (* max-ms iters) new-acc-ms) - (run-fn-for* fn max-ms new-acc-ms new-iters))))) - -(def! run-fn-for - (fn* [fn max-secs] - (do - ;; Warm it up first - (run-fn-for* fn 1000 0 0) - ;; Now do the test - (/ (run-fn-for* fn (* 1000 max-secs) 0 0) 3)))) diff --git a/perl/Makefile b/perl/Makefile deleted file mode 100644 index 0aed9c6850..0000000000 --- a/perl/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -TESTS = - -SOURCES_BASE = readline.pm types.pm reader.pm printer.pm \ - interop.pm -SOURCES_LISP = env.pm core.pm stepA_mal.pl -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -#all: mal.pl - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ruby $@ || exit 1; \ diff --git a/perl/core.pm b/perl/core.pm deleted file mode 100644 index 7d70278c58..0000000000 --- a/perl/core.pm +++ /dev/null @@ -1,242 +0,0 @@ -package core; -use strict; -use warnings FATAL => qw(all); -use Exporter 'import'; -our @EXPORT_OK = qw($core_ns); -use Time::HiRes qw(time); - -use readline; -use types qw(_sequential_Q _equal_Q _clone $nil $true $false - _nil_Q _true_Q _false_Q - _symbol _symbol_Q _keyword _keyword_Q _list_Q _vector_Q - _hash_map _hash_map_Q _assoc_BANG _dissoc_BANG _atom_Q); -use reader qw(read_str); -use printer qw(_pr_str); - -use Data::Dumper; - -# String functions - -sub pr_str { - return String->new(join(" ", map {_pr_str($_, 1)} @{$_[0]->{val}})); -} - -sub str { - return String->new(join("", map {_pr_str($_, 0)} @{$_[0]->{val}})); -} - -sub prn { - print join(" ", map {_pr_str($_, 1)} @{$_[0]->{val}}) . "\n"; - return $nil -} - -sub println { - print join(" ", map {_pr_str($_, 0)} @{$_[0]->{val}}) . "\n"; - return $nil -} - -sub mal_readline { - my $line = readline::mal_readline(${$_[0]}); - return defined $line ? String->new($line) : $nil; -} - -sub slurp { - my $fname = ${$_[0]}; - open(my $fh, '<', $fname) or die "error opening '$fname'"; - my $data = do { local $/; <$fh> }; - String->new($data) -} - -# Hash Map functions - -sub assoc { - my $src_hsh = shift; - my $new_hsh = { %{$src_hsh->{val}} }; - return _assoc_BANG($new_hsh, @_); -} - -sub dissoc { - my $src_hsh = shift; - my $new_hsh = { %{$src_hsh->{val}} }; - return _dissoc_BANG($new_hsh, @_); -} - - -sub get { - my ($hsh, $key) = @_; - return $nil if $hsh eq $nil; - return exists $hsh->{val}->{$$key} ? $hsh->{val}->{$$key} : $nil; -} - -sub contains_Q { - my ($hsh, $key) = @_; - return $nil if $hsh eq $false; - return (exists $hsh->{val}->{$$key}) ? $true : $false; -} - -sub mal_keys { - my @ks = map { String->new($_) } keys %{$_[0]->{val}}; - return List->new(\@ks); -} - -sub mal_vals { - my @vs = values %{$_[0]->{val}}; - return List->new(\@vs); -} - - -# Sequence functions - -sub cons { - my ($a, $b) = @_; - my @new_arr = @{[$a]}; - push @new_arr, @{$b->{val}}; - List->new(\@new_arr); -} - -sub concat { - if (scalar(@_) == 0) { return List->new([]); } - my ($a) = shift; - my @new_arr = @{$a->{val}}; - map { push @new_arr, @{$_->{val}} } @_; - List->new(\@new_arr); -} - -sub nth { - my ($seq,$i) = @_; - if (@{$seq->{val}} > $i) { - return scalar($seq->nth($i)); - } else { - die "nth: index out of bounds"; - } -} - -sub first { my ($seq) = @_; return scalar(@{$seq->{val}}) > 0 ? $seq->nth(0) : $nil; } - -sub rest { return $_[0]->rest(); } - -sub count { - if (_nil_Q($_[0])) { - return Integer->new(0); - } else { - return Integer->new(scalar(@{$_[0]->{val}})) - } -} - -sub apply { - my @all_args = @{$_[0]->{val}}; - my $f = $all_args[0]; - my @apply_args = @all_args[1..$#all_args]; - my @args = @apply_args[0..$#apply_args-1]; - push @args, @{$apply_args[$#apply_args]->{val}}; - if ((ref $f) =~ /^Function/) { - return $f->apply(List->new(\@args)); - } else { - return &{ $f }(List->new(\@args)); - } -} - -sub mal_map { - my $f = shift; - my @arr; - if ((ref $f) =~ /^Function/) { - @arr = map { $f->apply(List->new([$_])) } @{$_[0]->{val}}; - } else { - @arr = map { &{ $f}(List->new([$_])) } @{$_[0]->{val}}; - } - return List->new(\@arr); -} - - -# Metadata functions -sub with_meta { - my $new_obj = _clone($_[0]); - $new_obj->{meta} = $_[1]; - return $new_obj; -} - -sub meta { - if ((ref $_[0]) && !((ref $_[0]) =~ /^CODE/)) { - return $_[0]->{meta}; - } else { - return $nil; - } -} - - -# Atom functions -sub swap_BANG { - my ($atm,$f,@args) = @_; - unshift @args, $atm->{val}; - if ((ref $f) =~ /^Function/) { - return $atm->{val} = $f->apply(List->new(\@args)); - } else { - return $atm->{val} = &{ $f }(List->new(\@args)); - } -} - - - -our $core_ns = { - '=' => sub { _equal_Q($_[0]->nth(0), $_[0]->nth(1)) ? $true : $false }, - 'throw' => sub { die $_[0]->nth(0) }, - 'nil?' => sub { _nil_Q($_[0]->nth(0)) ? $true : $false }, - 'true?' => sub { _true_Q($_[0]->nth(0)) ? $true : $false }, - 'false?' => sub { _false_Q($_[0]->nth(0)) ? $true : $false }, - 'symbol' => sub { Symbol->new(${$_[0]->nth(0)}) }, - 'symbol?' => sub { _symbol_Q($_[0]->nth(0)) ? $true : $false }, - 'keyword' => sub { _keyword(${$_[0]->nth(0)}) }, - 'keyword?' => sub { _keyword_Q($_[0]->nth(0)) ? $true : $false }, - - 'pr-str' => sub { pr_str($_[0]) }, - 'str' => sub { str($_[0]) }, - 'prn' => sub { prn($_[0]) }, - 'println' => sub { println($_[0]) }, - 'readline' => sub { mal_readline($_[0]->nth(0)) }, - 'read-string' => sub { read_str(${$_[0]->nth(0)}) }, - 'slurp' => sub { slurp($_[0]->nth(0)) }, - '<' => sub { ${$_[0]->nth(0)} < ${$_[0]->nth(1)} ? $true : $false }, - '<=' => sub { ${$_[0]->nth(0)} <= ${$_[0]->nth(1)} ? $true : $false }, - '>' => sub { ${$_[0]->nth(0)} > ${$_[0]->nth(1)} ? $true : $false }, - '>=' => sub { ${$_[0]->nth(0)} >= ${$_[0]->nth(1)} ? $true : $false }, - '+' => sub { Integer->new(${$_[0]->nth(0)} + ${$_[0]->nth(1)}) }, - '-' => sub { Integer->new(${$_[0]->nth(0)} - ${$_[0]->nth(1)}) }, - '*' => sub { Integer->new(${$_[0]->nth(0)} * ${$_[0]->nth(1)}) }, - '/' => sub { Integer->new(${$_[0]->nth(0)} / ${$_[0]->nth(1)}) }, - 'time-ms' => sub { Integer->new(int(time()*1000)) }, - - 'list' => sub { List->new($_[0]->{val}) }, - 'list?' => sub { _list_Q($_[0]->nth(0)) ? $true : $false }, - 'vector' => sub { Vector->new($_[0]->{val}) }, - 'vector?' => sub { _vector_Q($_[0]->nth(0)) ? $true : $false }, - 'hash-map' => sub { _hash_map(@{$_[0]->{val}}) }, - 'map?' => sub { _hash_map_Q($_[0]->nth(0)) ? $true : $false }, - 'assoc' => sub { assoc(@{$_[0]->{val}}) }, - 'dissoc' => sub { dissoc(@{$_[0]->{val}}) }, - 'get' => sub { get($_[0]->nth(0),$_[0]->nth(1)) }, - 'contains?' => sub { contains_Q($_[0]->nth(0),$_[0]->nth(1)) }, - 'keys' => sub { mal_keys(@{$_[0]->{val}}) }, - 'vals' => sub { mal_vals(@{$_[0]->{val}}) }, - - 'sequential?' => sub { _sequential_Q($_[0]->nth(0)) ? $true : $false }, - 'nth' => sub { nth($_[0]->nth(0), ${$_[0]->nth(1)}) }, - 'first' => sub { first($_[0]->nth(0)) }, - 'rest' => sub { rest($_[0]->nth(0)) }, - 'cons' => sub { cons($_[0]->nth(0), $_[0]->nth(1)) }, - 'concat' => sub { concat(@{$_[0]->{val}}) }, - 'empty?' => sub { scalar(@{$_[0]->nth(0)->{val}}) == 0 ? $true : $false }, - 'count' => sub { count($_[0]->nth(0)) }, - 'apply' => sub { apply($_[0]) }, - 'map' => sub { mal_map($_[0]->nth(0), $_[0]->nth(1)) }, - 'conj' => sub { die "not implemented\n"; }, - - 'with-meta' => sub { with_meta($_[0]->nth(0), $_[0]->nth(1)) }, - 'meta' => sub { meta($_[0]->nth(0)) }, - 'atom' => sub { Atom->new($_[0]->nth(0)) }, - 'atom?' => sub { _atom_Q($_[0]->nth(0)) ? $true : $false }, - 'deref' => sub { $_[0]->nth(0)->{val} }, - 'reset!' => sub { $_[0]->nth(0)->{val} = $_[0]->nth(1) }, - 'swap!' => sub { swap_BANG(@{$_[0]->{val}}) }, -}; - -1; diff --git a/perl/env.pm b/perl/env.pm deleted file mode 100644 index 801256524a..0000000000 --- a/perl/env.pm +++ /dev/null @@ -1,66 +0,0 @@ -package reader; -use feature qw(switch); -use strict; -use warnings; -use Exporter 'import'; - - -{ - package Env; - use Data::Dumper; - sub new { - my ($class,$outer,$binds,$exprs) = @_; - my $data = { __outer__ => $outer }; - if ($binds) { - for (my $i=0; $i{val}}); $i++) { - if (${$binds->nth($i)} eq "&") { - # variable length arguments - my @earr = @{$exprs->{val}}; # get the array - my @new_arr = @earr[$i..$#earr]; # slice it - $data->{${$binds->nth($i+1)}} = List->new(\@new_arr); - last; - } else { - $data->{${$binds->nth($i)}} = $exprs->nth($i); - } - } - } - bless $data => $class - } - sub find { - my ($self, $key) = @_; - if (exists $self->{$$key}) { return $self; } - elsif ($self->{__outer__}) { return $self->{__outer__}->find($key); } - else { return undef; } - } - sub set { - my ($self, $key, $value) = @_; - $self->{$$key} = $value; - return $value - } - sub get { - my ($self, $key) = @_; - my $env = $self->find($key); - die "'" . $$key . "' not found\n" unless $env; - return $env->{$$key}; - } -} - -#my $e1 = Env->new(); -#print Dumper($e1); -# -#my $e2 = Env->new(); -#$e2->set('abc', 123); -#$e2->set('def', 456); -#print Dumper($e2); -# -#my $e3 = Env->new($e2); -#$e3->set('abc', 789); -#$e3->set('ghi', 1024); -#print Dumper($e3); -# -#print Dumper($e3->find('abc')); -#print Dumper($e3->get('abc')); -#print Dumper($e3->find('def')); -#print Dumper($e3->get('def')); - -1; diff --git a/perl/interop.pm b/perl/interop.pm deleted file mode 100644 index ffa379f23d..0000000000 --- a/perl/interop.pm +++ /dev/null @@ -1,36 +0,0 @@ -package interop; -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use feature qw(switch); -use Exporter 'import'; -our @EXPORT_OK = qw( pl_to_mal ); -use Scalar::Util qw(looks_like_number); - -use types; - -sub pl_to_mal { - my($obj) = @_; - given (ref $obj) { - when(/^ARRAY/) { - my @arr = map {pl_to_mal($_)} @$obj; - return List->new(\@arr); - } - when(/^HASH/) { - my $hsh = {}; - foreach my $key (keys %$obj) { - $hsh->{$key} = pl_to_mal($obj->{$key}); - } - return HashMap->new($hsh) - } - default { - if (looks_like_number($obj)) { - return Integer->new($obj); - } else { - return String->new($obj); - } - } - } -} - -1; diff --git a/perl/printer.pm b/perl/printer.pm deleted file mode 100644 index 7b00b1e9ff..0000000000 --- a/perl/printer.pm +++ /dev/null @@ -1,57 +0,0 @@ -package printer; -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use feature qw(switch); -use Exporter 'import'; -our @EXPORT_OK = qw( _pr_str ); - -use types qw($nil $true $false); - -use Data::Dumper; - -sub _pr_str { - my($obj, $print_readably) = @_; - my($_r) = (defined $print_readably) ? $print_readably : 1; - given (ref $obj) { - when(/^List/) { - return '(' . join(' ', map {_pr_str($_, $_r)} @{$obj->{val}}) . ')'; - } - when(/^Vector/) { - return '[' . join(' ', map {_pr_str($_, $_r)} @{$obj->{val}}) . ']'; - } - when(/^HashMap/) { - my @elems = (); - foreach my $key (keys $obj->{val}) { - push(@elems, _pr_str(String->new($key), $_r)); - push(@elems, _pr_str($obj->{val}->{$key}, $_r)); - } - - return '{' . join(' ', @elems) . '}'; - } - when(/^String/) { - if ($$obj =~ /^\x{029e}/) { - return ':' . substr($$obj,1); - } elsif ($_r) { - my $str = $$obj; - $str =~ s/\\/\\\\/g; - $str =~ s/"/\\"/g; - $str =~ s/\n/\\n/g; - return '"' . $str . '"'; - } else { - return $$obj; - } - } - when(/^Function/) { - return '{params}) . - ' ' . _pr_str($obj->{ast}) . '>'; - } - when(/^Atom/) { - return '(atom ' . _pr_str($obj->{val}) . ")"; - } - when(/^CODE/) { return ''; } - default { return $$obj; } - } -} - -1; diff --git a/perl/reader.pm b/perl/reader.pm deleted file mode 100644 index 501f99242a..0000000000 --- a/perl/reader.pm +++ /dev/null @@ -1,119 +0,0 @@ -package reader; -use feature qw(switch); -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use Exporter 'import'; -our @EXPORT_OK = qw( read_str ); - -use types qw($nil $true $false _keyword _hash_map); - -use Data::Dumper; - -{ - package Reader; - sub new { - my $class = shift; - bless { position => 0, tokens => shift } => $class - } - sub next { my $self = shift; return $self->{tokens}[$self->{position}++] } - sub peek { my $self = shift; return $self->{tokens}[$self->{position}] } -} - -sub tokenize { - my($str) = @_; - my @tokens = $str =~ /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/g; - return grep {! /^;|^$/} @tokens; -} - -sub read_atom { - my($rdr) = @_; - my $token = $rdr->next(); - given ($token) { - when(/^-?[0-9]+$/) { return Integer->new($token) } - when(/^"/) { - my $str = substr $token, 1, -1; - $str =~ s/\\"/"/g; - $str =~ s/\\n/\n/g; - return String->new($str) - } - when(/^:/) { return _keyword(substr($token,1)) } - when(/^nil$/) { return $nil } - when(/^true$/) { return $true } - when(/^false$/) { return $false } - default { return Symbol->new($token) } - } -} - -sub read_list { - my($rdr,$class,$start,$end) = @_; - $start = $start || '('; - $end = $end || ')'; - - my $token = $rdr->next(); - my @lst = (); - if ($token ne $start) { - die "expected '$start'"; - } - while (($token = $rdr->peek()) ne $end) { - if (! defined $token) { - die "expected '$end', got EOF"; - } - push(@lst, read_form($rdr)); - } - $rdr->next(); - if ($class eq 'List') { - return List->new(\@lst); - } elsif ($class eq 'Vector') { - return Vector->new(\@lst); - } else { - return _hash_map(@lst); - } -} - -sub read_form { - my($rdr) = @_; - my $token = $rdr->peek(); - given ($token) { - when("'") { $rdr->next(); List->new([Symbol->new('quote'), - read_form($rdr)]) } - when('`') { $rdr->next(); List->new([Symbol->new('quasiquote'), - read_form($rdr)]) } - when('~') { $rdr->next(); List->new([Symbol->new('unquote'), - read_form($rdr)]) } - when('~@') { $rdr->next(); List->new([Symbol->new('splice-unquote'), - read_form($rdr)]) } - when('^') { $rdr->next(); my $meta = read_form($rdr); - List->new([Symbol->new('with-meta'), - read_form($rdr), $meta]) } - when('@') { $rdr->next(); List->new([Symbol->new('deref'), - read_form($rdr)]) } - - when(')') { die "unexpected ')'" } - when('(') { return read_list($rdr, 'List') } - when(']') { die "unexpected ']'" } - when('[') { return read_list($rdr, 'Vector', '[', ']') } - when('}') { die "unexpected '}'" } - when('{') { return read_list($rdr, 'HashMap', '{', '}') } - default { return read_atom($rdr) } - } -} - -sub read_str { - my($str) = @_; - my @tokens = tokenize($str); - #print "tokens: " . Dumper(\@tokens); - if (scalar(@tokens) == 0) { die BlankException->new(); } - return read_form(Reader->new(\@tokens)); -} - -#print Dumper(read_str("123")); -#print Dumper(read_str("+")); -#print Dumper(read_str("\"abc\"")); -#print Dumper(read_str("nil")); -#print Dumper(read_str("true")); -#print Dumper(read_str("false")); -#print Dumper(read_str("(+ 2 3)")); -#print Dumper(read_str("(foo 2 (3 4))")); - -1; diff --git a/perl/readline.pm b/perl/readline.pm deleted file mode 100644 index 0629f3957e..0000000000 --- a/perl/readline.pm +++ /dev/null @@ -1,71 +0,0 @@ -# To get readline line editing functionality, please install -# Term::ReadKey and either Term::ReadLine::Gnu (GPL) or -# Term::ReadLine::Perl (GPL, Artistic) from CPAN. - -package readline; -use strict; -use warnings; -use Exporter 'import'; -our @EXPORT_OK = qw( mal_readline set_rl_mode ); - -use Term::ReadLine; - -my $_rl = Term::ReadLine->new('Mal'); -$_rl->ornaments(0); -#print "Using ReadLine implementation: " . $_rl->ReadLine() . "\n"; -my $OUT = $_rl->OUT || \*STDOUT; -my $_history_loaded = 0; - -my $history_file = $ENV{"HOME"} . "/.mal-history"; - -sub save_line { - my ($line) = @_; - open(my $fh, '>>', $history_file) or return; - say $fh $line; - close $fh; -} - -sub load_history { - open my $fh, $history_file or return; - - while(my $line = <$fh>) { - chomp $line; - $_rl->addhistory($line) if $line =~ /\S/; - } - - close $fh; -} - -my $rl_mode = "terminal"; - -sub set_rl_mode { - my($mode) = @_; - $rl_mode = $mode; -} - -sub mal_readline { - my($prompt) = @_; - my $line = undef; - if (! $_history_loaded) { - $_history_loaded = 1; - load_history(); - } - - if ($rl_mode eq "terminal") { - if (defined ($line = $_rl->readline($prompt))) { - save_line($line); - return $line; - } else { - return undef; - } - } else { - print "$prompt"; - if (defined ($line = readline(*STDIN))) { - save_line($line); - return $line; - } else { - return undef; - } - } -} -1; diff --git a/perl/step0.5_repl.pl b/perl/step0.5_repl.pl deleted file mode 100644 index d8a9d9fd93..0000000000 --- a/perl/step0.5_repl.pl +++ /dev/null @@ -1,33 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -use readline qw(readline); - -# read -sub READ { - my $str = shift; - return $str; -} - -# eval -sub EVAL { - my($ast, $env) = @_; - return eval($ast); -} - -# print -sub PRINT { - my $exp = shift; - return $exp; -} - -# repl -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), {})); -} - -while (1) { - my $line = readline("user> "); - if (! defined $line) { last; } - print(REP($line), "\n"); -} diff --git a/perl/step0_repl.pl b/perl/step0_repl.pl deleted file mode 100644 index 36d6375f3d..0000000000 --- a/perl/step0_repl.pl +++ /dev/null @@ -1,35 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline); - -# read -sub READ { - my $str = shift; - return $str; -} - -# eval -sub EVAL { - my($ast, $env) = @_; - return $ast; -} - -# print -sub PRINT { - my $exp = shift; - return $exp; -} - -# repl -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), {})); -} - -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - print(REP($line), "\n"); -} diff --git a/perl/step1_read_print.pl b/perl/step1_read_print.pl deleted file mode 100644 index 26c7bbf76c..0000000000 --- a/perl/step1_read_print.pl +++ /dev/null @@ -1,62 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); - -use reader; -use printer; - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub EVAL { - my($ast, $env) = @_; - return $ast; -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), {})); -} - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step2_eval.pl b/perl/step2_eval.pl deleted file mode 100644 index 858a385d12..0000000000 --- a/perl/step2_eval.pl +++ /dev/null @@ -1,109 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw(_list_Q); -use reader; -use printer; - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - if (exists $env->{$$ast}) { - return $env->{$$ast}; - } else { - die "'" . $$ast . "' not found"; - } - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - return &{ $f }($el->rest()); -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = {}; -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -$repl_env->{'+'} = sub { Integer->new(${$_[0]->nth(0)} + ${$_[0]->nth(1)}) }; -$repl_env->{'-'} = sub { Integer->new(${$_[0]->nth(0)} - ${$_[0]->nth(1)}) }; -$repl_env->{'*'} = sub { Integer->new(${$_[0]->nth(0)} * ${$_[0]->nth(1)}) }; -$repl_env->{'/'} = sub { Integer->new(${$_[0]->nth(0)} / ${$_[0]->nth(1)}) }; - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step3_env.pl b/perl/step3_env.pl deleted file mode 100644 index 1c34ab6277..0000000000 --- a/perl/step3_env.pl +++ /dev/null @@ -1,122 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw(_list_Q); -use reader; -use printer; -use env; - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ($$a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - return EVAL($a2, $let_env); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - return &{ $f }($el->rest()); - } - } -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -$repl_env->set(Symbol->new('+'), sub { Integer->new(${$_[0]->nth(0)} + ${$_[0]->nth(1)}) } ); -$repl_env->set(Symbol->new('-'), sub { Integer->new(${$_[0]->nth(0)} - ${$_[0]->nth(1)}) } ); -$repl_env->set(Symbol->new('*'), sub { Integer->new(${$_[0]->nth(0)} * ${$_[0]->nth(1)}) } ); -$repl_env->set(Symbol->new('/'), sub { Integer->new(${$_[0]->nth(0)} / ${$_[0]->nth(1)}) } ); - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step4_if_fn_do.pl b/perl/step4_if_fn_do.pl deleted file mode 100644 index 64ad314dc9..0000000000 --- a/perl/step4_if_fn_do.pl +++ /dev/null @@ -1,145 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - return EVAL($a2, $let_env); - } - when (/^do$/) { - my $el = eval_ast($ast->rest(), $env); - return $el->nth($#{$el->{val}}); - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - return $a3 ? EVAL($a3, $env) : $nil; - } else { - return EVAL($a2, $env); - } - } - when (/^fn\*$/) { - return sub { - #print "running fn*\n"; - my $args = $_[0]; - return EVAL($a2, Env->new($env, $a1, $args)); - }; - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - return &{ $f }($el->rest()); - } - } -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { - $repl_env->set(Symbol->new($n), $core_ns->{$n}); -} - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))"); - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step5_tco.pl b/perl/step5_tco.pl deleted file mode 100644 index 53255c220e..0000000000 --- a/perl/step5_tco.pl +++ /dev/null @@ -1,156 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { - $repl_env->set(Symbol->new($n), $core_ns->{$n}); -} - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))"); - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step6_file.pl b/perl/step6_file.pl deleted file mode 100644 index 48b835f43c..0000000000 --- a/perl/step6_file.pl +++ /dev/null @@ -1,165 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { - $repl_env->set(Symbol->new($n), $core_ns->{$n}); -} -$repl_env->set(Symbol->new('eval'), sub { EVAL($_[0]->nth(0), $repl_env); }); -my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Symbol->new('*ARGV*'), List->new(\@_argv)); - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))"); -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); - shift @ARGV; -} -if (scalar(@ARGV) > 0) { - REP("(load-file \"" . $ARGV[0] . "\")"); - exit 0; -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step7_quote.pl b/perl/step7_quote.pl deleted file mode 100644 index 89133a204d..0000000000 --- a/perl/step7_quote.pl +++ /dev/null @@ -1,195 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub is_pair { - my ($x) = @_; - return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; -} - -sub quasiquote { - my ($ast) = @_; - if (!is_pair($ast)) { - return List->new([Symbol->new("quote"), $ast]); - } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { - return $ast->nth(1); - } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && - ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { - return List->new([Symbol->new("concat"), - $ast->nth(0)->nth(1), - quasiquote($ast->rest())]); - } else { - return List->new([Symbol->new("cons"), - quasiquote($ast->nth(0)), - quasiquote($ast->rest())]); - } -} - -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^quote$/) { - return $a1; - } - when (/^quasiquote$/) { - $ast = quasiquote($a1); - # Continue loop (TCO) - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { - $repl_env->set(Symbol->new($n), $core_ns->{$n}); -} -$repl_env->set(Symbol->new('eval'), sub { EVAL($_[0]->nth(0), $repl_env); }); -my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Symbol->new('*ARGV*'), List->new(\@_argv)); - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))"); -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); - shift @ARGV; -} -if (scalar(@ARGV) > 0) { - REP("(load-file \"" . $ARGV[0] . "\")"); - exit 0; -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step8_macros.pl b/perl/step8_macros.pl deleted file mode 100644 index 4e4a48d4e9..0000000000 --- a/perl/step8_macros.pl +++ /dev/null @@ -1,232 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub is_pair { - my ($x) = @_; - return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; -} - -sub quasiquote { - my ($ast) = @_; - if (!is_pair($ast)) { - return List->new([Symbol->new("quote"), $ast]); - } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { - return $ast->nth(1); - } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && - ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { - return List->new([Symbol->new("concat"), - $ast->nth(0)->nth(1), - quasiquote($ast->rest())]); - } else { - return List->new([Symbol->new("cons"), - quasiquote($ast->nth(0)), - quasiquote($ast->rest())]); - } -} - -sub is_macro_call { - my ($ast, $env) = @_; - if (_list_Q($ast) && - _symbol_Q($ast->nth(0)) && - $env->find($ast->nth(0))) { - my ($f) = $env->get($ast->nth(0)); - if ((ref $f) =~ /^Function/) { - return $f->{ismacro}; - } - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my $mac = $env->get($ast->nth(0)); - $ast = $mac->apply($ast->rest()); - } - return $ast; -} - - -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - $ast = macroexpand($ast, $env); - if (! _list_Q($ast)) { return $ast; } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^quote$/) { - return $a1; - } - when (/^quasiquote$/) { - $ast = quasiquote($a1); - # Continue loop (TCO) - } - when (/^defmacro!$/) { - my $func = EVAL($a2, $env); - $func->{ismacro} = 1; - return $env->set($a1, $func); - } - when (/^macroexpand$/) { - return macroexpand($a1, $env); - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { - $repl_env->set(Symbol->new($n), $core_ns->{$n}); -} -$repl_env->set(Symbol->new('eval'), sub { EVAL($_[0]->nth(0), $repl_env); }); -my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Symbol->new('*ARGV*'), List->new(\@_argv)); - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))"); -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); - shift @ARGV; -} -if (scalar(@ARGV) > 0) { - REP("(load-file \"" . $ARGV[0] . "\")"); - exit 0; -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/step9_try.pl b/perl/step9_try.pl deleted file mode 100644 index ec823bcbdb..0000000000 --- a/perl/step9_try.pl +++ /dev/null @@ -1,260 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); -use interop qw(pl_to_mal); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub is_pair { - my ($x) = @_; - return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; -} - -sub quasiquote { - my ($ast) = @_; - if (!is_pair($ast)) { - return List->new([Symbol->new("quote"), $ast]); - } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { - return $ast->nth(1); - } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && - ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { - return List->new([Symbol->new("concat"), - $ast->nth(0)->nth(1), - quasiquote($ast->rest())]); - } else { - return List->new([Symbol->new("cons"), - quasiquote($ast->nth(0)), - quasiquote($ast->rest())]); - } -} - -sub is_macro_call { - my ($ast, $env) = @_; - if (_list_Q($ast) && - _symbol_Q($ast->nth(0)) && - $env->find($ast->nth(0))) { - my ($f) = $env->get($ast->nth(0)); - if ((ref $f) =~ /^Function/) { - return $f->{ismacro}; - } - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my $mac = $env->get($ast->nth(0)); - $ast = $mac->apply($ast->rest()); - } - return $ast; -} - - -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - $ast = macroexpand($ast, $env); - if (! _list_Q($ast)) { return $ast; } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^quote$/) { - return $a1; - } - when (/^quasiquote$/) { - $ast = quasiquote($a1); - # Continue loop (TCO) - } - when (/^defmacro!$/) { - my $func = EVAL($a2, $env); - $func->{ismacro} = 1; - return $env->set($a1, $func); - } - when (/^macroexpand$/) { - return macroexpand($a1, $env); - } - when (/^try\*$/) { - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - $ret = EVAL($a1, $env); - 1; - } or do { - my $err = $@; - if ($a2 && ${$a2->nth(0)} eq "catch\*") { - my $exc; - if (ref $err) { - $exc = $err; - } else { - $exc = String->new(substr $err, 0, -1); - } - return EVAL($a2->nth(2), Env->new($env, - List->new([$a2->nth(1)]), - List->new([$exc]))); - } else { - die $err; - } - }; - return $ret; - }; - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { - $repl_env->set(Symbol->new($n), $core_ns->{$n}); -} -$repl_env->set(Symbol->new('eval'), sub { EVAL($_[0]->nth(0), $repl_env); }); -my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Symbol->new('*ARGV*'), List->new(\@_argv)); - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))"); -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); - shift @ARGV; -} -if (scalar(@ARGV) > 0) { - REP("(load-file \"" . $ARGV[0] . "\")"); - exit 0; -} -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/stepA_mal.pl b/perl/stepA_mal.pl deleted file mode 100644 index 7993635536..0000000000 --- a/perl/stepA_mal.pl +++ /dev/null @@ -1,265 +0,0 @@ -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use File::Basename; -use lib dirname (__FILE__); -use readline qw(mal_readline set_rl_mode); -use feature qw(switch); -use Data::Dumper; - -use types qw($nil $true $false _sequential_Q _symbol_Q _list_Q); -use reader; -use printer; -use env; -use core qw($core_ns); -use interop qw(pl_to_mal); - -# read -sub READ { - my $str = shift; - return reader::read_str($str); -} - -# eval -sub is_pair { - my ($x) = @_; - return _sequential_Q($x) && scalar(@{$x->{val}}) > 0; -} - -sub quasiquote { - my ($ast) = @_; - if (!is_pair($ast)) { - return List->new([Symbol->new("quote"), $ast]); - } elsif (_symbol_Q($ast->nth(0)) && ${$ast->nth(0)} eq 'unquote') { - return $ast->nth(1); - } elsif (is_pair($ast->nth(0)) && _symbol_Q($ast->nth(0)->nth(0)) && - ${$ast->nth(0)->nth(0)} eq 'splice-unquote') { - return List->new([Symbol->new("concat"), - $ast->nth(0)->nth(1), - quasiquote($ast->rest())]); - } else { - return List->new([Symbol->new("cons"), - quasiquote($ast->nth(0)), - quasiquote($ast->rest())]); - } -} - -sub is_macro_call { - my ($ast, $env) = @_; - if (_list_Q($ast) && - _symbol_Q($ast->nth(0)) && - $env->find($ast->nth(0))) { - my ($f) = $env->get($ast->nth(0)); - if ((ref $f) =~ /^Function/) { - return $f->{ismacro}; - } - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my $mac = $env->get($ast->nth(0)); - $ast = $mac->apply($ast->rest()); - } - return $ast; -} - - -sub eval_ast { - my($ast, $env) = @_; - given (ref $ast) { - when (/^Symbol/) { - $env->get($ast); - } - when (/^List/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return List->new(\@lst); - } - when (/^Vector/) { - my @lst = map {EVAL($_, $env)} @{$ast->{val}}; - return Vector->new(\@lst); - } - when (/^HashMap/) { - my $new_hm = {}; - foreach my $k (keys($ast->{val})) { - $new_hm->{$k} = EVAL($ast->get($k), $env); - } - return HashMap->new($new_hm); - } - default { - return $ast; - } - } -} - -sub EVAL { - my($ast, $env) = @_; - - while (1) { - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! _list_Q($ast)) { - return eval_ast($ast, $env); - } - - # apply list - $ast = macroexpand($ast, $env); - if (! _list_Q($ast)) { return $ast; } - - my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; - given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { - when (/^def!$/) { - my $res = EVAL($a2, $env); - return $env->set($a1, $res); - } - when (/^let\*$/) { - my $let_env = Env->new($env); - for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { - $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env)); - } - $ast = $a2; - $env = $let_env; - # Continue loop (TCO) - } - when (/^quote$/) { - return $a1; - } - when (/^quasiquote$/) { - $ast = quasiquote($a1); - # Continue loop (TCO) - } - when (/^defmacro!$/) { - my $func = EVAL($a2, $env); - $func->{ismacro} = 1; - return $env->set($a1, $func); - } - when (/^macroexpand$/) { - return macroexpand($a1, $env); - } - when (/^pl\*$/) { - return pl_to_mal(eval(${$a1})); - } - when (/^try\*$/) { - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - $ret = EVAL($a1, $env); - 1; - } or do { - my $err = $@; - if ($a2 && ${$a2->nth(0)} eq "catch\*") { - my $exc; - if (ref $err) { - $exc = $err; - } else { - $exc = String->new(substr $err, 0, -1); - } - return EVAL($a2->nth(2), Env->new($env, - List->new([$a2->nth(1)]), - List->new([$exc]))); - } else { - die $err; - } - }; - return $ret; - }; - } - when (/^do$/) { - eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env); - $ast = $ast->nth($#{$ast->{val}}); - # Continue loop (TCO) - } - when (/^if$/) { - my $cond = EVAL($a1, $env); - if ($cond eq $nil || $cond eq $false) { - $ast = $a3 ? $a3 : $nil; - } else { - $ast = $a2; - } - # Continue loop (TCO) - } - when (/^fn\*$/) { - return Function->new(\&EVAL, $a2, $env, $a1); - } - default { - my $el = eval_ast($ast, $env); - my $f = $el->nth(0); - if ((ref $f) =~ /^Function/) { - $ast = $f->{ast}; - $env = $f->gen_env($el->rest()); - # Continue loop (TCO) - } else { - return &{ $f }($el->rest()); - } - } - } - - } # TCO while loop -} - -# print -sub PRINT { - my $exp = shift; - return printer::_pr_str($exp); -} - -# repl -my $repl_env = Env->new(); -sub REP { - my $str = shift; - return PRINT(EVAL(READ($str), $repl_env)); -} - -# core.pl: defined using perl -foreach my $n (%$core_ns) { - $repl_env->set(Symbol->new($n), $core_ns->{$n}); -} -$repl_env->set(Symbol->new('eval'), sub { EVAL($_[0]->nth(0), $repl_env); }); -my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Symbol->new('*ARGV*'), List->new(\@_argv)); - -# core.mal: defined using the language itself -REP("(def! *host-language* \"javascript\")"); -REP("(def! not (fn* (a) (if a false true)))"); -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - - -if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { - set_rl_mode("raw"); - shift @ARGV; -} -if (scalar(@ARGV) > 0) { - REP("(load-file \"" . $ARGV[0] . "\")"); - exit 0; -} -REP("(println (str \"Mal [\" *host-language* \"]\"))"); -while (1) { - my $line = mal_readline("user> "); - if (! defined $line) { last; } - do { - local $@; - my $ret; - eval { - use autodie; # always "throw" errors - print(REP($line), "\n"); - 1; - } or do { - my $err = $@; - given (ref $err) { - when (/^BlankException/) { - # ignore and continue - } - default { - chomp $err; - print "Error: $err\n"; - } - } - }; - }; -} diff --git a/perl/tests/stepA_mal.mal b/perl/tests/stepA_mal.mal deleted file mode 100644 index 1335be4021..0000000000 --- a/perl/tests/stepA_mal.mal +++ /dev/null @@ -1,22 +0,0 @@ -;; Testing types returned from pl* - -(pl* "123") -;=>123 - -(pl* "\"abc\"") -;=>"abc" - -(pl* "{'abc'=>123}") -;=>{"abc" 123} - -(pl* "['abc', 123]") -;=>("abc" 123) - -(pl* "2+3") -;=>5 - -;; Testing eval of print statement - -(pl* "print 'hello\n';") -; hello -;=>1 diff --git a/perl/types.pm b/perl/types.pm deleted file mode 100644 index e2d919c2d7..0000000000 --- a/perl/types.pm +++ /dev/null @@ -1,225 +0,0 @@ -package types; -use strict; -use warnings FATAL => qw(all); -no if $] >= 5.018, warnings => "experimental::smartmatch"; -use feature qw(switch); -use Exporter 'import'; -our @EXPORT_OK = qw(_sequential_Q _equal_Q _clone - $nil $true $false _nil_Q _true_Q _false_Q - _symbol _symbol_Q _keyword _keyword_Q _list_Q _vector_Q - _hash_map _hash_map_Q _assoc_BANG _dissoc_BANG _atom_Q); - -use Data::Dumper; - -# General functions - -sub _sequential_Q { - return _list_Q($_[0]) || _vector_Q($_[0]) -} - -sub _equal_Q { - my ($a, $b) = @_; - my ($ota, $otb) = (ref $a, ref $b); - if (!(($ota eq $otb) || (_sequential_Q($a) && _sequential_Q($b)))) { - return 0; - } - given (ref $a) { - when (/^Symbol/) { - return $$a eq $$b; - } - when (/^List/ || /^Vector/) { - if (! scalar(@{$a->{val}}) == scalar(@{$b->{val}})) { - return 0; - } - for (my $i=0; $i{val}}); $i++) { - if (! _equal_Q($a->nth($i), $b->nth($i))) { - return 0; - } - } - return 1; - } - when (/^HashMap/) { - die "TODO: Hash map comparison\n"; - } - default { - return $$a eq $$b; - } - } - return 0; -} - -sub _clone { - my ($obj) = @_; - given (ref $obj) { - when (/^List/) { - return List->new( [ @{$obj->{val}} ] ); - } - when (/^Vector/) { - return Vector->new( [ @{$obj->{val}} ] ); - } - when (/^HashMap/) { - return Vector->new( { %{$obj->{val}} } ); - } - when (/^Function/) { - return Function->new_from_hash( { %{$obj} } ); - } - default { - die "Clone of non-collection\n"; - } - } -} - -# Errors/Exceptions - -{ - package BlankException; - sub new { my $class = shift; bless String->new("Blank Line") => $class } -} - -# Scalars - -{ - package Nil; - sub new { my $class = shift; my $s = 'nil'; bless \$s => $class } -} -{ - package True; - sub new { my $class = shift; my $s = 'true'; bless \$s => $class } -} -{ - package False; - sub new { my $class = shift; my $s = 'false'; bless \$s => $class } -} - -our $nil = Nil->new(); -our $true = True->new(); -our $false = False->new(); - -sub _nil_Q { return $_[0] eq $nil } -sub _true_Q { return $_[0] eq $true } -sub _false_Q { return $_[0] eq $false } - - -{ - package Integer; - sub new { my $class = shift; bless \$_[0] => $class } -} - - -{ - package Symbol; - sub new { my $class = shift; bless \$_[0] => $class } -} -sub _symbol_Q { (ref $_[0]) =~ /^Symbol/ } - - -sub _keyword { return String->new(("\x{029e}".$_[0])); } -sub _keyword_Q { ((ref $_[0]) =~ /^String/) && ${$_[0]} =~ /^\x{029e}/; } - - -{ - package String; - sub new { my $class = shift; bless \$_[0] => $class } -} - - -# Lists - -{ - package List; - sub new { my $class = shift; bless {'meta'=>$nil, 'val'=>$_[0]}, $class } - sub nth { $_[0]->{val}->[$_[1]]; } - #sub _val { $_[0]->{val}->[$_[1]]->{val}; } # return value of nth item - sub rest { my @arr = @{$_[0]->{val}}; List->new([@arr[1..$#arr]]); } - sub slice { my @arr = @{$_[0]->{val}}; List->new([@arr[$_[1]..$_[2]]]); } -} - -sub _list_Q { (ref $_[0]) =~ /^List/ } - - -# Vectors - -{ - package Vector; - sub new { my $class = shift; bless {'meta'=>$nil, 'val'=>$_[0]}, $class } - sub nth { $_[0]->{val}->[$_[1]]; } - #sub _val { $_[0]->{val}->[$_[1]]->{val}; } # return value of nth item - sub rest { my @arr = @{$_[0]->{val}}; List->new([@arr[1..$#arr]]); } - sub slice { my @arr = @{$_[0]->{val}}; List->new([@arr[$_[1]..$_[2]]]); } -} - -sub _vector_Q { (ref $_[0]) =~ /^Vector/ } - - -# Hash Maps - -{ - package HashMap; - sub new { my $class = shift; bless {'meta'=>$nil, 'val'=>$_[0]}, $class } - sub get { $_[0]->{val}->{$_[1]}; } -} - -sub _hash_map { - my $hsh = {}; - return _assoc_BANG($hsh, @_); -} - -sub _assoc_BANG { - my $hsh = shift; - my @lst = @_; - for(my $i=0; $i{$$str} = $lst[$i+1]; - } - return HashMap->new($hsh); -} - -sub _dissoc_BANG { - my $hsh = shift; - my @lst = @_; - for(my $i=0; $i{$$str}; - } - return HashMap->new($hsh); -} - -sub _hash_map_Q { (ref $_[0]) =~ /^HashMap/ } - - -# Functions - -{ - package Function; - sub new { - my $class = shift; - my ($eval, $ast, $env, $params) = @_; - bless {'meta'=>$nil, - 'eval'=>$eval, - 'ast'=>$ast, - 'env'=>$env, - 'params'=>$params, - 'ismacro'=>0}, $class - } - sub new_from_hash { my $class = shift; bless $_[0], $class } - sub gen_env { - my $self = $_[0]; - return Env->new($self->{env}, $self->{params}, $_[1]); - } - sub apply { - my $self = $_[0]; - return &{ $self->{eval} }($self->{ast}, gen_env($self, $_[1])); - } -} - - -# Atoms - -{ - package Atom; - sub new { my $class = shift; bless {'meta'=>$nil, 'val'=>$_[0]}, $class } -} - -sub _atom_Q { (ref $_[0]) =~ /^Atom/ } - -1; diff --git a/php/Makefile b/php/Makefile deleted file mode 100644 index 659e89c299..0000000000 --- a/php/Makefile +++ /dev/null @@ -1,19 +0,0 @@ - -TESTS = - -SOURCES_BASE = readline.php types.php reader.php printer.php -SOURCES_LISP = env.php core.php stepA_mal.php -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - php $@ || exit 1; \ diff --git a/php/readline.php b/php/readline.php deleted file mode 100644 index 5e335019fa..0000000000 --- a/php/readline.php +++ /dev/null @@ -1,34 +0,0 @@ - diff --git a/php/step7_quote.php b/php/step7_quote.php deleted file mode 100644 index 37903d0bf7..0000000000 --- a/php/step7_quote.php +++ /dev/null @@ -1,168 +0,0 @@ - 0; -} - -function quasiquote($ast) { - if (!is_pair($ast)) { - return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { - return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); - } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); - } -} - -function eval_ast($ast, $env) { - if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } - foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } - return $el; - } elseif (_hash_map_Q($ast)) { - $new_hm = _hash_map(); - foreach (array_keys($ast->getArrayCopy()) as $key) { - $new_hm[$key] = MAL_EVAL($ast[$key], $env); - } - return $new_hm; - } else { - return $ast; - } -} - -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $a0 = $ast[0]; - $a0v = (_symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1], $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); - } - $ast = $ast[2]; - $env = $let_env; - break; // Continue loop (TCO) - case "quote": - return $ast[1]; - case "quasiquote": - $ast = quasiquote($ast[1]); - break; // Continue loop (TCO) - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; // Continue loop (TCO) - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; // Continue loop (TCO) - case "fn*": - return _function('MAL_EVAL', 'native', - $ast[2], $env, $ast[1]); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->ast; - $env = $f->gen_env($args); - // Continue loop (TCO) - } else { - return $f->apply($args); - } - } - - } -} - -// print -function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; -} - -// repl -$repl_env = new Env(NULL); -function rep($str) { - global $repl_env; - return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); -} - -// core.php: defined using PHP -foreach ($core_ns as $k=>$v) { - $repl_env->set(_symbol($k), _function($v)); -} -$repl_env->set(_symbol('eval'), _function(function($ast) { - global $repl_env; return MAL_EVAL($ast, $repl_env); -})); -$_argv = _list(); -for ($i=2; $i < count($argv); $i++) { - $_argv->append($argv[$i]); -} -$repl_env->set(_symbol('*ARGV*'), $_argv); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); - -if (count($argv) > 1) { - rep('(load-file "' . $argv[1] . '")'); - exit(0); -} - -// repl loop -do { - try { - $line = mal_readline("user> "); - if ($line === NULL) { break; } - if ($line !== "") { - print(rep($line)); - } - } catch (BlankException $e) { - continue; - } catch (Exception $e) { - echo "Error: " . $e->getMessage() . "\n"; - echo $e->getTraceAsString() . "\n"; - } -} while (true); - -?> diff --git a/php/step8_macros.php b/php/step8_macros.php deleted file mode 100644 index c7e0175643..0000000000 --- a/php/step8_macros.php +++ /dev/null @@ -1,195 +0,0 @@ - 0; -} - -function quasiquote($ast) { - if (!is_pair($ast)) { - return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { - return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); - } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); - } -} - -function is_macro_call($ast, $env) { - return is_pair($ast) && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} - -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]); - $args = array_slice($ast->getArrayCopy(),1); - $ast = $mac->apply($args); - } - return $ast; -} - -function eval_ast($ast, $env) { - if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } - foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } - return $el; - } elseif (_hash_map_Q($ast)) { - $new_hm = _hash_map(); - foreach (array_keys($ast->getArrayCopy()) as $key) { - $new_hm[$key] = MAL_EVAL($ast[$key], $env); - } - return $new_hm; - } else { - return $ast; - } -} - -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (_symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1], $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); - } - $ast = $ast[2]; - $env = $let_env; - break; // Continue loop (TCO) - case "quote": - return $ast[1]; - case "quasiquote": - $ast = quasiquote($ast[1]); - break; // Continue loop (TCO) - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; // Continue loop (TCO) - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; // Continue loop (TCO) - case "fn*": - return _function('MAL_EVAL', 'native', - $ast[2], $env, $ast[1]); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->ast; - $env = $f->gen_env($args); - // Continue loop (TCO) - } else { - return $f->apply($args); - } - } - - } -} - -// print -function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; -} - -// repl -$repl_env = new Env(NULL); -function rep($str) { - global $repl_env; - return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); -} - -// core.php: defined using PHP -foreach ($core_ns as $k=>$v) { - $repl_env->set(_symbol($k), _function($v)); -} -$repl_env->set(_symbol('eval'), _function(function($ast) { - global $repl_env; return MAL_EVAL($ast, $repl_env); -})); -$_argv = _list(); -for ($i=2; $i < count($argv); $i++) { - $_argv->append($argv[$i]); -} -$repl_env->set(_symbol('*ARGV*'), $_argv); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (count($argv) > 1) { - rep('(load-file "' . $argv[1] . '")'); - exit(0); -} - -// repl loop -do { - try { - $line = mal_readline("user> "); - if ($line === NULL) { break; } - if ($line !== "") { - print(rep($line)); - } - } catch (BlankException $e) { - continue; - } catch (Exception $e) { - echo "Error: " . $e->getMessage() . "\n"; - echo $e->getTraceAsString() . "\n"; - } -} while (true); - -?> diff --git a/php/step9_try.php b/php/step9_try.php deleted file mode 100644 index 0470763031..0000000000 --- a/php/step9_try.php +++ /dev/null @@ -1,213 +0,0 @@ - 0; -} - -function quasiquote($ast) { - if (!is_pair($ast)) { - return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { - return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); - } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); - } -} - -function is_macro_call($ast, $env) { - return is_pair($ast) && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} - -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]); - $args = array_slice($ast->getArrayCopy(),1); - $ast = $mac->apply($args); - } - return $ast; -} - -function eval_ast($ast, $env) { - if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } - foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } - return $el; - } elseif (_hash_map_Q($ast)) { - $new_hm = _hash_map(); - foreach (array_keys($ast->getArrayCopy()) as $key) { - $new_hm[$key] = MAL_EVAL($ast[$key], $env); - } - return $new_hm; - } else { - return $ast; - } -} - -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (_symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1], $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); - } - $ast = $ast[2]; - $env = $let_env; - break; // Continue loop (TCO) - case "quote": - return $ast[1]; - case "quasiquote": - $ast = quasiquote($ast[1]); - break; // Continue loop (TCO) - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "try*": - $a1 = $ast[1]; - $a2 = $ast[2]; - if ($a2[0]->value === "catch*") { - try { - return MAL_EVAL($a1, $env); - } catch (Error $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->obj)); - return MAL_EVAL($a2[2], $catch_env); - } catch (Exception $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->getMessage())); - return MAL_EVAL($a2[2], $catch_env); - } - } else { - return MAL_EVAL($a1, $env); - } - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; // Continue loop (TCO) - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; // Continue loop (TCO) - case "fn*": - return _function('MAL_EVAL', 'native', - $ast[2], $env, $ast[1]); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->ast; - $env = $f->gen_env($args); - // Continue loop (TCO) - } else { - return $f->apply($args); - } - } - - } -} - -// print -function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; -} - -// repl -$repl_env = new Env(NULL); -function rep($str) { - global $repl_env; - return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); -} - -// core.php: defined using PHP -foreach ($core_ns as $k=>$v) { - $repl_env->set(_symbol($k), _function($v)); -} -$repl_env->set(_symbol('eval'), _function(function($ast) { - global $repl_env; return MAL_EVAL($ast, $repl_env); -})); -$_argv = _list(); -for ($i=2; $i < count($argv); $i++) { - $_argv->append($argv[$i]); -} -$repl_env->set(_symbol('*ARGV*'), $_argv); - -// core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (count($argv) > 1) { - rep('(load-file "' . $argv[1] . '")'); - exit(0); -} - -// repl loop -do { - try { - $line = mal_readline("user> "); - if ($line === NULL) { break; } - if ($line !== "") { - print(rep($line)); - } - } catch (BlankException $e) { - continue; - } catch (Exception $e) { - echo "Error: " . $e->getMessage() . "\n"; - echo $e->getTraceAsString() . "\n"; - } -} while (true); - -?> diff --git a/php/stepA_mal.php b/php/stepA_mal.php deleted file mode 100644 index 1dc3b04640..0000000000 --- a/php/stepA_mal.php +++ /dev/null @@ -1,229 +0,0 @@ - 0; -} - -function quasiquote($ast) { - if (!is_pair($ast)) { - return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { - return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); - } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); - } -} - -function is_macro_call($ast, $env) { - return is_pair($ast) && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} - -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]); - $args = array_slice($ast->getArrayCopy(),1); - $ast = $mac->apply($args); - } - return $ast; -} - -function eval_ast($ast, $env) { - if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } - foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } - return $el; - } elseif (_hash_map_Q($ast)) { - $new_hm = _hash_map(); - foreach (array_keys($ast->getArrayCopy()) as $key) { - $new_hm[$key] = MAL_EVAL($ast[$key], $env); - } - return $new_hm; - } else { - return $ast; - } -} - -function MAL_EVAL($ast, $env) { - while (true) { - - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (_symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1], $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); - } - $ast = $ast[2]; - $env = $let_env; - break; // Continue loop (TCO) - case "quote": - return $ast[1]; - case "quasiquote": - $ast = quasiquote($ast[1]); - break; // Continue loop (TCO) - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "php*": - $res = eval($ast[1]); - switch (gettype($res)) { - case "array": - if ($res !== array_values($res)) { - $new_res = _hash_map(); - $new_res->exchangeArray($res); - return $new_res; - } else { - return call_user_func_array('_list', $res); - } - default: - return $res; - } - case "try*": - $a1 = $ast[1]; - $a2 = $ast[2]; - if ($a2[0]->value === "catch*") { - try { - return MAL_EVAL($a1, $env); - } catch (Error $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->obj)); - return MAL_EVAL($a2[2], $catch_env); - } catch (Exception $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->getMessage())); - return MAL_EVAL($a2[2], $catch_env); - } - } else { - return MAL_EVAL($a1, $env); - } - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; // Continue loop (TCO) - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; // Continue loop (TCO) - case "fn*": - return _function('MAL_EVAL', 'native', - $ast[2], $env, $ast[1]); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->ast; - $env = $f->gen_env($args); - // Continue loop (TCO) - } else { - return $f->apply($args); - } - } - - } -} - -// print -function MAL_PRINT($exp) { - return _pr_str($exp, True) . "\n"; -} - -// repl -$repl_env = new Env(NULL); -function rep($str) { - global $repl_env; - return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); -} - -// core.php: defined using PHP -foreach ($core_ns as $k=>$v) { - $repl_env->set(_symbol($k), _function($v)); -} -$repl_env->set(_symbol('eval'), _function(function($ast) { - global $repl_env; return MAL_EVAL($ast, $repl_env); -})); -$_argv = _list(); -for ($i=2; $i < count($argv); $i++) { - $_argv->append($argv[$i]); -} -$repl_env->set(_symbol('*ARGV*'), $_argv); - -// core.mal: defined using the language itself -rep("(def! *host-language* \"php\")"); -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); -rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); - -if (count($argv) > 1) { - rep('(load-file "' . $argv[1] . '")'); - exit(0); -} - -// repl loop -rep("(println (str \"Mal [\" *host-language* \"]\"))"); -do { - try { - $line = mal_readline("user> "); - if ($line === NULL) { break; } - if ($line !== "") { - print(rep($line)); - } - } catch (BlankException $e) { - continue; - } catch (Exception $e) { - echo "Error: " . $e->getMessage() . "\n"; - echo $e->getTraceAsString() . "\n"; - } -} while (true); - -?> diff --git a/php/tests/stepA_mal.mal b/php/tests/stepA_mal.mal deleted file mode 100644 index 15f8a9488d..0000000000 --- a/php/tests/stepA_mal.mal +++ /dev/null @@ -1,25 +0,0 @@ -;; Testing basic php interop - -(php* "return 7;") -;=>7 - -(php* "return '7';") -;=>"7" - -(php* "return array(7,8,9);") -;=>(7 8 9) - -(php* "return array(\"abc\" => 789);") -;=>{"abc" 789} - -(php* "print \"hello\n\";") -; hello -;=>nil - -(php* "global $foo; $foo=8;") -(php* "global $foo; return $foo;") -;=>8 - -(php* "global $f; $f = function($v) { return 1+$v; };") -(php* "global $f; return array_map($f, array(1,2,3));") -;=>(2 3 4) diff --git a/process/guide.md b/process/guide.md index df7eb5ec06..bda640206d 100644 --- a/process/guide.md +++ b/process/guide.md @@ -11,13 +11,30 @@ will be able to run a mal interpreter written in mal itself. So jump right in (er ... start the climb)! +- [Pick a language](#pick-a-language) +- [Getting started](#getting-started) +- [General hints](#general-hints) +- [The Make-A-Lisp Process](#the-make-a-lisp-process-1) + - [Step 0: The REPL](#step-0-the-repl) + - [Step 1: Read and Print](#step-1-read-and-print) + - [Step 2: Eval](#step-2-eval) + - [Step 3: Environments](#step-3-environments) + - [Step 4: If Fn Do](#step-4-if-fn-do) + - [Step 5: Tail call optimization](#step-5-tail-call-optimization) + - [Step 6: Files, Mutation, and Evil](#step-6-files-mutation-and-evil) + - [Step 7: Quoting](#step-7-quoting) + - [Step 8: Macros](#step-8-macros) + - [Step 9: Try](#step-9-try) + - [Step A: Metadata, Self-hosting and Interop](#step-a-metadata-self-hosting-and-interop) + + ## Pick a language You might already have a language in mind that you want to use. Technically speaking, mal can be implemented in any sufficiently -complete programming language (i.e. Turing complete), however, there are a few -language features that can make the task MUCH easier. Here are some of -them in rough order of importance: +complete programming language (i.e. Turing complete), however, there +are a few language features that can make the task MUCH easier. Here +are some of them in rough order of importance: * A sequential compound data structure (e.g. arrays, lists, vectors, etc) @@ -41,6 +58,12 @@ In addition, the following will make your task especially easy: Here are some examples of languages that have all of the above features: JavaScript, Ruby, Python, Lua, R, Clojure. +Michael Fogus has some great blog posts on interesting but less well +known languages and many of the languages on his lists do not yet have +any mal implementations: +* http://blog.fogus.me/2011/08/14/perlis-languages/ +* http://blog.fogus.me/2011/10/18/programming-language-development-the-past-5-years/ + Many of the most popular languages already have Mal implementations. However, this should not discourage you from creating your own implementation in a language that already has one. However, if you go @@ -51,9 +74,11 @@ add new implementations to mal as efficiently as possible, then you SHOULD find the most similar target language implementation and refer to it frequently. -If you want a fairly long list of programming languages with an -approximate measure of popularity, try the [Programming Language -Popularity Chart](http://langpop.corger.nl/) +If you want a list of programming languages with an +approximate measure of popularity try the [RedMonk Programming +Language +Rankings](https://redmonk.com/sogrady/2019/03/20/language-rankings-1-19/) +or the [GitHut 2.0 Project](https://madnight.github.io/githut). ## Getting started @@ -71,26 +96,51 @@ cd mal * Make a new directory for your implementation. For example, if your language is called "quux": ``` -mkdir quux +mkdir impls/quux ``` -* Modify the top level Makefile to allow the tests to be run against +* Modify the top level Makefile.impls to allow the tests to be run against your implementation. For example, if your language is named "quux" and uses "qx" as the file extension, then make the following - 3 modifications to Makefile: + 3 modifications to Makefile.impls: ``` IMPLS = ... quux ... ... -quux_STEP_TO_PROG = mylang/$($(1)).qx -... -quux_RUNSTEP = ../$(2) $(3) +quux_STEP_TO_PROG = impls/quux/$($(1)).qx +``` + +* Add a "run" script to your implementation directory that listens to + the "STEP" environment variable for the implementation step to run + and defaults to "stepA_mal". Make sure the run script has the + executable file permission set (or else the test runner might fail with a + permission denied error message). The following are examples of "run" + scripts for a compiled language and an interpreted language (where + the interpreter is named "quux"): + +``` +#!/usr/bin/env bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" +``` + +``` +#!/usr/bin/env bash +exec quux $(dirname $0)/${STEP:-stepA_mal}.qx "${@}" ``` This allows you to run tests against your implementation like this: ``` -make test^quux^stepX +make "test^quux^stepX" ``` +If your implementation language is a compiled language, then you +should also add a Makefile at the top level of your implementation +directory. This Makefile will define how to build the files pointed to +by the quux_STEP_TO_PROG macro. The top-level Makefile will attempt to +build those targets before running tests. If it is a scripting +language/uncompiled, then no Makefile is necessary because +quux_STEP_TO_PROG will point to a source file that already exists and +does not need to be compiled/built. + ## General hints @@ -112,16 +162,16 @@ that building a lisp interpreter is more like a branching tree. If you get stuck on tail call optimization, or hash-maps, move on to other things. You will often have a stroke of inspiration for a problem as you work through other functionality. I have tried to structure this -guide and the tests to make clear which things are optional or can be -deferred until later. - -An aside on optional bits: when you run the tests for a given step, -the last tests are often marked with an "optional" header. This -indicates that these are tests for functionality that is not critical -to finish a basic mal implementation. Many of the steps in this -process guide also have an "Optional" section, however, it is not -quite the same meaning. Those sections do include the functionality -that is marked as optional in the tests, but they also include +guide and the tests to make clear which things can be deferred until +later. + +An aside on deferrable/optional bits: when you run the tests for +a given step, the last tests are often marked with an "optional" +header. This indicates that these are tests for functionality that is +not critical to finish a basic mal implementation. Many of the steps +in this process guide have a "Deferrable" section, however, it is not +quite the same meaning. Those sections include the functionality that +is marked as optional in the tests, but they also include functionality that becomes mandatory at a later step. In other words, this is a "make your own Lisp adventure". @@ -130,18 +180,33 @@ a bunch of tests associated with it and there is an easy script to run all the tests for a specific step in the process. Pick a failing test, fix it, repeat until all the tests for that step pass. +## Reference Code + The `process` directory contains abbreviated pseudocode and -architecture images for each step of the make-a-lisp process. Use +architecture diagrams for each step of the make-a-lisp process. Use a textual diff/comparison tool to compare the previous pseudocode step -with the one you are working on. The architecture images have changes -from the previous step highlighted in red. +with the one you are working on. The architecture diagram images have +changes from the previous step highlighted in red. There is also +a concise +[cheatsheet](http://kanaka.github.io/mal/cheatsheet.html) that +summarizes the key changes at each step. -If you get stuck, find the same step or functionality in a different -implementation language. +If you get completely stuck and are feeling like giving up, then you +should "cheat" by referring to the same step or functionality in +an existing implementation language. You are here to learn, not to take +a test, so do not feel bad about it. Okay, you should feel a little +bit bad about it. ## The Make-A-Lisp Process +Feel free to follow the guide as literally or as loosely as you +like. You are here to learn; wandering off the beaten path may be the +way you learn best. However, each step builds on the previous steps, +so if you are new to Lisp or new to your implementation language then +you may want to stick more closely to the guide your first time +through to avoid frustration at later steps. + In the steps that follow the name of the target language is "quux" and the file extension for that language is "qx". @@ -154,7 +219,7 @@ the file extension for that language is "qx". This step is basically just creating a skeleton of your interpreter. -* Create a `step0_repl.qx` file in `quux/`. +* Create a `step0_repl.qx` file in `impls/quux/`. * Add the 4 trivial functions `READ`, `EVAL`, `PRINT`, and `rep` (read-eval-print). `READ`, `EVAL`, and `PRINT` are basically just @@ -172,9 +237,12 @@ This step is basically just creating a skeleton of your interpreter. language, then create a Makefile (or appropriate project definition file) in your directory. -Run your new program and make sure that it echos each line that you -type. Because step0 is so trivial, there are no automated tests to run -for it. +It is time to run your first tests. This will check that your program +does input and output in a way that can be captured by the test +harness. Go to the top level and run the following: +``` +make "test^quux^step0" +``` Add and then commit your new `step0_repl.qx` and `Makefile` to git. @@ -188,7 +256,7 @@ make-a-lisp process. interpreter REPL. Many languages have a library/module that provide line editing support. Another option if your language supports it is to use an FFI (foreign function interface) to load and call directly - into GNU readline, editline, or libnoise library. Add line + into GNU readline, editline, or linenoise library. Add line editing interface code to `readline.qx` @@ -242,25 +310,47 @@ expression support. * Add a `reader.qx` file to hold functions related to the reader. -* If the target language has objects types (OOP), then the next step +* If the target language has object types (OOP), then the next step is to create a simple stateful Reader object in `reader.qx`. This object will store the tokens and a position. The Reader object will - have two methods: `next` and `peek`. `next` returns the tokens at + have two methods: `next` and `peek`. `next` returns the token at the current position and increments the position. `peek` just returns the token at the current position. * Add a function `read_str` in `reader.qx`. This function - will call `tokenizer` and then create a new Reader object instance + will call `tokenize` and then create a new Reader object instance with the tokens. Then it will call `read_form` with the Reader instance. -* Add a function `tokenizer` in `reader.qx`. This function will take - a single single string and return an array/list +* Add a function `tokenize` in `reader.qx`. This function will take + a single string and return an array/list of all the tokens (strings) in it. The following regular expression (PCRE) will match all mal tokens. ``` -[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*) +[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*) ``` +* For each match captured within the parenthesis starting at char 6 of the + regular expression a new token will be created. + + * `[\s,]*`: Matches any number of whitespaces or commas. This is not captured + so it will be ignored and not tokenized. + + * `~@`: Captures the special two-characters `~@` (tokenized). + + * ```[\[\]{}()'`~^@]```: Captures any special single character, one of + ```[]{}()'`~^@``` (tokenized). + + * `"(?:\\.|[^\\"])*"?`: Starts capturing at a double-quote and stops at the + next double-quote unless it was preceded by a backslash in which case it + includes it until the next double-quote (tokenized). It will also + match unbalanced strings (no ending double-quote) which should be + reported as an error. + + * `;.*`: Captures any sequence of characters starting with `;` (tokenized). + + * ```[^\s\[\]{}('"`,;)]*```: Captures a sequence of zero or more non special + characters (e.g. symbols, numbers, "true", "false", and "nil") and is sort + of the inverse of the one above that captures special characters (tokenized). * Add the function `read_form` to `reader.qx`. This function will peek at the first token in the Reader object and switch on the @@ -270,31 +360,31 @@ expression support. is a mal data type. If your target language is statically typed then you will need some way for `read_form` to return a variant or subclass type. For example, if your language is object oriented, - then you cal define a top level MalType (in `types.qx`) that all + then you can define a top level MalType (in `types.qx`) that all your mal data types inherit from. The MalList type (which also - inherits from MalType) will contains a list/array of other MalTypes. + inherits from MalType) will contain a list/array of other MalTypes. If your language is dynamically typed then you can likely just return a plain list/array of other mal types. * Add the function `read_list` to `reader.qx`. This function will repeatedly call `read_form` with the Reader object until it - encounters a ')' token (if it reach EOF before reading a ')' then + encounters a ')' token (if it reaches EOF before reading a ')' then that is an error). It accumulates the results into a List type. If your language does not have a sequential data type that can hold mal type values you may need to implement one (in `types.qx`). Note that `read_list` repeatedly calls `read_form` rather than - `read_atom`. This mutually recursive defintion between `read_list` + `read_atom`. This mutually recursive definition between `read_list` and `read_form` is what allows lists to contain lists. * Add the function `read_atom` to `reader.qx`. This function will look at the contents of the token and return the appropriate scalar (simple/single) data type value. Initially, you can just implement - numbers (integers) and symbols . This will allow you to proceed + numbers (integers) and symbols. This will allow you to proceed through the next couple of steps before you will need to implement the other fundamental mal types: nil, true, false, and string. The - remaining mal types: keyword, vector, hash-map, and atom do not - need to be implemented until step 9 (but can be implemented at any - point between this step and that). BTW, symbols types are just an + remaining scalar mal type, keyword does not + need to be implemented until step A (but can be implemented at any + point between this step and that). BTW, symbol types are just an object that contains a single string name value (some languages have symbol types already). @@ -332,7 +422,7 @@ Once you have gotten past those simple manual tests, it is time to run the full suite of step 1 tests. Go to the top level and run the following: ``` -make test^quux^step1 +make "test^quux^step1" ``` Fix any test failures related to symbols, numbers and lists. @@ -342,8 +432,23 @@ that you have now just completed one of the most difficult steps. It is down hill from here. The remaining steps will probably be easier and each step will give progressively more bang for the buck. -#### Optional: +#### Deferrable: + +* Add support for the other basic data type to your reader and printer + functions: string, nil, true, and false. Nil, true, and false + become mandatory at step 4, strings at step 6. When a string is read, + the following transformations are + applied: a backslash followed by a doublequote is translated into + a plain doublequote character, a backslash followed by "n" is + translated into a newline, and a backslash followed by another + backslash is translated into a single backslash. To properly print + a string (for step 4 string functions), the `pr_str` function needs + another parameter called `print_readably`. When `print_readably` is + true, doublequotes, newlines, and backslashes are translated into + their printed representations (the reverse of the reader). The + `PRINT` function in the main program should call `pr_str` with + print_readably set to true. * Add error checking to your reader functions to make sure parens are properly matched. Catch and print these errors in your main @@ -351,29 +456,48 @@ and each step will give progressively more bang for the buck. exception handling, then you will need to add explicit error handling to your code to catch and pass on errors without crashing. -* Add support for the other basic data type to your reader and printer - functions: string, nil, true, and false. These become mandatory at - step 4. When a string is read, a slash followed by a doublequote is - translated into a plain doublequote character and a slash followed by - "n" is translated into a newline. To properly print a string (for - step 4 string functions), the `pr_str` function needs another - parameter called `print_readably`. When `print_readably` is true, - doublequotes and newlines are translated into their printed - representations (the reverse of the reader). The `PRINT` function in - the main program should call `pr_str` with print_readably set to - true. - -* Add support for the other mal types: keyword, vector, hash-map, and - atom. TODO/TBD - * keyword: just a string stored with unicode prefix (or char 127 if - no unicode support). - * vector: can be implemented with same underlying type as list if - there is some mechanism for marking/distinguishing from a list. - * hash-map: only need to implement string keys (which enables - keyword keys since they are just special strings). - -* Add support for reader macros which are special forms that are - transformed into other forms during the read phase. +* Add support for reader macros which are forms that are + transformed into other forms during the read phase. Refer to + `tests/step1_read_print.mal` for the form that these macros should + take (they are just simple transformations of the token stream). + +* Add support for the other mal types: keyword, vector, hash-map. + * keyword: a keyword is a token that begins with a colon. A keyword + can just be stored as a string with special unicode prefix like + 0x29E (or char 0xff/127 if the target language does not have good + unicode support) and the printer translates strings with that + prefix back to the keyword representation. This makes it easy to + use keywords as hash map keys in most languages. You can also + store keywords as a unique data type, but you will need to make + sure they can be used as hash map keys (which may involve doing + a similar prefixed translation anyways). + * vector: a vector can be implemented with same underlying + type as a list as long as there is some mechanism to keep track of + the difference. + Vector literals are similar to lists, but use bracket as + delimiters instead of parenthesis. + For example, `[]` constructs an empty vector and `[1 "a"]` a + vector with two elements. + You can use the same reader function for both + lists and vectors by adding parameters for the starting and ending + tokens. + * hash-map: a hash-map is an associative data structure that maps + strings to other mal values. If you implement keywords as prefixed + strings, then you only need a native associative data structure + which supports string keys. Clojure allows any value to be a hash + map key, but the base functionality in mal is to support strings + and keyword keys. + Hash-map literals are constructed with braces delimiters. + For example, + `{}` constructs an empty map, + `{"a" 1 :b "whatever"}` associates the `a` key to an integer value + and the `:b` key to a string value. + Because of the representation of hash-maps as + an alternating sequence of keys and values, you can probably use + the same reader function for hash-maps as lists and vectors with + parameters to indicate the starting and ending tokens. The odd + tokens are then used for keys with the corresponding even tokens + as the values. * Add comment support to your reader. The tokenizer should ignore tokens that start with ";". Your `read_str` function will need to @@ -398,7 +522,7 @@ functionality to the evaluator (`EVAL`). Compare the pseudocode for step 1 and step 2 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step1_read_print.txt ../process/step2_eval.txt +diff -u ../../process/step1_read_print.txt ../../process/step2_eval.txt ``` * Copy `step1_read_print.qx` to `step2_eval.qx`. @@ -417,22 +541,17 @@ repl_env = {'+': lambda a,b: a+b, * Modify the `rep` function to pass the REPL environment as the second parameter for the `EVAL` call. -* Create a new function `eval_ast` which takes `ast` (mal data type) - and an associative structure (the environment from above). - `eval_ast` switches on the type of `ast` as follows: +* In `EVAL`, switch on the type of the first parameter `ast` as follows: * symbol: lookup the symbol in the environment structure and return - the value or raise an error no value is found - * list: return a new list that is the result of calling `EVAL` on - each of the members of the list - * otherwise just return the original `ast` value + the value. + If the key is missing, throw/raise a "not found" error. -* Modify `EVAL` to check if the first parameter `ast` is a list. - * `ast` is not a list: then return the result of calling `eval_ast` - on it. - * `ast` is a list: call `eval_ast` to get a new evaluated list. Take - the first item of the evaluated list and call it as function using - the rest of the evaluated list as its arguments. + * `ast` is a non-empty list: + call `EVAL` on each of the members of the list. + Take the first evaluated item and call it as function using + the rest of the evaluated items as its arguments. + * otherwise just return the original `ast` value If your target language does not have full variable length argument support (e.g. variadic, vararg, splats, apply) then you will need to @@ -449,15 +568,37 @@ Try some simple expressions: * `(+ 2 (* 3 4))` -> `14` The most likely challenge you will encounter is how to properly call -a function references using an arguments list. +a function reference using an arguments list. Now go to the top level, run the step 2 tests and fix the errors. ``` -make test^quux^step2 +make "test^quux^step2" ``` You now have a simple prefix notation calculator! +#### Deferrable: + +* Add a print statement at the top of the main `eval` function, for + debugging issues or simply figuring how evaluation works. + The statement should be active when `env` contains the `DEBUG-EVAL` + key and the associated value is neither `nil` nor `false`. + For consistency, it should print "EVAL: " followed by the current + value of `ast` formatted with `pr_str` with the readably flag set. + Feel free to add any information you see fit, for example the + contents of `env`. + +* `EVAL` should evaluate elements of vectors and hash-maps. Add the + following cases in `EVAL`: + * If `ast` is a vector: return a new vector that is the result of calling + `EVAL` on each of the members of the vector. + * If `ast` is a hash-map: return a new hash-map which consists of key-value + pairs where the key is a key from the hash-map and the value is the result + of calling `EVAL` on the corresponding value. + Depending on the implementation of maps, it may be convenient to + also call `EVAL` on keys. The result is the same because keys are + not affected by evaluation. + @@ -468,7 +609,7 @@ You now have a simple prefix notation calculator! In step 2 you were already introduced to REPL environment (`repl_env`) where the basic numeric functions were stored and looked up. In this step you will add the ability to create new environments (`let*`) and -modify exiting environments (`def!`). +modify existing environments (`def!`). A Lisp environment is an associative data structure that maps symbols (the keys) to values. But Lisp environments have an additional important @@ -482,7 +623,7 @@ chain). Compare the pseudocode for step 2 and step 3 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step2_eval.txt ../process/step3_env.txt +diff -u ../../process/step2_eval.txt ../../process/step3_env.txt ``` * Copy `step2_eval.qx` to `step3_env.qx`. @@ -496,19 +637,19 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt * Define three methods for the Env object: * set: takes a symbol key and a mal value and adds to the `data` structure - * find: takes a symbol key and if the current environment contains - that key then return the environment. If no key is found and outer - is not `nil` then call find (recurse) on the outer environment. - * get: takes a symbol key and uses the `find` method to locate the - environment with the key, then returns the matching value. If no - key is found up the outer chain, then throws/raises a "not found" - error. - -* Update `step2_env.qx` to use the new `Env` type to create the + * get: takes a symbol key and if the current environment contains + that key then return the matching value. If no key is found and outer + is not `nil` then call get (recurse) on the outer environment. + Depending on the host language, a loop structure may be more + simple or efficient than a recursion. + If no key is found up the outer chain, then report that the key is + missing with the most idiomatic mechanism. + +* Update `step3_env.qx` to use the new `Env` type to create the repl_env (with a `nil` outer value) and use the `set` method to add the numeric functions. -* Modify `eval_ast` to call the `get` method on the `env` parameter. +* Modify `EVAL` to call the `get` method on the `env` parameter. * Modify the apply section of `EVAL` to switch on the first element of the list: @@ -516,21 +657,20 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt (second parameter of `EVAL` called `env`) using the unevaluated first parameter (second list element) as the symbol key and the evaluated second parameter as the value. - * symbol "let*": create a new environment using the current + * symbol "let\*": create a new environment using the current environment as the outer value and then use the first parameter as - a list of new bindings in the "let" environment. Take the second - element of the binding list, call `EVAL` using the new "let*" + a list of new bindings in the "let\*" environment. Take the second + element of the binding list, call `EVAL` using the new "let\*" environment as the evaluation environment, then call `set` on the - "let" environment using the first binding list element as the key + "let\*" environment using the first binding list element as the key and the evaluated second element as the value. This is repeated for each odd/even pair in the binding list. Note in particular, the bindings earlier in the list can be referred to by later bindings. Finally, the second parameter (third element) of the - original `let*` form is evaluated using the new "let*" environment + original `let*` form is evaluated using the new "let\*" environment and the result is returned as the result of the `let*` (the new let environment is discarded upon completion). - * otherwise: call `eval_ast` on the list and apply the first element - to the rest as before. + * otherwise: proceed as before. `def!` and `let*` are Lisp "specials" (or "special atoms") which means that they are language level features and more specifically that the @@ -538,7 +678,7 @@ rest of the list elements (arguments) may be evaluated differently (or not at all) unlike the default apply case where all elements of the list are evaluated before the first element is invoked. Lists which contain a "special" as the first element are known as "special forms". -The are special because the follow special evaluation rules. +They are special because they follow special evaluation rules. Try some simple environment tests: @@ -550,10 +690,10 @@ Try some simple environment tests: Now go to the top level, run the step 3 tests and fix the errors. ``` -make test^quux^step3 +make "test^quux^step3" ``` -You mal implementation is still basically just a numeric calculator +Your mal implementation is still basically just a numeric calculator with save/restore capability. But you have set the foundation for step 4 where it will begin to feel like a real programming language. @@ -576,8 +716,8 @@ run. Most Lisp variants tend to be dynamically typed (types of values are checked when they are actually used at runtime). As an aside-aside: The great debate between static and dynamic typing -debate can be understood by following the money. Advocates of strict -static typing use words like "correctness" and "safety" and thus get +can be understood by following the money. Advocates of strict static +typing use words like "correctness" and "safety" and thus get government and academic funding. Advocates of dynamic typing use words like "agile" and "time-to-market" and thus get venture capital and commercial funding. @@ -601,7 +741,7 @@ In some Lisps, this special form is named "lambda". Compare the pseudocode for step 3 and step 4 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step3_env.txt ../process/step4_if_fn_do.txt +diff -u ../../process/step3_env.txt ../../process/step4_if_fn_do.txt ``` * Copy `step3_env.qx` to `step4_if_fn_do.qx`. @@ -611,19 +751,19 @@ diff -urp ../process/step3_env.txt ../process/step4_if_fn_do.txt this step. * Update the constructor/initializer for environments to take two new - arguments: `binds` and `exprs`. Bind (`set`) each element (symbol) - of the binds list to the respective element of the `exprs` list. + parameters: `binds` and `exprs`. Bind (`set`) each element (symbol) + of the `binds` list to the respective element of the `exprs` list. -* Add support to `printer.qx` to print functions values. A string - literal like "#" is sufficient. +* Add support to `printer.qx` to print function values. A string + literal like "#\" is sufficient. -* Add the following special forms to `EVAL`. +* Add the following special forms to `EVAL`: - * `do`: Evaluate the all the elements of the list and return the - final element (evaluated). + * `do`: Evaluate all the elements of the list + and return the final evaluated element. * `if`: Evaluate the first parameter (second element). If the result (condition) is anything other than `nil` or `false`, then evaluate - the second parammeter (third element of the list) and return the + the second parameter (third element of the list) and return the result. Otherwise, evaluate the third parameter (fourth element) and return the result. If condition is false and there is no third parameter, then just return `nil`. @@ -649,10 +789,10 @@ the apply section of `EVAL`. Try out the basic functionality you have implemented: - * `(fn* [a] a)` -> `#` - * `( (fn* [a] a) 7)` -> `7` - * `( (fn* [a] (+ a 1)) 10)` -> `11` - * `( (fn* [a b] (+ a b)) 2 3)` -> `5` + * `(fn* (a) a)` -> `#` + * `( (fn* (a) a) 7)` -> `7` + * `( (fn* (a) (+ a 1)) 10)` -> `11` + * `( (fn* (a b) (+ a b)) 2 3)` -> `5` * Add a new file `core.qx` and define an associative data structure `ns` (namespace) that maps symbols to functions. Move the numeric @@ -663,6 +803,9 @@ Try out the basic functionality you have implemented: REPL environment (`repl_env`). * Add the following functions to `core.ns`: + * `prn`: call `pr_str` on the first parameter with `print_readably` + set to true, print the result to the screen and then return + `nil`. Note that the full version of `prn` is a deferrable below. * `list`: take the parameters and return them as a list. * `list?`: return true if the first parameter is a list, false otherwise. @@ -683,16 +826,17 @@ tests in step 4 but all of the non-optional tests that do not involve strings should be able to pass now. ``` -make test^quux^step4 +make "test^quux^step4" ``` Your mal implementation is already beginning to look like a real language. You have flow control, conditionals, user-defined functions with lexical scope, side-effects (if you implement the string -functions), etc. However, our little interpreter has not quite reach -Lisp-ness yet. The next several steps will take +functions), etc. However, our little interpreter has not quite reached +Lisp-ness yet. The next several steps will take your implementation +from a neat toy to a full featured language. -#### Optional: +#### Deferrable: * Implement Clojure-style variadic function parameters. Modify the constructor/initializer for environments, so that if a "&" symbol is @@ -700,13 +844,13 @@ Lisp-ness yet. The next several steps will take after the "&" is bound to the rest of the `exprs` list that has not been bound yet. -* Defines a `not` function using mal itself. In `step4_if_fn_do.qx` +* Define a `not` function using mal itself. In `step4_if_fn_do.qx` call the `rep` function with this string: "(def! not (fn* (a) (if a false true)))". -* Implement the strings functions in `core.qx`. To implement these +* Implement the string functions in `core.qx`. To implement these functions, you will need to implement the string support in the - reader and printer (optional section of step 1). Each of the string + reader and printer (deferrable section of step 1). Each of the string functions takes multiple mal values, prints them (`pr_str`) and joins them together into a new string. * `pr-str`: calls `pr_str` on each argument with `print_readably` @@ -739,18 +883,19 @@ calling back into `EVAL`. For those forms that call `EVAL` as the last thing that they do before returning (tail call) you will just loop back to the beginning of eval rather than calling it again. The advantage of this approach is that it avoids adding more frames to the call -stack. This is especially important in Lisp languages because they do -not tend to have iteration control structures preferring recursion -instead. However, with tail call optimization, recursion can be made -as stack efficient as iteration. +stack. This is especially important in Lisp languages because they tend +to prefer using recursion instead of iteration for control structures. +(Though some Lisps, such as Common Lisp, have iteration.) However, with +tail call optimization, recursion can be made as stack efficient as +iteration. Compare the pseudocode for step 4 and step 5 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt +diff -u ../../process/step4_if_fn_do.txt ../../process/step5_tco.txt ``` -* Copy `step4_env.qx` to `step5_tco.qx`. +* Copy `step4_if_fn_do.qx` to `step5_tco.qx`. * Add a loop (e.g. while true) around all code in `EVAL`. @@ -762,9 +907,9 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt `ast` (i.e. the local variable passed in as first parameter of `EVAL`) to be the second `ast` argument. Continue at the beginning of the loop (no return). - * `do`: change the `eval_ast` call to evaluate all the parameters - the except for the last (2nd list element up to but not - including last). Set `ast` to the last element of `ast`. Continue + * `do`: change the implementation to evaluate all the parameters + except for the last (2nd list element up to but not including + last). Set `ast` to the last element of `ast`. Continue at the beginning of the loop (`env` stays unchanged). * `if`: the condition continues to be evaluated, however, rather than evaluating the true or false branch, `ast` is set to the @@ -774,24 +919,29 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt * The return value from the `fn*` special form will now become an object/structure with attributes that allow the default invoke case of `EVAL` to do TCO on mal functions. Those attributes are: - * `fn`: the original function value return in step 4 * `ast`: the second `ast` argument (third list element) representing the body of the function. * `params`: the first `ast` argument (second list element) representing the parameter names of the function. * `env`: the current value of the `env` parameter of `EVAL`. + * `fn`: the original function value (i.e. what was return by `fn*` + in step 4). Note that this is deferrable until step 9 when it is + required for the `map` and `apply` core functions). You will also + need it in step 6 if you choose to not to defer atoms/`swap!` from + that step. * The default "apply"/invoke case of `EVAL` must now be changed to account for the new object/structure returned by the `fn*` form. - Continue to call `eval_ast` on `ast`. The first element is `f`. + Once each element of `ast` is evaluated, the first element of the + result of `eval_ast` is `f` and the remaining elements are in `args`. Switch on the type of `f`: * regular function (not one defined by `fn*`): apply/invoke it as - * before (in step 4). + before (in step 4). * a `fn*` value: set `ast` to the `ast` attribute of `f`. Generate a new environment using the `env` and `params` attributes of `f` - as the `outer` and `binds` arguments and rest `ast` arguments - (list elements 2 through the end) as the `exprs` argument. Set - `env` to the new environment. Continue at the beginning of the loop. + as the `outer` and `binds` arguments and `args` as the `exprs` + argument. Set `env` to the new environment. Continue at the + beginning of the loop. Run some manual tests from previous steps to make sure you have not broken anything by adding TCO. @@ -799,7 +949,7 @@ broken anything by adding TCO. Now go to the top level, run the step 5 tests. ``` -make test^quux^step5 +make "test^quux^step5" ``` Look at the step 5 test file `tests/step5_tco.mal`. The `sum-to` @@ -818,7 +968,7 @@ that most mainstream languages lack. -### Step 6: Files and Evil +### Step 6: Files, Mutation, and Evil ![step6_file architecture](step6_file.png) @@ -832,7 +982,7 @@ holding off on that you will need to go back and do so. Compare the pseudocode for step 5 and step 6 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step5_tco.txt ../process/step6_file.txt +diff -u ../../process/step5_tco.txt ../../process/step6_file.txt ``` * Copy `step5_tco.qx` to `step6_file.qx`. @@ -849,16 +999,22 @@ diff -urp ../process/step5_tco.txt ../process/step6_file.txt unmarshall (extract) the string parameter to get the raw file name string and marshall (wrap) the result back to a mal string type. -* In your main program, add a new `eval` (symbol) entry to your REPL - environment. The value of the new entry is a regular function - closure with a single argument `ast`. The closure calls the real - `EVAL` function using the `ast` as the first argument and the REPL - environment (closed over from outside) as the second argument. The - result of the `EVAL` call is returned. +* In your main program, add a new symbol "eval" to your REPL + environment. The value of this new entry is a function that takes + a single argument `ast`. The closure calls your `EVAL` function + using the `ast` as the first argument and the REPL environment + (closed over from outside) as the second argument. The result of + the `EVAL` call is returned. This simple but powerful addition + allows your program to treat mal data as a mal program. For example, + you can now do this: +``` +(def! mal-prog (list + 1 2)) +(eval mal-prog) +``` * Define a `load-file` function using mal itself. In your main program call the `rep` function with this string: - "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))". + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))". Try out `load-file`: * `(load-file "../tests/incA.mal")` -> `9` @@ -867,27 +1023,71 @@ Try out `load-file`: The `load-file` function does the following: * Call `slurp` to read in a file by name. Surround the contents with "(do ...)" so that the whole file will be treated as a single - program AST (abstract syntax tree). + program AST (abstract syntax tree). Add a new line in case the files + ends with a comment. The `nil` ensures a short and predictable result, + instead of what happens to be the last function defined in the loaded file. * Call `read-string` on the string returned from `slurp`. This uses the reader to read/convert the file contents into mal data/AST. * Call `eval` (the one in the REPL environment) on the AST returned from `read-string` to "run" it. +Besides adding file and eval support, we'll add support for the atom data type +in this step. An atom is the Mal way to represent *state*; it is +heavily inspired by [Clojure's atoms](http://clojure.org/state). An atom holds +a reference to a single Mal value of any type; it supports reading that Mal value +and *modifying* the reference to point to another Mal value. Note that this is +the only Mal data type that is mutable (but the Mal values it refers to are +still immutable; immutability is explained in greater detail in step 7). +You'll need to add 5 functions to the core namespace to support atoms: + + * `atom`: Takes a Mal value and returns a new atom which points to that Mal value. + * `atom?`: Takes an argument and returns `true` if the argument is an atom. + * `deref`: Takes an atom argument and returns the Mal value referenced by this atom. + * `reset!`: Takes an atom and a Mal value; the atom is modified to refer to + the given Mal value. The Mal value is returned. + * `swap!`: Takes an atom, a function, and zero or more function arguments. The + atom's value is modified to the result of applying the function with the atom's + value as the first argument and the optionally given function arguments as + the rest of the arguments. The new atom's value is returned. (Side note: Mal is + single-threaded, but in concurrent languages like Clojure, `swap!` promises + atomic update: `(swap! myatom (fn* [x] (+ 1 x)))` will always increase the + `myatom` counter by one and will not suffer from missing updates when the + atom is updated from multiple threads.) + +Optionally, you can add a reader macro `@` which will serve as a short form for +`deref`, so that `@a` is equivalent to `(deref a)`. In order to do that, modify +the conditional in reader function `read_form` and add a case which deals with +the `@` token: if the token is `@` (at sign) then return a new list that +contains the symbol `deref` and the result of reading the next form +(`read_form`). + Now go to the top level, run the step 6 tests. The optional tests will -need support from the reader for comments, vectors and hash-maps: +need support from the reader for comments, vectors, hash-maps and the `@` +reader macro: ``` -make test^quux^step6 +make "test^quux^step6" ``` Congratulations, you now have a full-fledged scripting language that -can run other mal programs. However, the set of functions that are -available (from `core.qx`) is fairly limited. The bulk of the -functions you will add are described in step 9, but you will begin to -flesh them out over the next few steps to support quoting (step 7) and -macros (step 8). - - -#### Optional: +can run other mal programs. The `slurp` function loads a file as +a string, the `read-string` function calls the mal reader to turn that +string into data, and the `eval` function takes data and evaluates it +as a normal mal program. However, it is important to note that the +`eval` function is not just for running external programs. Because mal +programs are regular mal data structures, you can dynamically generate +or manipulate those data structures before calling `eval` on them. +This isomorphism (same shape) between data and programs is known as +"homoiconicity". Lisp languages are homoiconic and this property +distinguishes them from most other programming languages. + +Your mal implementation is quite powerful already but the set of +functions that are available (from `core.qx`) is fairly limited. The +bulk of the functions you will add are described in step 9 and step A, +but you will begin to flesh them out over the next few steps to +support quoting (step 7) and macros (step 8). + + +#### Deferrable: * Add the ability to run another mal program from the command line. Prior to the REPL loop, check if your mal implementation is called @@ -897,7 +1097,7 @@ macros (step 8). * Add the rest of the command line arguments to your REPL environment so that programs that are run with `load-file` have access to their - calling environmnet. Add a new "*ARGV*" (symbol) entry to your REPL + calling environment. Add a new "\*ARGV\*" (symbol) entry to your REPL environment. The value of this entry should be the rest of the command line arguments as a mal list value. @@ -915,13 +1115,13 @@ add a powerful abstraction for manipulating mal code itself The `quote` special form indicates to the evaluator (`EVAL`) that the parameter should not be evaluated (yet). At first glance, this might -not seem particular useful but an example of what this enables is the +not seem particularly useful but an example of what this enables is the ability for a mal program to refer to a symbol itself rather than the value that it evaluates to. Likewise with lists. For example, consider the following: * `(prn abc)`: this will lookup the symbol `abc` in the current - evaluation environment and print it. This will result in error if + evaluation environment and print it. This will result in an error if `abc` is not defined. * `(prn (quote abc))`: this will print "abc" (prints the symbol itself). This will work regardless of whether `abc` is defined in @@ -939,27 +1139,28 @@ unquoted (normal evaluation). There are two special forms that only mean something within a quasiquoted list: `unquote` and `splice-unquote`. These are perhaps best explained with some examples: -* `(def! lst (quote (2 3)))` -> `(2 3)` -* `(quasiquote (1 (unquote lst)))` -> `(1 (2 3))` -* `(quasiquote (1 (splice-unquote lst)))` -> `(1 2 3)` +* `(def! lst (quote (b c)))` -> `(b c)` +* `(quasiquote (a lst d))` -> `(a lst d)` +* `(quasiquote (a (unquote lst) d))` -> `(a (b c) d)` +* `(quasiquote (a (splice-unquote lst) d))` -> `(a b c d)` The `unquote` form turns evaluation back on for its argument and the result of evaluation is put in place into the quasiquoted list. The `splice-unquote` also turns evaluation back on for its argument, but the evaluated value must be a list which is then "spliced" into the quasiquoted list. The true power of the quasiquote form will be -manifest when it used together with macros (in the next step). +manifest when it is used together with macros (in the next step). Compare the pseudocode for step 6 and step 7 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step6_file.txt ../process/step7_quote.txt +diff -u ../../process/step6_file.txt ../../process/step7_quote.txt ``` * Copy `step6_file.qx` to `step7_quote.qx`. * Before implementing the quoting forms, you will need to implement -* some supporting functions in the core namespace: + some supporting functions in the core namespace: * `cons`: this function takes a list as its second parameter and returns a new list that has the first argument prepended to it. @@ -978,53 +1179,82 @@ Mal borrows most of its syntax and feature-set). * Add the `quote` special form. This form just returns its argument (the second list element of `ast`). -* Add the `quasiquote` special form. First implement a helper function - `is_pair` that returns true if the parameter is a non-empty list. - Then define a `quasiquote` function. This is called from `EVAL` with - the first `ast` argument (second list element) and then `ast` is set - to the result and execution continues at the top of the loop (TCO). +* Add the `quasiquote` function. The `quasiquote` function takes a parameter `ast` and has the - following conditional: - 1. if `is_pair` of `ast` is false: return a new list containing: - a symbol named "quote" and `ast`. - 2. else if the first element of `ast` is a symbol named "unquote": - return the second element of `ast`. - 3. if `is_pair` of first element of `ast` is true and the first - element of first element of `ast` (`ast[0][0]`) is a symbol named - "splice-unquote": return a new list containing: a symbol named - "concat", the second element of first element of `ast` - (`ast[0][1]`), and the result of calling `quasiquote` with the - second through last element of `ast`. - 4. otherwise: return a new list containing: a symbol named "cons", the - result of calling `quasiquote` on first element of `ast` - (`ast[0]`), and result of calling `quasiquote` with the second - through last element of `ast`. - + following conditional. + - If `ast` is a list starting with the "unquote" symbol, return its + second element. + - If `ast` is a list failing the previous test, the result will be a + list populated by the following process. + + The result is initially an empty list. + Iterate over each element `elt` of `ast` in reverse order: + - If `elt` is a list starting with the "splice-unquote" symbol, + replace the current result with a list containing: + the "concat" symbol, + the second element of `elt`, + then the previous result. + - Else replace the current result with a list containing: + the "cons" symbol, + the result of calling `quasiquote` with `elt` as argument, + then the previous result. + + This process can also be described recursively: + - If `ast` is empty return it unchanged. else let `elt` be its + first element. + - If `elt` is a list starting with the "splice-unquote" symbol, + return a list containing: + the "concat" symbol, + the second element of `elt`, + then the result of processing the rest of `ast`. + - Else return a list containing: + the "cons" symbol, + the result of calling `quasiquote` with `elt` as argument, + then the result of processing the rest of `ast`. + - If `ast` is a map or a symbol, return a list containing: + the "quote" symbol, + then `ast`. + - Else return `ast` unchanged. + Such forms are not affected by evaluation, so you may quote them + as in the previous case if implementation is easier. + +* Add the `quasiquote` special form. + This form calls the `quasiquote` function using the first `ast` + argument (second list element), + then evaluates the result in the current environment, + either by recursively calling `EVAL` with the result and `env`, + or by assigning `ast` with the result and continuing execution at + the top of the loop (TCO). Now go to the top level, run the step 7 tests: ``` -make test^quux^step7 +make "test^quux^step7" ``` +If some tests do not pass, it may be convenient to enable the debug +print statement at the top of your main `eval` function (inside the +TCO loop). The quasiquoted but yet unevaluated AST will often reveal +the source of the issue. + Quoting is one of the more mundane functions available in mal, but do not let that discourage you. Your mal implementation is almost -complete, and quoting sets the stage for the next very exiting step: +complete, and quoting sets the stage for the next very exciting step: macros. -#### Optional +#### Deferrable * The full names for the quoting forms are fairly verbose. Most Lisp languages have a short-hand syntax and Mal is no exception. These short-hand syntaxes are known as reader macros because they allow us to manipulate mal code during the reader phase. Macros that run during the eval phase are just called "macros" and are described in - the next section. Expand the conditional with reader `read_form` - function to add the following four cases: + the next section. Expand the conditional in reader function + `read_form` to add the following four cases: * token is "'" (single quote): return a new list that contains the symbol "quote" and the result of reading the next form (`read_form`). - * token is "`" (back-tick): return a new list that contains the + * token is "\`" (back-tick): return a new list that contains the symbol "quasiquote" and the result of reading the next form (`read_form`). * token is "~" (tilde): return a new list that contains the @@ -1034,12 +1264,20 @@ macros. the symbol "splice-unquote" and the result of reading the next form (`read_form`). -* Add support for quoting of vectors. The `is_pair` function should - return true if the argument is a non-empty list or vector. `cons` +* Add support for quoting of vectors. `cons` should also accept a vector as the second argument. The return value - is a list regardless. `concat` should support concatenation of - lists, vectors, or a mix or both. The result is always a list. + is a list regardless. `concat` should support concatenation of + lists, vectors, or a mix of both. The result is always a list. + + Implement a core function `vec` turning a list into a vector with + the same elements. If provided a vector, `vec` should return it + unchanged. + In the `quasiquote` function, when `ast` is a vector, + return a list containing: + the "vec" symbol, + then the result of processing `ast` as if it were a list not + starting with `unquote`. @@ -1047,7 +1285,7 @@ macros. ![step8_macros architecture](step8_macros.png) -Your mal implementation is now ready for one of the most Lispy and +Your mal implementation is now ready for one of the most lispy and exciting of all programming concepts: macros. In the previous step, quoting enabled some simple manipulation data structures and therefore manipulation of mal code (because the `eval` function from step @@ -1060,7 +1298,7 @@ the mal language itself. Compare the pseudocode for step 7 and step 8 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step7_quote.txt ../process/step8_macros.txt +diff -u ../../process/step7_quote.txt ../../process/step8_macros.txt ``` * Copy `step7_quote.qx` to `step8_macros.qx`. @@ -1077,52 +1315,47 @@ simple. `def!` form, but before the evaluated value (mal function) is set in the environment, the `is_macro` attribute should be set to true. -* Add a `is_macro_call` function: This function takes arguments `ast` - and `env`. It returns true if `ast` is a list that contains a symbol - as the first element and that symbol refers to a function in the - `env` environment and that function has the `is_macro` attribute set - to true. Otherwise, it returns false. - -* Add a `macroexpand` function: This function takes arguments `ast` - and `env`. It calls `is_macro_call` with `ast` and `env` and loops - while that condition is true. Inside the loop, the first element of - the `ast` list (a symbol), is looked up in the environment to get - the macro function. This macro function is then called/applied with - the rest of the `ast` elements (2nd through the last) as arguments. - The return value of the macro call becomes the new value of `ast`. - When the loop completes because `ast` no longer represents a macro - call, the current value of `ast` is returned. - -* In the evaluator (`EVAL`) before the special forms switch (apply - section), perform macro expansion by calling the `macroexpand` - function with the current value of `ast` and `env`. Set `ast` to the - result of that call. If the new value of `ast` is no longer a list - after macro expansion, then return `ast`, otherwise continue with - the rest of the apply section (special forms switch). - -* Add a new special form condition for `macroexpand`. Call the - `macroexpand` function using the first `ast` argument (second list - element) and `env`. Return the result. This special form allows - a mal program to do explicit macro expansion without applying the - result (which can be useful for debugging macro expansion). +* In `EVAL`, + when `ast` is a non-empty list without leading special form, + the normal apply phase evaluates all elements of `ast`. + + Start by evaluating the first element separately. + The result must be a function. + If this function does have the `is_macro` attribute set, + + * apply the function to the (unevaluated) remaining elements of + `ast`, producing a new form. + + * evaluate the new form in the `env` environment. + Of course, instead of recursively calling `EVAL`, replace `ast` + with the new form and restart the TCO loop. + + For functions without the attribute, proceed as before: evaluate the + remaining elements of `ast`, then apply the function to them. + + +If you check existing implementations, be warned that former versions +of this guide were describing a slightly different macro expansion +mechanism. Now go to the top level, run the step 8 tests: ``` -make test^quux^step8 +make "test^quux^step8" ``` There is a reasonably good chance that the macro tests will not pass the first time. Although the implementation of macros is fairly simple, debugging runtime bugs with macros can be fairly tricky. If you do run into subtle problems that are difficult to solve, let me -recommend a couple of approaches: - -* Use the macroexpand special form to eliminate one of the layers of - indirection (to expand but skip evaluate). This will often reveal - the source of the issue. -* Add a debug print statement to the top of your main `eval` function - (inside the TCO loop) to print the current value of `ast` (hint use - `pr_str` to get easier to debug output). Pull up the step8 + +recommend an approach: + +* Enable the debug print statement at the top of your main `eval` + function (inside the TCO loop). + The expanded but yet unevaluated AST will often reveal the source of + the issue. + +* Pull up the step8 implementation from another language and uncomment its `eval` function (yes, I give you permission to violate the rule this once). Run the two side-by-side. The first difference is likely to point to @@ -1132,10 +1365,10 @@ Congratulations! You now have a Lisp interpreter with a super power that most non-Lisp languages can only dream of (I have it on good authority that languages dream when you are not using them). If you are not already familiar with Lisp macros, I suggest the following -excercise: write a recursive macro that handles postfixed mal code +exercise: write a recursive macro that handles postfixed mal code (with the function as the last parameter instead of the first). Or not. I have not actually done so myself, but I have heard it is an -interesting excercise. +interesting exercise. In the next step you will add try/catch style exception handling to your implementation in addition to some new core functions. After @@ -1143,7 +1376,7 @@ step9 you will be very close to having a fully self-hosting mal implementation. Let us continue! -### Optional +#### Deferrable * Add the following new core functions which are frequently used in macro functions: @@ -1151,16 +1384,22 @@ implementation. Let us continue! as arguments, returns the element of the list at the given index. If the index is out of range, this function raises an exception. * `first`: this function takes a list (or vector) as its argument - and return the first element. If the list (or vector) is empty or + and returns the first element. If the list (or vector) is empty or is `nil` then `nil` is returned. * `rest`: this function takes a list (or vector) as its argument and - returns a new list containing all the elements except the first. + returns a new list containing all the elements except the first. If + the list (or vector) is empty or is `nil` then `()` (empty list) + is returned. -* In the main program, use the `rep` function to define two new - control structures macros. Here are the string arguments for `rep` - to define these macros: - * `cond`: "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" - * `or`: "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" +* In the main program, call the `rep` function with the following + string argument to define a new control structure. +``` +"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +``` + * Note that `cond` calls the `throw` function when `cond` is + called with an odd number of args. The `throw` function is + implemented in the next step, but it will still serve it's + purpose here by causing an undefined symbol error. @@ -1169,44 +1408,338 @@ implementation. Let us continue! ![step9_try architecture](step9_try.png) +In this step you will implement the final mal special form for +error/exception handling: `try*/catch*`. You will also add several core +functions to your implementation. In particular, you will enhance the +functional programming pedigree of your implementation by adding the +`apply` and `map` core functions. + Compare the pseudocode for step 8 and step 9 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step8_macros.txt ../process/step9_try.txt +diff -u ../../process/step8_macros.txt ../../process/step9_try.txt ``` * Copy `step8_macros.qx` to `step9_try.qx`. -* TODO/TBD - - - +* Add the `try*/catch*` special form to the EVAL function. The + try catch form looks like this: `(try* A (catch* B C))`. The form + `A` is evaluated, if it throws an exception, then form `C` is + evaluated with a new environment that binds the symbol `B` to the + value of the exception that was thrown. + * If your target language has built-in try/catch style exception + handling then you are already 90% of the way done. Add a + (native language) try/catch block that evaluates `A` within + the try block and catches all exceptions. If an exception is + caught, then translate it to a mal type/value. For native + exceptions this is either the message string or a mal hash-map + that contains the message string and other attributes of the + exception. When a regular mal type/value is used as an + exception, you will probably need to store it within a native + exception type in order to be able to convey/transport it using + the native try/catch mechanism. Then you will extract the mal + type/value from the native exception. Create a new mal environment + that binds `B` to the value of the exception. Finally, evaluate `C` + using that new environment. + * If your target language does not have built-in try/catch style + exception handling then you have some extra work to do. One of the + most straightforward approaches is to create a a global error + variable that stores the thrown mal type/value. The complication + is that there are a bunch of places where you must check to see if + the global error state is set and return without proceeding. The + rule of thumb is that this check should happen at the top of your + EVAL function and also right after any call to EVAL (and after any + function call that might happen to call EVAL further down the + chain). Yes, it is ugly, but you were warned in the section on + picking a language. + +* Add the `throw` core function. + * If your language supports try/catch style exception handling, then + this function takes a mal type/value and throws/raises it as an + exception. In order to do this, you may need to create a custom + exception object that wraps a mal value/type. + * If your language does not support try/catch style exception + handling, then set the global error state to the mal type/value. + +* Add the `apply` and `map` core functions. In step 5, if you did not + add the original function (`fn`) to the structure returned from + `fn*`, then you will need to do so now. + * `apply`: takes at least two arguments. The first argument is + a function and the last argument is a list (or vector). The + function may be either a built-in core function, + an user function constructed with the `fn*` special form, + or a macro, not distinguished from the underlying user function). The + arguments between the function and the last argument (if there are + any) are concatenated with the final argument to create the + arguments that are used to call the function. The apply + function allows a function to be called with arguments that are + contained in a list (or vector). In other words, `(apply F A B [C + D])` is equivalent to `(F A B C D)`. + * `map`: takes a function and a list (or vector) and evaluates the + function against every element of the list (or vector) one at + a time and returns the results as a list. + +* Add some type predicate core functions. In Lisp, predicates are + functions that return true/false (or true value/nil) and typically + end in "?" or "p". + * `nil?`: takes a single argument and returns true (mal true value) + if the argument is nil (mal nil value). + * `true?`: takes a single argument and returns true (mal true value) + if the argument is a true value (mal true value). + * `false?`: takes a single argument and returns true (mal true + value) if the argument is a false value (mal false value). + * `symbol?`: takes a single argument and returns true (mal true + value) if the argument is a symbol (mal symbol value). + +Now go to the top level, run the step 9 tests: +``` +make "test^quux^step9" +``` -### Step A: Interop and Self-hosting +Your mal implementation is now essentially a fully featured Lisp +interpreter. But if you stop now you will miss one of the most +satisfying and enlightening aspects of creating a mal implementation: +self-hosting. + +#### Deferrable + +* Add the following new core functions: + * `symbol`: takes a string and returns a new symbol with the string + as its name. + * `keyword`: takes a string and returns a keyword with the same name + (usually just be prepending the special keyword + unicode symbol). This function should also detect if the argument + is already a keyword and just return it. + * `keyword?`: takes a single argument and returns true (mal true + value) if the argument is a keyword, otherwise returns false (mal + false value). + * `vector`: takes a variable number of arguments and returns + a vector containing those arguments. + * `vector?`: takes a single argument and returns true (mal true + value) if the argument is a vector, otherwise returns false (mal + false value). + * `sequential?`: takes a single argument and returns true (mal true + value) if it is a list or a vector, otherwise returns false (mal + false value). + * `hash-map`: takes a variable but even number of arguments and + returns a new mal hash-map value with keys from the odd arguments + and values from the even arguments respectively. This is basically + the functional form of the `{}` reader literal syntax. + * `map?`: takes a single argument and returns true (mal true + value) if the argument is a hash-map, otherwise returns false (mal + false value). + * `assoc`: takes a hash-map as the first argument and the remaining + arguments are odd/even key/value pairs to "associate" (merge) into + the hash-map. Note that the original hash-map is unchanged + (remember, mal values are immutable), and a new hash-map + containing the old hash-maps key/values plus the merged key/value + arguments is returned. + * `dissoc`: takes a hash-map and a list of keys to remove from the + hash-map. Again, note that the original hash-map is unchanged and + a new hash-map with the keys removed is returned. Key arguments + that do not exist in the hash-map are ignored. + * `get`: takes a hash-map and a key and returns the value of looking + up that key in the hash-map. If the key is not found in the + hash-map then nil is returned. + * `contains?`: takes a hash-map and a key and returns true (mal true + value) if the key exists in the hash-map and false (mal false + value) otherwise. + * `keys`: takes a hash-map and returns a list (mal list value) of + all the keys in the hash-map. + * `vals`: takes a hash-map and returns a list (mal list value) of + all the values in the hash-map. + + + + +### Step A: Metadata, Self-hosting and Interop ![stepA_mal architecture](stepA_mal.png) +You have reached the final step of your mal implementation. This step +is kind of a catchall for things that did not fit into other steps. +But most importantly, the changes you make in this step will unlock +the magical power known as "self-hosting". You might have noticed +that one of the languages that mal is implemented in is "mal". Any mal +implementation that is complete enough can run the mal implementation +of mal. You might need to pull out your hammock and ponder this for +a while if you have never built a compiler or interpreter before. Look +at the step source files for the mal implementation of mal (it is not +cheating now that you have reached step A). + +If you deferred the implementation of keywords, vectors and hash-maps, +now is the time to go back and implement them if you want your +implementation to self-host. + Compare the pseudocode for step 9 and step A to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step9_try.txt ../process/stepA_mal.txt +diff -u ../../process/step9_try.txt ../../process/stepA_mal.txt ``` * Copy `step9_try.qx` to `stepA_mal.qx`. -* TODO/TBD +* Add the `readline` core function. This functions takes a + string that is used to prompt the user for input. The line of text + entered by the user is returned as a string. If the user sends an + end-of-file (usually Ctrl-D), then nil is returned. + +* Add a new "\*host-language\*" (symbol) entry to your REPL + environment. The value of this entry should be a mal string + containing the name of the current implementation. +* When the REPL starts up (as opposed to when it is called with + a script and/or arguments), call the `rep` function with this string + to print a startup header: + "(println (str \"Mal [\" \*host-language\* \"]\"))". -## TODO: +* Ensure that the REPL environment contains definitions for `time-ms`, + `meta`, `with-meta`, `fn?` + `string?`, `number?`, `seq`, and `conj`. It doesn't really matter + what they do at this stage: they just need to be defined. Making + them functions that raise a "not implemented" exception would be + fine. + +Now go to the top level, run the step A tests: +``` +make "test^quux^stepA" +``` + +Once you have passed all the non-optional step A tests, it is time to +try self-hosting. Run your step A implementation as normal, but use +the file argument mode you added in step 6 to run each step +from the mal implementation: +``` +./stepA_mal.qx ../mal/step1_read_print.mal +./stepA_mal.qx ../mal/step2_eval.mal +... +./stepA_mal.qx ../mal/step9_try.mal +./stepA_mal.qx ../mal/stepA_mal.mal +``` + +There is a very good chance that you will encounter an error at some +point while trying to run the mal in mal implementation steps above. +Debugging failures that happen while self-hosting is MUCH more +difficult and mind bending. One of the best approaches I have +personally found is to add prn statements to the mal implementation +step (not your own implementation of mal) that is causing problems. + +Another approach I have frequently used is to pull out the code from +the mal implementation that is causing the problem and simplify it +step by step until you have a simple piece of mal code that still +reproduces the problem. Once the reproducer is simple enough you will +probably know where in your own implementation that problem is likely +to be. Please add your simple reproducer as a test case so that future +implementers will fix similar issues in their code before they get to +self-hosting when it is much more difficult to track down and fix. + +Once you can manually run all the self-hosted steps, it is time to run +all the tests in self-hosted mode: +``` +make MAL_IMPL=quux "test^mal" +``` -* simplify: "X argument (list element Y)" -> ast[Y] -* step 8 summary (power of macros, warning about macros, almost to - self-hosting) -* step 9 -* step A -* more info on hash-map and keyword implementation. Hash-maps just - need to support string keys. -* list of types with metadata: list, vector, hash-map, mal functions -* more clarity about when to peek and poke in read_list and read_form -* tokenizer: use first group rather than whole match (to eliminate - whitespace/commas) +When you run into problems (which you almost certainly will), use the +same process described above to debug them. + +Congratulations!!! When all the tests pass, you should pause for +a moment and consider what you have accomplished. You have implemented +a Lisp interpreter that is powerful and complete enough to run a large +mal program which is itself an implementation of the mal language. You +might even be asking if you can continue the "inception" by using your +implementation to run a mal implementation which itself runs the mal +implementation. + + +#### Optional additions + +* Add meta-data support to composite data types (lists, vectors + and hash-maps), and to functions (native or not), by adding a new + metadata attribute that refers to another mal value/type + (nil by default). Add the following metadata related core functions + (and remove any stub versions): + * `meta`: this takes a single mal function/list/vector/hash-map argument + and returns the value of the metadata attribute. + * `with-meta`: this function takes two arguments. The first argument + is a mal value and the second argument is another mal value/type + to set as metadata. A copy of the mal value is returned that has + its `meta` attribute set to the second argument. Note that when + copying a mal function, it is important that the environment and + macro attribute are retained. + * Add a reader-macro that expands the token "^" to + return a new list that contains the symbol "with-meta" and the + result of reading the next next form (2nd argument) (`read_form`) and the + next form (1st argument) in that order + (metadata comes first with the ^ macro and the function second). + * If you implemented `defmacro!` as mutating an existing function + without copying it, you can now use the function copying mechanism + used for metadata to make functions immutable even in the + defmacro! case... + +* Add the following new core functions (and remove any stub versions): + * `time-ms`: takes no arguments and returns the number of + milliseconds since epoch (00:00:00 UTC January 1, 1970), or, if + not possible, since another point in time (`time-ms` is usually + used relatively to measure time durations). After `time-ms` is + implemented, you can run the performance micro-benchmarks by + running `make perf^quux`. + * `conj`: takes a collection and one or more elements as arguments + and returns a new collection which includes the original + collection and the new elements. If the collection is a list, a + new list is returned with the elements inserted at the start of + the given list in opposite order; if the collection is a vector, a + new vector is returned with the elements added to the end of the + given vector. + * `string?`: returns true if the parameter is a string. + * `number?`: returns true if the parameter is a number. + * `fn?`: returns true if the parameter is a function (internal or + user-defined). + * `macro?`: returns true if the parameter is a macro. + * `seq`: takes a list, vector, string, or nil. If an empty list, + empty vector, or empty string ("") is passed in then nil is + returned. Otherwise, a list is returned unchanged, a vector is + converted into a list, and a string is converted to a list + containing the original string split into single character + strings. +* For interop with the target language, add this core function: + * `quux-eval`: takes a string, evaluates it in the target language, + and returns the result converted to the relevant Mal type. You may + also add other interop functions as you see fit; Clojure, for + example, has a function called `.` which allows calling Java + methods. If the target language is a static language, consider + using FFI or some language-specific reflection mechanism, if + available. The tests for `quux-eval` and any other interop + function should be added in `impls/quux/tests/stepA_mal.mal` (see + the [tests for `lua-eval`](../impls/lua/tests/stepA_mal.mal) as an + example). + +### Next Steps + +* Join our [Discord](https://discord.gg/CKgnNbJBpF) channel. +* If you have created an implementation for a new target language (or + a unique and interesting variant of an existing implementation), + consider sending a pull request to add it into the main mal + repository. The [FAQ](../docs/FAQ.md#will-you-add-my-new-implementation) + describes general requirements for getting an implementation merged + into the main repository. +* Take your interpreter implementation and have it emit source code in + the target language rather than immediately evaluating it. In other + words, create a compiler. +* Pick a new target language and implement mal in it. Pick a language + that is very different from any that you already know. +* Use your mal implementation to implement a real world project. Many + of these will force you to address interop. Some ideas: + * Web server (with mal as CGI language for extra points) + * An IRC/Slack chat bot + * An editor (GUI or curses) with mal as a scripting/extension + language. + * An AI player for a game like Chess or Go. +* Implement a feature in your mal implementation that is not covered + by this guide. Some ideas: + * Namespaces + * Multi-threading support + * Errors with line numbers and/or stack traces. + * Lazy sequences + * Clojure-style protocols + * Full call/cc (call-with-current-continuation) support + * Explicit TCO (i.e. `recur`) with tail-position error checking diff --git a/process/step0_repl.gliffy b/process/step0_repl.gliffy deleted file mode 100644 index a80df4325a..0000000000 --- a/process/step0_repl.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":222,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":253},"max":{"x":934,"y":725}},"objects":[{"x":401.5,"y":419.0,"rotation":0.0,"id":218,"width":150.0,"height":14.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":218,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pass through

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":0.5,"y":324.0,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":344.0,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.2928932188134525,"px":1.1102230246251563E-16}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[36.0,-21.0],[88.78571428571433,-21.0],[88.78571428571433,14.441558772842882],[121.00000000000009,14.441558772842882]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.58455673601285,"linePerpValue":0.0,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":581.0,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":226.50000000000003,"y":253.00000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":253.0,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":253.0,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":303.0,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":303.0,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":253.0,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":253.0,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":325.0,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":697.0,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":253.0,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":836.5,"y":402.0,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":2,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-43.55844122715712],[-82.21428571428567,-43.55844122715712],[-82.21428571428567,-79.0],[-35.0,-79.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":220,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3984216145800902,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#333333","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"bold":true,"size":"12px","color":"#000000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step0_repl.png b/process/step0_repl.png index 270f4274f1..67703b47f4 100644 Binary files a/process/step0_repl.png and b/process/step0_repl.png differ diff --git a/process/step1_read_print.gliffy b/process/step1_read_print.gliffy deleted file mode 100644 index 7f978360e7..0000000000 --- a/process/step1_read_print.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":224,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":253},"max":{"x":934,"y":725}},"objects":[{"x":401.5,"y":419.0,"rotation":0.0,"id":218,"width":150.0,"height":14.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":218,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pass through

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":0.5,"y":324.0,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":581.0,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":226.50000000000003,"y":253.00000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":253.0,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":253.0,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":303.0,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":303.0,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":253.0,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":253.0,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":325.0,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":697.0,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":253.0,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":344.0,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":393.0,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":218.5,"y":414.0,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":420.0,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.5,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":836.5,"y":402.0,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2,"stroke":"#cc0000"}},"textStyles":{"global":{"bold":true,"size":"12px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step1_read_print.png b/process/step1_read_print.png index 29cc1cf210..fd7270f996 100644 Binary files a/process/step1_read_print.png and b/process/step1_read_print.png differ diff --git a/process/step2_eval.gliffy b/process/step2_eval.gliffy deleted file mode 100644 index d451ee6b8a..0000000000 --- a/process/step2_eval.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":220,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":53},"max":{"x":934,"y":725}},"objects":[{"x":836.5,"y":402.0,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":324.0,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":344.0,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":420.0,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":581.0,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":414.0,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":253.00000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":253.0,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":253.0,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":303.0,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":393.0,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":303.0,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.5,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":253.0,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":253.0,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":253.0,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":325.0,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":697.0,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":351.5,"y":60.0,"rotation":0.0,"id":213,"width":150.0,"height":56.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":213,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

+

\n

-

\n

*

\n

/

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":306.5,"y":302.0,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

\n

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":53.0,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":431.5,"y":561.0,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":306.5,"y":53.0,"rotation":0.0,"id":110,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":111,"width":83.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

REPL Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":303.0,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

\n

* list

\n

* vector

\n

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":303.0,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":303.0,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":421.5,"y":303.0,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2,"stroke":"#cc0000"}},"textStyles":{"global":{"bold":true,"size":"12px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step2_eval.png b/process/step2_eval.png index da9c80579f..9e4676647f 100644 Binary files a/process/step2_eval.png and b/process/step2_eval.png differ diff --git a/process/step2_eval.txt b/process/step2_eval.txt index beb550036e..d3eb5b1a80 100644 --- a/process/step2_eval.txt +++ b/process/step2_eval.txt @@ -3,17 +3,16 @@ import types, reader, printer READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return lookup(env, ast) OR raise "'" + ast + "' not found" - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - if not list?(ast): return eval_ast(ast, env) - f, args = eval_ast(ast, env) - return apply(f, args) +EVAL(ast, env): + // prn('EVAL ast) + match ast: + 'key: return env[key] or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step3_env.gliffy b/process/step3_env.gliffy deleted file mode 100644 index 1734da253a..0000000000 --- a/process/step3_env.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":221,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":32,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":39,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":41,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":43,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":45,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":55,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":37,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":47,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":31,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":49,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":53,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":51,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":34,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":59,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":57,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":134,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.9189873417721519}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[123.0,40.00056818108453],[123.0,-33.33295454594361],[123.0,-106.6664772729718],[123.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6227256644502573,"linePerpValue":0.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":351.5,"y":59.5,"rotation":0.0,"id":220,"width":150.0,"height":56.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":61,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

+

-

*

/

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2,"stroke":"#cc0000"}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step3_env.png b/process/step3_env.png index 7d0c3b2ff1..9141a8b7ca 100644 Binary files a/process/step3_env.png and b/process/step3_env.png differ diff --git a/process/step3_env.txt b/process/step3_env.txt index 91beda66fe..8729698e45 100644 --- a/process/step3_env.txt +++ b/process/step3_env.txt @@ -3,20 +3,22 @@ import types, reader, printer, env READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - if not list?(ast): return eval_ast(ast, env) - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: let_env = ...; return EVAL(ast[2], let_env) - _default_: f, args = eval_ast(ast, env) - return apply(f, args) +EVAL(ast, env): + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + return EVAL(form, env) + ('let* [k1 v1 ..] form): // idem + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -34,5 +36,4 @@ main loop: class Env (outer=null) data = hash_map() set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) diff --git a/process/step4_if_fn_do.gliffy b/process/step4_if_fn_do.gliffy deleted file mode 100644 index dd6b29d232..0000000000 --- a/process/step4_if_fn_do.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":217,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":36,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":82,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":70,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":60,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":58,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":451.5,"y":63.5,"rotation":0.0,"id":211,"width":100.0,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":92,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

not

 

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":79,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":134,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.9189873417721519}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[123.0,40.00056818108453],[123.0,-33.33295454594361],[123.0,-106.6664772729718],[123.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6227256644502573,"linePerpValue":0.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":432.5,"rotation":0.0,"id":124,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":52,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":125,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

do

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":462.5,"rotation":0.0,"id":126,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":54,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":127,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

if

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":656.5,"y":432.5,"rotation":0.0,"id":128,"width":35.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":56,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.7000000000000001,"y":0.0,"rotation":0.0,"id":129,"width":33.599999999999994,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

fn*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":264.5,"y":87.5,"rotation":0.0,"id":208,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":91,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":197,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-3.0,-1.4213562373095243],[12.007480555277652,-1.4213562373095243],[27.01496111055536,-1.4213562373095243],[42.022441665833014,-1.4213562373095243]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":31.5,"y":63.5,"rotation":0.0,"id":207,"width":225.0,"height":99.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":90,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

= 

\n

 

\n

pr-str str prn println

\n

  

\n

< <= > >= + - * /

\n

 

\n

list list?

\n

 

\n

empty? count 

\n

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":31.5,"y":27.5,"rotation":0.0,"id":195,"width":55.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":87,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.833333333333333,"y":0.0,"rotation":0.0,"id":196,"width":51.333333333333314,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Core

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":31.5,"y":27.5,"rotation":0.0,"id":197,"width":230.0,"height":200.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":86,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2,"stroke":"#cc0000"}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step4_if_fn_do.png b/process/step4_if_fn_do.png index e3cfc7a7bd..4da8dbb37f 100644 Binary files a/process/step4_if_fn_do.png and b/process/step4_if_fn_do.png differ diff --git a/process/step4_if_fn_do.txt b/process/step4_if_fn_do.txt index 501ebfc095..8085df5c12 100644 --- a/process/step4_if_fn_do.txt +++ b/process/step4_if_fn_do.txt @@ -3,30 +3,41 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - if not list?(ast): return eval_ast(ast, env) - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: let_env = ...; return EVAL(ast[2], let_env) - 'do: return eval_ast(rest(ast), env)[-1] - 'if: return EVAL(EVAL(ast[1], env) ? ast[2] : ast[3], env) - 'fn*: return (...a) -> EVAL(ast[2], new Env(env, ast[1], a)) - _default_: f, args = eval_ast(ast, env) - return apply(f, args) +EVAL(ast, env): + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + return EVAL(form, env) + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + return EVAL(last, env) + ('if cond yes no): if EVAL(cond, env) in nil, false + then return EVAL(yes, env) + else return EVAL(no, env) + ('if cond yes): // idem with return nil in the else branch + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + if malfn?(f) then: + return EVAL(f.impl, + new Env(f.env, f.parm, args)) + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) -;; core.EXT: defined using Racket +;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) ;; core.mal: defined using the language itself @@ -43,8 +54,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step5_tco.gliffy b/process/step5_tco.gliffy deleted file mode 100644 index 2c67590962..0000000000 --- a/process/step5_tco.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":214,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":264.5,"y":87.5,"rotation":0.0,"id":208,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":91,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":197,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-3.0,-1.4213562373095243],[12.007480555277652,-1.4213562373095243],[27.01496111055536,-1.4213562373095243],[42.022441665833014,-1.4213562373095243]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":31.5,"y":63.5,"rotation":0.0,"id":207,"width":225.0,"height":99.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":90,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

= 

 

pr-str str prn println

  

< <= > >= + - * /

 

list list?

 

empty? count 

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":479.5,"y":383.8333333333333,"rotation":0.0,"id":158,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":72,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[2.0,-1.3333333333333144],[-76.67669529663686,-1.3333333333333144],[-76.67669529663686,-171.3333333333333],[-106.55339059327378,-171.3333333333333],[-106.55339059327378,-131.3333333333333]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":477.5,"y":352.5,"rotation":0.0,"id":157,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":84,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":130,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[4.0,0.0],[-74.27669529663689,0.0],[-74.27669529663689,-139.99999999999997],[-104.55339059327378,-139.99999999999997],[-104.55339059327378,-99.99999999999997]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":180,"width":30.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5410276646970311,"linePerpValue":0.0,"cardinalityType":null,"html":"

TCO

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":36,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":82,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":472.83333333333326,"y":449.16666666666663,"rotation":0.0,"id":159,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":73,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":124,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[8.666666666666742,-6.666666666666629],[-69.81002862997008,-6.666666666666629],[-69.81002862997008,-236.6666666666666],[-99.88672392660703,-236.6666666666666],[-99.88672392660703,-196.6666666666666]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":464.83333333333326,"y":481.83333333333326,"rotation":0.0,"id":160,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":74,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":126,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[16.666666666666742,-9.333333333333258],[-61.61002862997009,-9.333333333333258],[-61.61002862997009,-269.33333333333326],[-91.88672392660703,-269.33333333333326],[-91.88672392660703,-229.33333333333323]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":70,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":60,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":58,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":656.5,"y":432.5,"rotation":0.0,"id":128,"width":35.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":56,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.7000000000000001,"y":0.0,"rotation":0.0,"id":129,"width":33.599999999999994,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

fn*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":462.5,"rotation":0.0,"id":126,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":54,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":127,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

if

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":432.5,"rotation":0.0,"id":124,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":52,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":125,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

do

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":31.5,"y":27.5,"rotation":0.0,"id":195,"width":55.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":87,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.833333333333333,"y":0.0,"rotation":0.0,"id":196,"width":51.333333333333314,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Core

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":31.5,"y":27.5,"rotation":0.0,"id":197,"width":230.0,"height":200.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":86,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":451.5,"y":63.5,"rotation":0.0,"id":211,"width":100.0,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":92,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

not

 

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":79,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":134,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.9189873417721519}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[123.0,40.00056818108453],[123.0,-33.33295454594361],[123.0,-106.6664772729718],[123.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6227256644502573,"linePerpValue":0.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#333333","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2,"stroke":"#cc0000"}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step5_tco.png b/process/step5_tco.png index d4d48d61b7..686b74cff1 100644 Binary files a/process/step5_tco.png and b/process/step5_tco.png differ diff --git a/process/step5_tco.txt b/process/step5_tco.txt index 450a3bc8eb..1fd6d0540c 100644 --- a/process/step5_tco.txt +++ b/process/step5_tco.txt @@ -3,32 +3,42 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form; continue + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last; continue + ('if cond yes no): if EVAL(cond, env) in nil, false + then ast = yes; continue + else ast = no; continue + ('if cond yes): // idem with return nil in the else branch + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + if malfn?(f) then: + env = new Env(f.env, f.parm, args) + ast = f.impl; continue + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) -;; core.EXT: defined using Racket +;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) ;; core.mal: defined using the language itself @@ -45,8 +55,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step6_file.gliffy b/process/step6_file.gliffy deleted file mode 100644 index b488a02a57..0000000000 --- a/process/step6_file.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":214,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":264.5,"y":87.5,"rotation":0.0,"id":208,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":91,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":197,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-3.0,-1.4213562373095243],[12.007480555277652,-1.4213562373095243],[27.01496111055536,-1.4213562373095243],[42.022441665833014,-1.4213562373095243]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":31.5,"y":63.5,"rotation":0.0,"id":207,"width":225.0,"height":99.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":90,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

= 

 

pr-str str prn println read-string slurp

  

< <= > >= + - * /

 

list list?

 

empty? count 

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":393.5,"y":63.5,"rotation":0.0,"id":201,"width":56.0,"height":33.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":89,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval

 

*ARGV*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":479.5,"y":383.8333333333333,"rotation":0.0,"id":158,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":72,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[2.0,-1.3333333333333144],[-76.67669529663686,-1.3333333333333144],[-76.67669529663686,-171.3333333333333],[-106.55339059327378,-171.3333333333333],[-106.55339059327378,-131.3333333333333]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":477.5,"y":352.5,"rotation":0.0,"id":157,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":84,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":130,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[4.0,0.0],[-74.27669529663689,0.0],[-74.27669529663689,-139.99999999999997],[-104.55339059327378,-139.99999999999997],[-104.55339059327378,-99.99999999999997]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":180,"width":30.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5410276646970311,"linePerpValue":0.0,"cardinalityType":null,"html":"

TCO

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":36,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":82,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":472.83333333333326,"y":449.16666666666663,"rotation":0.0,"id":159,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":73,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":124,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[8.666666666666742,-6.666666666666629],[-69.81002862997008,-6.666666666666629],[-69.81002862997008,-236.6666666666666],[-99.88672392660703,-236.6666666666666],[-99.88672392660703,-196.6666666666666]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":464.83333333333326,"y":481.83333333333326,"rotation":0.0,"id":160,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":74,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":126,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[16.666666666666742,-9.333333333333258],[-61.61002862997009,-9.333333333333258],[-61.61002862997009,-269.33333333333326],[-91.88672392660703,-269.33333333333326],[-91.88672392660703,-229.33333333333323]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":70,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":60,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":58,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":656.5,"y":432.5,"rotation":0.0,"id":128,"width":35.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":56,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.7000000000000001,"y":0.0,"rotation":0.0,"id":129,"width":33.599999999999994,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

fn*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":462.5,"rotation":0.0,"id":126,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":54,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":127,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

if

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":432.5,"rotation":0.0,"id":124,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":52,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":125,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

do

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":31.5,"y":27.5,"rotation":0.0,"id":195,"width":55.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":87,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.833333333333333,"y":0.0,"rotation":0.0,"id":196,"width":51.333333333333314,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Core

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":31.5,"y":27.5,"rotation":0.0,"id":197,"width":230.0,"height":200.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":86,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":451.5,"y":63.5,"rotation":0.0,"id":211,"width":100.0,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":92,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

not

load-file

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":79,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":134,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.9189873417721519}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[123.0,40.00056818108453],[123.0,-33.33295454594361],[123.0,-106.6664772729718],[123.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6227256644502573,"linePerpValue":0.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#333333","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step6_file.png b/process/step6_file.png index 773247efbc..bdf85a934a 100644 Binary files a/process/step6_file.png and b/process/step6_file.png differ diff --git a/process/step6_file.txt b/process/step6_file.txt index b9b99071b1..221f4ba7e5 100644 --- a/process/step6_file.txt +++ b/process/step6_file.txt @@ -3,39 +3,49 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form; continue + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last; continue + ('if cond yes no): if EVAL(cond, env) in nil, false + then ast = yes; continue + else ast = no; continue + ('if cond yes): // idem with return nil in the else branch + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + if malfn?(f) then: + env = new Env(f.env, f.parm, args) + ast = f.impl; continue + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) -;; core.EXT: defined using Racket +;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) ...))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -50,8 +60,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, @@ -76,4 +85,10 @@ ns = {'=: equal?, 'list?: list?, 'empty?: empty?, - 'count: count} + 'count: count, + + 'atom: (a) -> new Atom(a[0]), + 'atom?: (a) -> type(a[0]) == "atom", + 'deref: (a) -> a[0].val, + 'reset!: (a) -> a[0].val = a[1], + 'swap!: swap!} diff --git a/process/step7_quote.gliffy b/process/step7_quote.gliffy deleted file mode 100644 index c6eaf46b33..0000000000 --- a/process/step7_quote.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":214,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":264.5,"y":87.5,"rotation":0.0,"id":208,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":91,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":197,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-3.0,-1.4213562373095243],[12.007480555277652,-1.4213562373095243],[27.01496111055536,-1.4213562373095243],[42.022441665833014,-1.4213562373095243]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":31.5,"y":63.5,"rotation":0.0,"id":207,"width":225.0,"height":99.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":90,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

= 

 

pr-str str prn println read-string slurp

  

< <= > >= + - * /

 

list list?

 

cons concat empty? count 

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":393.5,"y":63.5,"rotation":0.0,"id":201,"width":56.0,"height":33.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":89,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval

 

*ARGV*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":479.5,"y":383.8333333333333,"rotation":0.0,"id":158,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":72,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[2.0,-1.3333333333333144],[-76.67669529663686,-1.3333333333333144],[-76.67669529663686,-171.3333333333333],[-106.55339059327378,-171.3333333333333],[-106.55339059327378,-131.3333333333333]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":477.5,"y":352.5,"rotation":0.0,"id":157,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":84,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":130,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[4.0,0.0],[-74.27669529663689,0.0],[-74.27669529663689,-139.99999999999997],[-104.55339059327378,-139.99999999999997],[-104.55339059327378,-99.99999999999997]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":180,"width":30.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5410276646970311,"linePerpValue":0.0,"cardinalityType":null,"html":"

TCO

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":36,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":82,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":472.83333333333326,"y":449.16666666666663,"rotation":0.0,"id":159,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":73,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":124,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[8.666666666666742,-6.666666666666629],[-69.81002862997008,-6.666666666666629],[-69.81002862997008,-236.6666666666666],[-99.88672392660703,-236.6666666666666],[-99.88672392660703,-196.6666666666666]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":464.83333333333326,"y":481.83333333333326,"rotation":0.0,"id":160,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":74,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":126,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[16.666666666666742,-9.333333333333258],[-61.61002862997009,-9.333333333333258],[-61.61002862997009,-269.33333333333326],[-91.88672392660703,-269.33333333333326],[-91.88672392660703,-229.33333333333323]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":454.1666666666665,"y":513.8333333333333,"rotation":0.0,"id":161,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":75,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":140,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[27.333333333333485,-11.333333333333258],[-50.9433619633034,-11.333333333333258],[-50.9433619633034,-301.33333333333326],[-81.22005725994029,-301.33333333333326],[-81.22005725994029,-261.33333333333326]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":70,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":492.5,"rotation":0.0,"id":140,"width":90.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":66,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.800000000000001,"y":0.0,"rotation":0.0,"id":141,"width":86.40000000000003,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quasiquote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":629.0,"y":462.5,"rotation":0.0,"id":138,"width":62.5,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":64,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.2500000000000004,"y":0.0,"rotation":0.0,"id":139,"width":60.00000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":60,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":58,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":656.5,"y":432.5,"rotation":0.0,"id":128,"width":35.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":56,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.7000000000000001,"y":0.0,"rotation":0.0,"id":129,"width":33.599999999999994,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

fn*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":462.5,"rotation":0.0,"id":126,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":54,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":127,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

if

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":432.5,"rotation":0.0,"id":124,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":52,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":125,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

do

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":31.5,"y":27.5,"rotation":0.0,"id":195,"width":55.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":87,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.833333333333333,"y":0.0,"rotation":0.0,"id":196,"width":51.333333333333314,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Core

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":31.5,"y":27.5,"rotation":0.0,"id":197,"width":230.0,"height":200.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":86,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":451.5,"y":63.5,"rotation":0.0,"id":211,"width":100.0,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":92,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

not

load-file

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":79,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":134,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.9189873417721519}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[123.0,40.00056818108453],[123.0,-33.33295454594361],[123.0,-106.6664772729718],[123.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6227256644502573,"linePerpValue":0.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step7_quote.png b/process/step7_quote.png index ecf852f3fe..6989dfda4a 100644 Binary files a/process/step7_quote.png and b/process/step7_quote.png differ diff --git a/process/step7_quote.txt b/process/step7_quote.txt index 58360f2700..fb103551fc 100644 --- a/process/step7_quote.txt +++ b/process/step7_quote.txt @@ -3,44 +3,53 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form; continue + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last; continue + ('if cond yes no): if EVAL(cond, env) in nil, false + then ast = yes; continue + else ast = no; continue + ('if cond yes): // idem with return nil in the else branch + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form); continue + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + if malfn?(f) then: + env = new Env(f.env, f.parm, args) + ast = f.impl; continue + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) -;; core.EXT: defined using Racket +;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) ...))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -55,8 +64,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, @@ -82,5 +90,12 @@ ns = {'=: equal?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'empty?: empty?, - 'count: count} + 'count: count, + + 'atom: (a) -> new Atom(a[0]), + 'atom?: (a) -> type(a[0]) == "atom", + 'deref: (a) -> a[0].val, + 'reset!: (a) -> a[0].val = a[1], + 'swap!: swap!} diff --git a/process/step8_macros.gliffy b/process/step8_macros.gliffy deleted file mode 100644 index 5eec811605..0000000000 --- a/process/step8_macros.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":215,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":264.5,"y":87.5,"rotation":0.0,"id":208,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":91,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":197,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-3.0,-1.4213562373095243],[12.007480555277652,-1.4213562373095243],[27.01496111055536,-1.4213562373095243],[42.022441665833014,-1.4213562373095243]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":31.5,"y":63.5,"rotation":0.0,"id":207,"width":225.0,"height":99.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":90,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

= 

 

pr-str str prn println read-string slurp

  

< <= > >= + - * /

 

list list?

 

cons concat nth first rest empty? count 

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":393.5,"y":63.5,"rotation":0.0,"id":201,"width":56.0,"height":33.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":89,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval

 

*ARGV*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":479.5,"y":383.8333333333333,"rotation":0.0,"id":158,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":72,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[2.0,-1.3333333333333144],[-76.67669529663686,-1.3333333333333144],[-76.67669529663686,-171.3333333333333],[-106.55339059327378,-171.3333333333333],[-106.55339059327378,-131.3333333333333]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":477.5,"y":352.5,"rotation":0.0,"id":157,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":84,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":130,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[4.0,0.0],[-74.27669529663689,0.0],[-74.27669529663689,-139.99999999999997],[-104.55339059327378,-139.99999999999997],[-104.55339059327378,-99.99999999999997]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":180,"width":30.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5410276646970311,"linePerpValue":0.0,"cardinalityType":null,"html":"

TCO

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":36,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":79,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":136,"py":0.0,"px":0.2928932188134524}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.8227848101265823}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[85.00000000000011,70.02649212270546],[85.00000000000011,-13.315671918196358],[85.0,-96.65783595909818],[85.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6679846702072576,"linePerpValue":20.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":187,"width":83.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.484414172761811,"linePerpValue":null,"cardinalityType":null,"html":"

macroexpand

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":82,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":549.8333333333333,"y":312.5,"rotation":0.0,"id":154,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":78,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[119.66666666666663,30.01053612348437],[119.66666666666663,-79.99473193825781],[119.66666666666663,-79.99473193825781],[119.66666666666663,-190.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":472.83333333333326,"y":449.16666666666663,"rotation":0.0,"id":159,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":73,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":124,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[8.666666666666742,-6.666666666666629],[-69.81002862997008,-6.666666666666629],[-69.81002862997008,-236.6666666666666],[-99.88672392660703,-236.6666666666666],[-99.88672392660703,-196.6666666666666]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":464.83333333333326,"y":481.83333333333326,"rotation":0.0,"id":160,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":74,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":126,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[16.666666666666742,-9.333333333333258],[-61.61002862997009,-9.333333333333258],[-61.61002862997009,-269.33333333333326],[-91.88672392660703,-269.33333333333326],[-91.88672392660703,-229.33333333333323]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":454.1666666666665,"y":513.8333333333333,"rotation":0.0,"id":161,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":75,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":140,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[27.333333333333485,-11.333333333333258],[-50.9433619633034,-11.333333333333258],[-50.9433619633034,-301.33333333333326],[-81.22005725994029,-301.33333333333326],[-81.22005725994029,-261.33333333333326]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":70,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":591.5,"y":492.5,"rotation":0.0,"id":142,"width":100.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":68,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0000000000000004,"y":0.0,"rotation":0.0,"id":143,"width":96.00000000000003,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

macroexpand

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":492.5,"rotation":0.0,"id":140,"width":90.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":66,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.800000000000001,"y":0.0,"rotation":0.0,"id":141,"width":86.40000000000003,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quasiquote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":629.0,"y":462.5,"rotation":0.0,"id":138,"width":62.5,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":64,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.2500000000000004,"y":0.0,"rotation":0.0,"id":139,"width":60.00000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":601.5,"y":372.5,"rotation":0.0,"id":136,"width":90.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":62,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.8000000000000005,"y":0.0,"rotation":0.0,"id":137,"width":86.4,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

defmacro!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":60,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":58,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":656.5,"y":432.5,"rotation":0.0,"id":128,"width":35.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":56,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.7000000000000001,"y":0.0,"rotation":0.0,"id":129,"width":33.599999999999994,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

fn*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":462.5,"rotation":0.0,"id":126,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":54,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":127,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

if

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":432.5,"rotation":0.0,"id":124,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":52,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":125,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

do

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":31.5,"y":27.5,"rotation":0.0,"id":195,"width":55.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":87,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.833333333333333,"y":0.0,"rotation":0.0,"id":196,"width":51.333333333333314,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Core

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":31.5,"y":27.5,"rotation":0.0,"id":197,"width":230.0,"height":200.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":86,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":451.5,"y":63.5,"rotation":0.0,"id":211,"width":100.0,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":92,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

not

load-file

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":561.5,"y":63.5,"rotation":0.0,"id":212,"width":77.5,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":93,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

cond

or

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2,"stroke":"#cc0000"}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step8_macros.png b/process/step8_macros.png index 208f4565d2..16c94ce64b 100644 Binary files a/process/step8_macros.png and b/process/step8_macros.png differ diff --git a/process/step8_macros.txt b/process/step8_macros.txt index 47e5db92d4..87cabd7e62 100644 --- a/process/step8_macros.txt +++ b/process/step8_macros.txt @@ -3,55 +3,57 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form; continue + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last; continue + ('if cond yes no): if EVAL(cond, env) in nil, false + then ast = yes; continue + else ast = no; continue + ('if cond yes): // idem with return nil in the else branch + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form); continue + ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) + (callable arg1 ..): f = EVAL(callable, env) + if macro?(f) then: + ast = f(arg1, ..); continue + args = [EVAL(arg1, env) ..] + if malfn?(f) then: + env = new Env(f.env, f.parm, args) + ast = f.impl; continue + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) -;; core.EXT: defined using Racket +;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) ...))") -rep("(defmacro! cond (fn* (& xs) ...))") -rep("(defmacro! or (fn* (& xs) ...))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -66,8 +68,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, @@ -93,8 +94,15 @@ ns = {'=: equal?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range", 'first: (a) -> a[0][0] OR nil, 'rest: (a) -> a[0][1..] OR list(), 'empty?: empty?, - 'count: count} + 'count: count, + + 'atom: (a) -> new Atom(a[0]), + 'atom?: (a) -> type(a[0]) == "atom", + 'deref: (a) -> a[0].val, + 'reset!: (a) -> a[0].val = a[1], + 'swap!: swap!} diff --git a/process/step9_try.gliffy b/process/step9_try.gliffy deleted file mode 100644 index bc23dbf808..0000000000 --- a/process/step9_try.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":215,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":264.5,"y":87.5,"rotation":0.0,"id":208,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":91,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":197,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-3.0,-1.4213562373095243],[12.007480555277652,-1.4213562373095243],[27.01496111055536,-1.4213562373095243],[42.022441665833014,-1.4213562373095243]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":31.5,"y":63.5,"rotation":0.0,"id":207,"width":225.0,"height":154.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":90,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

= throw nil? true? false? symbol symbol? keyword keyword?

 

pr-str str prn println readline read-string slurp

  

< <= > >= + - * /

 

list list? vector vector? hash-map map? assoc dissoc get contains? keys vals

 

sequential? cons concat nth first rest empty? count apply map conj

 

with-meta meta atom atom? deref reset! swap!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":393.5,"y":63.5,"rotation":0.0,"id":201,"width":56.0,"height":33.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":89,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval

 

*ARGV*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":479.5,"y":383.8333333333333,"rotation":0.0,"id":158,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":72,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[2.0,-1.3333333333333144],[-76.67669529663686,-1.3333333333333144],[-76.67669529663686,-171.3333333333333],[-106.55339059327378,-171.3333333333333],[-106.55339059327378,-131.3333333333333]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":477.5,"y":352.5,"rotation":0.0,"id":157,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":84,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":130,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[4.0,0.0],[-74.27669529663689,0.0],[-74.27669529663689,-139.99999999999997],[-104.55339059327378,-139.99999999999997],[-104.55339059327378,-99.99999999999997]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":180,"width":30.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5410276646970311,"linePerpValue":0.0,"cardinalityType":null,"html":"

TCO

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":36,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":79,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":136,"py":0.0,"px":0.2928932188134524}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.8227848101265823}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[85.00000000000011,70.02649212270546],[85.00000000000011,-13.315671918196358],[85.0,-96.65783595909818],[85.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6679846702072576,"linePerpValue":20.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":187,"width":83.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.484414172761811,"linePerpValue":null,"cardinalityType":null,"html":"

macroexpand

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":82,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":549.8333333333333,"y":312.5,"rotation":0.0,"id":154,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":78,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[119.66666666666663,30.01053612348437],[119.66666666666663,-79.99473193825781],[119.66666666666663,-79.99473193825781],[119.66666666666663,-190.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":472.83333333333326,"y":449.16666666666663,"rotation":0.0,"id":159,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":73,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":124,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[8.666666666666742,-6.666666666666629],[-69.81002862997008,-6.666666666666629],[-69.81002862997008,-236.6666666666666],[-99.88672392660703,-236.6666666666666],[-99.88672392660703,-196.6666666666666]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":464.83333333333326,"y":481.83333333333326,"rotation":0.0,"id":160,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":74,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":126,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[16.666666666666742,-9.333333333333258],[-61.61002862997009,-9.333333333333258],[-61.61002862997009,-269.33333333333326],[-91.88672392660703,-269.33333333333326],[-91.88672392660703,-229.33333333333323]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":454.1666666666665,"y":513.8333333333333,"rotation":0.0,"id":161,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":75,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":140,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[27.333333333333485,-11.333333333333258],[-50.9433619633034,-11.333333333333258],[-50.9433619633034,-301.33333333333326],[-81.22005725994029,-301.33333333333326],[-81.22005725994029,-261.33333333333326]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":70,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":591.5,"y":492.5,"rotation":0.0,"id":142,"width":100.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":68,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0000000000000004,"y":0.0,"rotation":0.0,"id":143,"width":96.00000000000003,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

macroexpand

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":492.5,"rotation":0.0,"id":140,"width":90.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":66,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.800000000000001,"y":0.0,"rotation":0.0,"id":141,"width":86.40000000000003,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quasiquote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":629.0,"y":462.5,"rotation":0.0,"id":138,"width":62.5,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":64,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.2500000000000004,"y":0.0,"rotation":0.0,"id":139,"width":60.00000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":601.5,"y":372.5,"rotation":0.0,"id":136,"width":90.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":62,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.8000000000000005,"y":0.0,"rotation":0.0,"id":137,"width":86.4,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

defmacro!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":60,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":58,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":656.5,"y":432.5,"rotation":0.0,"id":128,"width":35.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":56,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.7000000000000001,"y":0.0,"rotation":0.0,"id":129,"width":33.599999999999994,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

fn*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":462.5,"rotation":0.0,"id":126,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":54,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":127,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

if

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":432.5,"rotation":0.0,"id":124,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":52,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":125,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

do

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":31.5,"y":27.5,"rotation":0.0,"id":195,"width":55.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":87,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.833333333333333,"y":0.0,"rotation":0.0,"id":196,"width":51.333333333333314,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Core

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":31.5,"y":27.5,"rotation":0.0,"id":197,"width":230.0,"height":200.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":86,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":451.5,"y":63.5,"rotation":0.0,"id":211,"width":100.0,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":92,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

not

load-file

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":561.5,"y":63.5,"rotation":0.0,"id":212,"width":77.5,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":93,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

cond

or

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":664.8333333333334,"y":319.83333333333337,"rotation":0.0,"id":152,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":81,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-88.66666666666674,82.66757369446611],[-88.66666666666674,-39.83287981943363],[-88.66666666666674,-39.83287981943363],[-88.66666666666674,-162.33333333333337]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":481.5,"y":402.5,"rotation":0.0,"id":122,"width":110.00000000000001,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":50,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#cc0000","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.200000000000001,"y":0.0,"rotation":0.0,"id":123,"width":105.60000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

try*/catch*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#cc0000","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2,"stroke":"#cc0000"}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/step9_try.png b/process/step9_try.png index 401af23752..3b1139d14b 100644 Binary files a/process/step9_try.png and b/process/step9_try.png differ diff --git a/process/step9_try.txt b/process/step9_try.txt index 7fd8fff2b3..a27c785a36 100644 --- a/process/step9_try.txt +++ b/process/step9_try.txt @@ -3,56 +3,63 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'try*: return ... // try/catch native and malval exceptions - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form; continue + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last; continue + ('if cond yes no): if EVAL(cond, env) in nil, false + then ast = yes; continue + else ast = no; continue + ('if cond yes): // idem with return nil in the else branch + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form); continue + ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) + ('try* f ('catch* 'k h)): try returning EVAL(f, env) + if native or malval exception then: + env = new Env(env) + env.set(k, exception) + ast = h; continue + ('try* form): ast = form; continue + (callable arg1 ..): f = EVAL(callable, env) + if macro?(f) then: + ast = f(arg1, ..); continue + args = [EVAL(arg1, env) ..] + if malfn?(f) then: + env = new Env(f.env, f.parm, args) + ast = f.impl; continue + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) -;; core.EXT: defined using Racket +;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) ...))") -rep("(defmacro! cond (fn* (& xs) ...))") -rep("(defmacro! or (fn* (& xs) ...))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -67,13 +74,20 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'throw: throw, + 'nil?: nil?, + 'true?: true?, + 'false?: false?, + 'symbol: symbol, + 'symbol?: symbol?, + 'keyword: keyword, + 'keyword?: keyword?, + 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), @@ -92,11 +106,31 @@ ns = {'=: equal?, 'list: list, 'list?: list?, - + 'vector: vector, + 'vector?: vector?, + 'hash-map: hash_map, + 'map?: hash_map?, + 'assoc: assoc, + 'dissoc: dissoc, + 'get: get, + 'contains?: contains?, + 'keys: keys, + 'vals: vals, + + 'sequential? sequential?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range", 'first: (a) -> a[0][0] OR nil, 'rest: (a) -> a[0][1..] OR list(), 'empty?: empty?, - 'count: count} + 'count: count, + 'apply: apply, + 'map: map, + + 'atom: (a) -> new Atom(a[0]), + 'atom?: (a) -> type(a[0]) == "atom", + 'deref: (a) -> a[0].val, + 'reset!: (a) -> a[0].val = a[1], + 'swap!: swap!} diff --git a/process/step9_try2.txt b/process/step9_try2.txt deleted file mode 100644 index 290fd489c3..0000000000 --- a/process/step9_try2.txt +++ /dev/null @@ -1,133 +0,0 @@ ---- step9_try ----------------------------------- -import types, reader, printer, env, core - -READ(str): return reader.read_str(str) - -pair?(ast): return ... // true if non-empty sequence -quasiquote(ast): return ... // quasiquote - -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'try*: return ... // try/catch native and malval exceptions - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) - -PRINT(exp): return printer.pr_str(exp) - -repl_env = new Env() -rep(str): return PRINT(EVAL(READ(str),repl_env)) - -;; core.EXT: defined using Racket -core.ns.map((k,v) -> (repl_env.set(k, v))) -repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) -repl_env.set('*ARGV*, cmdline_args[1..]) - -;; core.mal: defined using the language itself -rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) ...))") -rep("(defmacro! cond (fn* (& xs) ...))") -rep("(defmacro! or (fn* (& xs) ...))") - -if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 - -main loop: - try: println(rep(readline("user> "))) - catch e: println("Error: ", e) - ---- env module ---------------------------------- -class Env (outer=null,binds=[],exprs=[]) - data = hash_map() - foreach b, i in binds: - if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break - else: data[binds[i]] = exprs[i] - set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" - ---- core module --------------------------------- -ns = {'=: equal?, - 'throw: throw, - - 'nil?: nil?, - 'true?: true?, - 'false?: false?, - 'symbol: symbol, - 'symbol?: symbol?, - 'keyword: keyword, - 'keyword?: keyword?, - - 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), - 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), - 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), - 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), - 'read-string: read_str, - 'readline: readline, - 'slurp read-file, - - '<: lt, - '<=: lte, - '>: gt, - '>=: gte, - '+: add, - '-: sub, - '*: mult, - '/: div, - - 'list: list, - 'list?: list?, - 'vector: vector, - 'vector?: vector?, - 'hash-map: hash_map, - 'map?: hash_map?, - 'assoc: assoc, - 'dissoc: dissoc, - 'get: get, - 'contains?: contains?, - 'keys: keys, - 'vals: vals, - - 'sequential? sequential?, - 'cons: (a) -> concat([a[0]], a[1]), - 'concat: (a) -> reduce(concat, [], a), - 'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range", - 'first: (a) -> a[0][0] OR nil, - 'rest: (a) -> a[0][1..] OR list(), - 'empty?: empty?, - 'count: count, - 'apply: apply, - 'map: map, - 'conj: conj, - - 'meta: (a) -> a[0].meta, - 'with-meta: (a) -> a[0].with_meta(a[1]), - 'atom: (a) -> new Atom(a[0]), - 'atom?: (a) -> type(a[0]) == "atom", - 'deref: (a) -> a[0].val, - 'reset!: (a) -> a[0].val = a[1], - 'swap!: swap!} diff --git a/process/stepA_mal.gliffy b/process/stepA_mal.gliffy deleted file mode 100644 index 7d4920f2dc..0000000000 --- a/process/stepA_mal.gliffy +++ /dev/null @@ -1 +0,0 @@ -{"contentType":"application/gliffy+json","version":"1.3","stage":{"background":"#FFFFFF","width":934,"height":725,"nodeIndex":215,"autoFit":true,"exportBorder":false,"gridOn":true,"snapToGrid":true,"drawingGuidesOn":true,"pageBreaksOn":false,"printGridOn":false,"printPaper":"LETTER","printShrinkToFit":false,"printPortrait":true,"maxWidth":5000,"maxHeight":5000,"themeData":null,"viewportType":"default","fitBB":{"min":{"x":20,"y":18.5},"max":{"x":934,"y":724.5}},"objects":[{"x":264.5,"y":87.5,"rotation":0.0,"id":208,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":91,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":197,"py":0.29289321881345237,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-3.0,-1.4213562373095243],[12.007480555277652,-1.4213562373095243],[27.01496111055536,-1.4213562373095243],[42.022441665833014,-1.4213562373095243]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":31.5,"y":63.5,"rotation":0.0,"id":207,"width":225.0,"height":154.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":90,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

= throw nil? true? false? symbol symbol? keyword keyword?

 

pr-str str prn println readline read-string slurp

  

< <= > >= + - * / time-ms

 

list list? vector vector? hash-map map? assoc dissoc get contains? keys vals

 

sequential? cons concat nth first rest empty? count apply map conj

 

with-meta meta atom atom? deref reset! swap!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":393.5,"y":63.5,"rotation":0.0,"id":201,"width":56.0,"height":33.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":89,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval

 

*ARGV*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":479.5,"y":383.8333333333333,"rotation":0.0,"id":158,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":72,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[2.0,-1.3333333333333144],[-76.67669529663686,-1.3333333333333144],[-76.67669529663686,-171.3333333333333],[-106.55339059327378,-171.3333333333333],[-106.55339059327378,-131.3333333333333]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":477.5,"y":352.5,"rotation":0.0,"id":157,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":84,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":130,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[4.0,0.0],[-74.27669529663689,0.0],[-74.27669529663689,-139.99999999999997],[-104.55339059327378,-139.99999999999997],[-104.55339059327378,-99.99999999999997]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":180,"width":30.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5410276646970311,"linePerpValue":0.0,"cardinalityType":null,"html":"

TCO

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":835.5,"y":82.5,"rotation":0.0,"id":58,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":36,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":56,"py":0.0,"px":0.9711340206185567}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":0.0,"px":0.9200000000000002}}},"graphic":{"type":"Line","Line":{"strokeWidth":1.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"1.0,1.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-120.69072164948443,5.0],[-120.69072164948443,-58.5],[-165.5999999999999,-58.5],[-165.5999999999999,-30.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":168,"width":30.0,"height":11.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6273328731976967,"linePerpValue":null,"cardinalityType":null,"html":"

outer

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":546.5,"y":302.5,"rotation":0.0,"id":51,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":79,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":136,"py":0.0,"px":0.2928932188134524}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":44,"py":1.0,"px":0.8227848101265823}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[85.00000000000011,70.02649212270546],[85.00000000000011,-13.315671918196358],[85.0,-96.65783595909818],[85.0,-180.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":189,"width":68.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.6679846702072576,"linePerpValue":20.0,"cardinalityType":null,"html":"

update env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":301.5,"rotation":0.0,"id":46,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":33,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":44,"py":1.0,"px":0.06329113924050633}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":90,"py":0.0,"px":0.8}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[25.0,-179.0],[25.0,-118.99629641060108],[25.000000000000057,-58.99259282120215],[25.000000000000057,1.0111107681967724]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":112,"width":47.0,"height":28.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.3943470868113573,"linePerpValue":null,"cardinalityType":null,"html":"

symbol

lookup

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":431.5,"y":560.5,"rotation":0.0,"id":42,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":30,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":18,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":20,"py":1.0,"px":0.2392857142857143}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-110.0,-28.0],[-110.0,12.0],[57.0,12.0],[57.0,-28.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":187,"width":83.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.484414172761811,"linePerpValue":null,"cardinalityType":null,"html":"

macroexpand

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":302.5,"rotation":0.0,"id":36,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":29,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.0,"px":0.26785714285714285}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[15.0,0.0],[15.0,-89.99999999999997],[-108.55339059327378,-89.99999999999997],[-108.55339059327378,-49.99999999999997]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":836.5,"y":401.5,"rotation":0.0,"id":34,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":27,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":32,"py":0.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":30,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[0.0,33.5],[0.0,2.6666666666666856],[0.0,-28.166666666666686],[0.0,-59.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":185,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.42162162162162165,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":0.5,"y":323.5,"rotation":0.0,"id":27,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":19,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":22,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[24.0,-2.0],[39.670212364724215,-2.0],[55.34042472944843,-2.0],[71.01063709417264,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":100,"width":16.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.2339895963963344,"linePerpValue":null,"cardinalityType":null,"html":"

in

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":105.5,"y":343.5,"rotation":0.0,"id":26,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":17,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":22,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":24,"py":0.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[1.0,-1.0],[1.0,15.666666666666686],[1.0,32.333333333333314],[1.0,49.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":184,"width":38.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.44000000000000006,"linePerpValue":null,"cardinalityType":null,"html":"

string

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":18,"width":120.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":10,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":190,"width":116.0,"height":56.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

* symbol

* list

* vector

* hash-map

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":670.5,"y":419.5,"rotation":0.0,"id":17,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":8,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":20,"py":0.5,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":32,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[31.0,-2.0],[81.0,-2.0],[81.0,35.5],[131.0,35.5]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":99,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.46236810530620487,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":833.5,"y":580.5,"rotation":0.0,"id":15,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":7,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":13,"py":1.0,"px":0.5}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":0,"py":1.0,"px":0.5}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":"8.0,8.0","startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[3.0,32.0],[3.0,128.0],[-727.0,128.0],[-727.0,32.0]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":218.5,"y":413.5,"rotation":0.0,"id":9,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":4,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":24,"py":0.3973684210526316,"px":1.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":18,"py":0.5,"px":0.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-77.0,49.53289473684208],[-17.0,49.53289473684208],[-17.0,4.0],[43.0,4.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":98,"width":29.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.488635066574355,"linePerpValue":null,"cardinalityType":null,"html":"

AST

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.50000000000003,"y":252.50000000000003,"rotation":0.0,"id":2,"width":499.99999999999994,"height":359.99999999999994,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":3,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":51.5,"y":252.5,"rotation":0.0,"id":0,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":2,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":781.5,"y":252.5,"rotation":0.0,"id":13,"width":110.0,"height":360.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":6,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":71.5,"y":302.5,"rotation":0.0,"id":22,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":13,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":23,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

readline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":71.5,"y":392.5,"rotation":0.0,"id":24,"width":70.0,"height":177.5,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":15,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":25,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

read_str

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":302.5,"rotation":0.0,"id":30,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":23,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":31,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

printline

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":801.5,"y":435.0,"rotation":0.0,"id":32,"width":70.0,"height":40.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":25,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.4000000000000001,"y":0.0,"rotation":0.0,"id":33,"width":67.2,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

pr_str

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":321.5,"y":87.5,"rotation":0.0,"id":56,"width":405.00000000000006,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":0,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":8.099999999999998,"y":0.0,"rotation":0.0,"id":57,"width":388.8000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

ENV

","tid":null,"valign":"top","vposition":"none","hposition":"none"}},"children":[]}]},{"x":261.5,"y":302.5,"rotation":0.0,"id":90,"width":90.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":40,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":3.0,"y":0.0,"rotation":0.0,"id":91,"width":84.0,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

eval_ast

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":51.5,"y":252.5,"rotation":0.0,"id":92,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":42,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":93,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

READ

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":226.5,"y":252.5,"rotation":0.0,"id":94,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":44,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":95,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

EVAL

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":781.5,"y":252.5,"rotation":0.0,"id":96,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":46,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":97,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

PRINT

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":914.5,"y":324.5,"rotation":0.0,"id":29,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":21,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":30,"py":0.5,"px":1.0}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-43.0,-2.0],[-23.66666666666663,-2.0],[-4.333333333333371,-2.0],[15.0,-2.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":109,"width":24.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.5689655172413794,"linePerpValue":null,"cardinalityType":null,"html":"

out

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":654.5,"y":298.5,"rotation":0.0,"id":53,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":35,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-132.0,42.00496464680543],[-132.0,-50.49751767659728],[-132.0,-50.49751767659728],[-132.0,-143.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":656.8333333333334,"y":309.83333333333337,"rotation":0.0,"id":150,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":82,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":146,"py":0.0,"px":0.85}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-107.33333333333337,62.66666666666663],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-45.166666666666686],[-107.33333333333337,-153.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[{"x":0.0,"y":0.0,"rotation":0.0,"id":151,"width":64.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"both","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":0.7928902627511594,"linePerpValue":0.0,"cardinalityType":null,"html":"

create env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":664.8333333333334,"y":319.83333333333337,"rotation":0.0,"id":152,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":81,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[-88.66666666666674,82.66757369446611],[-88.66666666666674,-39.83287981943363],[-88.66666666666674,-39.83287981943363],[-88.66666666666674,-162.33333333333337]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":549.8333333333333,"y":312.5,"rotation":0.0,"id":154,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":78,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[119.66666666666663,30.01053612348437],[119.66666666666663,-79.99473193825781],[119.66666666666663,-79.99473193825781],[119.66666666666663,-190.0]],"lockSegments":{},"ortho":true}},"linkMap":[],"children":[]},{"x":472.83333333333326,"y":449.16666666666663,"rotation":0.0,"id":159,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":73,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":124,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[8.666666666666742,-6.666666666666629],[-69.81002862997008,-6.666666666666629],[-69.81002862997008,-236.6666666666666],[-99.88672392660703,-236.6666666666666],[-99.88672392660703,-196.6666666666666]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":464.83333333333326,"y":481.83333333333326,"rotation":0.0,"id":160,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":74,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":126,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[16.666666666666742,-9.333333333333258],[-61.61002862997009,-9.333333333333258],[-61.61002862997009,-269.33333333333326],[-91.88672392660703,-269.33333333333326],[-91.88672392660703,-229.33333333333323]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":454.1666666666665,"y":513.8333333333333,"rotation":0.0,"id":161,"width":100.0,"height":100.0,"uid":"com.gliffy.shape.basic.basic_v1.default.line","order":75,"lockAspectRatio":false,"lockShape":false,"constraints":{"constraints":[],"startConstraint":{"type":"StartPositionConstraint","StartPositionConstraint":{"nodeId":140,"py":0.5,"px":0.0}},"endConstraint":{"type":"EndPositionConstraint","EndPositionConstraint":{"nodeId":2,"py":0.0,"px":0.2928932188134524}}},"graphic":{"type":"Line","Line":{"strokeWidth":2.0,"strokeColor":"#000000","fillColor":"none","dashStyle":null,"startArrow":0,"endArrow":2,"startArrowRotation":"auto","endArrowRotation":"auto","interpolationType":"linear","cornerRadius":10.0,"controlPath":[[27.333333333333485,-11.333333333333258],[-50.9433619633034,-11.333333333333258],[-50.9433619633034,-301.33333333333326],[-81.22005725994029,-301.33333333333326],[-81.22005725994029,-261.33333333333326]],"lockSegments":{"1":true},"ortho":true}},"linkMap":[],"children":[]},{"x":421.5,"y":696.5,"rotation":0.0,"id":176,"width":70.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":76,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#c9daf8","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.333333333333333,"y":0.0,"rotation":0.0,"id":177,"width":65.33333333333331,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

LOOP

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":372.5,"rotation":0.0,"id":146,"width":80.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":70,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.6000000000000005,"y":0.0,"rotation":0.0,"id":147,"width":76.80000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

"apply"

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":591.5,"y":492.5,"rotation":0.0,"id":142,"width":100.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":68,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0000000000000004,"y":0.0,"rotation":0.0,"id":143,"width":96.00000000000003,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

macroexpand

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":492.5,"rotation":0.0,"id":140,"width":90.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":66,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.800000000000001,"y":0.0,"rotation":0.0,"id":141,"width":86.40000000000003,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quasiquote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":629.0,"y":462.5,"rotation":0.0,"id":138,"width":62.5,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":64,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.2500000000000004,"y":0.0,"rotation":0.0,"id":139,"width":60.00000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

quote

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":601.5,"y":372.5,"rotation":0.0,"id":136,"width":90.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":62,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.8000000000000005,"y":0.0,"rotation":0.0,"id":137,"width":86.4,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

defmacro!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":646.5,"y":342.5,"rotation":0.0,"id":134,"width":45.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":60,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.9000000000000001,"y":0.0,"rotation":0.0,"id":135,"width":43.199999999999996,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

def!

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":342.5,"rotation":0.0,"id":130,"width":50.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":58,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.0000000000000002,"y":0.0,"rotation":0.0,"id":131,"width":48.0,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

let*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":656.5,"y":432.5,"rotation":0.0,"id":128,"width":35.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":56,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.7000000000000001,"y":0.0,"rotation":0.0,"id":129,"width":33.599999999999994,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

fn*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":462.5,"rotation":0.0,"id":126,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":54,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":127,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

if

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":432.5,"rotation":0.0,"id":124,"width":40.0,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":52,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":0.8000000000000004,"y":0.0,"rotation":0.0,"id":125,"width":38.400000000000006,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

do

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":481.5,"y":402.5,"rotation":0.0,"id":122,"width":110.00000000000001,"height":20.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":50,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.200000000000001,"y":0.0,"rotation":0.0,"id":123,"width":105.60000000000001,"height":14.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

try*/catch*

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":87,"width":60.00000000000001,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":38,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":89,"width":56.00000000000001,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

apply

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":421.5,"y":302.5,"rotation":0.0,"id":20,"width":280.0,"height":230.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":12,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":306.5,"y":52.5,"rotation":0.0,"id":110,"width":60.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":48,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":2.0,"y":0.0,"rotation":0.0,"id":111,"width":55.99999999999999,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Env

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":306.5,"y":52.5,"rotation":0.0,"id":44,"width":395.0,"height":70.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":32,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":31.5,"y":27.5,"rotation":0.0,"id":195,"width":55.0,"height":28.0,"uid":"com.gliffy.shape.basic.basic_v1.default.rectangle","order":87,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[{"x":1.833333333333333,"y":0.0,"rotation":0.0,"id":196,"width":51.333333333333314,"height":16.0,"uid":null,"order":"auto","lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":8,"paddingRight":8,"paddingBottom":8,"paddingLeft":8,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

Core

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"children":[]}]},{"x":31.5,"y":27.5,"rotation":0.0,"id":197,"width":230.0,"height":200.0,"uid":"com.gliffy.shape.basic.basic_v1.default.square","order":86,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Shape","Shape":{"tid":"com.gliffy.stencil.rectangle.basic_v1","strokeWidth":2.0,"strokeColor":"#333333","fillColor":"#FFFFFF","gradient":false,"dashStyle":null,"dropShadow":false,"state":0,"opacity":1.0,"shadowX":0.0,"shadowY":0.0}},"linkMap":[],"children":[]},{"x":451.5,"y":63.5,"rotation":0.0,"id":211,"width":100.0,"height":33.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":92,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

*host-language*

not

load-file

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]},{"x":561.5,"y":63.5,"rotation":0.0,"id":212,"width":77.5,"height":22.0,"uid":"com.gliffy.shape.basic.basic_v1.default.text","order":93,"lockAspectRatio":false,"lockShape":false,"graphic":{"type":"Text","Text":{"overflow":"none","paddingTop":2,"paddingRight":2,"paddingBottom":2,"paddingLeft":2,"outerPaddingTop":6,"outerPaddingRight":6,"outerPaddingBottom":2,"outerPaddingLeft":6,"type":"fixed","lineTValue":null,"linePerpValue":null,"cardinalityType":null,"html":"

cond

or

","tid":null,"valign":"middle","vposition":"none","hposition":"none"}},"linkMap":[],"children":[]}],"shapeStyles":{"com.gliffy.shape.basic.basic_v1.default":{"fill":"#c9daf8","stroke":"#333333","strokeWidth":2}},"lineStyles":{"global":{"strokeWidth":2,"endArrow":2}},"textStyles":{"global":{"bold":true,"size":"10px","color":"#cc0000"}}},"metadata":{"title":"untitled","revision":0,"exportBorder":false,"loadPosition":"default","libraries":["com.gliffy.libraries.basic.basic_v1.default","com.gliffy.libraries.flowchart.flowchart_v1.default","com.gliffy.libraries.swimlanes.swimlanes_v1.default","com.gliffy.libraries.uml.uml_v2.class","com.gliffy.libraries.uml.uml_v2.sequence","com.gliffy.libraries.uml.uml_v2.activity","com.gliffy.libraries.erd.erd_v1.default","com.gliffy.libraries.ui.ui_v3.forms_controls","com.gliffy.libraries.images"],"autosaveDisabled":false},"embeddedResources":{"index":0,"resources":[]}} \ No newline at end of file diff --git a/process/stepA_mal.png b/process/stepA_mal.png index 28dcb5be86..e60363e4db 100644 Binary files a/process/stepA_mal.png and b/process/stepA_mal.png differ diff --git a/process/stepA_mal.txt b/process/stepA_mal.txt index 6c1e71e880..432bdef706 100644 --- a/process/stepA_mal.txt +++ b/process/stepA_mal.txt @@ -3,57 +3,64 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'try*: return ... // try/catch native and malval exceptions - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) + match ast: + 'key: return env.get(key) or raise "'{key}' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form; continue + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last; continue + ('if cond yes no): if EVAL(cond, env) in nil, false + then ast = yes; continue + else ast = no; continue + ('if cond yes): // idem with return nil in the else branch + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form); continue + ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) + ('try* f ('catch* 'k h)): try returning EVAL(f, env) + if native or malval exception then: + env = new Env(env) + env.set(k, exception) + ast = h; continue + ('try* form): ast = form; continue + (callable arg1 ..): f = EVAL(callable, env) + if macro?(f) then: + ast = f(arg1, ..); continue + args = [EVAL(arg1, env) ..] + if malfn?(f) then: + env = new Env(f.env, f.parm, args) + ast = f.impl; continue + return f(args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) -;; core.EXT: defined using Racket +;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself -rep("(def! *host-language* \"racket\")") +rep("(def! *host-language* \"...\")") rep("(def! not (fn* (a) (if a false true)))") -rep("(def! load-file (fn* (f) ...))") -rep("(defmacro! cond (fn* (& xs) ...))") -rep("(defmacro! or (fn* (& xs) ...))") +rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 @@ -69,8 +76,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, @@ -79,10 +85,14 @@ ns = {'=: equal?, 'nil?: nil?, 'true?: true?, 'false?: false?, + 'string?: string?, 'symbol: symbol, 'symbol?: symbol?, 'keyword: keyword, 'keyword?: keyword?, + 'number?: number?, + 'fn?: fn?, + 'macro?: macro?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), @@ -118,6 +128,7 @@ ns = {'=: equal?, 'sequential? sequential?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range", 'first: (a) -> a[0][0] OR nil, 'rest: (a) -> a[0][1..] OR list(), @@ -125,7 +136,9 @@ ns = {'=: equal?, 'count: count, 'apply: apply, 'map: map, + 'conj: conj, + 'seq: seq, 'meta: (a) -> a[0].meta, 'with-meta: (a) -> a[0].with_meta(a[1]), diff --git a/process/steps.drawio b/process/steps.drawio new file mode 100644 index 0000000000..f141bca1b9 --- /dev/null +++ b/process/steps.drawio @@ -0,0 +1,1314 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/process/steps.png b/process/steps.png new file mode 100644 index 0000000000..1a300d5b4f Binary files /dev/null and b/process/steps.png differ diff --git a/ps/Makefile b/ps/Makefile deleted file mode 100644 index 9131674728..0000000000 --- a/ps/Makefile +++ /dev/null @@ -1,19 +0,0 @@ - -TESTS = - -SOURCES_BASE = types.ps reader.ps printer.ps -SOURCES_LISP = env.ps core.ps stepA_mal.ps -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - gs -q -dNODISPLAY -- $@ || exit 1; \ diff --git a/ps/env.ps b/ps/env.ps deleted file mode 100644 index f6d5b88fe4..0000000000 Binary files a/ps/env.ps and /dev/null differ diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps deleted file mode 100644 index 215fc2efd3..0000000000 Binary files a/ps/step2_eval.ps and /dev/null differ diff --git a/ps/step3_env.ps b/ps/step3_env.ps deleted file mode 100644 index e662c11593..0000000000 Binary files a/ps/step3_env.ps and /dev/null differ diff --git a/ps/step4_if_fn_do.ps b/ps/step4_if_fn_do.ps deleted file mode 100644 index 422f6ebab4..0000000000 Binary files a/ps/step4_if_fn_do.ps and /dev/null differ diff --git a/ps/step5_tco.ps b/ps/step5_tco.ps deleted file mode 100644 index 680c3593ef..0000000000 Binary files a/ps/step5_tco.ps and /dev/null differ diff --git a/ps/step6_file.ps b/ps/step6_file.ps deleted file mode 100644 index bc30e3586f..0000000000 Binary files a/ps/step6_file.ps and /dev/null differ diff --git a/ps/step7_quote.ps b/ps/step7_quote.ps deleted file mode 100644 index 3dd9c0c5ef..0000000000 Binary files a/ps/step7_quote.ps and /dev/null differ diff --git a/ps/step8_macros.ps b/ps/step8_macros.ps deleted file mode 100644 index 32ca3afdda..0000000000 Binary files a/ps/step8_macros.ps and /dev/null differ diff --git a/ps/step9_try.ps b/ps/step9_try.ps deleted file mode 100644 index d9beec72c0..0000000000 Binary files a/ps/step9_try.ps and /dev/null differ diff --git a/ps/stepA_mal.ps b/ps/stepA_mal.ps deleted file mode 100644 index c879294207..0000000000 Binary files a/ps/stepA_mal.ps and /dev/null differ diff --git a/ps/tests/stepA_mal.mal b/ps/tests/stepA_mal.mal deleted file mode 100644 index fffa1784d9..0000000000 --- a/ps/tests/stepA_mal.mal +++ /dev/null @@ -1,23 +0,0 @@ -;; Testing basic ps interop - -(ps* "7") -;=>(7) - -(ps* "(7)") -;=>("7") - -(ps* "7 8 9 3 array astore") -;=>((7 8 9)) - -(ps* "1 1 eq") -;=>(true) - -(ps* "/sym") -;=>sym - -(ps* "1 1 eq { (yep) }{ (nope) } ifelse") -;=>("yep") - -(ps* "1 0 eq { (yep) }{ (nope) } ifelse") -;=>("nope") - diff --git a/python/Makefile b/python/Makefile deleted file mode 100644 index 7842eae71b..0000000000 --- a/python/Makefile +++ /dev/null @@ -1,32 +0,0 @@ - -TESTS = - - -SOURCES_BASE = mal_readline.py mal_types.py reader.py printer.py -SOURCES_LISP = env.py core.py stepA_mal.py -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - - -#all: mal.sh -# -#mal.sh: $(SOURCES) -# cat $+ > $@ -# echo "#!/bin/bash" > $@ -# cat $+ | grep -v "^source " >> $@ -# chmod +x $@ -# -#clean: -# rm -f mal.sh - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - python $@ || exit 1; \ diff --git a/python/core.py b/python/core.py deleted file mode 100644 index 4a64594077..0000000000 --- a/python/core.py +++ /dev/null @@ -1,173 +0,0 @@ -import copy, time -from itertools import chain - -import mal_types as types -from mal_types import List, Vector -import mal_readline -import reader -import printer - -# Errors/Exceptions -def throw(exc): raise Exception(exc) - - -# String functions -def pr_str(*args): - return " ".join(map(lambda exp: printer._pr_str(exp, True), args)) - -def do_str(*args): - return "".join(map(lambda exp: printer._pr_str(exp, False), args)) - -def prn(*args): - print(" ".join(map(lambda exp: printer._pr_str(exp, True), args))) - return None - -def println(*args): - line = " ".join(map(lambda exp: printer._pr_str(exp, False), args)) - print(line.replace('\\n', '\n')) - return None - - -# Hash map functions -def assoc(src_hm, *key_vals): - hm = copy.copy(src_hm) - for i in range(0,len(key_vals),2): hm[key_vals[i]] = key_vals[i+1] - return hm - -def dissoc(src_hm, *keys): - hm = copy.copy(src_hm) - for key in keys: - if key in hm: del hm[key] - return hm - -def get(hm, key): - if hm and key in hm: - return hm[key] - else: - return None - -def contains_Q(hm, key): return key in hm - -def keys(hm): return types._list(*hm.keys()) - -def vals(hm): return types._list(*hm.values()) - - -# Sequence functions -def coll_Q(coll): return sequential_Q(coll) or hash_map_Q(coll) - -def cons(x, seq): return List([x]) + List(seq) - -def concat(*lsts): return List(chain(*lsts)) - -def nth(lst, idx): - if idx < len(lst): return lst[idx] - else: throw("nth: index out of range") - -def first(lst): return lst[0] - -def rest(lst): return List(lst[1:]) - -def empty_Q(lst): return len(lst) == 0 - -def count(lst): - if types._nil_Q(lst): return 0 - else: return len(lst) - -# retains metadata -def conj(lst, *args): - if types._list_Q(lst): - new_lst = List(list(reversed(list(args))) + lst) - else: - new_lst = Vector(lst + list(args)) - if hasattr(lst, "__meta__"): - new_lst.__meta__ = lst.__meta__ - return new_lst - -def apply(f, *args): return f(*(list(args[0:-1])+args[-1])) - -def mapf(f, lst): return List(map(f, lst)) - - -# Metadata functions -def with_meta(obj, meta): - new_obj = types._clone(obj) - new_obj.__meta__ = meta - return new_obj - -def meta(obj): - if hasattr(obj, "__meta__"): return obj.__meta__ - else: return None - - -# Atoms functions -def deref(atm): return atm.val -def reset_BANG(atm,val): - atm.val = val - return atm.val -def swap_BANG(atm,f,*args): - atm.val = f(atm.val,*args) - return atm.val - - -ns = { - '=': types._equal_Q, - 'throw': throw, - 'nil?': types._nil_Q, - 'true?': types._true_Q, - 'false?': types._false_Q, - 'symbol': types._symbol, - 'symbol?': types._symbol_Q, - 'keyword': types._keyword, - 'keyword?': types._keyword_Q, - - 'pr-str': pr_str, - 'str': do_str, - 'prn': prn, - 'println': println, - 'readline': lambda prompt: mal_readline.readline(prompt), - 'read-string': reader.read_str, - 'slurp': lambda file: open(file).read(), - '<': lambda a,b: a': lambda a,b: a>b, - '>=': lambda a,b: a>=b, - '+': lambda a,b: a+b, - '-': lambda a,b: a-b, - '*': lambda a,b: a*b, - '/': lambda a,b: int(a/b), - 'time-ms': lambda : int(time.time() * 1000), - - 'list': types._list, - 'list?': types._list_Q, - 'vector': types._vector, - 'vector?': types._vector_Q, - 'hash-map': types._hash_map, - 'map?': types._hash_map_Q, - 'assoc': assoc, - 'dissoc': dissoc, - 'get': get, - 'contains?': contains_Q, - 'keys': keys, - 'vals': vals, - - 'sequential?': types._sequential_Q, - 'cons': cons, - 'concat': concat, - 'nth': nth, - 'first': first, - 'rest': rest, - 'empty?': empty_Q, - 'count': count, - 'conj': conj, - 'apply': apply, - 'map': mapf, - - 'with-meta': with_meta, - 'meta': meta, - 'atom': types._atom, - 'atom?': types._atom_Q, - 'deref': deref, - 'reset!': reset_BANG, - 'swap!': swap_BANG} - diff --git a/python/env.py b/python/env.py deleted file mode 100644 index 4cd8e0574d..0000000000 --- a/python/env.py +++ /dev/null @@ -1,28 +0,0 @@ -# Environment - -class Env(): - def __init__(self, outer=None, binds=None, exprs=None): - self.data = {} - self.outer = outer or None - - if binds: - for i in range(len(binds)): - if binds[i] == "&": - self.data[binds[i+1]] = exprs[i:] - break - else: - self.data[binds[i]] = exprs[i] - - def find(self, key): - if key in self.data: return self - elif self.outer: return self.outer.find(key) - else: return None - - def set(self, key, value): - self.data[key] = value - return value - - def get(self, key): - env = self.find(key) - if not env: raise Exception("'" + key + "' not found") - return env.data[key] diff --git a/python/mal_readline.py b/python/mal_readline.py deleted file mode 100644 index fc22b58d93..0000000000 --- a/python/mal_readline.py +++ /dev/null @@ -1,30 +0,0 @@ -import os, sys, readline as pyreadline - -history_loaded = False -histfile = os.path.expanduser("~/.mal-history") -if sys.version_info[0] >= 3: - rl = input -else: - rl = raw_input - -def readline(prompt="user> "): - global history_loaded - if not history_loaded: - history_loaded = True - try: - with open(histfile, "r") as hf: - for line in hf.readlines(): - pyreadline.add_history(line.rstrip("\r\n")) - pass - except IOError: - print("Could not open %s" % histfile) - pass - - try: - line = rl(prompt) - pyreadline.add_history(line) - with open(histfile, "a") as hf: - hf.write(line + "\n") - return line - except EOFError: - return None diff --git a/python/mal_types.py b/python/mal_types.py deleted file mode 100644 index b1b1b3bc62..0000000000 --- a/python/mal_types.py +++ /dev/null @@ -1,126 +0,0 @@ -import sys, copy, types as pytypes - -# python 3.0 differences -if sys.hexversion > 0x3000000: - def u(x): - return x -else: - import codecs - def u(x): - return codecs.unicode_escape_decode(x)[0] - - -if sys.version_info[0] >= 3: - str_types = [str] -else: - str_types = [str, unicode] - -# General functions - -def _equal_Q(a, b): - ota, otb = type(a), type(b) - if not (ota == otb or (_sequential_Q(a) and _sequential_Q(b))): - return False; - if _symbol_Q(a): - return a == b - elif _list_Q(a) or _vector_Q(a): - if len(a) != len(b): return False - for i in range(len(a)): - if not _equal_Q(a[i], b[i]): return False - return True - elif _hash_map_Q(a): - akeys = a.keys() - akeys.sort() - bkeys = b.keys() - bkeys.sort() - if len(akeys) != len(bkeys): return False - for i in range(len(akeys)): - if akeys[i] != bkeys[i]: return False - if not equal_Q(a[akeys[i]], b[bkeys[i]]): return False - return True - else: - return a == b - -def _sequential_Q(seq): return _list_Q(seq) or _vector_Q(seq) - -def _clone(obj): - #if type(obj) == type(lambda x:x): - if type(obj) == pytypes.FunctionType: - if obj.__code__: - return pytypes.FunctionType( - obj.__code__, obj.__globals__, name = obj.__name__, - argdefs = obj.__defaults__, closure = obj.__closure__) - else: - return pytypes.FunctionType( - obj.func_code, obj.func_globals, name = obj.func_name, - argdefs = obj.func_defaults, closure = obj.func_closure) - else: - return copy.copy(obj) - - -# Scalars -def _nil_Q(exp): return exp is None -def _true_Q(exp): return exp is True -def _false_Q(exp): return exp is False -def _string_Q(exp): return type(exp) in str_types - -# Symbols -class Symbol(str): pass -def _symbol(str): return Symbol(str) -def _symbol_Q(exp): return type(exp) == Symbol - -# Keywords -# A specially prefixed string -def _keyword(str): - if str[0] == u("\u029e"): return str - else: return u("\u029e") + str -def _keyword_Q(exp): - return _string_Q(exp) and exp[0] == u("\u029e") - -# Functions -def _function(Eval, Env, ast, env, params): - def fn(*args): - return Eval(ast, Env(env, params, args)) - fn.__meta__ = None - fn.__ast__ = ast - fn.__gen_env__ = lambda args: Env(env, params, args) - return fn -def _function_Q(f): return type(f) == type(function_Q) - -# lists -class List(list): - def __add__(self, rhs): return List(list.__add__(self, rhs)) - def __getitem__(self, i): - if type(i) == slice: return List(list.__getitem__(self, i)) - elif i >= len(self): return None - else: return list.__getitem__(self, i) - def __getslice__(self, *a): return List(list.__getslice__(self, *a)) -def _list(*vals): return List(vals) -def _list_Q(exp): return type(exp) == List - - -# vectors -class Vector(list): - def __add__(self, rhs): return Vector(list.__add__(self, rhs)) - def __getitem__(self, i): - if type(i) == slice: return Vector(list.__getitem__(self, i)) - elif i >= len(self): return None - else: return list.__getitem__(self, i) - def __getslice__(self, *a): return Vector(list.__getslice__(self, *a)) -def _vector(*vals): return Vector(vals) -def _vector_Q(exp): return type(exp) == Vector - -# Hash maps -class Hash_Map(dict): pass -def _hash_map(*key_vals): - hm = Hash_Map() - for i in range(0,len(key_vals),2): hm[key_vals[i]] = key_vals[i+1] - return hm -def _hash_map_Q(exp): return type(exp) == Hash_Map - -# atoms -class Atom(object): - def __init__(self, val): - self.val = val -def _atom(val): return Atom(val) -def _atom_Q(exp): return type(exp) == Atom diff --git a/python/printer.py b/python/printer.py deleted file mode 100644 index 98e3e90b2b..0000000000 --- a/python/printer.py +++ /dev/null @@ -1,31 +0,0 @@ -import mal_types as types - -def _pr_str(obj, print_readably=True): - _r = print_readably - if types._list_Q(obj): - return "(" + " ".join(map(lambda e: _pr_str(e,_r), obj)) + ")" - elif types._vector_Q(obj): - return "[" + " ".join(map(lambda e: _pr_str(e,_r), obj)) + "]" - elif types._hash_map_Q(obj): - ret = [] - for k in obj.keys(): - ret.extend((_pr_str(k), _pr_str(obj[k],_r))) - return "{" + " ".join(ret) + "}" - elif types._string_Q(obj): - if len(obj) > 0 and obj[0] == types.u('\u029e'): - return ':' + obj[1:] - elif print_readably: - return '"' + obj.encode('unicode_escape').decode('latin1').replace('"', '\\"') + '"' - else: - return obj - elif types._nil_Q(obj): - return "nil" - elif types._true_Q(obj): - return "true" - elif types._false_Q(obj): - return "false" - elif types._atom_Q(obj): - return "(atom " + _pr_str(obj.val,_r) + ")" - else: - return obj.__str__() - diff --git a/python/reader.py b/python/reader.py deleted file mode 100644 index 71ad3d64e0..0000000000 --- a/python/reader.py +++ /dev/null @@ -1,105 +0,0 @@ -import re -from mal_types import (_symbol, _keyword, _list, _vector, _hash_map) - -class Blank(Exception): pass - -class Reader(): - def __init__(self, tokens, position=0): - self.tokens = tokens - self.position = position - - def next(self): - self.position += 1 - return self.tokens[self.position-1] - - def peek(self): - if len(self.tokens) > self.position: - return self.tokens[self.position] - else: - return None - -def tokenize(str): - tre = re.compile(r"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:[\\].|[^\\"])*"|;.*|[^\s\[\]{}()'"`@,;]+)"""); - return [t for t in re.findall(tre, str) if t[0] != ';'] - -def read_atom(reader): - int_re = re.compile(r"-?[0-9]+$") - float_re = re.compile(r"-?[0-9][0-9.]*$") - token = reader.next() - if re.match(int_re, token): return int(token) - elif re.match(float_re, token): return int(token) - elif token[0] == '"': return token[1:-1].replace('\\"', '"') - elif token[0] == ':': return _keyword(token[1:]) - elif token == "nil": return None - elif token == "true": return True - elif token == "false": return False - else: return _symbol(token) - -def read_sequence(reader, typ=list, start='(', end=')'): - ast = typ() - token = reader.next() - if token != start: raise Exception("expected '" + start + "'") - - token = reader.peek() - while token != end: - if not token: raise Exception("expected '" + end + "', got EOF") - ast.append(read_form(reader)) - token = reader.peek() - reader.next() - return ast - -def read_hash_map(reader): - lst = read_sequence(reader, list, '{', '}') - return _hash_map(*lst) - -def read_list(reader): - return read_sequence(reader, _list, '(', ')') - -def read_vector(reader): - return read_sequence(reader, _vector, '[', ']') - -def read_form(reader): - token = reader.peek() - # reader macros/transforms - if token[0] == ';': - reader.next() - return None - elif token == '\'': - reader.next() - return _list(_symbol('quote'), read_form(reader)) - elif token == '`': - reader.next() - return _list(_symbol('quasiquote'), read_form(reader)) - elif token == '~': - reader.next() - return _list(_symbol('unquote'), read_form(reader)) - elif token == '~@': - reader.next() - return _list(_symbol('splice-unquote'), read_form(reader)) - elif token == '^': - reader.next() - meta = read_form(reader) - return _list(_symbol('with-meta'), read_form(reader), meta) - elif token == '@': - reader.next() - return _list(_symbol('deref'), read_form(reader)) - - # list - elif token == ')': raise Exception("unexpected ')'") - elif token == '(': return read_list(reader) - - # vector - elif token == ']': raise Exception("unexpected ']'"); - elif token == '[': return read_vector(reader); - - # hash-map - elif token == '}': raise Exception("unexpected '}'"); - elif token == '{': return read_hash_map(reader); - - # atom - else: return read_atom(reader); - -def read_str(str): - tokens = tokenize(str) - if len(tokens) == 0: raise Blank("Blank Line") - return read_form(Reader(tokens)) diff --git a/python/step0_repl.py b/python/step0_repl.py deleted file mode 100644 index bb4d6bf897..0000000000 --- a/python/step0_repl.py +++ /dev/null @@ -1,33 +0,0 @@ -import sys, traceback -import mal_readline - -# read -def READ(str): - return str - -# eval -def EVAL(ast, env): - # try it as an expression then a statement - try: - return eval(ast) - except SyntaxError: - exec compile(ast, '', 'single') in globals() - return None - -# print -def PRINT(exp): - return exp - -# repl -def REP(str): - return PRINT(EVAL(READ(str), {})) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step1_read_print.py b/python/step1_read_print.py deleted file mode 100644 index 3c2e4ac300..0000000000 --- a/python/step1_read_print.py +++ /dev/null @@ -1,31 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer - -# read -def READ(str): - return reader.read_str(str) - -# eval -def EVAL(ast, env): - #print("EVAL %s" % printer._pr_str(ast)) - return ast - -def PRINT(exp): - return printer._pr_str(exp) - -# repl -def REP(str): - return PRINT(EVAL(READ(str), {})) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step2_eval.py b/python/step2_eval.py deleted file mode 100644 index 8af09b16c6..0000000000 --- a/python/step2_eval.py +++ /dev/null @@ -1,62 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer - -# read -def READ(str): - return reader.read_str(str) - -# eval -def eval_ast(ast, env): - if types._symbol_Q(ast): - try: - return env[ast] - except: - raise Exception("'" + ast + "' not found") - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) - -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = {} -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -repl_env['+'] = lambda a,b: a+b -repl_env['-'] = lambda a,b: a-b -repl_env['*'] = lambda a,b: a*b -repl_env['/'] = lambda a,b: int(a/b) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step3_env.py b/python/step3_env.py deleted file mode 100644 index 86dc176d72..0000000000 --- a/python/step3_env.py +++ /dev/null @@ -1,75 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env - -# read -def READ(str): - return reader.read_str(str) - -# eval -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - return EVAL(a2, let_env) - else: - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -repl_env.set(types._symbol('+'), lambda a,b: a+b) -repl_env.set(types._symbol('-'), lambda a,b: a-b) -repl_env.set(types._symbol('*'), lambda a,b: a*b) -repl_env.set(types._symbol('/'), lambda a,b: int(a/b)) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step4_if_fn_do.py b/python/step4_if_fn_do.py deleted file mode 100644 index 39b9dd6653..0000000000 --- a/python/step4_if_fn_do.py +++ /dev/null @@ -1,91 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - return EVAL(a2, let_env) - elif "do" == a0: - el = eval_ast(ast[1:], env) - return el[-1] - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: return EVAL(ast[3], env) - else: return None - else: - return EVAL(a2, env) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))") - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step5_tco.py b/python/step5_tco.py deleted file mode 100644 index da338d413f..0000000000 --- a/python/step5_tco.py +++ /dev/null @@ -1,100 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))") - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step6_file.py b/python/step6_file.py deleted file mode 100644 index 5d10b46979..0000000000 --- a/python/step6_file.py +++ /dev/null @@ -1,107 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) -repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -if len(sys.argv) >= 2: - REP('(load-file "' + sys.argv[1] + '")') - sys.exit(0) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step7_quote.py b/python/step7_quote.py deleted file mode 100644 index 7c97c23797..0000000000 --- a/python/step7_quote.py +++ /dev/null @@ -1,130 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) - else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) - -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "quote" == a0: - return ast[1] - elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) -repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -if len(sys.argv) >= 2: - REP('(load-file "' + sys.argv[1] + '")') - sys.exit(0) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step8_macros.py b/python/step8_macros.py deleted file mode 100644 index da863c1eeb..0000000000 --- a/python/step8_macros.py +++ /dev/null @@ -1,152 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) - else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) - -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = macroexpand(mac(*ast[1:]), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): return ast - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "quote" == a0: - return ast[1] - elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) - elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func._ismacro_ = True - return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) -repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if len(sys.argv) >= 2: - REP('(load-file "' + sys.argv[1] + '")') - sys.exit(0) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/step9_try.py b/python/step9_try.py deleted file mode 100644 index e01f42c94a..0000000000 --- a/python/step9_try.py +++ /dev/null @@ -1,169 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) - else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) - -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = macroexpand(mac(*ast[1:]), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): return ast - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "quote" == a0: - return ast[1] - elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) - elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func._ismacro_ = True - return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) - elif "py!*" == a0: - if sys.version_info[0] >= 3: - exec(compile(ast[1], '', 'single'), globals()) - else: - exec(compile(ast[1], '', 'single') in globals()) - return None - elif "try*" == a0: - a1, a2 = ast[1], ast[2] - if a2[0] == "catch*": - try: - return EVAL(a1, env); - except Exception as exc: - exc = exc.args[0] - catch_env = Env(env, [a2[1]], [exc]) - return EVAL(a2[2], catch_env) - else: - return EVAL(a1, env); - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) -repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) - -# core.mal: defined using the language itself -REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if len(sys.argv) >= 2: - REP('(load-file "' + sys.argv[1] + '")') - sys.exit(0) - -# repl loop -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/python/stepA_mal.py b/python/stepA_mal.py deleted file mode 100644 index 93cdb2e39f..0000000000 --- a/python/stepA_mal.py +++ /dev/null @@ -1,177 +0,0 @@ -import sys, traceback -import mal_readline -import mal_types as types -import reader, printer -from env import Env -import core - -# read -def READ(str): - return reader.read_str(str) - -# eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 - -def quasiquote(ast): - if not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) - else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) - -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = macroexpand(mac(*ast[1:]), env) - return ast - -def eval_ast(ast, env): - if types._symbol_Q(ast): - return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) - elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) - elif types._hash_map_Q(ast): - keyvals = [] - for k in ast.keys(): - keyvals.append(EVAL(k, env)) - keyvals.append(EVAL(ast[k], env)) - return types._hash_map(*keyvals) - else: - return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - - # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): return ast - if len(ast) == 0: return ast - a0 = ast[0] - - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - ast = a2 - env = let_env - # Continue loop (TCO) - elif "quote" == a0: - return ast[1] - elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) - elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func._ismacro_ = True - return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) - elif "py!*" == a0: - if sys.version_info[0] >= 3: - exec(compile(ast[1], '', 'single'), globals()) - else: - exec(compile(ast[1], '', 'single') in globals()) - return None - elif "py*" == a0: - return eval(ast[1]) - elif "." == a0: - el = eval_ast(ast[2:], env) - f = eval(ast[1]) - return f(*el) - elif "try*" == a0: - a1, a2 = ast[1], ast[2] - if a2[0] == "catch*": - try: - return EVAL(a1, env); - except Exception as exc: - exc = exc.args[0] - catch_env = Env(env, [a2[1]], [exc]) - return EVAL(a2[2], catch_env) - else: - return EVAL(a1, env); - elif "do" == a0: - eval_ast(ast[1:-1], env) - ast = ast[-1] - # Continue loop (TCO) - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None - else: - ast = a2 - # Continue loop (TCO) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - if hasattr(f, '__ast__'): - ast = f.__ast__ - env = f.__gen_env__(el[1:]) - else: - return f(*el[1:]) - -# print -def PRINT(exp): - return printer._pr_str(exp) - -# repl -repl_env = Env() -def REP(str): - return PRINT(EVAL(READ(str), repl_env)) - -# core.py: defined using python -for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) -repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) - -# core.mal: defined using the language itself -REP("(def! *host-language* \"python\")") -REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -if len(sys.argv) >= 2: - REP('(load-file "' + sys.argv[1] + '")') - sys.exit(0) - -# repl loop -REP("(println (str \"Mal [\" *host-language* \"]\"))") -while True: - try: - line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue - print(REP(line)) - except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/r/Makefile b/r/Makefile deleted file mode 100644 index 4d1ec24a43..0000000000 --- a/r/Makefile +++ /dev/null @@ -1,24 +0,0 @@ -TESTS = - -SOURCES_BASE = readline.r types.r reader.r printer.r -SOURCES_LISP = env.r core.r stepA_mal.r -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: libs - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - - -.PHONY: -libs: lib/rdyncall - -lib/rdyncall: - curl -O http://cran.r-project.org/src/contrib/Archive/rdyncall/rdyncall_0.7.5.tar.gz - mkdir -p lib - R CMD INSTALL rdyncall_0.7.5.tar.gz -l lib/ - rm rdyncall_0.7.5.tar.gz diff --git a/r/readline.r b/r/readline.r deleted file mode 100644 index 79ababcf3e..0000000000 --- a/r/readline.r +++ /dev/null @@ -1,40 +0,0 @@ -..readline.. <- TRUE - -HISTORY_FILE = paste(path.expand("~"), "/.mal-history", sep="") - -library(rdyncall, lib.loc="lib/") - -#.rllib <- dynfind(c("edit")) -.rllib <- dynfind(c("readline")) -.call_readline <- .dynsym(.rllib,"readline") -.call_add_history <- .dynsym(.rllib,"add_history") - -.state <- new.env() -.state$rl_history_loaded = FALSE - -.readline <- function(prompt) { - res <- .dyncall(.call_readline, "Z)p", prompt) - if (is.nullptr(res)) { - return(NULL) - } else { - return(ptr2str(res)) - } -} - -readline <- function(prompt) { - if (!.state$rl_history_loaded) { - .state$rl_history_loaded <- TRUE - - lines <- scan(HISTORY_FILE, what="", sep="\n", quiet=TRUE) - for(add_line in lines) { - .dyncall(.call_add_history, "Z)v", add_line) - } - } - - line <- .readline(prompt) - if (is.null(line)) return(NULL) - .dyncall(.call_add_history, "Z)v", line) - write(line, file=HISTORY_FILE, append=TRUE) - - line -} diff --git a/r/step2_eval.r b/r/step2_eval.r deleted file mode 100644 index 45036f005c..0000000000 --- a/r/step2_eval.r +++ /dev/null @@ -1,63 +0,0 @@ -if(!exists("..readline..")) source("readline.r") -if(!exists("..types..")) source("types.r") -if(!exists("..reader..")) source("reader.r") -if(!exists("..printer..")) source("printer.r") - -READ <- function(str) { - return(read_str(str)) -} - -eval_ast <- function(ast, env) { - if (.symbol_q(ast)) { - env[[as.character(ast)]] - } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) - } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) - } else if (.hash_map_q(ast)) { - lst <- list() - for(k in ls(ast)) { - lst[[length(lst)+1]] = k - lst[[length(lst)+1]] = EVAL(ast[[k]], env) - } - new.hash_mapl(lst) - } else { - ast - } -} - -EVAL <- function(ast, env) { - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } - - # apply list - el <- eval_ast(ast, env) - f <- el[[1]] - return(do.call(f,el[-1])) -} - -PRINT <- function(exp) { - return(.pr_str(exp, TRUE)) -} - -repl_env <- new.env() -repl_env[["+"]] <- function(a,b) a+b -repl_env[["-"]] <- function(a,b) a-b -repl_env[["*"]] <- function(a,b) a*b -repl_env[["/"]] <- function(a,b) a/b - -rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) - -repeat { - line <- readline("user> ") - if (is.null(line)) { cat("\n"); break } - tryCatch({ - cat(rep(line),"\n", sep="") - }, error=function(err) { - cat("Error: ", get_error(err),"\n", sep="") - }) - # R debug/fatal with tracebacks: - #cat(rep(line),"\n", sep="") -} diff --git a/r/step7_quote.r b/r/step7_quote.r deleted file mode 100644 index 9abfdde467..0000000000 --- a/r/step7_quote.r +++ /dev/null @@ -1,148 +0,0 @@ -if(!exists("..readline..")) source("readline.r") -if(!exists("..types..")) source("types.r") -if(!exists("..reader..")) source("reader.r") -if(!exists("..printer..")) source("printer.r") -if(!exists("..env..")) source("env.r") -if(!exists("..core..")) source("core.r") - -# read -READ <- function(str) { - return(read_str(str)) -} - -# eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 -} - -quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) - } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) - } -} - -eval_ast <- function(ast, env) { - if (.symbol_q(ast)) { - Env.get(env, ast) - } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) - } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) - } else if (.hash_map_q(ast)) { - lst <- list() - for(k in ls(ast)) { - lst[[length(lst)+1]] = k - lst[[length(lst)+1]] = EVAL(ast[[k]], env) - } - new.hash_mapl(lst) - } else { - ast - } -} - -EVAL <- function(ast, env) { - repeat { - - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } - - # apply list - switch(paste("l",length(ast),sep=""), - l0={ return(ast) }, - l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, - l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, - { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) - if (length(a0) > 1) a0sym <- "__<*fn*>__" - else a0sym <- as.character(a0) - if (a0sym == "def!") { - res <- EVAL(a2, env) - return(Env.set(env, a1, res)) - } else if (a0sym == "let*") { - let_env <- new.Env(env) - for(i in seq(1,length(a1),2)) { - Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) - } - ast <- a2 - env <- let_env - } else if (a0sym == "quote") { - return(a1) - } else if (a0sym == "quasiquote") { - ast <- quasiquote(a1) - } else if (a0sym == "do") { - eval_ast(slice(ast,2,length(ast)-1), env) - ast <- ast[[length(ast)]] - } else if (a0sym == "if") { - cond <- EVAL(a1, env) - if (.nil_q(cond) || identical(cond, FALSE)) { - if (length(ast) < 4) return(nil) - ast <- ast[[4]] - } else { - ast <- a2 - } - } else if (a0sym == "fn*") { - return(malfunc(EVAL, a2, env, a1)) - } else { - el <- eval_ast(ast, env) - f <- el[[1]] - if (class(f) == "MalFunc") { - ast <- f$ast - env <- f$gen_env(slice(el,2)) - } else { - return(do.call(f,slice(el,2))) - } - } - - } -} - -# print -PRINT <- function(exp) { - return(.pr_str(exp, TRUE)) -} - -# repl loop -repl_env <- new.Env() -rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) - -# core.r: defined using R -for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } -Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) -Env.set(repl_env, "*ARGV*", new.list()) - -# core.mal: defined using the language itself -. <- rep("(def! not (fn* (a) (if a false true)))") -. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -args <- commandArgs(trailingOnly = TRUE) -if (length(args) > 0) { - Env.set(repl_env, "*ARGV*", new.listl(slice(list(args),2))) - . <- rep(concat("(load-file \"", args[[1]], "\")")) - quit(save="no", status=0) -} - -repeat { - line <- readline("user> ") - if (is.null(line)) { cat("\n"); break } - tryCatch({ - cat(rep(line),"\n", sep="") - }, error=function(err) { - cat("Error: ", get_error(err),"\n", sep="") - }) - # R debug/fatal with tracebacks: - #cat(rep(line),"\n", sep="") -} diff --git a/r/step8_macros.r b/r/step8_macros.r deleted file mode 100644 index 00931d81e4..0000000000 --- a/r/step8_macros.r +++ /dev/null @@ -1,178 +0,0 @@ -if(!exists("..readline..")) source("readline.r") -if(!exists("..types..")) source("types.r") -if(!exists("..reader..")) source("reader.r") -if(!exists("..printer..")) source("printer.r") -if(!exists("..env..")) source("env.r") -if(!exists("..core..")) source("core.r") - -# read -READ <- function(str) { - return(read_str(str)) -} - -# eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 -} - -quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) - } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) - } -} - -is_macro_call <- function(ast, env) { - if(.list_q(ast) && - .symbol_q(ast[[1]]) && - (!.nil_q(Env.find(env, ast[[1]])))) { - exp <- Env.get(env, ast[[1]]) - return(.malfunc_q(exp) && exp$ismacro) - } - FALSE -} - -macroexpand <- function(ast, env) { - while(is_macro_call(ast, env)) { - mac <- Env.get(env, ast[[1]]) - ast <- fapply(mac, slice(ast, 2)) - } - ast -} - -eval_ast <- function(ast, env) { - if (.symbol_q(ast)) { - Env.get(env, ast) - } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) - } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) - } else if (.hash_map_q(ast)) { - lst <- list() - for(k in ls(ast)) { - lst[[length(lst)+1]] = k - lst[[length(lst)+1]] = EVAL(ast[[k]], env) - } - new.hash_mapl(lst) - } else { - ast - } -} - -EVAL <- function(ast, env) { - repeat { - - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } - - # apply list - ast <- macroexpand(ast, env) - if (!.list_q(ast)) return(ast) - - switch(paste("l",length(ast),sep=""), - l0={ return(ast) }, - l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, - l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, - { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) - if (length(a0) > 1) a0sym <- "__<*fn*>__" - else a0sym <- as.character(a0) - if (a0sym == "def!") { - res <- EVAL(a2, env) - return(Env.set(env, a1, res)) - } else if (a0sym == "let*") { - let_env <- new.Env(env) - for(i in seq(1,length(a1),2)) { - Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) - } - ast <- a2 - env <- let_env - } else if (a0sym == "quote") { - return(a1) - } else if (a0sym == "quasiquote") { - ast <- quasiquote(a1) - } else if (a0sym == "defmacro!") { - func <- EVAL(a2, env) - func$ismacro = TRUE - return(Env.set(env, a1, func)) - } else if (a0sym == "macroexpand") { - return(macroexpand(a1, env)) - } else if (a0sym == "do") { - eval_ast(slice(ast,2,length(ast)-1), env) - ast <- ast[[length(ast)]] - } else if (a0sym == "if") { - cond <- EVAL(a1, env) - if (.nil_q(cond) || identical(cond, FALSE)) { - if (length(ast) < 4) return(nil) - ast <- ast[[4]] - } else { - ast <- a2 - } - } else if (a0sym == "fn*") { - return(malfunc(EVAL, a2, env, a1)) - } else { - el <- eval_ast(ast, env) - f <- el[[1]] - if (class(f) == "MalFunc") { - ast <- f$ast - env <- f$gen_env(slice(el,2)) - } else { - return(do.call(f,slice(el,2))) - } - } - - } -} - -# print -PRINT <- function(exp) { - return(.pr_str(exp, TRUE)) -} - -# repl loop -repl_env <- new.Env() -rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) - -# core.r: defined using R -for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } -Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) -Env.set(repl_env, "*ARGV*", new.list()) - -# core.mal: defined using the language itself -. <- rep("(def! not (fn* (a) (if a false true)))") -. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -. <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -. <- rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - -args <- commandArgs(trailingOnly = TRUE) -if (length(args) > 0) { - Env.set(repl_env, "*ARGV*", new.listl(slice(list(args),2))) - . <- rep(concat("(load-file \"", args[[1]], "\")")) - quit(save="no", status=0) -} - -repeat { - line <- readline("user> ") - if (is.null(line)) { cat("\n"); break } - tryCatch({ - cat(rep(line),"\n", sep="") - }, error=function(err) { - cat("Error: ", get_error(err),"\n", sep="") - }) - # R debug/fatal with tracebacks: - #cat(rep(line),"\n", sep="") -} diff --git a/r/step9_try.r b/r/step9_try.r deleted file mode 100644 index 02a6507d43..0000000000 --- a/r/step9_try.r +++ /dev/null @@ -1,196 +0,0 @@ -if(!exists("..readline..")) source("readline.r") -if(!exists("..types..")) source("types.r") -if(!exists("..reader..")) source("reader.r") -if(!exists("..printer..")) source("printer.r") -if(!exists("..env..")) source("env.r") -if(!exists("..core..")) source("core.r") - -# read -READ <- function(str) { - return(read_str(str)) -} - -# eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 -} - -quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) - } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) - } -} - -is_macro_call <- function(ast, env) { - if(.list_q(ast) && - .symbol_q(ast[[1]]) && - (!.nil_q(Env.find(env, ast[[1]])))) { - exp <- Env.get(env, ast[[1]]) - return(.malfunc_q(exp) && exp$ismacro) - } - FALSE -} - -macroexpand <- function(ast, env) { - while(is_macro_call(ast, env)) { - mac <- Env.get(env, ast[[1]]) - ast <- fapply(mac, slice(ast, 2)) - } - ast -} - -eval_ast <- function(ast, env) { - if (.symbol_q(ast)) { - Env.get(env, ast) - } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) - } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) - } else if (.hash_map_q(ast)) { - lst <- list() - for(k in ls(ast)) { - lst[[length(lst)+1]] = k - lst[[length(lst)+1]] = EVAL(ast[[k]], env) - } - new.hash_mapl(lst) - } else { - ast - } -} - -EVAL <- function(ast, env) { - repeat { - - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } - - # apply list - ast <- macroexpand(ast, env) - if (!.list_q(ast)) return(ast) - - switch(paste("l",length(ast),sep=""), - l0={ return(ast) }, - l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, - l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, - { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) - if (length(a0) > 1) a0sym <- "__<*fn*>__" - else a0sym <- as.character(a0) - if (a0sym == "def!") { - res <- EVAL(a2, env) - return(Env.set(env, a1, res)) - } else if (a0sym == "let*") { - let_env <- new.Env(env) - for(i in seq(1,length(a1),2)) { - Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) - } - ast <- a2 - env <- let_env - } else if (a0sym == "quote") { - return(a1) - } else if (a0sym == "quasiquote") { - ast <- quasiquote(a1) - } else if (a0sym == "defmacro!") { - func <- EVAL(a2, env) - func$ismacro = TRUE - return(Env.set(env, a1, func)) - } else if (a0sym == "macroexpand") { - return(macroexpand(a1, env)) - } else if (a0sym == "try*") { - edata <- new.env() - tryCatch({ - return(EVAL(a1, env)) - }, error=function(err) { - edata$exc <- get_error(err) - }) - if ((!is.null(a2)) && a2[[1]] == "catch*") { - return(EVAL(a2[[3]], new.Env(env, - new.list(a2[[2]]), - new.list(edata$exc)))) - } else { - throw(err) - } - } else if (a0sym == "do") { - eval_ast(slice(ast,2,length(ast)-1), env) - ast <- ast[[length(ast)]] - } else if (a0sym == "if") { - cond <- EVAL(a1, env) - if (.nil_q(cond) || identical(cond, FALSE)) { - if (length(ast) < 4) return(nil) - ast <- ast[[4]] - } else { - ast <- a2 - } - } else if (a0sym == "fn*") { - return(malfunc(EVAL, a2, env, a1)) - } else { - el <- eval_ast(ast, env) - f <- el[[1]] - if (class(f) == "MalFunc") { - ast <- f$ast - env <- f$gen_env(slice(el,2)) - } else { - return(do.call(f,slice(el,2))) - } - } - - } -} - -# print -PRINT <- function(exp) { - return(.pr_str(exp, TRUE)) -} - -# repl loop -repl_env <- new.Env() -rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) - -# core.r: defined using R -for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } -Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) -Env.set(repl_env, "*ARGV*", new.list()) - -# core.mal: defined using the language itself -. <- rep("(def! not (fn* (a) (if a false true)))") -. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -. <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -. <- rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - -args <- commandArgs(trailingOnly = TRUE) -if (length(args) > 0) { - Env.set(repl_env, "*ARGV*", new.listl(slice(list(args),2))) - tryCatch({ - . <- rep(concat("(load-file \"", args[[1]], "\")")) - }, error=function(err) { - cat("Error: ", get_error(err),"\n", sep="") - }) - quit(save="no", status=0) -} - -repeat { - line <- readline("user> ") - if (is.null(line)) { cat("\n"); break } - tryCatch({ - cat(rep(line),"\n", sep="") - }, error=function(err) { - cat("Error: ", get_error(err),"\n", sep="") - }) - # R debug/fatal with tracebacks: - #cat(rep(line),"\n", sep="") -} diff --git a/r/stepA_mal.r b/r/stepA_mal.r deleted file mode 100644 index e6990487fe..0000000000 --- a/r/stepA_mal.r +++ /dev/null @@ -1,198 +0,0 @@ -if(!exists("..readline..")) source("readline.r") -if(!exists("..types..")) source("types.r") -if(!exists("..reader..")) source("reader.r") -if(!exists("..printer..")) source("printer.r") -if(!exists("..env..")) source("env.r") -if(!exists("..core..")) source("core.r") - -# read -READ <- function(str) { - return(read_str(str)) -} - -# eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 -} - -quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) - } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) - } -} - -is_macro_call <- function(ast, env) { - if(.list_q(ast) && - .symbol_q(ast[[1]]) && - (!.nil_q(Env.find(env, ast[[1]])))) { - exp <- Env.get(env, ast[[1]]) - return(.malfunc_q(exp) && exp$ismacro) - } - FALSE -} - -macroexpand <- function(ast, env) { - while(is_macro_call(ast, env)) { - mac <- Env.get(env, ast[[1]]) - ast <- fapply(mac, slice(ast, 2)) - } - ast -} - -eval_ast <- function(ast, env) { - if (.symbol_q(ast)) { - Env.get(env, ast) - } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) - } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) - } else if (.hash_map_q(ast)) { - lst <- list() - for(k in ls(ast)) { - lst[[length(lst)+1]] = k - lst[[length(lst)+1]] = EVAL(ast[[k]], env) - } - new.hash_mapl(lst) - } else { - ast - } -} - -EVAL <- function(ast, env) { - repeat { - - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { - return(eval_ast(ast, env)) - } - - # apply list - ast <- macroexpand(ast, env) - if (!.list_q(ast)) return(ast) - - switch(paste("l",length(ast),sep=""), - l0={ return(ast) }, - l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, - l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, - { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) - if (length(a0) > 1) a0sym <- "__<*fn*>__" - else a0sym <- as.character(a0) - if (a0sym == "def!") { - res <- EVAL(a2, env) - return(Env.set(env, a1, res)) - } else if (a0sym == "let*") { - let_env <- new.Env(env) - for(i in seq(1,length(a1),2)) { - Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) - } - ast <- a2 - env <- let_env - } else if (a0sym == "quote") { - return(a1) - } else if (a0sym == "quasiquote") { - ast <- quasiquote(a1) - } else if (a0sym == "defmacro!") { - func <- EVAL(a2, env) - func$ismacro = TRUE - return(Env.set(env, a1, func)) - } else if (a0sym == "macroexpand") { - return(macroexpand(a1, env)) - } else if (a0sym == "try*") { - edata <- new.env() - tryCatch({ - return(EVAL(a1, env)) - }, error=function(err) { - edata$exc <- get_error(err) - }) - if ((!is.null(a2)) && a2[[1]] == "catch*") { - return(EVAL(a2[[3]], new.Env(env, - new.list(a2[[2]]), - new.list(edata$exc)))) - } else { - throw(err) - } - } else if (a0sym == "do") { - eval_ast(slice(ast,2,length(ast)-1), env) - ast <- ast[[length(ast)]] - } else if (a0sym == "if") { - cond <- EVAL(a1, env) - if (.nil_q(cond) || identical(cond, FALSE)) { - if (length(ast) < 4) return(nil) - ast <- ast[[4]] - } else { - ast <- a2 - } - } else if (a0sym == "fn*") { - return(malfunc(EVAL, a2, env, a1)) - } else { - el <- eval_ast(ast, env) - f <- el[[1]] - if (class(f) == "MalFunc") { - ast <- f$ast - env <- f$gen_env(slice(el,2)) - } else { - return(do.call(f,slice(el,2))) - } - } - - } -} - -# print -PRINT <- function(exp) { - return(.pr_str(exp, TRUE)) -} - -# repl loop -repl_env <- new.Env() -rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) - -# core.r: defined using R -for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } -Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) -Env.set(repl_env, "*ARGV*", new.list()) - -# core.mal: defined using the language itself -. <- rep("(def! *host-language* \"R\")") -. <- rep("(def! not (fn* (a) (if a false true)))") -. <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -. <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -. <- rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - -args <- commandArgs(trailingOnly = TRUE) -if (length(args) > 0) { - Env.set(repl_env, "*ARGV*", new.listl(slice(list(args),2))) - tryCatch({ - . <- rep(concat("(load-file \"", args[[1]], "\")")) - }, error=function(err) { - cat("Error: ", get_error(err),"\n", sep="") - }) - quit(save="no", status=0) -} - -. <- rep("(println (str \"Mal [\" *host-language* \"]\"))") -repeat { - line <- readline("user> ") - if (is.null(line)) { cat("\n"); break } - tryCatch({ - cat(rep(line),"\n", sep="") - }, error=function(err) { - cat("Error: ", get_error(err),"\n", sep="") - }) - # R debug/fatal with tracebacks: - #cat(rep(line),"\n", sep="") -} diff --git a/racket/Makefile b/racket/Makefile deleted file mode 100644 index 01cb12aa79..0000000000 --- a/racket/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -SOURCES_BASE = types.rkt reader.rkt printer.rkt -SOURCES_LISP = env.rkt core.rkt stepA_mal.rkt -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -all: - -.PHONY: stats - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/racket/env.rkt b/racket/env.rkt deleted file mode 100644 index 8e47b634a7..0000000000 --- a/racket/env.rkt +++ /dev/null @@ -1,47 +0,0 @@ -#lang racket - -(provide Env%) - -(require "types.rkt") - -(define Env% - (class object% - (init outer binds exprs) - (super-new) - (define _outer outer) - (define _binds (_to_list binds)) - (define _exprs (_to_list exprs)) - (define data (make-hash)) - (let ([vargs (member '& _binds)]) - (if vargs - (begin - (map (lambda (b e) (hash-set! data b e)) - (drop-right _binds 2) - (take _exprs (- (length _binds) 2))) - (hash-set! data - (last _binds) - (drop _exprs (- (length _binds) 2)))) - (map (lambda (b e) (hash-set! data b e)) - _binds - _exprs))) - - (define/public (set k v) - (hash-set! data k v) - v) - (define/public (find k) - (cond - [(hash-has-key? data k) this] - [(not (null? _outer)) (send _outer find k)] - [else null])) - (define/public (_get k) - (hash-ref data k)) - (define/public (get k) - (let ([e (find k)]) - (if (null? e) - (raise (string-append "'" - (symbol->string k) - "' not found")) - (send e _get k)))))) - - - diff --git a/racket/readline.rkt b/racket/readline.rkt deleted file mode 100644 index 7f92169f3f..0000000000 --- a/racket/readline.rkt +++ /dev/null @@ -1,32 +0,0 @@ -#lang racket - -(provide readline) - -(require (prefix-in readline: readline/readline)) - -(require "types.rkt") - -(define history-loaded #f) -(define HISTORY-FILE (format "~a/.mal-history" (find-system-path 'home-dir))) - -(define (load-history path) - (map - (lambda (line) (readline:add-history line)) - (string-split - (port->string (open-input-file path)) - #px"\n"))) - -(define (readline prompt) - (when (not history-loaded) - (set! history-loaded #t) - (load-history HISTORY-FILE)) - (let ([line (readline:readline prompt)]) - (if (eq? eof line) - nil - (begin - (readline:add-history line) - (with-output-to-file - HISTORY-FILE - (lambda () (printf "~a~n" line)) - #:exists 'append) - line)))) diff --git a/racket/step3_env.rkt b/racket/step3_env.rkt deleted file mode 100755 index fa735b8052..0000000000 --- a/racket/step3_env.rkt +++ /dev/null @@ -1,61 +0,0 @@ -#!/usr/bin/env racket -#lang racket - -(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" - "env.rkt") - -;; read -(define (READ str) - (read_str str)) - -;; eval -(define (eval-ast ast env) - (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] - [(hash? ast) (make-hash - (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - - (let ([a0 (_nth ast 0)]) - (cond - [(eq? 'def! a0) - (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] - [(eq? 'let* a0) - (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) - (_map (lambda (b_e) - (send let-env set (_first b_e) - (EVAL (_nth b_e 1) let-env))) - (_partition 2 (_to_list (_nth ast 1)))) - (EVAL (_nth ast 2) let-env))] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) - (apply f args))])))) - -;; print -(define (PRINT exp) - (pr_str exp true)) - -;; repl -(define repl-env - (new Env% - [outer null] - [binds '(+ - * /)] - [exprs (list + - * /)])) -(define (rep str) - (PRINT (EVAL (READ str) repl-env))) - -(define (repl-loop) - (let ([line (readline "user> ")]) - (when (not (eq? nil line)) - (with-handlers - ([string? (lambda (exc) (printf "Error: ~a~n" exc))] - [blank-exn? (lambda (exc) null)]) - (printf "~a~n" (rep line))) - (repl-loop)))) -(repl-loop) diff --git a/racket/step7_quote.rkt b/racket/step7_quote.rkt deleted file mode 100755 index 2b7baffb2d..0000000000 --- a/racket/step7_quote.rkt +++ /dev/null @@ -1,119 +0,0 @@ -#!/usr/bin/env racket -#lang racket - -(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" - "env.rkt" "core.rkt") - -;; read -(define (READ str) - (read_str str)) - -;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) - -(define (quasiquote ast) - (cond - [(not (is-pair ast)) - (list 'quote ast)] - - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] - - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] - - [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) - -(define (eval-ast ast env) - (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] - [(hash? ast) (make-hash - (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - - (let ([a0 (_nth ast 0)]) - (cond - [(eq? 'def! a0) - (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] - [(eq? 'let* a0) - (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) - (_map (lambda (b_e) - (send let-env set (_first b_e) - (EVAL (_nth b_e 1) let-env))) - (_partition 2 (_to_list (_nth ast 1)))) - (EVAL (_nth ast 2) let-env))] - [(eq? 'quote a0) - (_nth ast 1)] - [(eq? 'quasiquote a0) - (EVAL (quasiquote (_nth ast 1)) env)] - [(eq? 'do a0) - (eval-ast (drop (drop-right ast 1) 1) env) - (EVAL (last ast) env)] - [(eq? 'if a0) - (let ([cnd (EVAL (_nth ast 1) env)]) - (if (or (eq? cnd nil) (eq? cnd #f)) - (if (> (length ast) 3) - (EVAL (_nth ast 3) env) - nil) - (EVAL (_nth ast 2) env)))] - [(eq? 'fn* a0) - (malfunc - (lambda args (EVAL (_nth ast 2) - (new Env% [outer env] - [binds (_nth ast 1)] - [exprs args]))) - (_nth ast 2) env (_nth ast 1) #f nil)] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) - (if (malfunc? f) - (EVAL (malfunc-ast f) - (new Env% - [outer (malfunc-env f)] - [binds (malfunc-params f)] - [exprs args])) - (apply f args)))])))) - -;; print -(define (PRINT exp) - (pr_str exp true)) - -;; repl -(define repl-env - (new Env% [outer null] [binds null] [exprs null])) -(define (rep str) - (PRINT (EVAL (READ str) repl-env))) - -(for () ;; ignore return values - -;; core.rkt: defined using Racket -(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) -(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) -(send repl-env set '*ARGV* (list)) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - -) - -(define (repl-loop) - (let ([line (readline "user> ")]) - (when (not (eq? nil line)) - (with-handlers - ([string? (lambda (exc) (printf "Error: ~a~n" exc))] - [blank-exn? (lambda (exc) null)]) - (printf "~a~n" (rep line))) - (repl-loop)))) -(let ([args (current-command-line-arguments)]) - (if (> (vector-length args) 0) - (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) - (repl-loop))) diff --git a/racket/step8_macros.rkt b/racket/step8_macros.rkt deleted file mode 100755 index 7016a12b09..0000000000 --- a/racket/step8_macros.rkt +++ /dev/null @@ -1,143 +0,0 @@ -#!/usr/bin/env racket -#lang racket - -(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" - "env.rkt" "core.rkt") - -;; read -(define (READ str) - (read_str str)) - -;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) - -(define (quasiquote ast) - (cond - [(not (is-pair ast)) - (list 'quote ast)] - - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] - - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] - - [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) - -(define (macro? ast env) - (and (list? ast) - (symbol? (first ast)) - (not (equal? null (send env find (first ast)))) - (let ([fn (send env get (first ast))]) - (and (malfunc? fn) (malfunc-macro? fn))))) - -(define (macroexpand ast env) - (if (macro? ast env) - (let ([mac (malfunc-fn (send env get (first ast)))]) - (macroexpand (apply mac (rest ast)) env)) - ast)) - -(define (eval-ast ast env) - (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] - [(hash? ast) (make-hash - (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - (if (not (list? ast)) - (eval-ast ast env) - - (let ([ast (macroexpand ast env)]) - (if (not (list? ast)) - ast - (let ([a0 (_nth ast 0)]) - (cond - [(eq? 'def! a0) - (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] - [(eq? 'let* a0) - (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) - (_map (lambda (b_e) - (send let-env set (_first b_e) - (EVAL (_nth b_e 1) let-env))) - (_partition 2 (_to_list (_nth ast 1)))) - (EVAL (_nth ast 2) let-env))] - [(eq? 'quote a0) - (_nth ast 1)] - [(eq? 'quasiquote a0) - (EVAL (quasiquote (_nth ast 1)) env)] - [(eq? 'defmacro! a0) - (let* ([func (EVAL (_nth ast 2) env)] - [mac (struct-copy malfunc func [macro? #t])]) - (send env set (_nth ast 1) mac))] - [(eq? 'macroexpand a0) - (macroexpand (_nth ast 1) env)] - [(eq? 'do a0) - (eval-ast (drop (drop-right ast 1) 1) env) - (EVAL (last ast) env)] - [(eq? 'if a0) - (let ([cnd (EVAL (_nth ast 1) env)]) - (if (or (eq? cnd nil) (eq? cnd #f)) - (if (> (length ast) 3) - (EVAL (_nth ast 3) env) - nil) - (EVAL (_nth ast 2) env)))] - [(eq? 'fn* a0) - (malfunc - (lambda args (EVAL (_nth ast 2) - (new Env% [outer env] - [binds (_nth ast 1)] - [exprs args]))) - (_nth ast 2) env (_nth ast 1) #f nil)] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) - (if (malfunc? f) - (EVAL (malfunc-ast f) - (new Env% - [outer (malfunc-env f)] - [binds (malfunc-params f)] - [exprs args])) - (apply f args)))])))))) - -;; print -(define (PRINT exp) - (pr_str exp true)) - -;; repl -(define repl-env - (new Env% [outer null] [binds null] [exprs null])) -(define (rep str) - (PRINT (EVAL (READ str) repl-env))) - -(for () ;; ignore return values - -;; core.rkt: defined using Racket -(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) -(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) -(send repl-env set '*ARGV* (list)) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -) - -(define (repl-loop) - (let ([line (readline "user> ")]) - (when (not (eq? nil line)) - (with-handlers - ([string? (lambda (exc) (printf "Error: ~a~n" exc))] - [blank-exn? (lambda (exc) null)]) - (printf "~a~n" (rep line))) - (repl-loop)))) -(let ([args (current-command-line-arguments)]) - (if (> (vector-length args) 0) - (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) - (repl-loop))) diff --git a/racket/step9_try.rkt b/racket/step9_try.rkt deleted file mode 100755 index 434ec44c42..0000000000 --- a/racket/step9_try.rkt +++ /dev/null @@ -1,160 +0,0 @@ -#!/usr/bin/env racket -#lang racket - -(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" - "env.rkt" "core.rkt") - -;; read -(define (READ str) - (read_str str)) - -;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) - -(define (quasiquote ast) - (cond - [(not (is-pair ast)) - (list 'quote ast)] - - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] - - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] - - [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) - -(define (macro? ast env) - (and (list? ast) - (symbol? (first ast)) - (not (equal? null (send env find (first ast)))) - (let ([fn (send env get (first ast))]) - (and (malfunc? fn) (malfunc-macro? fn))))) - -(define (macroexpand ast env) - (if (macro? ast env) - (let ([mac (malfunc-fn (send env get (first ast)))]) - (macroexpand (apply mac (rest ast)) env)) - ast)) - -(define (eval-ast ast env) - (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] - [(hash? ast) (make-hash - (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - ;(printf "~a~n" (pr_str ast true)) - (if (not (list? ast)) - (eval-ast ast env) - - (let ([ast (macroexpand ast env)]) - (if (not (list? ast)) - ast - (let ([a0 (_nth ast 0)]) - (cond - [(eq? 'def! a0) - (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] - [(eq? 'let* a0) - (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) - (_map (lambda (b_e) - (send let-env set (_first b_e) - (EVAL (_nth b_e 1) let-env))) - (_partition 2 (_to_list (_nth ast 1)))) - (EVAL (_nth ast 2) let-env))] - [(eq? 'quote a0) - (_nth ast 1)] - [(eq? 'quasiquote a0) - (EVAL (quasiquote (_nth ast 1)) env)] - [(eq? 'defmacro! a0) - (let* ([func (EVAL (_nth ast 2) env)] - [mac (struct-copy malfunc func [macro? #t])]) - (send env set (_nth ast 1) mac))] - [(eq? 'macroexpand a0) - (macroexpand (_nth ast 1) env)] - [(eq? 'try* a0) - (if (eq? 'catch* (_nth (_nth ast 2) 0)) - (let ([efn (lambda (exc) - (EVAL (_nth (_nth ast 2) 2) - (new Env% - [outer env] - [binds (list (_nth (_nth ast 2) 1))] - [exprs (list exc)])))]) - (with-handlers - ([mal-exn? (lambda (exc) (efn (mal-exn-val exc)))] - [string? (lambda (exc) (efn exc))] - [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) - (EVAL (_nth ast 1) env))) - (EVAL (_nth ast 1)))] - [(eq? 'do a0) - (eval-ast (drop (drop-right ast 1) 1) env) - (EVAL (last ast) env)] - [(eq? 'if a0) - (let ([cnd (EVAL (_nth ast 1) env)]) - (if (or (eq? cnd nil) (eq? cnd #f)) - (if (> (length ast) 3) - (EVAL (_nth ast 3) env) - nil) - (EVAL (_nth ast 2) env)))] - [(eq? 'fn* a0) - (malfunc - (lambda args (EVAL (_nth ast 2) - (new Env% [outer env] - [binds (_nth ast 1)] - [exprs args]))) - (_nth ast 2) env (_nth ast 1) #f nil)] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) - (if (malfunc? f) - (EVAL (malfunc-ast f) - (new Env% - [outer (malfunc-env f)] - [binds (malfunc-params f)] - [exprs args])) - (apply f args)))])))))) - -;; print -(define (PRINT exp) - (pr_str exp true)) - -;; repl -(define repl-env - (new Env% [outer null] [binds null] [exprs null])) -(define (rep str) - (PRINT (EVAL (READ str) repl-env))) - -(for () ;; ignore return values - -;; core.rkt: defined using Racket -(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) -(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) -(send repl-env set '*ARGV* (list)) - -;; core.mal: defined using the language itself -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -) - -(define (repl-loop) - (let ([line (readline "user> ")]) - (when (not (eq? nil line)) - (with-handlers - ([string? (lambda (exc) (printf "Error: ~a~n" exc))] - [mal-exn? (lambda (exc) (printf "Error: ~a~n" - (pr_str (mal-exn-val exc) true)))] - [blank-exn? (lambda (exc) null)]) - (printf "~a~n" (rep line))) - (repl-loop)))) -(let ([args (current-command-line-arguments)]) - (if (> (vector-length args) 0) - (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) - (repl-loop))) diff --git a/racket/stepA_mal.rkt b/racket/stepA_mal.rkt deleted file mode 100755 index 9b816cb6c4..0000000000 --- a/racket/stepA_mal.rkt +++ /dev/null @@ -1,163 +0,0 @@ -#!/usr/bin/env racket -#lang racket - -(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" - "env.rkt" "core.rkt") - -;; read -(define (READ str) - (read_str str)) - -;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) - -(define (quasiquote ast) - (cond - [(not (is-pair ast)) - (list 'quote ast)] - - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] - - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] - - [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) - -(define (macro? ast env) - (and (list? ast) - (symbol? (first ast)) - (not (equal? null (send env find (first ast)))) - (let ([fn (send env get (first ast))]) - (and (malfunc? fn) (malfunc-macro? fn))))) - -(define (macroexpand ast env) - (if (macro? ast env) - (let ([mac (malfunc-fn (send env get (first ast)))]) - (macroexpand (apply mac (rest ast)) env)) - ast)) - -(define (eval-ast ast env) - (cond - [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] - [(hash? ast) (make-hash - (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - ;(printf "~a~n" (pr_str ast true)) - (if (not (list? ast)) - (eval-ast ast env) - - (let ([ast (macroexpand ast env)]) - (if (not (list? ast)) - ast - (let ([a0 (_nth ast 0)]) - (cond - [(eq? 'def! a0) - (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] - [(eq? 'let* a0) - (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) - (_map (lambda (b_e) - (send let-env set (_first b_e) - (EVAL (_nth b_e 1) let-env))) - (_partition 2 (_to_list (_nth ast 1)))) - (EVAL (_nth ast 2) let-env))] - [(eq? 'quote a0) - (_nth ast 1)] - [(eq? 'quasiquote a0) - (EVAL (quasiquote (_nth ast 1)) env)] - [(eq? 'defmacro! a0) - (let* ([func (EVAL (_nth ast 2) env)] - [mac (struct-copy malfunc func [macro? #t])]) - (send env set (_nth ast 1) mac))] - [(eq? 'macroexpand a0) - (macroexpand (_nth ast 1) env)] - [(eq? 'try* a0) - (if (eq? 'catch* (_nth (_nth ast 2) 0)) - (let ([efn (lambda (exc) - (EVAL (_nth (_nth ast 2) 2) - (new Env% - [outer env] - [binds (list (_nth (_nth ast 2) 1))] - [exprs (list exc)])))]) - (with-handlers - ([mal-exn? (lambda (exc) (efn (mal-exn-val exc)))] - [string? (lambda (exc) (efn exc))] - [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) - (EVAL (_nth ast 1) env))) - (EVAL (_nth ast 1)))] - [(eq? 'do a0) - (eval-ast (drop (drop-right ast 1) 1) env) - (EVAL (last ast) env)] - [(eq? 'if a0) - (let ([cnd (EVAL (_nth ast 1) env)]) - (if (or (eq? cnd nil) (eq? cnd #f)) - (if (> (length ast) 3) - (EVAL (_nth ast 3) env) - nil) - (EVAL (_nth ast 2) env)))] - [(eq? 'fn* a0) - (malfunc - (lambda args (EVAL (_nth ast 2) - (new Env% [outer env] - [binds (_nth ast 1)] - [exprs args]))) - (_nth ast 2) env (_nth ast 1) #f nil)] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) - (if (malfunc? f) - (EVAL (malfunc-ast f) - (new Env% - [outer (malfunc-env f)] - [binds (malfunc-params f)] - [exprs args])) - (apply f args)))])))))) - -;; print -(define (PRINT exp) - (pr_str exp true)) - -;; repl -(define repl-env - (new Env% [outer null] [binds null] [exprs null])) -(define (rep str) - (PRINT (EVAL (READ str) repl-env))) - -(for () ;; ignore return values - -;; core.rkt: defined using Racket -(hash-for-each core_ns (lambda (k v) (send repl-env set k v))) -(send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) -(send repl-env set '*ARGV* (list)) - -;; core.mal: defined using the language itself -(rep "(def! *host-language* \"racket\")") -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") -(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") -(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - -) - -(define (repl-loop) - (let ([line (readline "user> ")]) - (when (not (eq? nil line)) - (with-handlers - ([string? (lambda (exc) (printf "Error: ~a~n" exc))] - [mal-exn? (lambda (exc) (printf "Error: ~a~n" - (pr_str (mal-exn-val exc) true)))] - [blank-exn? (lambda (exc) null)]) - (printf "~a~n" (rep line))) - (repl-loop)))) -(let ([args (current-command-line-arguments)]) - (if (> (vector-length args) 0) - (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) - (begin - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (repl-loop)))) diff --git a/ruby/Makefile b/ruby/Makefile deleted file mode 100644 index 2241a4e271..0000000000 --- a/ruby/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -TESTS = - -SOURCES_BASE = mal_readline.rb types.rb reader.rb printer.rb -SOURCES_LISP = env.rb core.rb stepA_mal.rb -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -#all: mal.rb - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ruby $@ || exit 1; \ diff --git a/ruby/core.rb b/ruby/core.rb deleted file mode 100644 index b82bddc71c..0000000000 --- a/ruby/core.rb +++ /dev/null @@ -1,66 +0,0 @@ -require "readline" -require_relative "reader" -require_relative "printer" - -$core_ns = { - :"=" => lambda {|a,b| a == b}, - :throw => lambda {|a| raise MalException.new(a), "Mal Exception"}, - :nil? => lambda {|a| a == nil}, - :true? => lambda {|a| a == true}, - :false? => lambda {|a| a == false}, - :symbol => lambda {|a| a.to_sym}, - :symbol? => lambda {|a| a.is_a? Symbol}, - :keyword => lambda {|a| "\u029e"+a}, - :keyword? => lambda {|a| (a.is_a? String) && "\u029e" == a[0]}, - - :"pr-str" => lambda {|*a| a.map {|e| _pr_str(e, true)}.join(" ")}, - :str => lambda {|*a| a.map {|e| _pr_str(e, false)}.join("")}, - :prn => lambda {|*a| puts(a.map {|e| _pr_str(e, true)}.join(" "))}, - :println => lambda {|*a| puts(a.map {|e| _pr_str(e, false)}.join(" "))}, - :readline => lambda {|a| Readline.readline(a,true)}, - :"read-string" => lambda {|a| read_str(a)}, - :slurp => lambda {|a| File.read(a)}, - :< => lambda {|a,b| a < b}, - :<= => lambda {|a,b| a <= b}, - :> => lambda {|a,b| a > b}, - :>= => lambda {|a,b| a >= b}, - :+ => lambda {|a,b| a + b}, - :- => lambda {|a,b| a - b}, - :* => lambda {|a,b| a * b}, - :/ => lambda {|a,b| a / b}, - :"time-ms" => lambda {|| (Time.now.to_f * 1000).to_i}, - - :list => lambda {|*a| List.new a}, - :list? => lambda {|*a| a[0].is_a? List}, - :vector => lambda {|*a| Vector.new a}, - :vector? => lambda {|*a| a[0].is_a? Vector}, - :"hash-map" =>lambda {|*a| Hash[a.each_slice(2).to_a]}, - :map? => lambda {|a| a.is_a? Hash}, - :assoc => lambda {|*a| a[0].merge(Hash[a.drop(1).each_slice(2).to_a])}, - :dissoc => lambda {|*a| h = a[0].clone; a.drop(1).each{|k| h.delete k}; h}, - :get => lambda {|a,b| return nil if a == nil; a[b]}, - :contains? => lambda {|a,b| a.key? b}, - :keys => lambda {|a| List.new a.keys}, - :vals => lambda {|a| List.new a.values}, - - :sequential? => lambda {|a| sequential?(a)}, - :cons => lambda {|a,b| List.new(b.clone.insert(0,a))}, - :concat => lambda {|*a| List.new(a && a.reduce(:concat) || [])}, - :nth => lambda {|a,b| raise "nth: index out of range" if b >= a.size; a[b]}, - :first => lambda {|a| a[0]}, - :rest => lambda {|a| List.new(a.size > 0 && a.drop(1) || [])}, - :empty? => lambda {|a| a.size == 0}, - :count => lambda {|a| return 0 if a == nil; a.size}, - :conj => lambda {|*a| a[0].clone.conj(a.drop(1))}, - :apply => lambda {|*a| a[0][*a[1..-2].concat(a[-1])]}, - :map => lambda {|a,b| List.new(b.map {|e| a[e]})}, - - :"with-meta" => lambda {|a,b| x = a.clone; x.meta = b; x}, - :meta => lambda {|a| a.meta}, - :atom => lambda {|a| Atom.new(a)}, - :atom? => lambda {|a| a.is_a? Atom}, - :deref => lambda {|a| a.val}, - :reset! => lambda {|a,b| a.val = b}, - :swap! => lambda {|*a| a[0].val = a[1][*[a[0].val].concat(a.drop(2))]}, -} - diff --git a/ruby/env.rb b/ruby/env.rb deleted file mode 100644 index 97dfa13ef6..0000000000 --- a/ruby/env.rb +++ /dev/null @@ -1,37 +0,0 @@ -class Env - attr_accessor :data - def initialize(outer=nil, binds=[], exprs=[]) - @data = {} - @outer = outer - binds.each_index do |i| - if binds[i] == :"&" - data[binds[i+1]] = exprs.drop(i) - break - else - data[binds[i]] = exprs[i] - end - end - return self - end - - def find(key) - if @data.key? key - return self - elsif @outer - return @outer.find(key) - else - return nil - end - end - - def set(key, value) - @data[key] = value - return value - end - - def get(key) - env = find(key) - raise "'" + key.to_s + "' not found" if not env - env.data[key] - end -end diff --git a/ruby/mal_readline.rb b/ruby/mal_readline.rb deleted file mode 100644 index 3799783b8e..0000000000 --- a/ruby/mal_readline.rb +++ /dev/null @@ -1,18 +0,0 @@ -require "readline" - -$history_loaded = false -$histfile = "#{ENV['HOME']}/.mal-history" - -def _readline(prompt) - if !$history_loaded && File.exist?($histfile) - $history_loaded = true - File.readlines($histfile).each {|l| Readline::HISTORY.push(l.chomp)} - end - - if line = Readline.readline(prompt, true) - File.open($histfile, 'a+') {|f| f.write(line+"\n")} - return line - else - return nil - end -end diff --git a/ruby/reader.rb b/ruby/reader.rb deleted file mode 100644 index badc6ece1d..0000000000 --- a/ruby/reader.rb +++ /dev/null @@ -1,85 +0,0 @@ -require_relative "types" - -class Reader - def initialize(tokens) - @position = 0 - @tokens = tokens - end - def peek - return @tokens[@position] - end - def next - @position += 1 - return @tokens[@position-1] - end -end - - -def tokenize(str) - re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/ - return str.scan(re).map{|m| m[0]}.select{ |t| - t != "" && t[0..0] != ";" - } -end - -def parse_str(t) - return t[1..-2].gsub(/\\"/, '"').gsub(/\\n/, "\n") # unescape -end - -def read_atom(rdr) - token = rdr.next - return case token - when /^-?[0-9]+$/ then token.to_i # integer - when /^-?[0-9][0-9.]*$/ then token.to_f # float - when /^".*"$/ then parse_str(token) # string - when /^:/ then "\u029e" + token[1..-1] # keyword - when "nil" then nil - when "true" then true - when "false" then false - else token.to_sym # symbol - end -end - -def read_list(rdr, klass, start="(", last =")") - ast = klass.new - token = rdr.next() - if token != start - raise "expected '" + start + "'" - end - while (token = rdr.peek) != last - if not token - raise "expected '" + last + "', got EOF" - end - ast.push(read_form(rdr)) - end - rdr.next - return ast -end - -def read_form(rdr) - return case rdr.peek - when ";" then nil - when "'" then rdr.next; List.new [:quote, read_form(rdr)] - when "`" then rdr.next; List.new [:quasiquote, read_form(rdr)] - when "~" then rdr.next; List.new [:unquote, read_form(rdr)] - when "~@" then rdr.next; List.new [:"splice-unquote", read_form(rdr)] - when "^" then rdr.next; meta = read_form(rdr); - List.new [:"with-meta", read_form(rdr), meta] - when "@" then rdr.next; List.new [:deref, read_form(rdr)] - - when "(" then read_list(rdr, List, "(", ")") - when ")" then raise "unexpected ')'" - when "[" then read_list(rdr, Vector, "[", "]") - when "]" then raise "unexpected ']'" - when "{" then Hash[read_list(rdr, List, "{", "}").each_slice(2).to_a] - when "}" then raise "unexpected '}'" - else read_atom(rdr) - end -end - -def read_str(str) - tokens = tokenize(str) - return nil if tokens.size == 0 - return read_form(Reader.new(tokens)) -end - diff --git a/ruby/step2_eval.rb b/ruby/step2_eval.rb deleted file mode 100644 index d2b7e1ac6b..0000000000 --- a/ruby/step2_eval.rb +++ /dev/null @@ -1,65 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" - -# read -def READ(str) - return read_str(str) -end - -# eval -def eval_ast(ast, env) - return case ast - when Symbol - raise "'" + ast.to_s + "' not found" if not env.key? ast - env[ast] - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = {} -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -repl_env[:+] = lambda {|a,b| a + b} -repl_env[:-] = lambda {|a,b| a - b} -repl_env[:*] = lambda {|a,b| a * b} -repl_env[:/] = lambda {|a,b| a / b} - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step3_env.rb b/ruby/step3_env.rb deleted file mode 100644 index ec8405b211..0000000000 --- a/ruby/step3_env.rb +++ /dev/null @@ -1,77 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" - -# read -def READ(str) - return read_str(str) -end - -# eval -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - return EVAL(a2, let_env) - else - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -repl_env.set(:+, lambda {|a,b| a + b}) -repl_env.set(:-, lambda {|a,b| a - b}) -repl_env.set(:*, lambda {|a,b| a * b}) -repl_env.set(:/, lambda {|a,b| a / b}) - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step4_if_fn_do.rb b/ruby/step4_if_fn_do.rb deleted file mode 100644 index 151ecf65d6..0000000000 --- a/ruby/step4_if_fn_do.rb +++ /dev/null @@ -1,95 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" -require_relative "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - return EVAL(a2, let_env) - when :do - el = eval_ast(ast.drop(1), env) - return el.last - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - return EVAL(a3, env) - else - return EVAL(a2, env) - end - when :"fn*" - return lambda {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end - -# core.mal: defined using the language itself -RE["(def! not (fn* (a) (if a false true)))"] - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step5_tco.rb b/ruby/step5_tco.rb deleted file mode 100644 index 80be457b83..0000000000 --- a/ruby/step5_tco.rb +++ /dev/null @@ -1,105 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" -require_relative "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end - -# core.mal: defined using the language itself -RE["(def! not (fn* (a) (if a false true)))"] - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step6_file.rb b/ruby/step6_file.rb deleted file mode 100644 index 4eeca86256..0000000000 --- a/ruby/step6_file.rb +++ /dev/null @@ -1,113 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" -require_relative "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end -repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) -repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) - -# core.mal: defined using the language itself -RE["(def! not (fn* (a) (if a false true)))"] -RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] - -if ARGV.size > 0 - RE["(load-file \"" + ARGV[0] + "\")"] - exit 0 -end - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step7_quote.rb b/ruby/step7_quote.rb deleted file mode 100644 index 23d9499a7b..0000000000 --- a/ruby/step7_quote.rb +++ /dev/null @@ -1,133 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" -require_relative "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def pair?(x) - return sequential?(x) && x.size > 0 -end - -def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] - else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] - end -end - -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :quote - return a1 - when :quasiquote - ast = quasiquote(a1); # Continue loop (TCO) - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end -repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) -repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) - -# core.mal: defined using the language itself -RE["(def! not (fn* (a) (if a false true)))"] -RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] - -if ARGV.size > 0 - RE["(load-file \"" + ARGV[0] + "\")"] - exit 0 -end - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step8_macros.rb b/ruby/step8_macros.rb deleted file mode 100644 index 488db12968..0000000000 --- a/ruby/step8_macros.rb +++ /dev/null @@ -1,160 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" -require_relative "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def pair?(x) - return sequential?(x) && x.size > 0 -end - -def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] - else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] - end -end - -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end - -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end - -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - ast = macroexpand(ast, env) - return ast if not ast.is_a? List - - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :quote - return a1 - when :quasiquote - ast = quasiquote(a1); # Continue loop (TCO) - when :defmacro! - func = EVAL(a2, env) - func.is_macro = true - return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end -repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) -repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) - -# core.mal: defined using the language itself -RE["(def! not (fn* (a) (if a false true)))"] -RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] -RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] -RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"] - -if ARGV.size > 0 - RE["(load-file \"" + ARGV[0] + "\")"] - exit 0 -end - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/step9_try.rb b/ruby/step9_try.rb deleted file mode 100644 index 533853bbca..0000000000 --- a/ruby/step9_try.rb +++ /dev/null @@ -1,175 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" -require_relative "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def pair?(x) - return sequential?(x) && x.size > 0 -end - -def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] - else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] - end -end - -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end - -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end - -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - ast = macroexpand(ast, env) - return ast if not ast.is_a? List - - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :quote - return a1 - when :quasiquote - ast = quasiquote(a1); # Continue loop (TCO) - when :defmacro! - func = EVAL(a2, env) - func.is_macro = true - return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) - when :"try*" - begin - return EVAL(a1, env) - rescue Exception => exc - if exc.is_a? MalException - exc = exc.data - else - exc = exc.message - end - if a2 && a2[0] == :"catch*" - return EVAL(a2[2], Env.new(env, [a2[1]], [exc])) - else - raise esc - end - end - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end -repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) -repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) - -# core.mal: defined using the language itself -RE["(def! not (fn* (a) (if a false true)))"] -RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] -RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] -RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"] - -if ARGV.size > 0 - RE["(load-file \"" + ARGV[0] + "\")"] - exit 0 -end - -# repl loop -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/stepA_mal.rb b/ruby/stepA_mal.rb deleted file mode 100644 index 115fc8a15b..0000000000 --- a/ruby/stepA_mal.rb +++ /dev/null @@ -1,183 +0,0 @@ -require_relative "mal_readline" -require_relative "types" -require_relative "reader" -require_relative "printer" -require_relative "env" -require_relative "core" - -# read -def READ(str) - return read_str(str) -end - -# eval -def pair?(x) - return sequential?(x) && x.size > 0 -end - -def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] - else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] - end -end - -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end - -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end - -def eval_ast(ast, env) - return case ast - when Symbol - env.get(ast) - when List - List.new ast.map{|a| EVAL(a, env)} - when Vector - Vector.new ast.map{|a| EVAL(a, env)} - when Hash - new_hm = {} - ast.each{|k,v| new_hm[EVAL(k,env)] = EVAL(v, env)} - new_hm - else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) - end - - # apply list - ast = macroexpand(ast, env) - return ast if not ast.is_a? List - - a0,a1,a2,a3 = ast - case a0 - when :def! - return env.set(a1, EVAL(a2, env)) - when :"let*" - let_env = Env.new(env) - a1.each_slice(2) do |a,e| - let_env.set(a, EVAL(e, let_env)) - end - env = let_env - ast = a2 # Continue loop (TCO) - when :quote - return a1 - when :quasiquote - ast = quasiquote(a1); # Continue loop (TCO) - when :defmacro! - func = EVAL(a2, env) - func.is_macro = true - return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) - when :"rb*" - res = eval(a1) - return case res - when Array; List.new res - else; res - end - when :"try*" - begin - return EVAL(a1, env) - rescue Exception => exc - if exc.is_a? MalException - exc = exc.data - else - exc = exc.message - end - if a2 && a2[0] == :"catch*" - return EVAL(a2[2], Env.new(env, [a2[1]], [exc])) - else - raise esc - end - end - when :do - eval_ast(ast[1..-2], env) - ast = ast.last # Continue loop (TCO) - when :if - cond = EVAL(a1, env) - if not cond - return nil if a3 == nil - ast = a3 # Continue loop (TCO) - else - ast = a2 # Continue loop (TCO) - end - when :"fn*" - return Function.new(a2, env, a1) {|*args| - EVAL(a2, Env.new(env, a1, args)) - } - else - el = eval_ast(ast, env) - f = el[0] - if f.class == Function - ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) - else - return f[*el.drop(1)] - end - end - - end -end - -# print -def PRINT(exp) - return _pr_str(exp, true) -end - -# repl -repl_env = Env.new -RE = lambda {|str| EVAL(READ(str), repl_env) } -REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } - -# core.rb: defined using ruby -$core_ns.each do |k,v| repl_env.set(k,v) end -repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) -repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) - -# core.mal: defined using the language itself -RE["(def! *host-language* \"ruby\")"] -RE["(def! not (fn* (a) (if a false true)))"] -RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"] -RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] -RE["(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"] - -if ARGV.size > 0 - RE["(load-file \"" + ARGV[0] + "\")"] - exit 0 -end - -# repl loop -RE["(println (str \"Mal [\" *host-language* \"]\"))"] -while line = _readline("user> ") - begin - puts REP[line] - rescue Exception => e - puts "Error: #{e}" - puts "\t#{e.backtrace.join("\n\t")}" - end -end diff --git a/ruby/tests/stepA_mal.mal b/ruby/tests/stepA_mal.mal deleted file mode 100644 index 2d7efb8147..0000000000 --- a/ruby/tests/stepA_mal.mal +++ /dev/null @@ -1,27 +0,0 @@ -;; Testing basic ruby interop - -(rb* "7") -;=>7 - -(rb* "'7'") -;=>"7" - -(rb* "[7,8,9]") -;=>(7 8 9) - -(rb* "{\"abc\" => 789}") -;=>{"abc" 789} - -(rb* "print 'hello\n'") -; hello -;=>nil - -(rb* "$foo=8;") -(rb* "$foo") -;=>8 - -(rb* "['a','b','c'].map{|x| 'X'+x+'Y'}.join(' ')") -;=>"XaY XbY XcY" - -(rb* "[1,2,3].map{|x| 1+x}") -;=>(2 3 4) diff --git a/ruby/types.rb b/ruby/types.rb deleted file mode 100644 index d64664b58a..0000000000 --- a/ruby/types.rb +++ /dev/null @@ -1,63 +0,0 @@ -require_relative "env" - -class MalException < StandardError - attr_reader :data - def initialize(data) - @data = data - end -end - -class List < Array - attr_accessor :meta - def conj(xs) - xs.each{|x| self.unshift(x)} - return self - end -end - -class Vector < Array - attr_accessor :meta - def conj(xs) - self.push(*xs) - return self - end -end - -class Hash # re-open and add meta - attr_accessor :meta -end - -def sequential?(obj) - return obj.is_a?(List) || obj.is_a?(Vector) -end - -class Proc # re-open and add meta - attr_accessor :meta -end - -class Function < Proc - attr_accessor :ast - attr_accessor :env - attr_accessor :params - attr_accessor :is_macro - - def initialize(ast=nil, env=nil, params=nil, &block) - super() - @ast = ast - @env = env - @params = params - @is_macro = false - end - - def gen_env(args) - return Env.new(@env, @params, args) - end -end - -class Atom - attr_accessor :meta - attr_accessor :val - def initialize(val) - @val = val - end -end diff --git a/runtest-old.py b/runtest-old.py deleted file mode 100755 index aacd770497..0000000000 --- a/runtest-old.py +++ /dev/null @@ -1,134 +0,0 @@ -#!/usr/bin/env python - -import os, sys, re -import argparse - -# http://pexpect.sourceforge.net/pexpect.html -from pexpect import spawn, EOF, TIMEOUT - -# TODO: do we need to support '\n' too -sep = "\r\n" -rundir = None - -parser = argparse.ArgumentParser( - description="Run a test file against a Mal implementation") -parser.add_argument('--rundir', - help="change to the directory before running tests") -parser.add_argument('--start-timeout', default=10, type=int, - help="default timeout for initial prompt") -parser.add_argument('--test-timeout', default=20, type=int, - help="default timeout for each individual test action") -parser.add_argument('--pre-eval', default=None, type=str, - help="Mal code to evaluate prior to running the test") -parser.add_argument('--redirect', action='store_true', - help="Run implementation in bash and redirect output to /dev/null") - -parser.add_argument('test_file', type=argparse.FileType('r'), - help="a test file formatted as with mal test data") -parser.add_argument('mal_cmd', nargs="*", - help="Mal implementation command line. Use '--' to " - "specify a Mal command line with dashed options.") - -args = parser.parse_args(sys.argv[1:]) -test_data = args.test_file.read().split('\n') - -if args.rundir: os.chdir(args.rundir) - -if args.redirect: - # Redirect to try and force raw mode (no ASCII codes) - p = spawn('/bin/bash -c "' + " ".join(args.mal_cmd) + ' |tee /dev/null"') -else: - p = spawn(args.mal_cmd[0], args.mal_cmd[1:]) - - -test_idx = 0 -def read_test(data): - global test_idx - form, output, ret = None, "", None - while data: - test_idx += 1 - line = data.pop(0) - if re.match(r"^\s*$", line): # blank line - continue - elif line[0:3] == ";;;": # ignore comment - continue - elif line[0:2] == ";;": # output comment - print line[3:] - continue - elif line[0:2] == ";": # unexpected comment - print "Test data error at line %d:\n%s" % (test_idx, line) - return None, None, None, test_idx - form = line # the line is a form to send - - # Now find the output and return value - while data: - line = data[0] - if line[0:3] == ";=>": - ret = line[3:].replace('\\r', '\r').replace('\\n', '\n') - test_idx += 1 - data.pop(0) - break - elif line[0:2] == "; ": - output = output + line[2:] + sep - test_idx += 1 - data.pop(0) - else: - ret = "*" - break - if ret: break - - return form, output, ret, test_idx - -def assert_prompt(timeout): - # Wait for the initial prompt - idx = p.expect(['user> ', 'mal-user> ', EOF, TIMEOUT], - timeout=timeout) - if idx not in [0,1]: - print "Did not get 'user> ' or 'mal-user> ' prompt" - print " Got : %s" % repr(p.before) - sys.exit(1) - - -# Wait for the initial prompt -assert_prompt(args.start_timeout) - -# Send the pre-eval code if any -if args.pre_eval: - sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) - p.sendline(args.pre_eval) - assert_prompt(args.test_timeout) - -fail_cnt = 0 - -while test_data: - form, out, ret, line_num = read_test(test_data) - if form == None: - break - sys.stdout.write("TEST: %s -> [%s,%s]" % (form, repr(out), repr(ret))) - sys.stdout.flush() - expected = "%s%s%s%s" % (form, sep, out, ret) - - p.sendline(form) - try: - idx = p.expect(['\r\nuser> ', '\nuser> ', - '\r\nmal-user> ', '\nmal-user> '], - timeout=args.test_timeout) - #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) - if ret == "*" or p.before == expected: - print " -> SUCCESS" - else: - print " -> FAIL (line %d):" % line_num - print " Expected : %s" % repr(expected) - print " Got : %s" % repr(p.before) - fail_cnt += 1 - except EOF: - print "Got EOF" - sys.exit(1) - except TIMEOUT: - print "Got TIMEOUT, received: %s" % repr(p.before) - sys.exit(1) - -if fail_cnt > 0: - print "FAILURES: %d" % fail_cnt - sys.exit(2) -sys.exit(0) diff --git a/runtest.py b/runtest.py index a7f0e44ec4..e470b7c15e 100755 --- a/runtest.py +++ b/runtest.py @@ -1,19 +1,45 @@ #!/usr/bin/env python +from __future__ import print_function import os, sys, re import argparse, time +import signal, atexit -import pty, signal, atexit from subprocess import Popen, STDOUT, PIPE from select import select -# TODO: do we need to support '\n' too -sep = "\r\n" -#sep = "\n" +# Pseudo-TTY and terminal manipulation +import pty, array, fcntl, termios + +IS_PY_3 = sys.version_info[0] == 3 + +verbose = 0 +debug_file = None +log_file = None + +def debug(data): + if debug_file: + debug_file.write(data) + debug_file.flush() + +def log(data, verbosity=0, end='\n'): + if log_file: + log_file.write(data + end) + log_file.flush() + if verbose >= verbosity: + print(data, end=end) + sys.stdout.flush() + +def vlog(data, end='\n'): log(data, verbosity=1, end=end) +def vvlog(data, end='\n'): log(data, verbosity=2, end=end) + +sep = "\n" rundir = None parser = argparse.ArgumentParser( description="Run a test file against a Mal implementation") +parser.add_argument('-v', '--verbose', action='count', default=0, + help="verbose output; repeat to increase verbosity") parser.add_argument('--rundir', help="change to the directory before running tests") parser.add_argument('--start-timeout', default=10, type=int, @@ -22,35 +48,74 @@ help="default timeout for each individual test action") parser.add_argument('--pre-eval', default=None, type=str, help="Mal code to evaluate prior to running the test") -parser.add_argument('--mono', action='store_true', - help="Use workarounds Mono/.Net Console misbehaviors") +parser.add_argument('--no-pty', action='store_true', + help="Use direct pipes instead of pseudo-tty") +parser.add_argument('--log-file', type=str, + help="Write messages to the named file in addition the screen") +parser.add_argument('--debug-file', type=str, + help="Write all test interactions to the named file") +parser.add_argument('--hard', action='store_true', + help="Turn soft tests (soft, deferrable, optional) into hard failures") +parser.add_argument('--continue-after-fail', action='store_true', + help="Run all tests in a test file even if there are failures") + +# Control whether deferrable and optional tests are executed +parser.add_argument('--deferrable', dest='deferrable', action='store_true', + help="Enable deferrable tests that follow a ';>>> deferrable=True'") +parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', + help="Disable deferrable tests that follow a ';>>> deferrable=True'") +parser.set_defaults(deferrable=True) +parser.add_argument('--optional', dest='optional', action='store_true', + help="Enable optional tests that follow a ';>>> optional=True'") +parser.add_argument('--no-optional', dest='optional', action='store_false', + help="Disable optional tests that follow a ';>>> optional=True'") +parser.set_defaults(optional=True) -parser.add_argument('test_file', type=argparse.FileType('r'), +parser.add_argument('test_file', type=str, help="a test file formatted as with mal test data") parser.add_argument('mal_cmd', nargs="*", help="Mal implementation command line. Use '--' to " "specify a Mal command line with dashed options.") +parser.add_argument('--crlf', dest='crlf', action='store_true', + help="Write \\r\\n instead of \\n to the input") class Runner(): - def __init__(self, args, mono=False): + def __init__(self, args, no_pty=False, line_break="\n"): #print "args: %s" % repr(args) - self.mono = mono + self.no_pty = no_pty # Cleanup child process on exit atexit.register(self.cleanup) - if mono: + self.p = None + env = os.environ + env['TERM'] = 'dumb' + env['INPUTRC'] = '/dev/null' + env['PERL_RL'] = 'false' + if no_pty: self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, - preexec_fn=os.setsid) + preexec_fn=os.setsid, + env=env) self.stdin = self.p.stdin self.stdout = self.p.stdout else: # provide tty to get 'interactive' readline to work master, slave = pty.openpty() + + # Set terminal size large so that readline will not send + # ANSI/VT escape codes when the lines are long. + buf = array.array('h', [100, 200, 0, 0]) + fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) + self.p = Popen(args, bufsize=0, stdin=slave, stdout=slave, stderr=STDOUT, - preexec_fn=os.setsid) + preexec_fn=os.setsid, + env=env) + # Now close slave so that we will get an exception from + # read when the child exits early + # http://stackoverflow.com/questions/11165521 + os.close(slave) self.stdin = os.fdopen(master, 'r+b', 0) self.stdout = self.stdin @@ -58,136 +123,264 @@ def __init__(self, args, mono=False): self.buf = "" self.last_prompt = "" + self.line_break = line_break + def read_to_prompt(self, prompts, timeout): end_time = time.time() + timeout while time.time() < end_time: [outs,_,_] = select([self.stdout], [], [], 1) if self.stdout in outs: new_data = self.stdout.read(1) - #print "new_data: '%s'" % new_data - if self.mono: - self.buf += new_data.replace("\n", "\r\n") - else: - self.buf += new_data + new_data = new_data.decode("latin1") if IS_PY_3 else new_data + #print("new_data: %s" % repr(new_data)) + debug(new_data) + # Perform newline cleanup + self.buf += new_data.replace("\r", "") + if self.buf.endswith('\x1b[6n'): + vvlog("Handling ASCII cursor query") + self.stdin.write(b"\x1b[1;1R") + self.buf = "" + continue for prompt in prompts: regexp = re.compile(prompt) match = regexp.search(self.buf) if match: end = match.end() - buf = self.buf[0:end-len(prompt)] + buf = self.buf[0:match.start()] self.buf = self.buf[end:] self.last_prompt = prompt return buf return None def writeline(self, str): - self.stdin.write(str + "\n") - if self.mono: - # Simulate echo - self.buf += str + "\r\n" + def _to_bytes(s): + return bytes(s, "latin1") if IS_PY_3 else s + + data = _to_bytes(str.replace('\r', '\x16\r') + self.line_break) + #print("write: %s" % repr(data)) + self.stdin.write(data) def cleanup(self): #print "cleaning up" if self.p: - os.killpg(self.p.pid, signal.SIGTERM) + try: + os.killpg(self.p.pid, signal.SIGTERM) + except OSError: + pass self.p = None +class TestReader: + def __init__(self, test_file): + self.line_num = 0 + f = open(test_file, newline='') if IS_PY_3 else open(test_file) + self.data = f.read().split('\n') + self.soft = False + self.deferrable = False + self.optional = False + + def next(self): + self.msg = None + self.form = None + self.out = "" + self.ret = None + + while self.data: + self.line_num += 1 + line = self.data.pop(0) + if re.match(r"^\s*$", line): # blank line + continue + elif line[0:3] == ";;;": # ignore comment + continue + elif line[0:2] == ";;": # output comment + self.msg = line[3:] + return True + elif line[0:5] == ";>>> ": # settings/commands + settings = {} + exec(line[5:], {}, settings) + if 'soft' in settings: + self.soft = settings['soft'] + if 'deferrable' in settings and settings['deferrable']: + self.deferrable = "\nSkipping deferrable and optional tests" + return True + if 'optional' in settings and settings['optional']: + self.optional = "\nSkipping optional tests" + return True + continue + elif line[0:1] == ";": # unexpected comment + raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) + self.form = line # the line is a form to send + + # Now find the output and return value + while self.data: + line = self.data[0] + if line[0:3] == ";=>": + self.ret = line[3:] + self.line_num += 1 + self.data.pop(0) + break + elif line[0:2] == ";/": + self.out = self.out + line[2:] + sep + self.line_num += 1 + self.data.pop(0) + else: + self.ret = "" + break + if self.ret != None: break + + if self.out[-1:] == sep and not self.ret: + # If there is no return value, output should not end in + # separator + self.out = self.out[0:-1] + return self.form args = parser.parse_args(sys.argv[1:]) -test_data = args.test_file.read().split('\n') +verbose = args.verbose +# Workaround argparse issue with two '--' on command line +if sys.argv.count('--') > 0: + args.mal_cmd = sys.argv[sys.argv.index('--')+1:] if args.rundir: os.chdir(args.rundir) -r = Runner(args.mal_cmd, mono=args.mono) +if args.log_file: log_file = open(args.log_file, "a") +if args.debug_file: debug_file = open(args.debug_file, "a") +r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") +t = TestReader(args.test_file) -test_idx = 0 -def read_test(data): - global test_idx - form, output, ret = None, "", None - while data: - test_idx += 1 - line = data.pop(0) - if re.match(r"^\s*$", line): # blank line - continue - elif line[0:3] == ";;;": # ignore comment - continue - elif line[0:2] == ";;": # output comment - print line[3:] - continue - elif line[0:2] == ";": # unexpected comment - print "Test data error at line %d:\n%s" % (test_idx, line) - return None, None, None, test_idx - form = line # the line is a form to send - - # Now find the output and return value - while data: - line = data[0] - if line[0:3] == ";=>": - ret = line[3:].replace('\\r', '\r').replace('\\n', '\n') - test_idx += 1 - data.pop(0) - break - elif line[0:2] == "; ": - output = output + line[2:] + sep - test_idx += 1 - data.pop(0) - else: - ret = "*" - break - if ret: break - - return form, output, ret, test_idx -def assert_prompt(timeout): +def assert_prompt(runner, prompts, timeout): # Wait for the initial prompt - header = r.read_to_prompt(['user> ', 'mal-user> '], timeout=timeout) + header = runner.read_to_prompt(prompts, timeout=timeout) if not header == None: if header: - print "Started with:\n%s" % header + vvlog("Started with:\n%s" % header) else: - print "Did not get 'user> ' or 'mal-user> ' prompt" - print " Got : %s" % repr(r.buf) + log("Did not receive one of following prompt(s): %s" % repr(prompts)) + log(" Got : %s" % repr(r.buf)) sys.exit(1) +def elide(s, max = 79): + """Replace middle of a long string with '...' so length is <= max.""" + return s if len(s) <= max else s[:(max-3)//2] + "..." + s[-((max-2)//2):] # Wait for the initial prompt -assert_prompt(args.start_timeout) +try: + assert_prompt(r, ['[^\\s()<>]+> '], args.start_timeout) +except: + _, exc, _ = sys.exc_info() + log("\nException: %s" % repr(exc)) + log("Output before exception:\n%s" % r.buf) + sys.exit(1) # Send the pre-eval code if any if args.pre_eval: sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) - p.write(args.pre_eval) - assert_prompt(args.test_timeout) + r.writeline(args.pre_eval) + assert_prompt(r, ['[^\\s()<>]+> '], args.test_timeout) +total_test_cnt = 0 +test_cnt = 0 +pass_cnt = 0 fail_cnt = 0 +soft_fail_cnt = 0 +failures = [] +fail_type = "" -while test_data: - form, out, ret, line_num = read_test(test_data) - if form == None: +class TestTimeout(Exception): + pass + +while t.next(): + if args.deferrable == False and t.deferrable: + log(t.deferrable) break - sys.stdout.write("TEST: %s -> [%s,%s]" % (form, repr(out), repr(ret))) - sys.stdout.flush() - expected = "%s%s%s%s" % (form, sep, out, ret) - r.writeline(form) + if args.optional == False and t.optional: + log(t.optional) + break + + if t.msg != None: + # omit blank test lines unless verbose + if verbose or t.msg: + log(t.msg) + continue + + if t.form == None: continue + + total_test_cnt += 1 + if fail_type == "TIMED OUT": + continue # repl is stuck + if not args.continue_after_fail: + if fail_cnt > 0: + continue + + # The repeated form is to get around an occasional OS X issue + # where the form is repeated. + # https://github.com/kanaka/mal/issues/30 + expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), + ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] + + test_msg = "TEST (line %d): %s -> %s" % ( + t.line_num, repr(t.form), repr(expects[0])) + vlog(test_msg, end='') + + r.writeline(t.form) try: - res = r.read_to_prompt(['\r\nuser> ', '\nuser> ', - '\r\nmal-user> ', '\nmal-user> '], + test_cnt += 1 + res = r.read_to_prompt(['\r\n[^\\s()<>]+> ', '\n[^\\s()<>]+> '], timeout=args.test_timeout) #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) - if ret == "*" or res == expected: - print " -> SUCCESS" + if (t.ret == "" and t.out == ""): + vlog(" -> SUCCESS (result ignored)") + pass_cnt += 1 + elif res and (re.search(expects[0], res, re.S) or + re.search(expects[1], res, re.S)): + vlog(" -> SUCCESS") + pass_cnt += 1 else: - print " -> FAIL (line %d):" % line_num - print " Expected : %s" % repr(expected) - print " Got : %s" % repr(res) - fail_cnt += 1 + if (res == None): + if verbose == 0: log(test_msg, end='') + log(" -> TIMED OUT") + fail_cnt += 1 + fail_type = "TIMED OUT" + elif t.soft and not args.hard: + vlog(" -> SOFT FAIL:") + soft_fail_cnt += 1 + fail_type = "SOFT FAILED" + else: + vlog(" -> FAIL:") + fail_cnt += 1 + fail_type = "FAILED" + expected = " Expected : %s" % repr(expects[0]) + got = " Got : %s" % repr(res or "") + vvlog(expected) + vlog(got if verbose >= 2 else elide(got)) + failed_test = "%s %s:\n%s\n%s" % ( + fail_type, test_msg, expected, got) + failures.append(failed_test) except: - print "Got Exception" - sys.exit(1) + _, exc, _ = sys.exc_info() + log("\nException: %s" % repr(exc)) + log("Output before exception:\n%s" % r.buf) + break + +if len(failures) > 0: + log("\nFAILURES:") + for f in failures: + log(f) + +results = """ +TEST RESULTS (for %s): + %3d: soft failing tests + %3d: failing tests + %3d: passing tests + %3d: executed tests + %3d: total tests in the file (%d skipped) +""" % (args.test_file, soft_fail_cnt, fail_cnt, pass_cnt, test_cnt, + total_test_cnt, total_test_cnt - test_cnt) +log(results) + +debug("\n") # add some separate to debug log if fail_cnt > 0: - print "FAILURES: %d" % fail_cnt - sys.exit(2) + sys.exit(1) sys.exit(0) diff --git a/rust/Cargo.toml b/rust/Cargo.toml deleted file mode 100644 index daf999dbde..0000000000 --- a/rust/Cargo.toml +++ /dev/null @@ -1,39 +0,0 @@ -[package] - -name = "Mal" -version = "0.0.1" -authors = [ "Your name " ] - - -[dependencies.cadencemarseille-pcre] - -git = "https://github.com/kanaka/rust-pcre" - - -#[profile.dev] -# -#debug = true - - -[[bin]] -name = "step0_repl" -[[bin]] -name = "step1_read_print" -[[bin]] -name = "step2_eval" -[[bin]] -name = "step3_env" -[[bin]] -name = "step4_if_fn_do" -[[bin]] -name = "step5_tco" -[[bin]] -name = "step6_file" -[[bin]] -name = "step7_quote" -[[bin]] -name = "step8_macros" -[[bin]] -name = "step9_try" -[[bin]] -name = "stepA_mal" diff --git a/rust/Makefile b/rust/Makefile deleted file mode 100644 index fa1edc96dd..0000000000 --- a/rust/Makefile +++ /dev/null @@ -1,36 +0,0 @@ -##################### - -SOURCES_BASE = src/types.rs src/readline.rs \ - src/reader.rs src/printer.rs \ - src/env.rs src/core.rs -SOURCES_LISP = src/env.rs src/core.rs src/stepA_mal.rs -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -##################### - -SRCS = step1_read_print.rs step2_eval.rs step3_env.rs \ - step4_if_fn_do.rs step5_tco.rs step6_file.rs step7_quote.rs \ - step8_macros.rs step9_try.rs stepA_mal.rs -BINS = $(SRCS:%.rs=target/release/%) - -##################### - -all: mal - -mal: ${SOURCES_BASE} $(word $(words ${SOURCES_LISP}),${SOURCES_LISP}) - cargo build --release - cp $(word $(words ${BINS}),${BINS}) $@ - -#$(BINS): target/release/%: src/%.rs -# cargo build --release $* - -clean: - cargo clean - rm -f mal - -.PHONY: stats stats-lisp - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ diff --git a/rust/src/core.rs b/rust/src/core.rs deleted file mode 100644 index 2bc3c39d50..0000000000 --- a/rust/src/core.rs +++ /dev/null @@ -1,561 +0,0 @@ -#![allow(dead_code)] - -extern crate time; -use std::collections::HashMap; -use std::io::File; - -use types::{MalVal,MalRet,err_val,err_str,err_string, - Nil,Int,Strn,List,Vector,Hash_Map,Func,MalFunc,Atom, - _nil,_true,_false,_int,string, - list,vector,listm,vectorm,hash_mapm,func,funcm,malfuncd}; -use types; -use readline; -use reader; -use printer; - -// General functions -fn equal_q(a:Vec) -> MalRet { - if a.len() != 2 { - return err_str("Wrong arity to equal? call"); - } - match a[0] == a[1] { - true => Ok(_true()), - false => Ok(_false()), - } -} - -// Errors/Exceptions -fn throw(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to throw call"); - } - err_val(a[0].clone()) -} - -// String routines -fn pr_str(a:Vec) -> MalRet { - Ok(string(printer::pr_list(&a, true, "", "", " "))) -} - -fn str(a:Vec) -> MalRet { - Ok(string(printer::pr_list(&a, false, "", "", ""))) -} - -fn prn(a:Vec) -> MalRet { - println!("{}", printer::pr_list(&a, true, "", "", " ")) - Ok(_nil()) -} - -fn println(a:Vec) -> MalRet { - println!("{}", printer::pr_list(&a, false, "", "", " ")) - Ok(_nil()) -} - -fn readline(a:Vec) -> MalRet { - match *a[0] { - Strn(ref a0) => match readline::mal_readline(a0.as_slice()) { - Some(line) => Ok(string(line)), - None => err_val(_nil()), - }, - _ => err_str("read_string called with non-string"), - } -} - -fn read_string(a:Vec) -> MalRet { - match *a[0] { - Strn(ref a0) => reader::read_str(a0.to_string()), - _ => err_str("read_string called with non-string"), - } -} - -fn slurp(a:Vec) -> MalRet { - match *a[0] { - Strn(ref a0) => { - match File::open(&Path::new(a0.as_slice())).read_to_string() { - Ok(s) => Ok(string(s)), - Err(e) => err_string(e.to_string()), - } - }, - _ => err_str("slurp called with non-string"), - } -} - - -// Numeric functions -fn int_op(f: |i:int,j:int|-> int, a:Vec) -> MalRet { - match *a[0] { - Int(a0) => match *a[1] { - Int(a1) => Ok(_int(f(a0,a1))), - _ => err_str("second arg must be an int"), - }, - _ => err_str("first arg must be an int"), - } -} - -fn bool_op(f: |i:int,j:int|-> bool, a:Vec) -> MalRet { - match *a[0] { - Int(a0) => match *a[1] { - Int(a1) => { - match f(a0,a1) { - true => Ok(_true()), - false => Ok(_false()), - } - }, - _ => err_str("second arg must be an int"), - }, - _ => err_str("first arg must be an int"), - } -} - -pub fn add(a:Vec) -> MalRet { int_op(|i,j| { i+j }, a) } -pub fn sub(a:Vec) -> MalRet { int_op(|i,j| { i-j }, a) } -pub fn mul(a:Vec) -> MalRet { int_op(|i,j| { i*j }, a) } -pub fn div(a:Vec) -> MalRet { int_op(|i,j| { i/j }, a) } - -pub fn lt (a:Vec) -> MalRet { bool_op(|i,j| { i) -> MalRet { bool_op(|i,j| { i<=j }, a) } -pub fn gt (a:Vec) -> MalRet { bool_op(|i,j| { i>j }, a) } -pub fn gte(a:Vec) -> MalRet { bool_op(|i,j| { i>=j }, a) } - -#[allow(unused_variable)] -pub fn time_ms(a:Vec) -> MalRet { - //let x = time::now(); - let now = time::get_time(); - let now_ms = (now.sec * 1000).to_int().unwrap() + (now.nsec.to_int().unwrap() / 1000000); - Ok(_int(now_ms)) -} - - -// Hash Map functions -pub fn assoc(a:Vec) -> MalRet { - if a.len() < 3 { - return err_str("Wrong arity to assoc call"); - } - match *a[0] { - Hash_Map(ref hm,_) => { - types::_assoc(hm, a.slice(1,a.len()).to_vec()) - }, - Nil => { - types::hash_mapv(a.slice(1,a.len()).to_vec()) - } - _ => return err_str("assoc onto non-hash map"), - } -} - -pub fn dissoc(a:Vec) -> MalRet { - if a.len() < 2 { - return err_str("Wrong arity to dissoc call"); - } - match *a[0] { - Hash_Map(ref hm,_) => { - types::_dissoc(hm, a.slice(1,a.len()).to_vec()) - }, - Nil => { - Ok(_nil()) - } - _ => return err_str("dissoc onto non-hash map"), - } -} - -pub fn get(a:Vec) -> MalRet { - if a.len() != 2 { - return err_str("Wrong arity to get call"); - } - let a0 = a[0].clone(); - let hm: &HashMap = match *a0 { - Hash_Map(ref hm,_) => hm, - Nil => return Ok(_nil()), - _ => return err_str("get on non-hash map"), - }; - match *a[1] { - Strn(ref key) => { - match hm.find_copy(key) { - Some(v) => Ok(v), - None => Ok(_nil()), - } - }, - _ => return err_str("get with non-string key"), - } -} - -pub fn contains_q(a:Vec) -> MalRet { - if a.len() != 2 { - return err_str("Wrong arity to contains? call"); - } - let a0 = a[0].clone(); - let hm: &HashMap = match *a0 { - Hash_Map(ref hm,_) => hm, - Nil => return Ok(_false()), - _ => return err_str("contains? on non-hash map"), - }; - match *a[1] { - Strn(ref key) => { - match hm.contains_key(key) { - true => Ok(_true()), - false => Ok(_false()), - } - }, - _ => return err_str("contains? with non-string key"), - } -} - -pub fn keys(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to keys call"); - } - let a0 = a[0].clone(); - let hm: &HashMap = match *a0 { - Hash_Map(ref hm,_) => hm, - Nil => return Ok(_nil()), - _ => return err_str("contains? on non-hash map"), - }; - //if hm.len() == 0 { return Ok(_nil()); } - let mut keys = vec![]; - for k in hm.keys() { - keys.push(string(k.to_string())); - } - Ok(list(keys)) -} - -pub fn vals(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to values call"); - } - let a0 = a[0].clone(); - let hm: &HashMap = match *a0 { - Hash_Map(ref hm,_) => hm, - Nil => return Ok(_nil()), - _ => return err_str("contains? on non-hash map"), - }; - //if hm.len() == 0 { return Ok(_nil()); } - let mut vals = vec![]; - for k in hm.values() { - vals.push(k.clone()); - } - Ok(list(vals)) -} - - -// Sequence functions -pub fn cons(a:Vec) -> MalRet { - match *a[1] { - List(ref v,_) | Vector(ref v,_) => { - let mut new_v = v.clone(); - new_v.insert(0, a[0].clone()); - Ok(list(new_v)) - }, - _ => err_str("Second arg to cons not a sequence"), - } -} - -pub fn concat(a:Vec) -> MalRet { - let mut new_v:Vec = vec![]; - for lst in a.iter() { - match **lst { - List(ref l,_) | Vector(ref l,_) => { - new_v.push_all(l.as_slice()); - }, - _ => return err_str("concat called with non-sequence"), - } - } - Ok(list(new_v)) -} - -pub fn nth(a:Vec) -> MalRet { - if a.len() != 2 { - return err_str("Wrong arity to nth call"); - } - let a0 = a[0].clone(); - let a1 = a[1].clone(); - let seq = match *a0 { - List(ref v,_) | Vector(ref v,_) => v, - _ => return err_str("nth called with non-sequence"), - }; - let idx = match *a1 { - Int(i) => { - match i.to_uint() { - Some(ui) => ui, - None => return Ok(_nil()), - } - }, - _ => return err_str("nth called with non-integer index"), - }; - if idx >= seq.len() { - return err_str("nth: index out of range") - } else { - Ok(seq[idx].clone()) - } -} - -pub fn first(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to first call"); - } - let a0 = a[0].clone(); - let seq = match *a0 { - List(ref v,_) | Vector(ref v,_) => v, - _ => return err_str("first called with non-sequence"), - }; - if seq.len() == 0 { - Ok(_nil()) - } else { - Ok(seq[0].clone()) - } -} - -pub fn rest(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to rest call"); - } - let a0 = a[0].clone(); - let seq = match *a0 { - List(ref v,_) | Vector(ref v,_) => v, - _ => return err_str("rest called with non-sequence"), - }; - if seq.len() == 0 { - Ok(list(vec![])) - } else { - Ok(list(seq.slice(1,seq.len()).to_vec())) - } -} - -pub fn empty_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to empty? call"); - } - match *a[0].clone() { - List(ref v,_) | Vector(ref v,_) => { - match v.len() { - 0 => Ok(_true()), - _ => Ok(_false()), - } - }, - _ => err_str("empty? called on non-sequence"), - } -} - -pub fn count(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to count call"); - } - match *a[0].clone() { - List(ref v,_) | Vector(ref v,_) => { - Ok(_int(v.len().to_int().unwrap())) - }, - Nil => Ok(_int(0)), - _ => err_str("count called on non-sequence"), - } -} - -pub fn apply(a:Vec) -> MalRet { - if a.len() < 2 { - return err_str("apply call needs 2 or more arguments"); - } - let ref f = a[0]; - let mut args = a.slice(1,a.len()-1).to_vec(); - match *a[a.len()-1] { - List(ref v,_) | Vector(ref v,_) => { - args.push_all(v.as_slice()); - f.apply(args) - }, - _ => err_str("apply call with non-sequence"), - } -} - -pub fn map(a:Vec) -> MalRet { - if a.len() != 2 { - return err_str("Wrong arity to map call"); - } - let mut results:Vec = vec![]; - let ref f = a[0].clone(); - let seq = a[1].clone(); - match *seq { - List(ref v,_) | Vector(ref v,_) => { - for mv in v.iter() { - match f.apply(vec![mv.clone()]) { - Ok(res) => results.push(res), - Err(e) => return Err(e), - } - } - }, - _ => return err_str("map call with non-sequence"), - } - Ok(list(results)) -} - -pub fn conj(a:Vec) -> MalRet { - if a.len() < 2 { - return err_str("Wrong arity to conj call"); - } - let mut new_v:Vec = vec![]; - match *a[0].clone() { - List(ref l,_) => { - new_v.push_all(l.as_slice()); - for mv in a.iter().skip(1) { - new_v.insert(0,mv.clone()); - } - Ok(list(new_v)) - }, - Vector(ref l,_) => { - new_v.push_all(l.as_slice()); - for mv in a.iter().skip(1) { - new_v.push(mv.clone()); - } - Ok(vector(new_v)) - }, - _ => return err_str("conj called with non-sequence"), - } -} - - -// Metadata functions -fn with_meta(a:Vec) -> MalRet { - if a.len() != 2 { - return err_str("Wrong arity to with-meta call"); - } - let mv = a[0].clone(); - let meta = a[1].clone(); - match *mv { - List(ref v,_) => Ok(listm(v.clone(),meta)), - Vector(ref v,_) => Ok(vectorm(v.clone(),meta)), - Hash_Map(ref hm,_) => Ok(hash_mapm(hm.clone(),meta)), - MalFunc(ref mfd,_) => Ok(malfuncd(mfd.clone(),meta)), - Func(f,_) => Ok(funcm(f,meta)), - _ => err_str("type does not support metadata"), - } -} - -fn meta(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to meta call"); - } - match *a[0].clone() { - List(_,ref meta) | - Vector(_,ref meta) | - Hash_Map(_,ref meta) | - MalFunc(_,ref meta) | - Func(_,ref meta) => Ok(meta.clone()), - _ => err_str("type does not support metadata"), - } -} - -// Atom functions -fn deref(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to deref call"); - } - match *a[0].clone() { - Atom(ref val) => { - let val_cell = val.borrow(); - Ok(val_cell.clone()) - }, - _ => err_str("deref called on non-atom"), - } -} - -fn reset_bang(a:Vec) -> MalRet { - if a.len() != 2 { - return err_str("Wrong arity to map call"); - } - let a1 = a[1].clone(); - match *a[0].clone() { - Atom(ref val) => { - let mut val_cell = val.borrow_mut(); - let atm_mv = val_cell.deref_mut(); - *atm_mv = a1.clone(); - Ok(a1) - }, - _ => err_str("reset! called on non-atom"), - } -} - -fn swap_bang(a:Vec) -> MalRet { - if a.len() < 2 { - return err_str("Wrong arity to swap_q call"); - } - let f = a[1].clone(); - match *a[0].clone() { - Atom(ref val) => { - let mut val_cell = val.borrow_mut(); - let atm_mv = val_cell.deref_mut(); - let mut args = a.slice(2,a.len()).to_vec(); - args.insert(0, atm_mv.clone()); - match f.apply(args) { - Ok(new_mv) => { - *atm_mv = new_mv.clone(); - Ok(new_mv) - } - Err(e) => Err(e), - } - }, - _ => err_str("swap! called on non-atom"), - } -} - - -pub fn ns() -> HashMap { - let mut ns: HashMap = HashMap::new();; - - ns.insert("=".to_string(), func(equal_q)); - ns.insert("throw".to_string(), func(throw)); - ns.insert("nil?".to_string(), func(types::nil_q)); - ns.insert("true?".to_string(), func(types::true_q)); - ns.insert("false?".to_string(), func(types::false_q)); - ns.insert("symbol".to_string(), func(types::_symbol)); - ns.insert("symbol?".to_string(), func(types::symbol_q)); - ns.insert("keyword".to_string(), func(types::_keyword)); - ns.insert("keyword?".to_string(), func(types::keyword_q)); - - ns.insert("pr-str".to_string(), func(pr_str)); - ns.insert("str".to_string(), func(str)); - ns.insert("prn".to_string(), func(prn)); - ns.insert("println".to_string(), func(println)); - ns.insert("readline".to_string(), func(readline)); - ns.insert("read-string".to_string(), func(read_string)); - ns.insert("slurp".to_string(), func(slurp)); - - ns.insert("<".to_string(), func(lt)); - ns.insert("<=".to_string(), func(lte)); - ns.insert(">".to_string(), func(gt)); - ns.insert(">=".to_string(), func(gte)); - ns.insert("+".to_string(), func(add)); - ns.insert("-".to_string(), func(sub)); - ns.insert("*".to_string(), func(mul)); - ns.insert("/".to_string(), func(div)); - ns.insert("time-ms".to_string(), func(time_ms)); - - ns.insert("list".to_string(), func(types::listv)); - ns.insert("list?".to_string(), func(types::list_q)); - ns.insert("vector".to_string(), func(types::vectorv)); - ns.insert("vector?".to_string(), func(types::vector_q)); - ns.insert("hash-map".to_string(), func(types::hash_mapv)); - ns.insert("map?".to_string(), func(types::hash_map_q)); - ns.insert("assoc".to_string(), func(assoc)); - ns.insert("dissoc".to_string(), func(dissoc)); - ns.insert("get".to_string(), func(get)); - ns.insert("contains?".to_string(), func(contains_q)); - ns.insert("keys".to_string(), func(keys)); - ns.insert("vals".to_string(), func(vals)); - - ns.insert("sequential?".to_string(), func(types::sequential_q)); - ns.insert("cons".to_string(), func(cons)); - ns.insert("concat".to_string(), func(concat)); - ns.insert("empty?".to_string(), func(empty_q)); - ns.insert("nth".to_string(), func(nth)); - ns.insert("first".to_string(), func(first)); - ns.insert("rest".to_string(), func(rest)); - ns.insert("count".to_string(), func(count)); - ns.insert("apply".to_string(), func(apply)); - ns.insert("map".to_string(), func(map)); - ns.insert("conj".to_string(), func(conj)); - - ns.insert("with-meta".to_string(), func(with_meta)); - ns.insert("meta".to_string(), func(meta)); - ns.insert("atom".to_string(), func(types::atom)); - ns.insert("atom?".to_string(), func(types::atom_q)); - ns.insert("deref".to_string(), func(deref)); - ns.insert("reset!".to_string(), func(reset_bang)); - ns.insert("swap!".to_string(), func(swap_bang)); - - return ns; -} diff --git a/rust/src/env.rs b/rust/src/env.rs deleted file mode 100644 index e9af154ed6..0000000000 --- a/rust/src/env.rs +++ /dev/null @@ -1,118 +0,0 @@ -#![allow(dead_code)] - -use std::rc::Rc; -use std::cell::RefCell; -use std::collections::HashMap; -use std::fmt; - -use types::{MalVal,MalRet,Sym,List,Vector,_nil,list,err_string}; - -struct EnvType { - data: HashMap, - outer: Option, -} - -pub type Env = Rc>; - -pub fn env_new(outer: Option) -> Env { - Rc::new(RefCell::new(EnvType{data: HashMap::new(), outer: outer})) -} - -pub fn env_bind(env: &Env, - mbinds: MalVal, - mexprs: MalVal) -> Result { - let mut variadic = false; - match *mbinds { - List(ref binds,_) | Vector(ref binds,_) => { - match *mexprs { - List(ref exprs,_) | Vector(ref exprs,_) => { - let mut it = binds.iter().enumerate(); - for (i, b) in it { - match **b { - Sym(ref strn) => { - if *strn == "&".to_string() { - variadic = true; - break; - } else { - env_set(env, b.clone(), exprs[i].clone()); - } - } - _ => return Err("non-symbol bind".to_string()), - } - } - if variadic { - let (i, sym) = it.next().unwrap(); - match **sym { - Sym(_) => { - let rest = exprs.slice(i-1,exprs.len()).to_vec(); - env_set(env, sym.clone(), list(rest)); - } - _ => return Err("& bind to non-symbol".to_string()), - } - } - Ok(env.clone()) - }, - _ => Err("exprs must be a list".to_string()), - } - }, - _ => Err("binds must be a list".to_string()), - } -} - -pub fn env_find(env: Env, key: MalVal) -> Option { - match *key { - Sym(ref k) => { - if env.borrow().data.contains_key(k) { - Some(env) - } else { - match env.borrow().outer { - Some(ref e) => env_find(e.clone(), key.clone()), - None => None, - } - } - }, - _ => None - } -} - -pub fn env_root(env: &Env) -> Env { - match env.borrow().outer { - Some(ref ei) => env_root(ei), - None => env.clone(), - } -} - -pub fn env_set(env: &Env, key: MalVal, val: MalVal) { - match *key { - Sym(ref k) => { - env.borrow_mut().data.insert(k.to_string(), val.clone()); - }, - _ => {}, - } -} - -pub fn env_get(env: Env, key: MalVal) -> MalRet { - match *key { - Sym(ref k) => { - match env_find(env, key.clone()) { - Some(e) => { - match e.borrow().data.find_copy(k) { - Some(v) => Ok(v), - None => Ok(_nil()), - } - }, - None => err_string("'".to_string() + k.to_string() + "' not found".to_string()), - } - } - _ => err_string("env_get called with non-symbol key".to_string()), - } -} - -impl fmt::Show for EnvType { - fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { - match self.outer { - Some(ref o) => write!(f, "[{}/outer:{}]", self.data, o.borrow()), - _ => write!(f, "{}", self.data) - } - } -} diff --git a/rust/src/printer.rs b/rust/src/printer.rs deleted file mode 100644 index f46b66cd76..0000000000 --- a/rust/src/printer.rs +++ /dev/null @@ -1,45 +0,0 @@ -use types::MalVal; - -pub fn escape_str(s: &str) -> String { - let mut escaped = String::new(); - escaped.push('"'); - for c in s.as_slice().chars() { - let _ = match c { - '"' => escaped.push_str("\\\""), - '\\' => escaped.push_str("\\\\"), - '\x08' => escaped.push_str("\\b"), - '\x0c' => escaped.push_str("\\f"), - '\n' => escaped.push_str("\\n"), - '\r' => escaped.push_str("\\r"), - '\t' => escaped.push_str("\\t"), - _ => escaped.push(c), - }; - }; - - escaped.push('"'); - - escaped -} - -pub fn unescape_str(s: &str) -> String { - let re1 = regex!(r#"\\""#); - let re2 = regex!(r#"\n"#); - re2.replace_all(re1.replace_all(s.as_slice(), "\"").as_slice(), "\n") -} - -pub fn pr_list(lst: &Vec, pr: bool, - start: &str , end: &str, join: &str) -> String { - let mut first = true; - let mut res = String::new(); - res.push_str(start); - for mv in lst.iter() { - if first { - first = false; - } else { - res.push_str(join); - } - res.push_str(mv.pr_str(pr).as_slice()); - } - res.push_str(end); - res -} diff --git a/rust/src/reader.rs b/rust/src/reader.rs deleted file mode 100644 index d7b2b4c7b0..0000000000 --- a/rust/src/reader.rs +++ /dev/null @@ -1,213 +0,0 @@ -//#![feature(phase)] -//#[phase(plugin)] -//extern crate regex_macros; -//extern crate regex; - -extern crate pcre; - -use types::{MalVal,MalRet,ErrString,ErrMalVal, - _nil,_true,_false,_int,symbol,string,list,vector,hash_mapv, - err_str,err_string,err_val}; -use self::pcre::Pcre; -use super::printer::unescape_str; - -#[deriving(Show, Clone)] -struct Reader { - tokens : Vec, - position : uint, -} - -impl Reader { - fn next(&mut self) -> Option { - if self.position < self.tokens.len() { - self.position += 1; - Some(self.tokens[self.position-1].to_string()) - } else { - None - } - } - fn peek(&self) -> Option { - if self.position < self.tokens.len() { - Some(self.tokens[self.position].to_string()) - } else { - None - } - } -} - -fn tokenize(str :String) -> Vec { - let mut results = vec![]; - - let re = match Pcre::compile(r###"[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)"###) { - Err(_) => { fail!("failed to compile regex") }, - Ok(re) => re - }; - - let mut it = re.matches(str.as_slice()); - loop { - let opt_m = it.next(); - if opt_m.is_none() { break; } - let m = opt_m.unwrap(); - if m.group(1) == "" { break; } - if m.group(1).starts_with(";") { continue; } - - results.push((*m.group(1)).to_string()); - } - results -} - -fn read_atom(rdr : &mut Reader) -> MalRet { - let otoken = rdr.next(); - //println!("read_atom: {}", otoken); - if otoken.is_none() { return err_str("read_atom underflow"); } - let stoken = otoken.unwrap(); - let token = stoken.as_slice(); - if regex!(r"^-?[0-9]+$").is_match(token) { - let num : Option = from_str(token); - Ok(_int(num.unwrap())) - } else if regex!(r#"^".*"$"#).is_match(token) { - let new_str = token.slice(1,token.len()-1); - Ok(string(unescape_str(new_str))) - } else if regex!(r#"^:"#).is_match(token) { - Ok(string("\u029e".to_string() + token.slice(1,token.len()))) - } else if token == "nil" { - Ok(_nil()) - } else if token == "true" { - Ok(_true()) - } else if token == "false" { - Ok(_false()) - } else { - Ok(symbol(token)) - } -} - -fn read_seq(rdr : &mut Reader, start: &str, end: &str) -> Result,String> { - let otoken = rdr.next(); - if otoken.is_none() { - return Err("read_atom underflow".to_string()); - } - let stoken = otoken.unwrap(); - let token = stoken.as_slice(); - if token != start { - return Err("expected '".to_string() + start.to_string() + "'".to_string()); - } - - let mut ast_vec : Vec = vec![]; - loop { - let otoken = rdr.peek(); - if otoken.is_none() { - return Err("expected '".to_string() + end.to_string() + "', got EOF".to_string()); - } - let stoken = otoken.unwrap(); - let token = stoken.as_slice(); - if token == end { break; } - - match read_form(rdr) { - Ok(mv) => ast_vec.push(mv), - Err(ErrString(es)) => return Err(es), - Err(ErrMalVal(_)) => return Err("read_seq exception".to_string()), - } - } - rdr.next(); - - Ok(ast_vec) -} - -fn read_list(rdr : &mut Reader) -> MalRet { - match read_seq(rdr, "(", ")") { - Ok(seq) => Ok(list(seq)), - Err(es) => err_string(es), - } -} - -fn read_vector(rdr : &mut Reader) -> MalRet { - match read_seq(rdr, "[", "]") { - Ok(seq) => Ok(vector(seq)), - Err(es) => err_string(es), - } -} - -fn read_hash_map(rdr : &mut Reader) -> MalRet { - match read_seq(rdr, "{", "}") { - Ok(seq) => hash_mapv(seq), - Err(es) => err_string(es), - } -} - -fn read_form(rdr : &mut Reader) -> MalRet { - let otoken = rdr.peek(); - //println!("read_form: {}", otoken); - let stoken = otoken.unwrap(); - let token = stoken.as_slice(); - match token { - "'" => { - let _ = rdr.next(); - match read_form(rdr) { - Ok(f) => Ok(list(vec![symbol("quote"), f])), - Err(e) => Err(e), - } - }, - "`" => { - let _ = rdr.next(); - match read_form(rdr) { - Ok(f) => Ok(list(vec![symbol("quasiquote"), f])), - Err(e) => Err(e), - } - }, - "~" => { - let _ = rdr.next(); - match read_form(rdr) { - Ok(f) => Ok(list(vec![symbol("unquote"), f])), - Err(e) => Err(e), - } - }, - "~@" => { - let _ = rdr.next(); - match read_form(rdr) { - Ok(f) => Ok(list(vec![symbol("splice-unquote"), f])), - Err(e) => Err(e), - } - }, - "^" => { - let _ = rdr.next(); - match read_form(rdr) { - Ok(meta) => { - match read_form(rdr) { - Ok(f) => Ok(list(vec![symbol("with-meta"), f, meta])), - Err(e) => Err(e), - } - }, - Err(e) => Err(e), - } - }, - "@" => { - let _ = rdr.next(); - match read_form(rdr) { - Ok(f) => Ok(list(vec![symbol("deref"), f])), - Err(e) => Err(e), - } - }, - - ")" => err_str("unexected ')'"), - "(" => read_list(rdr), - - "]" => err_str("unexected ']'"), - "[" => read_vector(rdr), - - "}" => err_str("unexected '}'"), - "{" => read_hash_map(rdr), - - _ => read_atom(rdr) - } -} - -pub fn read_str(str :String) -> MalRet { - let tokens = tokenize(str); - if tokens.len() == 0 { - // any malval as the error slot means empty line - return err_val(_nil()) - } - //println!("tokens: {}", tokens); - let rdr = &mut Reader{tokens: tokens, position: 0}; - read_form(rdr) -} diff --git a/rust/src/readline.rs b/rust/src/readline.rs deleted file mode 100644 index 17d1ed9ead..0000000000 --- a/rust/src/readline.rs +++ /dev/null @@ -1,76 +0,0 @@ -// Based on: https://github.com/shaleh/rust-readline (MIT) -extern crate libc; - -use std::c_str; - -use std::io::{File, Append, Write}; -use std::io::BufferedReader; - -mod ext_readline { - extern crate libc; - use self::libc::c_char; - #[link(name = "readline")] - extern { - pub fn add_history(line: *const c_char); - pub fn readline(p: *const c_char) -> *const c_char; - } -} - -pub fn add_history(line: &str) { - unsafe { - ext_readline::add_history(line.to_c_str().as_ptr()); - } -} - -pub fn readline(prompt: &str) -> Option { - let cprmt = prompt.to_c_str(); - unsafe { - let ret = ext_readline::readline(cprmt.as_ptr()); - if ret.is_null() { // user pressed Ctrl-D - None - } - else { - c_str::CString::new(ret, true).as_str().map(|ret| ret.to_string()) - } - } -} - -// -------------------------------------------- - -static mut history_loaded : bool = false; -static HISTORY_FILE : &'static str = "/home/joelm/.mal-history"; - -fn load_history() { - unsafe { - if history_loaded { return; } - history_loaded = true; - } - - let path = Path::new(HISTORY_FILE); - let mut file = BufferedReader::new(File::open(&path)); - for line in file.lines() { - let rt: &[_] = &['\r', '\n']; - let line2 = line.unwrap(); - let line3 = line2.as_slice().trim_right_chars(rt); - add_history(line3); - } -} - -fn append_to_history(line: &str) { - let path = Path::new("/home/joelm/.mal-history"); - let mut file = File::open_mode(&path, Append, Write); - let _ = file.write_line(line); -} - -pub fn mal_readline (prompt: &str) -> Option { - load_history(); - let line = readline(prompt); - match line { - None => None, - _ => { - add_history(line.clone().unwrap().as_slice()); - append_to_history(line.clone().unwrap().as_slice()); - line - } - } -} diff --git a/rust/src/step0_repl.rs b/rust/src/step0_repl.rs deleted file mode 100644 index ac9cf24d0d..0000000000 --- a/rust/src/step0_repl.rs +++ /dev/null @@ -1,25 +0,0 @@ -use readline::mal_readline; -mod readline; - -// read -fn read(str: String) -> String { - str -} - -// eval -fn eval(ast: String) -> String { - ast -} - -// print -fn print(exp: String) -> String { - exp -} - -fn main() { - loop { - let line = mal_readline("user> "); - match line { None => break, _ => () } - println!("{}", print(eval(read(line.unwrap())))); - } -} diff --git a/rust/src/step1_read_print.rs b/rust/src/step1_read_print.rs deleted file mode 100644 index 3ce11e6e7e..0000000000 --- a/rust/src/step1_read_print.rs +++ /dev/null @@ -1,52 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal}; -mod readline; -mod types; -mod env; -mod reader; -mod printer; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval(ast: MalVal) -> MalRet { - Ok(ast) -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: String) -> Result { - match read(str) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step2_eval.rs b/rust/src/step2_eval.rs deleted file mode 100644 index 2cf7897c8d..0000000000 --- a/rust/src/step2_eval.rs +++ /dev/null @@ -1,129 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Int,Sym,List,Vector,Hash_Map, - _nil,_int,list,vector,hash_map,func}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; // because types uses env - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: &HashMap) -> MalRet { - match *ast { - Sym(ref sym) => { - match env.find_copy(sym) { - Some(mv) => Ok(mv), - None => Ok(_nil()), - } - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - match eval(mv.clone(), env) { - Ok(mv) => ast_vec.push(mv), - Err(e) => return Err(e), - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast.clone()) - } - } -} - -fn eval(ast: MalVal, env: &HashMap) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match eval_ast(ast, env) { - Err(e) => Err(e), - Ok(el) => { - match *el { - List(ref args,_) => { - let ref f = args.clone()[0]; - f.apply(args.slice(1,args.len()).to_vec()) - } - _ => err_str("Invalid apply"), - } - } - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: &HashMap) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn int_op(f: |i:int,j:int|-> int, a:Vec) -> MalRet { - match *a[0] { - Int(a0) => match *a[1] { - Int(a1) => Ok(_int(f(a0,a1))), - _ => err_str("second arg must be an int"), - }, - _ => err_str("first arg must be an int"), - } -} -fn add(a:Vec) -> MalRet { int_op(|i,j| { i+j }, a) } -fn sub(a:Vec) -> MalRet { int_op(|i,j| { i-j }, a) } -fn mul(a:Vec) -> MalRet { int_op(|i,j| { i*j }, a) } -fn div(a:Vec) -> MalRet { int_op(|i,j| { i/j }, a) } - -fn main() { - let mut repl_env : HashMap = HashMap::new(); - repl_env.insert("+".to_string(), func(add)); - repl_env.insert("-".to_string(), func(sub)); - repl_env.insert("*".to_string(), func(mul)); - repl_env.insert("/".to_string(), func(div)); - - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), &repl_env) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step3_env.rs b/rust/src/step3_env.rs deleted file mode 100644 index b2d49cd199..0000000000 --- a/rust/src/step3_env.rs +++ /dev/null @@ -1,204 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Int,Sym,List,Vector,Hash_Map, - symbol,_int,list,vector,hash_map,func}; -use env::{Env,env_new,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(ast: MalVal, env: Env) -> MalRet { - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let ast2 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - return eval(a2, let_env.clone()); - }, - _ => { // function call - return match eval_ast(ast, env) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - let ref f = args.clone()[0]; - f.apply(args.slice(1,args.len()).to_vec()) - } - }; - }, - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn int_op(f: |i:int,j:int|-> int, a:Vec) -> MalRet { - match *a[0] { - Int(a0) => match *a[1] { - Int(a1) => Ok(_int(f(a0,a1))), - _ => err_str("second arg must be an int"), - }, - _ => err_str("first arg must be an int"), - } -} -fn add(a:Vec) -> MalRet { int_op(|i,j| { i+j }, a) } -fn sub(a:Vec) -> MalRet { int_op(|i,j| { i-j }, a) } -fn mul(a:Vec) -> MalRet { int_op(|i,j| { i*j }, a) } -fn div(a:Vec) -> MalRet { int_op(|i,j| { i/j }, a) } - -fn main() { - let repl_env = env_new(None); - env_set(&repl_env, symbol("+"), func(add)); - env_set(&repl_env, symbol("-"), func(sub)); - env_set(&repl_env, symbol("*"), func(mul)); - env_set(&repl_env, symbol("/"), func(div)); - - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step4_if_fn_do.rs b/rust/src/step4_if_fn_do.rs deleted file mode 100644 index 92abf92733..0000000000 --- a/rust/src/step4_if_fn_do.rs +++ /dev/null @@ -1,235 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Nil,False,Sym,List,Vector,Hash_Map, - symbol,_nil,list,vector,hash_map,malfunc}; -use env::{Env,env_new,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; -mod core; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(ast: MalVal, env: Env) -> MalRet { - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let ast2 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - return eval(a2, let_env.clone()); - }, - "do" => { - let el = list(args.slice(1,args.len()).to_vec()); - return match eval_ast(el, env.clone()) { - Err(e) => return Err(e), - Ok(el) => { - match *el { - List(ref lst,_) => { - let ref last = lst[lst.len()-1]; - return Ok(last.clone()); - } - _ => return err_str("invalid do call"), - } - }, - }; - }, - "if" => { - let a1 = (*args)[1].clone(); - let cond = eval(a1, env.clone()); - match cond { - Err(e) => return Err(e), - Ok(c) => match *c { - False | Nil => { - if args.len() >= 4 { - let a3 = (*args)[3].clone(); - return eval(a3, env.clone()); - } else { - return Ok(_nil()); - } - }, - _ => { - let a2 = (*args)[2].clone(); - return eval(a2, env.clone()); - }, - } - } - }, - "fn*" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - return Ok(malfunc(eval, a2, env.clone(), a1, _nil())); - }, - _ => { // function call - return match eval_ast(ast, env.clone()) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - let ref f = args.clone()[0]; - f.apply(args.slice(1,args.len()).to_vec()) - } - }; - }, - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - // core.rs: defined using rust - let repl_env = env_new(None); - for (k, v) in core::ns().into_iter() { - env_set(&repl_env, symbol(k.as_slice()), v); - } - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step5_tco.rs b/rust/src/step5_tco.rs deleted file mode 100644 index 9223cbf750..0000000000 --- a/rust/src/step5_tco.rs +++ /dev/null @@ -1,257 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Nil,False,Sym,List,Vector,Hash_Map,Func,MalFunc, - symbol,_nil,list,vector,hash_map,malfunc}; -use env::{Env,env_new,env_bind,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; -mod core; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let ast2 = ast.clone(); - let ast3 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast3); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - ast = a2; - env = let_env.clone(); - continue 'tco; - }, - "do" => { - let el = list(args.slice(1,args.len()-1).to_vec()); - match eval_ast(el, env.clone()) { - Err(e) => return Err(e), - Ok(_) => { - let ref last = args[args.len()-1]; - ast = last.clone(); - continue 'tco; - }, - } - }, - "if" => { - let a1 = (*args)[1].clone(); - let cond = eval(a1, env.clone()); - match cond { - Err(e) => return Err(e), - Ok(c) => match *c { - False | Nil => { - if args.len() >= 4 { - let a3 = (*args)[3].clone(); - ast = a3; - env = env.clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - let a2 = (*args)[2].clone(); - ast = a2; - env = env.clone(); - continue 'tco; - }, - } - } - }, - "fn*" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - return Ok(malfunc(eval, a2, env.clone(), a1, _nil())); - }, - _ => { // function call - return match eval_ast(ast3, env.clone()) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - match *args.clone()[0] { - Func(f,_) => f(args.slice(1,args.len()).to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args.slice(1,args.len()).to_vec()); - let new_env = env_new(Some(mfc.env.clone())); - match env_bind(&new_env, mfc.params, alst) { - Ok(_) => { - ast = mfc.exp; - env = new_env; - continue 'tco; - }, - Err(e) => err_str(e.as_slice()), - } - }, - _ => err_str("attempt to call non-function"), - } - } - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - // core.rs: defined using rust - let repl_env = env_new(None); - for (k, v) in core::ns().into_iter() { - env_set(&repl_env, symbol(k.as_slice()), v); - } - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step6_file.rs b/rust/src/step6_file.rs deleted file mode 100644 index 1e871166b9..0000000000 --- a/rust/src/step6_file.rs +++ /dev/null @@ -1,293 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; -use std::os; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Nil,False,Sym,List,Vector,Hash_Map,Func,MalFunc, - symbol,_nil,string,list,vector,hash_map,malfunc}; -use env::{Env,env_new,env_bind,env_root,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; -mod core; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let ast2 = ast.clone(); - let ast3 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast3); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - ast = a2; - env = let_env.clone(); - continue 'tco; - }, - "do" => { - let el = list(args.slice(1,args.len()-1).to_vec()); - match eval_ast(el, env.clone()) { - Err(e) => return Err(e), - Ok(_) => { - let ref last = args[args.len()-1]; - ast = last.clone(); - continue 'tco; - }, - } - }, - "if" => { - let a1 = (*args)[1].clone(); - let cond = eval(a1, env.clone()); - match cond { - Err(e) => return Err(e), - Ok(c) => match *c { - False | Nil => { - if args.len() >= 4 { - let a3 = (*args)[3].clone(); - ast = a3; - env = env.clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - let a2 = (*args)[2].clone(); - ast = a2; - env = env.clone(); - continue 'tco; - }, - } - } - }, - "fn*" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - return Ok(malfunc(eval, a2, env.clone(), a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - match eval(a1, env.clone()) { - Ok(exp) => { - ast = exp; - env = env_root(&env); - continue 'tco; - }, - Err(e) => return Err(e), - } - }, - _ => { // function call - return match eval_ast(ast3, env.clone()) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - match *args.clone()[0] { - Func(f,_) => f(args.slice(1,args.len()).to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args.slice(1,args.len()).to_vec()); - let new_env = env_new(Some(mfc.env.clone())); - match env_bind(&new_env, mfc.params, alst) { - Ok(_) => { - ast = mfc.exp; - env = new_env; - continue 'tco; - }, - Err(e) => err_str(e.as_slice()), - } - }, - _ => err_str("attempt to call non-function"), - } - } - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - // core.rs: defined using rust - let repl_env = env_new(None); - for (k, v) in core::ns().into_iter() { - env_set(&repl_env, symbol(k.as_slice()), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(vec![])); - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - let _ = rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env.clone()); - - // Invoked with command line arguments - let args = os::args(); - if args.len() > 1 { - let mv_args = args.slice(2,args.len()).iter() - .map(|a| string(a.to_string())) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(mv_args)); - let lf = "(load-file \"".to_string() + args[1] + "\")".to_string(); - match rep(lf.as_slice(), repl_env.clone()) { - Ok(_) => { - os::set_exit_status(0); - return; - }, - Err(str) => { - println!("Error: {}", str); - os::set_exit_status(1); - return; - }, - } - } - - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step7_quote.rs b/rust/src/step7_quote.rs deleted file mode 100644 index b113920efd..0000000000 --- a/rust/src/step7_quote.rs +++ /dev/null @@ -1,352 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; -use std::os; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Nil,False,Sym,List,Vector,Hash_Map,Func,MalFunc, - symbol,_nil,string,list,vector,hash_map,malfunc}; -use env::{Env,env_new,env_bind,env_root,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; -mod core; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn is_pair(x: MalVal) -> bool { - match *x { - List(ref lst,_) | Vector(ref lst,_) => lst.len() > 0, - _ => false, - } -} - -fn quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast.clone()) { - return list(vec![symbol("quote"), ast]) - } - - match *ast.clone() { - List(ref args,_) | Vector(ref args,_) => { - let ref a0 = args[0]; - match **a0 { - Sym(ref s) => { - if s.to_string() == "unquote".to_string() { - let ref a1 = args[1]; - return a1.clone(); - } - }, - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - let a00 = a0args[0].clone(); - match *a00 { - Sym(ref s) => { - if s.to_string() == "splice-unquote".to_string() { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args.slice(1,args.len()).to_vec()))]) - } - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args.slice(1,args.len()).to_vec()); - return list(vec![symbol("cons"), - quasiquote(a0.clone()), - quasiquote(rest)]) - }, - _ => _nil(), // should never reach - } -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let ast2 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - let ast3 = ast2.clone(); - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast3); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - ast = a2; - env = let_env.clone(); - continue 'tco; - }, - "quote" => { - return Ok((*args)[1].clone()); - }, - "quasiquote" => { - let a1 = (*args)[1].clone(); - ast = quasiquote(a1); - continue 'tco; - }, - "do" => { - let el = list(args.slice(1,args.len()-1).to_vec()); - match eval_ast(el, env.clone()) { - Err(e) => return Err(e), - Ok(_) => { - let ref last = args[args.len()-1]; - ast = last.clone(); - continue 'tco; - }, - } - }, - "if" => { - let a1 = (*args)[1].clone(); - let cond = eval(a1, env.clone()); - match cond { - Err(e) => return Err(e), - Ok(c) => match *c { - False | Nil => { - if args.len() >= 4 { - let a3 = (*args)[3].clone(); - ast = a3; - env = env.clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - let a2 = (*args)[2].clone(); - ast = a2; - env = env.clone(); - continue 'tco; - }, - } - } - }, - "fn*" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - return Ok(malfunc(eval, a2, env.clone(), a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - match eval(a1, env.clone()) { - Ok(exp) => { - ast = exp; - env = env_root(&env); - continue 'tco; - }, - Err(e) => return Err(e), - } - }, - _ => { // function call - return match eval_ast(ast3, env.clone()) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - match *args.clone()[0] { - Func(f,_) => f(args.slice(1,args.len()).to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args.slice(1,args.len()).to_vec()); - let new_env = env_new(Some(mfc.env.clone())); - match env_bind(&new_env, mfc.params, alst) { - Ok(_) => { - ast = mfc.exp; - env = new_env; - continue 'tco; - }, - Err(e) => err_str(e.as_slice()), - } - }, - _ => err_str("attempt to call non-function"), - } - } - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - // core.rs: defined using rust - let repl_env = env_new(None); - for (k, v) in core::ns().into_iter() { - env_set(&repl_env, symbol(k.as_slice()), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(vec![])); - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - let _ = rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env.clone()); - - // Invoked with command line arguments - let args = os::args(); - if args.len() > 1 { - let mv_args = args.slice(2,args.len()).iter() - .map(|a| string(a.to_string())) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(mv_args)); - let lf = "(load-file \"".to_string() + args[1] + "\")".to_string(); - match rep(lf.as_slice(), repl_env.clone()) { - Ok(_) => { - os::set_exit_status(0); - return; - }, - Err(str) => { - println!("Error: {}", str); - os::set_exit_status(1); - return; - }, - } - } - - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step8_macros.rs b/rust/src/step8_macros.rs deleted file mode 100644 index 7450de8bfc..0000000000 --- a/rust/src/step8_macros.rs +++ /dev/null @@ -1,447 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; -use std::os; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Nil,False,Sym,List,Vector,Hash_Map,Func,MalFunc, - symbol,_nil,string,list,vector,hash_map,malfunc,malfuncd}; -use env::{Env,env_new,env_bind,env_root,env_find,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; -mod core; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn is_pair(x: MalVal) -> bool { - match *x { - List(ref lst,_) | Vector(ref lst,_) => lst.len() > 0, - _ => false, - } -} - -fn quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast.clone()) { - return list(vec![symbol("quote"), ast]) - } - - match *ast.clone() { - List(ref args,_) | Vector(ref args,_) => { - let ref a0 = args[0]; - match **a0 { - Sym(ref s) => { - if s.to_string() == "unquote".to_string() { - let ref a1 = args[1]; - return a1.clone(); - } - }, - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - let a00 = a0args[0].clone(); - match *a00 { - Sym(ref s) => { - if s.to_string() == "splice-unquote".to_string() { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args.slice(1,args.len()).to_vec()))]) - } - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args.slice(1,args.len()).to_vec()); - return list(vec![symbol("cons"), - quasiquote(a0.clone()), - quasiquote(rest)]) - }, - _ => _nil(), // should never reach - } -} - -fn is_macro_call(ast: MalVal, env: Env) -> bool { - match *ast { - List(ref lst,_) => { - match *lst[0] { - Sym(_) => { - if env_find(env.clone(), lst[0].clone()).is_some() { - match env_get(env, lst[0].clone()) { - Ok(f) => { - match *f { - MalFunc(ref mfd,_) => { - mfd.is_macro - }, - _ => false, - } - }, - _ => false, - } - } else { - false - } - }, - _ => false, - } - }, - _ => false, - } -} - -fn macroexpand(mut ast: MalVal, env: Env) -> MalRet { - while is_macro_call(ast.clone(), env.clone()) { - let ast2 = ast.clone(); - let args = match *ast2 { - List(ref args,_) => args, - _ => break, - }; - let ref a0 = args[0]; - let mf = match **a0 { - Sym(_) => { - match env_get(env.clone(), a0.clone()) { - Ok(mf) => mf, - Err(e) => return Err(e), - } - }, - _ => break, - }; - match *mf { - MalFunc(_,_) => { - match mf.apply(args.slice(1,args.len()).to_vec()) { - Ok(r) => ast = r, - Err(e) => return Err(e), - } - }, - _ => break, - } - } - Ok(ast) -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let mut ast2 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match macroexpand(ast2, env.clone()) { - Ok(a) => { - ast2 = a; - }, - Err(e) => return Err(e), - } - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - let ast3 = ast2.clone(); - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast3); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - ast = a2; - env = let_env.clone(); - continue 'tco; - }, - "quote" => { - return Ok((*args)[1].clone()); - }, - "quasiquote" => { - let a1 = (*args)[1].clone(); - ast = quasiquote(a1); - continue 'tco; - }, - "defmacro!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match eval(a2, env.clone()) { - Ok(r) => { - match *r { - MalFunc(ref mfd,_) => { - match *a1 { - Sym(_) => { - let mut new_mfd = mfd.clone(); - new_mfd.is_macro = true; - let mf = malfuncd(new_mfd,_nil()); - env_set(&env.clone(), a1.clone(), mf.clone()); - return Ok(mf); - }, - _ => return err_str("def! of non-symbol"), - } - }, - _ => return err_str("def! of non-symbol"), - } - }, - Err(e) => return Err(e), - } - }, - "macroexpand" => { - let a1 = (*args)[1].clone(); - return macroexpand(a1, env.clone()) - }, - "do" => { - let el = list(args.slice(1,args.len()-1).to_vec()); - match eval_ast(el, env.clone()) { - Err(e) => return Err(e), - Ok(_) => { - let ref last = args[args.len()-1]; - ast = last.clone(); - continue 'tco; - }, - } - }, - "if" => { - let a1 = (*args)[1].clone(); - let cond = eval(a1, env.clone()); - match cond { - Err(e) => return Err(e), - Ok(c) => match *c { - False | Nil => { - if args.len() >= 4 { - let a3 = (*args)[3].clone(); - ast = a3; - env = env.clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - let a2 = (*args)[2].clone(); - ast = a2; - env = env.clone(); - continue 'tco; - }, - } - } - }, - "fn*" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - return Ok(malfunc(eval, a2, env.clone(), a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - match eval(a1, env.clone()) { - Ok(exp) => { - ast = exp; - env = env_root(&env); - continue 'tco; - }, - Err(e) => return Err(e), - } - }, - _ => { // function call - return match eval_ast(ast3, env.clone()) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - match *args.clone()[0] { - Func(f,_) => f(args.slice(1,args.len()).to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args.slice(1,args.len()).to_vec()); - let new_env = env_new(Some(mfc.env.clone())); - match env_bind(&new_env, mfc.params, alst) { - Ok(_) => { - ast = mfc.exp; - env = new_env; - continue 'tco; - }, - Err(e) => err_str(e.as_slice()), - } - }, - _ => err_str("attempt to call non-function"), - } - } - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - // core.rs: defined using rust - let repl_env = env_new(None); - for (k, v) in core::ns().into_iter() { - env_set(&repl_env, symbol(k.as_slice()), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(vec![])); - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - let _ = rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env.clone()); - let _ = rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env.clone()); - let _ = rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env.clone()); - - // Invoked with command line arguments - let args = os::args(); - if args.len() > 1 { - let mv_args = args.slice(2,args.len()).iter() - .map(|a| string(a.to_string())) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(mv_args)); - let lf = "(load-file \"".to_string() + args[1] + "\")".to_string(); - match rep(lf.as_slice(), repl_env.clone()) { - Ok(_) => { - os::set_exit_status(0); - return; - }, - Err(str) => { - println!("Error: {}", str); - os::set_exit_status(1); - return; - }, - } - } - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/step9_try.rs b/rust/src/step9_try.rs deleted file mode 100644 index 0f6bd88e71..0000000000 --- a/rust/src/step9_try.rs +++ /dev/null @@ -1,477 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; -use std::os; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Nil,False,Sym,List,Vector,Hash_Map,Func,MalFunc, - symbol,_nil,string,list,vector,hash_map,malfunc,malfuncd}; -use env::{Env,env_new,env_bind,env_root,env_find,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; -mod core; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn is_pair(x: MalVal) -> bool { - match *x { - List(ref lst,_) | Vector(ref lst,_) => lst.len() > 0, - _ => false, - } -} - -fn quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast.clone()) { - return list(vec![symbol("quote"), ast]) - } - - match *ast.clone() { - List(ref args,_) | Vector(ref args,_) => { - let ref a0 = args[0]; - match **a0 { - Sym(ref s) => { - if s.to_string() == "unquote".to_string() { - let ref a1 = args[1]; - return a1.clone(); - } - }, - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - let a00 = a0args[0].clone(); - match *a00 { - Sym(ref s) => { - if s.to_string() == "splice-unquote".to_string() { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args.slice(1,args.len()).to_vec()))]) - } - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args.slice(1,args.len()).to_vec()); - return list(vec![symbol("cons"), - quasiquote(a0.clone()), - quasiquote(rest)]) - }, - _ => _nil(), // should never reach - } -} - -fn is_macro_call(ast: MalVal, env: Env) -> bool { - match *ast { - List(ref lst,_) => { - match *lst[0] { - Sym(_) => { - if env_find(env.clone(), lst[0].clone()).is_some() { - match env_get(env, lst[0].clone()) { - Ok(f) => { - match *f { - MalFunc(ref mfd,_) => { - mfd.is_macro - }, - _ => false, - } - }, - _ => false, - } - } else { - false - } - }, - _ => false, - } - }, - _ => false, - } -} - -fn macroexpand(mut ast: MalVal, env: Env) -> MalRet { - while is_macro_call(ast.clone(), env.clone()) { - let ast2 = ast.clone(); - let args = match *ast2 { - List(ref args,_) => args, - _ => break, - }; - let ref a0 = args[0]; - let mf = match **a0 { - Sym(_) => { - match env_get(env.clone(), a0.clone()) { - Ok(mf) => mf, - Err(e) => return Err(e), - } - }, - _ => break, - }; - match *mf { - MalFunc(_,_) => { - match mf.apply(args.slice(1,args.len()).to_vec()) { - Ok(r) => ast = r, - Err(e) => return Err(e), - } - }, - _ => break, - } - } - Ok(ast) -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let mut ast2 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match macroexpand(ast2, env.clone()) { - Ok(a) => { - ast2 = a; - }, - Err(e) => return Err(e), - } - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - let ast3 = ast2.clone(); - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast3); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - ast = a2; - env = let_env.clone(); - continue 'tco; - }, - "quote" => { - return Ok((*args)[1].clone()); - }, - "quasiquote" => { - let a1 = (*args)[1].clone(); - ast = quasiquote(a1); - continue 'tco; - }, - "defmacro!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match eval(a2, env.clone()) { - Ok(r) => { - match *r { - MalFunc(ref mfd,_) => { - match *a1 { - Sym(_) => { - let mut new_mfd = mfd.clone(); - new_mfd.is_macro = true; - let mf = malfuncd(new_mfd,_nil()); - env_set(&env.clone(), a1.clone(), mf.clone()); - return Ok(mf); - }, - _ => return err_str("def! of non-symbol"), - } - }, - _ => return err_str("def! of non-symbol"), - } - }, - Err(e) => return Err(e), - } - }, - "macroexpand" => { - let a1 = (*args)[1].clone(); - return macroexpand(a1, env.clone()) - }, - "try*" => { - let a1 = (*args)[1].clone(); - match eval(a1, env.clone()) { - Ok(res) => return Ok(res), - Err(err) => { - if args.len() < 3 { return Err(err); } - let a2 = (*args)[2].clone(); - let cat = match *a2 { - List(ref cat,_) => cat, - _ => return err_str("invalid catch* clause"), - }; - if cat.len() != 3 { - return err_str("wrong arity to catch* clause"); - } - let c1 = (*cat)[1].clone(); - match *c1 { - Sym(_) => {}, - _ => return err_str("invalid catch* binding"), - }; - let exc = match err { - ErrMalVal(mv) => mv, - ErrString(s) => string(s), - }; - let bind_env = env_new(Some(env.clone())); - env_set(&bind_env, c1.clone(), exc); - let c2 = (*cat)[2].clone(); - return eval(c2, bind_env); - }, - }; - } - "do" => { - let el = list(args.slice(1,args.len()-1).to_vec()); - match eval_ast(el, env.clone()) { - Err(e) => return Err(e), - Ok(_) => { - let ref last = args[args.len()-1]; - ast = last.clone(); - continue 'tco; - }, - } - }, - "if" => { - let a1 = (*args)[1].clone(); - let cond = eval(a1, env.clone()); - match cond { - Err(e) => return Err(e), - Ok(c) => match *c { - False | Nil => { - if args.len() >= 4 { - let a3 = (*args)[3].clone(); - ast = a3; - env = env.clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - let a2 = (*args)[2].clone(); - ast = a2; - env = env.clone(); - continue 'tco; - }, - } - } - }, - "fn*" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - return Ok(malfunc(eval, a2, env.clone(), a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - match eval(a1, env.clone()) { - Ok(exp) => { - ast = exp; - env = env_root(&env); - continue 'tco; - }, - Err(e) => return Err(e), - } - }, - _ => { // function call - return match eval_ast(ast3, env.clone()) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - match *args.clone()[0] { - Func(f,_) => f(args.slice(1,args.len()).to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args.slice(1,args.len()).to_vec()); - let new_env = env_new(Some(mfc.env.clone())); - match env_bind(&new_env, mfc.params, alst) { - Ok(_) => { - ast = mfc.exp; - env = new_env; - continue 'tco; - }, - Err(e) => err_str(e.as_slice()), - } - }, - _ => err_str("attempt to call non-function"), - } - } - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - // core.rs: defined using rust - let repl_env = env_new(None); - for (k, v) in core::ns().into_iter() { - env_set(&repl_env, symbol(k.as_slice()), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(vec![])); - - // core.mal: defined using the language itself - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - let _ = rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env.clone()); - let _ = rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env.clone()); - let _ = rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env.clone()); - - // Invoked with command line arguments - let args = os::args(); - if args.len() > 1 { - let mv_args = args.slice(2,args.len()).iter() - .map(|a| string(a.to_string())) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(mv_args)); - let lf = "(load-file \"".to_string() + args[1] + "\")".to_string(); - match rep(lf.as_slice(), repl_env.clone()) { - Ok(_) => { - os::set_exit_status(0); - return; - }, - Err(str) => { - println!("Error: {}", str); - os::set_exit_status(1); - return; - }, - } - } - - // repl loop - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/stepA_mal.rs b/rust/src/stepA_mal.rs deleted file mode 100644 index 8e30867c0b..0000000000 --- a/rust/src/stepA_mal.rs +++ /dev/null @@ -1,479 +0,0 @@ -// support precompiled regexes in reader.rs -#![feature(phase)] -#[phase(plugin)] -extern crate regex_macros; -extern crate regex; - -use std::collections::HashMap; -use std::os; - -use types::{MalVal,MalRet,MalError,ErrString,ErrMalVal,err_str, - Nil,False,Sym,List,Vector,Hash_Map,Func,MalFunc, - symbol,_nil,string,list,vector,hash_map,malfunc,malfuncd}; -use env::{Env,env_new,env_bind,env_root,env_find,env_set,env_get}; -mod readline; -mod types; -mod reader; -mod printer; -mod env; -mod core; - -// read -fn read(str: String) -> MalRet { - reader::read_str(str) -} - -// eval -fn is_pair(x: MalVal) -> bool { - match *x { - List(ref lst,_) | Vector(ref lst,_) => lst.len() > 0, - _ => false, - } -} - -fn quasiquote(ast: MalVal) -> MalVal { - if !is_pair(ast.clone()) { - return list(vec![symbol("quote"), ast]) - } - - match *ast.clone() { - List(ref args,_) | Vector(ref args,_) => { - let ref a0 = args[0]; - match **a0 { - Sym(ref s) => { - if s.to_string() == "unquote".to_string() { - let ref a1 = args[1]; - return a1.clone(); - } - }, - _ => (), - } - if is_pair(a0.clone()) { - match **a0 { - List(ref a0args,_) | Vector(ref a0args,_) => { - let a00 = a0args[0].clone(); - match *a00 { - Sym(ref s) => { - if s.to_string() == "splice-unquote".to_string() { - return list(vec![symbol("concat"), - a0args[1].clone(), - quasiquote(list(args.slice(1,args.len()).to_vec()))]) - } - }, - _ => (), - } - }, - _ => (), - } - } - let rest = list(args.slice(1,args.len()).to_vec()); - return list(vec![symbol("cons"), - quasiquote(a0.clone()), - quasiquote(rest)]) - }, - _ => _nil(), // should never reach - } -} - -fn is_macro_call(ast: MalVal, env: Env) -> bool { - match *ast { - List(ref lst,_) => { - match *lst[0] { - Sym(_) => { - if env_find(env.clone(), lst[0].clone()).is_some() { - match env_get(env, lst[0].clone()) { - Ok(f) => { - match *f { - MalFunc(ref mfd,_) => { - mfd.is_macro - }, - _ => false, - } - }, - _ => false, - } - } else { - false - } - }, - _ => false, - } - }, - _ => false, - } -} - -fn macroexpand(mut ast: MalVal, env: Env) -> MalRet { - while is_macro_call(ast.clone(), env.clone()) { - let ast2 = ast.clone(); - let args = match *ast2 { - List(ref args,_) => args, - _ => break, - }; - let ref a0 = args[0]; - let mf = match **a0 { - Sym(_) => { - match env_get(env.clone(), a0.clone()) { - Ok(mf) => mf, - Err(e) => return Err(e), - } - }, - _ => break, - }; - match *mf { - MalFunc(_,_) => { - match mf.apply(args.slice(1,args.len()).to_vec()) { - Ok(r) => ast = r, - Err(e) => return Err(e), - } - }, - _ => break, - } - } - Ok(ast) -} - -fn eval_ast(ast: MalVal, env: Env) -> MalRet { - let ast2 = ast.clone(); - match *ast2 { - //match *ast { - Sym(_) => { - env_get(env.clone(), ast) - }, - List(ref a,_) | Vector(ref a,_) => { - let mut ast_vec : Vec = vec![]; - for mv in a.iter() { - let mv2 = mv.clone(); - match eval(mv2, env.clone()) { - Ok(mv) => { ast_vec.push(mv); }, - Err(e) => { return Err(e); }, - } - } - Ok(match *ast { List(_,_) => list(ast_vec), - _ => vector(ast_vec) }) - }, - Hash_Map(ref hm,_) => { - let mut new_hm: HashMap = HashMap::new(); - for (key, value) in hm.iter() { - match eval(value.clone(), env.clone()) { - Ok(mv) => { new_hm.insert(key.to_string(), mv); }, - Err(e) => return Err(e), - } - } - Ok(hash_map(new_hm)) - }, - _ => { - Ok(ast) - } - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - 'tco: loop { - - //println!("eval: {}, {}", ast, env.borrow()); - //println!("eval: {}", ast); - let mut ast2 = ast.clone(); - match *ast2 { - List(_,_) => (), // continue - _ => return eval_ast(ast2, env), - } - - // apply list - match macroexpand(ast2, env.clone()) { - Ok(a) => { - ast2 = a; - }, - Err(e) => return Err(e), - } - match *ast2 { - List(_,_) => (), // continue - _ => return Ok(ast2), - } - let ast3 = ast2.clone(); - - let (args, a0sym) = match *ast2 { - List(ref args,_) => { - if args.len() == 0 { - return Ok(ast3); - } - let ref a0 = *args[0]; - match *a0 { - Sym(ref a0sym) => (args, a0sym.as_slice()), - _ => (args, "____"), - } - }, - _ => return err_str("Expected list"), - }; - - match a0sym { - "def!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - let res = eval(a2, env.clone()); - match res { - Ok(r) => { - match *a1 { - Sym(_) => { - env_set(&env.clone(), a1.clone(), r.clone()); - return Ok(r); - }, - _ => { - return err_str("def! of non-symbol") - } - } - }, - Err(e) => return Err(e), - } - }, - "let*" => { - let let_env = env_new(Some(env.clone())); - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match *a1 { - List(ref binds,_) | Vector(ref binds,_) => { - let mut it = binds.iter(); - while it.len() >= 2 { - let b = it.next().unwrap(); - let exp = it.next().unwrap(); - match **b { - Sym(_) => { - match eval(exp.clone(), let_env.clone()) { - Ok(r) => { - env_set(&let_env, b.clone(), r); - }, - Err(e) => { - return Err(e); - }, - } - }, - _ => { - return err_str("let* with non-symbol binding"); - }, - } - } - }, - _ => return err_str("let* with non-list bindings"), - } - ast = a2; - env = let_env.clone(); - continue 'tco; - }, - "quote" => { - return Ok((*args)[1].clone()); - }, - "quasiquote" => { - let a1 = (*args)[1].clone(); - ast = quasiquote(a1); - continue 'tco; - }, - "defmacro!" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - match eval(a2, env.clone()) { - Ok(r) => { - match *r { - MalFunc(ref mfd,_) => { - match *a1 { - Sym(_) => { - let mut new_mfd = mfd.clone(); - new_mfd.is_macro = true; - let mf = malfuncd(new_mfd,_nil()); - env_set(&env.clone(), a1.clone(), mf.clone()); - return Ok(mf); - }, - _ => return err_str("def! of non-symbol"), - } - }, - _ => return err_str("def! of non-symbol"), - } - }, - Err(e) => return Err(e), - } - }, - "macroexpand" => { - let a1 = (*args)[1].clone(); - return macroexpand(a1, env.clone()) - }, - "try*" => { - let a1 = (*args)[1].clone(); - match eval(a1, env.clone()) { - Ok(res) => return Ok(res), - Err(err) => { - if args.len() < 3 { return Err(err); } - let a2 = (*args)[2].clone(); - let cat = match *a2 { - List(ref cat,_) => cat, - _ => return err_str("invalid catch* clause"), - }; - if cat.len() != 3 { - return err_str("wrong arity to catch* clause"); - } - let c1 = (*cat)[1].clone(); - match *c1 { - Sym(_) => {}, - _ => return err_str("invalid catch* binding"), - }; - let exc = match err { - ErrMalVal(mv) => mv, - ErrString(s) => string(s), - }; - let bind_env = env_new(Some(env.clone())); - env_set(&bind_env, c1.clone(), exc); - let c2 = (*cat)[2].clone(); - return eval(c2, bind_env); - }, - }; - } - "do" => { - let el = list(args.slice(1,args.len()-1).to_vec()); - match eval_ast(el, env.clone()) { - Err(e) => return Err(e), - Ok(_) => { - let ref last = args[args.len()-1]; - ast = last.clone(); - continue 'tco; - }, - } - }, - "if" => { - let a1 = (*args)[1].clone(); - let cond = eval(a1, env.clone()); - match cond { - Err(e) => return Err(e), - Ok(c) => match *c { - False | Nil => { - if args.len() >= 4 { - let a3 = (*args)[3].clone(); - ast = a3; - env = env.clone(); - continue 'tco; - } else { - return Ok(_nil()); - } - }, - _ => { - let a2 = (*args)[2].clone(); - ast = a2; - env = env.clone(); - continue 'tco; - }, - } - } - }, - "fn*" => { - let a1 = (*args)[1].clone(); - let a2 = (*args)[2].clone(); - return Ok(malfunc(eval, a2, env.clone(), a1, _nil())); - }, - "eval" => { - let a1 = (*args)[1].clone(); - match eval(a1, env.clone()) { - Ok(exp) => { - ast = exp; - env = env_root(&env); - continue 'tco; - }, - Err(e) => return Err(e), - } - }, - _ => { // function call - return match eval_ast(ast3, env.clone()) { - Err(e) => Err(e), - Ok(el) => { - let args = match *el { - List(ref args,_) => args, - _ => return err_str("Invalid apply"), - }; - match *args.clone()[0] { - Func(f,_) => f(args.slice(1,args.len()).to_vec()), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args.slice(1,args.len()).to_vec()); - let new_env = env_new(Some(mfc.env.clone())); - match env_bind(&new_env, mfc.params, alst) { - Ok(_) => { - ast = mfc.exp; - env = new_env; - continue 'tco; - }, - Err(e) => err_str(e.as_slice()), - } - }, - _ => err_str("attempt to call non-function"), - } - } - } - }, - } - - } -} - -// print -fn print(exp: MalVal) -> String { - exp.pr_str(true) -} - -fn rep(str: &str, env: Env) -> Result { - match read(str.to_string()) { - Err(e) => Err(e), - Ok(ast) => { - //println!("read: {}", ast); - match eval(ast, env) { - Err(e) => Err(e), - Ok(exp) => Ok(print(exp)), - } - } - } -} - -fn main() { - // core.rs: defined using rust - let repl_env = env_new(None); - for (k, v) in core::ns().into_iter() { - env_set(&repl_env, symbol(k.as_slice()), v); - } - // see eval() for definition of "eval" - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(vec![])); - - // core.mal: defined using the language itself - let _ = rep("(def! *host-language* \"rust\")", repl_env.clone()); - let _ = rep("(def! not (fn* (a) (if a false true)))", repl_env.clone()); - let _ = rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env.clone()); - let _ = rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env.clone()); - let _ = rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env.clone()); - - // Invoked with command line arguments - let args = os::args(); - if args.len() > 1 { - let mv_args = args.slice(2,args.len()).iter() - .map(|a| string(a.to_string())) - .collect::>(); - env_set(&repl_env, symbol("*ARGV*".as_slice()), list(mv_args)); - let lf = "(load-file \"".to_string() + args[1] + "\")".to_string(); - match rep(lf.as_slice(), repl_env.clone()) { - Ok(_) => { - os::set_exit_status(0); - return; - }, - Err(str) => { - println!("Error: {}", str); - os::set_exit_status(1); - return; - }, - } - } - - // repl loop - let _ = rep("(println (str \"Mal [\" *host-language* \"]\"))", repl_env.clone()); - loop { - let line = readline::mal_readline("user> "); - match line { None => break, _ => () } - match rep(line.unwrap().as_slice(), repl_env.clone()) { - Ok(str) => println!("{}", str), - Err(ErrMalVal(_)) => (), // Blank line - Err(ErrString(s)) => println!("Error: {}", s), - } - } -} diff --git a/rust/src/types.rs b/rust/src/types.rs deleted file mode 100644 index 141c3db7c0..0000000000 --- a/rust/src/types.rs +++ /dev/null @@ -1,405 +0,0 @@ -#![allow(dead_code)] - -use std::rc::Rc; -use std::cell::RefCell; -use std::collections::HashMap; -use std::fmt; -use super::printer::{escape_str,pr_list}; -use super::env::{Env,env_new,env_bind}; - -#[deriving(Clone)] -#[allow(non_camel_case_types)] -pub enum MalType { - Nil, - True, - False, - Int(int), - Strn(String), - Sym(String), - List(Vec, MalVal), - Vector(Vec, MalVal), - Hash_Map(HashMap, MalVal), - Func(fn(Vec) -> MalRet, MalVal), - //Func(fn(&[MalVal]) -> MalRet), - //Func(|Vec|:'a -> MalRet), - MalFunc(MalFuncData, MalVal), - Atom(RefCell), -} - -pub type MalVal = Rc; - -#[deriving(Show)] -pub enum MalError { - ErrString(String), - ErrMalVal(MalVal), -} - -pub type MalRet = Result; - - -pub fn err_string(s: String) -> MalRet { - Err(ErrString(s)) -} - -pub fn err_str(s: &str) -> MalRet { - Err(ErrString(s.to_string())) -} - -pub fn err_val(mv: MalVal) -> MalRet { - Err(ErrMalVal(mv)) -} - -/* -pub enum MalRet { - Val(MalVal), - MalErr(MalVal), - StringErr(String), -} -*/ - - -#[deriving(Clone)] -pub struct MalFuncData { - pub eval: fn(MalVal, Env) -> MalRet, - pub exp: MalVal, - pub env: Env, - pub params: MalVal, - pub is_macro: bool, -} - -impl MalType { - pub fn pr_str(&self, print_readably: bool) -> String { - let _r = print_readably; - let mut res = String::new(); - match *self { - Nil => res.push_str("nil"), - True => res.push_str("true"), - False => res.push_str("false"), - Int(v) => res.push_str(v.to_string().as_slice()), - Sym(ref v) => res.push_str((*v).as_slice()), - Strn(ref v) => { - if v.as_slice().starts_with("\u029e") { - res.push_str(":"); - res.push_str(v.as_slice().slice(2,v.len())) - } else if print_readably { - res.push_str(escape_str((*v).as_slice()).as_slice()) - } else { - res.push_str(v.as_slice()) - } - }, - List(ref v,_) => { - res = pr_list(v, _r, "(", ")", " ") - }, - Vector(ref v,_) => { - res = pr_list(v, _r, "[", "]", " ") - }, - Hash_Map(ref v,_) => { - let mut first = true; - res.push_str("{"); - for (key, value) in v.iter() { - if first { first = false; } else { res.push_str(" "); } - if key.as_slice().starts_with("\u029e") { - res.push_str(":"); - res.push_str(key.as_slice().slice(2,key.len())) - } else if print_readably { - res.push_str(escape_str(key.as_slice()).as_slice()) - } else { - res.push_str(key.as_slice()) - } - res.push_str(" "); - res.push_str(value.pr_str(_r).as_slice()); - } - res.push_str("}") - }, - // TODO: better native function representation - Func(_,_) => { - res.push_str(format!("#").as_slice()) - }, - MalFunc(ref mf,_) => { - res.push_str(format!("(fn* {} {})", mf.params, mf.exp).as_slice()) - }, - Atom(ref v) => { - res = format!("(atom {})", v.borrow()); - }, - }; - res - } - - pub fn apply(&self, args:Vec) -> MalRet { - match *self { - Func(f,_) => f(args), - MalFunc(ref mf,_) => { - let mfc = mf.clone(); - let alst = list(args); - let new_env = env_new(Some(mfc.env.clone())); - match env_bind(&new_env, mfc.params, alst) { - Ok(_) => (mfc.eval)(mfc.exp, new_env), - Err(e) => err_string(e), - } - }, - _ => err_str("attempt to call non-function"), - } - - } -} - -impl PartialEq for MalType { - fn eq(&self, other: &MalType) -> bool { - match (self, other) { - (&Nil, &Nil) | - (&True, &True) | - (&False, &False) => true, - (&Int(ref a), &Int(ref b)) => a == b, - (&Strn(ref a), &Strn(ref b)) => a == b, - (&Sym(ref a), &Sym(ref b)) => a == b, - (&List(ref a,_), &List(ref b,_)) | - (&Vector(ref a,_), &Vector(ref b,_)) | - (&List(ref a,_), &Vector(ref b,_)) | - (&Vector(ref a,_), &List(ref b,_)) => a == b, - (&Hash_Map(ref a,_), &Hash_Map(ref b,_)) => a == b, - // TODO: fix this - (&Func(_,_), &Func(_,_)) => false, - (&MalFunc(_,_), &MalFunc(_,_)) => false, - _ => return false, - } - } -} - -impl fmt::Show for MalType { - fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { - write!(f, "{}", self.pr_str(true)) - } -} - - -// Scalars -pub fn _nil() -> MalVal { Rc::new(Nil) } -pub fn nil_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to nil? call"); - } - match *a[0].clone() { - Nil => Ok(_true()), - _ => Ok(_false()), - } -} - -pub fn _true() -> MalVal { Rc::new(True) } -pub fn true_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to true? call"); - } - match *a[0].clone() { - True => Ok(_true()), - _ => Ok(_false()), - } -} - -pub fn _false() -> MalVal { Rc::new(False) } -pub fn false_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to false? call"); - } - match *a[0].clone() { - False => Ok(_true()), - _ => Ok(_false()), - } -} - -pub fn _int(i: int) -> MalVal { Rc::new(Int(i)) } - - -// Symbols -pub fn symbol(strn: &str) -> MalVal { Rc::new(Sym(strn.to_string())) } -pub fn _symbol(a: Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to symbol call"); - } - match *a[0].clone() { - Strn(ref s) => { - Ok(Rc::new(Sym(s.to_string()))) - }, - _ => return err_str("symbol called on non-string"), - } -} -pub fn symbol_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to symbol? call"); - } - match *a[0].clone() { - Sym(_) => Ok(_true()), - _ => Ok(_false()), - } -} - -// Keywords -pub fn _keyword(a: Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to keyword call"); - } - match *a[0].clone() { - Strn(ref s) => { - Ok(Rc::new(Strn("\u029e".to_string() + s.to_string()))) - }, - _ => return err_str("keyword called on non-string"), - } -} -pub fn keyword_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to keyword? call"); - } - match *a[0].clone() { - Strn(ref s) => { - if s.as_slice().starts_with("\u029e") { - Ok(_true()) - } else { - Ok(_false()) - } - }, - _ => Ok(_false()), - } -} - - -// Strings -pub fn strn(strn: &str) -> MalVal { Rc::new(Strn(strn.to_string())) } -pub fn string(strn: String) -> MalVal { Rc::new(Strn(strn)) } - -// Lists -pub fn list(seq: Vec) -> MalVal { Rc::new(List(seq,_nil())) } -pub fn listm(seq: Vec, meta: MalVal) -> MalVal { - Rc::new(List(seq,meta)) -} -pub fn listv(seq:Vec) -> MalRet { Ok(list(seq)) } -pub fn list_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to list? call"); - } - match *a[0].clone() { - List(_,_) => Ok(_true()), - _ => Ok(_false()), - } -} - -// Vectors -pub fn vector(seq: Vec) -> MalVal { Rc::new(Vector(seq,_nil())) } -pub fn vectorm(seq: Vec, meta: MalVal) -> MalVal { - Rc::new(Vector(seq,meta)) -} -pub fn vectorv(seq: Vec) -> MalRet { Ok(vector(seq)) } -pub fn vector_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to vector? call"); - } - match *a[0].clone() { - Vector(_,_) => Ok(_true()), - _ => Ok(_false()), - } -} - -// Hash Maps -pub fn hash_map(hm: HashMap) -> MalVal { - Rc::new(Hash_Map(hm,_nil())) -} -pub fn hash_mapm(hm: HashMap, meta: MalVal) -> MalVal { - Rc::new(Hash_Map(hm,meta)) -} -pub fn _assoc(hm: &HashMap, a:Vec) -> MalRet { - if a.len() % 2 == 1 { - return err_str("odd number of hash-map keys/values"); - } - let mut new_hm = hm.clone(); - let mut it = a.iter(); - loop { - let k = match it.next() { - Some(mv) => match *mv.clone() { - Strn(ref s) => s.to_string(), - _ => return err_str("key is not a string in hash-map call"), - }, - None => break, - }; - let v = it.next().unwrap(); - new_hm.insert(k, v.clone()); - } - Ok(Rc::new(Hash_Map(new_hm,_nil()))) -} -pub fn _dissoc(hm: &HashMap, a:Vec) -> MalRet { - let mut new_hm = hm.clone(); - let mut it = a.iter(); - loop { - let k = match it.next() { - Some(mv) => match *mv.clone() { - Strn(ref s) => s.to_string(), - _ => return err_str("key is not a string in hash-map call"), - }, - None => break, - }; - new_hm.remove(&k); - } - Ok(Rc::new(Hash_Map(new_hm,_nil()))) -} -pub fn hash_mapv(seq: Vec) -> MalRet { - let new_hm: HashMap = HashMap::new(); - _assoc(&new_hm, seq) -} -pub fn hash_map_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to map? call"); - } - match *a[0].clone() { - Hash_Map(_,_) => Ok(_true()), - _ => Ok(_false()), - } -} - -// Functions -pub fn func(f: fn(Vec) -> MalRet) -> MalVal { - Rc::new(Func(f, _nil())) -} -pub fn funcm(f: fn(Vec) -> MalRet, meta: MalVal) -> MalVal { - Rc::new(Func(f, meta)) -} -pub fn malfunc(eval: fn(MalVal, Env) -> MalRet, - exp: MalVal, - env: Env, - params: MalVal, - meta: MalVal) -> MalVal { - Rc::new(MalFunc(MalFuncData{eval: eval, - exp: exp, - env: env, - params: params, - is_macro: false},meta)) -} -pub fn malfuncd(mfd: MalFuncData, meta: MalVal) -> MalVal { - Rc::new(MalFunc(mfd,meta)) -} - - -// Atoms -pub fn atom_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to atom? call"); - } - match *a[0].clone() { - Atom(_) => Ok(_true()), - _ => Ok(_false()), - } -} -pub fn atom(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to atom call"); - } - Ok(Rc::new(Atom(RefCell::new(a[0].clone())))) -} - - -// General functions -pub fn sequential_q(a:Vec) -> MalRet { - if a.len() != 1 { - return err_str("Wrong arity to sequential? call"); - } - match *a[0].clone() { - List(_,_) | Vector(_,_) => Ok(_true()), - _ => Ok(_false()), - } -} diff --git a/scala/Makefile b/scala/Makefile deleted file mode 100644 index 29dd8aa544..0000000000 --- a/scala/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -TESTS = - -SOURCES_BASE = types.scala reader.scala printer.scala -SOURCES_LISP = env.scala core.scala stepA_mal.scala -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -#all: mal.scala - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ruby $@ || exit 1; \ diff --git a/scala/build.sbt b/scala/build.sbt deleted file mode 100644 index d2a2802e6c..0000000000 --- a/scala/build.sbt +++ /dev/null @@ -1,15 +0,0 @@ -lazy val root = (project in file(".")). - settings( - name := "mal", - version := "0.1", - scalaVersion := "2.11.4" - ) - -// Suppress message for command line execution - -onLoadMessage := "" - -showSuccess := false - -logLevel in runMain := Level.Warn - diff --git a/scala/step7_quote.scala b/scala/step7_quote.scala deleted file mode 100644 index 3f0a4d8fc8..0000000000 --- a/scala/step7_quote.scala +++ /dev/null @@ -1,163 +0,0 @@ -import types.{MalList, _list, _list_Q, MalVector, MalHashMap, - Func, MalFunction} -import env.Env - -object step7_quote { - // read - def READ(str: String): Any = { - reader.read_str(str) - } - - // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 - } - - def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - - def eval_ast(ast: Any, env: Env): Any = { - ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) - case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} - } - case _ => ast - } - } - - def EVAL(orig_ast: Any, orig_env: Env): Any = { - var ast = orig_ast; var env = orig_env; - while (true) { - - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) - - // apply list - ast.asInstanceOf[MalList].value match { - case Symbol("def!") :: a1 :: a2 :: Nil => { - return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) - } - case Symbol("let*") :: a1 :: a2 :: Nil => { - val let_env = new Env(env) - for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { - let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) - } - env = let_env - ast = a2 // continue loop (TCO) - } - case Symbol("quote") :: a1 :: Nil => { - return a1 - } - case Symbol("quasiquote") :: a1 :: Nil => { - ast = quasiquote(a1) // continue loop (TCO) - } - case Symbol("do") :: rest => { - eval_ast(_list(rest.slice(0,rest.length-1):_*), env) - ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) - } - case Symbol("if") :: a1 :: a2 :: rest => { - val cond = EVAL(a1, env) - if (cond == null || cond == false) { - if (rest.length == 0) return null - ast = rest(0) // continue loop (TCO) - } else { - ast = a2 // continue loop (TCO) - } - } - case Symbol("fn*") :: a1 :: a2 :: Nil => { - return new MalFunction(a2, env, a1.asInstanceOf[MalList], - (args: List[Any]) => { - EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) - } - ) - } - case _ => { - // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { - case f :: el => { - f match { - case fn: MalFunction => { - env = fn.gen_env(el) - ast = fn.ast // continue loop (TCO) - } - case fn: Func => { - return fn(el) - } - case _ => { - throw new Exception("attempt to call non-function: " + f) - } - } - } - case _ => throw new Exception("invalid apply") - } - } - } - } - } - - // print - def PRINT(exp: Any): String = { - printer._pr_str(exp, true) - } - - // repl - def main(args: Array[String]) = { - val repl_env: Env = new Env() - val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) - - // core.scala: defined using scala - core.ns.map{case (k: String,v: Any) => { - repl_env.set(Symbol(k), new Func(v)) - }} - repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) - repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) - - // core.mal: defined using the language itself - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - - if (args.length > 0) { - REP("(load-file \"" + args(0) + "\")") - System.exit(0) - } - - // repl loop - var line:String = null - while ({line = readLine("user> "); line != null}) { - try { - println(REP(line)) - } catch { - case e : Throwable => { - println("Error: " + e.getMessage) - println(" " + e.getStackTrace.mkString("\n ")) - } - } - } - } -} - -// vim: ts=2:sw=2 diff --git a/scala/step8_macros.scala b/scala/step8_macros.scala deleted file mode 100644 index e1a22228e0..0000000000 --- a/scala/step8_macros.scala +++ /dev/null @@ -1,207 +0,0 @@ -import types.{MalList, _list, _list_Q, MalVector, MalHashMap, - Func, MalFunction} -import env.Env - -object step8_macros { - // read - def READ(str: String): Any = { - reader.read_str(str) - } - - // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 - } - - def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - - def is_macro_call(ast: Any, env: Env): Boolean = { - ast match { - case ml: MalList => { - if (types._symbol_Q(ml(0)) && - env.find(ml(0).asInstanceOf[Symbol]) != null) { - env.get(ml(0).asInstanceOf[Symbol]) match { - case f: MalFunction => return f.ismacro - case _ => return false - } - } - return false - } - case _ => return false - } - } - - def macroexpand(orig_ast: Any, env: Env): Any = { - var ast = orig_ast; - while (is_macro_call(ast, env)) { - ast.asInstanceOf[MalList].value match { - case f :: args => { - val mac = env.get(f.asInstanceOf[Symbol]) - ast = mac.asInstanceOf[MalFunction](args) - } - case _ => throw new Exception("macroexpand: invalid call") - } - } - ast - } - - def eval_ast(ast: Any, env: Env): Any = { - ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) - case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} - } - case _ => ast - } - } - - def EVAL(orig_ast: Any, orig_env: Env): Any = { - var ast = orig_ast; var env = orig_env; - while (true) { - - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) - - // apply list - ast = macroexpand(ast, env) - if (!_list_Q(ast)) return ast - - ast.asInstanceOf[MalList].value match { - case Symbol("def!") :: a1 :: a2 :: Nil => { - return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) - } - case Symbol("let*") :: a1 :: a2 :: Nil => { - val let_env = new Env(env) - for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { - let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) - } - env = let_env - ast = a2 // continue loop (TCO) - } - case Symbol("quote") :: a1 :: Nil => { - return a1 - } - case Symbol("quasiquote") :: a1 :: Nil => { - ast = quasiquote(a1) // continue loop (TCO) - } - case Symbol("defmacro!") :: a1 :: a2 :: Nil => { - val f = EVAL(a2, env) - f.asInstanceOf[MalFunction].ismacro = true - return env.set(a1.asInstanceOf[Symbol], f) - } - case Symbol("macroexpand") :: a1 :: Nil => { - return macroexpand(a1, env) - } - case Symbol("do") :: rest => { - eval_ast(_list(rest.slice(0,rest.length-1):_*), env) - ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) - } - case Symbol("if") :: a1 :: a2 :: rest => { - val cond = EVAL(a1, env) - if (cond == null || cond == false) { - if (rest.length == 0) return null - ast = rest(0) // continue loop (TCO) - } else { - ast = a2 // continue loop (TCO) - } - } - case Symbol("fn*") :: a1 :: a2 :: Nil => { - return new MalFunction(a2, env, a1.asInstanceOf[MalList], - (args: List[Any]) => { - EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) - } - ) - } - case _ => { - // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { - case f :: el => { - f match { - case fn: MalFunction => { - env = fn.gen_env(el) - ast = fn.ast // continue loop (TCO) - } - case fn: Func => { - return fn(el) - } - case _ => { - throw new Exception("attempt to call non-function: " + f) - } - } - } - case _ => throw new Exception("invalid apply") - } - } - } - } - } - - // print - def PRINT(exp: Any): String = { - printer._pr_str(exp, true) - } - - // repl - def main(args: Array[String]) = { - val repl_env: Env = new Env() - val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) - - // core.scala: defined using scala - core.ns.map{case (k: String,v: Any) => { - repl_env.set(Symbol(k), new Func(v)) - }} - repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) - repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) - - // core.mal: defined using the language itself - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") - REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - - if (args.length > 0) { - REP("(load-file \"" + args(0) + "\")") - System.exit(0) - } - - // repl loop - var line:String = null - while ({line = readLine("user> "); line != null}) { - try { - println(REP(line)) - } catch { - case e : Throwable => { - println("Error: " + e.getMessage) - println(" " + e.getStackTrace.mkString("\n ")) - } - } - } - } -} - -// vim: ts=2:sw=2 diff --git a/scala/step9_try.scala b/scala/step9_try.scala deleted file mode 100644 index 02c19beb18..0000000000 --- a/scala/step9_try.scala +++ /dev/null @@ -1,227 +0,0 @@ -import types.{MalList, _list, _list_Q, MalVector, MalHashMap, - Func, MalFunction} -import env.Env - -object step9_try { - // read - def READ(str: String): Any = { - reader.read_str(str) - } - - // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 - } - - def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - - def is_macro_call(ast: Any, env: Env): Boolean = { - ast match { - case ml: MalList => { - if (types._symbol_Q(ml(0)) && - env.find(ml(0).asInstanceOf[Symbol]) != null) { - env.get(ml(0).asInstanceOf[Symbol]) match { - case f: MalFunction => return f.ismacro - case _ => return false - } - } - return false - } - case _ => return false - } - } - - def macroexpand(orig_ast: Any, env: Env): Any = { - var ast = orig_ast; - while (is_macro_call(ast, env)) { - ast.asInstanceOf[MalList].value match { - case f :: args => { - val mac = env.get(f.asInstanceOf[Symbol]) - ast = mac.asInstanceOf[MalFunction](args) - } - case _ => throw new Exception("macroexpand: invalid call") - } - } - ast - } - - def eval_ast(ast: Any, env: Env): Any = { - ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) - case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} - } - case _ => ast - } - } - - def EVAL(orig_ast: Any, orig_env: Env): Any = { - var ast = orig_ast; var env = orig_env; - while (true) { - - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) - - // apply list - ast = macroexpand(ast, env) - if (!_list_Q(ast)) return ast - - ast.asInstanceOf[MalList].value match { - case Symbol("def!") :: a1 :: a2 :: Nil => { - return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) - } - case Symbol("let*") :: a1 :: a2 :: Nil => { - val let_env = new Env(env) - for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { - let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) - } - env = let_env - ast = a2 // continue loop (TCO) - } - case Symbol("quote") :: a1 :: Nil => { - return a1 - } - case Symbol("quasiquote") :: a1 :: Nil => { - ast = quasiquote(a1) // continue loop (TCO) - } - case Symbol("defmacro!") :: a1 :: a2 :: Nil => { - val f = EVAL(a2, env) - f.asInstanceOf[MalFunction].ismacro = true - return env.set(a1.asInstanceOf[Symbol], f) - } - case Symbol("macroexpand") :: a1 :: Nil => { - return macroexpand(a1, env) - } - case Symbol("try*") :: a1 :: rest => { - try { - return EVAL(a1, env) - } catch { - case t: Throwable => { - rest(0).asInstanceOf[MalList].value match { - case List(Symbol("catch*"), a21, a22) => { - val exc: Any = t match { - case mex: types.MalException => mex.value - case _ => t.getMessage - } - return EVAL(a22, new Env(env, - List(a21).iterator, - List(exc).iterator)) - } - } - throw t - } - } - } - case Symbol("do") :: rest => { - eval_ast(_list(rest.slice(0,rest.length-1):_*), env) - ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) - } - case Symbol("if") :: a1 :: a2 :: rest => { - val cond = EVAL(a1, env) - if (cond == null || cond == false) { - if (rest.length == 0) return null - ast = rest(0) // continue loop (TCO) - } else { - ast = a2 // continue loop (TCO) - } - } - case Symbol("fn*") :: a1 :: a2 :: Nil => { - return new MalFunction(a2, env, a1.asInstanceOf[MalList], - (args: List[Any]) => { - EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) - } - ) - } - case _ => { - // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { - case f :: el => { - f match { - case fn: MalFunction => { - env = fn.gen_env(el) - ast = fn.ast // continue loop (TCO) - } - case fn: Func => { - return fn(el) - } - case _ => { - throw new Exception("attempt to call non-function: " + f) - } - } - } - case _ => throw new Exception("invalid apply") - } - } - } - } - } - - // print - def PRINT(exp: Any): String = { - printer._pr_str(exp, true) - } - - // repl - def main(args: Array[String]) = { - val repl_env: Env = new Env() - val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) - - // core.scala: defined using scala - core.ns.map{case (k: String,v: Any) => { - repl_env.set(Symbol(k), new Func(v)) - }} - repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) - repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) - - // core.mal: defined using the language itself - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") - REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - - if (args.length > 0) { - REP("(load-file \"" + args(0) + "\")") - System.exit(0) - } - - // repl loop - var line:String = null - while ({line = readLine("user> "); line != null}) { - try { - println(REP(line)) - } catch { - case e : Throwable => { - println("Error: " + e.getMessage) - println(" " + e.getStackTrace.mkString("\n ")) - } - } - } - } -} - -// vim: ts=2:sw=2 diff --git a/scala/stepA_mal.scala b/scala/stepA_mal.scala deleted file mode 100644 index 5230cb1f67..0000000000 --- a/scala/stepA_mal.scala +++ /dev/null @@ -1,229 +0,0 @@ -import types.{MalList, _list, _list_Q, MalVector, MalHashMap, - Func, MalFunction} -import env.Env - -object stepA_mal { - // read - def READ(str: String): Any = { - reader.read_str(str) - } - - // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 - } - - def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) - } - } - - def is_macro_call(ast: Any, env: Env): Boolean = { - ast match { - case ml: MalList => { - if (types._symbol_Q(ml(0)) && - env.find(ml(0).asInstanceOf[Symbol]) != null) { - env.get(ml(0).asInstanceOf[Symbol]) match { - case f: MalFunction => return f.ismacro - case _ => return false - } - } - return false - } - case _ => return false - } - } - - def macroexpand(orig_ast: Any, env: Env): Any = { - var ast = orig_ast; - while (is_macro_call(ast, env)) { - ast.asInstanceOf[MalList].value match { - case f :: args => { - val mac = env.get(f.asInstanceOf[Symbol]) - ast = mac.asInstanceOf[MalFunction](args) - } - case _ => throw new Exception("macroexpand: invalid call") - } - } - ast - } - - def eval_ast(ast: Any, env: Env): Any = { - ast match { - case s : Symbol => env.get(s) - case v: MalVector => v.map(EVAL(_, env)) - case l: MalList => l.map(EVAL(_, env)) - case m: MalHashMap => { - m.map{case (k: String,v: Any) => (k, EVAL(v, env))} - } - case _ => ast - } - } - - def EVAL(orig_ast: Any, orig_env: Env): Any = { - var ast = orig_ast; var env = orig_env; - while (true) { - - //println("EVAL: " + printer._pr_str(ast,true)) - if (!_list_Q(ast)) - return eval_ast(ast, env) - - // apply list - ast = macroexpand(ast, env) - if (!_list_Q(ast)) return ast - - ast.asInstanceOf[MalList].value match { - case Symbol("def!") :: a1 :: a2 :: Nil => { - return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) - } - case Symbol("let*") :: a1 :: a2 :: Nil => { - val let_env = new Env(env) - for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { - let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) - } - env = let_env - ast = a2 // continue loop (TCO) - } - case Symbol("quote") :: a1 :: Nil => { - return a1 - } - case Symbol("quasiquote") :: a1 :: Nil => { - ast = quasiquote(a1) // continue loop (TCO) - } - case Symbol("defmacro!") :: a1 :: a2 :: Nil => { - val f = EVAL(a2, env) - f.asInstanceOf[MalFunction].ismacro = true - return env.set(a1.asInstanceOf[Symbol], f) - } - case Symbol("macroexpand") :: a1 :: Nil => { - return macroexpand(a1, env) - } - case Symbol("try*") :: a1 :: rest => { - try { - return EVAL(a1, env) - } catch { - case t: Throwable => { - rest(0).asInstanceOf[MalList].value match { - case List(Symbol("catch*"), a21, a22) => { - val exc: Any = t match { - case mex: types.MalException => mex.value - case _ => t.getMessage - } - return EVAL(a22, new Env(env, - List(a21).iterator, - List(exc).iterator)) - } - } - throw t - } - } - } - case Symbol("do") :: rest => { - eval_ast(_list(rest.slice(0,rest.length-1):_*), env) - ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) - } - case Symbol("if") :: a1 :: a2 :: rest => { - val cond = EVAL(a1, env) - if (cond == null || cond == false) { - if (rest.length == 0) return null - ast = rest(0) // continue loop (TCO) - } else { - ast = a2 // continue loop (TCO) - } - } - case Symbol("fn*") :: a1 :: a2 :: Nil => { - return new MalFunction(a2, env, a1.asInstanceOf[MalList], - (args: List[Any]) => { - EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) - } - ) - } - case _ => { - // function call - eval_ast(ast, env).asInstanceOf[MalList].value match { - case f :: el => { - f match { - case fn: MalFunction => { - env = fn.gen_env(el) - ast = fn.ast // continue loop (TCO) - } - case fn: Func => { - return fn(el) - } - case _ => { - throw new Exception("attempt to call non-function: " + f) - } - } - } - case _ => throw new Exception("invalid apply") - } - } - } - } - } - - // print - def PRINT(exp: Any): String = { - printer._pr_str(exp, true) - } - - // repl - def main(args: Array[String]) = { - val repl_env: Env = new Env() - val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) - - // core.scala: defined using scala - core.ns.map{case (k: String,v: Any) => { - repl_env.set(Symbol(k), new Func(v)) - }} - repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) - repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) - - // core.mal: defined using the language itself - REP("(def! *host-language* \"scala\")") - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))") - REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") - REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - - if (args.length > 0) { - REP("(load-file \"" + args(0) + "\")") - System.exit(0) - } - - // repl loop - REP("(println (str \"Mal [\" *host-language* \"]\"))") - var line:String = null - while ({line = readLine("user> "); line != null}) { - try { - println(REP(line)) - } catch { - case e : Throwable => { - println("Error: " + e.getMessage) - println(" " + e.getStackTrace.mkString("\n ")) - } - } - } - } -} - -// vim: ts=2:sw=2 diff --git a/tests b/tests new file mode 120000 index 0000000000..bfc25517e6 --- /dev/null +++ b/tests @@ -0,0 +1 @@ +impls/tests \ No newline at end of file diff --git a/tests/incB.mal b/tests/incB.mal deleted file mode 100644 index 519bdf41f5..0000000000 --- a/tests/incB.mal +++ /dev/null @@ -1,10 +0,0 @@ -;; A comment in a file -(def! inc4 (fn* (a) (+ 4 a))) -(def! inc5 (fn* (a) ;; a comment after code - (+ 5 a))) - -(prn "incB.mal finished") -"incB.mal return string" - -;; ending comment - diff --git a/tests/incC.mal b/tests/incC.mal deleted file mode 100644 index e6f5041ec2..0000000000 --- a/tests/incC.mal +++ /dev/null @@ -1,6 +0,0 @@ -(def! mymap {"a" - 1}) - -(prn "incC.mal finished") -"incC.mal return string" - diff --git a/tests/perf1.mal b/tests/perf1.mal deleted file mode 100644 index 73488f8a00..0000000000 --- a/tests/perf1.mal +++ /dev/null @@ -1,11 +0,0 @@ -(load-file "../core.mal") -(load-file "../perf.mal") - -;;(prn "Start: basic macros performance test") - -(time (do - (or false nil false nil false nil false nil false nil 4) - (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" 7) - (-> (list 1 2 3 4 5 6 7 8 9) rest rest rest rest rest rest first))) - -;;(prn "Done: basic macros performance test") diff --git a/tests/perf2.mal b/tests/perf2.mal deleted file mode 100644 index c525baf5eb..0000000000 --- a/tests/perf2.mal +++ /dev/null @@ -1,13 +0,0 @@ -(load-file "../core.mal") -(load-file "../perf.mal") - -;;(prn "Start: basic math/recursion test") - -(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) -(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) - -(time (do - (sumdown 10) - (fib 12))) - -;;(prn "Done: basic math/recursion test") diff --git a/tests/perf3.mal b/tests/perf3.mal deleted file mode 100644 index be66239f06..0000000000 --- a/tests/perf3.mal +++ /dev/null @@ -1,28 +0,0 @@ -(load-file "../core.mal") -(load-file "../perf.mal") - -;;(prn "Start: basic macros/atom test") - -(def! atm (atom (list 0 1 2 3 4 5 6 7 8 9))) - -(println "iters/s:" - (run-fn-for - (fn* [] - (do - (or false nil false nil false nil false nil false nil (first @atm)) - (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" (first @atm)) - (-> (deref atm) rest rest rest rest rest rest first) - (swap! atm (fn* [a] (concat (rest a) (list (first a))))))) - 10)) - -;;(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) -;;(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) -;; -;;(println "iters/s:" -;; (run-fn-for -;; (fn* [] -;; (do -;; (sumdown 10) -;; (fib 12))) -;; 3)) -;;(prn "Done: basic macros/atom test") diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal deleted file mode 100644 index 985b5fbf0f..0000000000 --- a/tests/step1_read_print.mal +++ /dev/null @@ -1,136 +0,0 @@ -;; Testing read of nil/true/false -nil -;=>nil -true -;=>true -false -;=>false - - -;; Testing read of numbers -1 -;=>1 -7 -;=>7 - 7 -;=>7 - - -;; Testing read of symbols -+ -;=>+ -abc -;=>abc - abc -;=>abc -abc5 -;=>abc5 -abc-def -;=>abc-def - - -;; Testing read of strings -"abc" -;=>"abc" - "abc" -;=>"abc" -"abc (with parens)" -;=>"abc (with parens)" -"abc\"def" -;=>"abc\"def" -;;;"abc\ndef" -;;;;=>"abc\ndef" -"" -;=>"" - - -;; Testing read of lists -(+ 1 2) -;=>(+ 1 2) -((3 4)) -;=>((3 4)) -(+ 1 (+ 2 3)) -;=>(+ 1 (+ 2 3)) - ( + 1 (+ 2 3 ) ) -;=>(+ 1 (+ 2 3)) -(* 1 2) -;=>(* 1 2) -(** 1 2) -;=>(** 1 2) - -;; Test commas as whitespace -(1 2, 3,,,,),, -;=>(1 2 3) - -;; Testing read of quoting -'1 -;=>(quote 1) -'(1 2 3) -;=>(quote (1 2 3)) -`1 -;=>(quasiquote 1) -`(1 2 3) -;=>(quasiquote (1 2 3)) -~1 -;=>(unquote 1) -~(1 2 3) -;=>(unquote (1 2 3)) -~@(1 2 3) -;=>(splice-unquote (1 2 3)) - -;; -;; Testing reader errors -;;; TODO: fix these so they fail correctly -(1 2 -; expected ')', got EOF -[1 2 -; expected ']', got EOF -"abc -; expected '"', got EOF - -;; -;; -------- Optional Functionality -------- - -;; Testing keywords -:kw -;=>:kw -(:kw1 :kw2 :kw3) -;=>(:kw1 :kw2 :kw3) - -;; Testing read of vectors -[+ 1 2] -;=>[+ 1 2] -[[3 4]] -;=>[[3 4]] -[+ 1 [+ 2 3]] -;=>[+ 1 [+ 2 3]] - [ + 1 [+ 2 3 ] ] -;=>[+ 1 [+ 2 3]] - -;; Testing read of hash maps -{"abc" 1} -;=>{"abc" 1} -{"a" {"b" 2}} -;=>{"a" {"b" 2}} -{"a" {"b" {"c" 3}}} -;=>{"a" {"b" {"c" 3}}} -{ "a" {"b" { "cde" 3 } }} -;=>{"a" {"b" {"cde" 3}}} -{ :a {:b { :cde 3 } }} -;=>{:a {:b {:cde 3}}} - -;; Testing read of comments - ;; whole line comment (not an exception) -1 ; comment after expression -;=>1 -1; comment after expression -;=>1 - -;; Testing read of ^/metadata -^{"a" 1} [1 2 3] -;=>(with-meta [1 2 3] {"a" 1}) - - -;; Testing read of @/deref -@a -;=>(deref a) diff --git a/tests/step2_eval.mal b/tests/step2_eval.mal deleted file mode 100644 index e97591020e..0000000000 --- a/tests/step2_eval.mal +++ /dev/null @@ -1,31 +0,0 @@ -;; Testing evaluation of arithmetic operations -(+ 1 2) -;=>3 - -(+ 5 (* 2 3)) -;=>11 - -(- (+ 5 (* 2 3)) 3) -;=>8 - -(/ (- (+ 5 (* 2 3)) 3) 4) -;=>2 - -(/ (- (+ 515 (* 222 311)) 302) 27) -;=>2565 - -(abc 1 2 3) -; .*\'abc\' not found.* - -;; -;; -------- Optional Functionality -------- - -;; Testing evaluation within collection literals -[1 2 (+ 1 2)] -;=>[1 2 3] - -{"a" (+ 7 8)} -;=>{"a" 15} - -{:a (+ 7 8)} -;=>{:a 15} diff --git a/tests/step3_env.mal b/tests/step3_env.mal deleted file mode 100644 index 8fb4c42653..0000000000 --- a/tests/step3_env.mal +++ /dev/null @@ -1,46 +0,0 @@ -;; Testing REPL_ENV -(+ 1 2) -;=>3 -(/ (- (+ 5 (* 2 3)) 3) 4) -;=>2 - - -;; Testing def! -(def! x 3) -;=>3 -x -;=>3 -(def! x 4) -;=>4 -x -;=>4 -(def! y (+ 1 7)) -;=>8 -y -;=>8 - - -;; Testing let* -(let* (z 9) z) -;=>9 -(let* (x 9) x) -;=>9 -x -;=>4 -(let* (z (+ 2 3)) (+ 1 z)) -;=>6 -(let* (p (+ 2 3) q (+ 2 p)) (+ p q)) -;=>12 - -;; -;; -------- Optional Functionality -------- - -;; Testing let* with vector bindings -(let* [z 9] z) -;=>9 -(let* [p (+ 2 3) q (+ 2 p)] (+ p q)) -;=>12 - -;; Testing vector evaluation -(let* (a 5 b 6) [3 4 a [b 7] 8]) -;=>[3 4 5 [6 7] 8] diff --git a/tests/step4_if_fn_do.mal b/tests/step4_if_fn_do.mal deleted file mode 100644 index 34966f50b2..0000000000 --- a/tests/step4_if_fn_do.mal +++ /dev/null @@ -1,388 +0,0 @@ -;; ----------------------------------------------------- - - -;; Testing list functions -(list) -;=>() -(list? (list)) -;=>true -(empty? (list)) -;=>true -(empty? (list 1)) -;=>false -(list 1 2 3) -;=>(1 2 3) -(count (list 1 2 3)) -;=>3 -(count (list)) -;=>0 -(count nil) -;=>0 -(if (> (count (list 1 2 3)) 3) "yes" "no") -;=>"no" -(if (>= (count (list 1 2 3)) 3) "yes" "no") -;=>"yes" - - -;; Testing if form -(if true 7 8) -;=>7 -(if false 7 8) -;=>8 -(if true (+ 1 7) (+ 1 8)) -;=>8 -(if false (+ 1 7) (+ 1 8)) -;=>9 -(if nil 7 8) -;=>8 -(if 0 7 8) -;=>7 -(if "" 7 8) -;=>7 -(if (list) 7 8) -;=>7 -(if (list 1 2 3) 7 8) -;=>7 -(= (list) nil) -;=>false - - -;; Testing 1-way if form -(if false (+ 1 7)) -;=>nil -(if nil 8 7) -;=>7 -(if true (+ 1 7)) -;=>8 - - -;; Testing basic conditionals -(= 2 1) -;=>false -(= 1 1) -;=>true -(= 1 2) -;=>false -(= 1 (+ 1 1)) -;=>false -(= 2 (+ 1 1)) -;=>true -(= nil 1) -;=>false -(= nil nil) -;=>true - -(> 2 1) -;=>true -(> 1 1) -;=>false -(> 1 2) -;=>false - -(>= 2 1) -;=>true -(>= 1 1) -;=>true -(>= 1 2) -;=>false - -(< 2 1) -;=>false -(< 1 1) -;=>false -(< 1 2) -;=>true - -(<= 2 1) -;=>false -(<= 1 1) -;=>true -(<= 1 2) -;=>true - - -;; Testing equality -(= 1 1) -;=>true -(= 0 0) -;=>true -(= 1 0) -;=>false -(= "" "") -;=>true -(= "abc" "") -;=>false -(= "" "abc") -;=>false -(= "abc" "def") -;=>false - -(= (list) (list)) -;=>true -(= (list 1 2) (list 1 2)) -;=>true -(= (list 1) (list)) -;=>false -(= (list) (list 1)) -;=>false -(= 0 (list)) -;=>false -(= (list) 0) -;=>false -(= (list) "") -;=>false -(= "" (list)) -;=>false - - -;; Testing builtin and user defined functions -(+ 1 2) -;=>3 -( (fn* (a b) (+ b a)) 3 4) -;=>7 -( (fn* () 4) ) -;=>4 - -( (fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7) -;=>8 - - -;; Testing closures -( ( (fn* (a) (fn* (b) (+ a b))) 5) 7) -;=>12 - -(def! gen-plus5 (fn* () (fn* (b) (+ 5 b)))) -(def! plus5 (gen-plus5)) -(plus5 7) -;=>12 - -(def! gen-plusX (fn* (x) (fn* (b) (+ x b)))) -(def! plus7 (gen-plusX 7)) -(plus7 8) -;=>15 - - -;; Testing variable length arguments - -( (fn* (& more) (count more)) 1 2 3) -;=>3 -( (fn* (& more) (count more)) 1) -;=>1 -( (fn* (& more) (count more)) ) -;=>0 -( (fn* (a & more) (count more)) 1 2 3) -;=>2 -( (fn* (a & more) (count more)) 1) -;=>0 - - -;; Testing language defined not function -(not false) -;=>true -(not true) -;=>false -(not "a") -;=>false -(not 0) -;=>false - - -;; Testing do form -(do (prn "prn output1")) -; "prn output1" -;=>nil -(do (prn "prn output2") 7) -; "prn output2" -;=>7 -(do (prn "prn output1") (prn "prn output2") (+ 1 2)) -; "prn output1" -; "prn output2" -;=>3 - -(do (def! a 6) 7 (+ a 8)) -;=>14 -a -;=>6 - - -;; Testing recursive sumdown function -(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) -(sumdown 1) -;=>1 -(sumdown 2) -;=>3 -(sumdown 6) -;=>21 - - -;; Testing recursive fibonacci function -(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) -(fib 1) -;=>1 -(fib 2) -;=>2 -(fib 4) -;=>5 -(fib 10) -;=>89 - -;; ----------------------------------------------------- - -;; Testing string quoting - -"" -;=>"" - -"abc" -;=>"abc" - -"abc def" -;=>"abc def" - -"\"" -;=>"\"" - - -;; Testing pr-str - -(pr-str) -;=>"" - -(pr-str "") -;=>"\"\"" - -(pr-str "abc") -;=>"\"abc\"" - -(pr-str "abc def" "ghi jkl") -;=>"\"abc def\" \"ghi jkl\"" - -(pr-str "\"") -;=>"\"\\\"\"" - -(pr-str (list 1 2 "abc" "\"") "def") -;=>"(1 2 \"abc\" \"\\\"\") \"def\"" - - -;; Testing str - -(str) -;=>"" - -(str "") -;=>"" - -(str "abc") -;=>"abc" - -(str "\"") -;=>"\"" - -(str 1 "abc" 3) -;=>"1abc3" - -(str "abc def" "ghi jkl") -;=>"abc defghi jkl" - -;;; TODO: get this working properly -;;;(str (list 1 2 "abc" "\"") "def") -;;;;=>"(1 2 \"abc\" \"\\\"\")def" - - -;; Testing prn -(prn) -; -;=>nil - -(prn "") -; "" -;=>nil - -(prn "abc") -; "abc" -;=>nil - -(prn "abc def" "ghi jkl") -; "abc def" "ghi jkl" - -(prn "\"") -; "\"" -;=>nil - -(prn (list 1 2 "abc" "\"") "def") -; (1 2 "abc" "\"") "def" -;=>nil - - -;; Testing println -(println) -; -;=>nil - -(println "") -; -;=>nil - -(println "abc") -; abc -;=>nil - -(println "abc def" "ghi jkl") -; abc def ghi jkl - -(println "\"") -; " -;=>nil - -(println (list 1 2 "abc" "\"") "def") -; (1 2 abc ") def -;=>nil - -;; -;; -------- Optional Functionality -------- - -;; Testing keywords -(= :abc :abc) -;=>true -(= :abc :def) -;=>false -(= :abc ":abc") -;=>false - -;; Testing vector truthiness -(if [] 7 8) -;=>7 - -;; Testing vector functions -(count [1 2 3]) -;=>3 -(empty? [1 2 3]) -;=>false -(empty? []) -;=>true -(list? [4 5 6]) -;=>false - -;; Testing vector equality -(= [] (list)) -;=>true -(= (list 1 2) [1 2]) -;=>true -(= (list 1) []) -;=>false -(= [] [1]) -;=>false -(= 0 []) -;=>false -(= [] 0) -;=>false -(= [] "") -;=>false -(= "" []) -;=>false - -;; Testing vector parameter lists -( (fn* [] 4) ) -;=>4 -( (fn* [f x] (f x)) (fn* [a] (+ 1 a)) 7) -;=>8 diff --git a/tests/step5_tco.mal b/tests/step5_tco.mal deleted file mode 100644 index 9054c7466a..0000000000 --- a/tests/step5_tco.mal +++ /dev/null @@ -1,27 +0,0 @@ -;; Test recursive non-tail call function - -(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) - -(sum-to 10) -;=>55 - -;;; no try* yet, so test completion of side-effects -(def! res1 nil) -;=>nil -(def! res1 (sum-to 10000))) -res1 -;=>nil - -;; Testing recursive tail-call function - -(def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc))))) - -(sum2 10 0) -;=>55 - -(def! res2 nil) -;=>nil -(def! res2 (sum2 10000 0)) -res2 -;=>50005000 - diff --git a/tests/step6_file.mal b/tests/step6_file.mal deleted file mode 100644 index adee56dda6..0000000000 --- a/tests/step6_file.mal +++ /dev/null @@ -1,62 +0,0 @@ -;;; TODO: really a step5 test -;; -;; Testing that (do (do)) not broken by TCO -(do (do 1 2)) -;=>2 - -;; Testing read-string, eval and slurp - -(read-string "(+ 2 3)") -;=>(+ 2 3) - -(eval (read-string "(+ 2 3)")) -;=>5 - -;;; TODO: fix newline matching so that this works -;;;(slurp "../tests/test.txt") -;;;;=>"A line of text\n" - - -;; Testing load-file - -(load-file "../tests/inc.mal") -(inc1 7) -;=>8 -(inc2 7) -;=>9 -(inc3 9) -;=>12 - -;; -;; Testing that *ARGV* exists and is an empty list -(list? *ARGV*) -;=>true -*ARGV* -;=>() - -;; -;; -------- Optional Functionality -------- - -;; Testing comments in a file -(load-file "../tests/incB.mal") -; "incB.mal finished" -;=>"incB.mal return string" -(inc4 7) -;=>11 -(inc5 7) -;=>12 - -;; Testing map literal across multiple lines in a file -(load-file "../tests/incC.mal") -mymap -;=>{"a" 1} - -;;; TODO: really a step5 test -;; Testing that vector params not broken by TCO -(def! g (fn* [] 78)) -(g) -;=>78 -(def! g (fn* [a] (+ a 78))) -(g 3) -;=>81 - diff --git a/tests/step7_quote.mal b/tests/step7_quote.mal deleted file mode 100644 index dae6cbd7b1..0000000000 --- a/tests/step7_quote.mal +++ /dev/null @@ -1,126 +0,0 @@ -;; Testing cons function -(cons 1 (list)) -;=>(1) -(cons 1 (list 2)) -;=>(1 2) -(cons 1 (list 2 3)) -;=>(1 2 3) -(cons (list 1) (list 2 3)) -;=>((1) 2 3) - -;; Testing concat function -(concat) -;=>() -(concat (list 1 2)) -;=>(1 2) -(concat (list 1 2) (list 3 4)) -;=>(1 2 3 4) -(concat (list 1 2) (list 3 4) (list 5 6)) -;=>(1 2 3 4 5 6) -(concat (concat)) -;=>() - - -;; Testing regular quote -(quote 7) -;=>7 -'7 -;=>7 -(quote (1 2 3)) -;=>(1 2 3) -'(1 2 3) -;=>(1 2 3) -(quote (1 2 (3 4))) -;=>(1 2 (3 4)) -'(1 2 (3 4)) -;=>(1 2 (3 4)) - - -;; Testing simple quasiquote -(quasiquote 7) -;=>7 -`7 -;=>7 -(quasiquote (1 2 3)) -;=>(1 2 3) -`(1 2 3) -;=>(1 2 3) -(quasiquote (1 2 (3 4))) -;=>(1 2 (3 4)) -`(1 2 (3 4)) -;=>(1 2 (3 4)) - - -;; Testing unquote -`~7 -;=>7 -(def! a 8) -;=>8 -`a -;=>a -`~a -;=>8 -`(1 a 3) -;=>(1 a 3) -`(1 ~a 3) -;=>(1 8 3) -(def! b '(1 "b" "d")) -;=>(1 "b" "d") -`(1 b 3) -;=>(1 b 3) -`(1 ~b 3) -;=>(1 (1 "b" "d") 3) - - -;; Testing splice-unquote -(def! c '(1 "b" "d")) -;=>(1 "b" "d") -`(1 c 3) -;=>(1 c 3) -`(1 ~@c 3) -;=>(1 1 "b" "d" 3) - - -;; Testing symbol equality -(= 'abc 'abc) -;=>true -(= 'abc 'abcd) -;=>false -(= 'abc "abc") -;=>false -(= "abc" 'abc) -;=>false - -;;;;; Test quine -;;; TODO: needs expect line length fix -;;;((fn* [q] (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* [q] (quasiquote ((unquote q) (quote (unquote q))))))) -;;;=>((fn* [q] (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* [q] (quasiquote ((unquote q) (quote (unquote q))))))) - -;; -;; -------- Optional Functionality -------- - -;; Testing cons, concat, first, rest with vectors - -(cons [1] [2 3]) -;=>([1] 2 3) -(cons 1 [2 3]) -;=>(1 2 3) -(concat [1 2] (list 3 4) [5 6]) -;=>(1 2 3 4 5 6) - -;; Testing unquote with vectors -(def! a 8) -;=>8 -`[1 a 3] -;=>(1 a 3) -;;; TODO: fix this -;;;;=>[1 a 3] - -;; Testing splice-unquote with vectors -(def! c '(1 "b" "d")) -;=>(1 "b" "d") -`[1 ~@c 3] -;=>(1 1 "b" "d" 3) -;;; TODO: fix this -;;;;=>[1 1 "b" "d" 3] - diff --git a/tests/step8_macros.mal b/tests/step8_macros.mal deleted file mode 100644 index cf8f5d1909..0000000000 --- a/tests/step8_macros.mal +++ /dev/null @@ -1,161 +0,0 @@ -;; Testing nth, first and rest functions - -(nth '(1) 0) -;=>1 -(nth '(1 2) 1) -;=>2 -(def! x "x") -(def! x (nth '(1 2) 2)) -x -;=>"x" - -(first '()) -;=>nil -(first '(6)) -;=>6 -(first '(7 8 9)) -;=>7 - -(rest '()) -;=>() -(rest '(6)) -;=>() -(rest '(7 8 9)) -;=>(8 9) - - -;; Testing non-macro function -(not (= 1 1)) -;=>false -;;; This should fail if it is a macro -(not (= 1 2)) -;=>true - - -;; Testing trivial macros -(defmacro! one (fn* () 1)) -(one) -;=>1 -(defmacro! two (fn* () 2)) -(two) -;=>2 - -;; Testing unless macros -(defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a))) -(unless false 7 8) -;=>7 -(unless true 7 8) -;=>8 -(defmacro! unless2 (fn* (pred a b) `(if (not ~pred) ~a ~b))) -(unless2 false 7 8) -;=>7 -(unless2 true 7 8) -;=>8 - -;; Testing or macro -(or) -;=>nil -(or 1) -;=>1 -(or 1 2 3 4) -;=>1 -(or false 2) -;=>2 -(or false nil 3) -;=>3 -(or false nil false false nil 4) -;=>4 -(or false nil 3 false nil 4) -;=>3 - -;; Testing cond macro - -(cond) -;=>nil -(cond true 7) -;=>7 -(cond true 7 true 8) -;=>7 -(cond false 7 true 8) -;=>8 -(cond false 7 false 8 "else" 9) -;=>9 -(cond false 7 (= 2 2) 8 "else" 9) -;=>8 -(cond false 7 false 8 false 9) -;=>nil - -;; Testing macroexpand -(macroexpand (unless2 2 3 4)) -;=>(if (not 2) 3 4) - -;; -;; Loading core.mal -(load-file "../core.mal") - -;; Testing and macro -(and) -;=>true -(and 1) -;=>1 -(and 1 2) -;=>2 -(and 1 2 3) -;=>3 -(and 1 2 3 4) -;=>4 -(and 1 2 3 4 false) -;=>false -(and 1 2 3 4 false 5) -;=>false - -;; Testing -> macro - -(-> 7) -;=>7 -(-> (list 7 8 9) first) -;=>7 -(-> (list 7 8 9) (first)) -;=>7 -(-> (list 7 8 9) first (+ 7)) -;=>14 -(-> (list 7 8 9) rest (rest) first (+ 7)) -;=>16 - -;; Testing EVAL in let* - -(let* (x (or nil "yes")) x) -;=>"yes" - -;; -;; -------- Optional Functionality -------- - -;; Testing nth, first, rest with vectors - -(nth [1] 0) -;=>1 -(nth [1 2] 1) -;=>2 -(def! x "x") -(def! x (nth [1 2] 2)) -x -;=>"x" - -(first []) -;=>nil -(first [10]) -;=>10 -(first [10 11 12]) -;=>10 -(rest []) -;=>() -(rest [10]) -;=>() -(rest [10 11 12]) -;=>(11 12) - -;; Testing EVAL in vector let* - -(let* [x (or nil "yes")] x) -;=>"yes" - diff --git a/tests/step9_try.mal b/tests/step9_try.mal deleted file mode 100644 index 168b632788..0000000000 --- a/tests/step9_try.mal +++ /dev/null @@ -1,437 +0,0 @@ -;; -;; Testing try*/catch* - -(try* 123 (catch* e 456)) -;=>123 - -(try* (abc 1 2) (catch* exc (prn "exc is:" exc)))) -; "exc is:" "'abc' not found" -;=>nil - -;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try* -;;;(try* (throw ["data" "foo"]) (catch* exc (do (prn "exc is:" exc) 7))) ;;;; -;;;; "exc is:" ["data" "foo"] ;;;;=>7 -;;;;=>7 - -(try* (throw (list "data" "foo")) (catch* exc (do (prn "err:" exc) 7))) -; "err:" ("data" "foo") -;=>7 - -(try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) -; "exc:" "my exception" -;=>7 - -;;; Test that throw is a function: -(try* (map throw [7]) (catch* exc exc)) -;=>7 - - -;; -;; Testing builtin functions - -(symbol? 'abc) -;=>true -(symbol? "abc") -;=>false - -(nil? nil) -;=>true -(nil? true) -;=>false - -(true? true) -;=>true -(true? false) -;=>false -(true? true?) -;=>false - -(false? false) -;=>true -(false? true) -;=>false - -;; Testing apply function -(apply + (list 2 3)) -;=>5 -(apply + 4 (list 5)) -;=>9 -(apply prn (list 1 2 "3" (list))) -; 1 2 "3" () -(apply prn 1 2 (list "3" (list))) -; 1 2 "3" () -;=>nil - - -;; Testing map function -(def! nums (list 1 2 3)) -(def! double (fn* (a) (* 2 a))) -(double 3) -;=>6 -(map double nums) -;=>(2 4 6) -(map (fn* (x) (symbol? x)) (list 1 (symbol "two") "three")) -;=>(false true false) - -;; -;; Testing read-str and eval -(read-string "(1 2 (3 4) nil)") -;=>(1 2 (3 4) nil) - -(read-string "7 ;; comment") -;=>7 - -;;; Differing output, but make sure no fatal error -(read-string ";; comment") - - -(eval (read-string "(+ 4 5)")) -;=>9 - -;; -;; Testing readline -(readline "mal-user> ") -"hello" -;=>"\"hello\"" - -;; -;; ------- Optional Functionality ---------- -;; ------- (Needed for self-hosting) ------- - -;; Testing symbol and keyword functions -(symbol? :abc) -;=>false -(symbol? 'abc) -;=>true -(symbol? "abc") -;=>false -(symbol? (symbol "abc")) -;=>true -(keyword? :abc) -;=>true -(keyword? 'abc) -;=>false -(keyword? "abc") -;=>false -(keyword? (keyword "abc")) -;=>true - -;; Testing sequential? function - -(sequential? (list 1 2 3)) -;=>true -(sequential? [15]) -;=>true -(sequential? sequential?) -;=>false -(sequential? nil) -;=>false -(sequential? "abc") -;=>false - - -;; Testing map function with vectors -(map (fn* (a) (* 2 a)) [1 2 3]) -;=>(2 4 6) - -;; Testing vector functions - -(vector? [10 11]) -;=>true -(vector? '(12 13)) -;=>false -(vector 3 4 5) -;=>[3 4 5] - -(map? {}) -;=>true -(map? '()) -;=>false -(map? []) -;=>false -(map? 'abc) -;=>false -(map? :abc) -;=>false - -;; -;; Testing hash-maps -(hash-map "a" 1) -;=>{"a" 1} - -{"a" 1} -;=>{"a" 1} - -(assoc {} "a" 1) -;=>{"a" 1} - -(def! hm1 (hash-map)) -;=>{} - -(map? hm1) -;=>true -(map? 1) -;=>false -(map? "abc") -;=>false - -(get nil "a") -;=>nil - -(get hm1 "a") -;=>nil - -(contains? hm1 "a") -;=>false - -(def! hm2 (assoc hm1 "a" 1)) -;=>{"a" 1} - -(get hm1 "a") -;=>nil - -(contains? hm1 "a") -;=>false - -(get hm2 "a") -;=>1 - -(contains? hm2 "a") -;=>true - - -;;; TODO: fix. Clojure returns nil but this breaks mal impl -(keys hm1) -;=>() - -(keys hm2) -;=>("a") - -;;; TODO: fix. Clojure returns nil but this breaks mal impl -(vals hm1) -;=>() - -(vals hm2) -;=>(1) - -(count (keys (assoc hm2 "b" 2 "c" 3))) -;=>3 - -(def! hm3 (assoc hm2 "b" 2)) -(count (keys hm3)) -;=>2 -(count (vals hm3)) -;=>2 - -(dissoc hm3 "a") -;=>{"b" 2} - -(dissoc hm3 "a" "b") -;=>{} - -(dissoc hm3 "a" "b" "c") -;=>{} - -(count (keys hm3)) -;=>2 - -;; Testing keywords as hash-map keys -(get {:abc 123} :abc) -;=>123 -(contains? {:abc 123} :abc) -;=>true -(contains? {:abcd 123} :abc) -;=>false -(assoc {} :bcd 234) -;=>{:bcd 234} -(dissoc {:cde 345 :fgh 456} :cde) -;=>{:fgh 456} -(keyword? (nth (keys {:abc 123 :def 456}) 0)) -;=>true -;;; TODO: support : in strings in make impl -;;;(keyword? (nth (keys {":abc" 123 ":def" 456}) 0)) -;;;;=>false -(keyword? (nth (vals {"a" :abc "b" :def}) 0)) -;=>true - - - -;; -;; Testing metadata on functions - -;; -;; Testing metadata on mal functions - -(meta (fn* (a) a)) -;=>nil - -(meta (with-meta (fn* (a) a) {"b" 1})) -;=>{"b" 1} - -(meta (with-meta (fn* (a) a) "abc")) -;=>"abc" - -(def! l-wm (with-meta (fn* (a) a) {"b" 2})) -(meta l-wm) -;=>{"b" 2} - -(meta (with-meta l-wm {"new_meta" 123})) -;=>{"new_meta" 123} -(meta l-wm) -;=>{"b" 2} - -(def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1})) -(meta f-wm) -;=>{"abc" 1} - -(meta (with-meta f-wm {"new_meta" 123})) -;=>{"new_meta" 123} -(meta f-wm) -;=>{"abc" 1} - -(def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a))) -(meta f-wm2) -;=>{"abc" 1} - -;; -;; Make sure closures and metadata co-exist -(def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1}))) -(def! plus7 (gen-plusX 7)) -(def! plus8 (gen-plusX 8)) -(plus7 8) -;=>15 -(meta plus7) -;=>{"meta" 1} -(meta plus8) -;=>{"meta" 1} -(meta (with-meta plus7 {"meta" 2})) -;=>{"meta" 2} -(meta plus8) -;=>{"meta" 1} - - -;; -;; Testing atoms - -(def! inc3 (fn* (a) (+ 3 a))) - -(def! a (atom 2)) -;=>(atom 2) - -;;;(type a) -;;;;=>"atom" - -(deref a) -;=>2 - -@a -;=>2 - -(reset! a 3) -;=>3 - -@a -;=>3 - -(swap! a inc3) -;=>6 - -@a -;=>6 - -(swap! a (fn* (a) a)) -;=>6 - -(swap! a (fn* (a) (* 2 a))) -;=>12 - -(swap! a (fn* (a b) (* a b)) 10) -;=>120 - -(swap! a + 3) -;=>123 - -;; Testing swap!/closure interaction -(def! inc-it (fn* (a) (+ 1 a))) -(def! atm (atom 7)) -(def! f (fn* [] (swap! atm inc-it))) -(f) -;=>8 -(f) -;=>9 - - -;; -;; ------- Optional Functionality -------------- -;; ------- (Not needed for self-hosting) ------- - -;; -;; Testing conj function -(conj (list) 1) -;=>(1) -(conj (list 1) 2) -;=>(2 1) -(conj (list 2 3) 4) -;=>(4 2 3) -(conj (list 2 3) 4 5 6) -;=>(6 5 4 2 3) -(conj (list 1) (list 2 3)) -;=>((2 3) 1) - -(conj [] 1) -;=>[1] -(conj [1] 2) -;=>[1 2] -(conj [2 3] 4) -;=>[2 3 4] -(conj [2 3] 4 5 6) -;=>[2 3 4 5 6] -(conj [1] [2 3]) -;=>[1 [2 3]] - - -;; -;; Testing metadata on collections - -(meta [1 2 3]) -;=>nil - -(with-meta [1 2 3] {"a" 1}) -;=>[1 2 3] - -(meta (with-meta [1 2 3] {"a" 1})) -;=>{"a" 1} - -(meta (with-meta [1 2 3] "abc")) -;=>"abc" - -(meta (with-meta (list 1 2 3) {"a" 1})) -;=>{"a" 1} - -(meta (with-meta {"abc" 123} {"a" 1})) -;=>{"a" 1} - -;;; Not actually supported by Clojure -;;;(meta (with-meta (atom 7) {"a" 1})) -;;;;=>{"a" 1} - -(def! l-wm (with-meta [4 5 6] {"b" 2})) -;=>[4 5 6] -(meta l-wm) -;=>{"b" 2} - -(meta (with-meta l-wm {"new_meta" 123})) -;=>{"new_meta" 123} -(meta l-wm) -;=>{"b" 2} - -;; -;; Testing metadata on builtin functions -(meta +) -;=>nil -(def! f-wm3 ^{"def" 2} +) -(meta f-wm3) -;=>{"def" 2} -(meta +) -;=>nil - diff --git a/vb/Makefile b/vb/Makefile deleted file mode 100644 index 25d9b96344..0000000000 --- a/vb/Makefile +++ /dev/null @@ -1,52 +0,0 @@ -##################### - -DEBUG = - -TESTS = - -SOURCES_BASE = readline.vb types.vb reader.vb printer.vb -SOURCES_LISP = env.vb core.vb stepA_mal.vb -SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) - -##################### - -SRCS = step0_repl.vb step1_read_print.vb step2_eval.vb \ - step3_env.vb step4_if_fn_do.vb step5_tco.vb step6_file.vb \ - step7_quote.vb step8_macros.vb step9_try.vb stepA_mal.vb - -LIB_CS_SRCS = getline.cs -LIB_VB_SRCS = $(filter-out step%,$(filter %.vb,$(SOURCES))) - -FLAGS = $(if $(strip $(DEBUG)),-debug:full,) - -##################### - -all: mal.exe $(patsubst %.vb,%.exe,$(SRCS)) - -mal.exe: $(patsubst %.vb,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) - cp $< $@ - -mal_cs.dll: $(LIB_CS_SRCS) - mcs $(FLAGS) -target:library $+ -out:$@ - -mal_vb.dll: mal_cs.dll $(LIB_VB_SRCS) - vbnc $(FLAGS) -target:library -r:mal_cs.dll $(LIB_VB_SRCS) -out:$@ - -%.exe: %.vb mal_vb.dll - vbnc $(FLAGS) -r:mal_vb.dll -r:mal_cs.dll $< - -clean: - rm -f *.dll *.exe *.mdb - -.PHONY: stats tests $(TESTS) - -stats: $(SOURCES) - @wc $^ -stats-lisp: $(SOURCES_LISP) - @wc $^ - -tests: $(TESTS) - -$(TESTS): - @echo "Running $@"; \ - ./$@ || exit 1; \ diff --git a/vb/env.vb b/vb/env.vb deleted file mode 100644 index a2c46289a3..0000000000 --- a/vb/env.vb +++ /dev/null @@ -1,55 +0,0 @@ -Imports System.Collections.Generic -Imports Mal -Imports MalVal = Mal.types.MalVal -Imports MalSymbol = Mal.types.MalSymbol -Imports MalList = Mal.types.MalList - -Namespace Mal - Public Class env - Public Class Env - Dim outer As Env = Nothing - Dim data As Dictionary(Of String, MalVal) = New Dictionary(Of String, MalVal) - - Public Sub New(new_outer As Env) - outer = new_outer - End Sub - Public Sub New(new_outer As Env, binds As MalList, exprs As MalList) - outer = new_outer - For i As Integer = 0 To binds.size()-1 - Dim sym As String = DirectCast(binds.nth(i),MalSymbol).getName() - If sym = "&" Then - data(DirectCast(binds.nth(i+1),MalSymbol).getName()) = exprs.slice(i) - Exit For - Else - data(sym) = exprs.nth(i) - End If - Next - End Sub - - Public Function find(key As MalSymbol) As Env - If data.ContainsKey(key.getName()) Then - return Me - Else If outer IsNot Nothing Then - return outer.find(key) - Else - return Nothing - End If - End Function - - Public Function do_get(key As MalSymbol) As MalVal - Dim e As Env = find(key) - If e Is Nothing Then - throw New Mal.types.MalException( - "'" & key.getName() & "' not found") - Else - return e.data(key.getName()) - End If - End Function - - Public Function do_set(key As MalSymbol, value As MalVal) As Env - data(key.getName()) = value - return Me - End Function - End Class - End Class -End Namespace diff --git a/vb/step7_quote.vb b/vb/step7_quote.vb deleted file mode 100644 index f38741effd..0000000000 --- a/vb/step7_quote.vb +++ /dev/null @@ -1,248 +0,0 @@ -Imports System -Imports System.IO -Imports System.Collections.Generic -Imports Mal -Imports MalVal = Mal.types.MalVal -Imports MalInt = Mal.types.MalInt -Imports MalString = Mal.types.MalString -Imports MalSymbol = Mal.types.MalSymbol -Imports MalList = Mal.types.MalList -Imports MalVector = Mal.types.MalVector -Imports MalHashMap = Mal.types.MalHashMap -Imports MalFunc = Mal.types.MalFunc -Imports MalEnv = Mal.env.Env - -Namespace Mal - Class step7_quote - ' read - Shared Function READ(str As String) As MalVal - Return reader.read_str(str) - End Function - - ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 - End Function - - Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then - return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End Function - - - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - new_lst.conj_BANG(EVAL(mv, env)) - Next - return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function - - ' TODO: move to types.vb when it is ported - Class FClosure - Public ast As MalVal - Public params As MalList - Public env As MalEnv - Function fn(args as MalList) As MalVal - return EVAL(ast, new MalEnv(env, params, args)) - End Function - End Class - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - Do - - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) - End If - - ' apply list - Dim ast As MalList = DirectCast(orig_ast, MalList) - If ast.size() = 0 Then - return ast - End If - Dim a0 As MalVal = ast(0) - Dim a0sym As String - If TypeOf a0 is MalSymbol Then - a0sym = DirectCast(a0,MalSymbol).getName() - Else - a0sym = "__<*fn*>__" - End If - - Select a0sym - Case "def!" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim res As MalVal = EVAL(a2, env) - env.do_set(DirectCast(a1,MalSymbol), res) - return res - Case "let*" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim key As MalSymbol - Dim val as MalVal - Dim let_env As new MalEnv(env) - For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 - key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) - val = DirectCast(a1,MalList)(i+1) - let_env.do_set(key, EVAL(val, let_env)) - Next - orig_ast = a2 - env = let_env - Case "quote" - return ast(1) - Case "quasiquote" - orig_ast = quasiquote(ast(1)) - Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) - orig_ast = ast(ast.size()-1) - Case "if" - Dim a1 As MalVal = ast(1) - Dim cond As MalVal = EVAL(a1, env) - If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then - ' eval false slot form - If ast.size() > 3 Then - orig_ast = ast(3) - Else - return Mal.types.Nil - End If - Else - ' eval true slot form - orig_ast = ast(2) - - End If - Case "fn*" - Dim fc As New FClosure() - fc.ast = ast(2) - fc.params = DirectCast(ast(1),MalLIst) - fc.env = env - Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn - Dim mf As new MalFunc(ast(2), env, - DirectCast(ast(1),MalList), f) - return DirectCast(mf,MalVal) - Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) - Dim f As MalFunc = DirectCast(el(0), MalFunc) - Dim fnast As MalVal = f.getAst() - If not fnast Is Nothing - orig_ast = fnast - env = f.genEnv(el.rest()) - Else - Return f.apply(el.rest()) - End If - End Select - - Loop While True - End Function - - ' print - Shared Function PRINT(exp As MalVal) As String - return printer._pr_str(exp, TRUE) - End Function - - ' repl - Shared repl_env As MalEnv - - Shared Function REP(str As String) As String - Return PRINT(EVAL(READ(str), repl_env)) - End Function - - Shared Function do_eval(args As MalList) As MalVal - Return EVAL(args(0), repl_env) - End Function - - Shared Function Main As Integer - Dim args As String() = Environment.GetCommandLineArgs() - - repl_env = New MalEnv(Nothing) - - ' core.vb: defined using VB.NET - For Each entry As KeyValuePair(Of String,MalVal) In core.ns() - repl_env.do_set(new MalSymbol(entry.Key), entry.Value) - Next - repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) - Dim fileIdx As Integer = 1 - If args.Length > 1 AndAlso args(1) = "--raw" Then - Mal.readline.SetMode(Mal.readline.Modes.Raw) - fileIdx = 2 - End If - Dim argv As New MalList() - For i As Integer = fileIdx+1 To args.Length-1 - argv.conj_BANG(new MalString(args(i))) - Next - repl_env.do_set(new MalSymbol("*ARGV*"), argv) - - ' core.mal: defined using the language itself - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))") - - If args.Length > fileIdx Then - REP("(load-file """ & args(fileIdx) & """)") - return 0 - End If - - ' repl loop - Dim line As String - Do - Try - line = Mal.readline.Readline("user> ") - If line is Nothing Then - Exit Do - End If - If line = "" Then - Continue Do - End If - Catch e As IOException - Console.WriteLine("IOException: " & e.Message) - End Try - Try - Console.WriteLine(REP(line)) - Catch e as Exception - Console.WriteLine("Error: " & e.Message) - Console.WriteLine(e.StackTrace) - Continue Do - End Try - Loop While True - End function - End Class -End Namespace diff --git a/vb/step8_macros.vb b/vb/step8_macros.vb deleted file mode 100644 index 400dbe78b0..0000000000 --- a/vb/step8_macros.vb +++ /dev/null @@ -1,288 +0,0 @@ -Imports System -Imports System.IO -Imports System.Collections.Generic -Imports Mal -Imports MalVal = Mal.types.MalVal -Imports MalInt = Mal.types.MalInt -Imports MalString = Mal.types.MalString -Imports MalSymbol = Mal.types.MalSymbol -Imports MalList = Mal.types.MalList -Imports MalVector = Mal.types.MalVector -Imports MalHashMap = Mal.types.MalHashMap -Imports MalFunc = Mal.types.MalFunc -Imports MalEnv = Mal.env.Env - -Namespace Mal - Class step8_macros - ' read - Shared Function READ(str As String) As MalVal - Return reader.read_str(str) - End Function - - ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 - End Function - - Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then - return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End Function - - Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean - If TypeOf ast Is MalList Then - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - env.find(DirectCast(a0,MalSymbol)) IsNot Nothing Then - Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol)) - If TypeOf mac Is MalFunc AndAlso _ - DirectCast(mac,MalFunc).isMacro() Then - return True - End If - End If - End If - return False - End Function - - Shared Function macroexpand(ast As MalVal, env As MalEnv) As MalVal - While is_macro_call(ast, env) - Dim a0 As MalSymbol = DirectCast(DirectCast(ast,MalList)(0),MalSymbol) - Dim mac As MalFunc = DirectCast(env.do_get(a0),MalFunc) - ast = mac.apply(DirectCast(ast,MalList).rest()) - End While - return ast - End Function - - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - new_lst.conj_BANG(EVAL(mv, env)) - Next - return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function - - ' TODO: move to types.vb when it is ported - Class FClosure - Public ast As MalVal - Public params As MalList - Public env As MalEnv - Function fn(args as MalList) As MalVal - return EVAL(ast, new MalEnv(env, params, args)) - End Function - End Class - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - Do - - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) - End If - - ' apply list - Dim expanded As MalVal = macroexpand(orig_ast, env) - if not expanded.list_Q() Then - return expanded - End If - Dim ast As MalList = DirectCast(expanded, MalList) - - If ast.size() = 0 Then - return ast - End If - Dim a0 As MalVal = ast(0) - Dim a0sym As String - If TypeOf a0 is MalSymbol Then - a0sym = DirectCast(a0,MalSymbol).getName() - Else - a0sym = "__<*fn*>__" - End If - - Select a0sym - Case "def!" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim res As MalVal = EVAL(a2, env) - env.do_set(DirectCast(a1,MalSymbol), res) - return res - Case "let*" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim key As MalSymbol - Dim val as MalVal - Dim let_env As new MalEnv(env) - For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 - key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) - val = DirectCast(a1,MalList)(i+1) - let_env.do_set(key, EVAL(val, let_env)) - Next - orig_ast = a2 - env = let_env - Case "quote" - return ast(1) - Case "quasiquote" - orig_ast = quasiquote(ast(1)) - Case "defmacro!" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim res As MalVal = EVAL(a2, env) - DirectCast(res,MalFunc).setMacro() - env.do_set(DirectCast(a1,MalSymbol), res) - return res - Case "macroexpand" - Dim a1 As MalVal = ast(1) - return macroexpand(a1, env) - Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) - orig_ast = ast(ast.size()-1) - Case "if" - Dim a1 As MalVal = ast(1) - Dim cond As MalVal = EVAL(a1, env) - If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then - ' eval false slot form - If ast.size() > 3 Then - orig_ast = ast(3) - Else - return Mal.types.Nil - End If - Else - ' eval true slot form - orig_ast = ast(2) - - End If - Case "fn*" - Dim fc As New FClosure() - fc.ast = ast(2) - fc.params = DirectCast(ast(1),MalLIst) - fc.env = env - Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn - Dim mf As new MalFunc(ast(2), env, - DirectCast(ast(1),MalList), f) - return DirectCast(mf,MalVal) - Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) - Dim f As MalFunc = DirectCast(el(0), MalFunc) - Dim fnast As MalVal = f.getAst() - If not fnast Is Nothing - orig_ast = fnast - env = f.genEnv(el.rest()) - Else - Return f.apply(el.rest()) - End If - End Select - - Loop While True - End Function - - ' print - Shared Function PRINT(exp As MalVal) As String - return printer._pr_str(exp, TRUE) - End Function - - ' repl - Shared repl_env As MalEnv - - Shared Function REP(str As String) As String - Return PRINT(EVAL(READ(str), repl_env)) - End Function - - Shared Function do_eval(args As MalList) As MalVal - Return EVAL(args(0), repl_env) - End Function - - Shared Function Main As Integer - Dim args As String() = Environment.GetCommandLineArgs() - - repl_env = New MalEnv(Nothing) - - ' core.vb: defined using VB.NET - For Each entry As KeyValuePair(Of String,MalVal) In core.ns() - repl_env.do_set(new MalSymbol(entry.Key), entry.Value) - Next - repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) - Dim fileIdx As Integer = 1 - If args.Length > 1 AndAlso args(1) = "--raw" Then - Mal.readline.SetMode(Mal.readline.Modes.Raw) - fileIdx = 2 - End If - Dim argv As New MalList() - For i As Integer = fileIdx+1 To args.Length-1 - argv.conj_BANG(new MalString(args(i))) - Next - repl_env.do_set(new MalSymbol("*ARGV*"), argv) - - ' core.mal: defined using the language itself - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))") - REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") - REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - If args.Length > fileIdx Then - REP("(load-file """ & args(fileIdx) & """)") - return 0 - End If - - ' repl loop - Dim line As String - Do - Try - line = Mal.readline.Readline("user> ") - If line is Nothing Then - Exit Do - End If - If line = "" Then - Continue Do - End If - Catch e As IOException - Console.WriteLine("IOException: " & e.Message) - End Try - Try - Console.WriteLine(REP(line)) - Catch e as Exception - Console.WriteLine("Error: " & e.Message) - Console.WriteLine(e.StackTrace) - Continue Do - End Try - Loop While True - End function - End Class -End Namespace diff --git a/vb/step9_try.vb b/vb/step9_try.vb deleted file mode 100644 index d4a7af4678..0000000000 --- a/vb/step9_try.vb +++ /dev/null @@ -1,315 +0,0 @@ -Imports System -Imports System.IO -Imports System.Collections.Generic -Imports Mal -Imports MalVal = Mal.types.MalVal -Imports MalInt = Mal.types.MalInt -Imports MalString = Mal.types.MalString -Imports MalSymbol = Mal.types.MalSymbol -Imports MalList = Mal.types.MalList -Imports MalVector = Mal.types.MalVector -Imports MalHashMap = Mal.types.MalHashMap -Imports MalFunc = Mal.types.MalFunc -Imports MalEnv = Mal.env.Env - -Namespace Mal - Class step9_try - ' read - Shared Function READ(str As String) As MalVal - Return reader.read_str(str) - End Function - - ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 - End Function - - Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then - return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End Function - - Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean - If TypeOf ast Is MalList Then - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - env.find(DirectCast(a0,MalSymbol)) IsNot Nothing Then - Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol)) - If TypeOf mac Is MalFunc AndAlso _ - DirectCast(mac,MalFunc).isMacro() Then - return True - End If - End If - End If - return False - End Function - - Shared Function macroexpand(ast As MalVal, env As MalEnv) As MalVal - While is_macro_call(ast, env) - Dim a0 As MalSymbol = DirectCast(DirectCast(ast,MalList)(0),MalSymbol) - Dim mac As MalFunc = DirectCast(env.do_get(a0),MalFunc) - ast = mac.apply(DirectCast(ast,MalList).rest()) - End While - return ast - End Function - - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - new_lst.conj_BANG(EVAL(mv, env)) - Next - return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function - - ' TODO: move to types.vb when it is ported - Class FClosure - Public ast As MalVal - Public params As MalList - Public env As MalEnv - Function fn(args as MalList) As MalVal - return EVAL(ast, new MalEnv(env, params, args)) - End Function - End Class - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - Do - - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) - End If - - ' apply list - Dim expanded As MalVal = macroexpand(orig_ast, env) - if not expanded.list_Q() Then - return expanded - End If - Dim ast As MalList = DirectCast(expanded, MalList) - - If ast.size() = 0 Then - return ast - End If - Dim a0 As MalVal = ast(0) - Dim a0sym As String - If TypeOf a0 is MalSymbol Then - a0sym = DirectCast(a0,MalSymbol).getName() - Else - a0sym = "__<*fn*>__" - End If - - Select a0sym - Case "def!" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim res As MalVal = EVAL(a2, env) - env.do_set(DirectCast(a1,MalSymbol), res) - return res - Case "let*" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim key As MalSymbol - Dim val as MalVal - Dim let_env As new MalEnv(env) - For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 - key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) - val = DirectCast(a1,MalList)(i+1) - let_env.do_set(key, EVAL(val, let_env)) - Next - orig_ast = a2 - env = let_env - Case "quote" - return ast(1) - Case "quasiquote" - orig_ast = quasiquote(ast(1)) - Case "defmacro!" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim res As MalVal = EVAL(a2, env) - DirectCast(res,MalFunc).setMacro() - env.do_set(DirectCast(a1,MalSymbol), res) - return res - Case "macroexpand" - Dim a1 As MalVal = ast(1) - return macroexpand(a1, env) - Case "try*" - Try - return EVAL(ast(1), env) - Catch e As Exception - If ast.size() > 2 Then - Dim exc As MalVal - Dim a2 As MalVal = ast(2) - Dim a20 As MalVal = DirectCast(a2,MalList)(0) - If DirectCast(a20,MalSymbol).getName() = "catch*" Then - If TypeOf e Is Mal.types.MalException Then - exc = DirectCast(e,Mal.types.MalException).getValue() - Else - exc = New MalString(e.StackTrace) - End If - return EVAL( - DirectCast(a2,MalList)(2), - New MalEnv(env, - DirectCast(a2,MalList).slice(1,2), - New MalList(exc))) - End If - Throw e - End If - End Try - Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) - orig_ast = ast(ast.size()-1) - Case "if" - Dim a1 As MalVal = ast(1) - Dim cond As MalVal = EVAL(a1, env) - If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then - ' eval false slot form - If ast.size() > 3 Then - orig_ast = ast(3) - Else - return Mal.types.Nil - End If - Else - ' eval true slot form - orig_ast = ast(2) - - End If - Case "fn*" - Dim fc As New FClosure() - fc.ast = ast(2) - fc.params = DirectCast(ast(1),MalLIst) - fc.env = env - Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn - Dim mf As new MalFunc(ast(2), env, - DirectCast(ast(1),MalList), f) - return DirectCast(mf,MalVal) - Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) - Dim f As MalFunc = DirectCast(el(0), MalFunc) - Dim fnast As MalVal = f.getAst() - If not fnast Is Nothing - orig_ast = fnast - env = f.genEnv(el.rest()) - Else - Return f.apply(el.rest()) - End If - End Select - - Loop While True - End Function - - ' print - Shared Function PRINT(exp As MalVal) As String - return printer._pr_str(exp, TRUE) - End Function - - ' repl - Shared repl_env As MalEnv - - Shared Function REP(str As String) As String - Return PRINT(EVAL(READ(str), repl_env)) - End Function - - Shared Function do_eval(args As MalList) As MalVal - Return EVAL(args(0), repl_env) - End Function - - Shared Function Main As Integer - Dim args As String() = Environment.GetCommandLineArgs() - - repl_env = New MalEnv(Nothing) - - ' core.vb: defined using VB.NET - For Each entry As KeyValuePair(Of String,MalVal) In core.ns() - repl_env.do_set(new MalSymbol(entry.Key), entry.Value) - Next - repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) - Dim fileIdx As Integer = 1 - If args.Length > 1 AndAlso args(1) = "--raw" Then - Mal.readline.SetMode(Mal.readline.Modes.Raw) - fileIdx = 2 - End If - Dim argv As New MalList() - For i As Integer = fileIdx+1 To args.Length-1 - argv.conj_BANG(new MalString(args(i))) - Next - repl_env.do_set(new MalSymbol("*ARGV*"), argv) - - ' core.mal: defined using the language itself - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))") - REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") - REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - If args.Length > fileIdx Then - REP("(load-file """ & args(fileIdx) & """)") - return 0 - End If - - ' repl loop - Dim line As String - Do - Try - line = Mal.readline.Readline("user> ") - If line is Nothing Then - Exit Do - End If - If line = "" Then - Continue Do - End If - Catch e As IOException - Console.WriteLine("IOException: " & e.Message) - End Try - Try - Console.WriteLine(REP(line)) - Catch e As Mal.types.MalException - Console.WriteLine("Error: " & _ - printer._pr_str(e.getValue(), False)) - Continue Do - Catch e As Exception - Console.WriteLine("Error: " & e.Message) - Console.WriteLine(e.StackTrace) - Continue Do - End Try - Loop While True - End function - End Class -End Namespace diff --git a/vb/stepA_mal.vb b/vb/stepA_mal.vb deleted file mode 100644 index 6778e0a07f..0000000000 --- a/vb/stepA_mal.vb +++ /dev/null @@ -1,317 +0,0 @@ -Imports System -Imports System.IO -Imports System.Collections.Generic -Imports Mal -Imports MalVal = Mal.types.MalVal -Imports MalInt = Mal.types.MalInt -Imports MalString = Mal.types.MalString -Imports MalSymbol = Mal.types.MalSymbol -Imports MalList = Mal.types.MalList -Imports MalVector = Mal.types.MalVector -Imports MalHashMap = Mal.types.MalHashMap -Imports MalFunc = Mal.types.MalFunc -Imports MalEnv = Mal.env.Env - -Namespace Mal - Class stepA_mal - ' read - Shared Function READ(str As String) As MalVal - Return reader.read_str(str) - End Function - - ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 - End Function - - Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then - return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End Function - - Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean - If TypeOf ast Is MalList Then - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - env.find(DirectCast(a0,MalSymbol)) IsNot Nothing Then - Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol)) - If TypeOf mac Is MalFunc AndAlso _ - DirectCast(mac,MalFunc).isMacro() Then - return True - End If - End If - End If - return False - End Function - - Shared Function macroexpand(ast As MalVal, env As MalEnv) As MalVal - While is_macro_call(ast, env) - Dim a0 As MalSymbol = DirectCast(DirectCast(ast,MalList)(0),MalSymbol) - Dim mac As MalFunc = DirectCast(env.do_get(a0),MalFunc) - ast = mac.apply(DirectCast(ast,MalList).rest()) - End While - return ast - End Function - - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - new_lst.conj_BANG(EVAL(mv, env)) - Next - return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast - End Function - - ' TODO: move to types.vb when it is ported - Class FClosure - Public ast As MalVal - Public params As MalList - Public env As MalEnv - Function fn(args as MalList) As MalVal - return EVAL(ast, new MalEnv(env, params, args)) - End Function - End Class - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - Do - - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) - End If - - ' apply list - Dim expanded As MalVal = macroexpand(orig_ast, env) - if not expanded.list_Q() Then - return expanded - End If - Dim ast As MalList = DirectCast(expanded, MalList) - - If ast.size() = 0 Then - return ast - End If - Dim a0 As MalVal = ast(0) - Dim a0sym As String - If TypeOf a0 is MalSymbol Then - a0sym = DirectCast(a0,MalSymbol).getName() - Else - a0sym = "__<*fn*>__" - End If - - Select a0sym - Case "def!" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim res As MalVal = EVAL(a2, env) - env.do_set(DirectCast(a1,MalSymbol), res) - return res - Case "let*" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim key As MalSymbol - Dim val as MalVal - Dim let_env As new MalEnv(env) - For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 - key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) - val = DirectCast(a1,MalList)(i+1) - let_env.do_set(key, EVAL(val, let_env)) - Next - orig_ast = a2 - env = let_env - Case "quote" - return ast(1) - Case "quasiquote" - orig_ast = quasiquote(ast(1)) - Case "defmacro!" - Dim a1 As MalVal = ast(1) - Dim a2 As MalVal = ast(2) - Dim res As MalVal = EVAL(a2, env) - DirectCast(res,MalFunc).setMacro() - env.do_set(DirectCast(a1,MalSymbol), res) - return res - Case "macroexpand" - Dim a1 As MalVal = ast(1) - return macroexpand(a1, env) - Case "try*" - Try - return EVAL(ast(1), env) - Catch e As Exception - If ast.size() > 2 Then - Dim exc As MalVal - Dim a2 As MalVal = ast(2) - Dim a20 As MalVal = DirectCast(a2,MalList)(0) - If DirectCast(a20,MalSymbol).getName() = "catch*" Then - If TypeOf e Is Mal.types.MalException Then - exc = DirectCast(e,Mal.types.MalException).getValue() - Else - exc = New MalString(e.StackTrace) - End If - return EVAL( - DirectCast(a2,MalList)(2), - New MalEnv(env, - DirectCast(a2,MalList).slice(1,2), - New MalList(exc))) - End If - Throw e - End If - End Try - Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) - orig_ast = ast(ast.size()-1) - Case "if" - Dim a1 As MalVal = ast(1) - Dim cond As MalVal = EVAL(a1, env) - If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then - ' eval false slot form - If ast.size() > 3 Then - orig_ast = ast(3) - Else - return Mal.types.Nil - End If - Else - ' eval true slot form - orig_ast = ast(2) - - End If - Case "fn*" - Dim fc As New FClosure() - fc.ast = ast(2) - fc.params = DirectCast(ast(1),MalLIst) - fc.env = env - Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn - Dim mf As new MalFunc(ast(2), env, - DirectCast(ast(1),MalList), f) - return DirectCast(mf,MalVal) - Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) - Dim f As MalFunc = DirectCast(el(0), MalFunc) - Dim fnast As MalVal = f.getAst() - If not fnast Is Nothing - orig_ast = fnast - env = f.genEnv(el.rest()) - Else - Return f.apply(el.rest()) - End If - End Select - - Loop While True - End Function - - ' print - Shared Function PRINT(exp As MalVal) As String - return printer._pr_str(exp, TRUE) - End Function - - ' repl - Shared repl_env As MalEnv - - Shared Function REP(str As String) As String - Return PRINT(EVAL(READ(str), repl_env)) - End Function - - Shared Function do_eval(args As MalList) As MalVal - Return EVAL(args(0), repl_env) - End Function - - Shared Function Main As Integer - Dim args As String() = Environment.GetCommandLineArgs() - - repl_env = New MalEnv(Nothing) - - ' core.vb: defined using VB.NET - For Each entry As KeyValuePair(Of String,MalVal) In core.ns() - repl_env.do_set(new MalSymbol(entry.Key), entry.Value) - Next - repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) - Dim fileIdx As Integer = 1 - If args.Length > 1 AndAlso args(1) = "--raw" Then - Mal.readline.SetMode(Mal.readline.Modes.Raw) - fileIdx = 2 - End If - Dim argv As New MalList() - For i As Integer = fileIdx+1 To args.Length-1 - argv.conj_BANG(new MalString(args(i))) - Next - repl_env.do_set(new MalSymbol("*ARGV*"), argv) - - ' core.mal: defined using the language itself - REP("(def! *host-language* ""VB.NET"")") - REP("(def! not (fn* (a) (if a false true)))") - REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))") - REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") - REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))") - - If args.Length > fileIdx Then - REP("(load-file """ & args(fileIdx) & """)") - return 0 - End If - - ' repl loop - Dim line As String - REP("(println (str ""Mal ["" *host-language* ""]""))") - Do - Try - line = Mal.readline.Readline("user> ") - If line is Nothing Then - Exit Do - End If - If line = "" Then - Continue Do - End If - Catch e As IOException - Console.WriteLine("IOException: " & e.Message) - End Try - Try - Console.WriteLine(REP(line)) - Catch e As Mal.types.MalException - Console.WriteLine("Error: " & _ - printer._pr_str(e.getValue(), False)) - Continue Do - Catch e As Exception - Console.WriteLine("Error: " & e.Message) - Console.WriteLine(e.StackTrace) - Continue Do - End Try - Loop While True - End function - End Class -End Namespace diff --git a/voom-like-version.sh b/voom-like-version.sh new file mode 100755 index 0000000000..9e85e92770 --- /dev/null +++ b/voom-like-version.sh @@ -0,0 +1,3 @@ +#!/usr/bin/env sh + +echo $(TZ=UTC git log -1 --pretty=%ad-g%h --date=format-local:"%Y%m%d_%H%M%S" -- "$@")$(test -z "$(git status --short -- "$@")" || echo _DIRTY)